diff -Nru ocaml-3.12.1/.cvsignore ocaml-4.01.0/.cvsignore --- ocaml-3.12.1/.cvsignore 2010-04-13 10:44:25.000000000 +0000 +++ ocaml-4.01.0/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,19 +0,0 @@ -.depend -configure -ocamlc -ocamlc.opt -expunge -ocaml -ocamlopt -ocamlopt.opt -ocamlcomp.sh -ocamlcompopt.sh -package-macosx -.DS_Store -*.annot -_boot_log1 -_boot_log2 -_build -_log -myocamlbuild_config.ml -ocamlnat diff -Nru ocaml-3.12.1/.depend ocaml-4.01.0/.depend --- ocaml-3.12.1/.depend 2011-07-04 21:15:01.000000000 +0000 +++ ocaml-4.01.0/.depend 2013-08-15 16:13:16.000000000 +0000 @@ -1,918 +1,1044 @@ -utils/ccomp.cmi: -utils/clflags.cmi: -utils/config.cmi: -utils/consistbl.cmi: -utils/misc.cmi: -utils/tbl.cmi: -utils/terminfo.cmi: -utils/warnings.cmi: -utils/ccomp.cmo: utils/misc.cmi utils/config.cmi utils/clflags.cmi \ +utils/ccomp.cmi : +utils/clflags.cmi : +utils/config.cmi : +utils/consistbl.cmi : +utils/misc.cmi : +utils/tbl.cmi : +utils/terminfo.cmi : +utils/warnings.cmi : +utils/ccomp.cmo : utils/misc.cmi utils/config.cmi utils/clflags.cmi \ utils/ccomp.cmi -utils/ccomp.cmx: utils/misc.cmx utils/config.cmx utils/clflags.cmx \ +utils/ccomp.cmx : utils/misc.cmx utils/config.cmx utils/clflags.cmx \ utils/ccomp.cmi -utils/clflags.cmo: utils/config.cmi utils/clflags.cmi -utils/clflags.cmx: utils/config.cmx utils/clflags.cmi -utils/config.cmo: utils/config.cmi -utils/config.cmx: utils/config.cmi -utils/consistbl.cmo: utils/consistbl.cmi -utils/consistbl.cmx: utils/consistbl.cmi -utils/misc.cmo: utils/misc.cmi -utils/misc.cmx: utils/misc.cmi -utils/tbl.cmo: utils/tbl.cmi -utils/tbl.cmx: utils/tbl.cmi -utils/terminfo.cmo: utils/terminfo.cmi -utils/terminfo.cmx: utils/terminfo.cmi -utils/warnings.cmo: utils/warnings.cmi -utils/warnings.cmx: utils/warnings.cmi -parsing/asttypes.cmi: -parsing/lexer.cmi: parsing/parser.cmi parsing/location.cmi -parsing/linenum.cmi: -parsing/location.cmi: utils/warnings.cmi -parsing/longident.cmi: -parsing/parse.cmi: parsing/parsetree.cmi -parsing/parser.cmi: parsing/parsetree.cmi -parsing/parsetree.cmi: parsing/longident.cmi parsing/location.cmi \ +utils/clflags.cmo : utils/config.cmi utils/clflags.cmi +utils/clflags.cmx : utils/config.cmx utils/clflags.cmi +utils/config.cmo : utils/config.cmi +utils/config.cmx : utils/config.cmi +utils/consistbl.cmo : utils/consistbl.cmi +utils/consistbl.cmx : utils/consistbl.cmi +utils/misc.cmo : utils/misc.cmi +utils/misc.cmx : utils/misc.cmi +utils/tbl.cmo : utils/tbl.cmi +utils/tbl.cmx : utils/tbl.cmi +utils/terminfo.cmo : utils/terminfo.cmi +utils/terminfo.cmx : utils/terminfo.cmi +utils/warnings.cmo : utils/warnings.cmi +utils/warnings.cmx : utils/warnings.cmi +parsing/ast_mapper.cmi : parsing/parsetree.cmi parsing/longident.cmi \ + parsing/location.cmi parsing/asttypes.cmi +parsing/asttypes.cmi : parsing/location.cmi +parsing/lexer.cmi : parsing/parser.cmi parsing/location.cmi +parsing/location.cmi : utils/warnings.cmi +parsing/longident.cmi : +parsing/parse.cmi : parsing/parsetree.cmi +parsing/parser.cmi : parsing/parsetree.cmi parsing/longident.cmi \ + parsing/location.cmi +parsing/parsetree.cmi : parsing/longident.cmi parsing/location.cmi \ parsing/asttypes.cmi -parsing/printast.cmi: parsing/parsetree.cmi -parsing/syntaxerr.cmi: parsing/location.cmi -parsing/lexer.cmo: utils/warnings.cmi parsing/parser.cmi utils/misc.cmi \ +parsing/pprintast.cmi : parsing/parsetree.cmi parsing/longident.cmi \ + parsing/asttypes.cmi +parsing/printast.cmi : parsing/parsetree.cmi +parsing/syntaxerr.cmi : parsing/location.cmi +parsing/ast_mapper.cmo : parsing/parsetree.cmi parsing/longident.cmi \ + parsing/location.cmi utils/config.cmi parsing/asttypes.cmi \ + parsing/ast_mapper.cmi +parsing/ast_mapper.cmx : parsing/parsetree.cmi parsing/longident.cmx \ + parsing/location.cmx utils/config.cmx parsing/asttypes.cmi \ + parsing/ast_mapper.cmi +parsing/lexer.cmo : utils/warnings.cmi parsing/parser.cmi utils/misc.cmi \ parsing/location.cmi parsing/lexer.cmi -parsing/lexer.cmx: utils/warnings.cmx parsing/parser.cmx utils/misc.cmx \ +parsing/lexer.cmx : utils/warnings.cmx parsing/parser.cmx utils/misc.cmx \ parsing/location.cmx parsing/lexer.cmi -parsing/linenum.cmo: utils/misc.cmi parsing/linenum.cmi -parsing/linenum.cmx: utils/misc.cmx parsing/linenum.cmi -parsing/location.cmo: utils/warnings.cmi utils/terminfo.cmi \ - parsing/linenum.cmi parsing/location.cmi -parsing/location.cmx: utils/warnings.cmx utils/terminfo.cmx \ - parsing/linenum.cmx parsing/location.cmi -parsing/longident.cmo: utils/misc.cmi parsing/longident.cmi -parsing/longident.cmx: utils/misc.cmx parsing/longident.cmi -parsing/parse.cmo: parsing/syntaxerr.cmi parsing/parser.cmi \ +parsing/location.cmo : utils/warnings.cmi utils/terminfo.cmi \ + parsing/location.cmi +parsing/location.cmx : utils/warnings.cmx utils/terminfo.cmx \ + parsing/location.cmi +parsing/longident.cmo : utils/misc.cmi parsing/longident.cmi +parsing/longident.cmx : utils/misc.cmx parsing/longident.cmi +parsing/parse.cmo : parsing/syntaxerr.cmi parsing/parser.cmi \ parsing/location.cmi parsing/lexer.cmi parsing/parse.cmi -parsing/parse.cmx: parsing/syntaxerr.cmx parsing/parser.cmx \ +parsing/parse.cmx : parsing/syntaxerr.cmx parsing/parser.cmx \ parsing/location.cmx parsing/lexer.cmx parsing/parse.cmi -parsing/parser.cmo: parsing/syntaxerr.cmi parsing/parsetree.cmi \ +parsing/parser.cmo : parsing/syntaxerr.cmi parsing/parsetree.cmi \ parsing/longident.cmi parsing/location.cmi utils/clflags.cmi \ parsing/asttypes.cmi parsing/parser.cmi -parsing/parser.cmx: parsing/syntaxerr.cmx parsing/parsetree.cmi \ +parsing/parser.cmx : parsing/syntaxerr.cmx parsing/parsetree.cmi \ parsing/longident.cmx parsing/location.cmx utils/clflags.cmx \ parsing/asttypes.cmi parsing/parser.cmi -parsing/printast.cmo: parsing/parsetree.cmi parsing/longident.cmi \ +parsing/pprintast.cmo : parsing/parsetree.cmi parsing/longident.cmi \ + parsing/location.cmi parsing/asttypes.cmi parsing/pprintast.cmi +parsing/pprintast.cmx : parsing/parsetree.cmi parsing/longident.cmx \ + parsing/location.cmx parsing/asttypes.cmi parsing/pprintast.cmi +parsing/printast.cmo : parsing/parsetree.cmi parsing/longident.cmi \ parsing/location.cmi parsing/asttypes.cmi parsing/printast.cmi -parsing/printast.cmx: parsing/parsetree.cmi parsing/longident.cmx \ +parsing/printast.cmx : parsing/parsetree.cmi parsing/longident.cmx \ parsing/location.cmx parsing/asttypes.cmi parsing/printast.cmi -parsing/syntaxerr.cmo: parsing/location.cmi parsing/syntaxerr.cmi -parsing/syntaxerr.cmx: parsing/location.cmx parsing/syntaxerr.cmi -typing/annot.cmi: parsing/location.cmi -typing/btype.cmi: typing/types.cmi typing/path.cmi parsing/asttypes.cmi -typing/ctype.cmi: typing/types.cmi typing/path.cmi typing/ident.cmi \ - typing/env.cmi parsing/asttypes.cmi -typing/datarepr.cmi: typing/types.cmi typing/path.cmi parsing/asttypes.cmi -typing/env.cmi: typing/types.cmi typing/path.cmi parsing/longident.cmi \ - typing/ident.cmi utils/consistbl.cmi typing/annot.cmi -typing/ident.cmi: -typing/includeclass.cmi: typing/types.cmi typing/typedtree.cmi typing/env.cmi \ - typing/ctype.cmi -typing/includecore.cmi: typing/types.cmi typing/typedtree.cmi \ +parsing/syntaxerr.cmo : parsing/location.cmi parsing/syntaxerr.cmi +parsing/syntaxerr.cmx : parsing/location.cmx parsing/syntaxerr.cmi +typing/annot.cmi : parsing/location.cmi +typing/btype.cmi : typing/types.cmi typing/path.cmi parsing/asttypes.cmi +typing/cmi_format.cmi : typing/types.cmi +typing/cmt_format.cmi : typing/types.cmi typing/typedtree.cmi \ + parsing/location.cmi typing/env.cmi typing/cmi_format.cmi +typing/ctype.cmi : typing/types.cmi typing/path.cmi parsing/longident.cmi \ + typing/ident.cmi typing/env.cmi parsing/asttypes.cmi +typing/datarepr.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi \ + parsing/asttypes.cmi +typing/env.cmi : utils/warnings.cmi typing/types.cmi typing/subst.cmi \ + typing/path.cmi parsing/longident.cmi parsing/location.cmi \ + typing/ident.cmi utils/consistbl.cmi parsing/asttypes.cmi +typing/envaux.cmi : typing/subst.cmi typing/path.cmi typing/env.cmi +typing/ident.cmi : +typing/includeclass.cmi : typing/types.cmi typing/env.cmi typing/ctype.cmi +typing/includecore.cmi : typing/types.cmi typing/typedtree.cmi \ typing/ident.cmi typing/env.cmi -typing/includemod.cmi: typing/types.cmi typing/typedtree.cmi typing/path.cmi \ - typing/includecore.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi -typing/mtype.cmi: typing/types.cmi typing/path.cmi typing/ident.cmi \ +typing/includemod.cmi : typing/types.cmi typing/typedtree.cmi \ + typing/path.cmi typing/includecore.cmi typing/ident.cmi typing/env.cmi \ + typing/ctype.cmi +typing/mtype.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi \ typing/env.cmi -typing/oprint.cmi: typing/outcometree.cmi -typing/outcometree.cmi: parsing/asttypes.cmi -typing/parmatch.cmi: typing/types.cmi typing/typedtree.cmi \ - parsing/location.cmi typing/env.cmi -typing/path.cmi: typing/ident.cmi -typing/predef.cmi: typing/types.cmi typing/path.cmi typing/ident.cmi -typing/primitive.cmi: -typing/printtyp.cmi: typing/types.cmi typing/path.cmi typing/outcometree.cmi \ - parsing/longident.cmi typing/ident.cmi -typing/stypes.cmi: typing/typedtree.cmi parsing/location.cmi typing/annot.cmi -typing/subst.cmi: typing/types.cmi typing/path.cmi typing/ident.cmi -typing/typeclass.cmi: typing/types.cmi typing/typedtree.cmi \ +typing/oprint.cmi : typing/outcometree.cmi +typing/outcometree.cmi : parsing/asttypes.cmi +typing/parmatch.cmi : typing/types.cmi typing/typedtree.cmi \ + parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ + typing/env.cmi parsing/asttypes.cmi +typing/path.cmi : typing/ident.cmi +typing/predef.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi +typing/primitive.cmi : +typing/printtyp.cmi : typing/types.cmi typing/path.cmi \ + typing/outcometree.cmi parsing/longident.cmi typing/ident.cmi \ + typing/env.cmi +typing/printtyped.cmi : typing/typedtree.cmi +typing/stypes.cmi : typing/typedtree.cmi parsing/location.cmi \ + typing/annot.cmi +typing/subst.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi +typing/typeclass.cmi : typing/types.cmi typing/typedtree.cmi \ parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ typing/ident.cmi typing/env.cmi typing/ctype.cmi parsing/asttypes.cmi -typing/typecore.cmi: typing/types.cmi typing/typedtree.cmi typing/path.cmi \ +typing/typecore.cmi : typing/types.cmi typing/typedtree.cmi typing/path.cmi \ parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ typing/ident.cmi typing/env.cmi parsing/asttypes.cmi typing/annot.cmi -typing/typedecl.cmi: typing/types.cmi typing/path.cmi parsing/parsetree.cmi \ - parsing/longident.cmi parsing/location.cmi typing/includecore.cmi \ - typing/ident.cmi typing/env.cmi -typing/typedtree.cmi: typing/types.cmi typing/primitive.cmi typing/path.cmi \ - parsing/location.cmi typing/ident.cmi typing/env.cmi parsing/asttypes.cmi -typing/typemod.cmi: typing/types.cmi typing/typedtree.cmi \ +typing/typedecl.cmi : typing/types.cmi typing/typedtree.cmi typing/path.cmi \ + parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ + typing/includecore.cmi typing/ident.cmi typing/env.cmi \ + parsing/asttypes.cmi +typing/typedtree.cmi : typing/types.cmi typing/primitive.cmi typing/path.cmi \ + parsing/longident.cmi parsing/location.cmi typing/ident.cmi \ + typing/env.cmi parsing/asttypes.cmi +typing/typedtreeIter.cmi : typing/typedtree.cmi parsing/asttypes.cmi +typing/typedtreeMap.cmi : typing/typedtree.cmi +typing/typemod.cmi : typing/types.cmi typing/typedtree.cmi \ parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ typing/includemod.cmi typing/ident.cmi typing/env.cmi -typing/types.cmi: typing/primitive.cmi typing/path.cmi typing/ident.cmi \ +typing/types.cmi : typing/primitive.cmi typing/path.cmi \ + parsing/longident.cmi parsing/location.cmi typing/ident.cmi \ parsing/asttypes.cmi -typing/typetexp.cmi: typing/types.cmi typing/path.cmi parsing/parsetree.cmi \ - parsing/longident.cmi parsing/location.cmi typing/env.cmi -typing/unused_var.cmi: parsing/parsetree.cmi -typing/btype.cmo: typing/types.cmi typing/path.cmi utils/misc.cmi \ - typing/btype.cmi -typing/btype.cmx: typing/types.cmx typing/path.cmx utils/misc.cmx \ - typing/btype.cmi -typing/ctype.cmo: typing/types.cmi typing/subst.cmi typing/path.cmi \ - utils/misc.cmi parsing/longident.cmi typing/ident.cmi typing/env.cmi \ - utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/ctype.cmi -typing/ctype.cmx: typing/types.cmx typing/subst.cmx typing/path.cmx \ - utils/misc.cmx parsing/longident.cmx typing/ident.cmx typing/env.cmx \ - utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/ctype.cmi -typing/datarepr.cmo: typing/types.cmi typing/predef.cmi utils/misc.cmi \ - parsing/asttypes.cmi typing/datarepr.cmi -typing/datarepr.cmx: typing/types.cmx typing/predef.cmx utils/misc.cmx \ - parsing/asttypes.cmi typing/datarepr.cmi -typing/env.cmo: typing/types.cmi utils/tbl.cmi typing/subst.cmi \ - typing/predef.cmi typing/path.cmi utils/misc.cmi parsing/longident.cmi \ - typing/ident.cmi typing/datarepr.cmi utils/consistbl.cmi utils/config.cmi \ - utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi \ - typing/env.cmi -typing/env.cmx: typing/types.cmx utils/tbl.cmx typing/subst.cmx \ - typing/predef.cmx typing/path.cmx utils/misc.cmx parsing/longident.cmx \ - typing/ident.cmx typing/datarepr.cmx utils/consistbl.cmx utils/config.cmx \ - utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi \ - typing/env.cmi -typing/ident.cmo: typing/ident.cmi -typing/ident.cmx: typing/ident.cmi -typing/includeclass.cmo: typing/types.cmi typing/printtyp.cmi \ +typing/typetexp.cmi : typing/types.cmi typing/typedtree.cmi typing/path.cmi \ + parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ + typing/env.cmi parsing/asttypes.cmi +typing/btype.cmo : typing/types.cmi typing/path.cmi utils/misc.cmi \ + typing/ident.cmi typing/btype.cmi +typing/btype.cmx : typing/types.cmx typing/path.cmx utils/misc.cmx \ + typing/ident.cmx typing/btype.cmi +typing/cmi_format.cmo : typing/types.cmi utils/misc.cmi parsing/location.cmi \ + utils/config.cmi typing/cmi_format.cmi +typing/cmi_format.cmx : typing/types.cmx utils/misc.cmx parsing/location.cmx \ + utils/config.cmx typing/cmi_format.cmi +typing/cmt_format.cmo : typing/types.cmi typing/typedtreeMap.cmi \ + typing/typedtree.cmi utils/misc.cmi parsing/location.cmi \ + parsing/lexer.cmi typing/env.cmi utils/config.cmi typing/cmi_format.cmi \ + utils/clflags.cmi typing/cmt_format.cmi +typing/cmt_format.cmx : typing/types.cmx typing/typedtreeMap.cmx \ + typing/typedtree.cmx utils/misc.cmx parsing/location.cmx \ + parsing/lexer.cmx typing/env.cmx utils/config.cmx typing/cmi_format.cmx \ + utils/clflags.cmx typing/cmt_format.cmi +typing/ctype.cmo : typing/types.cmi typing/subst.cmi typing/path.cmi \ + utils/misc.cmi parsing/longident.cmi parsing/location.cmi \ + typing/ident.cmi typing/env.cmi utils/clflags.cmi typing/btype.cmi \ + parsing/asttypes.cmi typing/ctype.cmi +typing/ctype.cmx : typing/types.cmx typing/subst.cmx typing/path.cmx \ + utils/misc.cmx parsing/longident.cmx parsing/location.cmx \ + typing/ident.cmx typing/env.cmx utils/clflags.cmx typing/btype.cmx \ + parsing/asttypes.cmi typing/ctype.cmi +typing/datarepr.cmo : typing/types.cmi typing/predef.cmi typing/path.cmi \ + typing/ident.cmi typing/btype.cmi parsing/asttypes.cmi \ + typing/datarepr.cmi +typing/datarepr.cmx : typing/types.cmx typing/predef.cmx typing/path.cmx \ + typing/ident.cmx typing/btype.cmx parsing/asttypes.cmi \ + typing/datarepr.cmi +typing/env.cmo : utils/warnings.cmi typing/types.cmi utils/tbl.cmi \ + typing/subst.cmi typing/predef.cmi typing/path.cmi utils/misc.cmi \ + parsing/longident.cmi parsing/location.cmi typing/ident.cmi \ + typing/datarepr.cmi utils/consistbl.cmi utils/config.cmi \ + typing/cmi_format.cmi utils/clflags.cmi typing/btype.cmi \ + parsing/asttypes.cmi typing/env.cmi +typing/env.cmx : utils/warnings.cmx typing/types.cmx utils/tbl.cmx \ + typing/subst.cmx typing/predef.cmx typing/path.cmx utils/misc.cmx \ + parsing/longident.cmx parsing/location.cmx typing/ident.cmx \ + typing/datarepr.cmx utils/consistbl.cmx utils/config.cmx \ + typing/cmi_format.cmx utils/clflags.cmx typing/btype.cmx \ + parsing/asttypes.cmi typing/env.cmi +typing/envaux.cmo : typing/types.cmi typing/subst.cmi typing/printtyp.cmi \ + typing/path.cmi typing/mtype.cmi utils/misc.cmi typing/env.cmi \ + parsing/asttypes.cmi typing/envaux.cmi +typing/envaux.cmx : typing/types.cmx typing/subst.cmx typing/printtyp.cmx \ + typing/path.cmx typing/mtype.cmx utils/misc.cmx typing/env.cmx \ + parsing/asttypes.cmi typing/envaux.cmi +typing/ident.cmo : typing/ident.cmi +typing/ident.cmx : typing/ident.cmi +typing/includeclass.cmo : typing/types.cmi typing/printtyp.cmi \ typing/ctype.cmi typing/includeclass.cmi -typing/includeclass.cmx: typing/types.cmx typing/printtyp.cmx \ +typing/includeclass.cmx : typing/types.cmx typing/printtyp.cmx \ typing/ctype.cmx typing/includeclass.cmi -typing/includecore.cmo: typing/types.cmi typing/typedtree.cmi \ - typing/predef.cmi typing/path.cmi utils/misc.cmi typing/ctype.cmi \ - typing/btype.cmi parsing/asttypes.cmi typing/includecore.cmi -typing/includecore.cmx: typing/types.cmx typing/typedtree.cmx \ - typing/predef.cmx typing/path.cmx utils/misc.cmx typing/ctype.cmx \ - typing/btype.cmx parsing/asttypes.cmi typing/includecore.cmi -typing/includemod.cmo: typing/types.cmi typing/typedtree.cmi utils/tbl.cmi \ +typing/includecore.cmo : typing/types.cmi typing/typedtree.cmi \ + typing/predef.cmi typing/path.cmi utils/misc.cmi typing/ident.cmi \ + typing/env.cmi typing/ctype.cmi typing/btype.cmi parsing/asttypes.cmi \ + typing/includecore.cmi +typing/includecore.cmx : typing/types.cmx typing/typedtree.cmx \ + typing/predef.cmx typing/path.cmx utils/misc.cmx typing/ident.cmx \ + typing/env.cmx typing/ctype.cmx typing/btype.cmx parsing/asttypes.cmi \ + typing/includecore.cmi +typing/includemod.cmo : typing/types.cmi typing/typedtree.cmi utils/tbl.cmi \ typing/subst.cmi typing/printtyp.cmi typing/path.cmi typing/mtype.cmi \ - utils/misc.cmi typing/includecore.cmi typing/includeclass.cmi \ - typing/ident.cmi typing/env.cmi typing/ctype.cmi typing/includemod.cmi -typing/includemod.cmx: typing/types.cmx typing/typedtree.cmx utils/tbl.cmx \ + utils/misc.cmi parsing/location.cmi typing/includecore.cmi \ + typing/includeclass.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \ + utils/clflags.cmi typing/includemod.cmi +typing/includemod.cmx : typing/types.cmx typing/typedtree.cmx utils/tbl.cmx \ typing/subst.cmx typing/printtyp.cmx typing/path.cmx typing/mtype.cmx \ - utils/misc.cmx typing/includecore.cmx typing/includeclass.cmx \ - typing/ident.cmx typing/env.cmx typing/ctype.cmx typing/includemod.cmi -typing/mtype.cmo: typing/types.cmi typing/subst.cmi typing/path.cmi \ + utils/misc.cmx parsing/location.cmx typing/includecore.cmx \ + typing/includeclass.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \ + utils/clflags.cmx typing/includemod.cmi +typing/mtype.cmo : typing/types.cmi typing/subst.cmi typing/path.cmi \ typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/clflags.cmi \ typing/btype.cmi parsing/asttypes.cmi typing/mtype.cmi -typing/mtype.cmx: typing/types.cmx typing/subst.cmx typing/path.cmx \ +typing/mtype.cmx : typing/types.cmx typing/subst.cmx typing/path.cmx \ typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/clflags.cmx \ typing/btype.cmx parsing/asttypes.cmi typing/mtype.cmi -typing/oprint.cmo: typing/outcometree.cmi parsing/asttypes.cmi \ +typing/oprint.cmo : typing/outcometree.cmi parsing/asttypes.cmi \ typing/oprint.cmi -typing/oprint.cmx: typing/outcometree.cmi parsing/asttypes.cmi \ +typing/oprint.cmx : typing/outcometree.cmi parsing/asttypes.cmi \ typing/oprint.cmi -typing/parmatch.cmo: utils/warnings.cmi typing/types.cmi typing/typedtree.cmi \ - typing/subst.cmi typing/predef.cmi typing/path.cmi utils/misc.cmi \ +typing/parmatch.cmo : utils/warnings.cmi typing/types.cmi \ + typing/typedtree.cmi typing/subst.cmi typing/predef.cmi typing/path.cmi \ + parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \ parsing/location.cmi typing/ident.cmi typing/env.cmi typing/datarepr.cmi \ typing/ctype.cmi typing/btype.cmi parsing/asttypes.cmi \ typing/parmatch.cmi -typing/parmatch.cmx: utils/warnings.cmx typing/types.cmx typing/typedtree.cmx \ - typing/subst.cmx typing/predef.cmx typing/path.cmx utils/misc.cmx \ +typing/parmatch.cmx : utils/warnings.cmx typing/types.cmx \ + typing/typedtree.cmx typing/subst.cmx typing/predef.cmx typing/path.cmx \ + parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \ parsing/location.cmx typing/ident.cmx typing/env.cmx typing/datarepr.cmx \ typing/ctype.cmx typing/btype.cmx parsing/asttypes.cmi \ typing/parmatch.cmi -typing/path.cmo: typing/ident.cmi typing/path.cmi -typing/path.cmx: typing/ident.cmx typing/path.cmi -typing/predef.cmo: typing/types.cmi typing/path.cmi typing/ident.cmi \ - typing/btype.cmi parsing/asttypes.cmi typing/predef.cmi -typing/predef.cmx: typing/types.cmx typing/path.cmx typing/ident.cmx \ - typing/btype.cmx parsing/asttypes.cmi typing/predef.cmi -typing/primitive.cmo: utils/misc.cmi typing/primitive.cmi -typing/primitive.cmx: utils/misc.cmx typing/primitive.cmi -typing/printtyp.cmo: typing/types.cmi typing/primitive.cmi typing/predef.cmi \ - typing/path.cmi typing/outcometree.cmi typing/oprint.cmi utils/misc.cmi \ - parsing/longident.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \ +typing/path.cmo : typing/ident.cmi typing/path.cmi +typing/path.cmx : typing/ident.cmx typing/path.cmi +typing/predef.cmo : typing/types.cmi typing/path.cmi parsing/location.cmi \ + typing/ident.cmi typing/btype.cmi parsing/asttypes.cmi typing/predef.cmi +typing/predef.cmx : typing/types.cmx typing/path.cmx parsing/location.cmx \ + typing/ident.cmx typing/btype.cmx parsing/asttypes.cmi typing/predef.cmi +typing/primitive.cmo : utils/misc.cmi typing/primitive.cmi +typing/primitive.cmx : utils/misc.cmx typing/primitive.cmi +typing/printtyp.cmo : typing/types.cmi typing/primitive.cmi \ + typing/predef.cmi typing/path.cmi typing/outcometree.cmi \ + typing/oprint.cmi utils/misc.cmi parsing/longident.cmi \ + parsing/location.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \ utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \ typing/printtyp.cmi -typing/printtyp.cmx: typing/types.cmx typing/primitive.cmx typing/predef.cmx \ - typing/path.cmx typing/outcometree.cmi typing/oprint.cmx utils/misc.cmx \ - parsing/longident.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \ +typing/printtyp.cmx : typing/types.cmx typing/primitive.cmx \ + typing/predef.cmx typing/path.cmx typing/outcometree.cmi \ + typing/oprint.cmx utils/misc.cmx parsing/longident.cmx \ + parsing/location.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \ utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \ typing/printtyp.cmi -typing/stypes.cmo: typing/typedtree.cmi typing/printtyp.cmi \ +typing/printtyped.cmo : typing/typedtree.cmi typing/path.cmi \ + parsing/longident.cmi parsing/location.cmi typing/ident.cmi \ + parsing/asttypes.cmi typing/printtyped.cmi +typing/printtyped.cmx : typing/typedtree.cmx typing/path.cmx \ + parsing/longident.cmx parsing/location.cmx typing/ident.cmx \ + parsing/asttypes.cmi typing/printtyped.cmi +typing/stypes.cmo : typing/typedtree.cmi typing/printtyp.cmi \ parsing/location.cmi utils/clflags.cmi typing/annot.cmi typing/stypes.cmi -typing/stypes.cmx: typing/typedtree.cmx typing/printtyp.cmx \ +typing/stypes.cmx : typing/typedtree.cmx typing/printtyp.cmx \ parsing/location.cmx utils/clflags.cmx typing/annot.cmi typing/stypes.cmi -typing/subst.cmo: typing/types.cmi utils/tbl.cmi typing/path.cmi \ - utils/misc.cmi typing/ident.cmi typing/btype.cmi typing/subst.cmi -typing/subst.cmx: typing/types.cmx utils/tbl.cmx typing/path.cmx \ - utils/misc.cmx typing/ident.cmx typing/btype.cmx typing/subst.cmi -typing/typeclass.cmo: utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \ - typing/typedtree.cmi typing/typedecl.cmi typing/typecore.cmi \ - typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi typing/predef.cmi \ - typing/path.cmi parsing/parsetree.cmi typing/parmatch.cmi utils/misc.cmi \ +typing/subst.cmo : typing/types.cmi utils/tbl.cmi typing/path.cmi \ + utils/misc.cmi parsing/location.cmi typing/ident.cmi typing/btype.cmi \ + typing/subst.cmi +typing/subst.cmx : typing/types.cmx utils/tbl.cmx typing/path.cmx \ + utils/misc.cmx parsing/location.cmx typing/ident.cmx typing/btype.cmx \ + typing/subst.cmi +typing/typeclass.cmo : utils/warnings.cmi typing/typetexp.cmi \ + typing/types.cmi typing/typedtree.cmi typing/typedecl.cmi \ + typing/typecore.cmi typing/subst.cmi typing/stypes.cmi \ + typing/printtyp.cmi typing/predef.cmi typing/path.cmi \ + parsing/parsetree.cmi typing/parmatch.cmi utils/misc.cmi \ parsing/longident.cmi parsing/location.cmi typing/includeclass.cmi \ - typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/clflags.cmi \ - typing/btype.cmi parsing/asttypes.cmi typing/typeclass.cmi -typing/typeclass.cmx: utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \ - typing/typedtree.cmx typing/typedecl.cmx typing/typecore.cmx \ - typing/subst.cmx typing/stypes.cmx typing/printtyp.cmx typing/predef.cmx \ - typing/path.cmx parsing/parsetree.cmi typing/parmatch.cmx utils/misc.cmx \ + typing/ident.cmi typing/env.cmi typing/ctype.cmi typing/cmt_format.cmi \ + utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \ + typing/typeclass.cmi +typing/typeclass.cmx : utils/warnings.cmx typing/typetexp.cmx \ + typing/types.cmx typing/typedtree.cmx typing/typedecl.cmx \ + typing/typecore.cmx typing/subst.cmx typing/stypes.cmx \ + typing/printtyp.cmx typing/predef.cmx typing/path.cmx \ + parsing/parsetree.cmi typing/parmatch.cmx utils/misc.cmx \ parsing/longident.cmx parsing/location.cmx typing/includeclass.cmx \ - typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/clflags.cmx \ - typing/btype.cmx parsing/asttypes.cmi typing/typeclass.cmi -typing/typecore.cmo: utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \ - typing/typedtree.cmi typing/subst.cmi typing/stypes.cmi \ + typing/ident.cmx typing/env.cmx typing/ctype.cmx typing/cmt_format.cmx \ + utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \ + typing/typeclass.cmi +typing/typecore.cmo : utils/warnings.cmi typing/typetexp.cmi \ + typing/types.cmi typing/typedtree.cmi typing/subst.cmi typing/stypes.cmi \ typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \ typing/path.cmi parsing/parsetree.cmi typing/parmatch.cmi \ typing/oprint.cmi utils/misc.cmi parsing/longident.cmi \ parsing/location.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \ - utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi \ - typing/typecore.cmi -typing/typecore.cmx: utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \ - typing/typedtree.cmx typing/subst.cmx typing/stypes.cmx \ + typing/cmt_format.cmi utils/clflags.cmi typing/btype.cmi \ + parsing/asttypes.cmi typing/annot.cmi typing/typecore.cmi +typing/typecore.cmx : utils/warnings.cmx typing/typetexp.cmx \ + typing/types.cmx typing/typedtree.cmx typing/subst.cmx typing/stypes.cmx \ typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \ typing/path.cmx parsing/parsetree.cmi typing/parmatch.cmx \ typing/oprint.cmx utils/misc.cmx parsing/longident.cmx \ parsing/location.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \ - utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi \ - typing/typecore.cmi -typing/typedecl.cmo: utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \ - typing/typedtree.cmi typing/subst.cmi typing/printtyp.cmi \ - typing/primitive.cmi typing/predef.cmi typing/path.cmi \ - parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \ - parsing/location.cmi typing/includecore.cmi typing/ident.cmi \ - typing/env.cmi typing/ctype.cmi utils/config.cmi utils/clflags.cmi \ - typing/btype.cmi parsing/asttypes.cmi typing/typedecl.cmi -typing/typedecl.cmx: utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \ - typing/typedtree.cmx typing/subst.cmx typing/printtyp.cmx \ - typing/primitive.cmx typing/predef.cmx typing/path.cmx \ - parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \ - parsing/location.cmx typing/includecore.cmx typing/ident.cmx \ - typing/env.cmx typing/ctype.cmx utils/config.cmx utils/clflags.cmx \ - typing/btype.cmx parsing/asttypes.cmi typing/typedecl.cmi -typing/typedtree.cmo: typing/types.cmi typing/primitive.cmi typing/path.cmi \ - utils/misc.cmi parsing/location.cmi typing/ident.cmi typing/env.cmi \ - parsing/asttypes.cmi typing/typedtree.cmi -typing/typedtree.cmx: typing/types.cmx typing/primitive.cmx typing/path.cmx \ - utils/misc.cmx parsing/location.cmx typing/ident.cmx typing/env.cmx \ - parsing/asttypes.cmi typing/typedtree.cmi -typing/typemod.cmo: typing/typetexp.cmi typing/types.cmi typing/typedtree.cmi \ - typing/typedecl.cmi typing/typecore.cmi typing/typeclass.cmi \ - typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi typing/path.cmi \ - parsing/parsetree.cmi typing/mtype.cmi utils/misc.cmi \ - parsing/longident.cmi parsing/location.cmi typing/includemod.cmi \ + typing/cmt_format.cmx utils/clflags.cmx typing/btype.cmx \ + parsing/asttypes.cmi typing/annot.cmi typing/typecore.cmi +typing/typedecl.cmo : utils/warnings.cmi typing/typetexp.cmi \ + typing/types.cmi typing/typedtree.cmi typing/subst.cmi \ + typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \ + typing/path.cmi parsing/parsetree.cmi utils/misc.cmi \ + parsing/longident.cmi parsing/location.cmi typing/includecore.cmi \ typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/config.cmi \ + utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \ + typing/typedecl.cmi +typing/typedecl.cmx : utils/warnings.cmx typing/typetexp.cmx \ + typing/types.cmx typing/typedtree.cmx typing/subst.cmx \ + typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \ + typing/path.cmx parsing/parsetree.cmi utils/misc.cmx \ + parsing/longident.cmx parsing/location.cmx typing/includecore.cmx \ + typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \ + utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \ + typing/typedecl.cmi +typing/typedtree.cmo : typing/types.cmi typing/primitive.cmi typing/path.cmi \ + utils/misc.cmi parsing/longident.cmi parsing/location.cmi \ + typing/ident.cmi typing/env.cmi parsing/asttypes.cmi typing/typedtree.cmi +typing/typedtree.cmx : typing/types.cmx typing/primitive.cmx typing/path.cmx \ + utils/misc.cmx parsing/longident.cmx parsing/location.cmx \ + typing/ident.cmx typing/env.cmx parsing/asttypes.cmi typing/typedtree.cmi +typing/typedtreeIter.cmo : typing/typedtree.cmi parsing/asttypes.cmi \ + typing/typedtreeIter.cmi +typing/typedtreeIter.cmx : typing/typedtree.cmx parsing/asttypes.cmi \ + typing/typedtreeIter.cmi +typing/typedtreeMap.cmo : typing/typedtree.cmi utils/misc.cmi \ + parsing/asttypes.cmi typing/typedtreeMap.cmi +typing/typedtreeMap.cmx : typing/typedtree.cmx utils/misc.cmx \ + parsing/asttypes.cmi typing/typedtreeMap.cmi +typing/typemod.cmo : utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \ + typing/typedtree.cmi typing/typedecl.cmi typing/typecore.cmi \ + typing/typeclass.cmi typing/subst.cmi typing/stypes.cmi \ + typing/printtyp.cmi typing/path.cmi parsing/parsetree.cmi \ + typing/mtype.cmi utils/misc.cmi parsing/longident.cmi \ + parsing/location.cmi typing/includemod.cmi typing/ident.cmi \ + typing/env.cmi typing/ctype.cmi utils/config.cmi typing/cmt_format.cmi \ utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi \ typing/typemod.cmi -typing/typemod.cmx: typing/typetexp.cmx typing/types.cmx typing/typedtree.cmx \ - typing/typedecl.cmx typing/typecore.cmx typing/typeclass.cmx \ - typing/subst.cmx typing/stypes.cmx typing/printtyp.cmx typing/path.cmx \ - parsing/parsetree.cmi typing/mtype.cmx utils/misc.cmx \ - parsing/longident.cmx parsing/location.cmx typing/includemod.cmx \ - typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \ +typing/typemod.cmx : utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \ + typing/typedtree.cmx typing/typedecl.cmx typing/typecore.cmx \ + typing/typeclass.cmx typing/subst.cmx typing/stypes.cmx \ + typing/printtyp.cmx typing/path.cmx parsing/parsetree.cmi \ + typing/mtype.cmx utils/misc.cmx parsing/longident.cmx \ + parsing/location.cmx typing/includemod.cmx typing/ident.cmx \ + typing/env.cmx typing/ctype.cmx utils/config.cmx typing/cmt_format.cmx \ utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi \ typing/typemod.cmi -typing/types.cmo: typing/primitive.cmi typing/path.cmi utils/misc.cmi \ - typing/ident.cmi parsing/asttypes.cmi typing/types.cmi -typing/types.cmx: typing/primitive.cmx typing/path.cmx utils/misc.cmx \ - typing/ident.cmx parsing/asttypes.cmi typing/types.cmi -typing/typetexp.cmo: utils/warnings.cmi typing/types.cmi utils/tbl.cmi \ - typing/printtyp.cmi typing/path.cmi parsing/parsetree.cmi utils/misc.cmi \ - parsing/longident.cmi parsing/location.cmi typing/env.cmi \ - typing/ctype.cmi utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \ - typing/typetexp.cmi -typing/typetexp.cmx: utils/warnings.cmx typing/types.cmx utils/tbl.cmx \ - typing/printtyp.cmx typing/path.cmx parsing/parsetree.cmi utils/misc.cmx \ - parsing/longident.cmx parsing/location.cmx typing/env.cmx \ - typing/ctype.cmx utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \ - typing/typetexp.cmi -typing/unused_var.cmo: utils/warnings.cmi parsing/parsetree.cmi \ - parsing/longident.cmi parsing/location.cmi parsing/asttypes.cmi \ - typing/unused_var.cmi -typing/unused_var.cmx: utils/warnings.cmx parsing/parsetree.cmi \ - parsing/longident.cmx parsing/location.cmx parsing/asttypes.cmi \ - typing/unused_var.cmi -bytecomp/bytegen.cmi: bytecomp/lambda.cmi bytecomp/instruct.cmi -bytecomp/bytelibrarian.cmi: -bytecomp/bytelink.cmi: bytecomp/symtable.cmi bytecomp/cmo_format.cmi -bytecomp/bytepackager.cmi: typing/ident.cmi -bytecomp/bytesections.cmi: -bytecomp/cmo_format.cmi: bytecomp/lambda.cmi typing/ident.cmi -bytecomp/dll.cmi: -bytecomp/emitcode.cmi: bytecomp/instruct.cmi bytecomp/cmo_format.cmi -bytecomp/instruct.cmi: typing/types.cmi typing/subst.cmi parsing/location.cmi \ - bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi -bytecomp/lambda.cmi: typing/types.cmi typing/primitive.cmi typing/path.cmi \ +typing/types.cmo : typing/primitive.cmi typing/path.cmi \ + parsing/longident.cmi parsing/location.cmi typing/ident.cmi \ + parsing/asttypes.cmi typing/types.cmi +typing/types.cmx : typing/primitive.cmx typing/path.cmx \ + parsing/longident.cmx parsing/location.cmx typing/ident.cmx \ + parsing/asttypes.cmi typing/types.cmi +typing/typetexp.cmo : utils/warnings.cmi typing/types.cmi \ + typing/typedtree.cmi utils/tbl.cmi typing/printtyp.cmi typing/path.cmi \ + parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \ + parsing/location.cmi typing/env.cmi typing/ctype.cmi utils/clflags.cmi \ + typing/btype.cmi parsing/asttypes.cmi typing/typetexp.cmi +typing/typetexp.cmx : utils/warnings.cmx typing/types.cmx \ + typing/typedtree.cmx utils/tbl.cmx typing/printtyp.cmx typing/path.cmx \ + parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \ + parsing/location.cmx typing/env.cmx typing/ctype.cmx utils/clflags.cmx \ + typing/btype.cmx parsing/asttypes.cmi typing/typetexp.cmi +bytecomp/bytegen.cmi : bytecomp/lambda.cmi bytecomp/instruct.cmi +bytecomp/bytelibrarian.cmi : +bytecomp/bytelink.cmi : bytecomp/symtable.cmi bytecomp/cmo_format.cmi +bytecomp/bytepackager.cmi : typing/ident.cmi +bytecomp/bytesections.cmi : +bytecomp/cmo_format.cmi : bytecomp/lambda.cmi typing/ident.cmi +bytecomp/dll.cmi : +bytecomp/emitcode.cmi : bytecomp/instruct.cmi bytecomp/cmo_format.cmi +bytecomp/instruct.cmi : typing/types.cmi typing/subst.cmi \ + parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi +bytecomp/lambda.cmi : typing/types.cmi typing/primitive.cmi typing/path.cmi \ parsing/location.cmi typing/ident.cmi typing/env.cmi parsing/asttypes.cmi -bytecomp/matching.cmi: typing/typedtree.cmi parsing/location.cmi \ +bytecomp/matching.cmi : typing/typedtree.cmi parsing/location.cmi \ bytecomp/lambda.cmi typing/ident.cmi parsing/asttypes.cmi -bytecomp/meta.cmi: -bytecomp/printinstr.cmi: bytecomp/instruct.cmi -bytecomp/printlambda.cmi: bytecomp/lambda.cmi -bytecomp/runtimedef.cmi: -bytecomp/simplif.cmi: bytecomp/lambda.cmi -bytecomp/switch.cmi: -bytecomp/symtable.cmi: typing/ident.cmi bytecomp/cmo_format.cmi -bytecomp/translclass.cmi: typing/typedtree.cmi parsing/location.cmi \ +bytecomp/meta.cmi : +bytecomp/printinstr.cmi : bytecomp/instruct.cmi +bytecomp/printlambda.cmi : bytecomp/lambda.cmi +bytecomp/runtimedef.cmi : +bytecomp/simplif.cmi : bytecomp/lambda.cmi +bytecomp/switch.cmi : +bytecomp/symtable.cmi : utils/misc.cmi typing/ident.cmi \ + bytecomp/cmo_format.cmi +bytecomp/translclass.cmi : typing/typedtree.cmi parsing/location.cmi \ bytecomp/lambda.cmi typing/ident.cmi parsing/asttypes.cmi -bytecomp/translcore.cmi: typing/types.cmi typing/typedtree.cmi \ - typing/primitive.cmi typing/path.cmi parsing/location.cmi \ - bytecomp/lambda.cmi typing/ident.cmi parsing/asttypes.cmi -bytecomp/translmod.cmi: typing/typedtree.cmi typing/primitive.cmi \ +bytecomp/translcore.cmi : typing/typedtree.cmi typing/primitive.cmi \ + typing/path.cmi parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi \ + parsing/asttypes.cmi +bytecomp/translmod.cmi : typing/typedtree.cmi typing/primitive.cmi \ parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi -bytecomp/translobj.cmi: bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi -bytecomp/typeopt.cmi: typing/typedtree.cmi typing/path.cmi \ +bytecomp/translobj.cmi : bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi +bytecomp/typeopt.cmi : typing/typedtree.cmi typing/path.cmi \ bytecomp/lambda.cmi -bytecomp/bytegen.cmo: typing/types.cmi bytecomp/switch.cmi typing/subst.cmi \ +bytecomp/bytegen.cmo : typing/types.cmi bytecomp/switch.cmi typing/subst.cmi \ typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi \ bytecomp/instruct.cmi typing/ident.cmi utils/config.cmi \ parsing/asttypes.cmi bytecomp/bytegen.cmi -bytecomp/bytegen.cmx: typing/types.cmx bytecomp/switch.cmx typing/subst.cmx \ +bytecomp/bytegen.cmx : typing/types.cmx bytecomp/switch.cmx typing/subst.cmx \ typing/primitive.cmx utils/misc.cmx bytecomp/lambda.cmx \ bytecomp/instruct.cmx typing/ident.cmx utils/config.cmx \ parsing/asttypes.cmi bytecomp/bytegen.cmi -bytecomp/bytelibrarian.cmo: utils/misc.cmi utils/config.cmi \ - bytecomp/cmo_format.cmi utils/clflags.cmi bytecomp/bytelink.cmi \ - bytecomp/bytelibrarian.cmi -bytecomp/bytelibrarian.cmx: utils/misc.cmx utils/config.cmx \ - bytecomp/cmo_format.cmi utils/clflags.cmx bytecomp/bytelink.cmx \ - bytecomp/bytelibrarian.cmi -bytecomp/bytelink.cmo: bytecomp/symtable.cmi bytecomp/opcodes.cmo \ - utils/misc.cmi bytecomp/instruct.cmi typing/ident.cmi bytecomp/dll.cmi \ - utils/consistbl.cmi utils/config.cmi bytecomp/cmo_format.cmi \ - utils/clflags.cmi utils/ccomp.cmi bytecomp/bytesections.cmi \ - bytecomp/bytelink.cmi -bytecomp/bytelink.cmx: bytecomp/symtable.cmx bytecomp/opcodes.cmx \ - utils/misc.cmx bytecomp/instruct.cmx typing/ident.cmx bytecomp/dll.cmx \ - utils/consistbl.cmx utils/config.cmx bytecomp/cmo_format.cmi \ - utils/clflags.cmx utils/ccomp.cmx bytecomp/bytesections.cmx \ - bytecomp/bytelink.cmi -bytecomp/bytepackager.cmo: typing/typemod.cmi bytecomp/translmod.cmi \ - typing/subst.cmi typing/path.cmi utils/misc.cmi bytecomp/instruct.cmi \ - typing/ident.cmi typing/env.cmi bytecomp/emitcode.cmi utils/config.cmi \ - bytecomp/cmo_format.cmi utils/clflags.cmi bytecomp/bytelink.cmi \ - bytecomp/bytegen.cmi bytecomp/bytepackager.cmi -bytecomp/bytepackager.cmx: typing/typemod.cmx bytecomp/translmod.cmx \ - typing/subst.cmx typing/path.cmx utils/misc.cmx bytecomp/instruct.cmx \ - typing/ident.cmx typing/env.cmx bytecomp/emitcode.cmx utils/config.cmx \ - bytecomp/cmo_format.cmi utils/clflags.cmx bytecomp/bytelink.cmx \ - bytecomp/bytegen.cmx bytecomp/bytepackager.cmi -bytecomp/bytesections.cmo: utils/config.cmi bytecomp/bytesections.cmi -bytecomp/bytesections.cmx: utils/config.cmx bytecomp/bytesections.cmi -bytecomp/dll.cmo: utils/misc.cmi utils/config.cmi bytecomp/dll.cmi -bytecomp/dll.cmx: utils/misc.cmx utils/config.cmx bytecomp/dll.cmi -bytecomp/emitcode.cmo: bytecomp/translmod.cmi typing/primitive.cmi \ +bytecomp/bytelibrarian.cmo : utils/misc.cmi parsing/location.cmi \ + utils/config.cmi bytecomp/cmo_format.cmi utils/clflags.cmi \ + bytecomp/bytelink.cmi bytecomp/bytelibrarian.cmi +bytecomp/bytelibrarian.cmx : utils/misc.cmx parsing/location.cmx \ + utils/config.cmx bytecomp/cmo_format.cmi utils/clflags.cmx \ + bytecomp/bytelink.cmx bytecomp/bytelibrarian.cmi +bytecomp/bytelink.cmo : utils/warnings.cmi bytecomp/symtable.cmi \ + bytecomp/opcodes.cmo utils/misc.cmi parsing/location.cmi typing/ident.cmi \ + bytecomp/dll.cmi utils/consistbl.cmi utils/config.cmi \ + bytecomp/cmo_format.cmi utils/clflags.cmi utils/ccomp.cmi \ + bytecomp/bytesections.cmi bytecomp/bytelink.cmi +bytecomp/bytelink.cmx : utils/warnings.cmx bytecomp/symtable.cmx \ + bytecomp/opcodes.cmx utils/misc.cmx parsing/location.cmx typing/ident.cmx \ + bytecomp/dll.cmx utils/consistbl.cmx utils/config.cmx \ + bytecomp/cmo_format.cmi utils/clflags.cmx utils/ccomp.cmx \ + bytecomp/bytesections.cmx bytecomp/bytelink.cmi +bytecomp/bytepackager.cmo : typing/typemod.cmi bytecomp/translmod.cmi \ + typing/subst.cmi typing/path.cmi utils/misc.cmi parsing/location.cmi \ + bytecomp/instruct.cmi typing/ident.cmi typing/env.cmi \ + bytecomp/emitcode.cmi utils/config.cmi bytecomp/cmo_format.cmi \ + utils/clflags.cmi bytecomp/bytelink.cmi bytecomp/bytegen.cmi \ + bytecomp/bytepackager.cmi +bytecomp/bytepackager.cmx : typing/typemod.cmx bytecomp/translmod.cmx \ + typing/subst.cmx typing/path.cmx utils/misc.cmx parsing/location.cmx \ + bytecomp/instruct.cmx typing/ident.cmx typing/env.cmx \ + bytecomp/emitcode.cmx utils/config.cmx bytecomp/cmo_format.cmi \ + utils/clflags.cmx bytecomp/bytelink.cmx bytecomp/bytegen.cmx \ + bytecomp/bytepackager.cmi +bytecomp/bytesections.cmo : utils/misc.cmi utils/config.cmi \ + bytecomp/bytesections.cmi +bytecomp/bytesections.cmx : utils/misc.cmx utils/config.cmx \ + bytecomp/bytesections.cmi +bytecomp/dll.cmo : utils/misc.cmi utils/config.cmi bytecomp/dll.cmi +bytecomp/dll.cmx : utils/misc.cmx utils/config.cmx bytecomp/dll.cmi +bytecomp/emitcode.cmo : bytecomp/translmod.cmi typing/primitive.cmi \ bytecomp/opcodes.cmo utils/misc.cmi bytecomp/meta.cmi bytecomp/lambda.cmi \ bytecomp/instruct.cmi typing/env.cmi utils/config.cmi \ bytecomp/cmo_format.cmi utils/clflags.cmi typing/btype.cmi \ parsing/asttypes.cmi bytecomp/emitcode.cmi -bytecomp/emitcode.cmx: bytecomp/translmod.cmx typing/primitive.cmx \ +bytecomp/emitcode.cmx : bytecomp/translmod.cmx typing/primitive.cmx \ bytecomp/opcodes.cmx utils/misc.cmx bytecomp/meta.cmx bytecomp/lambda.cmx \ bytecomp/instruct.cmx typing/env.cmx utils/config.cmx \ bytecomp/cmo_format.cmi utils/clflags.cmx typing/btype.cmx \ parsing/asttypes.cmi bytecomp/emitcode.cmi -bytecomp/instruct.cmo: typing/types.cmi typing/subst.cmi parsing/location.cmi \ - bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi bytecomp/instruct.cmi -bytecomp/instruct.cmx: typing/types.cmx typing/subst.cmx parsing/location.cmx \ - bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx bytecomp/instruct.cmi -bytecomp/lambda.cmo: typing/types.cmi typing/primitive.cmi typing/path.cmi \ +bytecomp/instruct.cmo : typing/types.cmi typing/subst.cmi \ + parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \ + bytecomp/instruct.cmi +bytecomp/instruct.cmx : typing/types.cmx typing/subst.cmx \ + parsing/location.cmx bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx \ + bytecomp/instruct.cmi +bytecomp/lambda.cmo : typing/types.cmi typing/primitive.cmi typing/path.cmi \ utils/misc.cmi parsing/location.cmi typing/ident.cmi typing/env.cmi \ parsing/asttypes.cmi bytecomp/lambda.cmi -bytecomp/lambda.cmx: typing/types.cmx typing/primitive.cmx typing/path.cmx \ +bytecomp/lambda.cmx : typing/types.cmx typing/primitive.cmx typing/path.cmx \ utils/misc.cmx parsing/location.cmx typing/ident.cmx typing/env.cmx \ parsing/asttypes.cmi bytecomp/lambda.cmi -bytecomp/matching.cmo: typing/types.cmi bytecomp/typeopt.cmi \ +bytecomp/matching.cmo : typing/types.cmi bytecomp/typeopt.cmi \ typing/typedtree.cmi bytecomp/switch.cmi bytecomp/printlambda.cmi \ typing/primitive.cmi typing/predef.cmi typing/path.cmi \ typing/parmatch.cmi utils/misc.cmi parsing/longident.cmi \ parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \ utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \ bytecomp/matching.cmi -bytecomp/matching.cmx: typing/types.cmx bytecomp/typeopt.cmx \ +bytecomp/matching.cmx : typing/types.cmx bytecomp/typeopt.cmx \ typing/typedtree.cmx bytecomp/switch.cmx bytecomp/printlambda.cmx \ typing/primitive.cmx typing/predef.cmx typing/path.cmx \ typing/parmatch.cmx utils/misc.cmx parsing/longident.cmx \ parsing/location.cmx bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx \ utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \ bytecomp/matching.cmi -bytecomp/meta.cmo: bytecomp/meta.cmi -bytecomp/meta.cmx: bytecomp/meta.cmi -bytecomp/opcodes.cmo: -bytecomp/opcodes.cmx: -bytecomp/printinstr.cmo: bytecomp/printlambda.cmi parsing/location.cmi \ +bytecomp/meta.cmo : bytecomp/meta.cmi +bytecomp/meta.cmx : bytecomp/meta.cmi +bytecomp/opcodes.cmo : +bytecomp/opcodes.cmx : +bytecomp/printinstr.cmo : bytecomp/printlambda.cmi parsing/location.cmi \ bytecomp/lambda.cmi bytecomp/instruct.cmi typing/ident.cmi \ bytecomp/printinstr.cmi -bytecomp/printinstr.cmx: bytecomp/printlambda.cmx parsing/location.cmx \ +bytecomp/printinstr.cmx : bytecomp/printlambda.cmx parsing/location.cmx \ bytecomp/lambda.cmx bytecomp/instruct.cmx typing/ident.cmx \ bytecomp/printinstr.cmi -bytecomp/printlambda.cmo: typing/types.cmi typing/primitive.cmi \ +bytecomp/printlambda.cmo : typing/types.cmi typing/primitive.cmi \ parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi \ parsing/asttypes.cmi bytecomp/printlambda.cmi -bytecomp/printlambda.cmx: typing/types.cmx typing/primitive.cmx \ +bytecomp/printlambda.cmx : typing/types.cmx typing/primitive.cmx \ parsing/location.cmx bytecomp/lambda.cmx typing/ident.cmx \ parsing/asttypes.cmi bytecomp/printlambda.cmi -bytecomp/runtimedef.cmo: bytecomp/runtimedef.cmi -bytecomp/runtimedef.cmx: bytecomp/runtimedef.cmi -bytecomp/simplif.cmo: typing/stypes.cmi bytecomp/lambda.cmi typing/ident.cmi \ - utils/clflags.cmi parsing/asttypes.cmi typing/annot.cmi \ +bytecomp/runtimedef.cmo : bytecomp/runtimedef.cmi +bytecomp/runtimedef.cmx : bytecomp/runtimedef.cmi +bytecomp/simplif.cmo : utils/tbl.cmi typing/stypes.cmi bytecomp/lambda.cmi \ + typing/ident.cmi utils/clflags.cmi parsing/asttypes.cmi typing/annot.cmi \ bytecomp/simplif.cmi -bytecomp/simplif.cmx: typing/stypes.cmx bytecomp/lambda.cmx typing/ident.cmx \ - utils/clflags.cmx parsing/asttypes.cmi typing/annot.cmi \ +bytecomp/simplif.cmx : utils/tbl.cmx typing/stypes.cmx bytecomp/lambda.cmx \ + typing/ident.cmx utils/clflags.cmx parsing/asttypes.cmi typing/annot.cmi \ bytecomp/simplif.cmi -bytecomp/switch.cmo: bytecomp/switch.cmi -bytecomp/switch.cmx: bytecomp/switch.cmi -bytecomp/symtable.cmo: utils/tbl.cmi bytecomp/runtimedef.cmi \ +bytecomp/switch.cmo : bytecomp/switch.cmi +bytecomp/switch.cmx : bytecomp/switch.cmi +bytecomp/symtable.cmo : utils/tbl.cmi bytecomp/runtimedef.cmi \ typing/predef.cmi utils/misc.cmi bytecomp/meta.cmi bytecomp/lambda.cmi \ typing/ident.cmi bytecomp/dll.cmi bytecomp/cmo_format.cmi \ utils/clflags.cmi bytecomp/bytesections.cmi parsing/asttypes.cmi \ bytecomp/symtable.cmi -bytecomp/symtable.cmx: utils/tbl.cmx bytecomp/runtimedef.cmx \ +bytecomp/symtable.cmx : utils/tbl.cmx bytecomp/runtimedef.cmx \ typing/predef.cmx utils/misc.cmx bytecomp/meta.cmx bytecomp/lambda.cmx \ typing/ident.cmx bytecomp/dll.cmx bytecomp/cmo_format.cmi \ utils/clflags.cmx bytecomp/bytesections.cmx parsing/asttypes.cmi \ bytecomp/symtable.cmi -bytecomp/translclass.cmo: typing/types.cmi bytecomp/typeopt.cmi \ +bytecomp/translclass.cmo : typing/types.cmi bytecomp/typeopt.cmi \ typing/typedtree.cmi bytecomp/translobj.cmi bytecomp/translcore.cmi \ - typing/path.cmi utils/misc.cmi bytecomp/matching.cmi parsing/location.cmi \ + typing/path.cmi bytecomp/matching.cmi parsing/location.cmi \ bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi utils/clflags.cmi \ typing/btype.cmi parsing/asttypes.cmi bytecomp/translclass.cmi -bytecomp/translclass.cmx: typing/types.cmx bytecomp/typeopt.cmx \ +bytecomp/translclass.cmx : typing/types.cmx bytecomp/typeopt.cmx \ typing/typedtree.cmx bytecomp/translobj.cmx bytecomp/translcore.cmx \ - typing/path.cmx utils/misc.cmx bytecomp/matching.cmx parsing/location.cmx \ + typing/path.cmx bytecomp/matching.cmx parsing/location.cmx \ bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx utils/clflags.cmx \ typing/btype.cmx parsing/asttypes.cmi bytecomp/translclass.cmi -bytecomp/translcore.cmo: typing/types.cmi bytecomp/typeopt.cmi \ - typing/typedtree.cmi bytecomp/translobj.cmi typing/primitive.cmi \ - typing/predef.cmi typing/path.cmi typing/parmatch.cmi utils/misc.cmi \ - bytecomp/matching.cmi parsing/location.cmi bytecomp/lambda.cmi \ +bytecomp/translcore.cmo : utils/warnings.cmi typing/types.cmi \ + bytecomp/typeopt.cmi typing/typedtree.cmi bytecomp/translobj.cmi \ + typing/primitive.cmi typing/predef.cmi typing/path.cmi \ + typing/parmatch.cmi utils/misc.cmi bytecomp/matching.cmi \ + parsing/longident.cmi parsing/location.cmi bytecomp/lambda.cmi \ typing/ident.cmi typing/env.cmi utils/config.cmi utils/clflags.cmi \ typing/btype.cmi parsing/asttypes.cmi bytecomp/translcore.cmi -bytecomp/translcore.cmx: typing/types.cmx bytecomp/typeopt.cmx \ - typing/typedtree.cmx bytecomp/translobj.cmx typing/primitive.cmx \ - typing/predef.cmx typing/path.cmx typing/parmatch.cmx utils/misc.cmx \ - bytecomp/matching.cmx parsing/location.cmx bytecomp/lambda.cmx \ +bytecomp/translcore.cmx : utils/warnings.cmx typing/types.cmx \ + bytecomp/typeopt.cmx typing/typedtree.cmx bytecomp/translobj.cmx \ + typing/primitive.cmx typing/predef.cmx typing/path.cmx \ + typing/parmatch.cmx utils/misc.cmx bytecomp/matching.cmx \ + parsing/longident.cmx parsing/location.cmx bytecomp/lambda.cmx \ typing/ident.cmx typing/env.cmx utils/config.cmx utils/clflags.cmx \ typing/btype.cmx parsing/asttypes.cmi bytecomp/translcore.cmi -bytecomp/translmod.cmo: typing/types.cmi typing/typedtree.cmi \ +bytecomp/translmod.cmo : typing/types.cmi typing/typedtree.cmi \ bytecomp/translobj.cmi bytecomp/translcore.cmi bytecomp/translclass.cmi \ typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \ typing/path.cmi typing/mtype.cmi utils/misc.cmi parsing/longident.cmi \ parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \ typing/ctype.cmi parsing/asttypes.cmi bytecomp/translmod.cmi -bytecomp/translmod.cmx: typing/types.cmx typing/typedtree.cmx \ +bytecomp/translmod.cmx : typing/types.cmx typing/typedtree.cmx \ bytecomp/translobj.cmx bytecomp/translcore.cmx bytecomp/translclass.cmx \ typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \ typing/path.cmx typing/mtype.cmx utils/misc.cmx parsing/longident.cmx \ parsing/location.cmx bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx \ typing/ctype.cmx parsing/asttypes.cmi bytecomp/translmod.cmi -bytecomp/translobj.cmo: typing/primitive.cmi utils/misc.cmi \ +bytecomp/translobj.cmo : typing/primitive.cmi utils/misc.cmi \ parsing/longident.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \ utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \ bytecomp/translobj.cmi -bytecomp/translobj.cmx: typing/primitive.cmx utils/misc.cmx \ +bytecomp/translobj.cmx : typing/primitive.cmx utils/misc.cmx \ parsing/longident.cmx bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx \ utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \ bytecomp/translobj.cmi -bytecomp/typeopt.cmo: typing/types.cmi typing/typedtree.cmi \ - typing/primitive.cmi typing/predef.cmi typing/path.cmi utils/misc.cmi \ - bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \ - parsing/asttypes.cmi bytecomp/typeopt.cmi -bytecomp/typeopt.cmx: typing/types.cmx typing/typedtree.cmx \ - typing/primitive.cmx typing/predef.cmx typing/path.cmx utils/misc.cmx \ - bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \ - parsing/asttypes.cmi bytecomp/typeopt.cmi -asmcomp/asmgen.cmi: bytecomp/lambda.cmi asmcomp/cmm.cmi -asmcomp/asmlibrarian.cmi: -asmcomp/asmlink.cmi: asmcomp/cmx_format.cmi -asmcomp/asmpackager.cmi: -asmcomp/clambda.cmi: bytecomp/lambda.cmi typing/ident.cmi \ +bytecomp/typeopt.cmo : typing/types.cmi typing/typedtree.cmi \ + typing/predef.cmi typing/path.cmi bytecomp/lambda.cmi typing/ident.cmi \ + typing/env.cmi typing/ctype.cmi bytecomp/typeopt.cmi +bytecomp/typeopt.cmx : typing/types.cmx typing/typedtree.cmx \ + typing/predef.cmx typing/path.cmx bytecomp/lambda.cmx typing/ident.cmx \ + typing/env.cmx typing/ctype.cmx bytecomp/typeopt.cmi +asmcomp/asmgen.cmi : bytecomp/lambda.cmi asmcomp/cmm.cmi +asmcomp/asmlibrarian.cmi : +asmcomp/asmlink.cmi : asmcomp/cmx_format.cmi +asmcomp/asmpackager.cmi : +asmcomp/clambda.cmi : bytecomp/lambda.cmi typing/ident.cmi \ asmcomp/debuginfo.cmi parsing/asttypes.cmi -asmcomp/closure.cmi: bytecomp/lambda.cmi asmcomp/clambda.cmi -asmcomp/cmm.cmi: typing/ident.cmi asmcomp/debuginfo.cmi -asmcomp/cmmgen.cmi: asmcomp/cmx_format.cmi asmcomp/cmm.cmi \ +asmcomp/closure.cmi : bytecomp/lambda.cmi asmcomp/clambda.cmi +asmcomp/cmm.cmi : typing/ident.cmi asmcomp/debuginfo.cmi +asmcomp/cmmgen.cmi : asmcomp/cmx_format.cmi asmcomp/cmm.cmi \ asmcomp/clambda.cmi -asmcomp/cmx_format.cmi: asmcomp/clambda.cmi -asmcomp/codegen.cmi: asmcomp/cmm.cmi -asmcomp/coloring.cmi: -asmcomp/comballoc.cmi: asmcomp/mach.cmi -asmcomp/compilenv.cmi: typing/ident.cmi asmcomp/cmx_format.cmi \ - asmcomp/clambda.cmi -asmcomp/debuginfo.cmi: parsing/location.cmi bytecomp/lambda.cmi -asmcomp/emit.cmi: asmcomp/linearize.cmi asmcomp/cmm.cmi -asmcomp/emitaux.cmi: asmcomp/debuginfo.cmi -asmcomp/interf.cmi: asmcomp/mach.cmi -asmcomp/linearize.cmi: asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/debuginfo.cmi -asmcomp/liveness.cmi: asmcomp/mach.cmi -asmcomp/mach.cmi: asmcomp/reg.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi \ +asmcomp/cmx_format.cmi : asmcomp/clambda.cmi +asmcomp/codegen.cmi : asmcomp/cmm.cmi +asmcomp/coloring.cmi : +asmcomp/comballoc.cmi : asmcomp/mach.cmi +asmcomp/compilenv.cmi : bytecomp/lambda.cmi typing/ident.cmi \ + asmcomp/cmx_format.cmi asmcomp/clambda.cmi +asmcomp/debuginfo.cmi : parsing/location.cmi bytecomp/lambda.cmi +asmcomp/emit.cmi : asmcomp/linearize.cmi asmcomp/cmm.cmi +asmcomp/emitaux.cmi : asmcomp/debuginfo.cmi +asmcomp/interf.cmi : asmcomp/mach.cmi +asmcomp/linearize.cmi : asmcomp/reg.cmi asmcomp/mach.cmi \ + asmcomp/debuginfo.cmi +asmcomp/liveness.cmi : asmcomp/mach.cmi +asmcomp/mach.cmi : asmcomp/reg.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi \ asmcomp/arch.cmo -asmcomp/printcmm.cmi: asmcomp/cmm.cmi -asmcomp/printlinear.cmi: asmcomp/linearize.cmi -asmcomp/printmach.cmi: asmcomp/reg.cmi asmcomp/mach.cmi -asmcomp/proc.cmi: asmcomp/reg.cmi asmcomp/mach.cmi -asmcomp/reg.cmi: asmcomp/cmm.cmi -asmcomp/reload.cmi: asmcomp/mach.cmi -asmcomp/reloadgen.cmi: asmcomp/reg.cmi asmcomp/mach.cmi -asmcomp/schedgen.cmi: asmcomp/mach.cmi asmcomp/linearize.cmi -asmcomp/scheduling.cmi: asmcomp/linearize.cmi -asmcomp/selectgen.cmi: utils/tbl.cmi asmcomp/reg.cmi asmcomp/mach.cmi \ +asmcomp/printclambda.cmi : asmcomp/clambda.cmi +asmcomp/printcmm.cmi : asmcomp/cmm.cmi +asmcomp/printlinear.cmi : asmcomp/linearize.cmi +asmcomp/printmach.cmi : asmcomp/reg.cmi asmcomp/mach.cmi +asmcomp/proc.cmi : asmcomp/reg.cmi asmcomp/mach.cmi +asmcomp/reg.cmi : asmcomp/cmm.cmi +asmcomp/reload.cmi : asmcomp/mach.cmi +asmcomp/reloadgen.cmi : asmcomp/reg.cmi asmcomp/mach.cmi +asmcomp/schedgen.cmi : asmcomp/mach.cmi asmcomp/linearize.cmi +asmcomp/scheduling.cmi : asmcomp/linearize.cmi +asmcomp/selectgen.cmi : utils/tbl.cmi asmcomp/reg.cmi asmcomp/mach.cmi \ typing/ident.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi asmcomp/arch.cmo -asmcomp/selection.cmi: asmcomp/mach.cmi asmcomp/cmm.cmi -asmcomp/spill.cmi: asmcomp/mach.cmi -asmcomp/split.cmi: asmcomp/mach.cmi -asmcomp/arch.cmo: -asmcomp/arch.cmx: -asmcomp/asmgen.cmo: bytecomp/translmod.cmi asmcomp/split.cmi \ +asmcomp/selection.cmi : asmcomp/mach.cmi asmcomp/cmm.cmi +asmcomp/spill.cmi : asmcomp/mach.cmi +asmcomp/split.cmi : asmcomp/mach.cmi +asmcomp/arch.cmo : +asmcomp/arch.cmx : +asmcomp/asmgen.cmo : bytecomp/translmod.cmi asmcomp/split.cmi \ asmcomp/spill.cmi asmcomp/selection.cmi asmcomp/scheduling.cmi \ asmcomp/reload.cmi asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/printmach.cmi \ - asmcomp/printlinear.cmi asmcomp/printcmm.cmi typing/primitive.cmi \ - utils/misc.cmi asmcomp/mach.cmi asmcomp/liveness.cmi \ - asmcomp/linearize.cmi asmcomp/interf.cmi asmcomp/emitaux.cmi \ - asmcomp/emit.cmi utils/config.cmi asmcomp/compilenv.cmi \ - asmcomp/comballoc.cmi asmcomp/coloring.cmi asmcomp/cmmgen.cmi \ - asmcomp/cmm.cmi asmcomp/closure.cmi utils/clflags.cmi asmcomp/asmgen.cmi -asmcomp/asmgen.cmx: bytecomp/translmod.cmx asmcomp/split.cmx \ + asmcomp/printlinear.cmi asmcomp/printcmm.cmi asmcomp/printclambda.cmi \ + typing/primitive.cmi utils/misc.cmi asmcomp/mach.cmi parsing/location.cmi \ + asmcomp/liveness.cmi asmcomp/linearize.cmi asmcomp/interf.cmi \ + asmcomp/emitaux.cmi asmcomp/emit.cmi utils/config.cmi \ + asmcomp/compilenv.cmi asmcomp/comballoc.cmi asmcomp/coloring.cmi \ + asmcomp/cmmgen.cmi asmcomp/cmm.cmi asmcomp/closure.cmi utils/clflags.cmi \ + asmcomp/asmgen.cmi +asmcomp/asmgen.cmx : bytecomp/translmod.cmx asmcomp/split.cmx \ asmcomp/spill.cmx asmcomp/selection.cmx asmcomp/scheduling.cmx \ asmcomp/reload.cmx asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/printmach.cmx \ - asmcomp/printlinear.cmx asmcomp/printcmm.cmx typing/primitive.cmx \ - utils/misc.cmx asmcomp/mach.cmx asmcomp/liveness.cmx \ - asmcomp/linearize.cmx asmcomp/interf.cmx asmcomp/emitaux.cmx \ - asmcomp/emit.cmx utils/config.cmx asmcomp/compilenv.cmx \ - asmcomp/comballoc.cmx asmcomp/coloring.cmx asmcomp/cmmgen.cmx \ - asmcomp/cmm.cmx asmcomp/closure.cmx utils/clflags.cmx asmcomp/asmgen.cmi -asmcomp/asmlibrarian.cmo: utils/misc.cmi utils/config.cmi \ + asmcomp/printlinear.cmx asmcomp/printcmm.cmx asmcomp/printclambda.cmx \ + typing/primitive.cmx utils/misc.cmx asmcomp/mach.cmx parsing/location.cmx \ + asmcomp/liveness.cmx asmcomp/linearize.cmx asmcomp/interf.cmx \ + asmcomp/emitaux.cmx asmcomp/emit.cmx utils/config.cmx \ + asmcomp/compilenv.cmx asmcomp/comballoc.cmx asmcomp/coloring.cmx \ + asmcomp/cmmgen.cmx asmcomp/cmm.cmx asmcomp/closure.cmx utils/clflags.cmx \ + asmcomp/asmgen.cmi +asmcomp/asmlibrarian.cmo : utils/misc.cmi utils/config.cmi \ asmcomp/compilenv.cmi asmcomp/cmx_format.cmi utils/clflags.cmi \ asmcomp/clambda.cmi utils/ccomp.cmi asmcomp/asmlink.cmi \ asmcomp/asmlibrarian.cmi -asmcomp/asmlibrarian.cmx: utils/misc.cmx utils/config.cmx \ +asmcomp/asmlibrarian.cmx : utils/misc.cmx utils/config.cmx \ asmcomp/compilenv.cmx asmcomp/cmx_format.cmi utils/clflags.cmx \ asmcomp/clambda.cmx utils/ccomp.cmx asmcomp/asmlink.cmx \ asmcomp/asmlibrarian.cmi -asmcomp/asmlink.cmo: bytecomp/runtimedef.cmi asmcomp/proc.cmi utils/misc.cmi \ - parsing/location.cmi asmcomp/emitaux.cmi asmcomp/emit.cmi \ +asmcomp/asmlink.cmo : bytecomp/runtimedef.cmi asmcomp/proc.cmi \ + utils/misc.cmi parsing/location.cmi asmcomp/emitaux.cmi asmcomp/emit.cmi \ utils/consistbl.cmi utils/config.cmi asmcomp/compilenv.cmi \ asmcomp/cmx_format.cmi asmcomp/cmmgen.cmi utils/clflags.cmi \ utils/ccomp.cmi asmcomp/asmgen.cmi asmcomp/asmlink.cmi -asmcomp/asmlink.cmx: bytecomp/runtimedef.cmx asmcomp/proc.cmx utils/misc.cmx \ - parsing/location.cmx asmcomp/emitaux.cmx asmcomp/emit.cmx \ +asmcomp/asmlink.cmx : bytecomp/runtimedef.cmx asmcomp/proc.cmx \ + utils/misc.cmx parsing/location.cmx asmcomp/emitaux.cmx asmcomp/emit.cmx \ utils/consistbl.cmx utils/config.cmx asmcomp/compilenv.cmx \ asmcomp/cmx_format.cmi asmcomp/cmmgen.cmx utils/clflags.cmx \ utils/ccomp.cmx asmcomp/asmgen.cmx asmcomp/asmlink.cmi -asmcomp/asmpackager.cmo: typing/typemod.cmi bytecomp/translmod.cmi \ - utils/misc.cmi parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi \ - typing/env.cmi utils/config.cmi asmcomp/compilenv.cmi \ - asmcomp/cmx_format.cmi utils/clflags.cmi asmcomp/clambda.cmi \ - utils/ccomp.cmi asmcomp/asmlink.cmi asmcomp/asmgen.cmi \ +asmcomp/asmpackager.cmo : typing/typemod.cmi bytecomp/translmod.cmi \ + utils/misc.cmi parsing/location.cmi typing/ident.cmi typing/env.cmi \ + utils/config.cmi asmcomp/compilenv.cmi asmcomp/cmx_format.cmi \ + utils/clflags.cmi utils/ccomp.cmi asmcomp/asmlink.cmi asmcomp/asmgen.cmi \ asmcomp/asmpackager.cmi -asmcomp/asmpackager.cmx: typing/typemod.cmx bytecomp/translmod.cmx \ - utils/misc.cmx parsing/location.cmx bytecomp/lambda.cmx typing/ident.cmx \ - typing/env.cmx utils/config.cmx asmcomp/compilenv.cmx \ - asmcomp/cmx_format.cmi utils/clflags.cmx asmcomp/clambda.cmx \ - utils/ccomp.cmx asmcomp/asmlink.cmx asmcomp/asmgen.cmx \ +asmcomp/asmpackager.cmx : typing/typemod.cmx bytecomp/translmod.cmx \ + utils/misc.cmx parsing/location.cmx typing/ident.cmx typing/env.cmx \ + utils/config.cmx asmcomp/compilenv.cmx asmcomp/cmx_format.cmi \ + utils/clflags.cmx utils/ccomp.cmx asmcomp/asmlink.cmx asmcomp/asmgen.cmx \ asmcomp/asmpackager.cmi -asmcomp/clambda.cmo: bytecomp/lambda.cmi typing/ident.cmi \ +asmcomp/clambda.cmo : bytecomp/lambda.cmi typing/ident.cmi \ asmcomp/debuginfo.cmi parsing/asttypes.cmi asmcomp/clambda.cmi -asmcomp/clambda.cmx: bytecomp/lambda.cmx typing/ident.cmx \ +asmcomp/clambda.cmx : bytecomp/lambda.cmx typing/ident.cmx \ asmcomp/debuginfo.cmx parsing/asttypes.cmi asmcomp/clambda.cmi -asmcomp/closure.cmo: utils/tbl.cmi bytecomp/switch.cmi typing/primitive.cmi \ +asmcomp/closure.cmo : utils/tbl.cmi bytecomp/switch.cmi typing/primitive.cmi \ utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi asmcomp/debuginfo.cmi \ asmcomp/compilenv.cmi utils/clflags.cmi asmcomp/clambda.cmi \ - parsing/asttypes.cmi asmcomp/closure.cmi -asmcomp/closure.cmx: utils/tbl.cmx bytecomp/switch.cmx typing/primitive.cmx \ + parsing/asttypes.cmi asmcomp/arch.cmo asmcomp/closure.cmi +asmcomp/closure.cmx : utils/tbl.cmx bytecomp/switch.cmx typing/primitive.cmx \ utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx asmcomp/debuginfo.cmx \ asmcomp/compilenv.cmx utils/clflags.cmx asmcomp/clambda.cmx \ - parsing/asttypes.cmi asmcomp/closure.cmi -asmcomp/cmm.cmo: typing/ident.cmi asmcomp/debuginfo.cmi asmcomp/arch.cmo \ + parsing/asttypes.cmi asmcomp/arch.cmx asmcomp/closure.cmi +asmcomp/cmm.cmo : typing/ident.cmi asmcomp/debuginfo.cmi asmcomp/arch.cmo \ asmcomp/cmm.cmi -asmcomp/cmm.cmx: typing/ident.cmx asmcomp/debuginfo.cmx asmcomp/arch.cmx \ +asmcomp/cmm.cmx : typing/ident.cmx asmcomp/debuginfo.cmx asmcomp/arch.cmx \ asmcomp/cmm.cmi -asmcomp/cmmgen.cmo: typing/types.cmi bytecomp/switch.cmi asmcomp/proc.cmi \ +asmcomp/cmmgen.cmo : typing/types.cmi bytecomp/switch.cmi asmcomp/proc.cmi \ typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi \ asmcomp/debuginfo.cmi utils/config.cmi asmcomp/compilenv.cmi \ asmcomp/cmx_format.cmi asmcomp/cmm.cmi utils/clflags.cmi \ asmcomp/clambda.cmi parsing/asttypes.cmi asmcomp/arch.cmo \ asmcomp/cmmgen.cmi -asmcomp/cmmgen.cmx: typing/types.cmx bytecomp/switch.cmx asmcomp/proc.cmx \ +asmcomp/cmmgen.cmx : typing/types.cmx bytecomp/switch.cmx asmcomp/proc.cmx \ typing/primitive.cmx utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx \ asmcomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \ asmcomp/cmx_format.cmi asmcomp/cmm.cmx utils/clflags.cmx \ asmcomp/clambda.cmx parsing/asttypes.cmi asmcomp/arch.cmx \ asmcomp/cmmgen.cmi -asmcomp/codegen.cmo: asmcomp/split.cmi asmcomp/spill.cmi asmcomp/reload.cmi \ +asmcomp/codegen.cmo : asmcomp/split.cmi asmcomp/spill.cmi asmcomp/reload.cmi \ asmcomp/reg.cmi asmcomp/printmach.cmi asmcomp/printlinear.cmi \ asmcomp/printcmm.cmi asmcomp/liveness.cmi asmcomp/linearize.cmi \ asmcomp/interf.cmi asmcomp/emit.cmi asmcomp/coloring.cmi asmcomp/cmm.cmi \ asmcomp/codegen.cmi -asmcomp/codegen.cmx: asmcomp/split.cmx asmcomp/spill.cmx asmcomp/reload.cmx \ +asmcomp/codegen.cmx : asmcomp/split.cmx asmcomp/spill.cmx asmcomp/reload.cmx \ asmcomp/reg.cmx asmcomp/printmach.cmx asmcomp/printlinear.cmx \ asmcomp/printcmm.cmx asmcomp/liveness.cmx asmcomp/linearize.cmx \ asmcomp/interf.cmx asmcomp/emit.cmx asmcomp/coloring.cmx asmcomp/cmm.cmx \ asmcomp/codegen.cmi -asmcomp/coloring.cmo: asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/coloring.cmi -asmcomp/coloring.cmx: asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/coloring.cmi -asmcomp/comballoc.cmo: asmcomp/reg.cmi asmcomp/mach.cmi utils/config.cmi \ +asmcomp/coloring.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/coloring.cmi +asmcomp/coloring.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/coloring.cmi +asmcomp/comballoc.cmo : asmcomp/reg.cmi asmcomp/mach.cmi utils/config.cmi \ asmcomp/arch.cmo asmcomp/comballoc.cmi -asmcomp/comballoc.cmx: asmcomp/reg.cmx asmcomp/mach.cmx utils/config.cmx \ +asmcomp/comballoc.cmx : asmcomp/reg.cmx asmcomp/mach.cmx utils/config.cmx \ asmcomp/arch.cmx asmcomp/comballoc.cmi -asmcomp/compilenv.cmo: utils/misc.cmi typing/ident.cmi typing/env.cmi \ - utils/config.cmi asmcomp/cmx_format.cmi asmcomp/clambda.cmi \ - asmcomp/compilenv.cmi -asmcomp/compilenv.cmx: utils/misc.cmx typing/ident.cmx typing/env.cmx \ - utils/config.cmx asmcomp/cmx_format.cmi asmcomp/clambda.cmx \ - asmcomp/compilenv.cmi -asmcomp/debuginfo.cmo: parsing/location.cmi bytecomp/lambda.cmi \ +asmcomp/compilenv.cmo : utils/misc.cmi parsing/location.cmi \ + bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi utils/config.cmi \ + asmcomp/cmx_format.cmi asmcomp/clambda.cmi asmcomp/compilenv.cmi +asmcomp/compilenv.cmx : utils/misc.cmx parsing/location.cmx \ + bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx utils/config.cmx \ + asmcomp/cmx_format.cmi asmcomp/clambda.cmx asmcomp/compilenv.cmi +asmcomp/debuginfo.cmo : parsing/location.cmi bytecomp/lambda.cmi \ asmcomp/debuginfo.cmi -asmcomp/debuginfo.cmx: parsing/location.cmx bytecomp/lambda.cmx \ +asmcomp/debuginfo.cmx : parsing/location.cmx bytecomp/lambda.cmx \ asmcomp/debuginfo.cmi -asmcomp/emit.cmo: asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \ +asmcomp/emit.cmo : asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \ asmcomp/mach.cmi asmcomp/linearize.cmi asmcomp/emitaux.cmi \ asmcomp/debuginfo.cmi utils/config.cmi asmcomp/compilenv.cmi \ asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/emit.cmi -asmcomp/emit.cmx: asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \ +asmcomp/emit.cmx : asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \ asmcomp/mach.cmx asmcomp/linearize.cmx asmcomp/emitaux.cmx \ asmcomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \ asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/emit.cmi -asmcomp/emitaux.cmo: asmcomp/reg.cmi asmcomp/linearize.cmi \ - asmcomp/debuginfo.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \ - asmcomp/emitaux.cmi -asmcomp/emitaux.cmx: asmcomp/reg.cmx asmcomp/linearize.cmx \ - asmcomp/debuginfo.cmx asmcomp/cmm.cmx asmcomp/arch.cmx \ - asmcomp/emitaux.cmi -asmcomp/interf.cmo: asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \ - asmcomp/mach.cmi asmcomp/interf.cmi -asmcomp/interf.cmx: asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \ - asmcomp/mach.cmx asmcomp/interf.cmi -asmcomp/linearize.cmo: asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \ +asmcomp/emitaux.cmo : asmcomp/linearize.cmi asmcomp/debuginfo.cmi \ + utils/config.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/emitaux.cmi +asmcomp/emitaux.cmx : asmcomp/linearize.cmx asmcomp/debuginfo.cmx \ + utils/config.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/emitaux.cmi +asmcomp/interf.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \ + asmcomp/interf.cmi +asmcomp/interf.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \ + asmcomp/interf.cmi +asmcomp/linearize.cmo : asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \ asmcomp/mach.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi \ asmcomp/linearize.cmi -asmcomp/linearize.cmx: asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \ +asmcomp/linearize.cmx : asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \ asmcomp/mach.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx \ asmcomp/linearize.cmi -asmcomp/liveness.cmo: asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/printmach.cmi \ - utils/misc.cmi asmcomp/mach.cmi asmcomp/liveness.cmi -asmcomp/liveness.cmx: asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/printmach.cmx \ - utils/misc.cmx asmcomp/mach.cmx asmcomp/liveness.cmi -asmcomp/mach.cmo: asmcomp/reg.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi \ +asmcomp/liveness.cmo : asmcomp/reg.cmi asmcomp/proc.cmi \ + asmcomp/printmach.cmi utils/misc.cmi asmcomp/mach.cmi \ + asmcomp/liveness.cmi +asmcomp/liveness.cmx : asmcomp/reg.cmx asmcomp/proc.cmx \ + asmcomp/printmach.cmx utils/misc.cmx asmcomp/mach.cmx \ + asmcomp/liveness.cmi +asmcomp/mach.cmo : asmcomp/reg.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi \ asmcomp/arch.cmo asmcomp/mach.cmi -asmcomp/mach.cmx: asmcomp/reg.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx \ +asmcomp/mach.cmx : asmcomp/reg.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx \ asmcomp/arch.cmx asmcomp/mach.cmi -asmcomp/printcmm.cmo: typing/ident.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi \ - asmcomp/printcmm.cmi -asmcomp/printcmm.cmx: typing/ident.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx \ - asmcomp/printcmm.cmi -asmcomp/printlinear.cmo: asmcomp/printmach.cmi asmcomp/mach.cmi \ +asmcomp/printclambda.cmo : bytecomp/printlambda.cmi bytecomp/lambda.cmi \ + typing/ident.cmi asmcomp/clambda.cmi parsing/asttypes.cmi \ + asmcomp/printclambda.cmi +asmcomp/printclambda.cmx : bytecomp/printlambda.cmx bytecomp/lambda.cmx \ + typing/ident.cmx asmcomp/clambda.cmx parsing/asttypes.cmi \ + asmcomp/printclambda.cmi +asmcomp/printcmm.cmo : typing/ident.cmi asmcomp/debuginfo.cmi \ + asmcomp/cmm.cmi asmcomp/printcmm.cmi +asmcomp/printcmm.cmx : typing/ident.cmx asmcomp/debuginfo.cmx \ + asmcomp/cmm.cmx asmcomp/printcmm.cmi +asmcomp/printlinear.cmo : asmcomp/printmach.cmi asmcomp/mach.cmi \ asmcomp/linearize.cmi asmcomp/debuginfo.cmi asmcomp/printlinear.cmi -asmcomp/printlinear.cmx: asmcomp/printmach.cmx asmcomp/mach.cmx \ +asmcomp/printlinear.cmx : asmcomp/printmach.cmx asmcomp/mach.cmx \ asmcomp/linearize.cmx asmcomp/debuginfo.cmx asmcomp/printlinear.cmi -asmcomp/printmach.cmo: asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/printcmm.cmi \ - asmcomp/mach.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \ - asmcomp/printmach.cmi -asmcomp/printmach.cmx: asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/printcmm.cmx \ - asmcomp/mach.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx asmcomp/arch.cmx \ - asmcomp/printmach.cmi -asmcomp/proc.cmo: asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \ - utils/config.cmi asmcomp/cmm.cmi utils/ccomp.cmi asmcomp/arch.cmo \ - asmcomp/proc.cmi -asmcomp/proc.cmx: asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \ - utils/config.cmx asmcomp/cmm.cmx utils/ccomp.cmx asmcomp/arch.cmx \ - asmcomp/proc.cmi -asmcomp/reg.cmo: asmcomp/cmm.cmi asmcomp/reg.cmi -asmcomp/reg.cmx: asmcomp/cmm.cmx asmcomp/reg.cmi -asmcomp/reload.cmo: asmcomp/reloadgen.cmi asmcomp/reg.cmi asmcomp/mach.cmi \ +asmcomp/printmach.cmo : asmcomp/reg.cmi asmcomp/proc.cmi \ + asmcomp/printcmm.cmi asmcomp/mach.cmi asmcomp/debuginfo.cmi \ + asmcomp/cmm.cmi asmcomp/arch.cmo asmcomp/printmach.cmi +asmcomp/printmach.cmx : asmcomp/reg.cmx asmcomp/proc.cmx \ + asmcomp/printcmm.cmx asmcomp/mach.cmx asmcomp/debuginfo.cmx \ + asmcomp/cmm.cmx asmcomp/arch.cmx asmcomp/printmach.cmi +asmcomp/proc.cmo : asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \ + utils/config.cmi asmcomp/cmm.cmi utils/clflags.cmi utils/ccomp.cmi \ + asmcomp/arch.cmo asmcomp/proc.cmi +asmcomp/proc.cmx : asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \ + utils/config.cmx asmcomp/cmm.cmx utils/clflags.cmx utils/ccomp.cmx \ + asmcomp/arch.cmx asmcomp/proc.cmi +asmcomp/reg.cmo : asmcomp/cmm.cmi asmcomp/reg.cmi +asmcomp/reg.cmx : asmcomp/cmm.cmx asmcomp/reg.cmi +asmcomp/reload.cmo : asmcomp/reloadgen.cmi asmcomp/reg.cmi asmcomp/mach.cmi \ asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/reload.cmi -asmcomp/reload.cmx: asmcomp/reloadgen.cmx asmcomp/reg.cmx asmcomp/mach.cmx \ +asmcomp/reload.cmx : asmcomp/reloadgen.cmx asmcomp/reg.cmx asmcomp/mach.cmx \ asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/reload.cmi -asmcomp/reloadgen.cmo: asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \ +asmcomp/reloadgen.cmo : asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \ asmcomp/reloadgen.cmi -asmcomp/reloadgen.cmx: asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \ +asmcomp/reloadgen.cmx : asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \ asmcomp/reloadgen.cmi -asmcomp/schedgen.cmo: asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \ +asmcomp/schedgen.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \ asmcomp/linearize.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \ asmcomp/schedgen.cmi -asmcomp/schedgen.cmx: asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \ +asmcomp/schedgen.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \ asmcomp/linearize.cmx asmcomp/cmm.cmx asmcomp/arch.cmx \ asmcomp/schedgen.cmi -asmcomp/scheduling.cmo: asmcomp/schedgen.cmi asmcomp/scheduling.cmi -asmcomp/scheduling.cmx: asmcomp/schedgen.cmx asmcomp/scheduling.cmi -asmcomp/selectgen.cmo: utils/tbl.cmi bytecomp/simplif.cmi asmcomp/reg.cmi \ +asmcomp/scheduling.cmo : asmcomp/schedgen.cmi asmcomp/scheduling.cmi +asmcomp/scheduling.cmx : asmcomp/schedgen.cmx asmcomp/scheduling.cmi +asmcomp/selectgen.cmo : utils/tbl.cmi bytecomp/simplif.cmi asmcomp/reg.cmi \ asmcomp/proc.cmi utils/misc.cmi asmcomp/mach.cmi typing/ident.cmi \ asmcomp/debuginfo.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \ asmcomp/selectgen.cmi -asmcomp/selectgen.cmx: utils/tbl.cmx bytecomp/simplif.cmx asmcomp/reg.cmx \ +asmcomp/selectgen.cmx : utils/tbl.cmx bytecomp/simplif.cmx asmcomp/reg.cmx \ asmcomp/proc.cmx utils/misc.cmx asmcomp/mach.cmx typing/ident.cmx \ asmcomp/debuginfo.cmx asmcomp/cmm.cmx asmcomp/arch.cmx \ asmcomp/selectgen.cmi -asmcomp/selection.cmo: asmcomp/selectgen.cmi asmcomp/reg.cmi asmcomp/proc.cmi \ - utils/misc.cmi asmcomp/mach.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi \ - utils/clflags.cmi asmcomp/arch.cmo asmcomp/selection.cmi -asmcomp/selection.cmx: asmcomp/selectgen.cmx asmcomp/reg.cmx asmcomp/proc.cmx \ - utils/misc.cmx asmcomp/mach.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx \ - utils/clflags.cmx asmcomp/arch.cmx asmcomp/selection.cmi -asmcomp/spill.cmo: asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \ +asmcomp/selection.cmo : asmcomp/selectgen.cmi asmcomp/proc.cmi \ + utils/misc.cmi asmcomp/mach.cmi asmcomp/cmm.cmi utils/clflags.cmi \ + asmcomp/arch.cmo asmcomp/selection.cmi +asmcomp/selection.cmx : asmcomp/selectgen.cmx asmcomp/proc.cmx \ + utils/misc.cmx asmcomp/mach.cmx asmcomp/cmm.cmx utils/clflags.cmx \ + asmcomp/arch.cmx asmcomp/selection.cmi +asmcomp/spill.cmo : asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \ asmcomp/mach.cmi asmcomp/spill.cmi -asmcomp/spill.cmx: asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \ +asmcomp/spill.cmx : asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \ asmcomp/mach.cmx asmcomp/spill.cmi -asmcomp/split.cmo: asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \ +asmcomp/split.cmo : asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \ asmcomp/split.cmi -asmcomp/split.cmx: asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \ +asmcomp/split.cmx : asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \ asmcomp/split.cmi -driver/compile.cmi: typing/env.cmi -driver/errors.cmi: -driver/main.cmi: -driver/main_args.cmi: -driver/optcompile.cmi: typing/env.cmi -driver/opterrors.cmi: -driver/optmain.cmi: -driver/pparse.cmi: -driver/compile.cmo: utils/warnings.cmi typing/unused_var.cmi \ - typing/typemod.cmi typing/typedtree.cmi bytecomp/translmod.cmi \ - typing/stypes.cmi bytecomp/simplif.cmi typing/printtyp.cmi \ - bytecomp/printlambda.cmi bytecomp/printinstr.cmi parsing/printast.cmi \ - driver/pparse.cmi parsing/parse.cmi utils/misc.cmi parsing/location.cmi \ - typing/ident.cmi typing/env.cmi bytecomp/emitcode.cmi utils/config.cmi \ - utils/clflags.cmi utils/ccomp.cmi bytecomp/bytegen.cmi driver/compile.cmi -driver/compile.cmx: utils/warnings.cmx typing/unused_var.cmx \ - typing/typemod.cmx typing/typedtree.cmx bytecomp/translmod.cmx \ - typing/stypes.cmx bytecomp/simplif.cmx typing/printtyp.cmx \ - bytecomp/printlambda.cmx bytecomp/printinstr.cmx parsing/printast.cmx \ - driver/pparse.cmx parsing/parse.cmx utils/misc.cmx parsing/location.cmx \ - typing/ident.cmx typing/env.cmx bytecomp/emitcode.cmx utils/config.cmx \ - utils/clflags.cmx utils/ccomp.cmx bytecomp/bytegen.cmx driver/compile.cmi -driver/errors.cmo: utils/warnings.cmi typing/typetexp.cmi typing/typemod.cmi \ - typing/typedecl.cmi typing/typecore.cmi typing/typeclass.cmi \ - bytecomp/translmod.cmi bytecomp/translcore.cmi bytecomp/translclass.cmi \ - parsing/syntaxerr.cmi bytecomp/symtable.cmi driver/pparse.cmi \ - parsing/location.cmi parsing/lexer.cmi typing/includemod.cmi \ - typing/env.cmi typing/ctype.cmi bytecomp/bytepackager.cmi \ - bytecomp/bytelink.cmi bytecomp/bytelibrarian.cmi driver/errors.cmi -driver/errors.cmx: utils/warnings.cmx typing/typetexp.cmx typing/typemod.cmx \ - typing/typedecl.cmx typing/typecore.cmx typing/typeclass.cmx \ - bytecomp/translmod.cmx bytecomp/translcore.cmx bytecomp/translclass.cmx \ - parsing/syntaxerr.cmx bytecomp/symtable.cmx driver/pparse.cmx \ - parsing/location.cmx parsing/lexer.cmx typing/includemod.cmx \ - typing/env.cmx typing/ctype.cmx bytecomp/bytepackager.cmx \ - bytecomp/bytelink.cmx bytecomp/bytelibrarian.cmx driver/errors.cmi -driver/main.cmo: utils/warnings.cmi utils/misc.cmi driver/main_args.cmi \ - driver/errors.cmi utils/config.cmi driver/compile.cmi utils/clflags.cmi \ - bytecomp/bytepackager.cmi bytecomp/bytelink.cmi \ +driver/compenv.cmi : +driver/compile.cmi : +driver/compmisc.cmi : typing/env.cmi +driver/errors.cmi : +driver/main.cmi : +driver/main_args.cmi : +driver/optcompile.cmi : +driver/opterrors.cmi : +driver/optmain.cmi : +driver/pparse.cmi : +driver/compenv.cmo : utils/warnings.cmi utils/misc.cmi parsing/location.cmi \ + utils/config.cmi utils/clflags.cmi driver/compenv.cmi +driver/compenv.cmx : utils/warnings.cmx utils/misc.cmx parsing/location.cmx \ + utils/config.cmx utils/clflags.cmx driver/compenv.cmi +driver/compile.cmo : utils/warnings.cmi typing/typemod.cmi \ + typing/typedtree.cmi typing/typecore.cmi bytecomp/translmod.cmi \ + typing/stypes.cmi bytecomp/simplif.cmi typing/printtyped.cmi \ + typing/printtyp.cmi bytecomp/printlambda.cmi bytecomp/printinstr.cmi \ + parsing/printast.cmi parsing/pprintast.cmi driver/pparse.cmi \ + parsing/parse.cmi utils/misc.cmi parsing/location.cmi \ + typing/includemod.cmi typing/env.cmi bytecomp/emitcode.cmi \ + utils/config.cmi driver/compmisc.cmi driver/compenv.cmi utils/clflags.cmi \ + utils/ccomp.cmi bytecomp/bytegen.cmi driver/compile.cmi +driver/compile.cmx : utils/warnings.cmx typing/typemod.cmx \ + typing/typedtree.cmx typing/typecore.cmx bytecomp/translmod.cmx \ + typing/stypes.cmx bytecomp/simplif.cmx typing/printtyped.cmx \ + typing/printtyp.cmx bytecomp/printlambda.cmx bytecomp/printinstr.cmx \ + parsing/printast.cmx parsing/pprintast.cmx driver/pparse.cmx \ + parsing/parse.cmx utils/misc.cmx parsing/location.cmx \ + typing/includemod.cmx typing/env.cmx bytecomp/emitcode.cmx \ + utils/config.cmx driver/compmisc.cmx driver/compenv.cmx utils/clflags.cmx \ + utils/ccomp.cmx bytecomp/bytegen.cmx driver/compile.cmi +driver/compmisc.cmo : utils/misc.cmi typing/ident.cmi typing/env.cmi \ + utils/config.cmi driver/compenv.cmi utils/clflags.cmi driver/compmisc.cmi +driver/compmisc.cmx : utils/misc.cmx typing/ident.cmx typing/env.cmx \ + utils/config.cmx driver/compenv.cmx utils/clflags.cmx driver/compmisc.cmi +driver/errors.cmo : utils/warnings.cmi typing/typetexp.cmi \ + typing/typemod.cmi typing/typedecl.cmi typing/typecore.cmi \ + typing/typeclass.cmi bytecomp/translmod.cmi bytecomp/translcore.cmi \ + bytecomp/translclass.cmi parsing/syntaxerr.cmi bytecomp/symtable.cmi \ + driver/pparse.cmi parsing/location.cmi parsing/lexer.cmi \ + typing/includemod.cmi typing/env.cmi typing/ctype.cmi \ + typing/cmi_format.cmi bytecomp/bytepackager.cmi bytecomp/bytelink.cmi \ + bytecomp/bytelibrarian.cmi driver/errors.cmi +driver/errors.cmx : utils/warnings.cmx typing/typetexp.cmx \ + typing/typemod.cmx typing/typedecl.cmx typing/typecore.cmx \ + typing/typeclass.cmx bytecomp/translmod.cmx bytecomp/translcore.cmx \ + bytecomp/translclass.cmx parsing/syntaxerr.cmx bytecomp/symtable.cmx \ + driver/pparse.cmx parsing/location.cmx parsing/lexer.cmx \ + typing/includemod.cmx typing/env.cmx typing/ctype.cmx \ + typing/cmi_format.cmx bytecomp/bytepackager.cmx bytecomp/bytelink.cmx \ + bytecomp/bytelibrarian.cmx driver/errors.cmi +driver/main.cmo : utils/warnings.cmi utils/misc.cmi driver/main_args.cmi \ + parsing/location.cmi driver/errors.cmi utils/config.cmi \ + driver/compmisc.cmi driver/compile.cmi driver/compenv.cmi \ + utils/clflags.cmi bytecomp/bytepackager.cmi bytecomp/bytelink.cmi \ bytecomp/bytelibrarian.cmi driver/main.cmi -driver/main.cmx: utils/warnings.cmx utils/misc.cmx driver/main_args.cmx \ - driver/errors.cmx utils/config.cmx driver/compile.cmx utils/clflags.cmx \ - bytecomp/bytepackager.cmx bytecomp/bytelink.cmx \ +driver/main.cmx : utils/warnings.cmx utils/misc.cmx driver/main_args.cmx \ + parsing/location.cmx driver/errors.cmx utils/config.cmx \ + driver/compmisc.cmx driver/compile.cmx driver/compenv.cmx \ + utils/clflags.cmx bytecomp/bytepackager.cmx bytecomp/bytelink.cmx \ bytecomp/bytelibrarian.cmx driver/main.cmi -driver/main_args.cmo: utils/warnings.cmi driver/main_args.cmi -driver/main_args.cmx: utils/warnings.cmx driver/main_args.cmi -driver/optcompile.cmo: utils/warnings.cmi typing/unused_var.cmi \ - typing/typemod.cmi typing/typedtree.cmi bytecomp/translmod.cmi \ - typing/stypes.cmi bytecomp/simplif.cmi typing/printtyp.cmi \ - bytecomp/printlambda.cmi parsing/printast.cmi driver/pparse.cmi \ - parsing/parse.cmi utils/misc.cmi parsing/location.cmi typing/ident.cmi \ - typing/env.cmi utils/config.cmi asmcomp/compilenv.cmi utils/clflags.cmi \ - utils/ccomp.cmi asmcomp/asmgen.cmi driver/optcompile.cmi -driver/optcompile.cmx: utils/warnings.cmx typing/unused_var.cmx \ - typing/typemod.cmx typing/typedtree.cmx bytecomp/translmod.cmx \ - typing/stypes.cmx bytecomp/simplif.cmx typing/printtyp.cmx \ - bytecomp/printlambda.cmx parsing/printast.cmx driver/pparse.cmx \ - parsing/parse.cmx utils/misc.cmx parsing/location.cmx typing/ident.cmx \ - typing/env.cmx utils/config.cmx asmcomp/compilenv.cmx utils/clflags.cmx \ - utils/ccomp.cmx asmcomp/asmgen.cmx driver/optcompile.cmi -driver/opterrors.cmo: utils/warnings.cmi typing/typetexp.cmi \ +driver/main_args.cmo : utils/warnings.cmi driver/main_args.cmi +driver/main_args.cmx : utils/warnings.cmx driver/main_args.cmi +driver/optcompile.cmo : utils/warnings.cmi typing/typemod.cmi \ + typing/typedtree.cmi typing/typecore.cmi bytecomp/translmod.cmi \ + typing/stypes.cmi bytecomp/simplif.cmi typing/printtyped.cmi \ + typing/printtyp.cmi bytecomp/printlambda.cmi parsing/printast.cmi \ + parsing/pprintast.cmi driver/pparse.cmi parsing/parse.cmi utils/misc.cmi \ + parsing/location.cmi typing/includemod.cmi typing/env.cmi \ + utils/config.cmi driver/compmisc.cmi asmcomp/compilenv.cmi \ + driver/compenv.cmi utils/clflags.cmi utils/ccomp.cmi asmcomp/asmgen.cmi \ + driver/optcompile.cmi +driver/optcompile.cmx : utils/warnings.cmx typing/typemod.cmx \ + typing/typedtree.cmx typing/typecore.cmx bytecomp/translmod.cmx \ + typing/stypes.cmx bytecomp/simplif.cmx typing/printtyped.cmx \ + typing/printtyp.cmx bytecomp/printlambda.cmx parsing/printast.cmx \ + parsing/pprintast.cmx driver/pparse.cmx parsing/parse.cmx utils/misc.cmx \ + parsing/location.cmx typing/includemod.cmx typing/env.cmx \ + utils/config.cmx driver/compmisc.cmx asmcomp/compilenv.cmx \ + driver/compenv.cmx utils/clflags.cmx utils/ccomp.cmx asmcomp/asmgen.cmx \ + driver/optcompile.cmi +driver/opterrors.cmo : utils/warnings.cmi typing/typetexp.cmi \ typing/typemod.cmi typing/typedecl.cmi typing/typecore.cmi \ typing/typeclass.cmi bytecomp/translmod.cmi bytecomp/translcore.cmi \ bytecomp/translclass.cmi parsing/syntaxerr.cmi driver/pparse.cmi \ parsing/location.cmi parsing/lexer.cmi typing/includemod.cmi \ typing/env.cmi typing/ctype.cmi asmcomp/compilenv.cmi \ - asmcomp/asmpackager.cmi asmcomp/asmlink.cmi asmcomp/asmlibrarian.cmi \ - asmcomp/asmgen.cmi driver/opterrors.cmi -driver/opterrors.cmx: utils/warnings.cmx typing/typetexp.cmx \ + typing/cmi_format.cmi asmcomp/asmpackager.cmi asmcomp/asmlink.cmi \ + asmcomp/asmlibrarian.cmi asmcomp/asmgen.cmi driver/opterrors.cmi +driver/opterrors.cmx : utils/warnings.cmx typing/typetexp.cmx \ typing/typemod.cmx typing/typedecl.cmx typing/typecore.cmx \ typing/typeclass.cmx bytecomp/translmod.cmx bytecomp/translcore.cmx \ bytecomp/translclass.cmx parsing/syntaxerr.cmx driver/pparse.cmx \ parsing/location.cmx parsing/lexer.cmx typing/includemod.cmx \ typing/env.cmx typing/ctype.cmx asmcomp/compilenv.cmx \ - asmcomp/asmpackager.cmx asmcomp/asmlink.cmx asmcomp/asmlibrarian.cmx \ - asmcomp/asmgen.cmx driver/opterrors.cmi -driver/optmain.cmo: utils/warnings.cmi asmcomp/printmach.cmi \ + typing/cmi_format.cmx asmcomp/asmpackager.cmx asmcomp/asmlink.cmx \ + asmcomp/asmlibrarian.cmx asmcomp/asmgen.cmx driver/opterrors.cmi +driver/optmain.cmo : utils/warnings.cmi asmcomp/printmach.cmi \ driver/opterrors.cmi driver/optcompile.cmi utils/misc.cmi \ - driver/main_args.cmi utils/config.cmi utils/clflags.cmi \ + driver/main_args.cmi parsing/location.cmi utils/config.cmi \ + driver/compmisc.cmi driver/compenv.cmi utils/clflags.cmi \ asmcomp/asmpackager.cmi asmcomp/asmlink.cmi asmcomp/asmlibrarian.cmi \ asmcomp/arch.cmo driver/optmain.cmi -driver/optmain.cmx: utils/warnings.cmx asmcomp/printmach.cmx \ +driver/optmain.cmx : utils/warnings.cmx asmcomp/printmach.cmx \ driver/opterrors.cmx driver/optcompile.cmx utils/misc.cmx \ - driver/main_args.cmx utils/config.cmx utils/clflags.cmx \ + driver/main_args.cmx parsing/location.cmx utils/config.cmx \ + driver/compmisc.cmx driver/compenv.cmx utils/clflags.cmx \ asmcomp/asmpackager.cmx asmcomp/asmlink.cmx asmcomp/asmlibrarian.cmx \ asmcomp/arch.cmx driver/optmain.cmi -driver/pparse.cmo: utils/misc.cmi parsing/location.cmi utils/clflags.cmi \ +driver/pparse.cmo : utils/misc.cmi parsing/location.cmi utils/clflags.cmi \ utils/ccomp.cmi driver/pparse.cmi -driver/pparse.cmx: utils/misc.cmx parsing/location.cmx utils/clflags.cmx \ +driver/pparse.cmx : utils/misc.cmx parsing/location.cmx utils/clflags.cmx \ utils/ccomp.cmx driver/pparse.cmi -toplevel/genprintval.cmi: typing/types.cmi typing/path.cmi \ +toplevel/genprintval.cmi : typing/types.cmi typing/path.cmi \ typing/outcometree.cmi typing/env.cmi -toplevel/opttopdirs.cmi: parsing/longident.cmi -toplevel/opttoploop.cmi: utils/warnings.cmi typing/types.cmi typing/path.cmi \ - parsing/parsetree.cmi typing/outcometree.cmi parsing/longident.cmi \ - parsing/location.cmi typing/env.cmi -toplevel/opttopmain.cmi: -toplevel/topdirs.cmi: parsing/longident.cmi -toplevel/toploop.cmi: utils/warnings.cmi typing/types.cmi typing/path.cmi \ +toplevel/opttopdirs.cmi : parsing/longident.cmi +toplevel/opttoploop.cmi : utils/warnings.cmi typing/types.cmi \ + typing/path.cmi parsing/parsetree.cmi typing/outcometree.cmi \ + parsing/longident.cmi parsing/location.cmi typing/env.cmi +toplevel/opttopmain.cmi : +toplevel/topdirs.cmi : parsing/longident.cmi +toplevel/toploop.cmi : utils/warnings.cmi typing/types.cmi typing/path.cmi \ parsing/parsetree.cmi typing/outcometree.cmi parsing/longident.cmi \ parsing/location.cmi typing/env.cmi -toplevel/topmain.cmi: -toplevel/trace.cmi: typing/types.cmi typing/path.cmi parsing/longident.cmi \ +toplevel/topmain.cmi : +toplevel/trace.cmi : typing/types.cmi typing/path.cmi parsing/longident.cmi \ typing/env.cmi -toplevel/expunge.cmo: bytecomp/symtable.cmi bytecomp/runtimedef.cmi \ +toplevel/expunge.cmo : bytecomp/symtable.cmi bytecomp/runtimedef.cmi \ utils/misc.cmi typing/ident.cmi bytecomp/bytesections.cmi -toplevel/expunge.cmx: bytecomp/symtable.cmx bytecomp/runtimedef.cmx \ +toplevel/expunge.cmx : bytecomp/symtable.cmx bytecomp/runtimedef.cmx \ utils/misc.cmx typing/ident.cmx bytecomp/bytesections.cmx -toplevel/genprintval.cmo: typing/types.cmi typing/printtyp.cmi \ +toplevel/genprintval.cmo : typing/types.cmi typing/printtyp.cmi \ typing/predef.cmi typing/path.cmi typing/outcometree.cmi utils/misc.cmi \ parsing/longident.cmi typing/ident.cmi typing/env.cmi typing/datarepr.cmi \ typing/ctype.cmi typing/btype.cmi toplevel/genprintval.cmi -toplevel/genprintval.cmx: typing/types.cmx typing/printtyp.cmx \ +toplevel/genprintval.cmx : typing/types.cmx typing/printtyp.cmx \ typing/predef.cmx typing/path.cmx typing/outcometree.cmi utils/misc.cmx \ parsing/longident.cmx typing/ident.cmx typing/env.cmx typing/datarepr.cmx \ typing/ctype.cmx typing/btype.cmx toplevel/genprintval.cmi -toplevel/opttopdirs.cmo: utils/warnings.cmi typing/types.cmi \ - typing/printtyp.cmi typing/path.cmi toplevel/opttoploop.cmi \ - utils/misc.cmi parsing/longident.cmi typing/ident.cmi typing/env.cmi \ - typing/ctype.cmi utils/config.cmi utils/clflags.cmi asmcomp/asmlink.cmi \ +toplevel/opttopdirs.cmo : utils/warnings.cmi typing/types.cmi \ + typing/printtyp.cmi toplevel/opttoploop.cmi utils/misc.cmi \ + parsing/longident.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \ + utils/config.cmi utils/clflags.cmi asmcomp/asmlink.cmi \ toplevel/opttopdirs.cmi -toplevel/opttopdirs.cmx: utils/warnings.cmx typing/types.cmx \ - typing/printtyp.cmx typing/path.cmx toplevel/opttoploop.cmx \ - utils/misc.cmx parsing/longident.cmx typing/ident.cmx typing/env.cmx \ - typing/ctype.cmx utils/config.cmx utils/clflags.cmx asmcomp/asmlink.cmx \ +toplevel/opttopdirs.cmx : utils/warnings.cmx typing/types.cmx \ + typing/printtyp.cmx toplevel/opttoploop.cmx utils/misc.cmx \ + parsing/longident.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \ + utils/config.cmx utils/clflags.cmx asmcomp/asmlink.cmx \ toplevel/opttopdirs.cmi -toplevel/opttoploop.cmo: utils/warnings.cmi typing/unused_var.cmi \ - typing/types.cmi typing/typemod.cmi typing/typedtree.cmi \ - typing/typecore.cmi bytecomp/translmod.cmi bytecomp/simplif.cmi \ +toplevel/opttoploop.cmo : utils/warnings.cmi typing/types.cmi \ + typing/typemod.cmi typing/typedtree.cmi typing/typecore.cmi \ + bytecomp/translmod.cmi bytecomp/simplif.cmi typing/printtyped.cmi \ typing/printtyp.cmi bytecomp/printlambda.cmi parsing/printast.cmi \ - typing/predef.cmi typing/path.cmi parsing/parsetree.cmi parsing/parse.cmi \ - typing/outcometree.cmi driver/opterrors.cmi driver/optcompile.cmi \ - typing/oprint.cmi utils/misc.cmi parsing/longident.cmi \ - parsing/location.cmi parsing/lexer.cmi bytecomp/lambda.cmi \ + typing/predef.cmi parsing/pprintast.cmi typing/path.cmi \ + parsing/parsetree.cmi parsing/parse.cmi typing/outcometree.cmi \ + driver/opterrors.cmi typing/oprint.cmi utils/misc.cmi \ + parsing/longident.cmi parsing/location.cmi parsing/lexer.cmi \ typing/ident.cmi toplevel/genprintval.cmi typing/env.cmi utils/config.cmi \ - asmcomp/compilenv.cmi utils/clflags.cmi typing/btype.cmi \ - asmcomp/asmlink.cmi asmcomp/asmgen.cmi toplevel/opttoploop.cmi -toplevel/opttoploop.cmx: utils/warnings.cmx typing/unused_var.cmx \ - typing/types.cmx typing/typemod.cmx typing/typedtree.cmx \ - typing/typecore.cmx bytecomp/translmod.cmx bytecomp/simplif.cmx \ + driver/compmisc.cmi asmcomp/compilenv.cmi utils/clflags.cmi \ + typing/btype.cmi asmcomp/asmlink.cmi asmcomp/asmgen.cmi \ + toplevel/opttoploop.cmi +toplevel/opttoploop.cmx : utils/warnings.cmx typing/types.cmx \ + typing/typemod.cmx typing/typedtree.cmx typing/typecore.cmx \ + bytecomp/translmod.cmx bytecomp/simplif.cmx typing/printtyped.cmx \ typing/printtyp.cmx bytecomp/printlambda.cmx parsing/printast.cmx \ - typing/predef.cmx typing/path.cmx parsing/parsetree.cmi parsing/parse.cmx \ - typing/outcometree.cmi driver/opterrors.cmx driver/optcompile.cmx \ - typing/oprint.cmx utils/misc.cmx parsing/longident.cmx \ - parsing/location.cmx parsing/lexer.cmx bytecomp/lambda.cmx \ + typing/predef.cmx parsing/pprintast.cmx typing/path.cmx \ + parsing/parsetree.cmi parsing/parse.cmx typing/outcometree.cmi \ + driver/opterrors.cmx typing/oprint.cmx utils/misc.cmx \ + parsing/longident.cmx parsing/location.cmx parsing/lexer.cmx \ typing/ident.cmx toplevel/genprintval.cmx typing/env.cmx utils/config.cmx \ - asmcomp/compilenv.cmx utils/clflags.cmx typing/btype.cmx \ - asmcomp/asmlink.cmx asmcomp/asmgen.cmx toplevel/opttoploop.cmi -toplevel/opttopmain.cmo: utils/warnings.cmi asmcomp/printmach.cmi \ + driver/compmisc.cmx asmcomp/compilenv.cmx utils/clflags.cmx \ + typing/btype.cmx asmcomp/asmlink.cmx asmcomp/asmgen.cmx \ + toplevel/opttoploop.cmi +toplevel/opttopmain.cmo : utils/warnings.cmi asmcomp/printmach.cmi \ toplevel/opttoploop.cmi toplevel/opttopdirs.cmi driver/opterrors.cmi \ - utils/misc.cmi driver/main_args.cmi utils/config.cmi utils/clflags.cmi \ - toplevel/opttopmain.cmi -toplevel/opttopmain.cmx: utils/warnings.cmx asmcomp/printmach.cmx \ + utils/misc.cmi driver/main_args.cmi parsing/location.cmi utils/config.cmi \ + driver/compenv.cmi utils/clflags.cmi toplevel/opttopmain.cmi +toplevel/opttopmain.cmx : utils/warnings.cmx asmcomp/printmach.cmx \ toplevel/opttoploop.cmx toplevel/opttopdirs.cmx driver/opterrors.cmx \ - utils/misc.cmx driver/main_args.cmx utils/config.cmx utils/clflags.cmx \ - toplevel/opttopmain.cmi -toplevel/opttopstart.cmo: toplevel/opttopmain.cmi -toplevel/opttopstart.cmx: toplevel/opttopmain.cmx -toplevel/topdirs.cmo: utils/warnings.cmi typing/types.cmi toplevel/trace.cmi \ - toplevel/toploop.cmi bytecomp/symtable.cmi typing/printtyp.cmi \ - typing/path.cmi bytecomp/opcodes.cmo utils/misc.cmi bytecomp/meta.cmi \ - parsing/longident.cmi typing/ident.cmi typing/env.cmi bytecomp/dll.cmi \ - typing/ctype.cmi utils/consistbl.cmi utils/config.cmi \ + utils/misc.cmx driver/main_args.cmx parsing/location.cmx utils/config.cmx \ + driver/compenv.cmx utils/clflags.cmx toplevel/opttopmain.cmi +toplevel/opttopstart.cmo : toplevel/opttopmain.cmi +toplevel/opttopstart.cmx : toplevel/opttopmain.cmx +toplevel/topdirs.cmo : utils/warnings.cmi typing/types.cmi \ + toplevel/trace.cmi toplevel/toploop.cmi bytecomp/symtable.cmi \ + typing/printtyp.cmi typing/path.cmi bytecomp/opcodes.cmo utils/misc.cmi \ + bytecomp/meta.cmi parsing/longident.cmi typing/ident.cmi typing/env.cmi \ + bytecomp/dll.cmi typing/ctype.cmi utils/consistbl.cmi utils/config.cmi \ bytecomp/cmo_format.cmi utils/clflags.cmi toplevel/topdirs.cmi -toplevel/topdirs.cmx: utils/warnings.cmx typing/types.cmx toplevel/trace.cmx \ - toplevel/toploop.cmx bytecomp/symtable.cmx typing/printtyp.cmx \ - typing/path.cmx bytecomp/opcodes.cmx utils/misc.cmx bytecomp/meta.cmx \ - parsing/longident.cmx typing/ident.cmx typing/env.cmx bytecomp/dll.cmx \ - typing/ctype.cmx utils/consistbl.cmx utils/config.cmx \ +toplevel/topdirs.cmx : utils/warnings.cmx typing/types.cmx \ + toplevel/trace.cmx toplevel/toploop.cmx bytecomp/symtable.cmx \ + typing/printtyp.cmx typing/path.cmx bytecomp/opcodes.cmx utils/misc.cmx \ + bytecomp/meta.cmx parsing/longident.cmx typing/ident.cmx typing/env.cmx \ + bytecomp/dll.cmx typing/ctype.cmx utils/consistbl.cmx utils/config.cmx \ bytecomp/cmo_format.cmi utils/clflags.cmx toplevel/topdirs.cmi -toplevel/toploop.cmo: utils/warnings.cmi typing/unused_var.cmi \ - typing/types.cmi typing/typemod.cmi typing/typedtree.cmi \ - typing/typecore.cmi bytecomp/translmod.cmi bytecomp/symtable.cmi \ - bytecomp/simplif.cmi typing/printtyp.cmi bytecomp/printlambda.cmi \ +toplevel/toploop.cmo : utils/warnings.cmi typing/types.cmi \ + typing/typemod.cmi typing/typedtree.cmi typing/typecore.cmi \ + bytecomp/translmod.cmi bytecomp/symtable.cmi bytecomp/simplif.cmi \ + typing/printtyped.cmi typing/printtyp.cmi bytecomp/printlambda.cmi \ bytecomp/printinstr.cmi parsing/printast.cmi typing/predef.cmi \ - typing/path.cmi parsing/parsetree.cmi parsing/parse.cmi \ - typing/outcometree.cmi typing/oprint.cmi utils/misc.cmi bytecomp/meta.cmi \ - parsing/longident.cmi parsing/location.cmi parsing/lexer.cmi \ + parsing/pprintast.cmi driver/pparse.cmi typing/path.cmi \ + parsing/parsetree.cmi parsing/parse.cmi typing/outcometree.cmi \ + typing/oprint.cmi utils/misc.cmi bytecomp/meta.cmi parsing/longident.cmi \ + parsing/location.cmi parsing/lexer.cmi typing/includemod.cmi \ typing/ident.cmi toplevel/genprintval.cmi driver/errors.cmi \ typing/env.cmi bytecomp/emitcode.cmi bytecomp/dll.cmi utils/consistbl.cmi \ - utils/config.cmi driver/compile.cmi utils/clflags.cmi \ + utils/config.cmi driver/compmisc.cmi utils/clflags.cmi \ bytecomp/bytegen.cmi typing/btype.cmi toplevel/toploop.cmi -toplevel/toploop.cmx: utils/warnings.cmx typing/unused_var.cmx \ - typing/types.cmx typing/typemod.cmx typing/typedtree.cmx \ - typing/typecore.cmx bytecomp/translmod.cmx bytecomp/symtable.cmx \ - bytecomp/simplif.cmx typing/printtyp.cmx bytecomp/printlambda.cmx \ +toplevel/toploop.cmx : utils/warnings.cmx typing/types.cmx \ + typing/typemod.cmx typing/typedtree.cmx typing/typecore.cmx \ + bytecomp/translmod.cmx bytecomp/symtable.cmx bytecomp/simplif.cmx \ + typing/printtyped.cmx typing/printtyp.cmx bytecomp/printlambda.cmx \ bytecomp/printinstr.cmx parsing/printast.cmx typing/predef.cmx \ - typing/path.cmx parsing/parsetree.cmi parsing/parse.cmx \ - typing/outcometree.cmi typing/oprint.cmx utils/misc.cmx bytecomp/meta.cmx \ - parsing/longident.cmx parsing/location.cmx parsing/lexer.cmx \ + parsing/pprintast.cmx driver/pparse.cmx typing/path.cmx \ + parsing/parsetree.cmi parsing/parse.cmx typing/outcometree.cmi \ + typing/oprint.cmx utils/misc.cmx bytecomp/meta.cmx parsing/longident.cmx \ + parsing/location.cmx parsing/lexer.cmx typing/includemod.cmx \ typing/ident.cmx toplevel/genprintval.cmx driver/errors.cmx \ typing/env.cmx bytecomp/emitcode.cmx bytecomp/dll.cmx utils/consistbl.cmx \ - utils/config.cmx driver/compile.cmx utils/clflags.cmx \ + utils/config.cmx driver/compmisc.cmx utils/clflags.cmx \ bytecomp/bytegen.cmx typing/btype.cmx toplevel/toploop.cmi -toplevel/topmain.cmo: utils/warnings.cmi toplevel/toploop.cmi \ +toplevel/topmain.cmo : utils/warnings.cmi toplevel/toploop.cmi \ toplevel/topdirs.cmi utils/misc.cmi driver/main_args.cmi \ - driver/errors.cmi utils/config.cmi utils/clflags.cmi toplevel/topmain.cmi -toplevel/topmain.cmx: utils/warnings.cmx toplevel/toploop.cmx \ + parsing/location.cmi driver/errors.cmi utils/config.cmi \ + driver/compenv.cmi utils/clflags.cmi toplevel/topmain.cmi +toplevel/topmain.cmx : utils/warnings.cmx toplevel/toploop.cmx \ toplevel/topdirs.cmx utils/misc.cmx driver/main_args.cmx \ - driver/errors.cmx utils/config.cmx utils/clflags.cmx toplevel/topmain.cmi -toplevel/topstart.cmo: toplevel/topmain.cmi -toplevel/topstart.cmx: toplevel/topmain.cmx -toplevel/trace.cmo: typing/types.cmi toplevel/toploop.cmi typing/printtyp.cmi \ - typing/predef.cmi typing/path.cmi utils/misc.cmi bytecomp/meta.cmi \ - parsing/longident.cmi typing/ctype.cmi toplevel/trace.cmi -toplevel/trace.cmx: typing/types.cmx toplevel/toploop.cmx typing/printtyp.cmx \ - typing/predef.cmx typing/path.cmx utils/misc.cmx bytecomp/meta.cmx \ - parsing/longident.cmx typing/ctype.cmx toplevel/trace.cmi + parsing/location.cmx driver/errors.cmx utils/config.cmx \ + driver/compenv.cmx utils/clflags.cmx toplevel/topmain.cmi +toplevel/topstart.cmo : toplevel/topmain.cmi +toplevel/topstart.cmx : toplevel/topmain.cmx +toplevel/trace.cmo : typing/types.cmi toplevel/toploop.cmi \ + typing/printtyp.cmi typing/predef.cmi typing/path.cmi utils/misc.cmi \ + bytecomp/meta.cmi parsing/longident.cmi typing/ctype.cmi \ + toplevel/trace.cmi +toplevel/trace.cmx : typing/types.cmx toplevel/toploop.cmx \ + typing/printtyp.cmx typing/predef.cmx typing/path.cmx utils/misc.cmx \ + bytecomp/meta.cmx parsing/longident.cmx typing/ctype.cmx \ + toplevel/trace.cmi diff -Nru ocaml-3.12.1/.ignore ocaml-4.01.0/.ignore --- ocaml-3.12.1/.ignore 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/.ignore 2012-12-31 01:25:54.000000000 +0000 @@ -0,0 +1,19 @@ +configure +ocamlc +ocamlc.opt +expunge +ocaml +ocamlopt +ocamlopt.opt +ocamlcomp.sh +ocamlcompopt.sh +package-macosx +_boot_log1 +_boot_log2 +_build +_start +_buildtest +_log +myocamlbuild_config.ml +ocamlbuild-mixed-boot +ocamlnat diff -Nru ocaml-3.12.1/Changes ocaml-4.01.0/Changes --- ocaml-3.12.1/Changes 2011-07-04 21:15:01.000000000 +0000 +++ ocaml-4.01.0/Changes 2013-09-11 15:14:15.000000000 +0000 @@ -1,5 +1,790 @@ -Objective Caml 3.12.1: ----------------------- +OCaml 4.01.0: +------------- + +(Changes that can break existing programs are marked with a "*") + +Other libraries: +- Labltk: updated to Tcl/Tk 8.6. + +Type system: +- PR#5759: use well-disciplined type information propagation to + disambiguate label and constructor names + (Jacques Garrigue, Alain Frisch and Leo P. White) +* Propagate type information towards pattern-matching, even in the presence of + polymorphic variants (discarding only information about possibly-present + constructors). As a result, matching against absent constructors is no longer + allowed for exact and fixed polymorphic variant types. + (Jacques Garrigue) +* PR#6035: Reject multiple declarations of the same method or instance variable + in an object + (Alain Frisch) + +Compilers: +- PR#5861: raise an error when multiple private keywords are used in type + declarations + (Hongbo Zhang) +- PR#5634: parsetree rewriter (-ppx flag) + (Alain Frisch) +- ocamldep now supports -absname + (Alain Frisch) +- PR#5768: On "unbound identifier" errors, use spell-checking to suggest names + present in the environment + (Gabriel Scherer) +- ocamlc has a new option -dsource to visualize the parsetree + (Alain Frisch, Hongbo Zhang) +- tools/eqparsetree compares two parsetree ignoring location + (Hongbo Zhang) +- ocamlopt now uses clang as assembler on OS X if available, which enables + CFI support for OS X. + (Benedikt Meurer) +- Added a new -short-paths option, which attempts to use the shortest + representation for type constructors inside types, taking open modules + into account. This can make types much more readable if your code + uses lots of functors. + (Jacques Garrigue) +- PR#5986: added flag -compat-32 to ocamlc, ensuring that the generated + bytecode executable can be loaded on 32-bit hosts. + (Xavier Leroy) +- PR#5980: warning on open statements which shadow an existing + identifier (if it is actually used in the scope of the open); new + open! syntax to silence it locally + (Alain Frisch, thanks to a report of Daniel Bünzli) +* warning 3 is extended to warn about other deprecated features: + - ISO-latin1 characters in identifiers + - uses of the (&) and (or) operators instead of (&&) and (||) + (Damien Doligez) +- Experimental OCAMLPARAM for ocamlc and ocamlopt + (Fabrice Le Fessant) +- PR#5571: incorrect ordinal number in error message + (Alain Frisch, report by John Carr) +- PR#6073: add signature to Tstr_include + (patch by Leo P. White) + +Standard library: +- PR#5899: expose a way to inspect the current call stack, + Printexc.get_callstack + (Gabriel Scherer, Jacques-Henri Jourdan, Alain Frisch) +- PR#5986: new flag Marshal.Compat_32 for the serialization functions + (Marshal.to_*), forcing the output to be readable on 32-bit hosts. + (Xavier Leroy) +- infix application operators |> and @@ in Pervasives + (Fabrice Le Fessant) + +Other libraries: +- PR#5568: add O_CLOEXEC flag to Unix.openfile, so that the returned + file descriptor is created in close-on-exec mode + (Xavier Leroy) + +Runtime system: +* PR#6019: more efficient implementation of caml_modify() and caml_initialize(). + The new implementations are less lenient than the old ones: now, + the destination pointer of caml_modify() must point within the minor or + major heaps, and the destination pointer of caml_initialize() must + point within the major heap. + (Xavier Leroy, from an experiment by Brian Nigito, with feedback + from Yaron Minsky and Gerd Stolpmann) + +Internals: +- Moved debugger/envaux.ml to typing/envaux.ml to publish env_of_only_summary + as part of compilerlibs, to be used on bin-annot files. + (Fabrice Le Fessant) +- The test suite can now be run without installing OCaml first. + (Damien Doligez) + +Bug fixes: +- PR#3236: Document the fact that queues are not thread-safe + (Damien Doligez) +- PR#3468: (part 1) Sys_error documentation + (Damien Doligez) +- PR#3679: Warning display problems + (Fabrice Le Fessant) +- PR#3963: Graphics.wait_next_event in Win32 hangs if window closed + (Damien Doligez) +- PR#4079: Queue.copy is now tail-recursive + (patch by Christophe Papazian) +- PR#4138: Documentation for Unix.mkdir + (Damien Doligez) +- PR#4469: emacs mode: caml-set-compile-command is annoying with ocamlbuild + (Daniel Bünzli) +- PR#4485: Graphics: Keyboard events incorrectly delivered in native code + (Damien Doligez, report by Sharvil Nanavati) +- PR#4502: ocamlbuild now reliably excludes the build-dir from hygiene check + (Gabriel Scherer, report by Romain Bardou) +- PR#4762: ?? is not used at all, but registered as a lexer token + (Alain Frisch) +- PR#4788: wrong error message when executable file is not found for backtrace + (Damien Doligez, report by Claudio Sacerdoti Coen) +- PR#4812: otherlibs/unix: add extern int code_of_unix_error (value error); + (Goswin von Berdelow) +- PR#4887: input_char after close_in crashes ocaml (msvc runtime) + (Alain Frisch and Christoph Bauer, report by ygrek) +- PR#4994: ocaml-mode doesn't work with xemacs21 + (Damien Doligez, report by Stéphane Glondu) +- PR#5098: creating module values may lead to memory leaks + (Alain Frisch, report by Milan Stanojević) +- PR#5102: ocamlbuild fails when using an unbound variable in rule dependency + (Xavier Clerc, report by Daniel Bünzli) +* PR#5119: camlp4 now raises a specific exception when 'DELETE_RULE' fails, + rather than raising 'Not_found' + (ygrek) +- PR#5121: %( %) in Format module seems to be broken + (Pierre Weis, first patch by Valentin Gatien-Baron, report by Khoo Yit Phang) +- PR#5178: document in INSTALL how to build a 32-bit version under Linux x86-64 + (Benjamin Monate) +- PR#5212: Improve ocamlbuild error messages of _tags parser + (ygrek) +- PR#5240: register exception printers for Unix.Unix_error and Dynlink.Error + (Jérémie Dimino) +- PR#5300: ocamlbuild: verbose parameter should implicitly set classic display + (Xavier Clerc, report by Robert Jakob) +- PR#5327: (Windows) Unix.select blocks if same socket listed in first and + third arguments + (David Allsopp, displaying impressive MSDN skills) +- PR#5343: ocaml -rectypes is unsound wrt module subtyping (was still unsound) + (Jacques Garrigue) +- PR#5350: missing return code checks in the runtime system + (Xavier Leroy) +- PR#5468: ocamlbuild should preserve order of parametric tags + (Wojciech Meyer, report by Dario Texeira) +- PR#5551: Avoid repeated lookups for missing cmi files + (Alain Frisch) +- PR#5552: unrecognized gcc option -no-cpp-precomp + (Damien Doligez, report by Markus Mottl) +- PR#5580: missed opportunities for constant propagation + (Xavier Leroy and John Carr) +- PR#5611: avoid clashes betwen .cmo files and output files during linking + (Wojciech Meyer) +- PR#5662: typo in md5.c + (Olivier Andrieu) +- PR#5673: type equality in a polymorphic field + (Jacques Garrigue, report by Jean-Louis Giavitto) +- PR#5674: Methods call are 2 times slower with 4.00 than with 3.12 + (Jacques Garrigue, Gabriel Scherer, report by Jean-Louis Giavitto) +- PR#5694: Exception raised by type checker + (Jacques Garrigue, report by Markus Mottl) +- PR#5695: remove warnings on sparc code emitter + (Fabrice Le Fessant) +- PR#5697: better location for warnings on statement expressions + (Dan Bensen) +- PR#5698: remove harcoded limit of 200000 labels in emitaux.ml + (Fabrice Le Fessant, report by Marcin Sawicki) +- PR#5702: bytecomp/bytelibrarian lib_sharedobjs was defined but never used + (Hongbo Zhang, Fabrice Le Fessant) +- PR#5708: catch Failure"int_of_string" in ocamldebug + (Fabrice Le Fessant, report by user 'schommer') +- PR#5712: (9) new option -bin-annot is not documented + (Damien Doligez, report by Hendrik Tews) +- PR#5731: instruction scheduling forgot to account for destroyed registers + (Xavier Leroy, Benedikt Meurer, reported by Jeffrey Scofield) +- PR#5734: improved Win32 implementation of Unix.gettimeofday + (David Allsopp) +- PR#5735: %apply and %revapply not first class citizens + (Fabrice Le Fessant, reported by Jun Furuse) +- PR#5738: first class module patterns not handled by ocamldep + (Fabrice Le Fessant, Jacques Garrigue, reported by Hongbo Zhang) +- PR#5739: Printf.printf "%F" (-.nan) returns -nan + (Xavier Leroy, David Allsopp, reported by Samuel Mimram) +- PR#5741: make pprintast.ml in compiler_libs + (Alain Frisch, Hongbo Zhang) +- PR#5747: 'unused open' warning not given when compiling with -annot + (Alain Frisch, reported by Valentin Gatien-Baron) +- PR#5752: missing dependencies at byte-code link with mlpack + (Wojciech Meyer, Nicholas Lucaroni) +- PR#5763: ocamlbuild does not give correct flags when running menhir + (Gabriel Scherer, reported by Philippe Veber) +- PR#5765: ocamllex doesn't preserve line directives + (Damien Doligez, reported by Martin Jambon) +- PR#5770: Syntax error messages involving unclosed parens are sometimes + incorrect + (Michel Mauny) +- PR#5772: problem with marshaling of mutually-recursive functions + (Jacques-Henri Jourdan, reported by Cédric Pasteur) +- PR#5775: several bug fixes for tools/pprintast.ml + (Hongbo Zhang) +- PR#5784: -dclambda option is ignored + (Pierre Chambart) +- PR#5785: misbehaviour with abstracted structural type used as GADT index + (Jacques Garrigue, report by Jeremy Yallop) +- PR#5787: Bad behavior of 'Unused ...' warnings in the toplevel + (Alain Frisch) +- PR#5793: integer marshalling is inconsistent between architectures + (Xavier Clerc, report by Pierre-Marie Pédrot) +- PR#5798: add ARM VFPv2 support for Raspbian (ocamlopt) + (Jeffrey Scofield and Anil Madhavapeddy, patch review by Benedikt Meurer) +- PR#5802: Avoiding "let" as a value name + (Jacques Garrigue, report by Tiphaine Turpin) +- PR#5805: Assert failure with warning 34 on pre-processed file + (Alain Frisch, report by Tiphaine Turpin) +- PR#5806: ensure that backtrace tests are always run (testsuite) + (Xavier Clerc, report by user 'michi') +- PR#5809: Generating .cmt files takes a long time, in case of type error + (Alain Frisch) +- PR#5810: error in switch printing when using -dclambda + (Pierre Chambart) +- PR#5811: Untypeast produces singleton tuples for constructor patterns + with only one argument + (Tiphaine Turpin) +- PR#5813: GC not called when unmarshaling repeatedly in a tight loop (ocamlopt) + (Xavier Leroy, report by David Waern) +- PR#5814: read_cmt -annot does not report internal references + (Alain Frisch) +- PR#5815: Multiple exceptions in signatures gives an error + (Leo P. White) +- PR#5816: read_cmt -annot does not work for partial .cmt files + (Alain Frisch) +- PR#5819: segfault when using [with] on large recursive record (ocamlopt) + (Xavier Leroy, Damien Doligez) +- PR#5821: Wrong record field is reported as duplicate + (Alain Frisch, report by Martin Jambon) +- PR#5824: Generate more efficient code for immediate right shifts. + (Pierre Chambart, review by Xavier Leroy) +- PR#5825: Add a toplevel primitive to use source file wrapped with the + coresponding module + (Grégoire Henry, Wojciech Meyer, caml-list discussion) +- PR#5833: README.win32 can leave the wrong flexlink in the path + (Damien Doligez, report by William Smith) +- PR#5835: nonoptional labeled arguments can be passed with '?' + (Jacques Garrigue, report by Elnatan Reisner) +- PR#5840: improved documentation for 'Unix.lseek' + (Xavier Clerc, report by Matej Košík) +- PR#5848: Assertion failure in type checker + (Jacques Garrigue, Alain Frisch, report by David Waern) +- PR#5858: Assert failure during typing of class + (Jacques Garrigue, report by Julien Signoles) +- PR#5865: assert failure when reporting undefined field label + (Jacques Garrigue, report by Anil Madhavapeddy) +- PR#5872: Performance: Buffer.add_char is not inlined + (Gerd Stolpmann, Damien Doligez) +- PR#5876: Uncaught exception with a typing error + (Alain Frisch, Gabriel Scherer, report by Julien Moutinho) +- PR#5877: multiple "open" can become expensive in memory + (Fabrice Le Fessant and Alain Frisch) +- PR#5880: 'Genlex.make_lexer' documention mentions the wrong exception + (Xavier Clerc, report by Virgile Prevosto) +- PR#5885: Incorrect rule for compiling C stubs when shared libraries are not + supported. + (Jérôme Vouillon) +- PR#5891: ocamlbuild: support rectypes tag for mlpack + (Khoo Yit Phang) +- PR#5892: GADT exhaustiveness check is broken + (Jacques Garrigue and Leo P. White) +- PR#5906: GADT exhaustiveness check is still broken + (Jacques Garrigue, report by Sébastien Briais) +- PR#5907: Undetected cycle during typecheck causes exceptions + (Jacques Garrigue, report by Pascal Zimmer) +- PR#5910: Fix code generation bug for "mod 1" on ARM. + (Benedikt Meurer, report by user 'jteg68') +- PR#5911: Signature substitutions fail in submodules + (Jacques Garrigue, report by Markus Mottl) +- PR#5912: add configure option -no-cfi (for OSX 10.6.x with XCode 4.0.2) + (Damien Doligez against XCode versions, report by Thomas Gazagnaire) +- PR#5914: Functor breaks with an equivalent argument signature + (Jacques Garrigue, report by Markus Mottl and Grégoire Henry) +- PR#5920, PR#5957: linking failure for big bytecodes on 32bit architectures + (Benoît Vaugon and Chet Murthy, report by Jun Furuse and Sebastien Mondet) +- PR#5928: Missing space between words in manual page for ocamlmktop + (Damien Doligez, report by Matej Košík) +- PR#5930: ocamldep leaks temporary preprocessing files + (Gabriel Scherer, report by Valentin Gatien-Baron) +- PR#5933: Linking is slow when there are functions with large arities + (Valentin Gatien-Baron, review by Gabriel Scherer) +- PR#5934: integer shift by negative amount (in otherlibs/num) + (Xavier Leroy, report by John Regehr) +- PR#5944: Bad typing performances of big variant type declaration + (Benoît Vaugon) +- PR#5945: Mix-up of Minor_heap_min and Minor_heap_max units + (Benoît Vaugon) +- PR#5948: GADT with polymorphic variants bug + (Jacques Garrigue, report by Leo P. White) +- PR#5953: Unix.system does not handle EINTR + (Jérémie Dimino) +- PR#5965: disallow auto-reference to a recursive module in its definition + (Alain Frisch, report by Arthur Windler via Gabriel Scherer) +- PR#5973: Format module incorrectly parses format string + (Pierre Weis, report by Frédéric Bour) +- PR#5974: better documentation for Str.regexp + (Damien Doligez, report by william) +- PR#5976: crash after recovering from two stack overflows (ocamlopt on MacOS X) + (Xavier Leroy, report by Pierre Boutillier) +- PR#5977: Build failure on raspberry pi: "input_value: integer too large" + (Alain Frisch, report by Sylvain Le Gall) +- PR#5981: Incompatibility check assumes abstracted types are injective + (Jacques Garrigue, report by Jeremy Yallop) +- PR#5982: caml_leave_blocking section and errno corruption + (Jérémie Dimino) +- PR#5985: Unexpected interaction between variance and GADTs + (Jacques Garrigue, Jeremy Yallop and Leo P. White and Gabriel Scherer) +- PR#5988: missing from the documentation: -impl is a valid flag for ocamlopt + (Damien Doligez, report by Vincent Bernardoff) +- PR#5989: Assumed inequalities involving private rows + (Jacques Garrigue, report by Jeremy Yallop) +- PR#5992: Crash when pattern-matching lazy values modifies the scrutinee + (Luc Maranget, Leo P. White) +- PR#5993: Variance of private type abbreviations not checked for modules + (Jacques Garrigue) +- PR#5997: Non-compatibility assumed for concrete types with same constructor + (Jacques Garrigue, report by Gabriel Scherer) +- PR#6004: Type information does not flow to "inherit" parameters + (Jacques Garrigue, report by Alain Frisch) +- PR#6005: Type unsoundness with recursive modules + (Jacques Garrigue, report by Jérémie Dimino and Josh Berdine) +- PR#6010: Big_int.extract_big_int gives wrong results on negative arguments + (Xavier Leroy, report by Drake Wilson via Stéphane Glondu) +- PR#6024: Format syntax for printing @ is incompatible with 3.12.1 + (Damien Doligez, report by Boris Yakobowski) +- PR#6001: Reduce the memory used by compiling Camlp4 + (Hongbo Zhang and Gabriel Scherer, report by Henri Gouraud) +- PR#6031: Camomile problem with -with-frame-pointers + (Fabrice Le Fessant, report by Anil Madhavapeddy) +- PR#6032: better Random.self_init under Windows + (Alain Frisch, Xavier Leroy) +- PR#6033: Matching.inline_lazy_force needs eta-expansion (command-line flags) + (Pierre Chambart, Xavier Leroy and Luc Maranget, + regression report by Gabriel Scherer) +- PR#6046: testsuite picks up the wrong ocamlrun dlls + (Anil Madhavapeddy) +- PR#6056: Using 'match' prevents generalization of values + (Jacques Garrigue, report by Elnatan Reisner) +- PR#6058: 'ocamlbuild -use-ocamlfind -tag thread -package threads t.cma' fails + (Gabriel Scherer, report by Hezekiah M. Carty) +- PR#6060: ocamlbuild rules for -principal, -strict-sequence and -short-paths + (Anil Madhavapeddy) +- PR#6069: ocamldoc: lexing: empty token + (Maxence Guesdon, Grégoire Henry, report by ygrek) +- PR#6072: configure does not handle FreeBSD current (i.e. 10) correctly + (Damien Doligez, report by Prashanth Mundkur) +- PR#6074: Wrong error message for failing Condition.broadcast + (Markus Mottl) +- PR#6084: Define caml_modify and caml_initialize as weak symbols to help + with Netmulticore + (Xavier Leroy, Gerd Stolpmann) +- PR#6090: Module constraint + private type seems broken in ocaml 4.01.0 + (Jacques Garrigue, report by Jacques-Pascal Deplaix) +- PR#6109: Typos in ocamlbuild error messages + (Gabriel Kerneis) +- PR#6123: Assert failure when self escapes its class + (Jacques Garrigue, report by whitequark) +- PR#6158: Fatal error using GADTs + (Jacques Garrigue, report by Jeremy Yallop) +- PR#6163: Assert_failure using polymorphic variants in GADTs + (Jacques Garrigue, report by Leo P. White) +- PR#6164: segmentation fault on Num.power_num of 0/1 + (Fabrice Le Fessant, report by Johannes Kanig) + +Feature wishes: +- PR#5181: Merge common floating point constants in ocamlopt + (Benedikt Meurer) +- PR#5243: improve the ocamlbuild API documentation in signatures.mli + (Christophe Troestler) +- PR#5546: moving a function into an internal module slows down its use + (Alain Frisch, report by Fabrice Le Fessant) +- PR#5597: add instruction trace option 't' to OCAMLRUNPARAM + (Anil Madhavapeddy, Wojciech Meyer) +- PR#5676: IPv6 support under Windows + (Jérôme Vouillon, review by Jonathan Protzenko) +- PR#5721: configure -with-frame-pointers for Linux perf profiling + (Fabrice Le Fessant, test by Jérémie Dimino) +- PR#5722: toplevel: print full module path only for first record field + (Jacques Garrigue, report by ygrek) +- PR#5762: Add primitives for fast access to bigarray dimensions + (Pierre Chambart) +- PR#5769: Allow propagation of Sys.big_endian in native code + (Pierre Chambart, stealth commit by Fabrice Le Fessant) +- PR#5771: Add primitives for reading 2, 4, 8 bytes in strings and bigarrays + (Pierre Chambart) +- PR#5774: Add bswap primitives for amd64 and arm + (Pierre Chambart, test by Alain Frisch) +- PR#5795: Generate sqrtsd opcode instead of external call to sqrt on amd64 + (Pierre Chambart) +- PR#5827: provide a dynamic command line parsing mechanism + (Hongbo Zhang) +- PR#5832: patch to improve "wrong file naming" error messages + (William Smith) +- PR#5864: Add a find operation to Set + (François Berenger) +- PR#5886: Small changes to compile for Android + (Jérôme Vouillon, review by Benedikt Meurer) +- PR#5902: -ppx based pre-processor executables accept arguments + (Alain Frisch, report by Wojciech Meyer) +- PR#5986: Protect against marshaling 64-bit integers in bytecode + (Xavier Leroy, report by Alain Frisch) +- PR#6049: support for OpenBSD/macppc platform + (Anil Madhavapeddy, review by Benedikt Meurer) +- PR#6059: add -output-obj rules for ocamlbuild + (Anil Madhavapeddy) + +Tools: +- OCamlbuild now features a bin_annot tag to generate .cmt files. + (Jonathan Protzenko) +- OCamlbuild now features a strict_sequence tag to trigger the + strict-sequence option. + (Jonathan Protzenko) +- OCamlbuild now picks the non-core tools like ocamlfind and menhir from PATH + (Wojciech Meyer) +- PR#5884: Misc minor fixes and cleanup for emacs mode + (Stefan Monnier) +- PR#6030: Improve performance of -annot + (Guillaume Melquiond, Alain Frisch) + + +OCaml 4.00.1: +------------- + +Bug fixes: +- PR#4019: better documentation of Str.matched_string +- PR#5111: ocamldoc, heading tags inside spans tags is illegal in html +- PR#5278: better error message when typing "make" +- PR#5468: ocamlbuild should preserve order of parametric tags +- PR#5563: harden Unix.select against file descriptors above FD_SETSIZE +- PR#5690: "ocamldoc ... -text README" raises exception +- PR#5700: crash with native-code stack backtraces under MacOS 10.8 x86-64 +- PR#5707: AMD64 code generator: do not use r10 and r11 for parameter passing, + as these registers can be destroyed by the dynamic loader +- PR#5712: some documentation problems +- PR#5715: configuring with -no-shared-libs breaks under cygwin +- PR#5718: false positive on 'unused constructor' warning +- PR#5719: ocamlyacc generates code that is not warning 33-compliant +- PR#5725: ocamldoc output of preformatted code +- PR#5727: emacs caml-mode indents shebang line in toplevel scripts +- PR#5729: tools/untypeast.ml creates unary Pexp_tuple +- PR#5731: instruction scheduling forgot to account for destroyed registers +- PR#5735: %apply and %revapply not first class citizens +- PR#5738: first class module patterns not handled by ocamldep +- PR#5742: missing bound checks in Array.sub +- PR#5744: ocamldoc error on "val virtual" +- PR#5757: GC compaction bug (crash) +- PR#5758: Compiler bug when matching on floats +- PR#5761: Incorrect bigarray custom block size + + +OCaml 4.00.0: +------------- + +(Changes that can break existing programs are marked with a "*") + +- The official name of the language is now OCaml. + +Language features: +- Added Generalized Algebraic Data Types (GADTs) to the language. + See chapter "Language extensions" of the reference manual for documentation. +- It is now possible to omit type annotations when packing and unpacking + first-class modules. The type-checker attempts to infer it from the context. + Using the -principal option guarantees forward compatibility. +- New (module M) and (module M : S) syntax in patterns, for immediate + unpacking of a first-class module. + +Compilers: +- Revised simplification of let-alias (PR#5205, PR#5288) +- Better reporting of compiler version mismatch in .cmi files +* Warning 28 is now enabled by default. +- New option -absname to use absolute paths in error messages +- Optimize away compile-time beta-redexes, e.g. (fun x y -> e) a b. +- Added option -bin-annot to dump the AST with type annotations. +- Added lots of new warnings about unused variables, opens, fields, + constructors, etc. +* New meaning for warning 7: it is now triggered when a method is overridden + with the "method" keyword. Use "method!" to avoid the warning. + +Native-code compiler: +- Optimized handling of partially-applied functions (PR#5287) +- Small improvements in code generated for array bounds checks (PR#5345, + PR#5360). +* New ARM backend (PR#5433): + . Supports both Linux/EABI (armel) and Linux/EABI+VFPv3 (armhf). + . Added support for the Thumb-2 instruction set with average code size + savings of 28%. + . Added support for position-independent code, natdynlink, profiling and + exception backtraces. +- Generation of CFI information, and filename/line number debugging (with -g) + annotations, enabling in particular precise stack backtraces with + the gdb debugger. Currently supported for x86 32-bits and 64-bits only. + (PR#5487) +- New tool: ocamloptp, the equivalent of ocamlcp for the native-code compiler. + +OCamldoc: +- PR#5645: ocamldoc doesn't handle module/type substitution in signatures +- PR#5544: improve HTML output (less formatting in html code) +- PR#5522: allow refering to record fields and variant constructors +- fix PR#5419 (error message in french) +- fix PR#5535 (no cross ref to class after dump+load) +* Use first class modules for custom generators, to be able to + load various plugins incrementally adding features to the current + generator +* PR#5507: Use Location.t structures for locations. +- fix: do not keep code when not told to keep code. + +Standard library: +- Added float functions "hypot" and "copysign" (PR#3806, PR#4752, PR#5246) +* Arg: options with empty doc strings are no longer included in the usage string + (PR#5437) +- Array: faster implementations of "blit", "copy", "sub", "append" and "concat" + (PR#2395, PR#2787, PR#4591) +* Hashtbl: + . Statistically-better generic hash function based on Murmur 3 (PR#5225) + . Fixed behavior of generic hash function w.r.t. -0.0 and NaN (PR#5222) + . Added optional "random" parameter to Hashtbl.create to randomize + collision patterns and improve security (PR#5572, CVE-2012-0839) + . Added "randomize" function and "R" parameter to OCAMLRUNPARAM + to turn randomization on by default (PR#5572, CVE-2012-0839) + . Added new functorial interface "MakeSeeded" to support randomization + with user-provided seeded hash functions. + . Install new header for C code. +- Filename: on-demand (lazy) initialization of the PRNG used by "temp_file". +- Marshal: marshalling of function values (flag Marshal.Closures) now + also works for functions that come from dynamically-loaded modules (PR#5215) +- Random: + . More random initialization (Random.self_init()), using /dev/urandom + when available (e.g. Linux, FreeBSD, MacOS X, Solaris) + * Faster implementation of Random.float (changes the generated sequences) +- Format strings for formatted input/output revised to correct PR#5380 + . Consistently treat %@ as a plain @ character + . Consistently treat %% as a plain % character +- Scanf: width and precision for floating point numbers are now handled +- Scanf: new function "unescaped" (PR#3888) +- Set and Map: more efficient implementation of "filter" and "partition" +- String: new function "map" (PR#3888) + +Installation procedure: +- Compiler internals are now installed in `ocamlc -where`/compiler-libs. + The files available there include the .cmi interfaces for all compiler + modules, plus the following libraries: + ocamlcommon.cma/.cmxa modules common to ocamlc, ocamlopt, ocaml + ocamlbytecomp.cma/.cmxa modules for ocamlc and ocaml + ocamloptcomp.cma/.cmxa modules specific to ocamlopt + ocamltoplevel.cma modules specific to ocaml + (PR#1804, PR#4653, frequently-asked feature). +* Some .cmi for toplevel internals that used to be installed in + `ocamlc -where` are now to be found in `ocamlc -where`/compiler-libs. + Add "-I +compiler-libs" where needed. +* toplevellib.cma is no longer installed because subsumed by + ocamlcommon.cma ocamlbytecomp.cma ocamltoplevel.cma +- Added a configuration option (-with-debug-runtime) to compile and install + a debug version of the runtime system, and a compiler option + (-runtime-variant) to select the debug runtime. + +Bug Fixes: +- PR#1643: functions of the Lazy module whose named started with 'lazy_' have + been deprecated, and new ones without the prefix added +- PR#3571: in Bigarrays, call msync() before unmapping to commit changes +- PR#4292: various documentation problems +- PR#4511, PR#4838: local modules remove polymorphism +* PR#4549: Filename.dirname is not handling multiple / on Unix +- PR#4688: (Windows) special floating-point values aren't converted to strings + correctly +- PR#4697: Unix.putenv leaks memory on failure +- PR#4705: camlp4 does not allow to define types with `True or `False +- PR#4746: wrong detection of stack overflows in native code under Linux +- PR#4869: rare collisions between assembly labels for code and data +- PR#4880: "assert" constructs now show up in the exception stack backtrace +- PR#4892: Array.set could raise "out of bounds" before evaluating 3rd arg +- PR#4937: camlp4 incorrectly handles optional arguments if 'option' is + redefined +- PR#5024: camlp4r now handles underscores in irrefutable pattern matching of + records +- PR#5064, PR#5485: try to ensure that 4K words of stack are available + before calling into C functions, raising a Stack_overflow exception + otherwise. This reduces (but does not eliminate) the risk of + segmentation faults due to stack overflow in C code +- PR#5073: wrong location for 'Unbound record field label' error +- PR#5084: sub-sub-module building fails for native code compilation +- PR#5120: fix the output function of Camlp4.Debug.formatter +- PR#5131: compilation of custom runtime with g++ generates lots of warnings +- PR#5137: caml-types-explore does not work +- PR#5159: better documentation of type Lexing.position +- PR#5171: Map.join does more comparisons than needed +- PR#5176: emacs mode: stack overflow in regexp matcher +- PR#5179: port OCaml to mingw-w64 +- PR#5211: updated Genlex documentation to state that camlp4 is mandatory for + 'parser' keyword and associated notation +- PR#5214: ocamlfind plugin invokes 'cut' utility +- PR#5218: use $(MAKE) instead of "make" in Makefiles +- PR#5224: confusing error message in non-regular type definition +- PR#5231: camlp4: fix parsing of <:str_item< type t = $x$ >> +- PR#5233: finaliser on weak array gives dangling pointers (crash) +- PR#5238, PR#5277: Sys_error when getting error location +- PR#5261, PR#5497: Ocaml source-code examples are not "copy-paste-able" +* PR#5279: executable name is not initialized properly in caml_startup_code +- PR#5290: added hash functions for channels, nats, mutexes, conditions +- PR#5291: undetected loop in class initialization +- PR#5295: OS threads: problem with caml_c_thread_unregister() +- PR#5301: camlp4r and exception equal to another one with parameters +- PR#5305: prevent ocamlbuild from complaining about links to _build/ +- PR#5306: comparing to Thread.self() raises exception at runtime +- PR#5309: Queue.add is not thread/signal safe +- PR#5310: Ratio.create_ratio/create_normalized_ratio have misleading names +- PR#5311: better message for warning 23 +* PR#5312: command-line arguments @reponsefile auto-expansion feature + removed from the Windows OCaml runtime, to avoid conflicts with "-w @..." +- PR#5313: ocamlopt -g misses optimizations +- PR#5214: ocamlfind plugin invokes 'cut' utility +- PR#5316: objinfo now shows ccopts/ccobjs/force_link when applicable +- PR#5318: segfault on stack overflow when reading marshaled data +- PR#5319: %r11 clobbered by Lswitch in Windows AMD64 native-code compilation +- PR#5322: type abbreviations expanding to a universal type variable +- PR#5328: under Windows, Unix.select leaves sockets in non-blocking mode +- PR#5330: thread tag with '.top' and '.inferred.mli' targets +- PR#5331: ocamlmktop is not always a shell script +- PR#5335: Unix.environment segfaults after a call to clearenv +- PR#5338: sanitize.sh has windows style end-of-lines (mingw) +- PR#5344: some predefined exceptions need special printing +- PR#5349: Hashtbl.replace uses new key instead of reusing old key +- PR#5356: ocamlbuild handling of 'predicates' for ocamlfind +- PR#5364: wrong compilation of "((val m : SIG1) : SIG2)" +- PR#5370: ocamldep omits filename in syntax error message +- PR#5374: camlp4 creates wrong location for type definitions +- PR#5380: strange sscanf input segfault +- PR#5382: EOPNOTSUPP and ENOTSUPP different on exotic platforms +- PR#5383: build failure in Win32/MSVC +- PR#5387: camlp4: str_item and other syntactic elements with Nils are + not very usable +- PR#5389: compaction sometimes leaves a very large heap +- PR#5393: fails to build from source on GNU/kFreeBSD because of -R link option +- PR#5394: documentation for -dtypes is missing in manpage +- PR#5397: Filename.temp_dir_name should be mutable +- PR#5410: fix printing of class application with Camlp4 +- PR#5416: (Windows) Unix.(set|clear)_close_on_exec now preserves blocking mode +- PR#5435: ocamlbuild does not find .opt executables on Windows +- PR#5436: update object ids on unmarshaling +- PR#5442: camlp4: quotation issue with strings +- PR#5453: configure doesn't find X11 under Ubuntu/MultiarchSpec +- PR#5461: Double linking of bytecode modules +- PR#5463: Bigarray.*.map_file fail if empty array is requested +- PR#5465: increase stack size of ocamlopt.opt for windows +- PR#5469: private record type generated by functor loses abbreviation +- PR#5475: Wrapper script for interpreted LablTk wrongly handles command line + parameters +- PR#5476: bug in native code compilation of let rec on float arrays +- PR#5477: use pkg-config to configure graphics on linux +- PR#5481: update camlp4 magic numbers +- PR#5482: remove bashism in test suite scripts +- PR#5495: camlp4o dies on infix definition (or) +- PR#5498: Unification with an empty object only checks the absence of + the first method +- PR#5503: error when ocamlbuild is passed an absolute path as build directory +- PR#5509: misclassification of statically-allocated empty array that + falls exactly at beginning of an otherwise unused data page. +- PR#5510: ocamldep has duplicate -ml{,i}-synonym options +- PR#5511: in Bigarray.reshape, unwarranted limitation on new array dimensions. +- PR#5513: Int64.div causes floating point exception (ocamlopt, x86) +- PR#5516: in Bigarray C stubs, use C99 flexible array types if possible +- PR#5518: segfault with lazy empty array +- PR#5531: Allow ocamlbuild to add ocamldoc flags through -docflag + and -docflags switches +- PR#5538: combining -i and -annot in ocamlc +- PR#5543: in Bigarray.map_file, try to avoid using lseek() when growing file +- PR#5648: (probably fixed) test failures in tests/lib-threads +- PR#5551: repeated calls to find_in_path degrade performance +- PR#5552: Mac OS X: unrecognized gcc option "-no-cpp-precomp" +- PR#5555: add Hashtbl.reset to resize the bucket table to its initial size +- PR#5560: incompatible type for tuple pattern with -principal +- PR#5575: Random states are not marshallable across architectures +- PR#5579: camlp4: when a plugin is loaded in the toplevel, + Token.Filter.define_filter has no effect before the first syntax error +- PR#5585: typo: "explicitely" +- PR#5587: documentation: "allows to" is not correct English +- PR#5593: remove C file when -output-obj fails +- PR#5597: register names for instrtrace primitives in embedded bytecode +- PR#5598: add backslash-space support in strings in ocamllex +- PR#5603: wrong .file debug info generated by ocamlopt -g +- PR#5604: fix permissions of files created by ocamlbuild itself +- PR#5610: new unmarshaler (from PR#5318) fails to freshen object identifiers +- PR#5614: add missing -linkall flag when compiling ocamldoc.opt +- PR#5616: move ocamlbuild documentation to the reference manual +- PR#5619: Uncaught CType.Unify exception in the compiler +- PR#5620: invalid printing of type manifest (camlp4 revised syntax) +- PR#5637: invalid printing of anonymous type parameters (camlp4 revised syntax) +- PR#5643: issues with .cfi and .loc directives generated by ocamlopt -g +- PR#5644: Stream.count broken when used with Sapp or Slazy nodes +- PR#5647: Cannot use install_printer in debugger +- PR#5651: printer for abstract data type (camlp4 revised syntax) +- PR#5654: self pattern variable location tweak +- PR#5655: ocamlbuild doesn't pass cflags when building C stubs +- PR#5657: wrong error location for abbreviated record fields +- PR#5659: ocamlmklib -L option breaks with MSVC +- PR#5661: fixes for the test suite +- PR#5668: Camlp4 produces invalid syntax for "let _ = ..." +- PR#5671: initialization of compare_ext field in caml_final_custom_operations() +- PR#5677: do not use "value" as identifier (genprintval.ml) +- PR#5687: dynlink broken when used from "output-obj" main program (bytecode) +- problem with printing of string literals in camlp4 (reported on caml-list) +- emacs mode: colorization of comments and strings now works correctly +- problem with forall and method (reported on caml-list on 2011-07-26) +- crash when using OCAMLRUNPARAM=a=X with invalid X (reported in private) + +Feature wishes: +- PR#352: new option "-stdin" to make ocaml read stdin as a script +- PR#1164: better error message when mixing -a and .cmxa +- PR#1284: documentation: remove restriction on mixed streams +- PR#1496: allow configuring LIBDIR, BINDIR, and MANDIR relative to $(PREFIX) +- PR#1835: add Digest.from_hex +- PR#1898: toplevel: add option to suppress continuation prompts +- PR#4278: configure: option to disable "graph" library +- PR#4444: new String.trim function, removing leading and trailing whistespace +- PR#4549: make Filename.dirname/basename POSIX compliant +- PR#4830: add option -v to expunge.ml +- PR#4898: new Sys.big_endian boolean for machine endianness +- PR#4963, PR#5467: no extern "C" into ocaml C-stub headers +- PR#5199: tests are run only for bytecode if either native support is missing, + or a non-empty value is set to "BYTECODE_ONLY" Makefile variable +- PR#5215: marshalling of dynlinked closure +- PR#5236: new '%revapply' primitive with the semantics 'revapply x f = f x', + and '%apply' with semantics 'apply f x = f x'. +- PR#5255: natdynlink detection on powerpc, hurd, sparc +- PR#5295: OS threads: problem with caml_c_thread_unregister() +- PR#5297: compiler now checks existence of builtin primitives +- PR#5329: (Windows) more efficient Unix.select if all fd's are sockets +- PR#5357: warning for useless open statements +- PR#5358: first class modules don't allow "with type" declarations for types + in sub-modules +- PR#5385: configure: emit a warning when MACOSX_DEPLOYMENT_TARGET is set +- PR#5396: ocamldep: add options -sort, -all, and -one-line +- PR#5397: Filename.temp_dir_name should be mutable +- PR#5403: give better error message when emacs is not found in PATH +- PR#5411: new directive for the toplevel: #load_rec +- PR#5420: Unix.openfile share mode (Windows) +- PR#5421: Unix: do not leak fds in various open_proc* functions +- PR#5434: implement Unix.times in win32unix (partially) +- PR#5438: new warnings for unused declarations +- PR#5439: upgrade config.guess and config.sub +- PR#5445 and others: better printing of types with user-provided names +- PR#5454: Digest.compare is missing and md5 doc update +- PR#5455: .emacs instructions, add lines to recognize ocaml scripts +- PR#5456: pa_macro: replace __LOCATION__ after macro expansion; add LOCATION_OF +- PR#5461: bytecode: emit warning when linking two modules with the same name +- PR#5478: ocamlopt assumes ar command exists +- PR#5479: Num.num_of_string may raise an exception, not reflected in the + documentation. +- PR#5501: increase IO_BUFFER_SIZE to 64KiB +- PR#5532: improve error message when bytecode file is wrong +- PR#5555: add function Hashtbl.reset to resize the bucket table to + its initial size. +- PR#5586: increase UNIX_BUFFER_SIZE to 64KiB +- PR#5597: register names for instrtrace primitives in embedded bytecode +- PR#5599: Add warn() tag in ocamlbuild to control -w compiler switch +- PR#5628: add #remove_directory and Topdirs.remove_directory to remove + a directory from the load path +- PR#5636: in system threads library, issue with linking of pthread_atfork +- PR#5666: C includes don't provide a revision number +- ocamldebug: ability to inspect values that contain code pointers +- ocamldebug: new 'environment' directive to set environment variables + for debuggee +- configure: add -no-camlp4 option + +Shedding weight: +* Removed the obsolete native-code generators for Alpha, HPPA, IA64 and MIPS. +* The "DBM" library (interface with Unix DBM key-value stores) is no + longer part of this distribution. It now lives its own life at + https://forge.ocamlcore.org/projects/camldbm/ +* The "OCamlWin" toplevel user interface for MS Windows is no longer + part of this distribution. It now lives its own life at + https://forge.ocamlcore.org/projects/ocamltopwin/ + +Other changes: +- Copy VERSION file to library directory when installing. + + +OCaml 3.12.1: +------------- Bug fixes: - PR#4345, PR#4767: problems with camlp4 printing of float values @@ -95,6 +880,7 @@ - Added new operation 'compare_ext' to custom blocks, called when comparing a custom block value with an unboxed integer. + Objective Caml 3.12.0: ---------------------- @@ -172,7 +958,7 @@ caused by the incomplete comparison of applicative paths F(X).t. Native-code compiler: -- AMD64: shorter and slightly more efficient code generated for +- AMD64: shorter and slightly more efficient code generated for float comparisons. Standard library: @@ -223,7 +1009,7 @@ - PR#5018: wrong exception raised by Dynlink.loadfile. - PR#5057: fatal typing error with local module + functor + polymorphic variant - Wrong type for Obj.add_offset. -- Small problem with the representation of Int32, Int64, and Nativeint constants. +- Small problem with representation of Int32, Int64, and Nativeint constants. - Use RTLD_LOCAL for native dynlink in private mode. Objective Caml 3.11.2: @@ -1320,7 +2106,7 @@ - Module Printf: added %S and %C formats (quoted, escaped strings and characters); added kprintf (calls user-specified continuation on formatted string). -- Module Queue: faster implementation (courtesy of François Pottier). +- Module Queue: faster implementation (courtesy of Francois Pottier). - Module Random: added Random.bool. - Module Stack: added Stack.is_empty. - Module Pervasives: @@ -2720,5 +3506,3 @@ ------------------------ * First public release. - -$Id: Changes 11110 2011-07-04 21:15:01Z doligez $ diff -Nru ocaml-3.12.1/INSTALL ocaml-4.01.0/INSTALL --- ocaml-3.12.1/INSTALL 2011-01-06 14:15:20.000000000 +0000 +++ ocaml-4.01.0/INSTALL 2013-08-23 06:22:36.000000000 +0000 @@ -1,5 +1,5 @@ - Installing Objective Caml on a Unix machine - ------------------------------------------- + Installing OCaml on a Unix machine + ---------------------------------- PREREQUISITES @@ -8,17 +8,6 @@ performance. gcc is the standard compiler under Linux, MacOS X, and many other systems. -* Under MacOS X 10.5, you need version 3.1 or later of the XCode - development tools. The version of XCode found on MacOS X 10.5 - installation media causes linking problems. XCode updates - are available free of charge at http://developer.apple.com/tools/xcode/ - -* Under MacOS X up to version 10.2.8, you must raise the limit on the - stack size with one of the following commands: - - limit stacksize 64M # if your shell is zsh or tcsh - ulimit -s 65536 # if your shell is bash - * If you do not have write access to /tmp, you should set the environment variable TMPDIR to the name of some other temporary directory. @@ -43,18 +32,21 @@ The "configure" script accepts the following options: --bindir (default: /usr/local/bin) - Directory where the binaries will be installed +-prefix (default: /usr/local) + Set the PREFIX variable used to define the defaults of the + following three options. Must be an absolute path name. --libdir (default: /usr/local/lib/ocaml) - Directory where the Caml library will be installed +-bindir (default: $(PREFIX)/bin) + Directory where the binaries will be installed. + Must be an absolute path name, or start with "$(PREFIX)" + +-libdir (default: $(PREFIX)/lib/ocaml) + Directory where the OCaml library will be installed + Must be an absolute path name, or start with "$(PREFIX)" --mandir (default: /usr/local/man/man1) +-mandir (default: $(PREFIX)/man/man1) Directory where the manual pages will be installed - --prefix (default: /usr/local) - Set bindir, libdir and mandir to - /bin, /lib/ocaml, /man/man1 respectively. + Must be an absolute path name, or start with "$(PREFIX)" -cc (default: gcc if available, cc otherwise) C compiler to use for building the system @@ -67,10 +59,11 @@ -host (default: determined automatically) The type of the host machine, in GNU's "configuration name" - format (CPU-COMPANY-SYSTEM). This info is generally determined - automatically by the "configure" script, and rarely ever - needs to be provided by hand. The installation instructions - for gcc or emacs contain a complete list of configuration names. + format (CPU-COMPANY-SYSTEM or CPU-COMPANY-KERNEL-SYSTEM). + This info is generally determined automatically by the + "configure" script, and rarely ever needs to be provided by + hand. The installation instructions for gcc or emacs contain a + complete list of configuration names. -x11include (default: determined automatically) -x11lib (default: determined automatically) @@ -119,10 +112,27 @@ run-time system manually written in assembly language. This assembler must preprocess its input with the C preprocessor. +-with-debug-runtime + Compile and install the debug version of the runtimes, useful + for debugging C stubs and other low-level code. + -verbose Verbose output of the configuration tests. Use it if the outcome of configure is not what you were expecting. +-no-camlp4 + Do not compile Camlp4. + +-no-graph + Do not compile the Graphics library. + +-partialld (default: determined automatically) + The linker and options to use for producing an object file + (rather than an executable) from several other object files. + +-no-cfi + Do not compile support for CFI directives. + Examples: Standard installation in /usr/{bin,lib,man} instead of /usr/local: @@ -130,6 +140,17 @@ Installation in /usr, man pages in section "l": ./configure -bindir /usr/bin -libdir /usr/lib/ocaml -mandir /usr/man/manl + or: + ./configure -prefix /usr -mandir '$(PREFIX)/man/manl' + + On a Linux x86/64 bits host, to build a 32-bit version of OCaml: + ./configure -cc "gcc -m32" -as "as --32" -aspp "gcc -m32 -c" \ + -host i386-linux -partialld "ld -r -melf_i386" + + On a Linux x86/64 bits host, to build the run-time system in PIC mode + (enables putting the runtime in a shared library, + at a small performance cost): + ./configure -cc "gcc -fPIC" -aspp "gcc -c -fPIC" On a MacOSX 10.5/Intel Core 2 or MacOSX 10.5/PowerPC host, to build a 64-bit version of OCaml: @@ -138,17 +159,12 @@ On a MacOSX 10.6/Intel Core 2, to build a 32-bit version of OCaml: ./configure -cc "gcc -m32" -as "as -arch i386" -aspp "gcc -m32 -c" - On a Linux x86/64 bits host, to build a 32-bit version of OCaml: - ./configure -cc "gcc -m32" -as "as --32" -aspp "gcc -m32 -c" - - On a Linux x86/64 bits host, to build the run-time system in PIC mode - (enables putting the runtime in a shared library, - at a small performance cost): - ./configure -cc "gcc -fPIC" -aspp "gcc -c -fPIC" - For Sun Solaris with the "acc" compiler: ./configure -cc "acc -fast" -libs "-lucb" + For Sun Solaris on Sparc 64bit, to compile natively (32bit only) + ./configure -cc "gcc -m32" -as "as -32" -aspp "gcc -m32 -c" + For AIX 4.3 with the IBM compiler xlc: ./configure -cc "xlc_r -D_AIX43 -Wl,-bexpall,-brtl -qmaxmem=8192" @@ -166,15 +182,15 @@ make world -This builds the Objective Caml bytecode compiler for the first time. -This phase is fairly verbose; consider redirecting the output to a file: +This builds the OCaml bytecode compiler for the first time. This +phase is fairly verbose; consider redirecting the output to a file: make world > log.world 2>&1 # in sh make world >& log.world # in csh 3- (Optional) To be sure everything works well, you can try to -bootstrap the system --- that is, to recompile all Objective Caml -sources with the newly created compiler. From the top directory, do: +bootstrap the system --- that is, to recompile all OCaml sources with +the newly created compiler. From the top directory, do: make bootstrap @@ -201,9 +217,9 @@ make opt > log.opt 2>&1 # in sh make opt >& log.opt # in csh -5- Compile fast versions of the Objective Caml compilers, by -compiling them with the native-code compiler (you have only compiled -them to bytecode so far). Just do: +5- Compile fast versions of the OCaml compilers, by compiling them +with the native-code compiler (you have only compiled them to bytecode +so far). Just do: make opt.opt @@ -222,7 +238,7 @@ The result is equivalent to "make world opt opt.opt", but this may fail if anything goes wrong in native-code generation. -6- You can now install the Objective Caml system. This will create the +6- You can now install the OCaml system. This will create the following commands (in the binary directory selected during autoconfiguration): @@ -233,9 +249,9 @@ ocamllex the lexer generator ocaml the interactive, toplevel-based system ocamlmktop a tool to make toplevel systems that integrate - user-defined C primitives and Caml code + user-defined C primitives and OCaml code ocamldebug the source-level replay debugger - ocamldep generator of "make" dependencies for Caml sources + ocamldep generator of "make" dependencies for OCaml sources ocamldoc documentation generator ocamlprof execution count profiler ocamlcp the bytecode compiler in profiling mode @@ -255,8 +271,8 @@ directory, do "make clean". 8- (Optional) The emacs/ subdirectory contains Emacs-Lisp files for an -Objective Caml editing mode and an interface for the debugger. To -install these files, change to the emacs/ subdirectory and do +OCaml editing mode and an interface for the debugger. To install +these files, change to the emacs/ subdirectory and do make EMACSDIR= install or @@ -267,7 +283,7 @@ 9- After installation, do *not* strip the ocamldebug and ocamlbrowser executables. (These are mixed-mode executables, containing both -compiled C code and Caml bytecode; stripping erases the bytecode!) +compiled C code and OCaml bytecode; stripping erases the bytecode!) Other executables such as ocamlrun can safely be stripped. IF SOMETHING GOES WRONG: @@ -324,3 +340,7 @@ unable to compile correctly the runtime system (wrong code is generated for (x - y) where x is a pointer and y an integer). Fix: use gcc. + +* Under MacOS X 10.6, with XCode 4.0.2, the configure script mistakenly +detects support for CFI directives in the assembler. +Fix: give the "-no-cfi" option to configure. diff -Nru ocaml-3.12.1/Makefile ocaml-4.01.0/Makefile --- ocaml-3.12.1/Makefile 2010-06-16 01:32:26.000000000 +0000 +++ ocaml-4.01.0/Makefile 2013-06-17 13:15:18.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -10,8 +10,6 @@ # # ######################################################################### -# $Id: Makefile 10566 2010-06-16 01:32:26Z garrigue $ - # The main Makefile include config/Makefile @@ -19,7 +17,7 @@ CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot CAMLOPT=boot/ocamlrun ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink -COMPFLAGS=-strict-sequence -warn-error A $(INCLUDES) +COMPFLAGS=-strict-sequence -w +33..39 -warn-error A $(INCLUDES) LINKFLAGS= CAMLYACC=boot/ocamlyacc @@ -31,6 +29,9 @@ SHELL=/bin/sh MKDIR=mkdir -p +CAMLP4OUT=$(CAMLP4:=out) +CAMLP4OPT=$(CAMLP4:=opt) + INCLUDES=-I utils -I parsing -I typing -I bytecomp -I asmcomp -I driver \ -I toplevel @@ -38,22 +39,23 @@ utils/clflags.cmo utils/terminfo.cmo utils/ccomp.cmo utils/warnings.cmo \ utils/consistbl.cmo -OPTUTILS=$(UTILS) - -PARSING=parsing/linenum.cmo parsing/location.cmo parsing/longident.cmo \ +PARSING=parsing/location.cmo parsing/longident.cmo \ parsing/syntaxerr.cmo parsing/parser.cmo \ - parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo + parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo \ + parsing/pprintast.cmo \ + parsing/ast_mapper.cmo -TYPING=typing/unused_var.cmo typing/ident.cmo typing/path.cmo \ +TYPING=typing/ident.cmo typing/path.cmo \ typing/primitive.cmo typing/types.cmo \ typing/btype.cmo typing/oprint.cmo \ typing/subst.cmo typing/predef.cmo \ - typing/datarepr.cmo typing/env.cmo \ - typing/typedtree.cmo typing/ctype.cmo \ + typing/datarepr.cmo typing/cmi_format.cmo typing/env.cmo \ + typing/typedtree.cmo typing/printtyped.cmo typing/ctype.cmo \ typing/printtyp.cmo typing/includeclass.cmo \ - typing/mtype.cmo typing/includecore.cmo \ - typing/includemod.cmo typing/parmatch.cmo \ - typing/typetexp.cmo typing/stypes.cmo typing/typecore.cmo \ + typing/mtype.cmo typing/envaux.cmo typing/includecore.cmo \ + typing/includemod.cmo typing/typetexp.cmo typing/parmatch.cmo \ + typing/typedtreeIter.cmo typing/typedtreeMap.cmo typing/cmt_format.cmo \ + typing/stypes.cmo typing/typecore.cmo \ typing/typedecl.cmo typing/typeclass.cmo \ typing/typemod.cmo @@ -61,17 +63,22 @@ bytecomp/typeopt.cmo bytecomp/switch.cmo bytecomp/matching.cmo \ bytecomp/translobj.cmo bytecomp/translcore.cmo \ bytecomp/translclass.cmo bytecomp/translmod.cmo \ - bytecomp/simplif.cmo bytecomp/runtimedef.cmo + bytecomp/simplif.cmo bytecomp/runtimedef.cmo \ + driver/pparse.cmo driver/main_args.cmo \ + driver/compenv.cmo driver/compmisc.cmo + +COMMON=$(UTILS) $(PARSING) $(TYPING) $(COMP) BYTECOMP=bytecomp/meta.cmo bytecomp/instruct.cmo bytecomp/bytegen.cmo \ bytecomp/printinstr.cmo bytecomp/opcodes.cmo bytecomp/emitcode.cmo \ bytecomp/bytesections.cmo bytecomp/dll.cmo bytecomp/symtable.cmo \ - bytecomp/bytelink.cmo bytecomp/bytelibrarian.cmo bytecomp/bytepackager.cmo + bytecomp/bytelink.cmo bytecomp/bytelibrarian.cmo bytecomp/bytepackager.cmo \ + driver/errors.cmo driver/compile.cmo ASMCOMP=asmcomp/arch.cmo asmcomp/debuginfo.cmo \ asmcomp/cmm.cmo asmcomp/printcmm.cmo \ asmcomp/reg.cmo asmcomp/mach.cmo asmcomp/proc.cmo \ - asmcomp/clambda.cmo asmcomp/compilenv.cmo \ + asmcomp/clambda.cmo asmcomp/printclambda.cmo asmcomp/compilenv.cmo \ asmcomp/closure.cmo asmcomp/cmmgen.cmo \ asmcomp/printmach.cmo asmcomp/selectgen.cmo asmcomp/selection.cmo \ asmcomp/comballoc.cmo asmcomp/liveness.cmo \ @@ -81,41 +88,22 @@ asmcomp/printlinear.cmo asmcomp/linearize.cmo \ asmcomp/schedgen.cmo asmcomp/scheduling.cmo \ asmcomp/emitaux.cmo asmcomp/emit.cmo asmcomp/asmgen.cmo \ - asmcomp/asmlink.cmo asmcomp/asmlibrarian.cmo asmcomp/asmpackager.cmo - -DRIVER=driver/pparse.cmo driver/errors.cmo driver/compile.cmo \ - driver/main_args.cmo driver/main.cmo + asmcomp/asmlink.cmo asmcomp/asmlibrarian.cmo asmcomp/asmpackager.cmo \ + driver/opterrors.cmo driver/optcompile.cmo -OPTDRIVER= driver/pparse.cmo driver/opterrors.cmo driver/optcompile.cmo \ - driver/main_args.cmo driver/optmain.cmo - -TOPLEVEL=driver/pparse.cmo driver/errors.cmo driver/compile.cmo \ - driver/main_args.cmo toplevel/genprintval.cmo toplevel/toploop.cmo \ +TOPLEVEL=toplevel/genprintval.cmo toplevel/toploop.cmo \ toplevel/trace.cmo toplevel/topdirs.cmo toplevel/topmain.cmo -TOPLEVELLIB=toplevel/toplevellib.cma -TOPLEVELSTART=toplevel/topstart.cmo - -COMPOBJS=$(UTILS) $(PARSING) $(TYPING) $(COMP) $(BYTECOMP) $(DRIVER) +BYTESTART=driver/main.cmo -TOPLIB=$(UTILS) $(PARSING) $(TYPING) $(COMP) $(BYTECOMP) $(TOPLEVEL) +OPTSTART=driver/optmain.cmo -TOPOBJS=$(TOPLEVELLIB) $(TOPLEVELSTART) +TOPLEVELSTART=toplevel/topstart.cmo -NATTOPOBJS=$(OPTUTILS) $(PARSING) $(TYPING) $(COMP) $(ASMCOMP) \ - driver/pparse.cmo driver/opterrors.cmo driver/optcompile.cmo \ - driver/main_args.cmo \ +NATTOPOBJS=$(UTILS) $(PARSING) $(TYPING) $(COMP) $(ASMCOMP) \ toplevel/genprintval.cmo toplevel/opttoploop.cmo toplevel/opttopdirs.cmo \ toplevel/opttopmain.cmo toplevel/opttopstart.cmo -OPTOBJS=$(OPTUTILS) $(PARSING) $(TYPING) $(COMP) $(ASMCOMP) $(OPTDRIVER) - -EXPUNGEOBJS=utils/misc.cmo utils/tbl.cmo \ - utils/config.cmo utils/clflags.cmo \ - typing/ident.cmo typing/path.cmo typing/types.cmo typing/btype.cmo \ - typing/predef.cmo bytecomp/runtimedef.cmo bytecomp/bytesections.cmo \ - bytecomp/dll.cmo bytecomp/meta.cmo bytecomp/symtable.cmo toplevel/expunge.cmo - PERVASIVES=$(STDLIB_MODULES) outcometree topdirs toploop # For users who don't read the INSTALL file @@ -123,14 +111,13 @@ @echo "Please refer to the installation instructions in file INSTALL." @echo "If you've just unpacked the distribution, something like" @echo " ./configure" - @echo " make world" - @echo " make opt" + @echo " make world.opt" @echo " make install" @echo "should work. But see the file INSTALL for more details." # Recompile the system using the bootstrap compiler all: runtime ocamlc ocamllex ocamlyacc ocamltools library ocaml \ - otherlibraries ocamlbuild.byte camlp4out $(DEBUGGER) ocamldoc + otherlibraries ocamlbuild.byte $(CAMLP4OUT) $(DEBUGGER) ocamldoc # Compile everything the first time world: @@ -259,27 +246,34 @@ $(MAKE) ocamlopt $(MAKE) libraryopt $(MAKE) otherlibrariesopt + $(MAKE) ocamltoolsopt $(MAKE) ocamlbuildlib.native # Native-code versions of the tools opt.opt: checkstack runtime core ocaml opt-core ocamlc.opt otherlibraries \ - ocamlbuild.byte camlp4out $(DEBUGGER) ocamldoc ocamlopt.opt \ - otherlibrariesopt \ - ocamllex.opt ocamltoolsopt.opt ocamlbuild.native camlp4opt ocamldoc.opt + $(DEBUGGER) ocamldoc ocamlbuild.byte $(CAMLP4OUT) \ + ocamlopt.opt otherlibrariesopt ocamllex.opt \ + ocamltoolsopt ocamltoolsopt.opt ocamldoc.opt ocamlbuild.native \ + $(CAMLP4OPT) base.opt: checkstack runtime core ocaml opt-core ocamlc.opt otherlibraries \ - ocamlbuild.byte camlp4out $(DEBUGGER) ocamldoc ocamlopt.opt \ + ocamlbuild.byte $(CAMLP4OUT) $(DEBUGGER) ocamldoc ocamlopt.opt \ otherlibrariesopt # Installation + +COMPLIBDIR=$(LIBDIR)/compiler-libs + install: if test -d $(BINDIR); then : ; else $(MKDIR) $(BINDIR); fi if test -d $(LIBDIR); then : ; else $(MKDIR) $(LIBDIR); fi if test -d $(STUBLIBDIR); then : ; else $(MKDIR) $(STUBLIBDIR); fi + if test -d $(COMPLIBDIR); then : ; else $(MKDIR) $(COMPLIBDIR); fi if test -d $(MANDIR)/man$(MANEXT); then : ; \ else $(MKDIR) $(MANDIR)/man$(MANEXT); fi + cp VERSION $(LIBDIR)/ cd $(LIBDIR); rm -f dllbigarray.so dlllabltk.so dllnums.so \ - dllthreads.so dllunix.so dllgraphics.so dllmldbm.so dllstr.so \ + dllthreads.so dllunix.so dllgraphics.so dllstr.so \ dlltkanim.so cd byterun; $(MAKE) install cp ocamlc $(BINDIR)/ocamlc$(EXE) @@ -287,12 +281,13 @@ cd stdlib; $(MAKE) install cp lex/ocamllex $(BINDIR)/ocamllex$(EXE) cp yacc/ocamlyacc$(EXE) $(BINDIR)/ocamlyacc$(EXE) - cp toplevel/toplevellib.cma $(LIBDIR)/toplevellib.cma + cp utils/*.cmi parsing/*.cmi typing/*.cmi bytecomp/*.cmi driver/*.cmi \ + toplevel/*.cmi $(COMPLIBDIR) + cp compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma \ + compilerlibs/ocamltoplevel.cma $(BYTESTART) $(TOPLEVELSTART) \ + $(COMPLIBDIR) cp expunge $(LIBDIR)/expunge$(EXE) - cp typing/outcometree.cmi typing/outcometree.mli $(LIBDIR) - cp toplevel/topstart.cmo $(LIBDIR) - cp toplevel/toploop.cmi toplevel/topdirs.cmi toplevel/topmain.cmi \ - $(LIBDIR) + cp toplevel/topdirs.cmi $(LIBDIR) cd tools; $(MAKE) install -cd man; $(MAKE) install for i in $(OTHERLIBRARIES); do \ @@ -311,33 +306,60 @@ cd asmrun; $(MAKE) install cp ocamlopt $(BINDIR)/ocamlopt$(EXE) cd stdlib; $(MAKE) installopt + cp asmcomp/*.cmi $(COMPLIBDIR) + cp compilerlibs/ocamloptcomp.cma $(OPTSTART) $(COMPLIBDIR) cd ocamldoc; $(MAKE) installopt for i in $(OTHERLIBRARIES); \ do (cd otherlibs/$$i; $(MAKE) installopt) || exit $$?; done - if test -f ocamlc.opt; \ - then cp ocamlc.opt $(BINDIR)/ocamlc.opt$(EXE); else :; fi - if test -f ocamlopt.opt; \ - then cp ocamlopt.opt $(BINDIR)/ocamlopt.opt$(EXE); else :; fi - if test -f lex/ocamllex.opt; \ - then cp lex/ocamllex.opt $(BINDIR)/ocamllex.opt$(EXE); else :; fi + if test -f ocamlopt.opt ; then $(MAKE) installoptopt; fi + cd tools; $(MAKE) installopt + +installoptopt: + cp ocamlc.opt $(BINDIR)/ocamlc.opt$(EXE) + cp ocamlopt.opt $(BINDIR)/ocamlopt.opt$(EXE) + cp lex/ocamllex.opt $(BINDIR)/ocamllex.opt$(EXE) + cp compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlcommon.a \ + compilerlibs/ocamlbytecomp.cmxa compilerlibs/ocamlbytecomp.a \ + compilerlibs/ocamloptcomp.cmxa compilerlibs/ocamloptcomp.a \ + $(BYTESTART:.cmo=.cmx) $(BYTESTART:.cmo=.o) \ + $(OPTSTART:.cmo=.cmx) $(OPTSTART:.cmo=.o) \ + $(COMPLIBDIR) + cd $(COMPLIBDIR) && $(RANLIB) ocamlcommon.a ocamlbytecomp.a \ + ocamloptcomp.a clean:: partialclean -# The compiler +# Shared parts of the system + +compilerlibs/ocamlcommon.cma: $(COMMON) + $(CAMLC) -a -o $@ $(COMMON) +partialclean:: + rm -f compilerlibs/ocamlcommon.cma + +# The bytecode compiler + +compilerlibs/ocamlbytecomp.cma: $(BYTECOMP) + $(CAMLC) -a -o $@ $(BYTECOMP) +partialclean:: + rm -f compilerlibs/ocamlbytecomp.cma -ocamlc: $(COMPOBJS) - $(CAMLC) $(LINKFLAGS) -o ocamlc $(COMPOBJS) +ocamlc: compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma $(BYTESTART) + $(CAMLC) $(LINKFLAGS) -compat-32 -o ocamlc \ + compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma $(BYTESTART) @sed -e 's|@compiler@|$$topdir/boot/ocamlrun $$topdir/ocamlc|' \ driver/ocamlcomp.sh.in > ocamlcomp.sh @chmod +x ocamlcomp.sh -partialclean:: - rm -f ocamlc ocamlcomp.sh - # The native-code compiler -ocamlopt: $(OPTOBJS) - $(CAMLC) $(LINKFLAGS) -o ocamlopt $(OPTOBJS) +compilerlibs/ocamloptcomp.cma: $(ASMCOMP) + $(CAMLC) -a -o $@ $(ASMCOMP) +partialclean:: + rm -f compilerlibs/ocamloptcomp.cma + +ocamlopt: compilerlibs/ocamlcommon.cma compilerlibs/ocamloptcomp.cma $(OPTSTART) + $(CAMLC) $(LINKFLAGS) -o ocamlopt \ + compilerlibs/ocamlcommon.cma compilerlibs/ocamloptcomp.cma $(OPTSTART) @sed -e 's|@compiler@|$$topdir/boot/ocamlrun $$topdir/ocamlopt|' \ driver/ocamlcomp.sh.in > ocamlcompopt.sh @chmod +x ocamlcompopt.sh @@ -347,16 +369,21 @@ # The toplevel -ocaml: $(TOPOBJS) expunge - $(CAMLC) $(LINKFLAGS) -linkall -o ocaml.tmp $(TOPOBJS) +compilerlibs/ocamltoplevel.cma: $(TOPLEVEL) + $(CAMLC) -a -o $@ $(TOPLEVEL) +partialclean:: + rm -f compilerlibs/ocamltoplevel.cma + +ocaml: compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma \ + compilerlibs/ocamltoplevel.cma $(TOPLEVELSTART) expunge + $(CAMLC) $(LINKFLAGS) -linkall -o ocaml.tmp \ + compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma \ + compilerlibs/ocamltoplevel.cma $(TOPLEVELSTART) - $(CAMLRUN) ./expunge ocaml.tmp ocaml $(PERVASIVES) rm -f ocaml.tmp -toplevel/toplevellib.cma: $(TOPLIB) - $(CAMLC) -a -o $@ $(TOPLIB) - partialclean:: - rm -f ocaml toplevel/toplevellib.cma + rm -f ocaml # The native toplevel @@ -367,7 +394,7 @@ toplevel/opttoploop.cmx: otherlibs/dynlink/dynlink.cmxa otherlibs/dynlink/dynlink.cmxa: otherlibs/dynlink/natdynlink.ml - cd otherlibs/dynlink && make allopt + cd otherlibs/dynlink && $(MAKE) allopt # The configuration file @@ -382,6 +409,7 @@ -e 's|%%BYTECCLIBS%%|$(BYTECCLIBS)|' \ -e 's|%%NATIVECCLIBS%%|$(NATIVECCLIBS)|' \ -e 's|%%RANLIBCMD%%|$(RANLIBCMD)|' \ + -e 's|%%ARCMD%%|$(ARCMD)|' \ -e 's|%%CC_PROFILE%%|$(CC_PROFILE)|' \ -e 's|%%ARCH%%|$(ARCH)|' \ -e 's|%%MODEL%%|$(MODEL)|' \ @@ -392,6 +420,8 @@ -e 's|%%EXT_DLL%%|.so|' \ -e 's|%%SYSTHREAD_SUPPORT%%|$(SYSTHREAD_SUPPORT)|' \ -e 's|%%ASM%%|$(ASM)|' \ + -e 's|%%ASM_CFI_SUPPORTED%%|$(ASM_CFI_SUPPORTED)|' \ + -e 's|%%WITH_FRAME_POINTERS%%|$(WITH_FRAME_POINTERS)|' \ -e 's|%%MKDLL%%|$(MKDLL)|' \ -e 's|%%MKEXE%%|$(MKEXE)|' \ -e 's|%%MKMAINDLL%%|$(MKMAINDLL)|' \ @@ -423,23 +453,25 @@ beforedepend:: parsing/lexer.ml -# The auxiliary lexer for counting line numbers - -parsing/linenum.ml: parsing/linenum.mll - $(CAMLLEX) parsing/linenum.mll +# Shared parts of the system compiled with the native-code compiler +compilerlibs/ocamlcommon.cmxa: $(COMMON:.cmo=.cmx) + $(CAMLOPT) -a -o $@ $(COMMON:.cmo=.cmx) partialclean:: - rm -f parsing/linenum.ml - -beforedepend:: parsing/linenum.ml + rm -f compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlcommon.a # The bytecode compiler compiled with the native-code compiler -ocamlc.opt: $(COMPOBJS:.cmo=.cmx) - cd asmrun; $(MAKE) meta.o dynlink.o +compilerlibs/ocamlbytecomp.cmxa: $(BYTECOMP:.cmo=.cmx) + $(CAMLOPT) -a -o $@ $(BYTECOMP:.cmo=.cmx) +partialclean:: + rm -f compilerlibs/ocamlbytecomp.cmxa compilerlibs/ocamlbytecomp.a + +ocamlc.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlbytecomp.cmxa \ + $(BYTESTART:.cmo=.cmx) $(CAMLOPT) $(LINKFLAGS) -ccopt "$(BYTECCLINKOPTS)" -o ocamlc.opt \ - $(COMPOBJS:.cmo=.cmx) \ - asmrun/meta.o asmrun/dynlink.o -cclib "$(BYTECCLIBS)" + compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlbytecomp.cmxa \ + $(BYTESTART:.cmo=.cmx) -cclib "$(BYTECCLIBS)" @sed -e 's|@compiler@|$$topdir/ocamlc.opt|' \ driver/ocamlcomp.sh.in > ocamlcomp.sh @chmod +x ocamlcomp.sh @@ -449,8 +481,16 @@ # The native-code compiler compiled with itself -ocamlopt.opt: $(OPTOBJS:.cmo=.cmx) - $(CAMLOPT) $(LINKFLAGS) -o ocamlopt.opt $(OPTOBJS:.cmo=.cmx) +compilerlibs/ocamloptcomp.cmxa: $(ASMCOMP:.cmo=.cmx) + $(CAMLOPT) -a -o $@ $(ASMCOMP:.cmo=.cmx) +partialclean:: + rm -f compilerlibs/ocamloptcomp.cmxa compilerlibs/ocamloptcomp.a + +ocamlopt.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \ + $(OPTSTART:.cmo=.cmx) + $(CAMLOPT) $(LINKFLAGS) -o ocamlopt.opt \ + compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \ + $(OPTSTART:.cmo=.cmx) @sed -e 's|@compiler@|$$topdir/ocamlopt.opt|' \ driver/ocamlcomp.sh.in > ocamlcompopt.sh @chmod +x ocamlcompopt.sh @@ -458,7 +498,7 @@ partialclean:: rm -f ocamlopt.opt -$(OPTOBJS:.cmo=.cmx): ocamlopt +$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(ASMCOMP:.cmo=.cmx): ocamlopt # The numeric opcodes @@ -549,8 +589,10 @@ # The "expunge" utility -expunge: $(EXPUNGEOBJS) - $(CAMLC) $(LINKFLAGS) -o expunge $(EXPUNGEOBJS) +expunge: compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma \ + toplevel/expunge.cmo + $(CAMLC) $(LINKFLAGS) -o expunge compilerlibs/ocamlcommon.cma \ + compilerlibs/ocamlbytecomp.cma toplevel/expunge.cmo partialclean:: rm -f expunge @@ -627,6 +669,9 @@ ocamltools: ocamlc ocamlyacc ocamllex asmcomp/cmx_format.cmi cd tools; $(MAKE) all +ocamltoolsopt: ocamlopt + cd tools; $(MAKE) opt + ocamltoolsopt.opt: ocamlc.opt ocamlyacc ocamllex asmcomp/cmx_format.cmi cd tools; $(MAKE) opt.opt @@ -686,27 +731,32 @@ # Camlp4 -camlp4out: ocamlc otherlibraries ocamlbuild-mixed-boot ocamlbuild.byte +camlp4out: ocamlc ocamlbuild.byte ./build/camlp4-byte-only.sh camlp4opt: ocamlopt otherlibrariesopt ocamlbuild-mixed-boot ocamlbuild.native ./build/camlp4-native-only.sh # Ocamlbuild - -ocamlbuild.byte: ocamlc otherlibraries ocamlbuild-mixed-boot +#ifeq ($(OCAMLBUILD_NOBOOT),"yes") +#ocamlbuild.byte: ocamlc +# $(MAKE) -C ocamlbuild -f Makefile.noboot +#else +ocamlbuild.byte: ocamlc ocamlbuild-mixed-boot ./build/ocamlbuild-byte-only.sh +#endif -ocamlbuild.native: ocamlopt otherlibrariesopt ocamlbuild-mixed-boot +ocamlbuild.native: ocamlopt ocamlbuild-mixed-boot otherlibrariesopt ./build/ocamlbuild-native-only.sh -ocamlbuildlib.native: ocamlopt otherlibrariesopt ocamlbuild-mixed-boot +ocamlbuildlib.native: ocamlopt ocamlbuild-mixed-boot otherlibrariesopt ./build/ocamlbuildlib-native-only.sh -ocamlbuild-mixed-boot: ocamlc otherlibraries +ocamlbuild-mixed-boot: ocamlc ./build/mixed-boot.sh + touch ocamlbuild-mixed-boot partialclean:: - rm -rf _build + rm -rf _build ocamlbuild-mixed-boot # Check that the stack limit is reasonable. @@ -717,11 +767,16 @@ fi @rm -f tools/checkstack +# Make clean in the test suite + +clean:: + cd testsuite; $(MAKE) clean + # Make MacOS X package package-macosx: sudo rm -rf package-macosx/root - make PREFIX="`pwd`"/package-macosx/root install + $(MAKE) PREFIX="`pwd`"/package-macosx/root install tools/make-package-macosx sudo rm -rf package-macosx/root @@ -755,15 +810,16 @@ distclean: ./build/distclean.sh + rm -f ocaml ocamlcomp.sh testsuite/_log .PHONY: all backup bootstrap camlp4opt camlp4out checkstack clean .PHONY: partialclean beforedepend alldepend cleanboot coldstart .PHONY: compare core coreall .PHONY: coreboot defaultentry depend distclean install installopt -.PHONY: library library-cross libraryopt ocamlbuild-mixed-boot +.PHONY: library library-cross libraryopt .PHONY: ocamlbuild.byte ocamlbuild.native ocamldebugger ocamldoc -.PHONY: ocamldoc.opt ocamllex ocamllex.opt ocamltools ocamltools.opt -.PHONY: ocamlyacc opt-core opt opt.opt otherlibraries +.PHONY: ocamldoc.opt ocamllex ocamllex.opt ocamltools ocamltoolsopt +.PHONY: ocamltoolsopt.opt ocamlyacc opt-core opt opt.opt otherlibraries .PHONY: otherlibrariesopt package-macosx promote promote-cross .PHONY: restore runtime runtimeopt makeruntimeopt world world.opt diff -Nru ocaml-3.12.1/Makefile.nt ocaml-4.01.0/Makefile.nt --- ocaml-3.12.1/Makefile.nt 2010-07-06 10:02:53.000000000 +0000 +++ ocaml-4.01.0/Makefile.nt 2013-06-05 16:34:40.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -10,8 +10,6 @@ # # ######################################################################### -# $Id: Makefile.nt 10616 2010-07-06 10:02:53Z doligez $ - # The main Makefile include config/Makefile @@ -28,6 +26,9 @@ DEPFLAGS=$(INCLUDES) CAMLRUN=byterun/ocamlrun +CAMLP4OUT=$(CAMLP4:=out) +CAMLP4OPT=$(CAMLP4:=opt) + INCLUDES=-I utils -I parsing -I typing -I bytecomp -I asmcomp -I driver \ -I toplevel @@ -35,22 +36,23 @@ utils/clflags.cmo utils/terminfo.cmo utils/ccomp.cmo utils/warnings.cmo \ utils/consistbl.cmo -OPTUTILS=$(UTILS) - -PARSING=parsing/linenum.cmo parsing/location.cmo parsing/longident.cmo \ +PARSING=parsing/location.cmo parsing/longident.cmo \ parsing/syntaxerr.cmo parsing/parser.cmo \ - parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo + parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo \ + parsing/pprintast.cmo \ + parsing/ast_mapper.cmo -TYPING=typing/unused_var.cmo typing/ident.cmo typing/path.cmo \ +TYPING=typing/ident.cmo typing/path.cmo \ typing/primitive.cmo typing/types.cmo \ typing/btype.cmo typing/oprint.cmo \ typing/subst.cmo typing/predef.cmo \ - typing/datarepr.cmo typing/env.cmo \ - typing/typedtree.cmo typing/ctype.cmo \ + typing/datarepr.cmo typing/cmi_format.cmo typing/env.cmo \ + typing/typedtree.cmo typing/printtyped.cmo typing/ctype.cmo \ typing/printtyp.cmo typing/includeclass.cmo \ - typing/mtype.cmo typing/includecore.cmo \ - typing/includemod.cmo typing/parmatch.cmo \ - typing/typetexp.cmo typing/stypes.cmo typing/typecore.cmo \ + typing/mtype.cmo typing/envaux.cmo typing/includecore.cmo \ + typing/includemod.cmo typing/typetexp.cmo typing/parmatch.cmo \ + typing/typedtreeIter.cmo typing/typedtreeMap.cmo typing/cmt_format.cmo \ + typing/stypes.cmo typing/typecore.cmo \ typing/typedecl.cmo typing/typeclass.cmo \ typing/typemod.cmo @@ -58,17 +60,22 @@ bytecomp/typeopt.cmo bytecomp/switch.cmo bytecomp/matching.cmo \ bytecomp/translobj.cmo bytecomp/translcore.cmo \ bytecomp/translclass.cmo bytecomp/translmod.cmo \ - bytecomp/simplif.cmo bytecomp/runtimedef.cmo + bytecomp/simplif.cmo bytecomp/runtimedef.cmo \ + driver/pparse.cmo driver/main_args.cmo \ + driver/compenv.cmo driver/compmisc.cmo + +COMMON=$(UTILS) $(PARSING) $(TYPING) $(COMP) BYTECOMP=bytecomp/meta.cmo bytecomp/instruct.cmo bytecomp/bytegen.cmo \ bytecomp/printinstr.cmo bytecomp/opcodes.cmo bytecomp/emitcode.cmo \ bytecomp/bytesections.cmo bytecomp/dll.cmo bytecomp/symtable.cmo \ - bytecomp/bytelink.cmo bytecomp/bytelibrarian.cmo bytecomp/bytepackager.cmo + bytecomp/bytelink.cmo bytecomp/bytelibrarian.cmo bytecomp/bytepackager.cmo \ + driver/errors.cmo driver/compile.cmo ASMCOMP=asmcomp/arch.cmo asmcomp/debuginfo.cmo \ asmcomp/cmm.cmo asmcomp/printcmm.cmo \ asmcomp/reg.cmo asmcomp/mach.cmo asmcomp/proc.cmo \ - asmcomp/clambda.cmo asmcomp/compilenv.cmo \ + asmcomp/clambda.cmo asmcomp/printclambda.cmo asmcomp/compilenv.cmo \ asmcomp/closure.cmo asmcomp/cmmgen.cmo \ asmcomp/printmach.cmo asmcomp/selectgen.cmo asmcomp/selection.cmo \ asmcomp/comballoc.cmo asmcomp/liveness.cmo \ @@ -78,50 +85,27 @@ asmcomp/printlinear.cmo asmcomp/linearize.cmo \ asmcomp/schedgen.cmo asmcomp/scheduling.cmo \ asmcomp/emitaux.cmo asmcomp/emit.cmo asmcomp/asmgen.cmo \ - asmcomp/asmlink.cmo asmcomp/asmlibrarian.cmo asmcomp/asmpackager.cmo - -DRIVER=driver/pparse.cmo driver/errors.cmo driver/compile.cmo \ - driver/main_args.cmo driver/main.cmo + asmcomp/asmlink.cmo asmcomp/asmlibrarian.cmo asmcomp/asmpackager.cmo \ + driver/opterrors.cmo driver/optcompile.cmo -OPTDRIVER=driver/pparse.cmo driver/opterrors.cmo driver/optcompile.cmo \ - driver/main_args.cmo driver/optmain.cmo - -TOPLEVEL=driver/pparse.cmo driver/errors.cmo driver/compile.cmo \ - driver/main_args.cmo toplevel/genprintval.cmo toplevel/toploop.cmo \ +TOPLEVEL=toplevel/genprintval.cmo toplevel/toploop.cmo \ toplevel/trace.cmo toplevel/topdirs.cmo toplevel/topmain.cmo -TOPLEVELLIB=toplevel/toplevellib.cma -TOPLEVELSTART=toplevel/topstart.cmo - -COMPOBJS=$(UTILS) $(PARSING) $(TYPING) $(COMP) $(BYTECOMP) $(DRIVER) - -TOPLIB=$(UTILS) $(PARSING) $(TYPING) $(COMP) $(BYTECOMP) $(TOPLEVEL) +BYTESTART=driver/main.cmo -TOPOBJS=$(TOPLEVELLIB) $(TOPLEVELSTART) +OPTSTART=driver/optmain.cmo -NATTOPOBJS=$(OPTUTILS) $(PARSING) $(TYPING) $(COMP) $(ASMCOMP) \ - driver/pparse.cmo driver/opterrors.cmo driver/optcompile.cmo \ - driver/main_args.cmo \ - toplevel/genprintval.cmo toplevel/opttoploop.cmo toplevel/opttopdirs.cmo \ - toplevel/opttopmain.cmo toplevel/opttopstart.cmo - -OPTOBJS=$(OPTUTILS) $(PARSING) $(TYPING) $(COMP) $(ASMCOMP) $(OPTDRIVER) - -EXPUNGEOBJS=utils/misc.cmo utils/tbl.cmo \ - utils/config.cmo utils/clflags.cmo \ - typing/ident.cmo typing/path.cmo typing/types.cmo typing/btype.cmo \ - typing/predef.cmo bytecomp/runtimedef.cmo bytecomp/bytesections.cmo \ - bytecomp/dll.cmo \ - bytecomp/symtable.cmo toplevel/expunge.cmo +TOPLEVELSTART=toplevel/topstart.cmo -PERVASIVES=$(STDLIB_MODULES) topdirs toploop outcometree +PERVASIVES=$(STDLIB_MODULES) outcometree topdirs toploop # For users who don't read the INSTALL file defaultentry: @echo "Please refer to the installation instructions in file README.win32." # Recompile the system using the bootstrap compiler -all: runtime ocamlc ocamllex ocamlyacc ocamltools library ocaml otherlibraries ocamldoc.byte ocamlbuild.byte camlp4out $(DEBUGGER) win32gui +all: runtime ocamlc ocamllex ocamlyacc ocamltools library ocaml \ + otherlibraries ocamldoc.byte ocamlbuild.byte $(CAMLP4OUT) $(DEBUGGER) # The compilation of ocaml will fail if the runtime has changed. # Never mind, just do make bootstrap to reach fixpoint again. @@ -211,35 +195,40 @@ # Native-code versions of the tools opt.opt: core opt-core ocamlc.opt all ocamlopt.opt ocamllex.opt \ - ocamltoolsopt.opt ocamlbuild.native camlp4opt ocamldoc.opt + ocamltoolsopt.opt ocamlbuild.native $(CAMLP4OPT) ocamldoc.opt # Complete build using fast compilers world.opt: coldstart opt.opt # Installation + +COMPLIBDIR=$(LIBDIR)/compiler-libs + install: installbyt installopt installbyt: mkdir -p $(BINDIR) mkdir -p $(LIBDIR) + mkdir -p $(COMPLIBDIR) cd byterun ; $(MAKEREC) install cp ocamlc $(BINDIR)/ocamlc.exe cp ocaml $(BINDIR)/ocaml.exe cd stdlib ; $(MAKEREC) install cp lex/ocamllex $(BINDIR)/ocamllex.exe cp yacc/ocamlyacc.exe $(BINDIR)/ocamlyacc.exe - cp toplevel/toplevellib.cma $(LIBDIR)/toplevellib.cma + cp utils/*.cmi parsing/*.cmi typing/*.cmi bytecomp/*.cmi driver/*.cmi \ + toplevel/*.cmi $(COMPLIBDIR) + cp compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma \ + compilerlibs/ocamltoplevel.cma $(BYTESTART) $(TOPLEVELSTART) \ + $(COMPLIBDIR) cp expunge $(LIBDIR)/expunge.exe - cp typing/outcometree.cmi typing/outcometree.mli $(LIBDIR) - cp toplevel/topstart.cmo $(LIBDIR) - cp toplevel/toploop.cmi toplevel/topdirs.cmi toplevel/topmain.cmi $(LIBDIR) + cp toplevel/topdirs.cmi $(LIBDIR) cd tools ; $(MAKEREC) install cd ocamldoc ; $(MAKEREC) install mkdir -p $(STUBLIBDIR) for i in $(OTHERLIBRARIES); do $(MAKEREC) -C otherlibs/$$i install; done if test -f debugger/ocamldebug.exe; then (cd debugger; $(MAKEREC) install); \ else :; fi - cd win32caml ; $(MAKE) install ./build/partial-install.sh cp config/Makefile $(LIBDIR)/Makefile.config cp README $(DISTRIB)/Readme.general.txt @@ -252,61 +241,94 @@ cd asmrun ; $(MAKEREC) install cp ocamlopt $(BINDIR)/ocamlopt.exe cd stdlib ; $(MAKEREC) installopt + cp asmcomp/*.cmi driver/*.cmi $(COMPLIBDIR) + cp compilerlibs/ocamloptcomp.cma $(OPTSTART) $(COMPLIBDIR) cd ocamldoc ; $(MAKEREC) installopt for i in $(OTHERLIBRARIES); do $(MAKEREC) -C otherlibs/$$i installopt; done - if test -f ocamlc.opt; \ - then cp ocamlc.opt $(BINDIR)/ocamlc.opt.exe; else :; fi - if test -f ocamlopt.opt; \ - then cp ocamlopt.opt $(BINDIR)/ocamlopt.opt.exe; else :; fi - if test -f lex/ocamllex.opt; \ - then cp lex/ocamllex.opt $(BINDIR)/ocamllex.opt.exe; else :; fi + if test -f ocamlopt.opt ; then $(MAKEREC) installoptopt; fi + +installoptopt: + cp ocamlc.opt $(BINDIR)/ocamlc.opt$(EXE) + cp ocamlopt.opt $(BINDIR)/ocamlopt.opt$(EXE) + cp lex/ocamllex.opt $(BINDIR)/ocamllex.opt$(EXE) + cp compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlcommon.$(A) \ + compilerlibs/ocamlbytecomp.cmxa compilerlibs/ocamlbytecomp.$(A) \ + compilerlibs/ocamloptcomp.cmxa compilerlibs/ocamloptcomp.$(A) \ + $(BYTESTART:.cmo=.cmx) $(BYTESTART:.cmo=.$(O)) \ + $(OPTSTART:.cmo=.cmx) $(OPTSTART:.cmo=.$(O)) \ + $(COMPLIBDIR) clean:: partialclean # The compiler -ocamlc: $(COMPOBJS) - $(CAMLC) $(LINKFLAGS) -o ocamlc $(COMPOBJS) +compilerlibs/ocamlcommon.cma: $(COMMON) + $(CAMLC) -a -o $@ $(COMMON) +partialclean:: + rm -f compilerlibs/ocamlcommon.cma + +# The bytecode compiler + +compilerlibs/ocamlbytecomp.cma: $(BYTECOMP) + $(CAMLC) -a -o $@ $(BYTECOMP) +partialclean:: + rm -f compilerlibs/ocamlbytecomp.cma + +ocamlc: compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma $(BYTESTART) + $(CAMLC) $(LINKFLAGS) -compat-32 -o ocamlc compilerlibs/ocamlcommon.cma \ + compilerlibs/ocamlbytecomp.cma $(BYTESTART) @sed -e 's|@compiler@|$$topdir/boot/ocamlrun $$topdir/ocamlc|' \ driver/ocamlcomp.sh.in > ocamlcomp.sh @chmod +x ocamlcomp.sh partialclean:: - rm -f ocamlc + rm -f ocamlc ocamlcomp.sh # The native-code compiler -ocamlopt: $(OPTOBJS) - $(CAMLC) $(LINKFLAGS) -o ocamlopt $(OPTOBJS) +compilerlibs/ocamloptcomp.cma: $(ASMCOMP) + $(CAMLC) -a -o $@ $(ASMCOMP) +partialclean:: + rm -f compilerlibs/ocamloptcomp.cma + +ocamlopt: compilerlibs/ocamlcommon.cma compilerlibs/ocamloptcomp.cma $(OPTSTART) + $(CAMLC) $(LINKFLAGS) -o ocamlopt \ + compilerlibs/ocamlcommon.cma compilerlibs/ocamloptcomp.cma $(OPTSTART) @sed -e 's|@compiler@|$$topdir/boot/ocamlrun $$topdir/ocamlopt|' \ driver/ocamlcomp.sh.in > ocamlcompopt.sh @chmod +x ocamlcompopt.sh partialclean:: - rm -f ocamlopt + rm -f ocamlopt ocamlcompopt.sh # The toplevel -ocaml: $(TOPOBJS) expunge - $(CAMLC) $(LINKFLAGS) -linkall -o ocaml.tmp $(TOPOBJS) +compilerlibs/ocamltoplevel.cma: $(TOPLEVEL) + $(CAMLC) -a -o $@ $(TOPLEVEL) +partialclean:: + rm -f compilerlibs/ocamltoplevel.cma + +ocaml: compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma \ + compilerlibs/ocamltoplevel.cma $(TOPLEVELSTART) expunge + $(CAMLC) $(LINKFLAGS) -linkall -o ocaml.tmp \ + compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma \ + compilerlibs/ocamltoplevel.cma $(TOPLEVELSTART) - $(CAMLRUN) ./expunge ocaml.tmp ocaml $(PERVASIVES) rm -f ocaml.tmp -toplevel/toplevellib.cma: $(TOPLIB) - $(CAMLC) -a -o $@ $(TOPLIB) - partialclean:: rm -f ocaml # The native toplevel ocamlnat: ocamlopt otherlibs/dynlink/dynlink.cmxa $(NATTOPOBJS:.cmo=.cmx) - $(CAMLOPT) $(LINKFLAGS) otherlibs/dynlink/dynlink.cmxa -o ocamlnat $(NATTOPOBJS:.cmo=.cmx) -linkall + $(CAMLOPT) $(LINKFLAGS) otherlibs/dynlink/dynlink.cmxa -o ocamlnat \ + $(NATTOPOBJS:.cmo=.cmx) -linkall toplevel/opttoploop.cmx: otherlibs/dynlink/dynlink.cmxa otherlibs/dynlink/dynlink.cmxa: otherlibs/dynlink/natdynlink.ml - cd otherlibs/dynlink && make allopt + cd otherlibs/dynlink && $(MAKE) allopt # The configuration file @@ -323,6 +345,7 @@ -e "s|%%BYTECCLIBS%%|$(BYTECCLIBS)|" \ -e "s|%%NATIVECCLIBS%%|$(NATIVECCLIBS)|" \ -e 's|%%RANLIBCMD%%|$(RANLIBCMD)|' \ + -e 's|%%ARCMD%%|$(ARCMD)|' \ -e 's|%%BINUTILS_NM%%|$(BINUTILS_NM)|' \ -e 's|%%BINUTILS_OBJCOPY%%|$(BINUTILS_OBJCOPY)|' \ -e "s|%%ARCH%%|$(ARCH)|" \ @@ -334,6 +357,8 @@ -e "s|%%EXT_DLL%%|.dll|" \ -e "s|%%SYSTHREAD_SUPPORT%%|true|" \ -e 's|%%ASM%%|$(ASM)|' \ + -e 's|%%ASM_CFI_SUPPORTED%%|false|' \ + -e 's|%%WITH_FRAME_POINTERS%%|false|' \ -e 's|%%MKDLL%%|$(MKDLL)|' \ -e 's|%%MKEXE%%|$(MKEXE)|' \ -e 's|%%MKMAINDLL%%|$(MKMAINDLL)|' \ @@ -366,21 +391,25 @@ beforedepend:: parsing/lexer.ml -# The auxiliary lexer for counting line numbers - -parsing/linenum.ml: parsing/linenum.mll - $(CAMLLEX) parsing/linenum.mll +# Shared parts of the system compiled with the native-code compiler +compilerlibs/ocamlcommon.cmxa: $(COMMON:.cmo=.cmx) + $(CAMLOPT) -a -o $@ $(COMMON:.cmo=.cmx) partialclean:: - rm -f parsing/linenum.ml - -beforedepend:: parsing/linenum.ml + rm -f compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlcommon.$(A) # The bytecode compiler compiled with the native-code compiler -ocamlc.opt: $(COMPOBJS:.cmo=.cmx) - cd asmrun ; $(MAKEREC) meta.$(O) dynlink.$(O) - $(CAMLOPT) $(LINKFLAGS) -o ocamlc.opt $(COMPOBJS:.cmo=.cmx) asmrun/meta.$(O) asmrun/dynlink.$(O) +compilerlibs/ocamlbytecomp.cmxa: $(BYTECOMP:.cmo=.cmx) + $(CAMLOPT) -a -o $@ $(BYTECOMP:.cmo=.cmx) +partialclean:: + rm -f compilerlibs/ocamlbytecomp.cmxa compilerlibs/ocamlbytecomp.$(A) + +ocamlc.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlbytecomp.cmxa \ + $(BYTESTART:.cmo=.cmx) + $(CAMLOPT) $(LINKFLAGS) -ccopt "$(BYTECCLINKOPTS)" -o ocamlc.opt \ + compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlbytecomp.cmxa \ + $(BYTESTART:.cmo=.cmx) -cclib "$(BYTECCLIBS)" @sed -e 's|@compiler@|$$topdir/ocamlc.opt|' \ driver/ocamlcomp.sh.in > ocamlcomp.sh @chmod +x ocamlcomp.sh @@ -390,8 +419,16 @@ # The native-code compiler compiled with itself -ocamlopt.opt: $(OPTOBJS:.cmo=.cmx) - $(CAMLOPT) $(LINKFLAGS) -o ocamlopt.opt $(OPTOBJS:.cmo=.cmx) +compilerlibs/ocamloptcomp.cmxa: $(ASMCOMP:.cmo=.cmx) + $(CAMLOPT) -a -o $@ $(ASMCOMP:.cmo=.cmx) +partialclean:: + rm -f compilerlibs/ocamloptcomp.cmxa compilerlibs/ocamloptcomp.$(A) + +ocamlopt.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \ + $(OPTSTART:.cmo=.cmx) + $(CAMLOPT) $(LINKFLAGS) -o ocamlopt.opt \ + compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \ + $(OPTSTART:.cmo=.cmx) @sed -e 's|@compiler@|$$topdir/ocamlopt.opt|' \ driver/ocamlcomp.sh.in > ocamlcompopt.sh @chmod +x ocamlcompopt.sh @@ -399,7 +436,7 @@ partialclean:: rm -f ocamlopt.opt -$(OPTOBJS:.cmo=.cmx): ocamlopt +$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(ASMCOMP:.cmo=.cmx): ocamlopt # The numeric opcodes @@ -442,15 +479,13 @@ beforedepend:: asmcomp/arch.ml ifeq ($(TOOLCHAIN),msvc) -ASMCOMP_PROC=asmcomp/$(ARCH)/proc_nt.ml ASMCOMP_EMIT=asmcomp/$(ARCH)/emit_nt.mlp else -ASMCOMP_PROC=asmcomp/$(ARCH)/proc.ml ASMCOMP_EMIT=asmcomp/$(ARCH)/emit.mlp endif -asmcomp/proc.ml: $(ASMCOMP_PROC) - cp $(ASMCOMP_PROC) asmcomp/proc.ml +asmcomp/proc.ml: asmcomp/$(ARCH)/proc.ml + cp asmcomp/$(ARCH)/proc.ml asmcomp/proc.ml partialclean:: rm -f asmcomp/proc.ml @@ -496,8 +531,10 @@ # The "expunge" utility -expunge: $(EXPUNGEOBJS) - $(CAMLC) $(LINKFLAGS) -o expunge $(EXPUNGEOBJS) +expunge: compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma \ + toplevel/expunge.cmo + $(CAMLC) $(LINKFLAGS) -o expunge compilerlibs/ocamlcommon.cma \ + compilerlibs/ocamlbytecomp.cma toplevel/expunge.cmo partialclean:: rm -f expunge @@ -626,13 +663,10 @@ partialclean:: rm -rf _build -# The Win32 toplevel GUI - -win32gui: - cd win32caml ; $(MAKE) all +# Make clean in the test suite clean:: - cd win32caml ; $(MAKE) clean + cd testsuite; $(MAKE) clean # Default rules @@ -664,4 +698,18 @@ alldepend:: depend +distclean: + ./build/distclean.sh + +.PHONY: all backup bootstrap camlp4opt camlp4out checkstack clean +.PHONY: partialclean beforedepend alldepend cleanboot coldstart +.PHONY: compare core coreall +.PHONY: coreboot defaultentry depend distclean install installopt +.PHONY: library library-cross libraryopt ocamlbuild-mixed-boot +.PHONY: ocamlbuild.byte ocamlbuild.native ocamldebugger ocamldoc +.PHONY: ocamldoc.opt ocamllex ocamllex.opt ocamltools ocamltools.opt +.PHONY: ocamlyacc opt-core opt opt.opt otherlibraries +.PHONY: otherlibrariesopt promote promote-cross +.PHONY: restore runtime runtimeopt makeruntimeopt world world.opt + include .depend diff -Nru ocaml-3.12.1/README ocaml-4.01.0/README --- ocaml-3.12.1/README 2011-04-29 09:10:12.000000000 +0000 +++ ocaml-4.01.0/README 2012-10-15 17:50:56.000000000 +0000 @@ -1,17 +1,17 @@ OVERVIEW: -Objective Caml is an implementation of the ML language, based on -the Caml Light dialect extended with a complete class-based object system -and a powerful module system in the style of Standard ML. - -Objective Caml comprises two compilers. One generates bytecode -which is then interpreted by a C program. This compiler runs quickly, -generates compact code with moderate memory requirements, and is -portable to essentially any 32 or 64 bit Unix platform. Performance of -generated programs is quite good for a bytecoded implementation. -This compiler can be used either as a standalone, batch-oriented -compiler that produces standalone programs, or as an interactive, -toplevel-based system. +OCaml is an implementation of the ML language, based on the Caml Light +dialect extended with a complete class-based object system and a +powerful module system in the style of Standard ML. + +OCaml comprises two compilers. One generates bytecode which is then +interpreted by a C program. This compiler runs quickly, generates +compact code with moderate memory requirements, and is portable to +essentially any 32 or 64 bit Unix platform. Performance of generated +programs is quite good for a bytecoded implementation. This compiler +can be used either as a standalone, batch-oriented compiler that +produces standalone programs, or as an interactive, toplevel-based +system. The other compiler generates high-performance native code for a number of processors. Compilation takes longer and generates bigger code, but @@ -19,31 +19,27 @@ the moderate memory requirements of the bytecode compiler. The native-code compiler currently runs on the following platforms: -Tier 1 (actively used and maintained by the core Caml team): +Tier 1 (actively used and maintained by the core OCaml team): AMD64 (Opteron) Linux, MacOS X, MS Windows IA32 (Pentium) Linux, FreeBSD, MacOS X, MS Windows - PowerPC MacOS X + PowerPC Linux, MacOS X + ARM Linux Tier 2 (maintained when possible, with help from users): - Alpha Digital Unix/Compaq Tru64, Linux, all BSD AMD64 FreeBSD, OpenBSD - HP PA-RISC HPUX 11, Linux IA32 (Pentium) NetBSD, OpenBSD, Solaris 9 - IA64 Linux, FreeBSD - MIPS IRIX 6 - PowerPC Linux, NetBSD - SPARC Solaris 9, Linux, NetBSD - Strong ARM Linux + PowerPC NetBSD + SPARC Solaris, Linux, NetBSD Other operating systems for the processors above have not been tested, but the compiler may work under other operating systems with little work. -Before the introduction of objects, Objective Caml was known as Caml -Special Light. Objective Caml is almost upwards compatible with Caml -Special Light, except for a few additional reserved keywords that have -forced some renaming of standard library functions. +Before the introduction of objects, OCaml was known as Caml Special +Light. OCaml is almost upwards compatible with Caml Special Light, +except for a few additional reserved keywords that have forced some +renaming of standard library functions. CONTENTS: @@ -52,7 +48,7 @@ LICENSE license and copyright notice Makefile main Makefile README this file - README.win32 infos on the MS Windows ports of O.Caml + README.win32 infos on the MS Windows ports of OCaml asmcomp/ native-code compiler and linker asmrun/ native-code runtime library boot/ bootstrap compiler @@ -62,7 +58,7 @@ config/ autoconfiguration stuff debugger/ source-level replay debugger driver/ driver code for the compilers - emacs/ Caml editing mode and debugger interface for GNU Emacs + emacs/ OCaml editing mode and debugger interface for GNU Emacs lex/ lexer generator maccaml/ the Macintosh GUI ocamldoc/ documentation generator @@ -79,8 +75,9 @@ All files marked "Copyright INRIA" in this distribution are copyright 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, -2007, 2008 Institut National de Recherche en Informatique et en Automatique -(INRIA) and distributed under the conditions stated in file LICENSE. +2007, 2008, 2009, 2010, 2011, 2012 Institut National de Recherche en +Informatique et en Automatique (INRIA) and distributed under the +conditions stated in file LICENSE. INSTALLATION: @@ -89,24 +86,24 @@ DOCUMENTATION: -The Objective Caml manual is distributed in HTML, PDF, Postscript, -DVI, and Emacs Info files. It is available on the World Wide Web, at +The OCaml manual is distributed in HTML, PDF, Postscript, DVI, and +Emacs Info files. It is available on the World Wide Web, at http://caml.inria.fr/ AVAILABILITY: -The complete Objective Caml distribution can be accessed at +The complete OCaml distribution can be accessed at http://caml.inria.fr/ KEEPING IN TOUCH WITH THE CAML COMMUNITY: -There exists a mailing list of users of the Caml implementations +There exists a mailing list of users of the OCaml implementations developed at INRIA. The purpose of this list is to share experience, exchange ideas (and even code), and report on applications -of the Caml language. Messages can be written in English or in -French. The list has about 750 subscribers. +of the OCaml language. Messages can be written in English or in +French. The list has more than 1000 subscribers. Messages to the list should be sent to: @@ -114,13 +111,13 @@ You can subscribe to this list via the Web interface at - http://yquem.inria.fr/cgi-bin/mailman/listinfo/caml-list + https://sympa-roc.inria.fr/wws/info/caml-list -Archives of the list are available on the Web site http://caml.inria.fr/ +Archives of the list are available on the Web site above. The Usenet news groups comp.lang.ml and comp.lang.functional also contains discussions about the ML family of programming languages, -including Caml. +including OCaml. BUG REPORTS AND USER FEEDBACK: @@ -132,7 +129,3 @@ configuration you are using (machine type, etc). You can also contact the implementors directly at caml@inria.fr. - - ----- -$Id: README 11017 2011-04-29 09:10:12Z doligez $ diff -Nru ocaml-3.12.1/README.win32 ocaml-4.01.0/README.win32 --- ocaml-3.12.1/README.win32 2011-07-04 21:15:01.000000000 +0000 +++ ocaml-4.01.0/README.win32 2013-08-28 12:12:42.000000000 +0000 @@ -1,9 +1,11 @@ - Release notes on the MS Windows ports of Objective Caml - ------------------------------------------------------- + Release notes on the MS Windows ports of OCaml + ---------------------------------------------- -There are no less than four ports of Objective Caml for MS Windows available: +There are no less than four ports of OCaml for MS Windows available: - a native Win32 port, built with the Microsoft development tools; - - a native Win32 port, built with the Cygwin/MinGW development tools; + - a native Win32 port, built with the 32-bit version of the gcc + compiler from the mingw-w64 project, packaged in Cygwin + (under the name mingw64-i686); - a port consisting of the Unix sources compiled under the Cygwin Unix-like environment for Windows; - a native Win64 port (64-bit Windows), built with the Microsoft @@ -57,7 +59,7 @@ The native-code compiler (ocamlopt) requires the Microsoft Windows SDK (item [1]) and the flexdll tool (item [2]). -Statically linking Caml bytecode with C code (ocamlc -custom) also requires +Statically linking OCaml bytecode with C code (ocamlc -custom) also requires items [1] and [2]. The LablTk GUI requires Tcl/Tk 8.5 (item [3]). @@ -85,12 +87,11 @@ http://www.microsoft.com/downloads/en/default.aspx under the name "Microsoft Windows 7 SDK". -[2] flexdll version 0.23 or later. +[2] flexdll version 0.31 or later. Can be downloaded from http://alain.frisch.fr/flexdll.html [3] TCL/TK version 8.5. Windows binaries are available as part of the - ActiveTCL distribution at http://www.activestate.com/products/ActiveTcl/ - + ActiveTCL distribution at http://www.activestate.com/activetcl/downloads RECOMPILATION FROM THE SOURCES: @@ -104,7 +105,8 @@ Make sure to install the 32-bit version of TCL/TK, even if you are compiling on a 64-bit Windows. - The Cygwin port of GNU tools, available from http://www.cygwin.com/ - Install at least the following packages: diffutils, make, ncurses. + Install at least the following packages (and their dependencies): + diffutils, dos2unix, gcc-core, make, ncurses. First, you need to set up your cygwin environment for using the MS tools. The following assumes that you have installed [1], [2], and [3] @@ -119,13 +121,14 @@ Then enter the following commands: cd "%PFPATH%\Microsoft Visual Studio 9.0\VC\bin" + set FLEXDLLDIR=%PFPATH%\flexdll vcvars32 echo VCPATH="`cygpath -p '%Path%'`" >C:\cygwin\tmp\msenv echo LIB="%LIB%;C:\Tcl\lib" >>C:\cygwin\tmp\msenv echo LIBPATH="%LIBPATH%" >>C:\cygwin\tmp\msenv - echo INCLUDE="%INCLUDE%;C:\Tcl\include" >>C:\cygwin\tmp\msenv - echo FLPATH="`cygpath '%PFPATH%\flexdll'`" >>C:\cygwin\tmp\msenv - echo PATH="${VCPATH}:$PATH:${FLPATH}" >>C:\cygwin\tmp\msenv + echo INCLUDE="%INCLUDE%;%FLEXDLLDIR%;C:\Tcl\include" >>C:\cygwin\tmp\msenv + echo FLPATH="`cygpath '%FLEXDLLDIR%'`" >>C:\cygwin\tmp\msenv + echo PATH="$VCPATH:$FLPATH:$PATH" >>C:\cygwin\tmp\msenv echo export PATH LIB LIBPATH INCLUDE >>C:\cygwin\tmp\msenv echo export OCAMLBUILD_FIND=/usr/bin/find >>C:\cygwin\tmp\msenv @@ -171,46 +174,59 @@ CREDITS: -The initial port of Caml Special Light (the ancestor of Objective Caml) -to Windows NT was done by Kevin Gallo at Microsoft Research, who -kindly contributed his changes to the Caml project. - -The graphical user interface for the toplevel was initially developed -by Jacob Navia, then significantly improved by Christopher A. Watford. +The initial port of Caml Special Light (the ancestor of OCaml) to +Windows NT was done by Kevin Gallo at Microsoft Research, who kindly +contributed his changes to the OCaml project. ------------------------------------------------------------------------------ The native Win32 port built with Mingw -------------------------------------- -NOTE: Due to changes in cygwin's compilers, this port is not available -in OCaml 3.12.1. A patch will be made available soon after the release -of 3.12.1. - REQUIREMENTS: -This port runs under MS Windows Vista, XP, and 2000. +This port runs under MS Windows Seven, Vista, XP, and 2000. The base bytecode system (ocamlc, ocaml, ocamllex, ocamlyacc, ...) runs without any additional tools. The native-code compiler (ocamlopt), as well as static linking of -Caml bytecode with C code (ocamlc -custom), require +OCaml bytecode with C code (ocamlc -custom), require the Cygwin development tools, available at http://www.cygwin.com/ and the flexdll tool, available at http://alain.frisch.fr/flexdll.html You will need to install at least the following Cygwin packages (use the Setup tool from Cygwin): -binutils, gcc-core, gcc-mingw-core, mingw-runtime, w32api. -Do *not* install the Mingw/MSYS development tools from www.mingw.org: -these are not compatible with this Caml port (@responsefile not -recognized on the command line). + mingw64-i686-binutils + mingw64-i686-gcc + mingw64-i686-gcc-core + mingw64-i686-runtime + + +NOTES: + + - Do not use the Cygwin version of flexdll for this port. + + - There is another 32-bit gcc compiler, from the MinGW.org + project, packaged in Cygwin under the name mingw-gcc. + It is not currently supported by flexdll and OCaml. + + - The standard gcc compiler shipped with Cygwin used to + support a "-mno-cygwin" option, which turned the compiler + into a mingw compiler. This option was used + by previous versions of flexdll and OCaml, but it is no + longer available in recent version, hence the switch + to another toolchain packaged in Cygwin. + + - The standalone mingw toolchain from the MinGW-w64 project + (http://mingw-w64.sourceforge.net/) is not supported. + Please use the version packaged in Cygwin instead. The LablTk GUI requires Tcl/Tk 8.5. Windows binaries are available as part of the ActiveTCL distribution at -http://www.activestate.com/products/ActiveTcl/ + http://www.activestate.com/activetcl/downloads Note that you will need to install the 32-bit version of ActiveTCL, even if you are on a 64-bit version of Windows. @@ -233,18 +249,26 @@ RECOMPILATION FROM THE SOURCES: You will need the following software components to perform the recompilation: -- Windows NT, 2000, XP, or Vista. -- Cygwin: http://sourceware.cygnus.com/cygwin/ - Install at least the following packages: binutils, diffutils, - gcc-core, gcc-mingw-core, make, mingw-runtime, ncurses, w32api. -- TCL/TK version 8.5 (see above). -- The flexdll tool (see above). - -Do *not* install the standalone distribution of MinGW, nor the -companion MSYS tools: these have problems with long command lines. -Instead, use the version of MinGW provided by Cygwin. +- Windows NT, 2000, XP, Vista, or Seven. +- Cygwin: http://cygwin.com/ + Install at least the following packages (and their dependencies, as + computed by Cygwin's setup.exe): + mingw64-i686-binutils + mingw64-i686-gcc + mingw64-i686-gcc-core + mingw64-i686-runtime + diffutils + make + ncurses +- Tcl/Tk version 8.5 (see above). +- The flexdll tool (see above). Do not forget to add the flexdll directory + to your PATH + +The standalone mingw toolchain from the MinGW-w64 project +(http://mingw-w64.sourceforge.net/) is not supported. Please use the +version packaged in Cygwin instead. -Start a Cygwin shell and unpack the source distribution +Start a new Cygwin shell and unpack the source distribution (ocaml-X.YY.Z.tar.gz) with "tar xzf". Change to the top-level directory of the OCaml distribution. Then, do @@ -255,7 +279,7 @@ Then, edit config/Makefile as needed, following the comments in this file. Normally, the only variables that need to be changed are PREFIX where to install everything - TK_ROOT where TCL/TK was installed + TK_ROOT where Tcl/Tk was installed Finally, use "make -f Makefile.nt" to build the system, e.g. @@ -275,8 +299,8 @@ ------------------------------------------------------------------------------ - The Cygwin port of Objective Caml - --------------------------------- + The Cygwin port of OCaml + ------------------------ REQUIREMENTS: @@ -299,16 +323,42 @@ RECOMPILATION FROM THE SOURCES: -Just follow the instructions for Unix machines given in the file INSTALL. +Before starting, make sure that the gcc version installed by cygwin +is not 4.5.3 (it has a bug that affects OCaml). If needed, use cygwin's +setup.exe to downgrade to 4.3.4. + +You will need to recompile (and install) flexdll from source with +Cygwin's C compiler because the official binary version of flexdll +doesn't handle Cygwin's symbolic links and sometimes fails to +launch the C compiler. + +In order to recompile flexdll, you first need to configure, compile, +and install OCaml without flexdll support (configure with options +-no-shared-libs -no-tk -no-camlp4), then modify the flexdll Makefile +to change line 51 from: + LINKFLAGS = -ccopt "-link version_res.o" +to: + LINKFLAGS = -cclib version_res.o + +Then "make CHAINS=cygwin" and add the flexdll directory to your PATH. +Make sure to add it before "/usr/bin" or you will get cygwin's flexlink. + +Then, in OCaml's source directory, type: + make clean + make distclean +and follow the instructions for Unix machines given in the file INSTALL. NOTES: -The libraries available in this port are "num", "str", "threads", -"unix" and "labltk". "graph" is not available. -The replay debugger is fully supported. -When upgrading from 3.12.0 to 3.12.1, you will need to remove -/usr/local/bin/ocamlmktop.exe before typing "make install". +- There is a problem with cygwin's port of gcc version 4.5.3. You should + use cygwin's setup program to downgrade to 4.3.4 before compiling OCaml. +- The replay debugger is fully supported. +- When upgrading from 3.12.0 to 3.12.1, you will need to remove + /usr/local/bin/ocamlmktop.exe before typing "make install". +- In order to use the "graph" and "labltk" libraries, you will need + to use Cygwin's setup.exe to install the xinit, libX11-devel, tcl, + and tcl-tk packages before compiling OCaml. ------------------------------------------------------------------------------ @@ -323,7 +373,7 @@ The base bytecode system (ocamlc, ocaml, ocamllex, ocamlyacc, ...) runs without any additional tools. -Statically linking Caml bytecode with C code (ocamlc -custom) requires the +Statically linking OCaml bytecode with C code (ocamlc -custom) requires the Microsoft Platform SDK compiler (item [1] in the section "third-party software" below) and the flexdll tool (item [2]). @@ -345,7 +395,7 @@ http://www.microsoft.com/downloads/en/default.aspx under the name "Microsoft Windows 7 SDK". -[2] flexdll version 0.23 or later. +[2] flexdll version 0.31 or later. Can be downloaded from http://alain.frisch.fr/flexdll.html @@ -375,7 +425,7 @@ echo LIBPATH="%LIBPATH%" >>C:\cygwin\tmp\msenv echo INCLUDE="%INCLUDE%;C:\Tcl\include" >>C:\cygwin\tmp\msenv echo FLPATH="`cygpath '%PFPATH%\flexdll'`" >>C:\cygwin\tmp\msenv - echo PATH="${VCPATH}:$PATH:${FLPATH}" >>C:\cygwin\tmp\msenv + echo PATH="$VCPATH:$FLPATH:$PATH" >>C:\cygwin\tmp\msenv echo export PATH LIB LIBPATH INCLUDE >>C:\cygwin\tmp\msenv echo export OCAMLBUILD_FIND=/usr/bin/find >>C:\cygwin\tmp\msenv diff -Nru ocaml-3.12.1/Upgrading ocaml-4.01.0/Upgrading --- ocaml-3.12.1/Upgrading 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/Upgrading 1970-01-01 00:00:00.000000000 +0000 @@ -1,109 +0,0 @@ - - FAQ: how to upgrade from Objective Caml 3.02 to 3.03 - -I Installation - -Q1: When compiling the distribution, I am getting strange linking - errors in "otherlibraries". - -A1: This is probably a problem with dynamic linking. You can disable - it with ./configure -no-shared-libs. If you really want to use - shared libraries, look in the manual pages of your system for how - to get some debugging output from the dynamic linker. - -II Non-label changes - -Q2: I get a syntax error when I try to compile a program using stream - parsers. - -A2: Stream parser now require camlp4. It is included in the - distribution, and you just need to use "ocamlc -pp camlp4o" in - place of "ocamlc". You can also use it under the toplevel with - #load"camlp4o.cma". - -Q3: I get a warning when I use the syntax "#variant" inside type - expressions. - -A3: The new syntax is [< variant], which just a special case of - the more general new syntax, which allows type expressions like - [ variant1 | variant2] or [> variant]. See the reference manual - for details. - -III Label changes - -Q4: I was using labels before, and now I get lots of type errors. - -A4: The handling of labels changed with 3.03-alpha. The new default - is a more flexible version of the commuting label mode, allowing - one to omit labels in total applications. There is still a - -nolabels mode, but it does not allow non-optional labels in - applications (this was unsound). - To keep full compatibility with Objective Caml 2, labels were - removed from the standard libraries. Some labelized libraries are - kept as StdLabels (contains Array, List and String), MoreLabels - (contains Hashtbl, Map and Set), and UnixLabels. - Note that MoreLabels' status is not yet decided. - -Q5: Why isn't there a ThreadUnixLabels module ? - -A5: ThreadUnix is deprecated. It only calls directly the Unix module. - -Q6: I was using commuting label mode, how can I upgrade ? - -A6: The new behaviour is compatible with commuting label mode, but - standard libraries have no labels. You can add the following - lines at the beginning of your files (according to your needs): - open Stdlabels - open MoreLabels - module Unix = UnixLabels - Alternatively, if you already have a common module opened by - everybody, you can add these: - include StdLabels - include MoreLabels - module Unix = UnixLabels - - You will then need to remove labels in functions from other modules. - This can be automated by using the scrapelabels tool, installed - in the Objective Caml library directory, which both removes labels - and inserts needed `open' clauses (see -help for details). - $CAMLLIB/scrapelabels -keepstd *.ml - or - $CAMLLIB/scrapelabels -keepmore *.ml - Note that scrapelabels is not guaranteed to be sound for commuting - label programs, since it will just remove labels, and not reorder - arguments. - -Q7: I was using a few labels in classic mode, and now I get all these - errors. I just want to get rid of all these silly labels. - -A7: scrapelabels will do it for you. - $CAMLLIB/scrapelabels [-all] *.ml - $CAMLLIB/scrapelabels -intf *.mli - You should specify the -all option only if you are sure that your - sources do not contain calls to functions with optional - parameters, as those labels would also be removed. - -Q8: I was using labels in classic mode, and I was actually pretty fond - of them. How much more labels will I have to write now ? How can I - convert my programs and libraries ? - -A8: The new default mode is more flexible than the original commuting - mode, so that you shouldn't see too much differences when using - labeled libraries. Labels are only compulsory in partial - applications (including the special case of function with an - unknown return type), or if you wrote some of them. - - On the other hand, for definitions, labels present in the - interface must also be present in the implementation. - The addlabels tool can help you to do that. Suppose that you have - mymod.ml and mymod.mli, where mymod.mli adds some labels. Then - doing - $CAMLLIB/addlabels mymod.ml - will insert labels from the interface inside the implementation. - It also takes care of inserting them in recursive calls, as - the return type of the function is not known while typing it. - - If you used labels from standard libraries, you will also have - problems with them. You can proceed as described in A6. Since you - used classic mode, you do not need to bother about changed - argument order. diff -Nru ocaml-3.12.1/VERSION ocaml-4.01.0/VERSION --- ocaml-3.12.1/VERSION 2011-07-04 21:15:01.000000000 +0000 +++ ocaml-4.01.0/VERSION 2013-09-11 14:52:59.000000000 +0000 @@ -1,6 +1,4 @@ -3.12.1 +4.01.0 # The version string is the first line of this file. # It must be in the format described in stdlib/sys.mli - -# $Id: VERSION 11110 2011-07-04 21:15:01Z doligez $ diff -Nru ocaml-3.12.1/_tags ocaml-4.01.0/_tags --- ocaml-3.12.1/_tags 2010-06-12 07:43:30.000000000 +0000 +++ ocaml-4.01.0/_tags 2013-03-09 00:33:21.000000000 +0000 @@ -1,3 +1,15 @@ +######################################################################### +# # +# OCaml # +# # +# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# # +# Copyright 2007 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + # Ocamlbuild tags file true: -traverse @@ -5,7 +17,7 @@ # Traverse only these directories <{bytecomp,driver,stdlib,tools,asmcomp,camlp4,ocamlbuild,toplevel,ocamldoc,typing,otherlibs,utils,debugger,lex,parsing,byterun,asmrun}/**>: traverse -"boot" or "byterun" or "asmrun": not_hygienic +"boot" or "byterun" or "asmrun" or "compilerlibs": not_hygienic # These should not be required but it fails on *BSD and Windows... "yacc" or "win32caml": not_hygienic diff -Nru ocaml-3.12.1/asmcomp/.cvsignore ocaml-4.01.0/asmcomp/.cvsignore --- ocaml-3.12.1/asmcomp/.cvsignore 2002-01-18 15:13:26.000000000 +0000 +++ ocaml-4.01.0/asmcomp/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -emit.ml -arch.ml -proc.ml -selection.ml -reload.ml -scheduling.ml diff -Nru ocaml-3.12.1/asmcomp/.ignore ocaml-4.01.0/asmcomp/.ignore --- ocaml-3.12.1/asmcomp/.ignore 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/asmcomp/.ignore 2012-07-17 15:31:12.000000000 +0000 @@ -0,0 +1,6 @@ +emit.ml +arch.ml +proc.ml +selection.ml +reload.ml +scheduling.ml diff -Nru ocaml-3.12.1/asmcomp/alpha/arch.ml ocaml-4.01.0/asmcomp/alpha/arch.ml --- ocaml-3.12.1/asmcomp/alpha/arch.ml 2002-11-29 15:03:37.000000000 +0000 +++ ocaml-4.01.0/asmcomp/alpha/arch.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,83 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: arch.ml 5304 2002-11-29 15:03:37Z xleroy $ *) - -(* Specific operations for the Alpha processor *) - -open Misc -open Format - -(* Machine-specific command-line options *) - -let command_line_options = [] - -(* Addressing modes *) - -type addressing_mode = - Ibased of string * int (* symbol + displ *) - | Iindexed of int (* reg + displ *) - -(* Specific operations *) - -type specific_operation = - Iadd4 | Iadd8 | Isub4 | Isub8 (* Scaled adds and subs *) - | Ireloadgp of bool (* The ldgp instruction *) - | Itrunc32 (* Truncate 64-bit int to 32 bit *) - -(* Sizes, endianness *) - -let big_endian = false - -let size_addr = 8 -let size_int = 8 -let size_float = 8 - -(* Operations on addressing modes *) - -let identity_addressing = Iindexed 0 - -let offset_addressing addr delta = - match addr with - Ibased(s, n) -> Ibased(s, n + delta) - | Iindexed n -> Iindexed(n + delta) - -let num_args_addressing = function - Ibased(s, n) -> 0 - | Iindexed n -> 1 - -(* Printing operations and addressing modes *) - -let print_addressing printreg addr ppf arg = - match addr with - | Ibased(s, n) -> - fprintf ppf "\"%s\"%s" s - (if n <> 0 then Printf.sprintf " + %i" n else "") - | Iindexed n -> - fprintf ppf "%a%s" printreg arg.(0) - (if n <> 0 then Printf.sprintf " + %i" n else "") - -let print_specific_operation printreg op ppf arg = - match op with - | Iadd4 -> fprintf ppf "%a * 4 + %a" printreg arg.(0) printreg arg.(1) - | Iadd8 -> fprintf ppf "%a * 8 + %a" printreg arg.(0) printreg arg.(1) - | Isub4 -> fprintf ppf "%a * 4 - %a" printreg arg.(0) printreg arg.(1) - | Isub8 -> fprintf ppf "%a * 8 - %a" printreg arg.(0) printreg arg.(1) - | Ireloadgp _ -> fprintf ppf "ldgp" - | Itrunc32 -> fprintf ppf "truncate32 %a" printreg arg.(0) - -(* Distinguish between the Digital assembler and other assemblers (e.g. gas) *) - -let digital_asm = - match Config.system with - "digital" -> true - | _ -> false diff -Nru ocaml-3.12.1/asmcomp/alpha/emit.mlp ocaml-4.01.0/asmcomp/alpha/emit.mlp --- ocaml-3.12.1/asmcomp/alpha/emit.mlp 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/alpha/emit.mlp 1970-01-01 00:00:00.000000000 +0000 @@ -1,861 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: emit.mlp 9547 2010-01-22 12:48:24Z doligez $ *) - -module LabelSet = - Set.Make(struct type t = Linearize.label let compare = compare end) - -(* Emission of Alpha assembly code *) - -open Location -open Misc -open Cmm -open Arch -open Proc -open Reg -open Mach -open Linearize -open Emitaux - -(* First pass: insert Iloadgp instructions where needed *) - -let insert_load_gp f = - - let labels_needing_gp = ref LabelSet.empty in - let fixpoint_reached = ref false in - - let label_needs_gp lbl = - LabelSet.mem lbl !labels_needing_gp in - let opt_label_needs_gp default = function - None -> default - | Some lbl -> label_needs_gp lbl in - let set_label_needs_gp lbl = - if not (label_needs_gp lbl) then begin - fixpoint_reached := false; - labels_needing_gp := LabelSet.add lbl !labels_needing_gp - end in - - let tailrec_entry_point = new_label() in - - (* Determine if $gp is needed before an instruction. - [next] says whether $gp is needed just after (i.e. by the following - instruction). *) - let instr_needs_gp next = function - Lend -> false - | Lop(Iconst_int n) -> (* for large n, turned into ldq ($gp) *) - next || n < Nativeint.of_int(-0x80000000) - || n > Nativeint.of_int 0x7FFFFFFF - | Lop(Iconst_float s) -> true (* turned into ldq ($gp) *) - | Lop(Iconst_symbol s) -> true (* turned into ldq ($gp) *) - | Lop(Icall_ind) -> false (* does ldgp if needed afterwards *) - | Lop(Icall_imm s) -> true (* does lda $27, *) - | Lop(Itailcall_ind) -> false - | Lop(Itailcall_imm s) -> - if s = f.fun_name then label_needs_gp tailrec_entry_point else true - | Lop(Iextcall(_, _)) -> true (* does lda $27, *) - | Lop(Iload(_, Ibased(_, _))) -> true (* loads address from ($gp) *) - | Lop(Istore(_, Ibased(_, _))) -> true (* loads address from ($gp) *) - | Lop(Iintop(Idiv | Imod)) -> true (* divq and remq can be turned into *) - | Lop(Iintop_imm((Idiv | Imod), _)) -> true (* a function call *) - | Lop(Iintop_imm(_, n)) -> (* for large n, turned into ldq ($gp) *) - next || n < -0x80000000 || n > 0x7FFFFFFF - | Lop _ -> next - | Lreloadretaddr -> next - | Lreturn -> false - | Llabel lbl -> if next then set_label_needs_gp lbl; next - | Lbranch lbl -> label_needs_gp lbl - | Lcondbranch(tst, lbl) -> next || label_needs_gp lbl - | Lcondbranch3(lbl1, lbl2, lbl3) -> - opt_label_needs_gp next lbl1 || - opt_label_needs_gp next lbl2 || - opt_label_needs_gp next lbl3 - | Lswitch lblv -> true - | Lsetuptrap lbl -> label_needs_gp lbl - | Lpushtrap -> next - | Lpoptrap -> next - | Lraise -> false in - - let rec needs_gp i = - if i.desc = Lend - then false - else instr_needs_gp (needs_gp i.next) i.desc in - - while not !fixpoint_reached do - fixpoint_reached := true; - if needs_gp f.fun_body then set_label_needs_gp tailrec_entry_point - done; - - (* Insert Ireloadgp instructions after calls where needed *) - let rec insert_reload_gp i = - if i.desc = Lend then (i, false) else begin - let (new_next, needs_next) = insert_reload_gp i.next in - let new_instr = - match i.desc with - (* If the instruction destroys $gp and $gp is needed afterwards, - insert a ldgp after the instructions. *) - Lop(Icall_ind | Icall_imm _) when needs_next -> - {i with next = - instr_cons (Lop(Ispecific(Ireloadgp true))) [||] [||] new_next } - | Lop(Iextcall(_, false)) | Lsetuptrap _ when needs_next -> - {i with next = - instr_cons (Lop(Ispecific(Ireloadgp false))) [||] [||] new_next } - | _ -> - {i with next = new_next} in - (new_instr, instr_needs_gp needs_next i.desc) - end in - - let (new_body, uses_gp) = insert_reload_gp f.fun_body in - ({f with fun_body = new_body}, uses_gp) - -(* Second pass: code generation proper *) - -(* Tradeoff between code size and code speed *) - -let fastcode_flag = ref true - -(* Output a label *) - -let emit_label lbl = - emit_string "$"; emit_int lbl - -let emit_Llabel fallthrough lbl = - if (not fallthrough) then begin - emit_string " .align 4\n" - end ; - emit_label lbl - -(* Output a symbol *) - -let emit_symbol s = - Emitaux.emit_symbol '$' s - -(* Output a pseudo-register *) - -let emit_reg r = - match r.loc with - Reg r -> emit_string (register_name r) - | _ -> fatal_error "Emit_alpha.emit_reg" - -(* Layout of the stack frame *) - -let stack_offset = ref 0 - -let frame_size () = - let size = - !stack_offset + - 8 * (num_stack_slots.(0) + num_stack_slots.(1)) + - (if !contains_calls then 8 else 0) in - Misc.align size 16 - -let slot_offset loc cl = - match loc with - Incoming n -> frame_size() + n - | Local n -> - if cl = 0 - then !stack_offset + n * 8 - else !stack_offset + (num_stack_slots.(0) + n) * 8 - | Outgoing n -> n - -(* Output a stack reference *) - -let emit_stack r = - match r.loc with - Stack s -> - let ofs = slot_offset s (register_class r) in `{emit_int ofs}($sp)` - | _ -> fatal_error "Emit_alpha.emit_stack" - -(* Output an addressing mode *) - -let emit_addressing addr r n = - match addr with - Iindexed ofs -> - `{emit_int ofs}({emit_reg r.(n)})` - | Ibased(s, ofs) -> - `{emit_symbol s}`; - if ofs > 0 then ` + {emit_int ofs}`; - if ofs < 0 then ` - {emit_int(-ofs)}` - -(* Immediate operands *) - -let is_immediate n = digital_asm || (n >= 0 && n <= 255) - -(* Communicate live registers at call points to the assembler *) - -let int_reg_number = [| - 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; - 16; 17; 18; 19; 20; 21; 22 -|] - -let float_reg_number = [| - 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; - 16; 17; 18; 19; 20; 21; 22; 23; 24; 25; 26; 27; 29; 30 -|] - -let liveregs instr extra_msk = - (* $13, $14, $15 always live *) - let int_mask = ref(0x00070000 lor extra_msk) - and float_mask = ref 0 in - let add_register = function - {loc = Reg r; typ = (Int | Addr)} -> - int_mask := !int_mask lor (1 lsl (31 - int_reg_number.(r))) - | {loc = Reg r; typ = Float} -> - float_mask := !float_mask lor (1 lsl (31 - float_reg_number.(r - 100))) - | _ -> () in - Reg.Set.iter add_register instr.live; - Array.iter add_register instr.arg; - emit_printf " .livereg 0x%08x, 0x%08x\n" !int_mask !float_mask - -let live_24 = 1 lsl (31 - 24) -let live_25 = 1 lsl (31 - 25) -let live_26 = 1 lsl (31 - 26) -let live_27 = 1 lsl (31 - 27) - -(* Record live pointers at call points *) - -type frame_descr = - { fd_lbl: int; (* Return address *) - fd_frame_size: int; (* Size of stack frame *) - fd_live_offset: int list } (* Offsets/regs of live addresses *) - -let frame_descriptors = ref([] : frame_descr list) - -let record_frame_label live = - let lbl = new_label() in - let live_offset = ref [] in - Reg.Set.iter - (function - {typ = Addr; loc = Reg r} -> - live_offset := ((int_reg_number.(r) lsl 1) + 1) :: !live_offset - | {typ = Addr; loc = Stack s} as reg -> - live_offset := slot_offset s (register_class reg) :: !live_offset - | _ -> ()) - live; - frame_descriptors := - { fd_lbl = lbl; - fd_frame_size = frame_size(); - fd_live_offset = !live_offset } :: !frame_descriptors; - lbl - -let record_frame live = - let lbl = record_frame_label live in `{emit_label lbl}:` - -let emit_frame fd = - ` .quad {emit_label fd.fd_lbl}\n`; - ` .word {emit_int fd.fd_frame_size}\n`; - ` .word {emit_int (List.length fd.fd_live_offset)}\n`; - List.iter - (fun n -> - ` .word {emit_int n}\n`) - fd.fd_live_offset; - ` .align 3\n` - -(* Record calls to the GC -- we've moved them out of the way *) - -type gc_call = - { gc_lbl: label; (* Entry label *) - gc_return_lbl: label; (* Where to branch after GC *) - gc_frame: label; (* Label of frame descriptor *) - gc_instr: instruction } (* Record live registers *) - -let call_gc_sites = ref ([] : gc_call list) - -let emit_call_gc gc = - `{emit_label gc.gc_lbl}:`; - liveregs gc.gc_instr 0; - ` bsr $26, caml_call_gc\n`; - (* caml_call_gc preserves $gp *) - `{emit_label gc.gc_frame}: br {emit_label gc.gc_return_lbl}\n` - -(* Name of readonly data section *) - -let rdata_section = - match Config.system with - "digital" -> ".rdata" - | "linux" | "openbsd" | "netbsd" | "freebsd" | "gnu" -> ".section .rodata" - | _ -> assert false - -(* Names of various instructions *) - -let name_for_int_operation = function - Iadd -> "addq" - | Isub -> "subq" - | Imul -> "mulq" - | Idiv -> "divq" - | Imod -> "remq" - | Iand -> "and" - | Ior -> "or" - | Ixor -> "xor" - | Ilsl -> "sll" - | Ilsr -> "srl" - | Iasr -> "sra" - | _ -> Misc.fatal_error "Emit.name_for_int_operation" - -let name_for_float_operation = function - Inegf -> "fneg" - | Iabsf -> "fabs" - | Iaddf -> "addt" - | Isubf -> "subt" - | Imulf -> "mult" - | Idivf -> "divt" - | _ -> Misc.fatal_error "Emit.name_for_float_operation" - -let name_for_specific_operation = function - Iadd4 -> "s4addq" - | Iadd8 -> "s8addq" - | Isub4 -> "s4subq" - | Isub8 -> "s8subq" - | _ -> Misc.fatal_error "Emit.name_for_specific_operation" - -let name_for_int_comparison = function - Isigned Ceq -> "cmpeq", true | Isigned Cne -> "cmpeq", false - | Isigned Cle -> "cmple", true | Isigned Cgt -> "cmple", false - | Isigned Clt -> "cmplt", true | Isigned Cge -> "cmplt", false - | Iunsigned Ceq -> "cmpeq", true | Iunsigned Cne -> "cmpeq", false - | Iunsigned Cle -> "cmpule", true | Iunsigned Cgt -> "cmpule", false - | Iunsigned Clt -> "cmpult", true | Iunsigned Cge -> "cmpult", false - -(* Used for comparisons against 0 *) -let name_for_int_cond_branch = function - Isigned Ceq -> "beq" | Isigned Cne -> "bne" - | Isigned Cle -> "ble" | Isigned Cgt -> "bgt" - | Isigned Clt -> "blt" | Isigned Cge -> "bge" - | Iunsigned Ceq -> "beq" | Iunsigned Cne -> "bne" - | Iunsigned Cle -> "beq" | Iunsigned Cgt -> "bne" - | Iunsigned Clt -> "#" | Iunsigned Cge -> "br" - (* Always false *) (* Always true *) - -let name_for_float_comparison cmp neg = - match cmp with - Ceq -> ("cmpteq", false, neg) | Cne -> ("cmpteq", false, not neg) - | Cle -> ("cmptle", false, neg) | Cgt -> ("cmptlt", true, neg) - | Clt -> ("cmptlt", false, neg) | Cge -> ("cmptle", true, neg) - -(* Output the assembly code for an instruction *) - -(* Name of current function *) -let function_name = ref "" -(* Entry point for tail recursive calls *) -let tailrec_entry_point = ref 0 -(* Label of trap for out-of-range accesses *) -let range_check_trap = ref 0 -(* List of floating-point and big integer literals - (fon non-Digital assemblers) *) -let float_constants = ref ([] : (label * string) list) -let bigint_constants = ref ([] : (label * nativeint) list) - -let emit_instr fallthrough i = - match i.desc with - Lend -> () - | Lop(Imove | Ispill | Ireload) -> - let src = i.arg.(0) and dst = i.res.(0) in - if src.loc <> dst.loc then begin - match (src.loc, dst.loc) with - (Reg rs, Reg rd) -> - if src.typ = Float then - ` fmov {emit_reg src}, {emit_reg dst}\n` - else - ` mov {emit_reg src}, {emit_reg dst}\n` - | (Reg rs, Stack sd) -> - if src.typ = Float then - ` stt {emit_reg src}, {emit_stack dst}\n` - else - ` stq {emit_reg src}, {emit_stack dst}\n` - | (Stack ss, Reg rd) -> - if src.typ = Float then - ` ldt {emit_reg dst}, {emit_stack src}\n` - else - ` ldq {emit_reg dst}, {emit_stack src}\n` - | _ -> - fatal_error "Emit_alpha: Imove" - end - | Lop(Iconst_int n) -> - if n = 0n then - ` clr {emit_reg i.res.(0)}\n` - else if digital_asm || - (n >= Nativeint.of_int (-0x80000000) && - n <= Nativeint.of_int 0x7FFFFFFF) then - ` ldiq {emit_reg i.res.(0)}, {emit_nativeint n}\n` - else begin - (* Work around a bug in gas/gld concerning big integer constants *) - let lbl = new_label() in - bigint_constants := (lbl, n) :: !bigint_constants; - ` lda $25, {emit_label lbl}\n`; - ` ldq {emit_reg i.res.(0)}, 0($25)\n` - end - | Lop(Iconst_float s) -> - if digital_asm then - ` ldit {emit_reg i.res.(0)}, {emit_string s}\n` - else if Int64.bits_of_float (float_of_string s) = 0L then - ` fmov $f31, {emit_reg i.res.(0)}\n` - else begin - let lbl = new_label() in - float_constants := (lbl, s) :: !float_constants; - ` lda $25, {emit_label lbl}\n`; - ` ldt {emit_reg i.res.(0)}, 0($25)\n` - end - | Lop(Iconst_symbol s) -> - ` lda {emit_reg i.res.(0)}, {emit_symbol s}\n` - | Lop(Icall_ind) -> - liveregs i 0; - ` mov {emit_reg i.arg.(0)}, $27\n`; - ` jsr ({emit_reg i.arg.(0)})\n`; - `{record_frame i.live}\n` - | Lop(Icall_imm s) -> - liveregs i 0; - ` jsr {emit_symbol s}\n`; - `{record_frame i.live}\n` - | Lop(Itailcall_ind) -> - let n = frame_size() in - if !contains_calls then - ` ldq $26, {emit_int(n - 8)}($sp)\n`; - if n > 0 then - ` lda $sp, {emit_int n}($sp)\n`; - ` mov {emit_reg i.arg.(0)}, $27\n`; - liveregs i (live_26 + live_27); - ` jmp ({emit_reg i.arg.(0)})\n` - | Lop(Itailcall_imm s) -> - if s = !function_name then begin - ` br {emit_label !tailrec_entry_point}\n` - end else begin - let n = frame_size() in - if !contains_calls then - ` ldq $26, {emit_int(n - 8)}($sp)\n`; - if n > 0 then - ` lda $sp, {emit_int n}($sp)\n`; - ` lda $27, {emit_symbol s}\n`; - liveregs i (live_26 + live_27); - ` br {emit_symbol s}\n` - end - | Lop(Iextcall(s, alloc)) -> - if alloc then begin - ` lda $25, {emit_symbol s}\n`; - liveregs i live_25; - ` bsr $26, caml_c_call\n`; - `{record_frame i.live}\n` - end else begin - ` jsr {emit_symbol s}\n` - end - | Lop(Istackoffset n) -> - ` lda $sp, {emit_int (-n)}($sp)\n`; - stack_offset := !stack_offset + n - | Lop(Iload(chunk, addr)) -> - let dest = i.res.(0) in - let load_instr = - match chunk with - | Byte_unsigned -> "ldbu" - | Byte_signed -> "ldb" - | Sixteen_unsigned -> "ldwu" - | Sixteen_signed -> "ldw" - | Thirtytwo_unsigned -> "ldl" - | Thirtytwo_signed -> "ldl" - | Word -> "ldq" - | Single -> "lds" - | Double -> "ldt" - | Double_u -> "ldt" in - ` {emit_string load_instr} {emit_reg dest}, {emit_addressing addr i.arg 0}\n`; - if chunk = Thirtytwo_unsigned then - ` zapnot {emit_reg dest}, 15, {emit_reg dest}\n` - | Lop(Istore(chunk, addr)) -> - let store_instr = - match chunk with - | Byte_unsigned | Byte_signed -> "stb" - | Sixteen_unsigned | Sixteen_signed -> "stw" - | Thirtytwo_unsigned | Thirtytwo_signed -> "stl" - | Word -> "stq" - | Single -> "sts" - | Double -> "stt" - | Double_u -> "stt" in - ` {emit_string store_instr} {emit_reg i.arg.(0)}, {emit_addressing addr i.arg 1}\n` - | Lop(Ialloc n) -> - if !fastcode_flag then begin - let lbl_redo = new_label() in - let lbl_call_gc = new_label() in - let lbl_frame = record_frame_label i.live in - call_gc_sites := - { gc_lbl = lbl_call_gc; - gc_return_lbl = lbl_redo; - gc_frame = lbl_frame; - gc_instr = i } :: !call_gc_sites; - `{emit_label lbl_redo}: lda $13, -{emit_int n}($13)\n`; - ` cmpult $13, $14, $25\n`; - ` bne $25, {emit_label lbl_call_gc}\n`; - ` addq $13, 8, {emit_reg i.res.(0)}\n` - end else begin - begin match n with - 16 -> liveregs i 0; - ` bsr $26, caml_alloc1\n` - | 24 -> liveregs i 0; - ` bsr $26, caml_alloc2\n` - | 32 -> liveregs i 0; - ` bsr $26, caml_alloc3\n` - | _ -> ` ldiq $25, {emit_int n}\n`; - liveregs i live_25; - ` bsr $26, caml_allocN\n` - end; - (* $gp preserved by caml_alloc* *) - `{record_frame i.live} addq $13, 8, {emit_reg i.res.(0)}\n` - end - | Lop(Iintop(Icomp cmp)) -> - let (comp, test) = name_for_int_comparison cmp in - ` {emit_string comp} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`; - if not test then - ` xor {emit_reg i.res.(0)}, 1, {emit_reg i.res.(0)}\n` - | Lop(Iintop(Icheckbound)) -> - if !range_check_trap = 0 then range_check_trap := new_label(); - ` cmpule {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, $25\n`; - ` bne $25, {emit_label !range_check_trap}\n` - | Lop(Iintop op) -> - let instr = name_for_int_operation op in - ` {emit_string instr} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n` - | Lop(Iintop_imm(Idiv, n)) -> - if n = 1 lsl (Misc.log2 n) then begin - let l = Misc.log2 n in - if is_immediate n then - ` addq {emit_reg i.arg.(0)}, {emit_int(n-1)}, $25\n` - else begin - ` ldiq $25, {emit_int(n-1)}\n`; - ` addq {emit_reg i.arg.(0)}, $25, $25\n` - end; - ` cmovge {emit_reg i.arg.(0)}, {emit_reg i.arg.(0)}, $25\n`; - ` sra $25, {emit_int l}, {emit_reg i.res.(0)}\n` - end else begin - (* divq with immediate arg is incorrectly assembled in Tru64 5.1, - so emulate it ourselves *) - ` ldiq $25, {emit_int n}\n`; - ` divq {emit_reg i.arg.(0)}, $25, {emit_reg i.res.(0)}\n` - end - | Lop(Iintop_imm(Imod, n)) -> - if n = 1 lsl (Misc.log2 n) then begin - if is_immediate n then - ` and {emit_reg i.arg.(0)}, {emit_int(n-1)}, $25\n` - else begin - ` ldiq $25, {emit_int (n-1)}\n`; - ` and {emit_reg i.arg.(0)}, $25, $25\n` - end; - ` subq $25, {emit_int n}, $24\n`; - ` cmovge {emit_reg i.arg.(0)}, $25, $24\n`; - ` cmoveq $25, $25, $24\n`; - ` mov $24, {emit_reg i.res.(0)}\n` - end else begin - (* remq with immediate arg is incorrectly assembled in Tru64 5.1, - so emulate it ourselves *) - ` ldiq $25, {emit_int n}\n`; - ` remq {emit_reg i.arg.(0)}, $25, {emit_reg i.res.(0)}\n` - end - | Lop(Iintop_imm(Ilsl, 1)) -> - (* Turn x << 1 into x + x, slightly faster according to the docs *) - ` addq {emit_reg i.arg.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n` - | Lop(Iintop_imm(Icomp cmp, n)) -> - let (comp, test) = name_for_int_comparison cmp in - ` {emit_string comp} {emit_reg i.arg.(0)}, {emit_int n}, {emit_reg i.res.(0)}\n`; - if not test then - ` xor {emit_reg i.res.(0)}, 1, {emit_reg i.res.(0)}\n` - - | Lop(Iintop_imm(Icheckbound, n)) -> - if !range_check_trap = 0 then range_check_trap := new_label(); - ` cmpule {emit_reg i.arg.(0)}, {emit_int n}, $25\n`; - ` bne $25, {emit_label !range_check_trap}\n` - | Lop(Iintop_imm(op, n)) -> - let instr = name_for_int_operation op in - ` {emit_string instr} {emit_reg i.arg.(0)}, {emit_int n}, {emit_reg i.res.(0)}\n` - | Lop(Inegf | Iabsf as op) -> - let instr = name_for_float_operation op in - ` {emit_string instr} {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n` - | Lop(Iaddf | Isubf | Imulf | Idivf as op) -> - let instr = name_for_float_operation op in - ` {emit_string instr} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n` - | Lop(Ifloatofint) -> - ` .set noat\n`; - ` lda $sp, -8($sp)\n`; - ` stq {emit_reg i.arg.(0)}, 0($sp)\n`; - ` ldt $f28, 0($sp)\n`; - ` cvtqt $f28, {emit_reg i.res.(0)}\n`; - ` lda $sp, 8($sp)\n`; - ` .set at\n` - | Lop(Iintoffloat) -> - ` .set noat\n`; - ` lda $sp, -8($sp)\n`; - ` cvttqc {emit_reg i.arg.(0)}, $f28\n`; - ` stt $f28, 0($sp)\n`; - ` ldq {emit_reg i.res.(0)}, 0($sp)\n`; - ` lda $sp, 8($sp)\n`; - ` .set at\n` - | Lop(Ispecific(Ireloadgp marked_r26)) -> - ` ldgp $gp, 0($26)\n`; - if marked_r26 then - ` bic $gp, 1, $gp\n` - | Lop(Ispecific Itrunc32) -> - ` addl {emit_reg i.arg.(0)}, 0, {emit_reg i.res.(0)}\n` - | Lop(Ispecific sop) -> - let instr = name_for_specific_operation sop in - ` {emit_string instr} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n` - | Lreloadretaddr -> - let n = frame_size() in - ` ldq $26, {emit_int(n - 8)}($sp)\n` - | Lreturn -> - let n = frame_size() in - if n > 0 then - ` lda $sp, {emit_int n}($sp)\n`; - liveregs i live_26; - ` ret ($26)\n` - | Llabel lbl -> - `{emit_Llabel fallthrough lbl}:\n` - | Lbranch lbl -> - ` br {emit_label lbl}\n` - | Lcondbranch(tst, lbl) -> - begin match tst with - Itruetest -> - ` bne {emit_reg i.arg.(0)}, {emit_label lbl}\n` - | Ifalsetest -> - ` beq {emit_reg i.arg.(0)}, {emit_label lbl}\n` - | Iinttest cmp -> - let (comp, test) = name_for_int_comparison cmp in - ` {emit_string comp} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, $25\n`; - if test then - ` bne $25, {emit_label lbl}\n` - else - ` beq $25, {emit_label lbl}\n` - | Iinttest_imm(cmp, 0) -> - let branch = name_for_int_cond_branch cmp in - ` {emit_string branch} {emit_reg i.arg.(0)}, {emit_label lbl}\n` - | Iinttest_imm(cmp, n) -> - let (comp, test) = name_for_int_comparison cmp in - ` {emit_string comp} {emit_reg i.arg.(0)}, {emit_int n}, $25\n`; - if test then - ` bne $25, {emit_label lbl}\n` - else - ` beq $25, {emit_label lbl}\n` - | Ifloattest(cmp, neg) -> - ` .set noat\n`; - let (comp, swap, test) = name_for_float_comparison cmp neg in - ` {emit_string comp} `; - if swap - then `{emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, $f28\n` - else `{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, $f28\n`; - if test - then ` fbeq $f28, {emit_label lbl}\n` - else ` fbne $f28, {emit_label lbl}\n`; - ` .set at\n` - | Ioddtest -> - ` blbs {emit_reg i.arg.(0)}, {emit_label lbl}\n` - | Ieventest -> - ` blbc {emit_reg i.arg.(0)}, {emit_label lbl}\n` - end - | Lcondbranch3(lbl0, lbl1, lbl2) -> - begin match lbl0 with - None -> () - | Some lbl -> ` beq {emit_reg i.arg.(0)}, {emit_label lbl}\n` - end; - begin match lbl1 with - None -> () - | Some lbl -> ` blbs {emit_reg i.arg.(0)}, {emit_label lbl}\n` - end; - begin match lbl2 with - None -> () - | Some lbl -> - if lbl0 <> None then - ` blbc {emit_reg i.arg.(0)}, {emit_label lbl}\n` - else if lbl1 <> None then - ` bne {emit_reg i.arg.(0)}, {emit_label lbl}\n` - else begin - ` subq {emit_reg i.arg.(0)}, 2, $25\n`; - ` beq $25, {emit_label lbl}\n` - end - end - | Lswitch jumptbl -> - let lbl_jumptbl = new_label() in - ` lda $25, {emit_label lbl_jumptbl}\n`; - ` s4addq {emit_reg i.arg.(0)}, $25, $25\n`; - ` ldl $25, 0($25)\n`; - ` addq $gp, $25, $25\n`; - ` jmp ($25), {emit_label jumptbl.(0)}\n`; - ` {emit_string rdata_section}\n`; - `{emit_label lbl_jumptbl}:`; - for i = 0 to Array.length jumptbl - 1 do - ` .gprel32 {emit_label jumptbl.(i)}\n` - done; - ` .text\n` - | Lsetuptrap lbl -> - ` br $25, {emit_label lbl}\n` - | Lpushtrap -> - stack_offset := !stack_offset + 16; - ` lda $sp, -16($sp)\n`; - ` stq $15, 0($sp)\n`; - ` stq $25, 8($sp)\n`; - ` mov $sp, $15\n` - | Lpoptrap -> - ` ldq $15, 0($sp)\n`; - ` lda $sp, 16($sp)\n`; - stack_offset := !stack_offset - 16 - | Lraise -> - ` ldq $26, 8($15)\n`; - ` mov $15, $sp\n`; - ` ldq $15, 0($sp)\n`; - ` lda $sp, 16($sp)\n`; - liveregs i live_26; - ` jmp $25, ($26)\n` (* Keep retaddr in $25 for debugging *) - -let rec emit_all fallthrough i = match i.desc with -| Lend -> () -| _ -> - emit_instr fallthrough i; - emit_all (has_fallthrough i.desc) i.next - -(* Emission of a function declaration *) - -let emit_fundecl (fundecl, needs_gp) = - function_name := fundecl.fun_name; - fastcode_flag := fundecl.fun_fast; - stack_offset := 0; - call_gc_sites := []; - range_check_trap := 0; - float_constants := []; - bigint_constants := []; - ` .text\n`; - ` .align 4\n`; - ` .globl {emit_symbol fundecl.fun_name}\n`; - ` .ent {emit_symbol fundecl.fun_name}\n`; - `{emit_symbol fundecl.fun_name}:\n`; - if needs_gp then begin - ` .set noreorder\n`; - ` ldgp $gp, 0($27)\n`; - ` .set reorder\n` - end; - let n = frame_size() in - if n > 0 then - ` lda $sp, -{emit_int n}($sp)\n`; - if !contains_calls then begin - ` stq $26, {emit_int(n - 8)}($sp)\n`; - ` .mask 0x04000000, -8\n`; - ` .fmask 0x0, 0\n` - end; - ` .frame $sp, {emit_int n}, $26\n`; - ` .prologue {emit_int(if needs_gp then 1 else 0)}\n`; - tailrec_entry_point := new_label(); - `{emit_label !tailrec_entry_point}:\n`; - emit_all true fundecl.fun_body; - List.iter emit_call_gc !call_gc_sites; - if !range_check_trap > 0 then begin - `{emit_label !range_check_trap}:\n`; - ` br $26, caml_ml_array_bound_error\n` - (* Keep retaddr in $26 for debugging *) - end; - ` .end {emit_symbol fundecl.fun_name}\n`; - if !bigint_constants <> [] then begin - ` {emit_string rdata_section}\n`; - ` .align 3\n`; - List.iter - (fun (lbl, n) -> `{emit_label lbl}: .quad 0x{emit_string(Nativeint.format "%x" n)}\n`) - !bigint_constants - end; - if !float_constants <> [] then begin - ` {emit_string rdata_section}\n`; - ` .align 3\n`; - List.iter - (fun (lbl, s) -> `{emit_label lbl}: .t_floating {emit_string s}\n`) - !float_constants - end - -let fundecl f = - emit_fundecl (insert_load_gp f) - -(* Emission of data *) - -let emit_item = function - Cglobal_symbol s -> - ` .globl {emit_symbol s}\n`; - | Cdefine_symbol s -> - `{emit_symbol s}:\n` - | Cdefine_label lbl -> - `{emit_label (100000 + lbl)}:\n` - | Cint8 n -> - ` .byte {emit_int n}\n` - | Cint16 n -> - ` .word {emit_int n}\n` - | Cint32 n -> - let n' = Nativeint.shift_right (Nativeint.shift_left n 32) 32 in - ` .long {emit_nativeint n'}\n` - | Cint n -> - if digital_asm then - ` .quad {emit_nativeint n}\n` - else - (* Work around a bug in gas regarding the parsing of - long decimal constants *) - ` .quad 0x{emit_string(Nativeint.format "%x" n)}\n` - | Csingle f -> - emit_float32_directive ".long" f - | Cdouble f -> - emit_float64_directive ".quad" f - | Csymbol_address s -> - ` .quad {emit_symbol s}\n` - | Clabel_address lbl -> - ` .quad {emit_label (100000 + lbl)}\n` - | Cstring s -> - emit_string_directive " .ascii " s - | Cskip n -> - if n > 0 then ` .space {emit_int n}\n` - | Calign n -> - ` .align {emit_int(Misc.log2 n)}\n` - -let data l = - ` .data\n`; - List.iter emit_item l - -(* Beginning / end of an assembly file *) - -let begin_assembly() = - (* There are really two groups of registers: - $sp and $15 always point to stack locations - $0 - $14, $16-$23 never point to stack locations. *) - ` .noalias $0,$sp; .noalias $0,$15; .noalias $1,$sp; .noalias $1,$15\n`; - ` .noalias $2,$sp; .noalias $2,$15; .noalias $3,$sp; .noalias $3,$15\n`; - ` .noalias $4,$sp; .noalias $4,$15; .noalias $5,$sp; .noalias $5,$15\n`; - ` .noalias $6,$sp; .noalias $6,$15; .noalias $7,$sp; .noalias $7,$15\n`; - ` .noalias $8,$sp; .noalias $8,$15; .noalias $9,$sp; .noalias $9,$15\n`; - ` .noalias $10,$sp; .noalias $10,$15; .noalias $11,$sp; .noalias $11,$15\n`; - ` .noalias $12,$sp; .noalias $12,$15; .noalias $13,$sp; .noalias $13,$15\n`; - ` .noalias $14,$sp; .noalias $14,$15; .noalias $16,$sp; .noalias $16,$15\n`; - ` .noalias $17,$sp; .noalias $17,$15; .noalias $18,$sp; .noalias $18,$15\n`; - ` .noalias $19,$sp; .noalias $19,$15; .noalias $20,$sp; .noalias $20,$15\n`; - ` .noalias $21,$sp; .noalias $21,$15; .noalias $22,$sp; .noalias $22,$15\n`; - ` .noalias $23,$sp; .noalias $23,$15\n\n`; - (* The following .file directive is intended to prevent the generation - of line numbers for the debugger, 'cos they make .o files larger - and slow down linking. *) - ` .file 1 \"{emit_string !Location.input_name}\"\n\n`; - let lbl_begin = Compilenv.make_symbol (Some "data_begin") in - ` .data\n`; - ` .globl {emit_symbol lbl_begin}\n`; - `{emit_symbol lbl_begin}:\n`; - let lbl_begin = Compilenv.make_symbol (Some "code_begin") in - ` .text\n`; - ` .globl {emit_symbol lbl_begin}\n`; - `{emit_symbol lbl_begin}:\n` - -let end_assembly () = - let lbl_end = Compilenv.make_symbol (Some "code_end") in - ` .text\n`; - ` .globl {emit_symbol lbl_end}\n`; - `{emit_symbol lbl_end}:\n`; - let lbl_end = Compilenv.make_symbol (Some "data_end") in - ` .data\n`; - ` .globl {emit_symbol lbl_end}\n`; - `{emit_symbol lbl_end}:\n`; - ` .quad 0\n`; - let lbl_frame = Compilenv.make_symbol (Some "frametable") in - ` {emit_string rdata_section}\n`; - ` .globl {emit_symbol lbl_frame}\n`; - `{emit_symbol lbl_frame}:\n`; - ` .quad {emit_int (List.length !frame_descriptors)}\n`; - List.iter emit_frame !frame_descriptors; - frame_descriptors := [] diff -Nru ocaml-3.12.1/asmcomp/alpha/proc.ml ocaml-4.01.0/asmcomp/alpha/proc.ml --- ocaml-3.12.1/asmcomp/alpha/proc.ml 2010-04-18 09:02:40.000000000 +0000 +++ ocaml-4.01.0/asmcomp/alpha/proc.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,217 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: proc.ml 10268 2010-04-18 09:02:40Z xleroy $ *) - -(* Description of the Alpha processor *) - -open Misc -open Cmm -open Reg -open Arch -open Mach - -(* Instruction selection *) - -let word_addressed = true - -(* Registers available for register allocation *) - -(* Register map: - $0 - $7 0 - 7 function results - $8 - $12 8 - 12 general purpose ($9 - $15 are preserved by C) - $13 allocation pointer - $14 allocation limit - $15 trap pointer - $16 - $22 13 - 19 function arguments - $23 - $25 temporaries (for the code gen and for the asm) - $26 - $30 stack ptr, global ptr, etc - $31 always zero - - $f0 - $f7 100 - 107 function results - $f8 - $f15 108 - 115 general purpose ($f2 - $f9 preserved by C) - $f16 - $f23 116 - 123 function arguments - $f24 - $f30 124 - 129 general purpose - $f28 temporary - $f31 always zero *) - -let int_reg_name = [| - (* 0-7 *) "$0"; "$1"; "$2"; "$3"; "$4"; "$5"; "$6"; "$7"; - (* 8-12 *) "$8"; "$9"; "$10"; "$11"; "$12"; - (* 13-19 *) "$16"; "$17"; "$18"; "$19"; "$20"; "$21"; "$22" -|] - -let float_reg_name = [| - (* 100-107 *) "$f0"; "$f1"; "$f2"; "$f3"; "$f4"; "$f5"; "$f6"; "$f7"; - (* 108-115 *) "$f8"; "$f9"; "$f10"; "$f11"; "$f12"; "$f13"; "$f14"; "$f15"; - (* 116-123 *) "$f16"; "$f17"; "$f18"; "$f19"; "$f20"; "$f21"; "$f22"; "$f23"; - (* 124-129 *) "$f24"; "$f25"; "$f26"; "$f27"; "$f29"; "$f30" -|] - -let num_register_classes = 2 - -let register_class r = - match r.typ with - Int -> 0 - | Addr -> 0 - | Float -> 1 - -let num_available_registers = [| 20; 30 |] - -let first_available_register = [| 0; 100 |] - -let register_name r = - if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100) - -let rotate_registers = true - -(* Representation of hard registers by pseudo-registers *) - -let hard_int_reg = - let v = Array.create 20 Reg.dummy in - for i = 0 to 19 do v.(i) <- Reg.at_location Int (Reg i) done; - v - -let hard_float_reg = - let v = Array.create 30 Reg.dummy in - for i = 0 to 29 do v.(i) <- Reg.at_location Float (Reg(100 + i)) done; - v - -let all_phys_regs = - Array.append hard_int_reg hard_float_reg - -let phys_reg n = - if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100) - -let stack_slot slot ty = - Reg.at_location ty (Stack slot) - -(* Calling conventions *) - -let calling_conventions first_int last_int first_float last_float make_stack - arg = - let loc = Array.create (Array.length arg) Reg.dummy in - let int = ref first_int in - let float = ref first_float in - let ofs = ref 0 in - for i = 0 to Array.length arg - 1 do - match arg.(i).typ with - Int | Addr as ty -> - if !int <= last_int then begin - loc.(i) <- phys_reg !int; - incr int - end else begin - loc.(i) <- stack_slot (make_stack !ofs) ty; - ofs := !ofs + size_int - end - | Float -> - if !float <= last_float then begin - loc.(i) <- phys_reg !float; - incr float - end else begin - loc.(i) <- stack_slot (make_stack !ofs) Float; - ofs := !ofs + size_float - end - done; - (loc, Misc.align !ofs 16) (* Keep stack 16-aligned *) - -let incoming ofs = Incoming ofs -let outgoing ofs = Outgoing ofs -let not_supported ofs = fatal_error "Proc.loc_results: cannot call" - -let loc_arguments arg = - calling_conventions 13 18 116 123 outgoing arg -let loc_parameters arg = - let (loc, ofs) = calling_conventions 13 18 116 123 incoming arg in loc -let loc_results res = - let (loc, ofs) = calling_conventions 0 7 100 107 not_supported res in loc - -(* On the Alpha, C functions have calling conventions similar to those - for Caml functions, except that integer and floating-point registers - for arguments are allocated "in sequence". E.g. a function - taking a float f1 and two ints i2 and i3 will put f1 in the - first float reg, i2 in the second int reg and i3 in the third int reg. *) - -let ext_calling_conventions first_int last_int first_float last_float - make_stack arg = - let loc = Array.create (Array.length arg) Reg.dummy in - let int = ref first_int in - let float = ref first_float in - let ofs = ref 0 in - for i = 0 to Array.length arg - 1 do - match arg.(i).typ with - Int | Addr as ty -> - if !int <= last_int then begin - loc.(i) <- phys_reg !int; incr int; incr float - end else begin - loc.(i) <- stack_slot (make_stack !ofs) ty; - ofs := !ofs + size_int - end - | Float -> - if !float <= last_float then begin - loc.(i) <- phys_reg !float; incr int; incr float - end else begin - loc.(i) <- stack_slot (make_stack !ofs) Float; - ofs := !ofs + size_float - end - done; - (loc, Misc.align !ofs 16) (* Keep stack 16-aligned *) - -let loc_external_arguments arg = - ext_calling_conventions 13 18 116 121 outgoing arg -let loc_external_results res = - let (loc, ofs) = ext_calling_conventions 0 0 100 100 not_supported res in loc -let extcall_use_push = false - -let loc_exn_bucket = phys_reg 0 (* $0 *) - -(* Registers destroyed by operations *) - -let destroyed_at_c_call = (* $9 - $12, $f2 - $f9 preserved *) - Array.of_list(List.map phys_reg - [0;1;2;3;4;5;6;7;8;13;14;15;16;17;18;19; - 100;101;110;111;112;113;114;115;116;117;118;119;120;121;122;123;124; - 125;126;127;128;129]) - -let destroyed_at_oper = function - Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs - | Iop(Iextcall(_, false)) -> destroyed_at_c_call - | _ -> [||] - -let destroyed_at_raise = all_phys_regs - -(* Maximal register pressure *) - -let safe_register_pressure = function - Iextcall(_, _) -> 4 - | _ -> 19 -let max_register_pressure = function - Iextcall(_, _) -> [| 4; 8 |] - | _ -> [| 19; 29 |] - -(* Layout of the stack *) - -let num_stack_slots = [| 0; 0 |] -let contains_calls = ref false - -(* Calling the assembler *) - -let assemble_file infile outfile = - let as_cmd = - if digital_asm && !Clflags.gprofile - then Config.asm ^ " -pg" - else Config.asm in - Ccomp.command (as_cmd ^ " -o " ^ - Filename.quote outfile ^ " " ^ Filename.quote infile) - -open Clflags;; -open Config;; diff -Nru ocaml-3.12.1/asmcomp/alpha/reload.ml ocaml-4.01.0/asmcomp/alpha/reload.ml --- ocaml-3.12.1/asmcomp/alpha/reload.ml 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/alpha/reload.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,18 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: reload.ml 2553 1999-11-17 18:59:06Z xleroy $ *) - -(* Reloading for the Alpha *) - -let fundecl f = - (new Reloadgen.reload_generic)#fundecl f diff -Nru ocaml-3.12.1/asmcomp/alpha/scheduling.ml ocaml-4.01.0/asmcomp/alpha/scheduling.ml --- ocaml-3.12.1/asmcomp/alpha/scheduling.ml 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/alpha/scheduling.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,70 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: scheduling.ml 2553 1999-11-17 18:59:06Z xleroy $ *) - -open Arch -open Mach - -(* The Digital Unix assembler does scheduling better than us. - However, the Linux-Alpha assembler does not do scheduling, so we do - a feeble attempt here. *) - -class scheduler = object (self) - -inherit Schedgen.scheduler_generic as super - -(* Latencies (in cycles). Based on the 21064, with some poetic license. *) - -method oper_latency = function - Ireload -> 3 - | Iload(_, _) -> 3 - | Iconst_symbol _ -> 3 (* turned into a load *) - | Iconst_float _ -> 3 (* ends up in a load *) - | Iintop(Imul) -> 23 - | Iintop_imm(Imul, _) -> 23 - | Iaddf -> 6 - | Isubf -> 6 - | Imulf -> 6 - | Idivf -> 63 - | _ -> 2 - (* Most arithmetic instructions can be executed back-to-back in 1 cycle. - However, some combinations (arith; load or arith; store) require 2 - cycles. Also, by claiming 2 cycles instead of 1, we might favor - dual issue. *) - -(* Issue cycles. Rough approximations. *) - -method oper_issue_cycles = function - Iconst_float _ -> 4 (* load from $gp, then load *) - | Ialloc _ -> 4 - | Iintop(Icheckbound) -> 2 - | Iintop_imm(Idiv, _) -> 3 - | Iintop_imm(Imod, _) -> 5 - | Iintop_imm(Icheckbound, _) -> 2 - | Ifloatofint -> 10 - | Iintoffloat -> 10 - | _ -> 1 - -(* Say that reloadgp is not part of a basic block (prevents moving it - past an operation that uses $gp) *) - -method oper_in_basic_block = function - Ispecific(Ireloadgp _) -> false - | op -> super#oper_in_basic_block op - -end - -let fundecl = - if digital_asm - then (fun f -> f) - else (new scheduler)#schedule_fundecl diff -Nru ocaml-3.12.1/asmcomp/alpha/selection.ml ocaml-4.01.0/asmcomp/alpha/selection.ml --- ocaml-3.12.1/asmcomp/alpha/selection.ml 2010-04-22 12:51:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/alpha/selection.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,83 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1997 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: selection.ml 10296 2010-04-22 12:51:06Z xleroy $ *) - -(* Instruction selection for the Alpha processor *) - -open Misc -open Cmm -open Reg -open Arch -open Mach - -class selector = object (self) - -inherit Selectgen.selector_generic as super - -method is_immediate n = digital_asm || (n >= 0 && n <= 255) - -method select_addressing = function - (* Force an explicit lda for non-scheduling assemblers, - this allows our scheduler to do a better job. *) - Cconst_symbol s when digital_asm -> - (Ibased(s, 0), Ctuple []) - | Cop((Cadda | Caddi), [Cconst_symbol s; Cconst_int n]) when digital_asm -> - (Ibased(s, n), Ctuple []) - | Cop((Cadda | Caddi), [arg; Cconst_int n]) -> - (Iindexed n, arg) - | Cop((Cadda | Caddi), [arg1; Cop(Caddi, [arg2; Cconst_int n])]) -> - (Iindexed n, Cop(Cadda, [arg1; arg2])) - | arg -> - (Iindexed 0, arg) - -method! select_operation op args = - match (op, args) with - (* Recognize shift-add operations *) - ((Caddi|Cadda), - [arg2; Cop(Clsl, [arg1; Cconst_int(2|3 as shift)])]) -> - (Ispecific(if shift = 2 then Iadd4 else Iadd8), [arg1; arg2]) - | ((Caddi|Cadda), - [arg2; Cop(Cmuli, [arg1; Cconst_int(4|8 as mult)])]) -> - (Ispecific(if mult = 4 then Iadd4 else Iadd8), [arg1; arg2]) - | ((Caddi|Cadda), - [arg2; Cop(Cmuli, [Cconst_int(4|8 as mult); arg1])]) -> - (Ispecific(if mult = 4 then Iadd4 else Iadd8), [arg1; arg2]) - | (Caddi, [Cop(Clsl, [arg1; Cconst_int(2|3 as shift)]); arg2]) -> - (Ispecific(if shift = 2 then Iadd4 else Iadd8), [arg1; arg2]) - | (Caddi, [Cop(Cmuli, [arg1; Cconst_int(4|8 as mult)]); arg2]) -> - (Ispecific(if mult = 4 then Iadd4 else Iadd8), [arg1; arg2]) - | (Caddi, [Cop(Cmuli, [Cconst_int(4|8 as mult); arg1]); arg2]) -> - (Ispecific(if mult = 4 then Iadd4 else Iadd8), [arg1; arg2]) - | (Csubi, [Cop(Clsl, [arg1; Cconst_int(2|3 as shift)]); arg2]) -> - (Ispecific(if shift = 2 then Isub4 else Isub8), [arg1; arg2]) - | (Csubi, [Cop(Cmuli, [Cconst_int(4|8 as mult); arg1]); arg2]) -> - (Ispecific(if mult = 4 then Isub4 else Isub8), [arg1; arg2]) - (* Recognize truncation/normalization of 64-bit integers to 32 bits *) - | (Casr, [Cop(Clsl, [arg; Cconst_int 32]); Cconst_int 32]) -> - (Ispecific Itrunc32, [arg]) - (* Work around various limitations of the GNU assembler *) - | ((Caddi|Cadda), [arg1; Cconst_int n]) - when not (self#is_immediate n) && self#is_immediate (-n) -> - (Iintop_imm(Isub, -n), [arg1]) - | (Cdivi, [arg1; Cconst_int n]) - when (not digital_asm) && n <> 1 lsl (Misc.log2 n) -> - (Iintop Idiv, args) - | (Cmodi, [arg1; Cconst_int n]) - when (not digital_asm) && n <> 1 lsl (Misc.log2 n) -> - (Iintop Imod, args) - | _ -> - super#select_operation op args - -end - -let fundecl f = (new selector)#emit_fundecl f diff -Nru ocaml-3.12.1/asmcomp/amd64/arch.ml ocaml-4.01.0/asmcomp/amd64/arch.ml --- ocaml-3.12.1/asmcomp/amd64/arch.ml 2007-01-01 13:07:35.000000000 +0000 +++ ocaml-4.01.0/asmcomp/amd64/arch.ml 2013-03-09 22:38:52.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: arch.ml 7784 2007-01-01 13:07:35Z xleroy $ *) - (* Machine-specific command-line options *) let pic_code = ref true @@ -40,6 +38,9 @@ | Ioffset_loc of int * addressing_mode (* Add a constant to a location *) | Ifloatarithmem of float_operation * addressing_mode (* Float arith operation with memory *) + | Ibswap of int (* endiannes conversion *) + | Isqrtf (* Float square root *) + | Ifloatsqrtf of addressing_mode (* Float square root from memory *) and float_operation = Ifloatadd | Ifloatsub | Ifloatmul | Ifloatdiv @@ -51,6 +52,12 @@ let size_int = 8 let size_float = 8 +let allow_unaligned_access = true + +(* Behavior of division *) + +let division_crashes_on_overflow = true + (* Operations on addressing modes *) let identity_addressing = Iindexed 0 @@ -100,6 +107,11 @@ fprintf ppf "[%a] := \"%s\"" (print_addressing printreg addr) arg lbl | Ioffset_loc(n, addr) -> fprintf ppf "[%a] +:= %i" (print_addressing printreg addr) arg n + | Isqrtf -> + fprintf ppf "sqrtf %a" printreg arg.(0) + | Ifloatsqrtf addr -> + fprintf ppf "sqrtf float64[%a]" + (print_addressing printreg addr) [|arg.(0)|] | Ifloatarithmem(op, addr) -> let op_name = function | Ifloatadd -> "+f" @@ -109,3 +121,5 @@ fprintf ppf "%a %s float64[%a]" printreg arg.(0) (op_name op) (print_addressing printreg addr) (Array.sub arg 1 (Array.length arg - 1)) + | Ibswap i -> + fprintf ppf "bswap_%i %a" i printreg arg.(0) diff -Nru ocaml-3.12.1/asmcomp/amd64/emit.mlp ocaml-4.01.0/asmcomp/amd64/emit.mlp --- ocaml-3.12.1/asmcomp/amd64/emit.mlp 2011-03-13 13:33:17.000000000 +0000 +++ ocaml-4.01.0/asmcomp/amd64/emit.mlp 2013-06-03 18:03:59.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,11 +10,8 @@ (* *) (***********************************************************************) -(* $Id: emit.mlp 10980 2011-03-13 13:33:17Z xleroy $ *) - (* Emission of x86-64 (AMD 64) assembly code *) -open Misc open Cmm open Arch open Proc @@ -23,11 +20,10 @@ open Linearize open Emitaux -let macosx = - match Config.system with - | "macosx" -> true - | _ -> false +let macosx = (Config.system = "macosx") +let mingw64 = (Config.system = "mingw64") +let fp = Config.with_frame_pointers (* Tradeoff between code size and code speed *) @@ -38,12 +34,13 @@ (* Layout of the stack frame *) let frame_required () = - !contains_calls || num_stack_slots.(0) > 0 || num_stack_slots.(1) > 0 + fp || !contains_calls || num_stack_slots.(0) > 0 || num_stack_slots.(1) > 0 let frame_size () = (* includes return address *) if frame_required() then begin let sz = - (!stack_offset + 8 * (num_stack_slots.(0) + num_stack_slots.(1)) + 8) + (!stack_offset + 8 * (num_stack_slots.(0) + num_stack_slots.(1)) + 8 + + (if fp then 8 else 0) ) in Misc.align sz 16 end else !stack_offset + 8 @@ -64,17 +61,17 @@ Emitaux.emit_symbol '$' s let emit_call s = - if !Clflags.dlcode && not macosx + if !Clflags.dlcode && not macosx && not mingw64 then `call {emit_symbol s}@PLT` else `call {emit_symbol s}` let emit_jump s = - if !Clflags.dlcode && not macosx + if !Clflags.dlcode && not macosx && not mingw64 then `jmp {emit_symbol s}@PLT` else `jmp {emit_symbol s}` let load_symbol_addr s = - if !Clflags.dlcode + if !Clflags.dlcode && not mingw64 then `movq {emit_symbol s}@GOTPCREL(%rip)` else if !pic_code then `leaq {emit_symbol s}(%rip)` @@ -85,6 +82,9 @@ let emit_label lbl = emit_string ".L"; emit_int lbl +let emit_data_label lbl = + emit_string ".Ld"; emit_int lbl + (* Output a .align directive. *) let emit_align n = @@ -110,13 +110,13 @@ let reg_low_8_name = [| "%al"; "%bl"; "%dil"; "%sil"; "%dl"; "%cl"; "%r8b"; "%r9b"; - "%r10b"; "%r11b"; "%bpl"; "%r12b"; "%r13b" |] + "%r12b"; "%r13b"; "%r10b"; "%r11b"; "%bpl" |] let reg_low_16_name = [| "%ax"; "%bx"; "%di"; "%si"; "%dx"; "%cx"; "%r8w"; "%r9w"; - "%r10w"; "%r11w"; "%bp"; "%r12w"; "%r13w" |] + "%r12w"; "%r13w"; "%r10w"; "%r11w"; "%bp" |] let reg_low_32_name = [| "%eax"; "%ebx"; "%edi"; "%esi"; "%edx"; "%ecx"; "%r8d"; "%r9d"; - "%r10d"; "%r11d"; "%ebp"; "%r12d"; "%r13d" |] + "%r12d"; "%r13d"; "%r10d"; "%r11d"; "%ebp" |] let emit_subreg tbl r = match r.loc with @@ -291,25 +291,25 @@ ` jp {emit_label lbl}\n`; (* branch taken if unordered *) ` jne {emit_label lbl}\n` (* branch taken if xy *) | (Clt, _) -> - ` comisd {emit_reg arg.(0)}, {emit_reg arg.(1)}\n`; (* swap compare *) + ` comisd {emit_reg arg.(0)}, {emit_reg arg.(1)}\n`; (* swap compare *) if not neg then ` ja {emit_label lbl}\n` (* branch taken if y>x i.e. x - ` comisd {emit_reg arg.(0)}, {emit_reg arg.(1)}\n`; (* swap compare *) + ` comisd {emit_reg arg.(0)}, {emit_reg arg.(1)}\n`; (* swap compare *) if not neg then ` jae {emit_label lbl}\n` (* branch taken if y>=x i.e. x<=y *) else ` jb {emit_label lbl}\n` (* taken if unordered or y - ` comisd {emit_reg arg.(1)}, {emit_reg arg.(0)}\n`; + ` comisd {emit_reg arg.(1)}, {emit_reg arg.(0)}\n`; if not neg then ` ja {emit_label lbl}\n` (* branch taken if x>y *) else ` jbe {emit_label lbl}\n` (* taken if unordered or x<=y i.e. !(x>y) *) | (Cge, _) -> - ` comisd {emit_reg arg.(1)}, {emit_reg arg.(0)}\n`; (* swap compare *) + ` comisd {emit_reg arg.(1)}, {emit_reg arg.(0)}\n`; (* swap compare *) if not neg then ` jae {emit_label lbl}\n` (* branch taken if x>=y *) else @@ -317,11 +317,37 @@ (* Deallocate the stack frame before a return or tail call *) -let output_epilogue () = +let output_epilogue f = if frame_required() then begin - let n = frame_size() - 8 in - ` addq ${emit_int n}, %rsp\n` + let n = frame_size() - 8 - (if fp then 8 else 0) in + ` addq ${emit_int n}, %rsp\n`; + cfi_adjust_cfa_offset (-n); + if fp then begin + ` popq %rbp\n` + end; + f (); + (* reset CFA back cause function body may continue *) + cfi_adjust_cfa_offset n end + else + f () + +(* Floating-point constants *) + +let float_constants = ref ([] : (string * int) list) + +let add_float_constant cst = + try + List.assoc cst !float_constants + with + Not_found -> + let lbl = new_label() in + float_constants := (cst, lbl) :: !float_constants; + lbl + +let emit_float_constant (cst, lbl) = + `{emit_label lbl}:`; + emit_float64_directive ".quad" cst (* Output the assembly code for an instruction *) @@ -330,9 +356,9 @@ (* Entry point for tail recursive calls *) let tailrec_entry_point = ref 0 -let float_constants = ref ([] : (int * string) list) - +(* Emit an instruction *) let emit_instr fallthrough i = + emit_debug_info i.dbg; match i.desc with Lend -> () | Lop(Imove | Ispill | Ireload) -> @@ -360,8 +386,7 @@ | 0x0000_0000_0000_0000L -> (* +0.0 *) ` xorpd {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` | _ -> - let lbl = new_label() in - float_constants := (lbl, s) :: !float_constants; + let lbl = add_float_constant s in ` movsd {emit_label lbl}(%rip), {emit_reg i.res.(0)}\n` end | Lop(Iconst_symbol s) -> @@ -373,20 +398,24 @@ ` {emit_call s}\n`; record_frame i.live i.dbg | Lop(Itailcall_ind) -> - output_epilogue(); + output_epilogue begin fun () -> ` jmp *{emit_reg i.arg.(0)}\n` + end | Lop(Itailcall_imm s) -> if s = !function_name then ` jmp {emit_label !tailrec_entry_point}\n` else begin - output_epilogue(); + output_epilogue begin fun () -> ` {emit_jump s}\n` + end end | Lop(Iextcall(s, alloc)) -> if alloc then begin ` {load_symbol_addr s}, %rax\n`; ` {emit_call "caml_c_call"}\n`; - record_frame i.live i.dbg + record_frame i.live i.dbg; + ` {load_symbol_addr "caml_young_ptr"}, %r11\n`; + ` movq (%r11), %r15\n`; end else begin ` {emit_call s}\n` end @@ -394,6 +423,7 @@ if n < 0 then ` addq ${emit_int(-n)}, %rsp\n` else ` subq ${emit_int(n)}, %rsp\n`; + cfi_adjust_cfa_offset n; stack_offset := !stack_offset + n | Lop(Iload(chunk, addr)) -> let dest = i.res.(0) in @@ -533,11 +563,28 @@ ` addq ${emit_int n}, {emit_addressing addr i.arg 0}\n` | Lop(Ispecific(Ifloatarithmem(op, addr))) -> ` {emit_string(instr_for_floatarithmem op)} {emit_addressing addr i.arg 1}, {emit_reg i.res.(0)}\n` + | Lop(Ispecific(Ibswap size)) -> + begin match size with + | 16 -> + ` xchg %ah, %al\n`; + ` movzwq {emit_reg16 i.res.(0)}, {emit_reg i.res.(0)}\n` + | 32 -> + ` bswap {emit_reg32 i.res.(0)}\n`; + ` movslq {emit_reg32 i.res.(0)}, {emit_reg i.res.(0)}\n` + | 64 -> + ` bswap {emit_reg i.res.(0)}\n` + | _ -> assert false + end + | Lop(Ispecific Isqrtf) -> + ` sqrtsd {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n` + | Lop(Ispecific(Ifloatsqrtf addr)) -> + ` sqrtsd {emit_addressing addr i.arg 0}, {emit_reg i.res.(0)}\n` | Lreloadretaddr -> () | Lreturn -> - output_epilogue(); + output_epilogue begin fun () -> ` ret\n` + end | Llabel lbl -> `{emit_Llabel fallthrough lbl}:\n` | Lbranch lbl -> @@ -601,9 +648,12 @@ ` movslq ({emit_reg tmp1}, {emit_reg i.arg.(0)}, 4), {emit_reg tmp2}\n`; ` addq {emit_reg tmp2}, {emit_reg tmp1}\n`; ` jmp *{emit_reg tmp1}\n`; - if macosx - then ` .const\n` - else ` .section .rodata\n`; + if macosx then + ` .const\n` + else if mingw64 then + ` .section .rdata,\"dr\"\n` + else + ` .section .rodata\n`; emit_align 4; `{emit_label lbl}:`; for i = 0 to Array.length jumptbl - 1 do @@ -613,12 +663,16 @@ | Lsetuptrap lbl -> ` call {emit_label lbl}\n` | Lpushtrap -> + cfi_adjust_cfa_offset 8; ` pushq %r14\n`; + cfi_adjust_cfa_offset 8; ` movq %rsp, %r14\n`; stack_offset := !stack_offset + 16 | Lpoptrap -> ` popq %r14\n`; + cfi_adjust_cfa_offset (-8); ` addq $8, %rsp\n`; + cfi_adjust_cfa_offset (-8); stack_offset := !stack_offset - 16 | Lraise -> if !Clflags.debug then begin @@ -637,26 +691,20 @@ emit_instr fallthrough i; emit_all (Linearize.has_fallthrough i.desc) i.next -(* Emission of the floating-point constants *) - -let emit_float_constant (lbl, cst) = - `{emit_label lbl}:`; - emit_float64_directive ".quad" cst - (* Emission of the profiling prelude *) let emit_profile () = match Config.system with | "linux" | "gnu" -> (* mcount preserves rax, rcx, rdx, rsi, rdi, r8, r9 explicitly - and rbx, rbp, r12-r15 like all C functions. - We need to preserve r10 and r11 ourselves, since Caml can - use them for argument passing. *) + and rbx, rbp, r12-r15 like all C functions. This includes + all the registers used for argument passing, so we don't + need to preserve other regs. We do need to initialize rbp + like mcount expects it, though. *) ` pushq %r10\n`; - ` movq %rsp, %rbp\n`; - ` pushq %r11\n`; + if not fp then + ` movq %rsp, %rbp\n`; ` {emit_call "mcount"}\n`; - ` popq %r11\n`; ` popq %r10\n` | _ -> () (*unsupported yet*) @@ -668,7 +716,6 @@ fastcode_flag := fundecl.fun_fast; tailrec_entry_point := new_label(); stack_offset := 0; - float_constants := []; call_gc_sites := []; bound_error_sites := []; bound_error_call := 0; @@ -682,26 +729,29 @@ else ` .globl {emit_symbol fundecl.fun_name}\n`; `{emit_symbol fundecl.fun_name}:\n`; + emit_debug_info fundecl.fun_dbg; + cfi_startproc (); + if fp then begin + ` pushq %rbp\n`; + cfi_adjust_cfa_offset 8; + ` movq %rsp, %rbp\n`; + end; if !Clflags.gprofile then emit_profile(); if frame_required() then begin - let n = frame_size() - 8 in - ` subq ${emit_int n}, %rsp\n` + let n = frame_size() - 8 - (if fp then 8 else 0) in + ` subq ${emit_int n}, %rsp\n`; + cfi_adjust_cfa_offset n; end; `{emit_label !tailrec_entry_point}:\n`; emit_all true fundecl.fun_body; List.iter emit_call_gc !call_gc_sites; emit_call_bound_errors (); + cfi_endproc (); begin match Config.system with "linux" | "gnu" -> ` .type {emit_symbol fundecl.fun_name},@function\n`; ` .size {emit_symbol fundecl.fun_name},.-{emit_symbol fundecl.fun_name}\n` | _ -> () - end; - if !float_constants <> [] then begin - if macosx - then ` .literal8\n` - else ` .section .rodata.cst8,\"a\",@progbits\n`; - List.iter emit_float_constant !float_constants end (* Emission of data *) @@ -712,7 +762,7 @@ | Cdefine_symbol s -> `{emit_symbol s}:\n` | Cdefine_label lbl -> - `{emit_label (100000 + lbl)}:\n` + `{emit_data_label lbl}:\n` | Cint8 n -> ` .byte {emit_int n}\n` | Cint16 n -> @@ -728,7 +778,7 @@ | Csymbol_address s -> ` .quad {emit_symbol s}\n` | Clabel_address lbl -> - ` .quad {emit_label (100000 + lbl)}\n` + ` .quad {emit_data_label lbl}\n` | Cstring s -> emit_string_directive " .ascii " s | Cskip n -> @@ -743,12 +793,16 @@ (* Beginning / end of an assembly file *) let begin_assembly() = + reset_debug_info(); (* PR#5603 *) + float_constants := []; if !Clflags.dlcode then begin (* from amd64.S; could emit these constants on demand *) if macosx then - ` .literal16\n` + ` .literal16\n` + else if mingw64 then + ` .section .rdata,\"dr\"\n` else - ` .section .rodata.cst8,\"a\",@progbits\n`; + ` .section .rodata.cst8,\"a\",@progbits\n`; emit_align 16; `{emit_symbol "caml_negf_mask"}: .quad 0x8000000000000000, 0\n`; emit_align 16; @@ -765,6 +819,15 @@ if macosx then ` nop\n` (* PR#4690 *) let end_assembly() = + if !float_constants <> [] then begin + if macosx then + ` .literal8\n` + else if mingw64 then + ` .section .rdata,\"dr\"\n` + else + ` .section .rodata.cst8,\"a\",@progbits\n`; + List.iter emit_float_constant !float_constants + end; let lbl_end = Compilenv.make_symbol (Some "code_end") in ` .text\n`; if macosx then ` nop\n`; (* suppress "ld warning: atom sorting error" *) diff -Nru ocaml-3.12.1/asmcomp/amd64/emit_nt.mlp ocaml-4.01.0/asmcomp/amd64/emit_nt.mlp --- ocaml-3.12.1/asmcomp/amd64/emit_nt.mlp 2010-11-27 17:19:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/amd64/emit_nt.mlp 2013-06-03 18:03:59.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,12 +10,10 @@ (* *) (***********************************************************************) -(* $Id: emit_nt.mlp 10862 2010-11-27 17:19:24Z xleroy $ *) - (* Emission of x86-64 (AMD 64) assembly code, MASM syntax *) module StringSet = - Set.Make(struct type t = string let compare = compare end) + Set.Make(struct type t = string let compare (x:t) y = compare x y end) open Misc open Cmm @@ -80,6 +78,9 @@ let emit_label lbl = emit_string "L"; emit_int lbl +let emit_data_label lbl = + emit_string "Ld"; emit_int lbl + (* Output a .align directive. *) let emit_align n = @@ -107,13 +108,13 @@ let reg_low_8_name = [| "al"; "bl"; "dil"; "sil"; "dl"; "cl"; "r8b"; "r9b"; - "r10b"; "r11b"; "bpl"; "r12b"; "r13b" |] + "r12b"; "r13b"; "r10b"; "r11b"; "bpl" |] let reg_low_16_name = [| "ax"; "bx"; "di"; "si"; "dx"; "cx"; "r8w"; "r9w"; - "r10w"; "r11w"; "bp"; "r12w"; "r13w" |] + "r12w"; "r13w"; "r10w"; "r11w"; "bp" |] let reg_low_32_name = [| "eax"; "ebx"; "edi"; "esi"; "edx"; "ecx"; "r8d"; "r9d"; - "r10d"; "r11d"; "ebp"; "r12d"; "r13d" |] + "r12d"; "r13d"; "r10d"; "r11d"; "ebp" |] let emit_subreg tbl pref r = match r.loc with @@ -317,6 +318,39 @@ ` add rsp, {emit_int n}\n` end +(* Floating-point constants *) + +let float_constants = ref ([] : (string * int) list) + +let add_float_constant cst = + try + List.assoc cst !float_constants + with + Not_found -> + let lbl = new_label() in + float_constants := (cst, lbl) :: !float_constants; + lbl + +let emit_float s = + (* MASM doesn't like floating-point constants such as 2e9. + Turn them into 2.0e9. *) + let pos_e = ref (-1) and pos_dot = ref (-1) in + for i = 0 to String.length s - 1 do + match s.[i] with + 'e'|'E' -> pos_e := i + | '.' -> pos_dot := i + | _ -> () + done; + if !pos_dot < 0 && !pos_e >= 0 then begin + emit_string (String.sub s 0 !pos_e); + emit_string ".0"; + emit_string (String.sub s !pos_e (String.length s - !pos_e)) + end else + emit_string s + +let emit_float_constant (cst, lbl) = + `{emit_label lbl} REAL8 {emit_float cst}\n` + (* Output the assembly code for an instruction *) (* Name of current function *) @@ -324,8 +358,6 @@ (* Entry point for tail recursive calls *) let tailrec_entry_point = ref 0 -let float_constants = ref ([] : (int * string) list) - let emit_instr fallthrough i = match i.desc with Lend -> () @@ -358,8 +390,7 @@ | 0x0000_0000_0000_0000L -> (* +0.0 *) ` xorpd {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` | _ -> - let lbl = new_label() in - float_constants := (lbl, s) :: !float_constants; + let lbl = add_float_constant s in ` movsd {emit_reg i.res.(0)}, {emit_label lbl}\n` end | Lop(Iconst_symbol s) -> @@ -536,6 +567,22 @@ ` add QWORD PTR {emit_addressing addr i.arg 0}, {emit_int n}\n` | Lop(Ispecific(Ifloatarithmem(op, addr))) -> ` {emit_string(instr_for_floatarithmem op)} {emit_reg i.res.(0)}, REAL8 PTR {emit_addressing addr i.arg 1}\n` + | Lop(Ispecific(Ibswap size)) -> + begin match size with + | 16 -> + ` xchg ah, al\n`; + ` movzx {emit_reg i.res.(0)}, {emit_reg16 i.res.(0)}\n` + | 32 -> + ` bswap {emit_reg32 i.res.(0)}\n`; + ` movsxd {emit_reg i.res.(0)}, {emit_reg32 i.res.(0)}\n` + | 64 -> + ` bswap {emit_reg i.res.(0)}\n` + | _ -> assert false + end + | Lop(Ispecific Isqrtf) -> + ` sqrtsd {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n` + | Lop(Ispecific(Ifloatsqrtf addr)) -> + ` sqrtsd {emit_reg i.res.(0)}, REAL8 PTR {emit_addressing addr i.arg 0}\n` | Lreloadretaddr -> () | Lreturn -> @@ -591,19 +638,24 @@ end | Lswitch jumptbl -> let lbl = new_label() in - if !pic_code then begin - ` lea r11, {emit_label lbl}\n`; - ` jmp QWORD PTR [r11+{emit_reg i.arg.(0)}*8]\n` - end else begin - ` jmp QWORD PTR [{emit_reg i.arg.(0)}*8 + {emit_label lbl}]\n` - end; - ` .DATA\n`; - emit_align 8; - `{emit_label lbl} LABEL QWORD\n`; + (* rax and rdx are clobbered by the Lswitch, + meaning that no variable that is live across the Lswitch + is assigned to rax or rdx. However, the argument to Lswitch + can still be assigned to one of these two registers, so + we must be careful not to clobber it before use. *) + let (tmp1, tmp2) = + if i.arg.(0).loc = Reg 0 (* rax *) + then (phys_reg 4 (*rdx*), phys_reg 0 (*rax*)) + else (phys_reg 0 (*rax*), phys_reg 4 (*rdx*)) in + ` lea {emit_reg tmp1}, {emit_label lbl}\n`; + ` movsxd {emit_reg tmp2}, DWORD PTR [{emit_reg tmp1}+{emit_reg i.arg.(0)}*4]\n`; + ` add {emit_reg tmp1}, {emit_reg tmp2}\n`; + ` jmp {emit_reg tmp1}\n`; + emit_align 4; + `{emit_label lbl} LABEL DWORD\n`; for i = 0 to Array.length jumptbl - 1 do - ` QWORD {emit_label jumptbl.(i)}\n` - done; - ` .CODE\n` + ` DWORD {emit_label jumptbl.(i)} - {emit_label lbl}\n` + done | Lsetuptrap lbl -> ` call {emit_label lbl}\n` | Lpushtrap -> @@ -631,28 +683,6 @@ emit_instr fallthrough i; emit_all (Linearize.has_fallthrough i.desc) i.next -(* Emission of the floating-point constants *) - -let emit_float s = - (* MASM doesn't like floating-point constants such as 2e9. - Turn them into 2.0e9. *) - let pos_e = ref (-1) and pos_dot = ref (-1) in - for i = 0 to String.length s - 1 do - match s.[i] with - 'e'|'E' -> pos_e := i - | '.' -> pos_dot := i - | _ -> () - done; - if !pos_dot < 0 && !pos_e >= 0 then begin - emit_string (String.sub s 0 !pos_e); - emit_string ".0"; - emit_string (String.sub s !pos_e (String.length s - !pos_e)) - end else - emit_string s - -let emit_float_constant (lbl, cst) = - `{emit_label lbl} REAL8 {emit_float cst}\n` - (* Emission of a function declaration *) let fundecl fundecl = @@ -660,7 +690,6 @@ fastcode_flag := fundecl.fun_fast; tailrec_entry_point := new_label(); stack_offset := 0; - float_constants := []; call_gc_sites := []; bound_error_sites := []; bound_error_call := 0; @@ -676,11 +705,7 @@ `{emit_label !tailrec_entry_point}:\n`; emit_all true fundecl.fun_body; List.iter emit_call_gc !call_gc_sites; - emit_call_bound_errors(); - if !float_constants <> [] then begin - ` .DATA\n`; - List.iter emit_float_constant !float_constants - end + emit_call_bound_errors() (* Emission of data *) @@ -691,7 +716,7 @@ add_def_symbol s; `{emit_symbol s} LABEL QWORD\n` | Cdefine_label lbl -> - `{emit_label (100000 + lbl)} LABEL QWORD\n` + `{emit_data_label lbl} LABEL QWORD\n` | Cint8 n -> ` BYTE {emit_int n}\n` | Cint16 n -> @@ -708,7 +733,7 @@ add_used_symbol s; ` QWORD {emit_symbol s}\n` | Clabel_address lbl -> - ` QWORD {emit_label (100000 + lbl)}\n` + ` QWORD {emit_data_label lbl}\n` | Cstring s -> emit_bytes_directive " BYTE " s | Cskip n -> @@ -723,6 +748,7 @@ (* Beginning / end of an assembly file *) let begin_assembly() = + float_constants := []; ` EXTRN caml_young_ptr: QWORD\n`; ` EXTRN caml_young_limit: QWORD\n`; ` EXTRN caml_exception_pointer: QWORD\n`; @@ -748,6 +774,10 @@ `{emit_symbol lbl_begin} LABEL QWORD\n` let end_assembly() = + if !float_constants <> [] then begin + ` .DATA\n`; + List.iter emit_float_constant !float_constants + end; let lbl_end = Compilenv.make_symbol (Some "code_end") in add_def_symbol lbl_end; ` .CODE\n`; diff -Nru ocaml-3.12.1/asmcomp/amd64/proc.ml ocaml-4.01.0/asmcomp/amd64/proc.ml --- ocaml-3.12.1/asmcomp/amd64/proc.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/amd64/proc.ml 2013-06-03 18:03:59.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: proc.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Description of the AMD64 processor *) open Misc @@ -20,37 +18,82 @@ open Reg open Mach +let fp = Config.with_frame_pointers + +(* Which ABI to use *) + +let win64 = + match Config.system with + | "win64" | "mingw64" -> true + | _ -> false + +(* Which asm conventions to use *) + +let masm = + match Config.ccomp_type with + | "msvc" -> true + | _ -> false + (* Registers available for register allocation *) (* Register map: - rax 0 rax - r11: Caml function arguments - rbx 1 rdi - r9: C function arguments - rdi 2 rax: Caml and C function results - rsi 3 rbx, rbp, r12-r15 are preserved by C + rax 0 + rbx 1 + rdi 2 + rsi 3 rdx 4 rcx 5 r8 6 r9 7 - r10 8 - r11 9 - rbp 10 - r12 11 - r13 12 + r12 8 + r13 9 + r10 10 + r11 11 + rbp 12 r14 trap pointer r15 allocation pointer - xmm0 - xmm15 100 - 115 xmm0 - xmm9: Caml function arguments - xmm0 - xmm7: C function arguments - xmm0: Caml and C function results *) + xmm0 - xmm15 100 - 115 *) + +(* Conventions: + rax - r13: OCaml function arguments + rax: OCaml and C function results + xmm0 - xmm9: OCaml function arguments + xmm0: OCaml and C function results + Under Unix: + rdi, rsi, rdx, rcx, r8, r9: C function arguments + xmm0 - xmm7: C function arguments + rbx, rbp, r12-r15 are preserved by C + xmm registers are not preserved by C + Under Win64: + rcx, rdx, r8, r9: C function arguments + xmm0 - xmm3: C function arguments + rbx, rbp, rsi, rdi r12-r15 are preserved by C + xmm6-xmm15 are preserved by C + Note (PR#5707): r11 should not be used for parameter passing, as it + can be destroyed by the dynamic loader according to SVR4 ABI. + Linux's dynamic loader also destroys r10. +*) let int_reg_name = - [| "%rax"; "%rbx"; "%rdi"; "%rsi"; "%rdx"; "%rcx"; "%r8"; "%r9"; - "%r10"; "%r11"; "%rbp"; "%r12"; "%r13" |] + match Config.ccomp_type with + | "msvc" -> + [| "rax"; "rbx"; "rdi"; "rsi"; "rdx"; "rcx"; "r8"; "r9"; + "r12"; "r13"; "r10"; "r11"; "rbp" |] + | _ -> + [| "%rax"; "%rbx"; "%rdi"; "%rsi"; "%rdx"; "%rcx"; "%r8"; "%r9"; + "%r12"; "%r13"; "%r10"; "%r11"; "%rbp" |] let float_reg_name = - [| "%xmm0"; "%xmm1"; "%xmm2"; "%xmm3"; "%xmm4"; "%xmm5"; "%xmm6"; "%xmm7"; - "%xmm8"; "%xmm9"; "%xmm10"; "%xmm11"; - "%xmm12"; "%xmm13"; "%xmm14"; "%xmm15" |] + match Config.ccomp_type with + | "msvc" -> + [| "xmm0"; "xmm1"; "xmm2"; "xmm3"; "xmm4"; "xmm5"; "xmm6"; "xmm7"; + "xmm8"; "xmm9"; "xmm10"; "xmm11"; + "xmm12"; "xmm13"; "xmm14"; "xmm15" |] + | _ -> + [| "%xmm0"; "%xmm1"; "%xmm2"; "%xmm3"; "%xmm4"; "%xmm5"; "%xmm6"; "%xmm7"; + "%xmm8"; "%xmm9"; "%xmm10"; "%xmm11"; + "%xmm12"; "%xmm13"; "%xmm14"; "%xmm15" |] let num_register_classes = 2 @@ -92,6 +135,7 @@ let rax = phys_reg 0 let rcx = phys_reg 5 let rdx = phys_reg 4 +let rbp = phys_reg 12 let rxmm15 = phys_reg 115 let stack_slot slot ty = @@ -141,26 +185,74 @@ let loc_results res = let (loc, ofs) = calling_conventions 0 0 100 100 not_supported res in loc -(* C calling convention: +(* C calling conventions under Unix: first integer args in rdi, rsi, rdx, rcx, r8, r9 first float args in xmm0 ... xmm7 - remaining args on stack. - Return value in rax or xmm0. *) + remaining args on stack + return value in rax or xmm0. + C calling conventions under Win64: + first integer args in rcx, rdx, r8, r9 + first float args in xmm0 ... xmm3 + each integer arg consumes a float reg, and conversely + remaining args on stack + always 32 bytes reserved at bottom of stack. + Return value in rax or xmm0. *) -let loc_external_arguments arg = - calling_conventions 2 7 100 107 outgoing arg let loc_external_results res = let (loc, ofs) = calling_conventions 0 0 100 100 not_supported res in loc +let unix_loc_external_arguments arg = + calling_conventions 2 7 100 107 outgoing arg + +let win64_int_external_arguments = + [| 5 (*rcx*); 4 (*rdx*); 6 (*r8*); 7 (*r9*) |] +let win64_float_external_arguments = + [| 100 (*xmm0*); 101 (*xmm1*); 102 (*xmm2*); 103 (*xmm3*) |] + +let win64_loc_external_arguments arg = + let loc = Array.create (Array.length arg) Reg.dummy in + let reg = ref 0 + and ofs = ref 32 in + for i = 0 to Array.length arg - 1 do + match arg.(i).typ with + Int | Addr as ty -> + if !reg < 4 then begin + loc.(i) <- phys_reg win64_int_external_arguments.(!reg); + incr reg + end else begin + loc.(i) <- stack_slot (Outgoing !ofs) ty; + ofs := !ofs + size_int + end + | Float -> + if !reg < 4 then begin + loc.(i) <- phys_reg win64_float_external_arguments.(!reg); + incr reg + end else begin + loc.(i) <- stack_slot (Outgoing !ofs) Float; + ofs := !ofs + size_float + end + done; + (loc, Misc.align !ofs 16) (* keep stack 16-aligned *) + +let loc_external_arguments = + if win64 then win64_loc_external_arguments else unix_loc_external_arguments + let loc_exn_bucket = rax (* Registers destroyed by operations *) -let destroyed_at_c_call = (* rbp, rbx, r12-r15 preserved *) - Array.of_list(List.map phys_reg - [0;2;3;4;5;6;7;8;9; - 100;101;102;103;104;105;106;107; - 108;109;110;111;112;113;114;115]) +let destroyed_at_c_call = + if win64 then + (* Win64: rbx, rbp, rsi, rdi, r12-r15, xmm6-xmm15 preserved *) + Array.of_list(List.map phys_reg + [0;4;5;6;7;10;11; + 100;101;102;103;104;105]) + else + (* Unix: rbp, rbx, r12-r15 preserved *) + Array.of_list(List.map phys_reg + [0;2;3;4;5;6;7;10;11; + 100;101;102;103;104;105;106;107; + 108;109;110;111;112;113;114;115]) let destroyed_at_oper = function Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs @@ -170,23 +262,36 @@ | Iop(Ialloc _ | Iintop(Icomp _) | Iintop_imm((Idiv|Imod|Icomp _), _)) -> [| rax |] | Iswitch(_, _) -> [| rax; rdx |] - | _ -> [||] + | _ -> + if fp then +(* prevent any use of the frame pointer ! *) + [| rbp |] + else + [||] + let destroyed_at_raise = all_phys_regs (* Maximal register pressure *) + let safe_register_pressure = function - Iextcall(_,_) -> 0 - | _ -> 11 + Iextcall(_,_) -> if win64 then if fp then 7 else 8 else 0 + | _ -> if fp then 10 else 11 let max_register_pressure = function - Iextcall(_, _) -> [| 4; 0 |] - | Iintop(Idiv | Imod) -> [| 11; 16 |] - | Ialloc _ | Iintop(Icomp _) | Iintop_imm((Idiv|Imod|Icomp _), _) - -> [| 12; 16 |] - | Istore(Single, _) -> [| 13; 15 |] - | _ -> [| 13; 16 |] + Iextcall(_, _) -> + if win64 then + if fp then [| 7; 10 |] else [| 8; 10 |] + else + if fp then [| 3; 0 |] else [| 4; 0 |] + | Iintop(Idiv | Imod) -> + if fp then [| 10; 16 |] else [| 11; 16 |] + | Ialloc _ | Iintop(Icomp _) | Iintop_imm((Idiv|Imod|Icomp _), _) -> + if fp then [| 11; 16 |] else [| 12; 16 |] + | Istore(Single, _) -> + if fp then [| 12; 15 |] else [| 13; 15 |] + | _ -> if fp then [| 12; 16 |] else [| 13; 16 |] (* Layout of the stack frame *) @@ -196,5 +301,16 @@ (* Calling the assembler *) let assemble_file infile outfile = - Ccomp.command (Config.asm ^ " -o " ^ - Filename.quote outfile ^ " " ^ Filename.quote infile) + if masm then + Ccomp.command (Config.asm ^ + Filename.quote outfile ^ " " ^ Filename.quote infile ^ + (if !Clflags.verbose then "" else ">NUL")) + else + Ccomp.command (Config.asm ^ " -o " ^ + Filename.quote outfile ^ " " ^ Filename.quote infile) + +let init () = + if fp then begin + num_available_registers.(0) <- 12 + end else + num_available_registers.(0) <- 13 diff -Nru ocaml-3.12.1/asmcomp/amd64/proc_nt.ml ocaml-4.01.0/asmcomp/amd64/proc_nt.ml --- ocaml-3.12.1/asmcomp/amd64/proc_nt.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/amd64/proc_nt.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,233 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2000 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: proc_nt.ml 9547 2010-01-22 12:48:24Z doligez $ *) - -(* Description of the AMD64 processor with Win64 conventions *) - -open Misc -open Arch -open Cmm -open Reg -open Mach - -(* Registers available for register allocation *) - -(* Register map: - rax 0 rax - r11: Caml function arguments - rbx 1 rcx - r9: C function arguments - rdi 2 rax: Caml and C function results - rsi 3 rbx, rbp, rsi, rdi r12-r15 are preserved by C - rdx 4 - rcx 5 - r8 6 - r9 7 - r10 8 - r11 9 - rbp 10 - r12 11 - r13 12 - r14 trap pointer - r15 allocation pointer - - xmm0 - xmm15 100 - 115 xmm0 - xmm9: Caml function arguments - xmm0 - xmm3: C function arguments - xmm0: Caml and C function results - xmm6-xmm15 are preserved by C *) - -let int_reg_name = - [| "rax"; "rbx"; "rdi"; "rsi"; "rdx"; "rcx"; "r8"; "r9"; - "r10"; "r11"; "rbp"; "r12"; "r13" |] - -let float_reg_name = - [| "xmm0"; "xmm1"; "xmm2"; "xmm3"; "xmm4"; "xmm5"; "xmm6"; "xmm7"; - "xmm8"; "xmm9"; "xmm10"; "xmm11"; "xmm12"; "xmm13"; "xmm14"; "xmm15" |] - -let num_register_classes = 2 - -let register_class r = - match r.typ with - Int -> 0 - | Addr -> 0 - | Float -> 1 - -let num_available_registers = [| 13; 16 |] - -let first_available_register = [| 0; 100 |] - -let register_name r = - if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100) - -(* Pack registers starting at %rax so as to reduce the number of REX - prefixes and thus improve code density *) -let rotate_registers = false - -(* Representation of hard registers by pseudo-registers *) - -let hard_int_reg = - let v = Array.create 13 Reg.dummy in - for i = 0 to 12 do v.(i) <- Reg.at_location Int (Reg i) done; - v - -let hard_float_reg = - let v = Array.create 16 Reg.dummy in - for i = 0 to 15 do v.(i) <- Reg.at_location Float (Reg (100 + i)) done; - v - -let all_phys_regs = - Array.append hard_int_reg hard_float_reg - -let phys_reg n = - if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100) - -let rax = phys_reg 0 -let rcx = phys_reg 5 -let rdx = phys_reg 4 -let r11 = phys_reg 9 -let rxmm15 = phys_reg 115 - -let stack_slot slot ty = - Reg.at_location ty (Stack slot) - -(* Instruction selection *) - -let word_addressed = false - -(* Calling conventions *) - -let calling_conventions first_int last_int first_float last_float make_stack - arg = - let loc = Array.create (Array.length arg) Reg.dummy in - let int = ref first_int in - let float = ref first_float in - let ofs = ref 0 in - for i = 0 to Array.length arg - 1 do - match arg.(i).typ with - Int | Addr as ty -> - if !int <= last_int then begin - loc.(i) <- phys_reg !int; - incr int - end else begin - loc.(i) <- stack_slot (make_stack !ofs) ty; - ofs := !ofs + size_int - end - | Float -> - if !float <= last_float then begin - loc.(i) <- phys_reg !float; - incr float - end else begin - loc.(i) <- stack_slot (make_stack !ofs) Float; - ofs := !ofs + size_float - end - done; - (loc, Misc.align !ofs 16) (* keep stack 16-aligned *) - -let incoming ofs = Incoming ofs -let outgoing ofs = Outgoing ofs -let not_supported ofs = fatal_error "Proc.loc_results: cannot call" - -let loc_arguments arg = - calling_conventions 0 9 100 109 outgoing arg -let loc_parameters arg = - let (loc, ofs) = calling_conventions 0 9 100 109 incoming arg in loc -let loc_results res = - let (loc, ofs) = calling_conventions 0 0 100 100 not_supported res in loc - -(* C calling conventions (Win64): - first integer args in rcx, rdx, r8, r9 (4 - 7) - first float args in xmm0 ... xmm3 (100 - 103) - each integer arg consumes a float reg, and conversely - remaining args on stack - always 32 bytes reserved at bottom of stack. - Return value in rax or xmm0 -*) - -let loc_external_results res = - let (loc, ofs) = calling_conventions 0 0 100 100 not_supported res in loc - -let int_external_arguments = - [| 5 (*rcx*); 4 (*rdx*); 6 (*r8*); 7 (*r9*) |] -let float_external_arguments = - [| 100 (*xmm0*); 101 (*xmm1*); 102 (*xmm2*); 103 (*xmm3*) |] - -let loc_external_arguments arg = - let loc = Array.create (Array.length arg) Reg.dummy in - let reg = ref 0 - and ofs = ref 32 in - for i = 0 to Array.length arg - 1 do - match arg.(i).typ with - Int | Addr as ty -> - if !reg < 4 then begin - loc.(i) <- phys_reg int_external_arguments.(!reg); - incr reg - end else begin - loc.(i) <- stack_slot (Outgoing !ofs) ty; - ofs := !ofs + size_int - end - | Float -> - if !reg < 4 then begin - loc.(i) <- phys_reg float_external_arguments.(!reg); - incr reg - end else begin - loc.(i) <- stack_slot (Outgoing !ofs) Float; - ofs := !ofs + size_float - end - done; - (loc, Misc.align !ofs 16) (* keep stack 16-aligned *) - -let loc_exn_bucket = rax - -(* Registers destroyed by operations *) - -let destroyed_at_c_call = - (* Win64: rbx, rbp, rsi, rdi, r12-r15, xmm6-xmm15 preserved *) - Array.of_list(List.map phys_reg - [0;4;5;6;7;8;9; - 100;101;102;103;104;105]) - -let destroyed_at_oper = function - Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs - | Iop(Iextcall(_, false)) -> destroyed_at_c_call - | Iop(Iintop(Idiv | Imod)) -> [| rax; rdx |] - | Iop(Istore(Single, _)) -> [| rxmm15 |] - | Iop(Ialloc _ | Iintop(Icomp _) | Iintop_imm((Idiv|Imod|Icomp _), _)) - -> [| rax |] - | Iswitch(_, _) when !pic_code -> [| r11 |] - | _ -> [||] - -let destroyed_at_raise = all_phys_regs - -(* Maximal register pressure *) - -let safe_register_pressure = function - Iextcall(_,_) -> 8 - | _ -> 11 - -let max_register_pressure = function - Iextcall(_, _) -> [| 8; 10 |] - | Iintop(Idiv | Imod) -> [| 11; 16 |] - | Ialloc _ | Iintop(Icomp _) | Iintop_imm((Idiv|Imod|Icomp _), _) - -> [| 12; 16 |] - | Istore(Single, _) -> [| 13; 15 |] - | _ -> [| 13; 16 |] - -(* Layout of the stack frame *) - -let num_stack_slots = [| 0; 0 |] -let contains_calls = ref false - -(* Calling the assembler *) - -let assemble_file infile outfile = - Ccomp.command (Config.asm ^ - Filename.quote outfile ^ " " ^ - Filename.quote infile ^ "> NUL") diff -Nru ocaml-3.12.1/asmcomp/amd64/reload.ml ocaml-4.01.0/asmcomp/amd64/reload.ml --- ocaml-3.12.1/asmcomp/amd64/reload.ml 2010-05-24 15:26:23.000000000 +0000 +++ ocaml-4.01.0/asmcomp/amd64/reload.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: reload.ml 10460 2010-05-24 15:26:23Z xleroy $ *) - open Cmm open Arch open Reg diff -Nru ocaml-3.12.1/asmcomp/amd64/scheduling.ml ocaml-4.01.0/asmcomp/amd64/scheduling.ml --- ocaml-3.12.1/asmcomp/amd64/scheduling.ml 2003-06-30 08:28:48.000000000 +0000 +++ ocaml-4.01.0/asmcomp/amd64/scheduling.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,9 +10,7 @@ (* *) (***********************************************************************) -(* $Id: scheduling.ml 5634 2003-06-30 08:28:48Z xleroy $ *) - -open Schedgen (* to create a dependency *) +let _ = let module M = Schedgen in () (* to create a dependency *) (* Scheduling is turned off because the processor schedules dynamically much better than what we could do. *) diff -Nru ocaml-3.12.1/asmcomp/amd64/selection.ml ocaml-4.01.0/asmcomp/amd64/selection.ml --- ocaml-3.12.1/asmcomp/amd64/selection.ml 2010-04-08 03:58:41.000000000 +0000 +++ ocaml-4.01.0/asmcomp/amd64/selection.ml 2012-11-29 09:55:00.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,15 +10,11 @@ (* *) (***********************************************************************) -(* $Id: selection.ml 10250 2010-04-08 03:58:41Z garrigue $ *) - (* Instruction selection for the AMD64 *) -open Misc open Arch open Proc open Cmm -open Reg open Mach (* Auxiliary for recognizing addressing modes *) @@ -88,8 +84,13 @@ ([|res.(0); arg.(1)|], res) (* One-address unary operations: arg.(0) and res.(0) must be the same *) | Iintop_imm((Iadd|Isub|Imul|Iand|Ior|Ixor|Ilsl|Ilsr|Iasr), _) - | Iabsf | Inegf -> + | Iabsf | Inegf + | Ispecific(Ibswap (32|64)) -> (res, res) + (* For xchg, args must be a register allowing access to high 8 bit register + (rax, rbx, rcx or rdx). Keep it simple, just force the argument in rax. *) + | Ispecific(Ibswap 16) -> + ([| rax |], [| rax |]) | Ispecific(Ifloatarithmem(_,_)) -> let arg' = Array.copy arg in arg'.(0) <- res.(0); @@ -111,6 +112,10 @@ (* Other instructions are regular *) | _ -> raise Use_default +let inline_ops = + [ "sqrt"; "caml_bswap16_direct"; "caml_int32_direct_bswap"; + "caml_int64_direct_bswap"; "caml_nativeint_direct_bswap" ] + (* The selector class *) class selector = object (self) @@ -121,7 +126,16 @@ method is_immediate_natint n = n <= 0x7FFFFFFFn && n >= -0x80000000n -method select_addressing exp = +method! is_simple_expr e = + match e with + | Cop(Cextcall(fn, _, _, _), args) + when List.mem fn inline_ops -> + (* inlined ops are simple if their arguments are *) + List.for_all self#is_simple_expr args + | _ -> + super#is_simple_expr e + +method select_addressing chunk exp = let (a, d) = select_addr exp in (* PR#4625: displacement must be a signed 32-bit immediate *) if d < -0x8000_0000 || d > 0x7FFF_FFFF @@ -157,7 +171,7 @@ match op with (* Recognize the LEA instruction *) Caddi | Cadda | Csubi | Csuba -> - begin match self#select_addressing (Cop(op, args)) with + begin match self#select_addressing Word (Cop(op, args)) with (Iindexed d, _) -> super#select_operation op args | (Iindexed2 0, _) -> super#select_operation op args | (addr, arg) -> (Ispecific(Ilea addr), [arg]) @@ -186,28 +200,45 @@ self#select_floatarith true Imulf Ifloatmul args | Cdivf -> self#select_floatarith false Idivf Ifloatdiv args + | Cextcall("sqrt", _, false, _) -> + begin match args with + [Cop(Cload (Double|Double_u as chunk), [loc])] -> + let (addr, arg) = self#select_addressing chunk loc in + (Ispecific(Ifloatsqrtf addr), [arg]) + | [arg] -> + (Ispecific Isqrtf, [arg]) + | _ -> + assert false + end (* Recognize store instructions *) | Cstore Word -> begin match args with [loc; Cop(Caddi, [Cop(Cload _, [loc']); Cconst_int n])] when loc = loc' && self#is_immediate n -> - let (addr, arg) = self#select_addressing loc in + let (addr, arg) = self#select_addressing Word loc in (Ispecific(Ioffset_loc(n, addr)), [arg]) | _ -> super#select_operation op args end + | Cextcall("caml_bswap16_direct", _, _, _) -> + (Ispecific (Ibswap 16), args) + | Cextcall("caml_int32_direct_bswap", _, _, _) -> + (Ispecific (Ibswap 32), args) + | Cextcall("caml_int64_direct_bswap", _, _, _) + | Cextcall("caml_nativeint_direct_bswap", _, _, _) -> + (Ispecific (Ibswap 64), args) | _ -> super#select_operation op args (* Recognize float arithmetic with mem *) method select_floatarith commutative regular_op mem_op args = match args with - [arg1; Cop(Cload (Double|Double_u), [loc2])] -> - let (addr, arg2) = self#select_addressing loc2 in + [arg1; Cop(Cload (Double|Double_u as chunk), [loc2])] -> + let (addr, arg2) = self#select_addressing chunk loc2 in (Ispecific(Ifloatarithmem(mem_op, addr)), [arg1; arg2]) - | [Cop(Cload (Double|Double_u), [loc1]); arg2] when commutative -> - let (addr, arg1) = self#select_addressing loc1 in + | [Cop(Cload (Double|Double_u as chunk), [loc1]); arg2] when commutative -> + let (addr, arg1) = self#select_addressing chunk loc1 in (Ispecific(Ifloatarithmem(mem_op, addr)), [arg2; arg1]) | [arg1; arg2] -> @@ -227,9 +258,6 @@ with Use_default -> super#insert_op_debug op dbg rs rd -method! insert_op op rs rd = - self#insert_op_debug op Debuginfo.none rs rd - end let fundecl f = (new selector)#emit_fundecl f diff -Nru ocaml-3.12.1/asmcomp/arm/arch.ml ocaml-4.01.0/asmcomp/arm/arch.ml --- ocaml-3.12.1/asmcomp/arm/arch.ml 2002-11-29 15:03:37.000000000 +0000 +++ ocaml-4.01.0/asmcomp/arm/arch.ml 2013-01-06 17:07:50.000000000 +0000 @@ -1,25 +1,98 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* Benedikt Meurer, University of Siegen *) (* *) -(* Copyright 1998 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) +(* Copyright 1998 Institut National de Recherche en Informatique *) +(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) +(* reserved. This file is distributed under the terms of the Q *) +(* Public License version 1.0. *) (* *) (***********************************************************************) -(* $Id: arch.ml 5304 2002-11-29 15:03:37Z xleroy $ *) - (* Specific operations for the ARM processor *) -open Misc open Format +type abi = EABI | EABI_HF +type arch = ARMv4 | ARMv5 | ARMv5TE | ARMv6 | ARMv6T2 | ARMv7 +type fpu = Soft | VFPv2 | VFPv3_D16 | VFPv3 + +let abi = + match Config.system with + "linux_eabi" -> EABI + | "linux_eabihf" -> EABI_HF + | _ -> assert false + +let string_of_arch = function + ARMv4 -> "armv4" + | ARMv5 -> "armv5" + | ARMv5TE -> "armv5te" + | ARMv6 -> "armv6" + | ARMv6T2 -> "armv6t2" + | ARMv7 -> "armv7" + +let string_of_fpu = function + Soft -> "soft" + | VFPv2 -> "vfpv2" + | VFPv3_D16 -> "vfpv3-d16" + | VFPv3 -> "vfpv3" + (* Machine-specific command-line options *) -let command_line_options = [] +let (arch, fpu, thumb) = + let (def_arch, def_fpu, def_thumb) = + begin match abi, Config.model with + (* Defaults for architecture, FPU and Thumb *) + EABI, "armv5" -> ARMv5, Soft, false + | EABI, "armv5te" -> ARMv5TE, Soft, false + | EABI, "armv6" -> ARMv6, Soft, false + | EABI, "armv6t2" -> ARMv6T2, Soft, false + | EABI, "armv7" -> ARMv7, Soft, false + | EABI, _ -> ARMv4, Soft, false + | EABI_HF, "armv6" -> ARMv6, VFPv2, false + | EABI_HF, _ -> ARMv7, VFPv3_D16, true + end in + (ref def_arch, ref def_fpu, ref def_thumb) + +let pic_code = ref false + +let farch spec = + arch := (match spec with + "armv4" when abi <> EABI_HF -> ARMv4 + | "armv5" when abi <> EABI_HF -> ARMv5 + | "armv5te" when abi <> EABI_HF -> ARMv5TE + | "armv6" -> ARMv6 + | "armv6t2" -> ARMv6T2 + | "armv7" -> ARMv7 + | spec -> raise (Arg.Bad spec)) + +let ffpu spec = + fpu := (match spec with + "soft" when abi <> EABI_HF -> Soft + | "vfpv2" when abi = EABI_HF -> VFPv2 + | "vfpv3-d16" when abi = EABI_HF -> VFPv3_D16 + | "vfpv3" when abi = EABI_HF -> VFPv3 + | spec -> raise (Arg.Bad spec)) + +let command_line_options = + [ "-farch", Arg.String farch, + " Select the ARM target architecture" + ^ " (default: " ^ (string_of_arch !arch) ^ ")"; + "-ffpu", Arg.String ffpu, + " Select the floating-point hardware" + ^ " (default: " ^ (string_of_fpu !fpu) ^ ")"; + "-fPIC", Arg.Set pic_code, + " Generate position-independent machine code"; + "-fno-PIC", Arg.Clear pic_code, + " Generate position-dependent machine code"; + "-fthumb", Arg.Set thumb, + " Enable Thumb/Thumb-2 code generation" + ^ (if !thumb then " (default)" else ""); + "-fno-thumb", Arg.Clear thumb, + " Disable Thumb/Thumb-2 code generation" + ^ (if not !thumb then " (default" else "")] (* Addressing modes *) @@ -37,6 +110,15 @@ Ishiftarith of arith_operation * int | Ishiftcheckbound of int | Irevsubimm of int + | Imuladd (* multiply and add *) + | Imulsub (* multiply and subtract *) + | Inegmulf (* floating-point negate and multiply *) + | Imuladdf (* floating-point multiply and add *) + | Inegmuladdf (* floating-point negate, multiply and add *) + | Imulsubf (* floating-point multiply and subtract *) + | Inegmulsubf (* floating-point negate, multiply and subtract *) + | Isqrtf (* floating-point square root *) + | Ibswap of int (* endianess conversion *) and arith_operation = Ishiftadd @@ -51,6 +133,12 @@ let size_int = 4 let size_float = 8 +let allow_unaligned_access = false + +(* Behavior of division *) + +let division_crashes_on_overflow = false + (* Operations on addressing modes *) let identity_addressing = Iindexed 0 @@ -84,3 +172,59 @@ fprintf ppf "check %a >> %i > %a" printreg arg.(0) n printreg arg.(1) | Irevsubimm n -> fprintf ppf "%i %s %a" n "-" printreg arg.(0) + | Imuladd -> + fprintf ppf "(%a * %a) + %a" + printreg arg.(0) + printreg arg.(1) + printreg arg.(2) + | Imulsub -> + fprintf ppf "-(%a * %a) + %a" + printreg arg.(0) + printreg arg.(1) + printreg arg.(2) + | Inegmulf -> + fprintf ppf "-f (%a *f %a)" + printreg arg.(0) + printreg arg.(1) + | Imuladdf -> + fprintf ppf "%a +f (%a *f %a)" + printreg arg.(0) + printreg arg.(1) + printreg arg.(2) + | Inegmuladdf -> + fprintf ppf "%a -f (%a *f %a)" + printreg arg.(0) + printreg arg.(1) + printreg arg.(2) + | Imulsubf -> + fprintf ppf "(-f %a) +f (%a *f %a)" + printreg arg.(0) + printreg arg.(1) + printreg arg.(2) + | Inegmulsubf -> + fprintf ppf "(-f %a) -f (%a *f %a)" + printreg arg.(0) + printreg arg.(1) + printreg arg.(2) + | Isqrtf -> + fprintf ppf "sqrtf %a" + printreg arg.(0) + | Ibswap n -> + fprintf ppf "bswap%i %a" n + printreg arg.(0) + +(* Recognize immediate operands *) + +(* Immediate operands are 8-bit immediate values, zero-extended, + and rotated right by 0 ... 30 bits. + In Thumb/Thumb-2 mode we utilize 26 ... 30. *) + +let is_immediate n = + let n = ref n in + let s = ref 0 in + let m = if !thumb then 24 else 30 in + while (!s <= m && Int32.logand !n 0xffl <> !n) do + n := Int32.logor (Int32.shift_right_logical !n 2) (Int32.shift_left !n 30); + s := !s + 2 + done; + !s <= m diff -Nru ocaml-3.12.1/asmcomp/arm/emit.mlp ocaml-4.01.0/asmcomp/arm/emit.mlp --- ocaml-3.12.1/asmcomp/arm/emit.mlp 2010-04-22 09:33:18.000000000 +0000 +++ ocaml-4.01.0/asmcomp/arm/emit.mlp 2013-03-09 22:38:52.000000000 +0000 @@ -1,20 +1,18 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* Benedikt Meurer, University of Siegen *) (* *) -(* Copyright 1998 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) +(* Copyright 1998 Institut National de Recherche en Informatique *) +(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) +(* reserved. This file is distributed under the terms of the Q *) +(* Public License version 1.0. *) (* *) (***********************************************************************) -(* $Id: emit.mlp 10293 2010-04-22 09:33:18Z xleroy $ *) - (* Emission of ARM assembly code *) -open Location open Misc open Cmm open Arch @@ -33,16 +31,28 @@ let emit_label lbl = emit_string ".L"; emit_int lbl -(* Output a symbol *) +let emit_data_label lbl = + emit_string ".Ld"; emit_int lbl + +(* Symbols *) let emit_symbol s = Emitaux.emit_symbol '$' s +let emit_call s = + if !Clflags.dlcode || !pic_code + then `bl {emit_symbol s}(PLT)` + else `bl {emit_symbol s}` + +let emit_jump s = + if !Clflags.dlcode || !pic_code + then `b {emit_symbol s}(PLT)` + else `b {emit_symbol s}` + (* Output a pseudo-register *) -let emit_reg r = - match r.loc with - | Reg r -> emit_string (register_name r) +let emit_reg = function + {loc = Reg r} -> emit_string (register_name r) | _ -> fatal_error "Emit_arm.emit_reg" (* Layout of the stack frame *) @@ -53,14 +63,23 @@ let sz = !stack_offset + 4 * num_stack_slots.(0) + + 8 * num_stack_slots.(1) + + 8 * num_stack_slots.(2) + (if !contains_calls then 4 else 0) in Misc.align sz 8 let slot_offset loc cl = match loc with - Incoming n -> frame_size() + n - | Local n -> !stack_offset + n * 4 - | Outgoing n -> n + Incoming n -> + assert (n >= 0); + frame_size() + n + | Local n -> + if cl = 0 + then !stack_offset + n * 4 + else !stack_offset + num_stack_slots.(0) * 4 + n * 8 + | Outgoing n -> + assert (n >= 0); + n (* Output a stack reference *) @@ -79,20 +98,13 @@ (* Record live pointers at call points *) -type frame_descr = - { fd_lbl: int; (* Return address *) - fd_frame_size: int; (* Size of stack frame *) - fd_live_offset: int list } (* Offsets/regs of live addresses *) - -let frame_descriptors = ref([] : frame_descr list) - -let record_frame live = +let record_frame_label live dbg = let lbl = new_label() in let live_offset = ref [] in Reg.Set.iter (function {typ = Addr; loc = Reg r} -> - live_offset := (r lsl 1) + 1 :: !live_offset + live_offset := ((r lsl 1) + 1) :: !live_offset | {typ = Addr; loc = Stack s} as reg -> live_offset := slot_offset s (register_class reg) :: !live_offset | _ -> ()) @@ -100,18 +112,57 @@ frame_descriptors := { fd_lbl = lbl; fd_frame_size = frame_size(); - fd_live_offset = !live_offset } :: !frame_descriptors; - `{emit_label lbl}:` + fd_live_offset = !live_offset; + fd_debuginfo = dbg } :: !frame_descriptors; + lbl + +let record_frame live dbg = + let lbl = record_frame_label live dbg in `{emit_label lbl}:` + +(* Record calls to the GC -- we've moved them out of the way *) + +type gc_call = + { gc_lbl: label; (* Entry label *) + gc_return_lbl: label; (* Where to branch after GC *) + gc_frame_lbl: label } (* Label of frame descriptor *) + +let call_gc_sites = ref ([] : gc_call list) + +let emit_call_gc gc = + `{emit_label gc.gc_lbl}: {emit_call "caml_call_gc"}\n`; + `{emit_label gc.gc_frame_lbl}: b {emit_label gc.gc_return_lbl}\n` + +(* Record calls to caml_ml_array_bound_error. + In debug mode, we maintain one call to caml_ml_array_bound_error + per bound check site. Otherwise, we can share a single call. *) + +type bound_error_call = + { bd_lbl: label; (* Entry label *) + bd_frame_lbl: label } (* Label of frame descriptor *) + +let bound_error_sites = ref ([] : bound_error_call list) + +let bound_error_label dbg = + if !Clflags.debug || !bound_error_sites = [] then begin + let lbl_bound_error = new_label() in + let lbl_frame = record_frame_label Reg.Set.empty dbg in + bound_error_sites := + { bd_lbl = lbl_bound_error; + bd_frame_lbl = lbl_frame } :: !bound_error_sites; + lbl_bound_error + end else begin + let bd = List.hd !bound_error_sites in bd.bd_lbl + end -let emit_frame fd = - ` .word {emit_label fd.fd_lbl} + 4\n`; - ` .short {emit_int fd.fd_frame_size}\n`; - ` .short {emit_int (List.length fd.fd_live_offset)}\n`; - List.iter - (fun n -> - ` .short {emit_int n}\n`) - fd.fd_live_offset; - ` .align 2\n` +let emit_call_bound_error bd = + `{emit_label bd.bd_lbl}: {emit_call "caml_ml_array_bound_error"}\n`; + `{emit_label bd.bd_frame_lbl}:\n` + +(* Negate a comparison *) + +let negate_integer_comparison = function + Isigned cmp -> Isigned(negate_comparison cmp) + | Iunsigned cmp -> Iunsigned(negate_comparison cmp) (* Names of various instructions *) @@ -121,22 +172,13 @@ | Iunsigned Ceq -> "eq" | Iunsigned Cne -> "ne" | Iunsigned Cle -> "ls" | Iunsigned Cge -> "cs" | Iunsigned Clt -> "cc" | Iunsigned Cgt -> "hi" -let name_for_float_comparison cmp neg = - match cmp with - Ceq -> if neg then "ne" else "eq" - | Cne -> if neg then "eq" else "ne" - | Cle -> if neg then "hi" else "ls" - | Cge -> if neg then "lt" else "ge" - | Clt -> if neg then "pl" else "mi" - | Cgt -> if neg then "le" else "gt" - let name_for_int_operation = function Iadd -> "add" | Isub -> "sub" | Imul -> "mul" - | Iand -> "and" - | Ior -> "orr" - | Ixor -> "eor" + | Iand -> "and" + | Ior -> "orr" + | Ixor -> "eor" | _ -> assert false let name_for_shift_operation = function @@ -145,193 +187,310 @@ | Iasr -> "asr" | _ -> assert false -let name_for_shift_int_operation = function - Ishiftadd -> "add" - | Ishiftsub -> "sub" - | Ishiftsubrev -> "rsb" - -(* Recognize immediate operands *) - -(* Immediate operands are 8-bit immediate values, zero-extended, and rotated - right by 0, 2, 4, ... 30 bits. - We check only with 8-bit values shifted left 0 to 24 bits. *) - -let rec is_immed n shift = - shift <= 24 && - (Nativeint.logand n (Nativeint.shift_left (Nativeint.of_int 0xFF) shift) = n - || is_immed n (shift + 2)) - -let is_immediate n = is_immed n 0 - (* General functional to decompose a non-immediate integer constant - into 8-bit chunks shifted left 0 ... 24 bits *) + into 8-bit chunks shifted left 0 ... 30 bits. *) let decompose_intconst n fn = let i = ref n in let shift = ref 0 in let ninstr = ref 0 in - while !i <> 0n do - if Nativeint.to_int (Nativeint.shift_right !i !shift) land 3 = 0 then + while !i <> 0l do + if Int32.logand (Int32.shift_right !i !shift) 3l = 0l then shift := !shift + 2 else begin - let mask = Nativeint.shift_left 0xFFn !shift in - let bits = Nativeint.logand !i mask in - fn bits; + let bits = Int32.logand !i (Int32.shift_left 0xffl !shift) in + i := Int32.sub !i bits; shift := !shift + 8; - i := Nativeint.sub !i bits; - incr ninstr + incr ninstr; + fn bits end done; !ninstr (* Load an integer constant into a register *) -let emit_intconst r n = - let nr = Nativeint.lognot n in +let emit_intconst dst n = + let nr = Int32.lognot n in if is_immediate n then begin - ` mov {emit_reg r}, #{emit_nativeint n}\n`; 1 + (* Use movs here to enable 16-bit T1 encoding *) + ` movs {emit_reg dst}, #{emit_int32 n}\n`; 1 end else if is_immediate nr then begin - ` mvn {emit_reg r}, #{emit_nativeint nr}\n`; 1 + ` mvn {emit_reg dst}, #{emit_int32 nr}\n`; 1 + end else if !arch > ARMv6 then begin + let nl = Int32.logand 0xffffl n in + let nh = Int32.logand 0xffffl (Int32.shift_right_logical n 16) in + if nh = 0l then begin + ` movw {emit_reg dst}, #{emit_int32 nl}\n`; 1 + end else if Int32.logand nl 0xffl = nl then begin + ` movs {emit_reg dst}, #{emit_int32 nl}\n`; + ` movt {emit_reg dst}, #{emit_int32 nh}\n`; 2 + end else begin + ` movw {emit_reg dst}, #{emit_int32 nl}\n`; + ` movt {emit_reg dst}, #{emit_int32 nh}\n`; 2 + end end else begin let first = ref true in decompose_intconst n (fun bits -> if !first - then ` mov {emit_reg r}, #{emit_nativeint bits} @ {emit_nativeint n}\n` - else ` add {emit_reg r}, {emit_reg r}, #{emit_nativeint bits}\n`; + then ` mov {emit_reg dst}, #{emit_int32 bits} @ {emit_int32 n}\n` + else ` add {emit_reg dst}, {emit_reg dst}, #{emit_int32 bits}\n`; first := false) end (* Adjust sp (up or down) by the given byte amount *) -let emit_stack_adjustment instr n = - if n <= 0 then 0 else - decompose_intconst (Nativeint.of_int n) - (fun bits -> - ` {emit_string instr} sp, sp, #{emit_nativeint bits}\n`) +let emit_stack_adjustment n = + if n = 0 then 0 else begin + let instr = if n < 0 then "sub" else "add" in + let ninstr = decompose_intconst (Int32.of_int (abs n)) + (fun bits -> + ` {emit_string instr} sp, sp, #{emit_int32 bits}\n`) in + cfi_adjust_cfa_offset (-n); + ninstr + end + +(* Deallocate the stack frame before a return or tail call *) + +let output_epilogue f = + let n = frame_size() in + if n > 0 then begin + let ninstr = emit_stack_adjustment n in + let ninstr = ninstr + f () in + (* reset CFA back cause function body may continue *) + cfi_adjust_cfa_offset n; + ninstr + end else + f () (* Name of current function *) let function_name = ref "" (* Entry point for tail recursive calls *) let tailrec_entry_point = ref 0 -(* Table of symbols referenced *) -let symbol_constants = (Hashtbl.create 11 : (string, int) Hashtbl.t) -(* Table of floating-point literals *) -let float_constants = (Hashtbl.create 11 : (string, int) Hashtbl.t) -(* Total space (in word) occupied by pending literals *) +(* Pending floating-point literals *) +let float_literals = ref ([] : (string * label) list) +(* Pending relative references to the global offset table *) +let gotrel_literals = ref ([] : (label * label) list) +(* Pending symbol literals *) +let symbol_literals = ref ([] : (string * label) list) +(* Total space (in words) occupied by pending literals *) let num_literals = ref 0 -(* Label a symbol or float constant *) -let label_constant tbl s size = +(* Label a floating-point literal *) +let float_literal f = try - Hashtbl.find tbl s + List.assoc f !float_literals with Not_found -> let lbl = new_label() in - Hashtbl.add tbl s lbl; - num_literals := !num_literals + size; + num_literals := !num_literals + 2; + float_literals := (f, lbl) :: !float_literals; lbl -(* Emit all pending constants *) +(* Label a GOTREL literal *) +let gotrel_literal l = + let lbl = new_label() in + num_literals := !num_literals + 1; + gotrel_literals := (l, lbl) :: !gotrel_literals; + lbl -let emit_constants () = - Hashtbl.iter - (fun s lbl -> - `{emit_label lbl}: .word {emit_symbol s}\n`) - symbol_constants; - Hashtbl.iter - (fun s lbl -> - `{emit_label lbl}: .double {emit_string s}\n`) - float_constants; - Hashtbl.clear symbol_constants; - Hashtbl.clear float_constants; +(* Label a symbol literal *) +let symbol_literal s = + try + List.assoc s !symbol_literals + with Not_found -> + let lbl = new_label() in + num_literals := !num_literals + 1; + symbol_literals := (s, lbl) :: !symbol_literals; + lbl + +(* Emit all pending literals *) +let emit_literals() = + if !float_literals <> [] then begin + ` .align 3\n`; + List.iter + (fun (f, lbl) -> + `{emit_label lbl}: .double {emit_string f}\n`) + !float_literals; + float_literals := [] + end; + if !symbol_literals <> [] then begin + let offset = if !thumb then 4 else 8 in + let suffix = if !pic_code then "(GOT)" else "" in + ` .align 2\n`; + List.iter + (fun (l, lbl) -> + `{emit_label lbl}: .word _GLOBAL_OFFSET_TABLE_-({emit_label l}+{emit_int offset})\n`) + !gotrel_literals; + List.iter + (fun (s, lbl) -> + `{emit_label lbl}: .word {emit_symbol s}{emit_string suffix}\n`) + !symbol_literals; + gotrel_literals := []; + symbol_literals := [] + end; num_literals := 0 +(* Emit code to load the address of a symbol *) + +let emit_load_symbol_addr dst s = + if !pic_code then begin + let lbl_pic = new_label() in + let lbl_got = gotrel_literal lbl_pic in + let lbl_sym = symbol_literal s in + (* Both r3 and r12 are marked as clobbered in PIC mode (cf. proc.ml), + so use r12 as temporary scratch register unless the destination is + r12, then we use r3 instead. *) + let tmp = if dst.loc = Reg 8 (*r12*) + then phys_reg 3 (*r3*) + else phys_reg 8 (*r12*) in + ` ldr {emit_reg tmp}, {emit_label lbl_got}\n`; + ` ldr {emit_reg dst}, {emit_label lbl_sym}\n`; + `{emit_label lbl_pic}: add {emit_reg tmp}, pc, {emit_reg tmp}\n`; + ` ldr {emit_reg dst}, [{emit_reg tmp}, {emit_reg dst}] @ {emit_symbol s}\n`; + 4 + end else if !arch > ARMv6 && not !Clflags.dlcode && !fastcode_flag then begin + ` movw {emit_reg dst}, #:lower16:{emit_symbol s}\n`; + ` movt {emit_reg dst}, #:upper16:{emit_symbol s}\n`; + 2 + end else begin + let lbl = symbol_literal s in + ` ldr {emit_reg dst}, {emit_label lbl} @ {emit_symbol s}\n`; + 1 + end + (* Output the assembly code for an instruction *) let emit_instr i = + emit_debug_info i.dbg; match i.desc with Lend -> 0 | Lop(Imove | Ispill | Ireload) -> let src = i.arg.(0) and dst = i.res.(0) in if src.loc = dst.loc then 0 else begin - match (src, dst) with - {loc = Reg rs; typ = Int|Addr}, {loc = Reg rd; typ = Int|Addr} -> - ` mov {emit_reg dst}, {emit_reg src}\n`; 1 - | {loc = Reg rs; typ = Int|Addr}, {loc = Stack sd} -> - ` str {emit_reg src}, {emit_stack dst}\n`; 1 - | {loc = Stack ss; typ = Int|Addr}, {loc = Reg rd} -> - ` ldr {emit_reg dst}, {emit_stack src}\n`; 1 + begin match (src, dst) with + {loc = Reg _; typ = Float}, {loc = Reg _} -> + ` fcpyd {emit_reg dst}, {emit_reg src}\n` + | {loc = Reg _}, {loc = Reg _} -> + ` mov {emit_reg dst}, {emit_reg src}\n` + | {loc = Reg _; typ = Float}, _ -> + ` fstd {emit_reg src}, {emit_stack dst}\n` + | {loc = Reg _}, _ -> + ` str {emit_reg src}, {emit_stack dst}\n` + | {typ = Float}, _ -> + ` fldd {emit_reg dst}, {emit_stack src}\n` | _ -> - assert false + ` ldr {emit_reg dst}, {emit_stack src}\n` + end; 1 end | Lop(Iconst_int n) -> - emit_intconst i.res.(0) n - | Lop(Iconst_float s) -> - let bits = Int64.bits_of_float (float_of_string s) in - let high_bits = Int64.to_nativeint (Int64.shift_right_logical bits 32) - and low_bits = Int64.to_nativeint bits in - if is_immediate low_bits && is_immediate high_bits then begin - ` mov {emit_reg i.res.(0)}, #{emit_nativeint low_bits} @ {emit_string s}\n`; - ` mov {emit_reg i.res.(1)}, #{emit_nativeint high_bits}\n`; - 2 + emit_intconst i.res.(0) (Nativeint.to_int32 n) + | Lop(Iconst_float f) when !fpu = Soft -> + ` @ {emit_string f}\n`; + let bits = Int64.bits_of_float (float_of_string f) in + let high_bits = Int64.to_int32 (Int64.shift_right_logical bits 32) + and low_bits = Int64.to_int32 bits in + if is_immediate low_bits || is_immediate high_bits then begin + let ninstr_low = emit_intconst i.res.(0) low_bits + and ninstr_high = emit_intconst i.res.(1) high_bits in + ninstr_low + ninstr_high end else begin - let lbl = label_constant float_constants s 2 in - ` ldr {emit_reg i.res.(0)}, {emit_label lbl} @ {emit_string s}\n`; + let lbl = float_literal f in + ` ldr {emit_reg i.res.(0)}, {emit_label lbl}\n`; ` ldr {emit_reg i.res.(1)}, {emit_label lbl} + 4\n`; 2 end + | Lop(Iconst_float f) when !fpu = VFPv2 -> + let lbl = float_literal f in + ` fldd {emit_reg i.res.(0)}, {emit_label lbl} @ {emit_string f}\n`; + 1 + | Lop(Iconst_float f) -> + let encode imm = + let sg = Int64.to_int (Int64.shift_right_logical imm 63) in + let ex = Int64.to_int (Int64.shift_right_logical imm 52) in + let ex = (ex land 0x7ff) - 1023 in + let mn = Int64.logand imm 0xfffffffffffffL in + if Int64.logand mn 0xffffffffffffL <> 0L || ex < -3 || ex > 4 + then + None + else begin + let mn = Int64.to_int (Int64.shift_right_logical mn 48) in + if mn land 0x0f <> mn then + None + else + let ex = ((ex + 3) land 0x07) lxor 0x04 in + Some((sg lsl 7) lor (ex lsl 4) lor mn) + end in + begin match encode (Int64.bits_of_float (float_of_string f)) with + None -> + let lbl = float_literal f in + ` fldd {emit_reg i.res.(0)}, {emit_label lbl} @ {emit_string f}\n` + | Some imm8 -> + ` fconstd {emit_reg i.res.(0)}, #{emit_int imm8} @ {emit_string f}\n` + end; 1 | Lop(Iconst_symbol s) -> - let lbl = label_constant symbol_constants s 1 in - ` ldr {emit_reg i.res.(0)}, {emit_label lbl} @ {emit_symbol s}\n`; 1 + emit_load_symbol_addr i.res.(0) s | Lop(Icall_ind) -> - ` mov lr, pc\n`; - `{record_frame i.live} bx {emit_reg i.arg.(0)}\n`; 2 + if !arch >= ARMv5 then begin + ` blx {emit_reg i.arg.(0)}\n`; + `{record_frame i.live i.dbg}\n`; 1 + end else begin + ` mov lr, pc\n`; + ` bx {emit_reg i.arg.(0)}\n`; + `{record_frame i.live i.dbg}\n`; 2 + end | Lop(Icall_imm s) -> - `{record_frame i.live} bl {emit_symbol s}\n`; 1 + ` {emit_call s}\n`; + `{record_frame i.live i.dbg}\n`; 1 | Lop(Itailcall_ind) -> - let n = frame_size() in - if !contains_calls then - ` ldr lr, [sp, #{emit_int (n-4)}]\n`; - let ninstr = emit_stack_adjustment "add" n in - ` bx {emit_reg i.arg.(0)}\n`; - 2 + ninstr + output_epilogue begin fun () -> + if !contains_calls then + ` ldr lr, [sp, #{emit_int (-4)}]\n`; + ` bx {emit_reg i.arg.(0)}\n`; 2 + end | Lop(Itailcall_imm s) -> if s = !function_name then begin ` b {emit_label !tailrec_entry_point}\n`; 1 end else begin - let n = frame_size() in - if !contains_calls then - ` ldr lr, [sp, #{emit_int (n-4)}]\n`; - let ninstr = emit_stack_adjustment "add" n in - ` b {emit_symbol s}\n`; - 2 + ninstr - end - | Lop(Iextcall(s, alloc)) -> - if alloc then begin - let lbl = label_constant symbol_constants s 1 in - ` ldr r12, {emit_label lbl} @ {emit_symbol s}\n`; - `{record_frame i.live} bl caml_c_call\n`; 2 - end else begin - ` bl {emit_symbol s}\n`; 1 + output_epilogue begin fun () -> + if !contains_calls then + ` ldr lr, [sp, #{emit_int (-4)}]\n`; + ` {emit_jump s}\n`; 2 + end end + | Lop(Iextcall(s, false)) -> + ` {emit_call s}\n`; 1 + | Lop(Iextcall(s, true)) -> + let ninstr = emit_load_symbol_addr (phys_reg 7 (* r7 *)) s in + ` {emit_call "caml_c_call"}\n`; + `{record_frame i.live i.dbg}\n`; + 1 + ninstr | Lop(Istackoffset n) -> assert (n mod 8 = 0); - let ninstr = - if n >= 0 - then emit_stack_adjustment "sub" n - else emit_stack_adjustment "add" (-n) in + let ninstr = emit_stack_adjustment (-n) in stack_offset := !stack_offset + n; ninstr - | Lop(Iload((Double | Double_u), addr)) -> - let addr' = offset_addressing addr 4 in - if i.res.(0).loc <> i.arg.(0).loc then begin - ` ldr {emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`; - ` ldr {emit_reg i.res.(1)}, {emit_addressing addr' i.arg 0}\n` - end else begin - ` ldr {emit_reg i.res.(1)}, {emit_addressing addr' i.arg 0}\n`; - ` ldr {emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n` - end; - 2 + | Lop(Iload(Single, addr)) when !fpu >= VFPv2 -> + ` flds s14, {emit_addressing addr i.arg 0}\n`; + ` fcvtds {emit_reg i.res.(0)}, s14\n`; 2 + | Lop(Iload((Double | Double_u), addr)) when !fpu = Soft -> + (* Use LDM or LDRD if possible *) + begin match i.res.(0), i.res.(1), addr with + {loc = Reg rt}, {loc = Reg rt2}, Iindexed 0 + when rt < rt2 -> + ` ldm {emit_reg i.arg.(0)}, \{{emit_reg i.res.(0)}, {emit_reg i.res.(1)}}\n`; 1 + | {loc = Reg rt}, {loc = Reg rt2}, addr + when !arch >= ARMv5TE && rt mod 2 == 0 && rt2 = rt + 1 -> + ` ldrd {emit_reg i.res.(0)}, {emit_reg i.res.(1)}, {emit_addressing addr i.arg 0}\n`; 1 + | _ -> + let addr' = offset_addressing addr 4 in + if i.res.(0).loc <> i.arg.(0).loc then begin + ` ldr {emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`; + ` ldr {emit_reg i.res.(1)}, {emit_addressing addr' i.arg 0}\n` + end else begin + ` ldr {emit_reg i.res.(1)}, {emit_addressing addr' i.arg 0}\n`; + ` ldr {emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n` + end; 2 + end | Lop(Iload(size, addr)) -> let r = i.res.(0) in let instr = @@ -340,65 +499,114 @@ | Byte_signed -> "ldrsb" | Sixteen_unsigned -> "ldrh" | Sixteen_signed -> "ldrsh" + | Double + | Double_u -> "fldd" | _ (* 32-bit quantities *) -> "ldr" in - ` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 0}\n`; - 1 - | Lop(Istore((Double | Double_u), addr)) -> - let addr' = offset_addressing addr 4 in - ` str {emit_reg i.arg.(0)}, {emit_addressing addr i.arg 2}\n`; - ` str {emit_reg i.arg.(1)}, {emit_addressing addr' i.arg 2}\n`; - 2 + ` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 0}\n`; 1 + | Lop(Istore(Single, addr)) when !fpu >= VFPv2 -> + ` fcvtsd s14, {emit_reg i.arg.(0)}\n`; + ` fsts s14, {emit_addressing addr i.arg 1}\n`; 2 + | Lop(Istore((Double | Double_u), addr)) when !fpu = Soft -> + (* Use STM or STRD if possible *) + begin match i.arg.(0), i.arg.(1), addr with + {loc = Reg rt}, {loc = Reg rt2}, Iindexed 0 + when rt < rt2 -> + ` stm {emit_reg i.arg.(2)}, \{{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}}\n`; 1 + | {loc = Reg rt}, {loc = Reg rt2}, addr + when !arch >= ARMv5TE && rt mod 2 == 0 && rt2 = rt + 1 -> + ` strd {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_addressing addr i.arg 2}\n`; 1 + | _ -> + let addr' = offset_addressing addr 4 in + ` str {emit_reg i.arg.(0)}, {emit_addressing addr i.arg 2}\n`; + ` str {emit_reg i.arg.(1)}, {emit_addressing addr' i.arg 2}\n`; 2 + end | Lop(Istore(size, addr)) -> let r = i.arg.(0) in let instr = match size with - Byte_unsigned | Byte_signed -> "strb" - | Sixteen_unsigned | Sixteen_signed -> "strh" + Byte_unsigned + | Byte_signed -> "strb" + | Sixteen_unsigned + | Sixteen_signed -> "strh" + | Double + | Double_u -> "fstd" | _ (* 32-bit quantities *) -> "str" in - ` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 1}\n`; - 1 + ` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 1}\n`; 1 | Lop(Ialloc n) -> + let lbl_frame = record_frame_label i.live i.dbg in if !fastcode_flag then begin - let ni = emit_intconst (phys_reg 8 (*r12*)) (Nativeint.of_int n) in - ` sub alloc_ptr, alloc_ptr, r12\n`; + let lbl_redo = new_label() in + `{emit_label lbl_redo}:`; + let ninstr = decompose_intconst + (Int32.of_int n) + (fun i -> + ` sub alloc_ptr, alloc_ptr, #{emit_int32 i}\n`) in ` cmp alloc_ptr, alloc_limit\n`; - `{record_frame i.live} blcc caml_call_gc\n`; ` add {emit_reg i.res.(0)}, alloc_ptr, #4\n`; - 4 + ni - end else if n = 8 || n = 12 || n = 16 then begin - `{record_frame i.live} bl caml_alloc{emit_int ((n-4)/4)}\n`; - ` add {emit_reg i.res.(0)}, alloc_ptr, #4\n`; 2 + let lbl_call_gc = new_label() in + ` bcc {emit_label lbl_call_gc}\n`; + call_gc_sites := + { gc_lbl = lbl_call_gc; + gc_return_lbl = lbl_redo; + gc_frame_lbl = lbl_frame } :: !call_gc_sites; + 3 + ninstr end else begin - let ni = emit_intconst (phys_reg 8 (*r12*)) (Nativeint.of_int n) in - `{record_frame i.live} bl caml_allocN\n`; - ` add {emit_reg i.res.(0)}, alloc_ptr, #4\n`; - 2 + ni + let ninstr = + begin match n with + 8 -> ` {emit_call "caml_alloc1"}\n`; 1 + | 12 -> ` {emit_call "caml_alloc2"}\n`; 1 + | 16 -> ` {emit_call "caml_alloc3"}\n`; 1 + | _ -> let ninstr = emit_intconst (phys_reg 7) (Int32.of_int n) in + ` {emit_call "caml_allocN"}\n`; 1 + ninstr + end in + `{emit_label lbl_frame}: add {emit_reg i.res.(0)}, alloc_ptr, #4\n`; + 1 + ninstr end | Lop(Iintop(Ilsl | Ilsr | Iasr as op)) -> let shift = name_for_shift_operation op in ` mov {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_string shift} {emit_reg i.arg.(1)}\n`; 1 | Lop(Iintop(Icomp cmp)) -> - let comp = name_for_comparison cmp in + let compthen = name_for_comparison cmp in + let compelse = name_for_comparison (negate_integer_comparison cmp) in ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; - ` mov {emit_reg i.res.(0)}, #0\n`; - ` mov{emit_string comp} {emit_reg i.res.(0)}, #1\n`; 3 - | Lop(Iintop(Icheckbound)) -> + ` ite {emit_string compthen}\n`; + ` mov{emit_string compthen} {emit_reg i.res.(0)}, #1\n`; + ` mov{emit_string compelse} {emit_reg i.res.(0)}, #0\n`; 4 + | Lop(Iintop_imm(Icomp cmp, n)) -> + let compthen = name_for_comparison cmp in + let compelse = name_for_comparison (negate_integer_comparison cmp) in + ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; + ` ite {emit_string compthen}\n`; + ` mov{emit_string compthen} {emit_reg i.res.(0)}, #1\n`; + ` mov{emit_string compelse} {emit_reg i.res.(0)}, #0\n`; 4 + | Lop(Iintop Icheckbound) -> + let lbl = bound_error_label i.dbg in ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; - ` blls caml_ml_array_bound_error\n`; 2 + ` bls {emit_label lbl}\n`; 2 + | Lop(Iintop_imm(Icheckbound, n)) -> + let lbl = bound_error_label i.dbg in + ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; + ` bls {emit_label lbl}\n`; 2 + | Lop(Ispecific(Ishiftcheckbound shift)) -> + let lbl = bound_error_label i.dbg in + ` cmp {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`; + ` bcs {emit_label lbl}\n`; 2 | Lop(Iintop op) -> let instr = name_for_int_operation op in - ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; 1 + ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; 1 | Lop(Iintop_imm(Idiv, n)) -> (* n is a power of 2 *) let l = Misc.log2 n in let r = i.res.(0) in ` movs {emit_reg r}, {emit_reg i.arg.(0)}\n`; - if n <= 256 then + if n <= 256 then begin + ` it lt\n`; ` addlt {emit_reg r}, {emit_reg r}, #{emit_int (n-1)}\n` - else begin + end else begin + ` itt lt\n`; ` addlt {emit_reg r}, {emit_reg r}, #{emit_int n}\n`; ` sublt {emit_reg r}, {emit_reg r}, #1\n` end; - ` mov {emit_reg r}, {emit_reg r}, asr #{emit_int l}\n`; 4 + ` mov {emit_reg r}, {emit_reg r}, asr #{emit_int l}\n`; 5 | Lop(Iintop_imm(Imod, n)) -> (* n is a power of 2 *) let l = Misc.log2 n in let a = i.arg.(0) in @@ -409,47 +617,88 @@ ` mov {emit_reg r}, {emit_reg r}, lsr #{emit_int (32-l)}\n`; ` bpl {emit_label lbl}\n`; ` cmp {emit_reg r}, #0\n`; + ` it ne\n`; ` subne {emit_reg r}, {emit_reg r}, #{emit_int n}\n`; - `{emit_label lbl}:\n`; 6 + `{emit_label lbl}:\n`; 7 | Lop(Iintop_imm((Ilsl | Ilsr | Iasr as op), n)) -> let shift = name_for_shift_operation op in ` mov {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_string shift} #{emit_int n}\n`; 1 - | Lop(Iintop_imm(Icomp cmp, n)) -> - let comp = name_for_comparison cmp in - ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; - ` mov {emit_reg i.res.(0)}, #0\n`; - ` mov{emit_string comp} {emit_reg i.res.(0)}, #1\n`; 3 - | Lop(Iintop_imm(Icheckbound, n)) -> - ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; - ` blls caml_ml_array_bound_error\n`; 2 | Lop(Iintop_imm(op, n)) -> let instr = name_for_int_operation op in - ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n`; 1 - | Lop(Inegf) -> (* argument and result in (r0, r1) *) - ` eor r1, r1, #0x80000000\n`; 1 - | Lop(Iabsf) -> (* argument and result in (r0, r1) *) - ` bic r1, r1, #0x80000000\n`; 1 - | Lop(Ifloatofint | Iintoffloat | Iaddf | Isubf | Imulf | Idivf) -> - assert false + ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n`; 1 + | Lop(Iabsf | Inegf as op) when !fpu = Soft -> + let instr = (match op with + Iabsf -> "bic" + | Inegf -> "eor" + | _ -> assert false) in + ` {emit_string instr} {emit_reg i.res.(1)}, {emit_reg i.arg.(1)}, #0x80000000\n`; 1 + | Lop(Iabsf | Inegf | Ispecific Isqrtf as op) -> + let instr = (match op with + Iabsf -> "fabsd" + | Inegf -> "fnegd" + | Ispecific Isqrtf -> "fsqrtd" + | _ -> assert false) in + ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`; 1 + | Lop(Ifloatofint) -> + ` fmsr s14, {emit_reg i.arg.(0)}\n`; + ` fsitod {emit_reg i.res.(0)}, s14\n`; 2 + | Lop(Iintoffloat) -> + ` ftosizd s14, {emit_reg i.arg.(0)}\n`; + ` fmrs {emit_reg i.res.(0)}, s14\n`; 2 + | Lop(Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf as op) -> + let instr = (match op with + Iaddf -> "faddd" + | Isubf -> "fsubd" + | Imulf -> "fmuld" + | Idivf -> "fdivd" + | Ispecific Inegmulf -> "fnmuld" + | _ -> assert false) in + ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; + 1 + | Lop(Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf as op)) -> + let instr = (match op with + Imuladdf -> "fmacd" + | Inegmuladdf -> "fnmacd" + | Imulsubf -> "fmscd" + | Inegmulsubf -> "fnmscd" + | _ -> assert false) in + ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n`; + 1 | Lop(Ispecific(Ishiftarith(op, shift))) -> - let instr = name_for_shift_int_operation op in - ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}`; + let instr = (match op with + Ishiftadd -> "add" + | Ishiftsub -> "sub" + | Ishiftsubrev -> "rsb") in + ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}`; if shift >= 0 then `, lsl #{emit_int shift}\n` else `, asr #{emit_int (-shift)}\n`; 1 - | Lop(Ispecific(Ishiftcheckbound shift)) -> - ` cmp {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`; - ` blcs caml_ml_array_bound_error\n`; 2 | Lop(Ispecific(Irevsubimm n)) -> ` rsb {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n`; 1 + | Lop(Ispecific(Imuladd | Imulsub as op)) -> + let instr = (match op with + Imuladd -> "mla" + | Imulsub -> "mls" + | _ -> assert false) in + ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n`; 1 + | Lop(Ispecific(Ibswap size)) -> + begin match size with + 16 -> + ` rev16 {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`; + ` movt {emit_reg i.res.(0)}, #0\n`; 2 + | 32 -> + ` rev {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`; 1 + | _ -> + assert false + end | Lreloadretaddr -> let n = frame_size() in ` ldr lr, [sp, #{emit_int(n-4)}]\n`; 1 | Lreturn -> - let ninstr = emit_stack_adjustment "add" (frame_size()) in - ` bx lr\n`; - ninstr + 1 + output_epilogue begin fun () -> + ` bx lr\n`; 1 + end | Llabel lbl -> `{emit_label lbl}:\n`; 0 | Lbranch lbl -> @@ -458,29 +707,41 @@ begin match tst with Itruetest -> ` cmp {emit_reg i.arg.(0)}, #0\n`; - ` bne {emit_label lbl}\n` + ` bne {emit_label lbl}\n`; 2 | Ifalsetest -> ` cmp {emit_reg i.arg.(0)}, #0\n`; - ` beq {emit_label lbl}\n` + ` beq {emit_label lbl}\n`; 2 | Iinttest cmp -> ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; let comp = name_for_comparison cmp in - ` b{emit_string comp} {emit_label lbl}\n` + ` b{emit_string comp} {emit_label lbl}\n`; 2 | Iinttest_imm(cmp, n) -> ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; let comp = name_for_comparison cmp in - ` b{emit_string comp} {emit_label lbl}\n` + ` b{emit_string comp} {emit_label lbl}\n`; 2 | Ifloattest(cmp, neg) -> - assert false + let comp = (match (cmp, neg) with + (Ceq, false) | (Cne, true) -> "eq" + | (Cne, false) | (Ceq, true) -> "ne" + | (Clt, false) -> "cc" + | (Clt, true) -> "cs" + | (Cle, false) -> "ls" + | (Cle, true) -> "hi" + | (Cgt, false) -> "gt" + | (Cgt, true) -> "le" + | (Cge, false) -> "ge" + | (Cge, true) -> "lt") in + ` fcmpd {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; + ` fmstat\n`; + ` b{emit_string comp} {emit_label lbl}\n`; 3 | Ioddtest -> ` tst {emit_reg i.arg.(0)}, #1\n`; - ` bne {emit_label lbl}\n` + ` bne {emit_label lbl}\n`; 2 | Ieventest -> ` tst {emit_reg i.arg.(0)}, #1\n`; - ` beq {emit_label lbl}\n` - end; - 2 - | Lcondbranch3(lbl0, lbl1, lbl2) -> + ` beq {emit_label lbl}\n`; 2 + end + | Lcondbranch3(lbl0, lbl1, lbl2) -> ` cmp {emit_reg i.arg.(0)}, #1\n`; begin match lbl0 with None -> () @@ -495,107 +756,151 @@ | Some lbl -> ` bgt {emit_label lbl}\n` end; 4 - | Lswitch jumptbl -> - ` ldr pc, [pc, {emit_reg i.arg.(0)}, lsl #2]\n`; - ` mov r0, r0\n`; (* nop *) - for i = 0 to Array.length jumptbl - 1 do - ` .word {emit_label jumptbl.(i)}\n` - done; + | Lswitch jumptbl -> + if !arch > ARMv6 && !thumb then begin + (* The Thumb-2 TBH instruction supports only forward branches, + so we need to generate appropriate trampolines for all labels + that appear before this switch instruction (PR#5623) *) + let tramtbl = Array.copy jumptbl in + ` tbh [pc, {emit_reg i.arg.(0)}, lsl #1]\n`; + for j = 0 to Array.length tramtbl - 1 do + let rec label i = + match i.desc with + Lend -> new_label() + | Llabel lbl when lbl = tramtbl.(j) -> lbl + | _ -> label i.next in + tramtbl.(j) <- label i.next; + ` .short ({emit_label tramtbl.(j)}-.)/2+{emit_int j}\n` + done; + (* Generate the necessary trampolines *) + for j = 0 to Array.length tramtbl - 1 do + if tramtbl.(j) <> jumptbl.(j) then + `{emit_label tramtbl.(j)}: b {emit_label jumptbl.(j)}\n` + done + end else if not !pic_code then begin + ` ldr pc, [pc, {emit_reg i.arg.(0)}, lsl #2]\n`; + ` nop\n`; + for j = 0 to Array.length jumptbl - 1 do + ` .word {emit_label jumptbl.(j)}\n` + done + end else begin + (* Slightly slower, but position-independent *) + ` add pc, pc, {emit_reg i.arg.(0)}, lsl #2\n`; + ` nop\n`; + for j = 0 to Array.length jumptbl - 1 do + ` b {emit_label jumptbl.(j)}\n` + done + end; 2 + Array.length jumptbl | Lsetuptrap lbl -> ` bl {emit_label lbl}\n`; 1 | Lpushtrap -> stack_offset := !stack_offset + 8; - ` stmfd sp!, \{trap_ptr, lr}\n`; + ` push \{trap_ptr, lr}\n`; + cfi_adjust_cfa_offset 8; ` mov trap_ptr, sp\n`; 2 | Lpoptrap -> - ` ldmfd sp!, \{trap_ptr, lr}\n`; + ` pop \{trap_ptr, lr}\n`; + cfi_adjust_cfa_offset (-8); stack_offset := !stack_offset - 8; 1 | Lraise -> - ` mov sp, trap_ptr\n`; - ` ldmfd sp!, \{trap_ptr, pc}\n`; 2 + if !Clflags.debug then begin + ` {emit_call "caml_raise_exn"}\n`; + `{record_frame Reg.Set.empty i.dbg}\n`; 1 + end else begin + ` mov sp, trap_ptr\n`; + ` pop \{trap_ptr, pc}\n`; 2 + end (* Emission of an instruction sequence *) -let no_fallthrough = function - Lop(Itailcall_ind | Itailcall_imm _) -> true - | Lreturn -> true - | Lbranch _ -> true - | Lswitch _ -> true - | Lraise -> true - | _ -> false - let rec emit_all ninstr i = if i.desc = Lend then () else begin let n = emit_instr i in let ninstr' = ninstr + n in - let limit = 511 - !num_literals in - if ninstr' >= limit - 64 && no_fallthrough i.desc then begin - emit_constants(); + (* fldd can address up to +/-1KB, ldr can address up to +/-4KB *) + let limit = (if !fpu >= VFPv2 && !float_literals <> [] + then 127 + else 511) in + let limit = limit - !num_literals in + if ninstr' >= limit - 64 && not(has_fallthrough i.desc) then begin + emit_literals(); emit_all 0 i.next - end else - if ninstr' >= limit then begin + end else if !num_literals != 0 && ninstr' >= limit then begin let lbl = new_label() in ` b {emit_label lbl}\n`; - emit_constants(); + emit_literals(); `{emit_label lbl}:\n`; emit_all 0 i.next end else emit_all ninstr' i.next end +(* Emission of the profiling prelude *) + +let emit_profile() = + match Config.system with + "linux_eabi" | "linux_eabihf" -> + ` push \{lr}\n`; + ` {emit_call "__gnu_mcount_nc"}\n` + | _ -> () + (* Emission of a function declaration *) let fundecl fundecl = function_name := fundecl.fun_name; fastcode_flag := fundecl.fun_fast; tailrec_entry_point := new_label(); + float_literals := []; + gotrel_literals := []; + symbol_literals := []; stack_offset := 0; - Hashtbl.clear symbol_constants; - Hashtbl.clear float_constants; + call_gc_sites := []; + bound_error_sites := []; ` .text\n`; ` .align 2\n`; - ` .global {emit_symbol fundecl.fun_name}\n`; + ` .globl {emit_symbol fundecl.fun_name}\n`; + if !arch > ARMv6 && !thumb then + ` .thumb\n` + else + ` .arm\n`; + ` .type {emit_symbol fundecl.fun_name}, %function\n`; `{emit_symbol fundecl.fun_name}:\n`; + emit_debug_info fundecl.fun_dbg; + cfi_startproc(); + if !Clflags.gprofile then emit_profile(); let n = frame_size() in - ignore(emit_stack_adjustment "sub" n); - if !contains_calls then - ` str lr, [sp, #{emit_int(n - 4)}]\n`; + if n > 0 then begin + ignore(emit_stack_adjustment (-n)); + if !contains_calls then + ` str lr, [sp, #{emit_int(n - 4)}]\n` + end; `{emit_label !tailrec_entry_point}:\n`; emit_all 0 fundecl.fun_body; - emit_constants() + emit_literals(); + List.iter emit_call_gc !call_gc_sites; + List.iter emit_call_bound_error !bound_error_sites; + cfi_endproc(); + ` .type {emit_symbol fundecl.fun_name}, %function\n`; + ` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n` (* Emission of data *) let emit_item = function - Cglobal_symbol s -> - ` .global {emit_symbol s}\n`; - | Cdefine_symbol s -> - `{emit_symbol s}:\n` - | Cdefine_label lbl -> - `{emit_label (100000 + lbl)}:\n` - | Cint8 n -> - ` .byte {emit_int n}\n` - | Cint16 n -> - ` .short {emit_int n}\n` - | Cint32 n -> - ` .word {emit_nativeint n}\n` - | Cint n -> - ` .word {emit_nativeint n}\n` - | Csingle f -> - emit_float32_directive ".long" f - | Cdouble f -> - emit_float64_split_directive ".long" f - | Csymbol_address s -> - ` .word {emit_symbol s}\n` - | Clabel_address lbl -> - ` .word {emit_label (100000 + lbl)}\n` - | Cstring s -> - emit_string_directive " .ascii " s - | Cskip n -> - if n > 0 then ` .space {emit_int n}\n` - | Calign n -> - ` .align {emit_int(Misc.log2 n)}\n` + Cglobal_symbol s -> ` .globl {emit_symbol s}\n`; + | Cdefine_symbol s -> `{emit_symbol s}:\n` + | Cdefine_label lbl -> `{emit_data_label lbl}:\n` + | Cint8 n -> ` .byte {emit_int n}\n` + | Cint16 n -> ` .short {emit_int n}\n` + | Cint32 n -> ` .long {emit_int32 (Nativeint.to_int32 n)}\n` + | Cint n -> ` .long {emit_int32 (Nativeint.to_int32 n)}\n` + | Csingle f -> ` .single {emit_string f}\n` + | Cdouble f -> ` .double {emit_string f}\n` + | Csymbol_address s -> ` .word {emit_symbol s}\n` + | Clabel_address lbl -> ` .word {emit_data_label lbl}\n` + | Cstring s -> emit_string_directive " .ascii " s + | Cskip n -> if n > 0 then ` .space {emit_int n}\n` + | Calign n -> ` .align {emit_int(Misc.log2 n)}\n` let data l = ` .data\n`; @@ -604,32 +909,64 @@ (* Beginning / end of an assembly file *) let begin_assembly() = - `trap_ptr .req r11\n`; - `alloc_ptr .req r8\n`; - `alloc_limit .req r10\n`; + reset_debug_info(); + ` .syntax unified\n`; + begin match !arch with + | ARMv4 -> ` .arch armv4t\n` + | ARMv5 -> ` .arch armv5t\n` + | ARMv5TE -> ` .arch armv5te\n` + | ARMv6 -> ` .arch armv6\n` + | ARMv6T2 -> ` .arch armv6t2\n` + | ARMv7 -> ` .arch armv7-a\n` + end; + begin match !fpu with + Soft -> ` .fpu softvfp\n` + | VFPv2 -> ` .fpu vfpv2\n` + | VFPv3_D16 -> ` .fpu vfpv3-d16\n` + | VFPv3 -> ` .fpu vfpv3\n` + end; + `trap_ptr .req r8\n`; + `alloc_ptr .req r10\n`; + `alloc_limit .req r11\n`; let lbl_begin = Compilenv.make_symbol (Some "data_begin") in ` .data\n`; - ` .global {emit_symbol lbl_begin}\n`; + ` .globl {emit_symbol lbl_begin}\n`; `{emit_symbol lbl_begin}:\n`; let lbl_begin = Compilenv.make_symbol (Some "code_begin") in ` .text\n`; - ` .global {emit_symbol lbl_begin}\n`; + ` .globl {emit_symbol lbl_begin}\n`; `{emit_symbol lbl_begin}:\n` let end_assembly () = let lbl_end = Compilenv.make_symbol (Some "code_end") in ` .text\n`; - ` .global {emit_symbol lbl_end}\n`; + ` .globl {emit_symbol lbl_end}\n`; `{emit_symbol lbl_end}:\n`; let lbl_end = Compilenv.make_symbol (Some "data_end") in ` .data\n`; - ` .global {emit_symbol lbl_end}\n`; + ` .globl {emit_symbol lbl_end}\n`; `{emit_symbol lbl_end}:\n`; - ` .word 0\n`; + ` .long 0\n`; let lbl = Compilenv.make_symbol (Some "frametable") in - ` .data\n`; - ` .global {emit_symbol lbl}\n`; + ` .globl {emit_symbol lbl}\n`; `{emit_symbol lbl}:\n`; - ` .word {emit_int (List.length !frame_descriptors)}\n`; - List.iter emit_frame !frame_descriptors; - frame_descriptors := [] + emit_frames + { efa_label = (fun lbl -> + ` .type {emit_label lbl}, %function\n`; + ` .word {emit_label lbl}\n`); + efa_16 = (fun n -> ` .short {emit_int n}\n`); + efa_32 = (fun n -> ` .long {emit_int32 n}\n`); + efa_word = (fun n -> ` .word {emit_int n}\n`); + efa_align = (fun n -> ` .align {emit_int(Misc.log2 n)}\n`); + efa_label_rel = (fun lbl ofs -> + ` .word {emit_label lbl} - . + {emit_int32 ofs}\n`); + efa_def_label = (fun lbl -> `{emit_label lbl}:\n`); + efa_string = (fun s -> emit_string_directive " .asciz " s) }; + ` .type {emit_symbol lbl}, %object\n`; + ` .size {emit_symbol lbl}, .-{emit_symbol lbl}\n`; + begin match Config.system with + "linux_eabihf" | "linux_eabi" -> + (* Mark stack as non-executable *) + ` .section .note.GNU-stack,\"\",%progbits\n` + | _ -> () + end diff -Nru ocaml-3.12.1/asmcomp/arm/proc.ml ocaml-4.01.0/asmcomp/arm/proc.ml --- ocaml-3.12.1/asmcomp/arm/proc.ml 2009-05-04 13:46:46.000000000 +0000 +++ ocaml-4.01.0/asmcomp/arm/proc.ml 2013-06-03 18:03:59.000000000 +0000 @@ -1,17 +1,16 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* Benedikt Meurer, University of Siegen *) (* *) -(* Copyright 1998 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) +(* Copyright 1998 Institut National de Recherche en Informatique *) +(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) +(* reserved. This file is distributed under the terms of the Q *) +(* Public License version 1.0. *) (* *) (***********************************************************************) -(* $Id: proc.ml 9252 2009-05-04 13:46:46Z xleroy $ *) - (* Description of the ARM processor *) open Misc @@ -26,32 +25,57 @@ (* Registers available for register allocation *) -(* Register map: - r0 - r3 general purpose (not preserved by C) - r4 - r7 general purpose (preserved) - r8 allocation pointer (preserved) - r9 platform register, usually reserved - r10 allocation limit (preserved) - r11 trap pointer (preserved) - r12 general purpose (not preserved by C) - r13 stack pointer - r14 return address - r15 program counter +(* Integer register map: + r0 - r3 general purpose (not preserved) + r4 - r7 general purpose (preserved) + r8 trap pointer (preserved) + r9 platform register, usually reserved + r10 allocation pointer (preserved) + r11 allocation limit (preserved) + r12 intra-procedural scratch register (not preserved) + r13 stack pointer + r14 return address + r15 program counter + Floating-point register map (VFPv{2,3}): + d0 - d7 general purpose (not preserved) + d8 - d15 general purpose (preserved) + d16 - d31 generat purpose (not preserved), VFPv3 only *) -let int_reg_name = [| - "r0"; "r1"; "r2"; "r3"; "r4"; "r5"; "r6"; "r7"; "r12" -|] +let int_reg_name = + [| "r0"; "r1"; "r2"; "r3"; "r4"; "r5"; "r6"; "r7"; "r12" |] + +let float_reg_name = + [| "d0"; "d1"; "d2"; "d3"; "d4"; "d5"; "d6"; "d7"; + "d8"; "d9"; "d10"; "d11"; "d12"; "d13"; "d14"; "d15"; + "d16"; "d17"; "d18"; "d19"; "d20"; "d21"; "d22"; "d23"; + "d24"; "d25"; "d26"; "d27"; "d28"; "d29"; "d30"; "d31" |] + +(* We have three register classes: + 0 for integer registers + 1 for VFPv2 and VFPv3-D16 + 2 for VFPv3 + This way we can choose between VFPv2/VFPv3-D16 and VFPv3 + at (ocamlopt) runtime using command line switches. +*) -let num_register_classes = 1 +let num_register_classes = 3 -let register_class r = assert (r.typ <> Float); 0 +let register_class r = + match (r.typ, !fpu) with + (Int | Addr), _ -> 0 + | Float, VFPv2 -> 1 + | Float, VFPv3_D16 -> 1 + | Float, _ -> 2 -let num_available_registers = [| 9 |] +let num_available_registers = + [| 9; 16; 32 |] -let first_available_register = [| 0 |] +let first_available_register = + [| 0; 100; 100 |] -let register_name r = int_reg_name.(r) +let register_name r = + if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100) let rotate_registers = true @@ -59,25 +83,34 @@ let hard_int_reg = let v = Array.create 9 Reg.dummy in - for i = 0 to 8 do v.(i) <- Reg.at_location Int (Reg i) done; + for i = 0 to 8 do + v.(i) <- Reg.at_location Int (Reg i) + done; + v + +let hard_float_reg = + let v = Array.create 32 Reg.dummy in + for i = 0 to 31 do + v.(i) <- Reg.at_location Float (Reg(100 + i)) + done; v -let all_phys_regs = hard_int_reg +let all_phys_regs = + Array.append hard_int_reg hard_float_reg -let phys_reg n = all_phys_regs.(n) +let phys_reg n = + if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100) let stack_slot slot ty = - assert (ty <> Float); Reg.at_location ty (Stack slot) (* Calling conventions *) -(* XXX float types have already been expanded into pairs of integers. - So we cannot align these floats. See if that causes a problem. *) - -let calling_conventions first_int last_int make_stack arg = +let calling_conventions + first_int last_int first_float last_float make_stack arg = let loc = Array.create (Array.length arg) Reg.dummy in let int = ref first_int in + let float = ref first_float in let ofs = ref 0 in for i = 0 to Array.length arg - 1 do match arg.(i).typ with @@ -90,37 +123,86 @@ ofs := !ofs + size_int end | Float -> - assert false + assert (abi = EABI_HF); + assert (!fpu >= VFPv2); + if !float <= last_float then begin + loc.(i) <- phys_reg !float; + incr float + end else begin + ofs := Misc.align !ofs size_float; + loc.(i) <- stack_slot (make_stack !ofs) Float; + ofs := !ofs + size_float + end done; - (loc, Misc.align !ofs 8) + (loc, Misc.align !ofs 8) (* keep stack 8-aligned *) let incoming ofs = Incoming ofs let outgoing ofs = Outgoing ofs let not_supported ofs = fatal_error "Proc.loc_results: cannot call" +(* OCaml calling convention: + first integer args in r0...r7 + first float args in d0...d15 (EABI+VFP) + remaining args on stack. + Return values in r0...r7 or d0...d15. *) + let loc_arguments arg = - calling_conventions 0 7 outgoing arg + calling_conventions 0 7 100 115 outgoing arg let loc_parameters arg = - let (loc, ofs) = calling_conventions 0 7 incoming arg in loc + let (loc, _) = calling_conventions 0 7 100 115 incoming arg in loc let loc_results res = - let (loc, ofs) = calling_conventions 0 7 not_supported res in loc + let (loc, _) = calling_conventions 0 7 100 115 not_supported res in loc + +(* C calling convention: + first integer args in r0...r3 + first float args in d0...d7 (EABI+VFP) + remaining args on stack. + Return values in r0...r1 or d0. *) let loc_external_arguments arg = - calling_conventions 0 3 outgoing arg + calling_conventions 0 3 100 107 outgoing arg let loc_external_results res = - let (loc, ofs) = calling_conventions 0 1 not_supported res in loc + let (loc, _) = calling_conventions 0 1 100 100 not_supported res in loc let loc_exn_bucket = phys_reg 0 (* Registers destroyed by operations *) -let destroyed_at_c_call = (* r4-r7 preserved *) - Array.of_list(List.map phys_reg [0;1;2;3;8]) +let destroyed_at_alloc = (* r0-r6, d0-d15 preserved *) + Array.of_list (List.map + phys_reg + [7;8; + 116;116;118;119;120;121;122;123; + 124;125;126;127;128;129;130;131]) + +let destroyed_at_c_call = + Array.of_list (List.map + phys_reg + (match abi with + EABI -> (* r4-r7 preserved *) + [0;1;2;3;8; + 100;101;102;103;104;105;106;107; + 108;109;110;111;112;113;114;115; + 116;116;118;119;120;121;122;123; + 124;125;126;127;128;129;130;131] + | EABI_HF -> (* r4-r7, d8-d15 preserved *) + [0;1;2;3;8; + 100;101;102;103;104;105;106;107; + 116;116;118;119;120;121;122;123; + 124;125;126;127;128;129;130;131])) let destroyed_at_oper = function - Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs - | Iop(Iextcall(_, false)) -> destroyed_at_c_call - | Iop(Ialloc(_)) -> [|phys_reg 8|] (* r12 destroyed *) + Iop(Icall_ind | Icall_imm _) + | Iop(Iextcall(_, true)) -> + all_phys_regs + | Iop(Iextcall(_, false)) -> + destroyed_at_c_call + | Iop(Ialloc _) -> + destroyed_at_alloc + | Iop(Iconst_symbol _) when !pic_code -> + [| phys_reg 3; phys_reg 8 |] (* r3 and r12 destroyed *) + | Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _)) -> + [| phys_reg 107 |] (* d7 (s14-s15) destroyed *) | _ -> [||] let destroyed_at_raise = all_phys_regs @@ -128,15 +210,22 @@ (* Maximal register pressure *) let safe_register_pressure = function - Iextcall(_, _) -> 4 + Iextcall(_, _) -> if abi = EABI then 0 else 4 + | Ialloc _ -> if abi = EABI then 0 else 7 + | Iconst_symbol _ when !pic_code -> 7 | _ -> 9 + let max_register_pressure = function - Iextcall(_, _) -> [| 4 |] - | _ -> [| 9 |] + Iextcall(_, _) -> if abi = EABI then [| 4; 0; 0 |] else [| 4; 8; 8 |] + | Ialloc _ -> if abi = EABI then [| 7; 0; 0 |] else [| 7; 8; 8 |] + | Iconst_symbol _ when !pic_code -> [| 7; 16; 32 |] + | Iintoffloat | Ifloatofint + | Iload(Single, _) | Istore(Single, _) -> [| 9; 15; 31 |] + | _ -> [| 9; 16; 32 |] (* Layout of the stack *) -let num_stack_slots = [| 0 |] +let num_stack_slots = [| 0; 0; 0 |] let contains_calls = ref false (* Calling the assembler *) @@ -145,5 +234,5 @@ Ccomp.command (Config.asm ^ " -o " ^ Filename.quote outfile ^ " " ^ Filename.quote infile) -open Clflags;; -open Config;; + +let init () = () diff -Nru ocaml-3.12.1/asmcomp/arm/reload.ml ocaml-4.01.0/asmcomp/arm/reload.ml --- ocaml-3.12.1/asmcomp/arm/reload.ml 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/arm/reload.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: reload.ml 2553 1999-11-17 18:59:06Z xleroy $ *) - (* Reloading for the ARM *) let fundecl f = diff -Nru ocaml-3.12.1/asmcomp/arm/scheduling.ml ocaml-4.01.0/asmcomp/arm/scheduling.ml --- ocaml-3.12.1/asmcomp/arm/scheduling.ml 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/arm/scheduling.ml 2012-10-24 06:20:45.000000000 +0000 @@ -1,51 +1,77 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* Benedikt Meurer, University of Siegen *) (* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) +(* Copyright 1998 Institut National de Recherche en Informatique *) +(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) +(* reserved. This file is distributed under the terms of the Q *) +(* Public License version 1.0. *) (* *) (***********************************************************************) -(* $Id: scheduling.ml 2553 1999-11-17 18:59:06Z xleroy $ *) - +open Arch open Mach -(* Instruction scheduling for the Sparc *) +(* Instruction scheduling for the ARM *) -class scheduler = object +class scheduler = object(self) -inherit Schedgen.scheduler_generic +inherit Schedgen.scheduler_generic as super -(* Scheduling -- based roughly on the Strong ARM *) +(* Scheduling -- based roughly on the ARM11 (ARMv6) *) method oper_latency = function - Ireload -> 2 - | Iload(_, _) -> 2 - | Iconst_symbol _ -> 2 (* turned into a load *) - | Iconst_float _ -> 2 (* turned into a load *) - | Iintop(Imul) -> 3 - | Iintop_imm(Imul, _) -> 3 - (* No data available for floatops, let's make educated guesses *) - | Iaddf -> 3 - | Isubf -> 3 - | Imulf -> 5 - | Idivf -> 15 + (* Loads have a latency of two cycles in general *) + Iconst_symbol _ + | Iconst_float _ + | Iload(_, _) + | Ireload + | Ifloatofint (* mcr/mrc count as memory access *) + | Iintoffloat -> 2 + (* Multiplys have a latency of two cycles *) + | Iintop Imul + | Ispecific(Imuladd | Imulsub) -> 2 + (* VFP instructions *) + | Iaddf + | Isubf + | Idivf + | Imulf | Ispecific Inegmulf + | Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf) + | Ispecific Isqrtf + | Inegf | Iabsf when !fpu >= VFPv2 -> 2 + (* Everything else *) | _ -> 1 -(* Issue cycles. Rough approximations *) +method! is_checkbound = function + Ispecific(Ishiftcheckbound _) -> true + | op -> super#is_checkbound op + +(* Issue cycles. Rough approximations *) method oper_issue_cycles = function Ialloc _ -> 4 - | Iintop(Icomp _) -> 3 - | Iintop(Icheckbound) -> 2 - | Iintop_imm(Idiv, _) -> 4 - | Iintop_imm(Imod, _) -> 6 + | Iintop(Ilsl | Ilsr | Iasr) -> 2 + | Iintop(Icomp _) | Iintop_imm(Icomp _, _) -> 3 + | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> 2 + | Ispecific(Ishiftcheckbound _) -> 3 + | Iintop_imm(Idiv, _) -> 4 + | Iintop_imm(Imod, _) -> 6 + | Iintop Imul + | Ispecific(Imuladd | Imulsub) -> 2 + (* VFP instructions *) + | Iaddf + | Isubf -> 7 + | Imulf + | Ispecific Inegmulf -> 9 + | Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf) -> 17 + | Idivf + | Ispecific Isqrtf -> 27 + | Inegf | Iabsf | Iconst_float _ when !fpu >= VFPv2 -> 4 + (* Everything else *) | _ -> 1 end diff -Nru ocaml-3.12.1/asmcomp/arm/selection.ml ocaml-4.01.0/asmcomp/arm/selection.ml --- ocaml-3.12.1/asmcomp/arm/selection.ml 2010-04-22 12:39:40.000000000 +0000 +++ ocaml-4.01.0/asmcomp/arm/selection.ml 2013-05-08 13:21:32.000000000 +0000 @@ -1,54 +1,73 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* Benedikt Meurer, University of Siegen *) (* *) -(* Copyright 1998 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) +(* Copyright 1998 Institut National de Recherche en Informatique *) +(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) +(* reserved. This file is distributed under the terms of the Q *) +(* Public License version 1.0. *) (* *) (***********************************************************************) -(* $Id: selection.ml 10295 2010-04-22 12:39:40Z xleroy $ *) - (* Instruction selection for the ARM processor *) -open Misc -open Cmm -open Reg open Arch open Proc +open Cmm open Mach -(* Immediate operands are 8-bit immediate values, zero-extended, and rotated - right by 0, 2, 4, ... 30 bits. - To avoid problems with Caml's 31-bit arithmetic, - we check only with 8-bit values shifted left 0 to 22 bits. *) - -let rec is_immed n shift = - if shift > 22 then false - else if n land (0xFF lsl shift) = n then true - else is_immed n (shift + 2) - -(* We have 12-bit + sign byte offsets for word accesses, - 8-bit + sign word offsets for float accesses, - and 8-bit + sign byte offsets for bytes and shorts. - Use lowest common denominator. *) - -let is_offset n = n < 256 && n > -256 - -let is_intconst = function Cconst_int n -> true | _ -> false - -(* Soft emulation of float comparisons *) - -let float_comparison_function = function - | Ceq -> "__eqdf2" - | Cne -> "__nedf2" - | Clt -> "__ltdf2" - | Cle -> "__ledf2" - | Cgt -> "__gtdf2" - | Cge -> "__gedf2" +let is_offset chunk n = + match chunk with + (* VFPv{2,3} load/store have -1020 to 1020 *) + Single | Double | Double_u + when !fpu >= VFPv2 -> + n >= -1020 && n <= 1020 + (* ARM load/store byte/word have -4095 to 4095 *) + | Byte_unsigned | Byte_signed + | Thirtytwo_unsigned | Thirtytwo_signed + | Word | Single + when not !thumb -> + n >= -4095 && n <= 4095 + (* Thumb-2 load/store have -255 to 4095 *) + | _ when !arch > ARMv6 && !thumb -> + n >= -255 && n <= 4095 + (* Everything else has -255 to 255 *) + | _ -> + n >= -255 && n <= 255 + +let is_intconst = function + Cconst_int _ -> true + | _ -> false + +(* Special constraints on operand and result registers *) + +exception Use_default + +let r1 = phys_reg 1 + +let pseudoregs_for_operation op arg res = + match op with + (* For mul rd,rm,rs and mla rd,rm,rs,ra (pre-ARMv6) the registers rm + and rd must be different. We deal with this by pretending that rm + is also a result of the mul / mla operation. *) + Iintop Imul | Ispecific Imuladd when !arch < ARMv6 -> + (arg, [| res.(0); arg.(0) |]) + (* Soft-float Iabsf and Inegf: arg.(0) and res.(0) must be the same *) + | Iabsf | Inegf when !fpu = Soft -> + ([|res.(0); arg.(1)|], res) + (* VFPv{2,3} Imuladdf...Inegmulsubf: arg.(0) and res.(0) must be the same *) + | Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf) -> + let arg' = Array.copy arg in + arg'.(0) <- res.(0); + (arg', res) + (* We use __aeabi_idivmod for Cmodi only, and hence we care only + for the remainder in r1, so fix up the destination register. *) + | Iextcall("__aeabi_idivmod", false) -> + (arg, [|r1|]) + (* Other instructions are regular *) + | _ -> raise Use_default (* Instruction selection *) class selector = object(self) @@ -56,23 +75,37 @@ inherit Selectgen.selector_generic as super method! regs_for tyv = - (* Expand floats into pairs of integer registers *) - let nty = Array.length tyv in - let rec expand i = - if i >= nty then [] else begin - match tyv.(i) with - | Float -> Int :: Int :: expand (i+1) - | ty -> ty :: expand (i+1) - end in - Reg.createv (Array.of_list (expand 0)) + Reg.createv (if !fpu = Soft then begin + (* Expand floats into pairs of integer registers *) + let rec expand = function + [] -> [] + | Float :: tyl -> Int :: Int :: expand tyl + | ty :: tyl -> ty :: expand tyl in + Array.of_list (expand (Array.to_list tyv)) + end else begin + tyv + end) method is_immediate n = - n land 0xFF = n || is_immed n 2 + is_immediate (Int32.of_int n) -method select_addressing = function - Cop(Cadda, [arg; Cconst_int n]) when is_offset n -> +method! is_simple_expr = function + (* inlined floating-point ops are simple if their arguments are *) + | Cop(Cextcall("sqrt", _, _, _), args) when !fpu >= VFPv2 -> + List.for_all self#is_simple_expr args + (* inlined byte-swap ops are simple if their arguments are *) + | Cop(Cextcall("caml_bswap16_direct", _, _, _), args) when !arch >= ARMv6T2 -> + List.for_all self#is_simple_expr args + | Cop(Cextcall("caml_int32_direct_bswap", _,_,_), args) when !arch >= ARMv6 -> + List.for_all self#is_simple_expr args + | e -> super#is_simple_expr e + +method select_addressing chunk = function + | Cop(Cadda, [arg; Cconst_int n]) + when is_offset chunk n -> (Iindexed n, arg) - | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) when is_offset n -> + | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) + when is_offset chunk n -> (Iindexed n, Cop(Cadda, [arg1; arg2])) | arg -> (Iindexed 0, arg) @@ -91,109 +124,152 @@ | [Cop(Casr, [arg1; Cconst_int n]); arg2] when n > 0 && n < 32 && not(is_intconst arg1) -> (Ispecific(Ishiftarith(shiftrevop, -n)), [arg2; arg1]) - | _ -> - super#select_operation op args + | args -> + begin match super#select_operation op args with + (* Recognize multiply and add *) + (Iintop Iadd, [Cop(Cmuli, args); arg3]) + | (Iintop Iadd, [arg3; Cop(Cmuli, args)]) as op_args -> + begin match self#select_operation Cmuli args with + (Iintop Imul, [arg1; arg2]) -> + (Ispecific Imuladd, [arg1; arg2; arg3]) + | _ -> op_args + end + (* Recognize multiply and subtract *) + | (Iintop Isub, [arg3; Cop(Cmuli, args)]) as op_args + when !arch > ARMv6 -> + begin match self#select_operation Cmuli args with + (Iintop Imul, [arg1; arg2]) -> + (Ispecific Imulsub, [arg1; arg2; arg3]) + | _ -> op_args + end + | op_args -> op_args + end method! select_operation op args = - match op with - Cadda | Caddi -> - begin match args with - [arg1; Cconst_int n] when n < 0 && self#is_immediate (-n) -> - (Iintop_imm(Isub, -n), [arg1]) - | _ -> - self#select_shift_arith op Ishiftadd Ishiftadd args - end - | Csuba | Csubi -> - begin match args with - [arg1; Cconst_int n] when n < 0 && self#is_immediate (-n) -> - (Iintop_imm(Iadd, -n), [arg1]) - | [Cconst_int n; arg2] when self#is_immediate n -> - (Ispecific(Irevsubimm n), [arg2]) - | _ -> - self#select_shift_arith op Ishiftsub Ishiftsubrev args - end - | Cmuli -> (* no multiply immediate *) + match (op, args) with + (* Recognize special shift arithmetic *) + ((Cadda | Caddi), [arg; Cconst_int n]) + when n < 0 && self#is_immediate (-n) -> + (Iintop_imm(Isub, -n), [arg]) + | ((Cadda | Caddi as op), args) -> + self#select_shift_arith op Ishiftadd Ishiftadd args + | ((Csuba | Csubi), [arg; Cconst_int n]) + when n < 0 && self#is_immediate (-n) -> + (Iintop_imm(Iadd, -n), [arg]) + | ((Csuba | Csubi), [Cconst_int n; arg]) + when self#is_immediate n -> + (Ispecific(Irevsubimm n), [arg]) + | ((Csuba | Csubi as op), args) -> + self#select_shift_arith op Ishiftsub Ishiftsubrev args + | (Ccheckbound _, [Cop(Clsr, [arg1; Cconst_int n]); arg2]) + when n > 0 && n < 32 && not(is_intconst arg2) -> + (Ispecific(Ishiftcheckbound n), [arg1; arg2]) + (* ARM does not support immediate operands for multiplication *) + | (Cmuli, args) -> (Iintop Imul, args) - | Cdivi -> - begin match args with - [arg1; Cconst_int n] when n = 1 lsl (Misc.log2 n) -> - (Iintop_imm(Idiv, n), [arg1]) - | _ -> - (Iextcall("__divsi3", false), args) - end - | Cmodi -> - begin match args with - [arg1; Cconst_int n] when n = 1 lsl (Misc.log2 n) -> - (Iintop_imm(Imod, n), [arg1]) - | _ -> - (Iextcall("__modsi3", false), args) - end - | Ccheckbound _ -> - begin match args with - [Cop(Clsr, [arg1; Cconst_int n]); arg2] - when n > 0 && n < 32 && not(is_intconst arg2) -> - (Ispecific(Ishiftcheckbound n), [arg1; arg2]) - | _ -> - super#select_operation op args - end - (* Turn floating-point operations into library function calls *) - | Caddf -> (Iextcall("__adddf3", false), args) - | Csubf -> (Iextcall("__subdf3", false), args) - | Cmulf -> (Iextcall("__muldf3", false), args) - | Cdivf -> (Iextcall("__divdf3", false), args) - | Cfloatofint -> (Iextcall("__floatsidf", false), args) - | Cintoffloat -> (Iextcall("__fixdfsi", false), args) - | Ccmpf comp -> - (Iintop_imm(Icomp(Isigned comp), 0), - [Cop(Cextcall(float_comparison_function comp, - typ_int, false, Debuginfo.none), - args)]) + (* Turn integer division/modulus into runtime ABI calls *) + | (Cdivi, [arg; Cconst_int n]) + when n = 1 lsl Misc.log2 n -> + (Iintop_imm(Idiv, n), [arg]) + | (Cdivi, args) -> + (Iextcall("__aeabi_idiv", false), args) + | (Cmodi, [arg; Cconst_int n]) + when n > 1 && n = 1 lsl Misc.log2 n -> + (Iintop_imm(Imod, n), [arg]) + | (Cmodi, args) -> + (* See above for fix up of return register *) + (Iextcall("__aeabi_idivmod", false), args) + (* Recognize 16-bit bswap instruction (ARMv6T2 because we need movt) *) + | (Cextcall("caml_bswap16_direct", _, _, _), args) when !arch >= ARMv6T2 -> + (Ispecific(Ibswap 16), args) + (* Recognize 32-bit bswap instructions (ARMv6 and above) *) + | (Cextcall("caml_int32_direct_bswap", _, _, _), args) when !arch >= ARMv6 -> + (Ispecific(Ibswap 32), args) + (* Turn floating-point operations into runtime ABI calls for softfp *) + | (op, args) when !fpu = Soft -> self#select_operation_softfp op args + (* Select operations for VFPv{2,3} *) + | (op, args) -> self#select_operation_vfpv3 op args + +method private select_operation_softfp op args = + match (op, args) with + (* Turn floating-point operations into runtime ABI calls *) + | (Caddf, args) -> (Iextcall("__aeabi_dadd", false), args) + | (Csubf, args) -> (Iextcall("__aeabi_dsub", false), args) + | (Cmulf, args) -> (Iextcall("__aeabi_dmul", false), args) + | (Cdivf, args) -> (Iextcall("__aeabi_ddiv", false), args) + | (Cfloatofint, args) -> (Iextcall("__aeabi_i2d", false), args) + | (Cintoffloat, args) -> (Iextcall("__aeabi_d2iz", false), args) + | (Ccmpf comp, args) -> + let func = (match comp with + Cne (* there's no __aeabi_dcmpne *) + | Ceq -> "__aeabi_dcmpeq" + | Clt -> "__aeabi_dcmplt" + | Cle -> "__aeabi_dcmple" + | Cgt -> "__aeabi_dcmpgt" + | Cge -> "__aeabi_dcmpge") in + let comp = (match comp with + Cne -> Ceq (* eq 0 => false *) + | _ -> Cne (* ne 0 => true *)) in + (Iintop_imm(Icomp(Iunsigned comp), 0), + [Cop(Cextcall(func, typ_int, false, Debuginfo.none), args)]) (* Add coercions around loads and stores of 32-bit floats *) - | Cload Single -> - (Iextcall("__extendsfdf2", false), [Cop(Cload Word, args)]) - | Cstore Single -> - begin match args with - | [arg1; arg2] -> - let arg2' = - Cop(Cextcall("__truncdfsf2", typ_int, false, Debuginfo.none), - [arg2]) in - self#select_operation (Cstore Word) [arg1; arg2'] - | _ -> assert false - end + | (Cload Single, args) -> + (Iextcall("__aeabi_f2d", false), [Cop(Cload Word, args)]) + | (Cstore Single, [arg1; arg2]) -> + let arg2' = + Cop(Cextcall("__aeabi_d2f", typ_int, false, Debuginfo.none), + [arg2]) in + self#select_operation (Cstore Word) [arg1; arg2'] (* Other operations are regular *) - | _ -> super#select_operation op args + | (op, args) -> super#select_operation op args + +method private select_operation_vfpv3 op args = + match (op, args) with + (* Recognize floating-point negate and multiply *) + (Cnegf, [Cop(Cmulf, args)]) -> + (Ispecific Inegmulf, args) + (* Recognize floating-point multiply and add *) + | (Caddf, [arg; Cop(Cmulf, args)]) + | (Caddf, [Cop(Cmulf, args); arg]) -> + (Ispecific Imuladdf, arg :: args) + (* Recognize floating-point negate, multiply and subtract *) + | (Csubf, [Cop(Cnegf, [arg]); Cop(Cmulf, args)]) + | (Csubf, [Cop(Cnegf, [Cop(Cmulf, args)]); arg]) -> + (Ispecific Inegmulsubf, arg :: args) + (* Recognize floating-point negate, multiply and add *) + | (Csubf, [arg; Cop(Cmulf, args)]) -> + (Ispecific Inegmuladdf, arg :: args) + (* Recognize multiply and subtract *) + | (Csubf, [Cop(Cmulf, args); arg]) -> + (Ispecific Imulsubf, arg :: args) + (* Recognize floating-point square root *) + | (Cextcall("sqrt", _, false, _), args) -> + (Ispecific Isqrtf, args) + (* Other operations are regular *) + | (op, args) -> super#select_operation op args method! select_condition = function - | Cop(Ccmpf cmp, args) -> - (Iinttest_imm(Isigned cmp, 0), - Cop(Cextcall(float_comparison_function cmp, - typ_int, false, Debuginfo.none), - args)) + (* Turn floating-point comparisons into runtime ABI calls *) + Cop(Ccmpf _ as op, args) when !fpu = Soft -> + begin match self#select_operation_softfp op args with + (Iintop_imm(Icomp(Iunsigned Ceq), 0), [arg]) -> (Ifalsetest, arg) + | (Iintop_imm(Icomp(Iunsigned Cne), 0), [arg]) -> (Itruetest, arg) + | _ -> assert false + end | expr -> super#select_condition expr -(* Deal with some register irregularities: - -1- In mul rd, rm, rs, the registers rm and rd must be different. - We deal with this by pretending that rm is also a result of the mul - operation. - -2- For Inegf and Iabsf, force arguments and results in (r0, r1); - this simplifies code generation later. -*) +(* Deal with some register constraints *) method! insert_op_debug op dbg rs rd = - match op with - | Iintop(Imul) -> - self#insert_debug (Iop op) dbg rs [| rd.(0); rs.(0) |]; rd - | Iabsf | Inegf -> - let r = [| phys_reg 0; phys_reg 1 |] in - self#insert_moves rs r; - self#insert_debug (Iop op) dbg r r; - self#insert_moves r rd; - rd - | _ -> - super#insert_op_debug op dbg rs rd + try + let (rsrc, rdst) = pseudoregs_for_operation op rs rd in + self#insert_moves rs rsrc; + self#insert_debug (Iop op) dbg rsrc rdst; + self#insert_moves rdst rd; + rd + with Use_default -> + super#insert_op_debug op dbg rs rd end diff -Nru ocaml-3.12.1/asmcomp/asmgen.ml ocaml-4.01.0/asmcomp/asmgen.ml --- ocaml-3.12.1/asmcomp/asmgen.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/asmgen.ml 2013-06-03 18:03:59.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: asmgen.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* From lambda to assembly code *) open Format @@ -37,6 +35,9 @@ if !flag then fprintf ppf "*** %s@.%a@." message Printlinear.fundecl phrase; phrase +let clambda_dump_if ppf ulambda = + if !dump_clambda then Printclambda.clambda ppf ulambda; ulambda + let rec regalloc ppf round fd = if round > 50 then fatal_error(fd.Mach.fun_name ^ @@ -56,6 +57,7 @@ let (++) x f = f x let compile_fundecl (ppf : formatter) fd_cmm = + Proc.init (); Reg.reset(); fd_cmm ++ Selection.fundecl @@ -104,6 +106,7 @@ Emitaux.output_channel := oc; Emit.begin_assembly(); Closure.intro size lam + ++ clambda_dump_if ppf ++ Cmmgen.compunit size ++ List.iter (compile_phrase ppf) ++ (fun () -> ()); (match toplevel with None -> () | Some f -> compile_genfuns ppf f); @@ -135,4 +138,5 @@ let report_error ppf = function | Assembler_error file -> - fprintf ppf "Assembler error, input left in file %s" file + fprintf ppf "Assembler error, input left in file %a" + Location.print_filename file diff -Nru ocaml-3.12.1/asmcomp/asmgen.mli ocaml-4.01.0/asmcomp/asmgen.mli --- ocaml-3.12.1/asmcomp/asmgen.mli 2007-11-06 15:16:56.000000000 +0000 +++ ocaml-4.01.0/asmcomp/asmgen.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: asmgen.mli 8477 2007-11-06 15:16:56Z frisch $ *) - (* From lambda to assembly code *) val compile_implementation : diff -Nru ocaml-3.12.1/asmcomp/asmlibrarian.ml ocaml-4.01.0/asmcomp/asmlibrarian.ml --- ocaml-3.12.1/asmcomp/asmlibrarian.ml 2010-05-19 11:29:38.000000000 +0000 +++ ocaml-4.01.0/asmcomp/asmlibrarian.ml 2013-06-05 16:34:40.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: asmlibrarian.ml 10424 2010-05-19 11:29:38Z xleroy $ *) - (* Build libraries of .cmx files *) open Misc @@ -53,7 +51,7 @@ let infos = { lib_units = descr_list; lib_ccobjs = !Clflags.ccobjs; - lib_ccopts = !Clflags.ccopts } in + lib_ccopts = !Clflags.all_ccopts } in output_value outchan infos; if Ccomp.create_archive archive_name objfile_list <> 0 then raise(Error(Archiver_error archive_name)); diff -Nru ocaml-3.12.1/asmcomp/asmlibrarian.mli ocaml-4.01.0/asmcomp/asmlibrarian.mli --- ocaml-3.12.1/asmcomp/asmlibrarian.mli 2000-04-21 08:13:22.000000000 +0000 +++ ocaml-4.01.0/asmcomp/asmlibrarian.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: asmlibrarian.mli 3123 2000-04-21 08:13:22Z weis $ *) - (* Build libraries of .cmx files *) open Format diff -Nru ocaml-3.12.1/asmcomp/asmlink.ml ocaml-4.01.0/asmcomp/asmlink.ml --- ocaml-3.12.1/asmcomp/asmlink.ml 2011-05-17 14:14:38.000000000 +0000 +++ ocaml-4.01.0/asmcomp/asmlink.ml 2013-07-23 14:48:47.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,11 +10,8 @@ (* *) (***********************************************************************) -(* $Id: asmlink.ml 11049 2011-05-17 14:14:38Z doligez $ *) - (* Link a set of .cmx/.o files and produce an executable *) -open Sys open Misc open Config open Cmx_format @@ -101,7 +98,7 @@ let libname = if !Clflags.gprofile then "libasmrunp" ^ ext_lib - else "libasmrun" ^ ext_lib in + else "libasmrun" ^ !Clflags.runtime_variant ^ ext_lib in try if !Clflags.nopervasives then [] else [ find_in_path !load_path libname ] @@ -260,7 +257,7 @@ (fun (info, file_name, crc) -> check_consistency file_name info crc) units_tolink; Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs; - Clflags.ccopts := !lib_ccopts @ !Clflags.ccopts; + Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts; let objfiles = List.rev (List.map object_file_name objfiles) @ (List.rev !Clflags.ccobjs) in @@ -318,7 +315,8 @@ (fun (info, file_name, crc) -> check_consistency file_name info crc) units_tolink; Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs; - Clflags.ccopts := !lib_ccopts @ !Clflags.ccopts; (* put user's opts first *) + Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts; + (* put user's opts first *) let startup = if !Clflags.keep_startup_file then output_name ^ ".startup" ^ ext_asm else Filename.temp_file "camlstartup" ext_asm in @@ -342,7 +340,8 @@ | File_not_found name -> fprintf ppf "Cannot find file %s" name | Not_an_object_file name -> - fprintf ppf "The file %s is not a compilation unit description" name + fprintf ppf "The file %a is not a compilation unit description" + Location.print_filename name | Missing_implementations l -> let print_references ppf = function | [] -> () @@ -359,27 +358,35 @@ print_modules l | Inconsistent_interface(intf, file1, file2) -> fprintf ppf - "@[Files %s@ and %s@ make inconsistent assumptions \ + "@[Files %a@ and %a@ make inconsistent assumptions \ over interface %s@]" - file1 file2 intf + Location.print_filename file1 + Location.print_filename file2 + intf | Inconsistent_implementation(intf, file1, file2) -> fprintf ppf - "@[Files %s@ and %s@ make inconsistent assumptions \ + "@[Files %a@ and %a@ make inconsistent assumptions \ over implementation %s@]" - file1 file2 intf + Location.print_filename file1 + Location.print_filename file2 + intf | Assembler_error file -> - fprintf ppf "Error while assembling %s" file + fprintf ppf "Error while assembling %a" Location.print_filename file | Linking_error -> fprintf ppf "Error during linking" | Multiple_definition(modname, file1, file2) -> fprintf ppf - "@[Files %s@ and %s@ both define a module named %s@]" - file1 file2 modname + "@[Files %a@ and %a@ both define a module named %s@]" + Location.print_filename file1 + Location.print_filename file2 + modname | Missing_cmx(filename, name) -> fprintf ppf - "@[File %s@ was compiled without access@ \ + "@[File %a@ was compiled without access@ \ to the .cmx file@ for module %s,@ \ which was produced by `ocamlopt -for-pack'.@ \ - Please recompile %s@ with the correct `-I' option@ \ + Please recompile %a@ with the correct `-I' option@ \ so that %s.cmx@ is found.@]" - filename name filename name + Location.print_filename filename name + Location.print_filename filename + name diff -Nru ocaml-3.12.1/asmcomp/asmlink.mli ocaml-4.01.0/asmcomp/asmlink.mli --- ocaml-3.12.1/asmcomp/asmlink.mli 2010-05-19 11:29:38.000000000 +0000 +++ ocaml-4.01.0/asmcomp/asmlink.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: asmlink.mli 10424 2010-05-19 11:29:38Z xleroy $ *) - (* Link a set of .cmx/.o files and produce an executable or a plugin *) open Format diff -Nru ocaml-3.12.1/asmcomp/asmpackager.ml ocaml-4.01.0/asmcomp/asmpackager.ml --- ocaml-3.12.1/asmcomp/asmpackager.ml 2010-05-19 11:29:38.000000000 +0000 +++ ocaml-4.01.0/asmcomp/asmpackager.ml 2013-07-23 14:48:47.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,19 +10,14 @@ (* *) (***********************************************************************) -(* $Id: asmpackager.ml 10424 2010-05-19 11:29:38Z xleroy $ *) - (* "Package" a set of .cmx/.o files into one .cmx/.o file having the original compilation units as sub-modules. *) -open Printf open Misc -open Lambda -open Clambda open Cmx_format type error = - Illegal_renaming of string * string + Illegal_renaming of string * string * string | Forward_reference of string * string | Wrong_for_pack of string * string | Linking_error @@ -41,14 +36,14 @@ pm_name: string; pm_kind: pack_member_kind } -let read_member_info pack_path file = +let read_member_info pack_path file = ( let name = String.capitalize(Filename.basename(chop_extensions file)) in let kind = if Filename.check_suffix file ".cmx" then begin let (info, crc) = Compilenv.read_unit_info file in if info.ui_name <> name - then raise(Error(Illegal_renaming(file, info.ui_name))); + then raise(Error(Illegal_renaming(name, file, info.ui_name))); if info.ui_symbol <> (Compilenv.current_unit_infos()).ui_symbol ^ "__" ^ info.ui_name then raise(Error(Wrong_for_pack(file, pack_path))); @@ -58,6 +53,7 @@ end else PM_intf in { pm_file = file; pm_name = name; pm_kind = kind } +) (* Check absence of forward references *) @@ -192,14 +188,16 @@ open Format let report_error ppf = function - Illegal_renaming(file, id) -> - fprintf ppf "Wrong file naming: %s@ contains the code for@ %s" - file id + Illegal_renaming(name, file, id) -> + fprintf ppf "Wrong file naming: %a@ contains the code for\ + @ %s when %s was expected" + Location.print_filename file name id | Forward_reference(file, ident) -> - fprintf ppf "Forward reference to %s in file %s" ident file + fprintf ppf "Forward reference to %s in file %a" ident + Location.print_filename file | Wrong_for_pack(file, path) -> - fprintf ppf "File %s@ was not compiled with the `-for-pack %s' option" - file path + fprintf ppf "File %a@ was not compiled with the `-for-pack %s' option" + Location.print_filename file path | File_not_found file -> fprintf ppf "File %s not found" file | Assembler_error file -> diff -Nru ocaml-3.12.1/asmcomp/asmpackager.mli ocaml-4.01.0/asmcomp/asmpackager.mli --- ocaml-3.12.1/asmcomp/asmpackager.mli 2005-08-01 15:51:09.000000000 +0000 +++ ocaml-4.01.0/asmcomp/asmpackager.mli 2013-04-29 14:57:38.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,15 +10,13 @@ (* *) (***********************************************************************) -(* $Id: asmpackager.mli 7003 2005-08-01 15:51:09Z xleroy $ *) - (* "Package" a set of .cmx/.o files into one .cmx/.o file having the original compilation units as sub-modules. *) val package_files: Format.formatter -> string list -> string -> unit type error = - Illegal_renaming of string * string + Illegal_renaming of string * string * string | Forward_reference of string * string | Wrong_for_pack of string * string | Linking_error diff -Nru ocaml-3.12.1/asmcomp/clambda.ml ocaml-4.01.0/asmcomp/clambda.ml --- ocaml-3.12.1/asmcomp/clambda.ml 2007-01-29 12:11:18.000000000 +0000 +++ ocaml-4.01.0/asmcomp/clambda.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: clambda.ml 7812 2007-01-29 12:11:18Z xleroy $ *) - (* A variant of the "lambda" code with direct / indirect calls explicit and closures explicit too *) @@ -22,11 +20,10 @@ type ulambda = Uvar of Ident.t - | Uconst of structured_constant + | Uconst of structured_constant * string option | Udirect_apply of function_label * ulambda list * Debuginfo.t | Ugeneric_apply of ulambda * ulambda list * Debuginfo.t - | Uclosure of (function_label * int * Ident.t list * ulambda) list - * ulambda list + | Uclosure of ufunction list * ulambda list | Uoffset of ulambda * int | Ulet of Ident.t * ulambda * ulambda | Uletrec of (Ident.t * ulambda) list * ulambda @@ -42,6 +39,14 @@ | Uassign of Ident.t * ulambda | Usend of meth_kind * ulambda * ulambda * ulambda list * Debuginfo.t +and ufunction = { + label : function_label; + arity : int; + params : Ident.t list; + body : ulambda; + dbg : Debuginfo.t +} + and ulambda_switch = { us_index_consts: int array; us_actions_consts : ulambda array; diff -Nru ocaml-3.12.1/asmcomp/clambda.mli ocaml-4.01.0/asmcomp/clambda.mli --- ocaml-3.12.1/asmcomp/clambda.mli 2007-01-29 12:11:18.000000000 +0000 +++ ocaml-4.01.0/asmcomp/clambda.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: clambda.mli 7812 2007-01-29 12:11:18Z xleroy $ *) - (* A variant of the "lambda" code with direct / indirect calls explicit and closures explicit too *) @@ -22,11 +20,10 @@ type ulambda = Uvar of Ident.t - | Uconst of structured_constant + | Uconst of structured_constant * string option | Udirect_apply of function_label * ulambda list * Debuginfo.t | Ugeneric_apply of ulambda * ulambda list * Debuginfo.t - | Uclosure of (function_label * int * Ident.t list * ulambda) list - * ulambda list + | Uclosure of ufunction list * ulambda list | Uoffset of ulambda * int | Ulet of Ident.t * ulambda * ulambda | Uletrec of (Ident.t * ulambda) list * ulambda @@ -42,6 +39,14 @@ | Uassign of Ident.t * ulambda | Usend of meth_kind * ulambda * ulambda * ulambda list * Debuginfo.t +and ufunction = { + label : function_label; + arity : int; + params : Ident.t list; + body : ulambda; + dbg : Debuginfo.t; +} + and ulambda_switch = { us_index_consts: int array; us_actions_consts: ulambda array; diff -Nru ocaml-3.12.1/asmcomp/closure.ml ocaml-4.01.0/asmcomp/closure.ml --- ocaml-3.12.1/asmcomp/closure.ml 2010-09-02 13:29:21.000000000 +0000 +++ ocaml-4.01.0/asmcomp/closure.ml 2013-06-07 11:32:13.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: closure.ml 10667 2010-09-02 13:29:21Z xclerc $ *) - (* Introduction of closures, uncurrying, recognition of direct calls *) open Misc @@ -50,7 +48,7 @@ let occurs_var var u = let rec occurs = function Uvar v -> v = var - | Uconst cst -> false + | Uconst (cst,_) -> false | Udirect_apply(lbl, args, _) -> List.exists occurs args | Ugeneric_apply(funct, args, _) -> occurs funct || List.exists occurs args | Uclosure(fundecls, clos) -> List.exists occurs clos @@ -120,9 +118,12 @@ if !size > threshold then raise Exit; match lam with Uvar v -> () - | Uconst(Const_base(Const_int _ | Const_char _ | Const_float _ | + | Uconst( + (Const_base(Const_int _ | Const_char _ | Const_float _ | Const_int32 _ | Const_int64 _ | Const_nativeint _) | - Const_pointer _) -> incr size + Const_pointer _), _) -> incr size +(* Structured Constants are now emitted during closure conversion. *) + | Uconst (_, Some _) -> incr size | Uconst _ -> raise Exit (* avoid duplication of structured constants *) | Udirect_apply(fn, args, _) -> @@ -177,7 +178,7 @@ let rec is_pure_clambda = function Uvar v -> true - | Uconst cst -> true + | Uconst _ -> true | Uprim((Psetglobal _ | Psetfield _ | Psetfloatfield _ | Pduprecord _ | Pccall _ | Praise | Poffsetref _ | Pstringsetu | Pstringsets | Parraysetu _ | Parraysets _ | Pbigarrayset _), _, _) -> false @@ -186,9 +187,18 @@ (* Simplify primitive operations on integers *) -let make_const_int n = (Uconst(Const_base(Const_int n)), Value_integer n) -let make_const_ptr n = (Uconst(Const_pointer n), Value_constptr n) +let make_const_int n = (Uconst(Const_base(Const_int n), None), Value_integer n) +let make_const_ptr n = (Uconst(Const_pointer n, None), Value_constptr n) let make_const_bool b = make_const_ptr(if b then 1 else 0) +let make_comparison cmp (x: int) (y: int) = + make_const_bool + (match cmp with + Ceq -> x = y + | Cneq -> x <> y + | Clt -> x < y + | Cgt -> x > y + | Cle -> x <= y + | Cge -> x >= y) let simplif_prim_pure p (args, approxs) dbg = match approxs with @@ -196,6 +206,9 @@ begin match p with Pidentity -> make_const_int x | Pnegint -> make_const_int (-x) + | Pbswap16 -> + make_const_int (((x land 0xff) lsl 8) lor + ((x land 0xff00) lsr 8)) | Poffsetint y -> make_const_int (x + y) | _ -> (Uprim(p, args, dbg), Value_unknown) end @@ -212,15 +225,7 @@ | Plslint -> make_const_int(x lsl y) | Plsrint -> make_const_int(x lsr y) | Pasrint -> make_const_int(x asr y) - | Pintcomp cmp -> - let result = match cmp with - Ceq -> x = y - | Cneq -> x <> y - | Clt -> x < y - | Cgt -> x > y - | Cle -> x <= y - | Cge -> x >= y in - make_const_bool result + | Pintcomp cmp -> make_comparison cmp x y | _ -> (Uprim(p, args, dbg), Value_unknown) end | [Value_constptr x] -> @@ -228,12 +233,32 @@ Pidentity -> make_const_ptr x | Pnot -> make_const_bool(x = 0) | Pisint -> make_const_bool true + | Pctconst c -> + begin + match c with + | Big_endian -> make_const_bool Arch.big_endian + | Word_size -> make_const_int (8*Arch.size_int) + | Ostype_unix -> make_const_bool (Sys.os_type = "Unix") + | Ostype_win32 -> make_const_bool (Sys.os_type = "Win32") + | Ostype_cygwin -> make_const_bool (Sys.os_type = "Cygwin") + end | _ -> (Uprim(p, args, dbg), Value_unknown) end | [Value_constptr x; Value_constptr y] -> begin match p with Psequand -> make_const_bool(x <> 0 && y <> 0) | Psequor -> make_const_bool(x <> 0 || y <> 0) + | Pintcomp cmp -> make_comparison cmp x y + | _ -> (Uprim(p, args, dbg), Value_unknown) + end + | [Value_constptr x; Value_integer y] -> + begin match p with + | Pintcomp cmp -> make_comparison cmp x y + | _ -> (Uprim(p, args, dbg), Value_unknown) + end + | [Value_integer x; Value_constptr y] -> + begin match p with + | Pintcomp cmp -> make_comparison cmp x y | _ -> (Uprim(p, args, dbg), Value_unknown) end | _ -> @@ -254,16 +279,16 @@ over functions. *) let approx_ulam = function - Uconst(Const_base(Const_int n)) -> Value_integer n - | Uconst(Const_base(Const_char c)) -> Value_integer(Char.code c) - | Uconst(Const_pointer n) -> Value_constptr n + Uconst(Const_base(Const_int n),_) -> Value_integer n + | Uconst(Const_base(Const_char c),_) -> Value_integer(Char.code c) + | Uconst(Const_pointer n,_) -> Value_constptr n | _ -> Value_unknown let rec substitute sb ulam = match ulam with Uvar v -> begin try Tbl.find v sb with Not_found -> ulam end - | Uconst cst -> ulam + | Uconst _ -> ulam | Udirect_apply(lbl, args, dbg) -> Udirect_apply(lbl, List.map (substitute sb) args, dbg) | Ugeneric_apply(fn, args, dbg) -> @@ -313,7 +338,7 @@ Utrywith(substitute sb u1, id', substitute (Tbl.add id (Uvar id') sb) u2) | Uifthenelse(u1, u2, u3) -> begin match substitute sb u1 with - Uconst(Const_pointer n) -> + Uconst(Const_pointer n, _) -> if n <> 0 then substitute sb u2 else substitute sb u3 | su1 -> Uifthenelse(su1, substitute sb u2, substitute sb u3) @@ -332,21 +357,22 @@ id in Uassign(id', substitute sb u) | Usend(k, u1, u2, ul, dbg) -> - Usend(k, substitute sb u1, substitute sb u2, List.map (substitute sb) ul, dbg) + Usend(k, substitute sb u1, substitute sb u2, List.map (substitute sb) ul, + dbg) (* Perform an inline expansion *) let is_simple_argument = function Uvar _ -> true | Uconst(Const_base(Const_int _ | Const_char _ | Const_float _ | - Const_int32 _ | Const_int64 _ | Const_nativeint _)) -> + Const_int32 _ | Const_int64 _ | Const_nativeint _),_) -> true - | Uconst(Const_pointer _) -> true + | Uconst(Const_pointer _, _) -> true | _ -> false let no_effects = function Uclosure _ -> true - | Uconst(Const_base(Const_string _)) -> true + | Uconst(Const_base(Const_string _),_) -> true | u -> is_simple_argument u let rec bind_params_rec subst params args body = @@ -485,13 +511,18 @@ close_approx_var fenv cenv id | Lconst cst -> begin match cst with - Const_base(Const_int n) -> (Uconst cst, Value_integer n) - | Const_base(Const_char c) -> (Uconst cst, Value_integer(Char.code c)) - | Const_pointer n -> (Uconst cst, Value_constptr n) - | _ -> (Uconst cst, Value_unknown) + Const_base(Const_int n) -> (Uconst (cst,None), Value_integer n) + | Const_base(Const_char c) -> (Uconst (cst,None), + Value_integer(Char.code c)) + | Const_pointer n -> (Uconst (cst, None), Value_constptr n) + | _ -> (Uconst (cst, Some (Compilenv.new_structured_constant cst true)), + Value_unknown) end | Lfunction(kind, params, body) as funct -> close_one_function fenv cenv (Ident.create "fun") funct + + (* We convert [f a] to [let a' = a in fun b c -> f a' b c] + when fun_arity > nargs *) | Lapply(funct, args, loc) -> let nargs = List.length args in begin match (close fenv cenv funct, close_list fenv cenv args) with @@ -504,6 +535,32 @@ when nargs = fundesc.fun_arity -> let app = direct_apply fundesc funct ufunct uargs in (app, strengthen_approx app approx_res) + + | ((ufunct, Value_closure(fundesc, approx_res)), uargs) + when nargs < fundesc.fun_arity -> + let first_args = List.map (fun arg -> + (Ident.create "arg", arg) ) uargs in + let final_args = + Array.to_list (Array.init (fundesc.fun_arity - nargs) + (fun _ -> Ident.create "arg")) in + let rec iter args body = + match args with + [] -> body + | (arg1, arg2) :: args -> + iter args + (Ulet ( arg1, arg2, body)) + in + let internal_args = + (List.map (fun (arg1, arg2) -> Lvar arg1) first_args) + @ (List.map (fun arg -> Lvar arg ) final_args) + in + let (new_fun, approx) = close fenv cenv + (Lfunction( + Curried, final_args, Lapply(funct, internal_args, loc))) + in + let new_fun = iter first_args new_fun in + (new_fun, approx) + | ((ufunct, Value_closure(fundesc, approx_res)), uargs) when fundesc.fun_arity > 0 && nargs > fundesc.fun_arity -> let (first_args, rem_args) = split_list fundesc.fun_arity uargs in @@ -563,6 +620,9 @@ let (ubody, approx) = close fenv_body cenv body in (Uletrec(udefs, ubody), approx) end + | Lprim(Pdirapply loc,[funct;arg]) + | Lprim(Prevapply loc,[arg;funct]) -> + close fenv cenv (Lapply(funct, [arg], loc)) | Lprim(Pgetglobal id, []) as lam -> check_constant_result lam (getglobal id) @@ -580,7 +640,8 @@ match approx with Value_tuple a when n < Array.length a -> a.(n) | _ -> Value_unknown in - check_constant_result lam (Uprim(Pfield n, [ulam], Debuginfo.none)) fieldapprox + check_constant_result lam (Uprim(Pfield n, [ulam], Debuginfo.none)) + fieldapprox | Lprim(Psetfield(n, _), [Lprim(Pgetglobal id, []); lam]) -> let (ulam, approx) = close fenv cenv lam in (!global_approx).(n) <- approx; @@ -714,6 +775,9 @@ let useless_env = ref initially_closed in (* Translate each function definition *) let clos_fundef (id, params, body, fundesc) env_pos = + let dbg = match body with + | Levent (_,({lev_kind=Lev_function} as ev)) -> Debuginfo.from_call ev + | _ -> Debuginfo.none in let env_param = Ident.create "env" in let cenv_fv = build_closure_env env_param (fv_pos - env_pos) fv in @@ -725,7 +789,11 @@ let (ubody, approx) = close fenv_rec cenv_body body in if !useless_env && occurs_var env_param ubody then useless_env := false; let fun_params = if !useless_env then params else params @ [env_param] in - ((fundesc.fun_label, fundesc.fun_arity, fun_params, ubody), + ({ label = fundesc.fun_label; + arity = fundesc.fun_arity; + params = fun_params; + body = ubody; + dbg }, (id, env_pos, Value_closure(fundesc, approx))) in (* Translate all function definitions. *) let clos_info_list = @@ -755,11 +823,12 @@ and close_one_function fenv cenv id funct = match close_functions fenv cenv [id, funct] with - ((Uclosure([_, _, params, body], _) as clos), + ((Uclosure([f], _) as clos), [_, _, (Value_closure(fundesc, _) as approx)]) -> (* See if the function can be inlined *) - if lambda_smaller body (!Clflags.inline_threshold + List.length params) - then fundesc.fun_inline <- Some(params, body); + if lambda_smaller f.body + (!Clflags.inline_threshold + List.length f.params) + then fundesc.fun_inline <- Some(f.params, f.body); (clos, approx) | _ -> fatal_error "Closure.close_one_function" diff -Nru ocaml-3.12.1/asmcomp/closure.mli ocaml-4.01.0/asmcomp/closure.mli --- ocaml-3.12.1/asmcomp/closure.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/closure.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: closure.mli 9547 2010-01-22 12:48:24Z doligez $ *) - (* Introduction of closures, uncurrying, recognition of direct calls *) val intro: int -> Lambda.lambda -> Clambda.ulambda diff -Nru ocaml-3.12.1/asmcomp/cmm.ml ocaml-4.01.0/asmcomp/cmm.ml --- ocaml-3.12.1/asmcomp/cmm.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/cmm.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: cmm.ml 9547 2010-01-22 12:48:24Z doligez $ *) - type machtype_component = Addr | Int @@ -108,7 +106,8 @@ { fun_name: string; fun_args: (Ident.t * machtype) list; fun_body: expression; - fun_fast: bool } + fun_fast: bool; + fun_dbg : Debuginfo.t; } type data_item = Cdefine_symbol of string diff -Nru ocaml-3.12.1/asmcomp/cmm.mli ocaml-4.01.0/asmcomp/cmm.mli --- ocaml-3.12.1/asmcomp/cmm.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/cmm.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: cmm.mli 9547 2010-01-22 12:48:24Z doligez $ *) - (* Second intermediate language (machine independent) *) type machtype_component = @@ -94,7 +92,8 @@ { fun_name: string; fun_args: (Ident.t * machtype) list; fun_body: expression; - fun_fast: bool } + fun_fast: bool; + fun_dbg : Debuginfo.t; } type data_item = Cdefine_symbol of string diff -Nru ocaml-3.12.1/asmcomp/cmmgen.ml ocaml-4.01.0/asmcomp/cmmgen.ml --- ocaml-3.12.1/asmcomp/cmmgen.ml 2010-11-11 17:08:07.000000000 +0000 +++ ocaml-4.01.0/asmcomp/cmmgen.ml 2013-05-22 13:59:24.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: cmmgen.ml 10794 2010-11-11 17:08:07Z xleroy $ *) - (* Translation from closed lambda to C-- *) open Misc @@ -78,7 +76,10 @@ (Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n) let add_const c n = - if n = 0 then c else Cop(Caddi, [c; Cconst_int n]) + if n = 0 then c + else match c with + | Cconst_int x when no_overflow_add x n -> Cconst_int (x + n) + | c -> Cop(Caddi, [c; Cconst_int n]) let incr_int = function Cconst_int n when n < max_int -> Cconst_int(n+1) @@ -155,17 +156,35 @@ Cop(Clsl, [c1; c2]) let ignore_low_bit_int = function - Cop(Caddi, [(Cop(Clsl, [_; Cconst_int 1]) as c); Cconst_int 1]) -> c + Cop(Caddi, [(Cop(Clsl, [_; Cconst_int n]) as c); Cconst_int 1]) when n > 0 + -> c | Cop(Cor, [c; Cconst_int 1]) -> c | c -> c -let is_nonzero_constant = function - Cconst_int n -> n <> 0 - | Cconst_natint n -> n <> 0n +let lsr_int c1 c2 = + match c2 with + (Cconst_int n) when n > 0 -> + Cop(Clsr, [ignore_low_bit_int c1; c2]) + | _ -> + Cop(Clsr, [c1; c2]) + +let asr_int c1 c2 = + match c2 with + (Cconst_int n) when n > 0 -> + Cop(Casr, [ignore_low_bit_int c1; c2]) + | _ -> + Cop(Casr, [c1; c2]) + +(* Division or modulo on tagged integers. The overflow case min_int / -1 + cannot occur, but we must guard against division by zero. *) + +let is_different_from x = function + Cconst_int n -> n <> x + | Cconst_natint n -> n <> Nativeint.of_int x | _ -> false let safe_divmod op c1 c2 dbg = - if !Clflags.fast || is_nonzero_constant c2 then + if !Clflags.fast || is_different_from 0 c2 then Cop(op, [c1; c2]) else bind "divisor" c2 (fun c2 -> @@ -174,6 +193,35 @@ Cop(Craise dbg, [Cconst_symbol "caml_bucket_Division_by_zero"]))) +(* Division or modulo on boxed integers. The overflow case min_int / -1 + can occur, in which case we force x / -1 = -x and x mod -1 = 0. (PR#5513). *) + +let safe_divmod_bi mkop mkm1 c1 c2 bi dbg = + bind "dividend" c1 (fun c1 -> + bind "divisor" c2 (fun c2 -> + let c3 = + if Arch.division_crashes_on_overflow + && (size_int = 4 || bi <> Pint32) + && not (is_different_from (-1) c2) + then + Cifthenelse(Cop(Ccmpi Cne, [c2; Cconst_int(-1)]), mkop c1 c2, mkm1 c1) + else + mkop c1 c2 in + if !Clflags.fast || is_different_from 0 c2 then + c3 + else + Cifthenelse(c2, c3, + Cop(Craise dbg, + [Cconst_symbol "caml_bucket_Division_by_zero"])))) + +let safe_div_bi = + safe_divmod_bi (fun c1 c2 -> Cop(Cdivi, [c1;c2])) + (fun c1 -> Cop(Csubi, [Cconst_int 0; c1])) + +let safe_mod_bi = + safe_divmod_bi (fun c1 c2 -> Cop(Cmodi, [c1;c2])) + (fun c1 -> Cconst_int 0) + (* Bool *) let test_bool = function @@ -369,33 +417,49 @@ make_alloc_generic float_array_set tag (List.length args * size_float / size_addr) args +(* Bounds checking *) + +let make_checkbound dbg = function + | [Cop(Clsr, [a1; Cconst_int n]); Cconst_int m] when (m lsl n) > n -> + Cop(Ccheckbound dbg, [a1; Cconst_int(m lsl n + 1 lsl n - 1)]) + | args -> + Cop(Ccheckbound dbg, args) + (* To compile "let rec" over values *) let fundecls_size fundecls = let sz = ref (-1) in List.iter - (fun (label, arity, params, body) -> - sz := !sz + 1 + (if arity = 1 then 2 else 3)) + (fun f -> sz := !sz + 1 + (if f.arity = 1 then 2 else 3)) fundecls; !sz type rhs_kind = | RHS_block of int + | RHS_floatblock of int | RHS_nonrec ;; -let rec expr_size = function +let rec expr_size env = function + | Uvar id -> + begin try Ident.find_same id env with Not_found -> RHS_nonrec end | Uclosure(fundecls, clos_vars) -> RHS_block (fundecls_size fundecls + List.length clos_vars) | Ulet(id, exp, body) -> - expr_size body + expr_size (Ident.add id (expr_size env exp) env) body | Uletrec(bindings, body) -> - expr_size body + expr_size env body | Uprim(Pmakeblock(tag, mut), args, _) -> RHS_block (List.length args) | Uprim(Pmakearray(Paddrarray | Pintarray), args, _) -> RHS_block (List.length args) + | Uprim(Pmakearray(Pfloatarray), args, _) -> + RHS_floatblock (List.length args) + | Uprim (Pduprecord (Record_regular, sz), _, _) -> + RHS_block sz + | Uprim (Pduprecord (Record_float, sz), _, _) -> + RHS_floatblock sz | Usequence(exp, exp') -> - expr_size exp' + expr_size env exp' | _ -> RHS_nonrec (* Record application and currying functions *) @@ -420,6 +484,7 @@ (* Translate structured constants *) +(* Fabrice: moved to compilenv.ml ---- let const_label = ref 0 let new_const_label () = @@ -431,6 +496,7 @@ Compilenv.make_symbol (Some (string_of_int !const_label)) let structured_constants = ref ([] : (string * structured_constant) list) +*) let transl_constant = function Const_base(Const_int n) -> @@ -443,14 +509,12 @@ else Cconst_natpointer (Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n) | cst -> - let lbl = new_const_symbol() in - structured_constants := (lbl, cst) :: !structured_constants; - Cconst_symbol lbl + Cconst_symbol (Compilenv.new_structured_constant cst false) (* Translate constant closures *) let constant_closures = - ref ([] : (string * (string * int * Ident.t list * ulambda) list) list) + ref ([] : (string * ufunction list) list) (* Boxed integers *) @@ -534,7 +598,7 @@ let bigarray_indexing unsafe elt_kind layout b args dbg = let check_bound a1 a2 k = - if unsafe then k else Csequence(Cop(Ccheckbound dbg, [a1;a2]), k) in + if unsafe then k else Csequence(make_checkbound dbg [a1;a2], k) in let rec ba_indexing dim_ofs delta_ofs = function [] -> assert false | [arg] -> @@ -585,7 +649,8 @@ Pbigarray_complex32 | Pbigarray_complex64 -> let kind = bigarray_word_kind elt_kind in let sz = bigarray_elt_size elt_kind / 2 in - bind "addr" (bigarray_indexing unsafe elt_kind layout b args dbg) (fun addr -> + bind "addr" (bigarray_indexing unsafe elt_kind layout b args dbg) + (fun addr -> box_complex (Cop(Cload kind, [addr])) (Cop(Cload kind, [Cop(Cadda, [addr; Cconst_int sz])]))) @@ -600,7 +665,8 @@ let kind = bigarray_word_kind elt_kind in let sz = bigarray_elt_size elt_kind / 2 in bind "newval" newval (fun newv -> - bind "addr" (bigarray_indexing unsafe elt_kind layout b args dbg) (fun addr -> + bind "addr" (bigarray_indexing unsafe elt_kind layout b args dbg) + (fun addr -> Csequence( Cop(Cstore kind, [addr; complex_re newv]), Cop(Cstore kind, @@ -609,6 +675,158 @@ Cop(Cstore (bigarray_word_kind elt_kind), [bigarray_indexing unsafe elt_kind layout b args dbg; newval])) +let unaligned_load_16 ptr idx = + if Arch.allow_unaligned_access + then Cop(Cload Sixteen_unsigned, [add_int ptr idx]) + else + let v1 = Cop(Cload Byte_unsigned, [add_int ptr idx]) in + let v2 = Cop(Cload Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 1)]) in + let b1, b2 = if Arch.big_endian then v1, v2 else v2, v1 in + Cop(Cor, [lsl_int b1 (Cconst_int 8); b2]) + +let unaligned_set_16 ptr idx newval = + if Arch.allow_unaligned_access + then Cop(Cstore Sixteen_unsigned, [add_int ptr idx; newval]) + else + let v1 = Cop(Cand, [Cop(Clsr, [newval; Cconst_int 8]); Cconst_int 0xFF]) in + let v2 = Cop(Cand, [newval; Cconst_int 0xFF]) in + let b1, b2 = if Arch.big_endian then v1, v2 else v2, v1 in + Csequence( + Cop(Cstore Byte_unsigned, [add_int ptr idx; b1]), + Cop(Cstore Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 1); b2])) + +let unaligned_load_32 ptr idx = + if Arch.allow_unaligned_access + then Cop(Cload Thirtytwo_unsigned, [add_int ptr idx]) + else + let v1 = Cop(Cload Byte_unsigned, [add_int ptr idx]) in + let v2 = Cop(Cload Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 1)]) in + let v3 = Cop(Cload Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 2)]) in + let v4 = Cop(Cload Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 3)]) in + let b1, b2, b3, b4 = + if Arch.big_endian + then v1, v2, v3, v4 + else v4, v3, v2, v1 in + Cop(Cor, + [Cop(Cor, [lsl_int b1 (Cconst_int 24); lsl_int b2 (Cconst_int 16)]); + Cop(Cor, [lsl_int b3 (Cconst_int 8); b4])]) + +let unaligned_set_32 ptr idx newval = + if Arch.allow_unaligned_access + then Cop(Cstore Thirtytwo_unsigned, [add_int ptr idx; newval]) + else + let v1 = + Cop(Cand, [Cop(Clsr, [newval; Cconst_int 24]); Cconst_int 0xFF]) in + let v2 = + Cop(Cand, [Cop(Clsr, [newval; Cconst_int 16]); Cconst_int 0xFF]) in + let v3 = + Cop(Cand, [Cop(Clsr, [newval; Cconst_int 8]); Cconst_int 0xFF]) in + let v4 = Cop(Cand, [newval; Cconst_int 0xFF]) in + let b1, b2, b3, b4 = + if Arch.big_endian + then v1, v2, v3, v4 + else v4, v3, v2, v1 in + Csequence( + Csequence( + Cop(Cstore Byte_unsigned, [add_int ptr idx; b1]), + Cop(Cstore Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 1); b2])), + Csequence( + Cop(Cstore Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 2); b3]), + Cop(Cstore Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 3); b4]))) + +let unaligned_load_64 ptr idx = + assert(size_int = 8); + if Arch.allow_unaligned_access + then Cop(Cload Word, [add_int ptr idx]) + else + let v1 = Cop(Cload Byte_unsigned, [add_int ptr idx]) in + let v2 = Cop(Cload Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 1)]) in + let v3 = Cop(Cload Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 2)]) in + let v4 = Cop(Cload Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 3)]) in + let v5 = Cop(Cload Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 4)]) in + let v6 = Cop(Cload Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 5)]) in + let v7 = Cop(Cload Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 6)]) in + let v8 = Cop(Cload Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 7)]) in + let b1, b2, b3, b4, b5, b6, b7, b8 = + if Arch.big_endian + then v1, v2, v3, v4, v5, v6, v7, v8 + else v8, v7, v6, v5, v4, v3, v2, v1 in + Cop(Cor, + [Cop(Cor, + [Cop(Cor, [lsl_int b1 (Cconst_int (8*7)); + lsl_int b2 (Cconst_int (8*6))]); + Cop(Cor, [lsl_int b3 (Cconst_int (8*5)); + lsl_int b4 (Cconst_int (8*4))])]); + Cop(Cor, + [Cop(Cor, [lsl_int b5 (Cconst_int (8*3)); + lsl_int b6 (Cconst_int (8*2))]); + Cop(Cor, [lsl_int b7 (Cconst_int 8); + b8])])]) + +let unaligned_set_64 ptr idx newval = + assert(size_int = 8); + if Arch.allow_unaligned_access + then Cop(Cstore Word, [add_int ptr idx; newval]) + else + let v1 = + Cop(Cand, [Cop(Clsr, [newval; Cconst_int (8*7)]); Cconst_int 0xFF]) in + let v2 = + Cop(Cand, [Cop(Clsr, [newval; Cconst_int (8*6)]); Cconst_int 0xFF]) in + let v3 = + Cop(Cand, [Cop(Clsr, [newval; Cconst_int (8*5)]); Cconst_int 0xFF]) in + let v4 = + Cop(Cand, [Cop(Clsr, [newval; Cconst_int (8*4)]); Cconst_int 0xFF]) in + let v5 = + Cop(Cand, [Cop(Clsr, [newval; Cconst_int (8*3)]); Cconst_int 0xFF]) in + let v6 = + Cop(Cand, [Cop(Clsr, [newval; Cconst_int (8*2)]); Cconst_int 0xFF]) in + let v7 = Cop(Cand, [Cop(Clsr, [newval; Cconst_int 8]); Cconst_int 0xFF]) in + let v8 = Cop(Cand, [newval; Cconst_int 0xFF]) in + let b1, b2, b3, b4, b5, b6, b7, b8 = + if Arch.big_endian + then v1, v2, v3, v4, v5, v6, v7, v8 + else v8, v7, v6, v5, v4, v3, v2, v1 in + Csequence( + Csequence( + Csequence( + Cop(Cstore Byte_unsigned, [add_int ptr idx; b1]), + Cop(Cstore Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 1); b2])), + Csequence( + Cop(Cstore Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 2); b3]), + Cop(Cstore Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 3); b4]))), + Csequence( + Csequence( + Cop(Cstore Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 4); b5]), + Cop(Cstore Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 5); b6])), + Csequence( + Cop(Cstore Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 6); b7]), + Cop(Cstore Byte_unsigned, + [add_int (add_int ptr idx) (Cconst_int 7); b8])))) + +let check_bound unsafe dbg a1 a2 k = + if unsafe then k else Csequence(make_checkbound dbg [a1;a2], k) + (* Simplification of some primitives into C calls *) let default_prim name = @@ -646,6 +864,11 @@ Pccall (default_prim ("caml_ba_get_" ^ string_of_int n)) | Pbigarrayset(unsafe, n, Pbigarray_int64, layout) -> Pccall (default_prim ("caml_ba_set_" ^ string_of_int n)) + | Pstring_load_64(_) -> Pccall (default_prim "caml_string_get64") + | Pstring_set_64(_) -> Pccall (default_prim "caml_string_set64") + | Pbigstring_load_64(_) -> Pccall (default_prim "caml_ba_uint8_get64") + | Pbigstring_set_64(_) -> Pccall (default_prim "caml_ba_uint8_set64") + | Pbbswap Pint64 -> Pccall (default_prim "caml_int64_bswap") | p -> p let simplif_primitive p = @@ -669,8 +892,6 @@ let transl_isout h arg = tag_int (Cop(Ccmpa Clt, [h ; arg])) -exception Found of int - let make_switch_gen arg cases acts = let lcases = Array.length cases in let new_cases = Array.create lcases 0 in @@ -726,7 +947,7 @@ | Boxed_integer of boxed_integer let is_unboxed_number = function - Uconst(Const_base(Const_float f)) -> + Uconst(Const_base(Const_float f), _) -> Boxed_float | Uprim(p, _, _) -> begin match simplif_primitive p with @@ -759,7 +980,12 @@ Boxed_float | Pbigarrayref(_, _, Pbigarray_int32, _) -> Boxed_integer Pint32 | Pbigarrayref(_, _, Pbigarray_int64, _) -> Boxed_integer Pint64 - | Pbigarrayref(_, _, Pbigarray_native_int, _) -> Boxed_integer Pnativeint + | Pbigarrayref(_, _, Pbigarray_native_int,_) -> Boxed_integer Pnativeint + | Pstring_load_32(_) -> Boxed_integer Pint32 + | Pstring_load_64(_) -> Boxed_integer Pint64 + | Pbigstring_load_32(_) -> Boxed_integer Pint32 + | Pbigstring_load_64(_) -> Boxed_integer Pint64 + | Pbbswap bi -> Boxed_integer bi | _ -> No_unboxing end | _ -> No_unboxing @@ -797,20 +1023,19 @@ (* Translate an expression *) -let functions = (Queue.create() : (string * Ident.t list * ulambda) Queue.t) +let functions = (Queue.create() : ufunction Queue.t) let rec transl = function Uvar id -> Cvar id - | Uconst sc -> + | Uconst (sc, Some const_label) -> + Cconst_symbol const_label + | Uconst (sc, None) -> transl_constant sc | Uclosure(fundecls, []) -> - let lbl = new_const_symbol() in + let lbl = Compilenv.new_const_symbol() in constant_closures := (lbl, fundecls) :: !constant_closures; - List.iter - (fun (label, arity, params, body) -> - Queue.add (label, params, body) functions) - fundecls; + List.iter (fun f -> Queue.add f functions) fundecls; Cconst_symbol lbl | Uclosure(fundecls, clos_vars) -> let block_size = @@ -818,22 +1043,22 @@ let rec transl_fundecls pos = function [] -> List.map transl clos_vars - | (label, arity, params, body) :: rem -> - Queue.add (label, params, body) functions; + | f :: rem -> + Queue.add f functions; let header = if pos = 0 then alloc_closure_header block_size else alloc_infix_header pos in - if arity = 1 then + if f.arity = 1 then header :: - Cconst_symbol label :: + Cconst_symbol f.label :: int_const 1 :: transl_fundecls (pos + 3) rem else header :: - Cconst_symbol(curry_function arity) :: - int_const arity :: - Cconst_symbol label :: + Cconst_symbol(curry_function f.arity) :: + int_const f.arity :: + Cconst_symbol f.label :: transl_fundecls (pos + 4) rem in Cop(Calloc, transl_fundecls 0 fundecls) | Uoffset(arg, offset) -> @@ -896,7 +1121,8 @@ (Cop(Cextcall(prim.prim_native_name, typ_float, false, dbg), List.map transl_unbox_float args)) else - Cop(Cextcall(Primitive.native_name prim, typ_addr, prim.prim_alloc, dbg), + Cop(Cextcall(Primitive.native_name prim, typ_addr, prim.prim_alloc, + dbg), List.map transl args) | (Pmakearray kind, []) -> transl_constant(Const_block(0, [])) @@ -938,6 +1164,9 @@ | Pbigarray_native_int -> transl_unbox_int Pnativeint argnewval | _ -> untag_int (transl argnewval)) dbg) + | (Pbigarraydim(n), [b]) -> + let dim_ofs = 4 + n in + tag_int (Cop(Cload Word, [field_address (transl b) dim_ofs])) | (p, [arg]) -> transl_prim_1 p arg dbg | (p, [arg1; arg2]) -> @@ -1066,11 +1295,22 @@ (* Integer operations *) | Pnegint -> Cop(Csubi, [Cconst_int 2; transl arg]) + | Pctconst c -> + let const_of_bool b = tag_int (Cconst_int (if b then 1 else 0)) in + begin + match c with + | Big_endian -> const_of_bool Arch.big_endian + | Word_size -> tag_int (Cconst_int (8*Arch.size_int)) + | Ostype_unix -> const_of_bool (Sys.os_type = "Unix") + | Ostype_win32 -> const_of_bool (Sys.os_type = "Win32") + | Ostype_cygwin -> const_of_bool (Sys.os_type = "Cygwin") + end | Poffsetint n -> if no_overflow_lsl n then add_const (transl arg) (n lsl 1) else - transl_prim_2 Paddint arg (Uconst (Const_base(Const_int n))) Debuginfo.none + transl_prim_2 Paddint arg (Uconst (Const_base(Const_int n), None)) + Debuginfo.none | Poffsetref n -> return_unit (bind "ref" (transl arg) (fun arg -> @@ -1121,6 +1361,18 @@ box_int bi2 (transl_unbox_int bi1 arg) | Pnegbint bi -> box_int bi (Cop(Csubi, [Cconst_int 0; transl_unbox_int bi arg])) + | Pbbswap bi -> + let prim = match bi with + | Pnativeint -> "nativeint" + | Pint32 -> "int32" + | Pint64 -> "int64" in + box_int bi (Cop(Cextcall(Printf.sprintf "caml_%s_direct_bswap" prim, + typ_int, false, Debuginfo.none), + [transl_unbox_int bi arg])) + | Pbswap16 -> + tag_int (Cop(Cextcall("caml_bswap16_direct", typ_int, false, + Debuginfo.none), + [untag_int (transl arg)])) | _ -> fatal_error "Cmmgen.transl_prim_1" @@ -1129,7 +1381,7 @@ (* Heap operations *) Psetfield(n, ptr) -> if ptr then - return_unit(Cop(Cextcall("caml_modify", typ_void, false, Debuginfo.none), + return_unit(Cop(Cextcall("caml_modify", typ_void, false,Debuginfo.none), [field_address (transl arg1) n; transl arg2])) else return_unit(set_field (transl arg1) n (transl arg2)) @@ -1158,9 +1410,11 @@ | Pmulint -> incr_int(Cop(Cmuli, [decr_int(transl arg1); untag_int(transl arg2)])) | Pdivint -> - tag_int(safe_divmod Cdivi (untag_int(transl arg1)) (untag_int(transl arg2)) dbg) + tag_int(safe_divmod Cdivi (untag_int(transl arg1)) + (untag_int(transl arg2)) dbg) | Pmodint -> - tag_int(safe_divmod Cmodi (untag_int(transl arg1)) (untag_int(transl arg2)) dbg) + tag_int(safe_divmod Cmodi (untag_int(transl arg1)) + (untag_int(transl arg2)) dbg) | Pandint -> Cop(Cand, [transl arg1; transl arg2]) | Porint -> @@ -1172,10 +1426,10 @@ | Plslint -> incr_int(lsl_int (decr_int(transl arg1)) (untag_int(transl arg2))) | Plsrint -> - Cop(Cor, [Cop(Clsr, [transl arg1; untag_int(transl arg2)]); + Cop(Cor, [lsr_int (transl arg1) (untag_int(transl arg2)); Cconst_int 1]) | Pasrint -> - Cop(Cor, [Cop(Casr, [transl arg1; untag_int(transl arg2)]); + Cop(Cor, [asr_int (transl arg1) (untag_int(transl arg2)); Cconst_int 1]) | Pintcomp cmp -> tag_int(Cop(Ccmpi(transl_comparison cmp), [transl arg1; transl arg2])) @@ -1207,9 +1461,57 @@ (bind "str" (transl arg1) (fun str -> bind "index" (untag_int (transl arg2)) (fun idx -> Csequence( - Cop(Ccheckbound dbg, [string_length str; idx]), + make_checkbound dbg [string_length str; idx], Cop(Cload Byte_unsigned, [add_int str idx]))))) + | Pstring_load_16(unsafe) -> + tag_int + (bind "str" (transl arg1) (fun str -> + bind "index" (untag_int (transl arg2)) (fun idx -> + check_bound unsafe dbg (sub_int (string_length str) (Cconst_int 1)) + idx (unaligned_load_16 str idx)))) + + | Pbigstring_load_16(unsafe) -> + tag_int + (bind "ba" (transl arg1) (fun ba -> + bind "index" (untag_int (transl arg2)) (fun idx -> + bind "ba_data" (Cop(Cload Word, [field_address ba 1])) (fun ba_data -> + check_bound unsafe dbg (sub_int (Cop(Cload Word,[field_address ba 5])) + (Cconst_int 1)) idx + (unaligned_load_16 ba_data idx))))) + + | Pstring_load_32(unsafe) -> + box_int Pint32 + (bind "str" (transl arg1) (fun str -> + bind "index" (untag_int (transl arg2)) (fun idx -> + check_bound unsafe dbg (sub_int (string_length str) (Cconst_int 3)) + idx (unaligned_load_32 str idx)))) + + | Pbigstring_load_32(unsafe) -> + box_int Pint32 + (bind "ba" (transl arg1) (fun ba -> + bind "index" (untag_int (transl arg2)) (fun idx -> + bind "ba_data" (Cop(Cload Word, [field_address ba 1])) (fun ba_data -> + check_bound unsafe dbg (sub_int (Cop(Cload Word,[field_address ba 5])) + (Cconst_int 3)) idx + (unaligned_load_32 ba_data idx))))) + + | Pstring_load_64(unsafe) -> + box_int Pint64 + (bind "str" (transl arg1) (fun str -> + bind "index" (untag_int (transl arg2)) (fun idx -> + check_bound unsafe dbg (sub_int (string_length str) (Cconst_int 7)) + idx (unaligned_load_64 str idx)))) + + | Pbigstring_load_64(unsafe) -> + box_int Pint64 + (bind "ba" (transl arg1) (fun ba -> + bind "index" (untag_int (transl arg2)) (fun idx -> + bind "ba_data" (Cop(Cload Word, [field_address ba 1])) (fun ba_data -> + check_bound unsafe dbg (sub_int (Cop(Cload Word,[field_address ba 5])) + (Cconst_int 7)) idx + (unaligned_load_64 ba_data idx))))) + (* Array operations *) | Parrayrefu kind -> begin match kind with @@ -1226,27 +1528,33 @@ end | Parrayrefs kind -> begin match kind with - Pgenarray -> + | Pgenarray -> bind "index" (transl arg2) (fun idx -> - bind "arr" (transl arg1) (fun arr -> - bind "header" (header arr) (fun hdr -> - Cifthenelse(is_addr_array_hdr hdr, - Csequence(Cop(Ccheckbound dbg, [addr_array_length hdr; idx]), - addr_array_ref arr idx), - Csequence(Cop(Ccheckbound dbg, [float_array_length hdr; idx]), - float_array_ref arr idx))))) + bind "arr" (transl arg1) (fun arr -> + bind "header" (header arr) (fun hdr -> + if wordsize_shift = numfloat_shift then + Csequence(make_checkbound dbg [addr_array_length hdr; idx], + Cifthenelse(is_addr_array_hdr hdr, + addr_array_ref arr idx, + float_array_ref arr idx)) + else + Cifthenelse(is_addr_array_hdr hdr, + Csequence(make_checkbound dbg [addr_array_length hdr; idx], + addr_array_ref arr idx), + Csequence(make_checkbound dbg [float_array_length hdr; idx], + float_array_ref arr idx))))) | Paddrarray | Pintarray -> bind "index" (transl arg2) (fun idx -> - bind "arr" (transl arg1) (fun arr -> - Csequence(Cop(Ccheckbound dbg, [addr_array_length(header arr); idx]), - addr_array_ref arr idx))) + bind "arr" (transl arg1) (fun arr -> + Csequence(make_checkbound dbg [addr_array_length(header arr); idx], + addr_array_ref arr idx))) | Pfloatarray -> box_float( bind "index" (transl arg2) (fun idx -> - bind "arr" (transl arg1) (fun arr -> - Csequence(Cop(Ccheckbound dbg, - [float_array_length(header arr); idx]), - unboxed_float_array_ref arr idx)))) + bind "arr" (transl arg1) (fun arr -> + Csequence(make_checkbound dbg + [float_array_length(header arr); idx], + unboxed_float_array_ref arr idx)))) end (* Operations on bitvects *) @@ -1270,13 +1578,13 @@ box_int bi (Cop(Cmuli, [transl_unbox_int bi arg1; transl_unbox_int bi arg2])) | Pdivbint bi -> - box_int bi (safe_divmod Cdivi + box_int bi (safe_div_bi (transl_unbox_int bi arg1) (transl_unbox_int bi arg2) - dbg) + bi dbg) | Pmodbint bi -> - box_int bi (safe_divmod Cmodi + box_int bi (safe_mod_bi (transl_unbox_int bi arg1) (transl_unbox_int bi arg2) - dbg) + bi dbg) | Pandbint bi -> box_int bi (Cop(Cand, [transl_unbox_int bi arg1; transl_unbox_int bi arg2])) @@ -1314,7 +1622,7 @@ (bind "str" (transl arg1) (fun str -> bind "index" (untag_int (transl arg2)) (fun idx -> Csequence( - Cop(Ccheckbound dbg, [string_length str; idx]), + make_checkbound dbg [string_length str; idx], Cop(Cstore Byte_unsigned, [add_int str idx; untag_int(transl arg3)]))))) @@ -1337,48 +1645,113 @@ end) | Parraysets kind -> return_unit(begin match kind with - Pgenarray -> + | Pgenarray -> bind "newval" (transl arg3) (fun newval -> - bind "index" (transl arg2) (fun idx -> - bind "arr" (transl arg1) (fun arr -> - bind "header" (header arr) (fun hdr -> - Cifthenelse(is_addr_array_hdr hdr, - Csequence(Cop(Ccheckbound dbg, [addr_array_length hdr; idx]), - addr_array_set arr idx newval), - Csequence(Cop(Ccheckbound dbg, [float_array_length hdr; idx]), - float_array_set arr idx - (unbox_float newval))))))) + bind "index" (transl arg2) (fun idx -> + bind "arr" (transl arg1) (fun arr -> + bind "header" (header arr) (fun hdr -> + if wordsize_shift = numfloat_shift then + Csequence(make_checkbound dbg [addr_array_length hdr; idx], + Cifthenelse(is_addr_array_hdr hdr, + addr_array_set arr idx newval, + float_array_set arr idx + (unbox_float newval))) + else + Cifthenelse(is_addr_array_hdr hdr, + Csequence(make_checkbound dbg [addr_array_length hdr; idx], + addr_array_set arr idx newval), + Csequence(make_checkbound dbg [float_array_length hdr; idx], + float_array_set arr idx + (unbox_float newval))))))) | Paddrarray -> + bind "newval" (transl arg3) (fun newval -> bind "index" (transl arg2) (fun idx -> - bind "arr" (transl arg1) (fun arr -> - Csequence(Cop(Ccheckbound dbg, [addr_array_length(header arr); idx]), - addr_array_set arr idx (transl arg3)))) + bind "arr" (transl arg1) (fun arr -> + Csequence(make_checkbound dbg [addr_array_length(header arr); idx], + addr_array_set arr idx newval)))) | Pintarray -> + bind "newval" (transl arg3) (fun newval -> bind "index" (transl arg2) (fun idx -> - bind "arr" (transl arg1) (fun arr -> - Csequence(Cop(Ccheckbound dbg, [addr_array_length(header arr); idx]), - int_array_set arr idx (transl arg3)))) + bind "arr" (transl arg1) (fun arr -> + Csequence(make_checkbound dbg [addr_array_length(header arr); idx], + int_array_set arr idx newval)))) | Pfloatarray -> + bind "newval" (transl_unbox_float arg3) (fun newval -> bind "index" (transl arg2) (fun idx -> - bind "arr" (transl arg1) (fun arr -> - Csequence(Cop(Ccheckbound dbg, [float_array_length(header arr);idx]), - float_array_set arr idx (transl_unbox_float arg3)))) + bind "arr" (transl arg1) (fun arr -> + Csequence(make_checkbound dbg [float_array_length(header arr);idx], + float_array_set arr idx newval)))) end) + + | Pstring_set_16(unsafe) -> + return_unit + (bind "str" (transl arg1) (fun str -> + bind "index" (untag_int (transl arg2)) (fun idx -> + bind "newval" (untag_int (transl arg3)) (fun newval -> + check_bound unsafe dbg (sub_int (string_length str) (Cconst_int 1)) + idx (unaligned_set_16 str idx newval))))) + + | Pbigstring_set_16(unsafe) -> + return_unit + (bind "ba" (transl arg1) (fun ba -> + bind "index" (untag_int (transl arg2)) (fun idx -> + bind "newval" (untag_int (transl arg3)) (fun newval -> + bind "ba_data" (Cop(Cload Word, [field_address ba 1])) (fun ba_data -> + check_bound unsafe dbg (sub_int (Cop(Cload Word,[field_address ba 5])) + (Cconst_int 1)) + idx (unaligned_set_16 ba_data idx newval)))))) + + | Pstring_set_32(unsafe) -> + return_unit + (bind "str" (transl arg1) (fun str -> + bind "index" (untag_int (transl arg2)) (fun idx -> + bind "newval" (transl_unbox_int Pint32 arg3) (fun newval -> + check_bound unsafe dbg (sub_int (string_length str) (Cconst_int 3)) + idx (unaligned_set_32 str idx newval))))) + + | Pbigstring_set_32(unsafe) -> + return_unit + (bind "ba" (transl arg1) (fun ba -> + bind "index" (untag_int (transl arg2)) (fun idx -> + bind "newval" (transl_unbox_int Pint32 arg3) (fun newval -> + bind "ba_data" (Cop(Cload Word, [field_address ba 1])) (fun ba_data -> + check_bound unsafe dbg (sub_int (Cop(Cload Word,[field_address ba 5])) + (Cconst_int 3)) + idx (unaligned_set_32 ba_data idx newval)))))) + + | Pstring_set_64(unsafe) -> + return_unit + (bind "str" (transl arg1) (fun str -> + bind "index" (untag_int (transl arg2)) (fun idx -> + bind "newval" (transl_unbox_int Pint64 arg3) (fun newval -> + check_bound unsafe dbg (sub_int (string_length str) (Cconst_int 7)) + idx (unaligned_set_64 str idx newval))))) + + | Pbigstring_set_64(unsafe) -> + return_unit + (bind "ba" (transl arg1) (fun ba -> + bind "index" (untag_int (transl arg2)) (fun idx -> + bind "newval" (transl_unbox_int Pint64 arg3) (fun newval -> + bind "ba_data" (Cop(Cload Word, [field_address ba 1])) (fun ba_data -> + check_bound unsafe dbg (sub_int (Cop(Cload Word,[field_address ba 5])) + (Cconst_int 7)) idx + (unaligned_set_64 ba_data idx newval)))))) + | _ -> fatal_error "Cmmgen.transl_prim_3" and transl_unbox_float = function - Uconst(Const_base(Const_float f)) -> Cconst_float f + Uconst(Const_base(Const_float f), _) -> Cconst_float f | exp -> unbox_float(transl exp) and transl_unbox_int bi = function - Uconst(Const_base(Const_int32 n)) -> + Uconst(Const_base(Const_int32 n), _) -> Cconst_natint (Nativeint.of_int32 n) - | Uconst(Const_base(Const_nativeint n)) -> + | Uconst(Const_base(Const_nativeint n), _) -> Cconst_natint n - | Uconst(Const_base(Const_int64 n)) -> + | Uconst(Const_base(Const_int64 n), _) -> assert (size_int = 8); Cconst_natint (Int64.to_nativeint n) - | Uprim(Pbintofint bi', [Uconst(Const_base(Const_int i))], _) when bi = bi' -> + | Uprim(Pbintofint bi',[Uconst(Const_base(Const_int i),_)],_) when bi = bi' -> Cconst_int i | exp -> unbox_int bi (transl exp) @@ -1411,8 +1784,8 @@ and exit_if_true cond nfail otherwise = match cond with - | Uconst (Const_pointer 0) -> otherwise - | Uconst (Const_pointer 1) -> Cexit (nfail,[]) + | Uconst (Const_pointer 0, _) -> otherwise + | Uconst (Const_pointer 1, _) -> Cexit (nfail,[]) | Uprim(Psequor, [arg1; arg2], _) -> exit_if_true arg1 nfail (exit_if_true arg2 nfail otherwise) | Uprim(Psequand, _, _) -> @@ -1441,8 +1814,8 @@ and exit_if_false cond otherwise nfail = match cond with - | Uconst (Const_pointer 0) -> Cexit (nfail,[]) - | Uconst (Const_pointer 1) -> otherwise + | Uconst (Const_pointer 0, _) -> Cexit (nfail,[]) + | Uconst (Const_pointer 1, _) -> otherwise | Uprim(Psequand, [arg1; arg2], _) -> exit_if_false arg1 (exit_if_false arg2 otherwise nfail) nfail | Uprim(Psequor, _, _) -> @@ -1501,54 +1874,61 @@ (Array.of_list !inters) actions) and transl_letrec bindings cont = - let bsz = List.map (fun (id, exp) -> (id, exp, expr_size exp)) bindings in + let bsz = + List.map (fun (id, exp) -> (id, exp, expr_size Ident.empty exp)) bindings in + let op_alloc prim sz = + Cop(Cextcall(prim, typ_addr, true, Debuginfo.none), [int_const sz]) in let rec init_blocks = function | [] -> fill_nonrec bsz | (id, exp, RHS_block sz) :: rem -> - Clet(id, Cop(Cextcall("caml_alloc_dummy", typ_addr, true, Debuginfo.none), - [int_const sz]), - init_blocks rem) + Clet(id, op_alloc "caml_alloc_dummy" sz, init_blocks rem) + | (id, exp, RHS_floatblock sz) :: rem -> + Clet(id, op_alloc "caml_alloc_dummy_float" sz, init_blocks rem) | (id, exp, RHS_nonrec) :: rem -> Clet (id, Cconst_int 0, init_blocks rem) and fill_nonrec = function | [] -> fill_blocks bsz - | (id, exp, RHS_block sz) :: rem -> fill_nonrec rem + | (id, exp, (RHS_block _ | RHS_floatblock _)) :: rem -> + fill_nonrec rem | (id, exp, RHS_nonrec) :: rem -> Clet (id, transl exp, fill_nonrec rem) and fill_blocks = function | [] -> cont - | (id, exp, RHS_block _) :: rem -> - Csequence(Cop(Cextcall("caml_update_dummy", typ_void, false, Debuginfo.none), - [Cvar id; transl exp]), - fill_blocks rem) + | (id, exp, (RHS_block _ | RHS_floatblock _)) :: rem -> + let op = + Cop(Cextcall("caml_update_dummy", typ_void, false, Debuginfo.none), + [Cvar id; transl exp]) in + Csequence(op, fill_blocks rem) | (id, exp, RHS_nonrec) :: rem -> fill_blocks rem in init_blocks bsz (* Translate a function definition *) -let transl_function lbl params body = - Cfunction {fun_name = lbl; - fun_args = List.map (fun id -> (id, typ_addr)) params; - fun_body = transl body; - fun_fast = !Clflags.optimize_for_speed} +let transl_function f = + Cfunction {fun_name = f.label; + fun_args = List.map (fun id -> (id, typ_addr)) f.params; + fun_body = transl f.body; + fun_fast = !Clflags.optimize_for_speed; + fun_dbg = f.dbg; } (* Translate all function definitions *) module StringSet = Set.Make(struct type t = string - let compare = compare + let compare (x:t) y = compare x y end) let rec transl_all_functions already_translated cont = try - let (lbl, params, body) = Queue.take functions in - if StringSet.mem lbl already_translated then + let f = Queue.take functions in + if StringSet.mem f.label already_translated then transl_all_functions already_translated cont else begin - transl_all_functions (StringSet.add lbl already_translated) - (transl_function lbl params body :: cont) + transl_all_functions + (StringSet.add f.label already_translated) + (transl_function f :: cont) end with Queue.Empty -> cont @@ -1601,11 +1981,11 @@ | Const_base(Const_char c) -> (Cint(Nativeint.of_int(((Char.code c) lsl 1) + 1)), cont) | Const_base(Const_float s) -> - let lbl = new_const_label() in + let lbl = Compilenv.new_const_label() in (Clabel_address lbl, Cint(float_header) :: Cdefine_label lbl :: Cdouble s :: cont) | Const_base(Const_string s) -> - let lbl = new_const_label() in + let lbl = Compilenv.new_const_label() in (Clabel_address lbl, Cint(string_header (String.length s)) :: Cdefine_label lbl :: emit_string_constant s cont) @@ -1613,24 +1993,24 @@ begin try (Clabel_address (Hashtbl.find immstrings s), cont) with Not_found -> - let lbl = new_const_label() in + let lbl = Compilenv.new_const_label() in Hashtbl.add immstrings s lbl; (Clabel_address lbl, Cint(string_header (String.length s)) :: Cdefine_label lbl :: emit_string_constant s cont) end | Const_base(Const_int32 n) -> - let lbl = new_const_label() in + let lbl = Compilenv.new_const_label() in (Clabel_address lbl, Cint(boxedint32_header) :: Cdefine_label lbl :: emit_boxed_int32_constant n cont) | Const_base(Const_int64 n) -> - let lbl = new_const_label() in + let lbl = Compilenv.new_const_label() in (Clabel_address lbl, Cint(boxedint64_header) :: Cdefine_label lbl :: emit_boxed_int64_constant n cont) | Const_base(Const_nativeint n) -> - let lbl = new_const_label() in + let lbl = Compilenv.new_const_label() in (Clabel_address lbl, Cint(boxedintnat_header) :: Cdefine_label lbl :: emit_boxed_nativeint_constant n cont) @@ -1638,13 +2018,13 @@ (Cint(Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n), cont) | Const_block(tag, fields) -> - let lbl = new_const_label() in + let lbl = Compilenv.new_const_label() in let (emit_fields, cont1) = emit_constant_fields fields cont in (Clabel_address lbl, Cint(block_header tag (List.length fields)) :: Cdefine_label lbl :: emit_fields @ cont1) | Const_float_array(fields) -> - let lbl = new_const_label() in + let lbl = Compilenv.new_const_label() in (Clabel_address lbl, Cint(floatarray_header (List.length fields)) :: Cdefine_label lbl :: Misc.map_end (fun f -> Cdouble f) fields cont) @@ -1680,31 +2060,31 @@ let emit_constant_closure symb fundecls cont = match fundecls with [] -> assert false - | (label, arity, params, body) :: remainder -> + | f1 :: remainder -> let rec emit_others pos = function [] -> cont - | (label, arity, params, body) :: rem -> - if arity = 1 then + | f2 :: rem -> + if f2.arity = 1 then Cint(infix_header pos) :: - Csymbol_address label :: + Csymbol_address f2.label :: Cint 3n :: emit_others (pos + 3) rem else Cint(infix_header pos) :: - Csymbol_address(curry_function arity) :: - Cint(Nativeint.of_int (arity lsl 1 + 1)) :: - Csymbol_address label :: + Csymbol_address(curry_function f2.arity) :: + Cint(Nativeint.of_int (f2.arity lsl 1 + 1)) :: + Csymbol_address f2.label :: emit_others (pos + 4) rem in Cint(closure_header (fundecls_size fundecls)) :: Cdefine_symbol symb :: - if arity = 1 then - Csymbol_address label :: + if f1.arity = 1 then + Csymbol_address f1.label :: Cint 3n :: emit_others 3 remainder else - Csymbol_address(curry_function arity) :: - Cint(Nativeint.of_int (arity lsl 1 + 1)) :: - Csymbol_address label :: + Csymbol_address(curry_function f1.arity) :: + Cint(Nativeint.of_int (f1.arity lsl 1 + 1)) :: + Csymbol_address f1.label :: emit_others 4 remainder (* Emit all structured constants *) @@ -1712,9 +2092,14 @@ let emit_all_constants cont = let c = ref cont in List.iter - (fun (lbl, cst) -> c := Cdata(emit_constant lbl cst []) :: !c) - !structured_constants; - structured_constants := []; + (fun (lbl, global, cst) -> + let cst = emit_constant lbl cst [] in + let cst = if global then + Cglobal_symbol lbl :: cst + else cst in + c:= Cdata(cst):: !c) + (Compilenv.structured_constants()); +(* structured_constants := []; done in Compilenv.reset() *) Hashtbl.clear immstrings; (* PR#3979 *) List.iter (fun (symb, fundecls) -> @@ -1730,7 +2115,8 @@ let init_code = transl ulam in let c1 = [Cfunction {fun_name = Compilenv.make_symbol (Some "entry"); fun_args = []; - fun_body = init_code; fun_fast = false}] in + fun_body = init_code; fun_fast = false; + fun_dbg = Debuginfo.none }] in let c2 = transl_all_functions StringSet.empty c1 in let c3 = emit_all_constants c2 in Cdata [Cint(block_header 0 size); @@ -1859,7 +2245,8 @@ {fun_name = "caml_send" ^ string_of_int arity; fun_args = fun_args; fun_body = body; - fun_fast = true} + fun_fast = true; + fun_dbg = Debuginfo.none } let apply_function arity = let (args, clos, body) = apply_function_body arity in @@ -1868,7 +2255,8 @@ {fun_name = "caml_apply" ^ string_of_int arity; fun_args = List.map (fun id -> (id, typ_addr)) all_args; fun_body = body; - fun_fast = true} + fun_fast = true; + fun_dbg = Debuginfo.none } (* Generate tuplifying functions: (defun caml_tuplifyN (arg clos) @@ -1887,23 +2275,38 @@ fun_body = Cop(Capply(typ_addr, Debuginfo.none), get_field (Cvar clos) 2 :: access_components 0 @ [Cvar clos]); - fun_fast = true} + fun_fast = true; + fun_dbg = Debuginfo.none } (* Generate currying functions: (defun caml_curryN (arg clos) - (alloc HDR caml_curryN_1 arg clos)) + (alloc HDR caml_curryN_1 caml_curry_N_1_app arg clos)) (defun caml_curryN_1 (arg clos) - (alloc HDR caml_curryN_2 arg clos)) + (alloc HDR caml_curryN_2 caml_curry_N_2_app arg clos)) ... (defun caml_curryN_N-1 (arg clos) - (let (closN-2 clos.cdr - closN-3 closN-2.cdr + (let (closN-2 clos.vars[1] + closN-3 closN-2.vars[1] ... - clos1 clos2.cdr - clos clos1.cdr) + clos1 clos2.vars[1] + clos clos1.vars[1]) (app clos.direct - clos1.car clos2.car ... closN-2.car clos.car arg clos))) *) + clos1.vars[0] ... closN-2.vars[0] clos.vars[0] arg clos))) + + Special "shortcut" functions are also generated to handle the + case where a partially applied function is applied to all remaining + arguments in one go. For instance: + (defun caml_curry_N_1_app (arg2 ... argN clos) + (let clos' clos.vars[1] + (app clos'.direct clos.vars[0] arg2 ... argN clos'))) + + Those shortcuts may lead to a quadratic number of application + primitives being generated in the worst case, which resulted in + linking time blowup in practice (PR#5933), so we only generate and + use them when below a fixed arity 'max_arity_optimized'. +*) +let max_arity_optimized = 15 let final_curry_function arity = let last_arg = Ident.create "arg" in let last_clos = Ident.create "clos" in @@ -1912,18 +2315,27 @@ Cop(Capply(typ_addr, Debuginfo.none), get_field (Cvar clos) 2 :: args @ [Cvar last_arg; Cvar clos]) - else begin + else + if n = arity - 1 || arity > max_arity_optimized then + begin let newclos = Ident.create "clos" in Clet(newclos, get_field (Cvar clos) 3, curry_fun (get_field (Cvar clos) 2 :: args) newclos (n-1)) + end else + begin + let newclos = Ident.create "clos" in + Clet(newclos, + get_field (Cvar clos) 4, + curry_fun (get_field (Cvar clos) 3 :: args) newclos (n-1)) end in Cfunction {fun_name = "caml_curry" ^ string_of_int arity ^ "_" ^ string_of_int (arity-1); fun_args = [last_arg, typ_addr; last_clos, typ_addr]; fun_body = curry_fun [] last_clos (arity-1); - fun_fast = true} + fun_fast = true; + fun_dbg = Debuginfo.none } let rec intermediate_curry_functions arity num = if num = arity - 1 then @@ -1935,12 +2347,52 @@ Cfunction {fun_name = name2; fun_args = [arg, typ_addr; clos, typ_addr]; - fun_body = Cop(Calloc, + fun_body = + if arity - num > 2 && arity <= max_arity_optimized then + Cop(Calloc, + [alloc_closure_header 5; + Cconst_symbol(name1 ^ "_" ^ string_of_int (num+1)); + int_const (arity - num - 1); + Cconst_symbol(name1 ^ "_" ^ string_of_int (num+1) ^ "_app"); + Cvar arg; Cvar clos]) + else + Cop(Calloc, [alloc_closure_header 4; Cconst_symbol(name1 ^ "_" ^ string_of_int (num+1)); int_const 1; Cvar arg; Cvar clos]); - fun_fast = true} - :: intermediate_curry_functions arity (num+1) + fun_fast = true; + fun_dbg = Debuginfo.none } + :: + (if arity <= max_arity_optimized && arity - num > 2 then + let rec iter i = + if i <= arity then + let arg = Ident.create (Printf.sprintf "arg%d" i) in + (arg, typ_addr) :: iter (i+1) + else [] + in + let direct_args = iter (num+2) in + let rec iter i args clos = + if i = 0 then + Cop(Capply(typ_addr, Debuginfo.none), + (get_field (Cvar clos) 2) :: args @ [Cvar clos]) + else + let newclos = Ident.create "clos" in + Clet(newclos, + get_field (Cvar clos) 4, + iter (i-1) (get_field (Cvar clos) 3 :: args) newclos) + in + let cf = + Cfunction + {fun_name = name1 ^ "_" ^ string_of_int (num+1) ^ "_app"; + fun_args = direct_args @ [clos, typ_addr]; + fun_body = iter (num+1) + (List.map (fun (arg,_) -> Cvar arg) direct_args) clos; + fun_fast = true; + fun_dbg = Debuginfo.none } + in + cf :: intermediate_curry_functions arity (num+1) + else + intermediate_curry_functions arity (num+1)) end let curry_function arity = @@ -1952,7 +2404,7 @@ module IntSet = Set.Make( struct type t = int - let compare = compare + let compare (x:t) y = compare x y end) let default_apply = IntSet.add 2 (IntSet.add 3 IntSet.empty) @@ -1992,7 +2444,8 @@ Cfunction {fun_name = "caml_program"; fun_args = []; fun_body = body; - fun_fast = false} + fun_fast = false; + fun_dbg = Debuginfo.none } (* Generate the table of globals *) diff -Nru ocaml-3.12.1/asmcomp/cmmgen.mli ocaml-4.01.0/asmcomp/cmmgen.mli --- ocaml-3.12.1/asmcomp/cmmgen.mli 2010-05-19 11:29:38.000000000 +0000 +++ ocaml-4.01.0/asmcomp/cmmgen.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: cmmgen.mli 10424 2010-05-19 11:29:38Z xleroy $ *) - (* Translation from closed lambda to C-- *) val compunit: int -> Clambda.ulambda -> Cmm.phrase list diff -Nru ocaml-3.12.1/asmcomp/cmx_format.mli ocaml-4.01.0/asmcomp/cmx_format.mli --- ocaml-3.12.1/asmcomp/cmx_format.mli 2010-05-19 11:29:38.000000000 +0000 +++ ocaml-4.01.0/asmcomp/cmx_format.mli 2013-03-09 22:38:52.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) (* *) @@ -10,18 +10,16 @@ (* *) (***********************************************************************) -(* $Id: compilenv.mli 9547 2010-01-22 12:48:24Z doligez $ *) - (* Format of .cmx, .cmxa and .cmxs files *) (* Each .o file has a matching .cmx file that provides the following infos on the compilation unit: - - list of other units imported, with CRCs of their .cmx files + - list of other units imported, with MD5s of their .cmx files - approximation of the structure implemented (includes descriptions of known functions: arity and direct entry points) - list of currying functions and application functions needed - The .cmx file contains these infos (as an externed record) plus a CRC + The .cmx file contains these infos (as an externed record) plus a MD5 of these infos *) type unit_infos = @@ -30,7 +28,7 @@ mutable ui_defines: string list; (* Unit and sub-units implemented *) mutable ui_imports_cmi: (string * Digest.t) list; (* Interfaces imported *) mutable ui_imports_cmx: (string * Digest.t) list; (* Infos imported *) - mutable ui_approx: Clambda.value_approximation; (* Approx of the structure *) + mutable ui_approx: Clambda.value_approximation; (* Approx of the structure*) mutable ui_curry_fun: int list; (* Currying functions needed *) mutable ui_apply_fun: int list; (* Apply functions needed *) mutable ui_send_fun: int list; (* Send functions needed *) @@ -40,7 +38,7 @@ infos on the library: *) type library_infos = - { lib_units: (unit_infos * Digest.t) list; (* List of unit infos w/ CRCs *) + { lib_units: (unit_infos * Digest.t) list; (* List of unit infos w/ MD5s *) lib_ccobjs: string list; (* C object files needed *) lib_ccopts: string list } (* Extra opts to C compiler *) @@ -60,4 +58,3 @@ dynu_magic: string; dynu_units: dynunit list; } - diff -Nru ocaml-3.12.1/asmcomp/codegen.ml ocaml-4.01.0/asmcomp/codegen.ml --- ocaml-3.12.1/asmcomp/codegen.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/codegen.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: codegen.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* From C-- to assembly code *) open Format diff -Nru ocaml-3.12.1/asmcomp/codegen.mli ocaml-4.01.0/asmcomp/codegen.mli --- ocaml-3.12.1/asmcomp/codegen.mli 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/codegen.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: codegen.mli 2553 1999-11-17 18:59:06Z xleroy $ *) - (* From C-- to assembly code *) val phrase: Cmm.phrase -> unit diff -Nru ocaml-3.12.1/asmcomp/coloring.ml ocaml-4.01.0/asmcomp/coloring.ml --- ocaml-3.12.1/asmcomp/coloring.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/coloring.ml 2013-01-13 16:57:36.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,269 +10,214 @@ (* *) (***********************************************************************) -(* $Id: coloring.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Register allocation by coloring of the interference graph *) +module OrderedRegSet = + Set.Make(struct + type t = Reg.t + let compare r1 r2 = + let open Reg in + let c1 = r1.spill_cost and d1 = r1.degree in + let c2 = r2.spill_cost and d2 = r2.degree in + let n = c2 * d1 - c1 * d2 in + if n <> 0 then n else + let n = c2 - c1 in + if n <> 0 then n else + let n = d1 - d2 in + if n <> 0 then n else r1.stamp - r2.stamp + end) + open Reg -(* Preallocation of spilled registers in the stack. *) +let allocate_registers() = -let allocate_spilled reg = - if reg.spill then begin + (* Constrained regs with degree >= number of available registers, + sorted by spill cost (highest first). + The spill cost measure is [r.spill_cost / r.degree]. + [r.spill_cost] estimates the number of accesses to [r]. *) + let constrained = ref OrderedRegSet.empty in + + (* Unconstrained regs with degree < number of available registers *) + let unconstrained = ref [] in + + (* Preallocate the spilled registers in the stack. + Split the remaining registers into constrained and unconstrained. *) + let remove_reg reg = let cl = Proc.register_class reg in - let nslots = Proc.num_stack_slots.(cl) in - let conflict = Array.create nslots false in - List.iter - (fun r -> - match r.loc with - Stack(Local n) -> - if Proc.register_class r = cl then conflict.(n) <- true - | _ -> ()) - reg.interf; - let slot = ref 0 in - while !slot < nslots && conflict.(!slot) do incr slot done; - reg.loc <- Stack(Local !slot); - if !slot >= nslots then Proc.num_stack_slots.(cl) <- !slot + 1 - end - -(* Compute the degree (= number of neighbours of the same type) - of each register, and split them in two sets: - unconstrained (degree < number of available registers) - and constrained (degree >= number of available registers). - Spilled registers are ignored in the process. *) + if reg.spill then begin + (* Preallocate the registers in the stack *) + let nslots = Proc.num_stack_slots.(cl) in + let conflict = Array.create nslots false in + List.iter + (fun r -> + match r.loc with + Stack(Local n) -> + if Proc.register_class r = cl then conflict.(n) <- true + | _ -> ()) + reg.interf; + let slot = ref 0 in + while !slot < nslots && conflict.(!slot) do incr slot done; + reg.loc <- Stack(Local !slot); + if !slot >= nslots then Proc.num_stack_slots.(cl) <- !slot + 1 + end else if reg.degree < Proc.num_available_registers.(cl) then + unconstrained := reg :: !unconstrained + else begin + constrained := OrderedRegSet.add reg !constrained + end in -let unconstrained = ref Reg.Set.empty -let constrained = ref Reg.Set.empty + (* Iterate over all registers preferred by the given register (transitive) *) + let iter_preferred f reg = + let rec walk r w = + if not r.visited then begin + f r w; + begin match r.prefer with + [] -> () + | p -> r.visited <- true; + List.iter (fun (r1, w1) -> walk r1 (min w w1)) p; + r.visited <- false + end + end in + reg.visited <- true; + List.iter (fun (r, w) -> walk r w) reg.prefer; + reg.visited <- false in + + (* Where to start the search for a suitable register. + Used to introduce some "randomness" in the choice between registers + with equal scores. This offers more opportunities for scheduling. *) + let start_register = Array.create Proc.num_register_classes 0 in -let find_degree reg = - if reg.spill then () else begin + (* Assign a location to a register, the best we can. *) + let assign_location reg = let cl = Proc.register_class reg in - let avail_regs = Proc.num_available_registers.(cl) in - if avail_regs = 0 then - (* Don't bother computing the degree if there are no regs - in this class *) - unconstrained := Reg.Set.add reg !unconstrained - else begin - let deg = ref 0 in + let first_reg = Proc.first_available_register.(cl) in + let num_regs = Proc.num_available_registers.(cl) in + let score = Array.create num_regs 0 in + let best_score = ref (-1000000) and best_reg = ref (-1) in + let start = start_register.(cl) in + if num_regs <> 0 then begin + (* Favor the registers that have been assigned to pseudoregs for which + we have a preference. If these pseudoregs have not been assigned + already, avoid the registers with which they conflict. *) + iter_preferred + (fun r w -> + match r.loc with + Reg n -> let n = n - first_reg in + if n < num_regs then + score.(n) <- score.(n) + w + | Unknown -> + List.iter + (fun neighbour -> + match neighbour.loc with + Reg n -> let n = n - first_reg in + if n < num_regs then + score.(n) <- score.(n) - w + | _ -> ()) + r.interf + | _ -> ()) + reg; List.iter - (fun r -> if not r.spill && Proc.register_class r = cl then incr deg) + (fun neighbour -> + (* Prohibit the registers that have been assigned + to our neighbours *) + begin match neighbour.loc with + Reg n -> let n = n - first_reg in + if n < num_regs then + score.(n) <- (-1000000) + | _ -> () + end; + (* Avoid the registers that have been assigned to pseudoregs + for which our neighbours have a preference *) + iter_preferred + (fun r w -> + match r.loc with + Reg n -> let n = n - first_reg in + if n < num_regs then + score.(n) <- score.(n) - (w-1) + (* w-1 to break the symmetry when two conflicting regs + have the same preference for a third reg. *) + | _ -> ()) + neighbour) reg.interf; - reg.degree <- !deg; - if !deg >= avail_regs - then constrained := Reg.Set.add reg !constrained - else unconstrained := Reg.Set.add reg !unconstrained - end - end - -(* Remove a register from the interference graph *) - -let remove_reg reg = - reg.degree <- 0; (* 0 means r is no longer part of the graph *) - let cl = Proc.register_class reg in - List.iter - (fun r -> - if Proc.register_class r = cl && r.degree > 0 then begin - let olddeg = r.degree in - r.degree <- olddeg - 1; - if olddeg = Proc.num_available_registers.(cl) then begin - (* r was constrained and becomes unconstrained *) - constrained := Reg.Set.remove r !constrained; - unconstrained := Reg.Set.add r !unconstrained + (* Pick the register with the best score *) + for n = start to num_regs - 1 do + if score.(n) > !best_score then begin + best_score := score.(n); + best_reg := n end - end) - reg.interf - -(* Remove all registers one by one, unconstrained if possible, otherwise - constrained with lowest spill cost. Return the list of registers removed - in reverse order. - The spill cost measure is [r.spill_cost / r.degree]. - [r.spill_cost] estimates the number of accesses to this register. *) - -let rec remove_all_regs stack = - if not (Reg.Set.is_empty !unconstrained) then begin - (* Pick any unconstrained register *) - let r = Reg.Set.choose !unconstrained in - unconstrained := Reg.Set.remove r !unconstrained; - remove_all_regs (r :: stack) - end else - if not (Reg.Set.is_empty !constrained) then begin - (* Find a constrained reg with minimal cost *) - let r = ref Reg.dummy in - let min_degree = ref 0 and min_spill_cost = ref 1 in - (* initially !min_spill_cost / !min_degree is +infty *) - Reg.Set.iter - (fun r2 -> - (* if r2.spill_cost / r2.degree < !min_spill_cost / !min_degree *) - if r2.spill_cost * !min_degree < !min_spill_cost * r2.degree - then begin - r := r2; min_degree := r2.degree; min_spill_cost := r2.spill_cost - end) - !constrained; - constrained := Reg.Set.remove !r !constrained; - remove_all_regs (!r :: stack) - end else - stack (* All regs have been removed *) - -(* Iterate over all registers preferred by the given register (transitively) *) - -let iter_preferred f reg = - let rec walk r w = - if not r.visited then begin - f r w; - begin match r.prefer with - [] -> () - | p -> r.visited <- true; - List.iter (fun (r1, w1) -> walk r1 (min w w1)) p; - r.visited <- false - end - end in - reg.visited <- true; - List.iter (fun (r, w) -> walk r w) reg.prefer; - reg.visited <- false - -(* Where to start the search for a suitable register. - Used to introduce some "randomness" in the choice between registers - with equal scores. This offers more opportunities for scheduling. *) - -let start_register = Array.create Proc.num_register_classes 0 - -(* Assign a location to a register, the best we can *) - -let assign_location reg = - let cl = Proc.register_class reg in - let first_reg = Proc.first_available_register.(cl) in - let num_regs = Proc.num_available_registers.(cl) in - let last_reg = first_reg + num_regs in - let score = Array.create num_regs 0 in - let best_score = ref (-1000000) and best_reg = ref (-1) in - let start = start_register.(cl) in - if num_regs > 0 then begin - (* Favor the registers that have been assigned to pseudoregs for which - we have a preference. If these pseudoregs have not been assigned - already, avoid the registers with which they conflict. *) - iter_preferred - (fun r w -> - match r.loc with - Reg n -> if n >= first_reg && n < last_reg then - score.(n - first_reg) <- score.(n - first_reg) + w - | Unknown -> - List.iter - (fun neighbour -> - match neighbour.loc with - Reg n -> if n >= first_reg && n < last_reg then - score.(n - first_reg) <- score.(n - first_reg) - w - | _ -> ()) - r.interf - | _ -> ()) - reg; - List.iter - (fun neighbour -> - (* Prohibit the registers that have been assigned - to our neighbours *) - begin match neighbour.loc with - Reg n -> if n >= first_reg && n < last_reg then - score.(n - first_reg) <- (-1000000) - | _ -> () - end; - (* Avoid the registers that have been assigned to pseudoregs - for which our neighbours have a preference *) - iter_preferred - (fun r w -> - match r.loc with - Reg n -> if n >= first_reg && n < last_reg then - score.(n - first_reg) <- score.(n - first_reg) - (w - 1) - (* w-1 to break the symmetry when two conflicting regs - have the same preference for a third reg. *) - | _ -> ()) - neighbour) - reg.interf; - (* Pick the register with the best score *) - for n = start to num_regs - 1 do - if score.(n) > !best_score then begin - best_score := score.(n); - best_reg := n - end - done; - for n = 0 to start - 1 do - if score.(n) > !best_score then begin - best_score := score.(n); - best_reg := n - end - done - end; - (* Found a register? *) - if !best_reg >= 0 then begin - reg.loc <- Reg(first_reg + !best_reg); - if Proc.rotate_registers then - start_register.(cl) <- (if start+1 >= num_regs then 0 else start+1) - end else begin - (* Sorry, we must put the pseudoreg in a stack location *) - let nslots = Proc.num_stack_slots.(cl) in - let score = Array.create nslots 0 in - (* Compute the scores as for registers *) - List.iter - (fun (r, w) -> - match r.loc with - Stack(Local n) -> if Proc.register_class r = cl then - score.(n) <- score.(n) + w - | Unknown -> - List.iter - (fun neighbour -> - match neighbour.loc with - Stack(Local n) -> - if Proc.register_class neighbour = cl - then score.(n) <- score.(n) - w - | _ -> ()) - r.interf - | _ -> ()) - reg.prefer; - List.iter - (fun neighbour -> - begin match neighbour.loc with - Stack(Local n) -> - if Proc.register_class neighbour = cl then - score.(n) <- (-1000000) - | _ -> () - end; - List.iter - (fun (r, w) -> - match r.loc with - Stack(Local n) -> if Proc.register_class r = cl then - score.(n) <- score.(n) - w - | _ -> ()) - neighbour.prefer) - reg.interf; - (* Pick the location with the best score *) - let best_score = ref (-1000000) and best_slot = ref (-1) in - for n = 0 to nslots - 1 do - if score.(n) > !best_score then begin - best_score := score.(n); - best_slot := n + done; + for n = 0 to start - 1 do + if score.(n) > !best_score then begin + best_score := score.(n); + best_reg := n + end + done + end; + (* Found a register? *) + if !best_reg >= 0 then begin + reg.loc <- Reg(first_reg + !best_reg); + if Proc.rotate_registers then + start_register.(cl) <- (let start = start + 1 in + if start >= num_regs then 0 else start) + end else begin + (* Sorry, we must put the pseudoreg in a stack location *) + let nslots = Proc.num_stack_slots.(cl) in + let score = Array.create nslots 0 in + (* Compute the scores as for registers *) + List.iter + (fun (r, w) -> + match r.loc with + Stack(Local n) -> score.(n) <- score.(n) + w + | Unknown -> + List.iter + (fun neighbour -> + match neighbour.loc with + Stack(Local n) -> score.(n) <- score.(n) - w + | _ -> ()) + r.interf + | _ -> ()) + reg.prefer; + List.iter + (fun neighbour -> + begin match neighbour.loc with + Stack(Local n) -> score.(n) <- (-1000000) + | _ -> () + end; + List.iter + (fun (r, w) -> + match r.loc with + Stack(Local n) -> score.(n) <- score.(n) - w + | _ -> ()) + neighbour.prefer) + reg.interf; + (* Pick the location with the best score *) + let best_score = ref (-1000000) and best_slot = ref (-1) in + for n = 0 to nslots - 1 do + if score.(n) > !best_score then begin + best_score := score.(n); + best_slot := n + end + done; + (* Found one? *) + if !best_slot >= 0 then + reg.loc <- Stack(Local !best_slot) + else begin + (* Allocate a new stack slot *) + reg.loc <- Stack(Local nslots); + Proc.num_stack_slots.(cl) <- nslots + 1 end - done; - (* Found one? *) - if !best_slot >= 0 then - reg.loc <- Stack(Local !best_slot) - else begin - (* Allocate a new stack slot *) - reg.loc <- Stack(Local nslots); - Proc.num_stack_slots.(cl) <- nslots + 1 - end - end; - (* Cancel the preferences of this register so that they don't influence - transitively the allocation of registers that prefer this reg. *) - reg.prefer <- [] + end; + (* Cancel the preferences of this register so that they don't influence + transitively the allocation of registers that prefer this reg. *) + reg.prefer <- [] in -let allocate_registers() = - (* First pass: preallocate spill registers - Second pass: compute the degrees - Third pass: determine coloring order by successive removals of regs - Fourth pass: assign registers in that order *) + (* Reset the stack slot counts *) for i = 0 to Proc.num_register_classes - 1 do Proc.num_stack_slots.(i) <- 0; - start_register.(i) <- 0 done; - List.iter allocate_spilled (Reg.all_registers()); - List.iter find_degree (Reg.all_registers()); - List.iter assign_location (remove_all_regs []) + + (* First pass: preallocate spill registers and split remaining regs + Second pass: assign locations to constrained regs + Third pass: assign locations to unconstrained regs *) + List.iter remove_reg (Reg.all_registers()); + OrderedRegSet.iter assign_location !constrained; + List.iter assign_location !unconstrained diff -Nru ocaml-3.12.1/asmcomp/coloring.mli ocaml-4.01.0/asmcomp/coloring.mli --- ocaml-3.12.1/asmcomp/coloring.mli 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/coloring.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: coloring.mli 2553 1999-11-17 18:59:06Z xleroy $ *) - (* Register allocation by coloring of the interference graph *) val allocate_registers: unit -> unit diff -Nru ocaml-3.12.1/asmcomp/comballoc.ml ocaml-4.01.0/asmcomp/comballoc.ml --- ocaml-3.12.1/asmcomp/comballoc.ml 2010-12-22 13:52:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/comballoc.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: comballoc.ml 10910 2010-12-22 13:52:24Z xleroy $ *) - (* Combine heap allocations occurring in the same basic block *) open Mach diff -Nru ocaml-3.12.1/asmcomp/comballoc.mli ocaml-4.01.0/asmcomp/comballoc.mli --- ocaml-3.12.1/asmcomp/comballoc.mli 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/comballoc.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: comballoc.mli 2553 1999-11-17 18:59:06Z xleroy $ *) - (* Combine heap allocations occurring in the same basic block *) val fundecl: Mach.fundecl -> Mach.fundecl diff -Nru ocaml-3.12.1/asmcomp/compilenv.ml ocaml-4.01.0/asmcomp/compilenv.ml --- ocaml-3.12.1/asmcomp/compilenv.ml 2010-05-19 11:29:38.000000000 +0000 +++ ocaml-4.01.0/asmcomp/compilenv.ml 2013-07-23 14:48:47.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: compilenv.ml 10424 2010-05-19 11:29:38Z xleroy $ *) - (* Compilation environments for compilation units *) open Config @@ -22,13 +20,16 @@ type error = Not_a_unit_info of string | Corrupted_unit_info of string - | Illegal_renaming of string * string + | Illegal_renaming of string * string * string exception Error of error let global_infos_table = (Hashtbl.create 17 : (string, unit_infos option) Hashtbl.t) +let structured_constants = + ref ([] : (string * bool * Lambda.structured_constant) list) + let current_unit = { ui_name = ""; ui_symbol = ""; @@ -55,6 +56,7 @@ Buffer.add_string b name; Buffer.contents b + let reset ?packname name = Hashtbl.clear global_infos_table; let symbol = symbolname_for_pack packname name in @@ -66,7 +68,8 @@ current_unit.ui_curry_fun <- []; current_unit.ui_apply_fun <- []; current_unit.ui_send_fun <- []; - current_unit.ui_force_link <- false + current_unit.ui_force_link <- false; + structured_constants := [] let current_unit_infos () = current_unit @@ -83,8 +86,7 @@ let read_unit_info filename = let ic = open_in_bin filename in try - let buffer = String.create (String.length cmx_magic_number) in - really_input ic buffer 0 (String.length cmx_magic_number); + let buffer = input_bytes ic (String.length cmx_magic_number) in if buffer <> cmx_magic_number then begin close_in ic; raise(Error(Not_a_unit_info filename)) @@ -99,8 +101,7 @@ let read_library_info filename = let ic = open_in_bin filename in - let buffer = String.create (String.length cmxa_magic_number) in - really_input ic buffer 0 (String.length cmxa_magic_number); + let buffer = input_bytes ic (String.length cmxa_magic_number) in if buffer <> cmxa_magic_number then raise(Error(Not_a_unit_info filename)); let infos = (input_value ic : library_infos) in @@ -113,7 +114,7 @@ let cmx_not_found_crc = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000" -let get_global_info global_ident = +let get_global_info global_ident = ( let modname = Ident.name global_ident in if modname = current_unit.ui_name then Some current_unit @@ -127,7 +128,7 @@ find_in_path_uncap !load_path (modname ^ ".cmx") in let (ui, crc) = read_unit_info filename in if ui.ui_name <> modname then - raise(Error(Illegal_renaming(ui.ui_name, filename))); + raise(Error(Illegal_renaming(modname, ui.ui_name, filename))); (Some ui, crc) with Not_found -> (None, cmx_not_found_crc) in @@ -136,6 +137,7 @@ Hashtbl.add global_infos_table modname infos; infos end +) let cache_unit_info ui = Hashtbl.add global_infos_table ui.ui_name (Some ui) @@ -200,14 +202,37 @@ current_unit.ui_imports_cmi <- Env.imported_units(); write_unit_info current_unit filename + + +let const_label = ref 0 + +let new_const_label () = + incr const_label; + !const_label + +let new_const_symbol () = + incr const_label; + make_symbol (Some (string_of_int !const_label)) + +let new_structured_constant cst global = + let lbl = new_const_symbol() in + structured_constants := (lbl, global, cst) :: !structured_constants; + lbl + +let structured_constants () = !structured_constants + (* Error report *) open Format let report_error ppf = function | Not_a_unit_info filename -> - fprintf ppf "%s@ is not a compilation unit description." filename + fprintf ppf "%a@ is not a compilation unit description." + Location.print_filename filename | Corrupted_unit_info filename -> - fprintf ppf "Corrupted compilation unit description@ %s" filename - | Illegal_renaming(modname, filename) -> - fprintf ppf "%s@ contains the description for unit@ %s" filename modname + fprintf ppf "Corrupted compilation unit description@ %a" + Location.print_filename filename + | Illegal_renaming(name, modname, filename) -> + fprintf ppf "%a@ contains the description for unit\ + @ %s when %s was expected" + Location.print_filename filename name modname diff -Nru ocaml-3.12.1/asmcomp/compilenv.mli ocaml-4.01.0/asmcomp/compilenv.mli --- ocaml-3.12.1/asmcomp/compilenv.mli 2010-05-19 11:29:38.000000000 +0000 +++ ocaml-4.01.0/asmcomp/compilenv.mli 2013-04-29 14:57:38.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,11 +10,8 @@ (* *) (***********************************************************************) -(* $Id: compilenv.mli 10424 2010-05-19 11:29:38Z xleroy $ *) - (* Compilation environments for compilation units *) -open Clambda open Cmx_format val reset: ?packname:string -> string -> unit @@ -51,9 +48,14 @@ (* Record the need of a currying (resp. application, message sending) function with the given arity *) +val new_const_symbol : unit -> string +val new_const_label : unit -> int +val new_structured_constant : Lambda.structured_constant -> bool -> string +val structured_constants : + unit -> (string * bool * Lambda.structured_constant) list val read_unit_info: string -> unit_infos * Digest.t - (* Read infos and CRC from a [.cmx] file. *) + (* Read infos and MD5 from a [.cmx] file. *) val write_unit_info: unit_infos -> string -> unit (* Save the given infos in the given file *) val save_unit_info: string -> unit @@ -72,7 +74,7 @@ type error = Not_a_unit_info of string | Corrupted_unit_info of string - | Illegal_renaming of string * string + | Illegal_renaming of string * string * string exception Error of error diff -Nru ocaml-3.12.1/asmcomp/debuginfo.ml ocaml-4.01.0/asmcomp/debuginfo.ml --- ocaml-3.12.1/asmcomp/debuginfo.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/debuginfo.ml 2012-07-30 18:04:46.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) (* *) @@ -31,14 +31,18 @@ dinfo_char_end = 0 } +(* PR#5643: cannot use (==) because Debuginfo values are marshalled *) +let is_none t = + t = none + let to_string d = - if d == none + if d = none then "" else Printf.sprintf "{%s:%d,%d-%d}" d.dinfo_file d.dinfo_line d.dinfo_char_start d.dinfo_char_end let from_location kind loc = - if loc.loc_ghost then none else + if loc == Location.none then none else { dinfo_kind = kind; dinfo_file = loc.loc_start.pos_fname; dinfo_line = loc.loc_start.pos_lnum; diff -Nru ocaml-3.12.1/asmcomp/debuginfo.mli ocaml-4.01.0/asmcomp/debuginfo.mli --- ocaml-3.12.1/asmcomp/debuginfo.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/debuginfo.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) (* *) @@ -12,7 +12,7 @@ type kind = Dinfo_call | Dinfo_raise -type t = { +type t = private { dinfo_kind: kind; dinfo_file: string; dinfo_line: int; @@ -22,6 +22,8 @@ val none: t +val is_none: t -> bool + val to_string: t -> string val from_location: kind -> Location.t -> t diff -Nru ocaml-3.12.1/asmcomp/emit.mli ocaml-4.01.0/asmcomp/emit.mli --- ocaml-3.12.1/asmcomp/emit.mli 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/emit.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: emit.mli 2553 1999-11-17 18:59:06Z xleroy $ *) - (* Generation of assembly code *) val fundecl: Linearize.fundecl -> unit diff -Nru ocaml-3.12.1/asmcomp/emitaux.ml ocaml-4.01.0/asmcomp/emitaux.ml --- ocaml-3.12.1/asmcomp/emitaux.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/emitaux.ml 2013-06-03 18:03:59.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,14 +10,9 @@ (* *) (***********************************************************************) -(* $Id: emitaux.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Common functions for emitting assembly code *) open Debuginfo -open Cmm -open Reg -open Linearize let output_channel = ref stdout @@ -136,24 +131,22 @@ let emit_frames a = let filenames = Hashtbl.create 7 in - let lbl_filenames = ref 200000 in let label_filename name = try Hashtbl.find filenames name with Not_found -> - let lbl = !lbl_filenames in + let lbl = Linearize.new_label () in Hashtbl.add filenames name lbl; - incr lbl_filenames; lbl in let emit_frame fd = a.efa_label fd.fd_lbl; - a.efa_16 (if fd.fd_debuginfo == Debuginfo.none + a.efa_16 (if Debuginfo.is_none fd.fd_debuginfo then fd.fd_frame_size else fd.fd_frame_size + 1); a.efa_16 (List.length fd.fd_live_offset); List.iter a.efa_16 fd.fd_live_offset; a.efa_align Arch.size_addr; - if fd.fd_debuginfo != Debuginfo.none then begin + if not (Debuginfo.is_none fd.fd_debuginfo) then begin let d = fd.fd_debuginfo in let line = min 0xFFFFF d.dinfo_line and char_start = min 0xFF d.dinfo_char_start @@ -189,3 +182,60 @@ List.exists (fun p -> isprefix p name) ["caml_apply"; "caml_curry"; "caml_send"; "caml_tuplify"] + +(* CFI directives *) + +let is_cfi_enabled () = + Config.asm_cfi_supported + +let cfi_startproc () = + if is_cfi_enabled () then + emit_string "\t.cfi_startproc\n" + +let cfi_endproc () = + if is_cfi_enabled () then + emit_string "\t.cfi_endproc\n" + +let cfi_adjust_cfa_offset n = + if is_cfi_enabled () then + begin + emit_string "\t.cfi_adjust_cfa_offset\t"; emit_int n; emit_string "\n"; + end + +(* Emit debug information *) + +(* This assoc list is expected to be very short *) +let file_pos_nums = + (ref [] : (string * int) list ref) + +(* Number of files *) +let file_pos_num_cnt = ref 1 + +(* Reset debug state at beginning of asm file *) +let reset_debug_info () = + file_pos_nums := []; + file_pos_num_cnt := 1 + +(* We only diplay .file if the file has not been seen before. We + display .loc for every instruction. *) +let emit_debug_info dbg = + if is_cfi_enabled () && + (!Clflags.debug || Config.with_frame_pointers) + && not (Debuginfo.is_none dbg) then begin + let line = dbg.Debuginfo.dinfo_line in + assert (line <> 0); (* clang errors out on zero line numbers *) + let file_name = dbg.Debuginfo.dinfo_file in + let file_num = + try List.assoc file_name !file_pos_nums + with Not_found -> + let file_num = !file_pos_num_cnt in + incr file_pos_num_cnt; + emit_string "\t.file\t"; + emit_int file_num; emit_char '\t'; + emit_string_literal file_name; emit_char '\n'; + file_pos_nums := (file_name,file_num) :: !file_pos_nums; + file_num in + emit_string "\t.loc\t"; + emit_int file_num; emit_char '\t'; + emit_int line; emit_char '\n' + end diff -Nru ocaml-3.12.1/asmcomp/emitaux.mli ocaml-4.01.0/asmcomp/emitaux.mli --- ocaml-3.12.1/asmcomp/emitaux.mli 2010-01-20 16:26:46.000000000 +0000 +++ ocaml-4.01.0/asmcomp/emitaux.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: emitaux.mli 9540 2010-01-20 16:26:46Z doligez $ *) - (* Common functions for emitting assembly code *) val output_channel: out_channel ref @@ -29,6 +27,9 @@ val emit_float64_split_directive: string -> string -> unit val emit_float32_directive: string -> string -> unit +val reset_debug_info: unit -> unit +val emit_debug_info: Debuginfo.t -> unit + type frame_descr = { fd_lbl: int; (* Return address *) fd_frame_size: int; (* Size of stack frame *) @@ -50,3 +51,7 @@ val emit_frames: emit_frame_actions -> unit val is_generic_function: string -> bool + +val cfi_startproc : unit -> unit +val cfi_endproc : unit -> unit +val cfi_adjust_cfa_offset : int -> unit diff -Nru ocaml-3.12.1/asmcomp/hppa/arch.ml ocaml-4.01.0/asmcomp/hppa/arch.ml --- ocaml-3.12.1/asmcomp/hppa/arch.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/hppa/arch.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,73 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: arch.ml 9547 2010-01-22 12:48:24Z doligez $ *) - -(* Specific operations for the HP PA-RISC processor *) - -open Misc -open Format - -(* Machine-specific command-line options *) - -let command_line_options = [] - -(* Specific operations *) - -type specific_operation = - Ishift1add - | Ishift2add - | Ishift3add - -(* Addressing modes *) - -type addressing_mode = - Ibased of string * int (* symbol + displ *) - | Iindexed of int (* reg + displ *) - -(* Sizes, endianness *) - -let big_endian = true - -let size_addr = 4 -let size_int = 4 -let size_float = 8 - -(* Operations on addressing modes *) - -let identity_addressing = Iindexed 0 - -let offset_addressing addr delta = - match addr with - Ibased(s, n) -> Ibased(s, n + delta) - | Iindexed n -> Iindexed(n + delta) - -let num_args_addressing = function - Ibased(s, n) -> 0 - | Iindexed n -> 1 - -(* Printing operations and addressing modes *) - -let print_addressing printreg addr ppf arg = - match addr with - | Ibased(s, n) -> - let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in - fprintf ppf "\"%s\"%s" s idx - | Iindexed n -> - let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in - fprintf ppf "%a%s" printreg arg.(0) idx - -let print_specific_operation printreg op ppf arg = - match op with - | Ishift1add -> fprintf ppf "%a << 1 + %a" printreg arg.(0) printreg arg.(1) - | Ishift2add -> fprintf ppf "%a << 2 + %a" printreg arg.(0) printreg arg.(1) - | Ishift3add -> fprintf ppf "%a << 3 + %a" printreg arg.(0) printreg arg.(1) diff -Nru ocaml-3.12.1/asmcomp/hppa/emit.mlp ocaml-4.01.0/asmcomp/hppa/emit.mlp --- ocaml-3.12.1/asmcomp/hppa/emit.mlp 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/hppa/emit.mlp 1970-01-01 00:00:00.000000000 +0000 @@ -1,1042 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: emit.mlp 9547 2010-01-22 12:48:24Z doligez $ *) - -(* Emission of HP PA-RISC assembly code *) - -(* Must come before open Reg... *) -module StringSet = - Set.Make(struct - type t = string - let compare = compare - end) - -open Location -open Misc -open Cmm -open Arch -open Proc -open Reg -open Mach -open Linearize -open Emitaux - -(* Tradeoff between code size and code speed *) - -let fastcode_flag = ref true - -(* Layout of the stack *) -(* Always keep the stack 8-aligned. *) - -let stack_offset = ref 0 - -let frame_size () = - let size = - !stack_offset + - 4 * num_stack_slots.(0) + 8 * num_stack_slots.(1) + - (if !contains_calls then 4 else 0) in - Misc.align size 8 - -let slot_offset loc cl = - match loc with - Incoming n -> -frame_size() - n - | Local n -> - if cl = 0 - then - !stack_offset - num_stack_slots.(1) * 8 - n * 4 - 4 - else - !stack_offset - n * 8 - 8 - | Outgoing n -> -n - -(* Output a label *) - -let emit_label lbl = - emit_string "L$"; emit_int lbl - -(* Output a symbol *) - -let emit_symbol s = - Emitaux.emit_symbol '$' s - -(* Output a pseudo-register *) - -let emit_reg r = - match r.loc with - Reg r -> emit_string (register_name r) - | _ -> assert false - -(* Output low address / high address prefixes *) - -let low_prefix = "RR%" -let high_prefix = "LR%" - -let is_immediate n = (n < 16) && (n >= -16) (* 5 bits *) - -let emit_int_low n = emit_string low_prefix; emit_int n -let emit_int_high n = emit_string high_prefix; emit_int n - -let emit_nativeint_low n = emit_string low_prefix; emit_nativeint n -let emit_nativeint_high n = emit_string high_prefix; emit_nativeint n - -let emit_symbol_low s = - `RR%{emit_symbol s}-$global$` - -let load_symbol_high s = - ` addil LR%{emit_symbol s}-$global$, %r27\n` - -let load_symbol_offset_high s ofs = - ` addil LR%{emit_symbol s}-$global$+{emit_int ofs}, %r27\n` - -(* Record imported and defined symbols *) - -let used_symbols = ref StringSet.empty -let defined_symbols = ref StringSet.empty -let called_symbols = ref StringSet.empty - -let use_symbol s = - used_symbols := StringSet.add s !used_symbols -let define_symbol s = - defined_symbols := StringSet.add s !defined_symbols -let call_symbol s = - used_symbols := StringSet.add s !used_symbols; - called_symbols := StringSet.add s !called_symbols - -(* An external symbol is code if either it is branched to, or - it is one of the caml_apply* caml_curry* caml_tuplify* special functions. *) - -let code_imports = ["caml_apply"; "caml_curry"; "caml_tuplify"] - -let match_prefix s pref = - String.length s >= String.length pref - && String.sub s 0 (String.length pref) = pref - -let emit_import s = - if not(StringSet.mem s !defined_symbols) then begin - ` .import {emit_symbol s}`; - if StringSet.mem s !called_symbols - || List.exists (match_prefix s) code_imports - then `, code\n` - else `, data\n` - end - -let emit_imports () = - StringSet.iter emit_import !used_symbols; - used_symbols := StringSet.empty; - defined_symbols := StringSet.empty; - called_symbols := StringSet.empty - -(* Output an integer load / store *) - -let is_offset n = (n < 8192) && (n >= -8192) (* 14 bits *) - -let is_offset_native n = - n < Nativeint.of_int 8192 && n >= Nativeint.of_int (-8192) - -let emit_load instr addr arg dst = - match addr with - Ibased(s, 0) -> - use_symbol s; - load_symbol_high s; - ` {emit_string instr} {emit_symbol_low s}(%r1), {emit_reg dst}\n` - | Ibased(s, ofs) -> - use_symbol s; - load_symbol_offset_high s ofs; - ` {emit_string instr} {emit_symbol_low s}+{emit_int ofs}(%r1), {emit_reg dst}\n` - | Iindexed ofs -> - if is_offset ofs then - ` {emit_string instr} {emit_int ofs}({emit_reg arg.(0)}), {emit_reg dst}\n` - else begin - ` addil {emit_int_high ofs}, {emit_reg arg.(0)}\n`; - ` {emit_string instr} {emit_int_low ofs}(%r1), {emit_reg dst}\n` - end - -let emit_store instr addr arg src = - match addr with - Ibased(s, 0) -> - use_symbol s; - load_symbol_high s; - ` {emit_string instr} {emit_reg src}, {emit_symbol_low s}(%r1)\n` - | Ibased(s, ofs) -> - use_symbol s; - load_symbol_offset_high s ofs; - ` {emit_string instr} {emit_reg src}, {emit_symbol_low s}+{emit_int ofs}(%r1)\n` - | Iindexed ofs -> - if is_offset ofs then - ` {emit_string instr} {emit_reg src}, {emit_int ofs}({emit_reg arg.(1)})\n` - else begin - ` addil {emit_int_high ofs}, {emit_reg arg.(0)}\n`; - ` {emit_string instr} {emit_reg src}, {emit_int_low ofs}(%r1)\n` - end - -(* Output a floating-point load / store *) - -let emit_float_load addr arg dst doubleword = - match addr with - Ibased(s, 0) -> - use_symbol s; - load_symbol_high s; - ` ldo {emit_symbol_low s}(%r1), %r1\n`; - ` fldws 0(%r1), {emit_reg dst}L\n`; - if doubleword then - ` fldws 4(%r1), {emit_reg dst}R\n` - | Ibased(s, ofs) -> - use_symbol s; - load_symbol_offset_high s ofs; - ` ldo {emit_symbol_low s}+{emit_int ofs}(%r1), %r1\n`; - ` fldws 0(%r1), {emit_reg dst}L\n`; - if doubleword then - ` fldws 4(%r1), {emit_reg dst}R\n` - | Iindexed ofs -> - if is_immediate ofs && (is_immediate (ofs+4) || not doubleword) - then begin - ` fldws {emit_int ofs}({emit_reg arg.(0)}), {emit_reg dst}L\n`; - if doubleword then - ` fldws {emit_int (ofs+4)}({emit_reg arg.(0)}), {emit_reg dst}R\n` - end else begin - if is_offset ofs then - ` ldo {emit_int ofs}({emit_reg arg.(0)}), %r1\n` - else begin - ` addil {emit_int_high ofs}, {emit_reg arg.(0)}\n`; - ` ldo {emit_int_low ofs}(%r1), %r1\n` - end; - ` fldws 0(%r1), {emit_reg dst}L\n`; - if doubleword then - ` fldws 4(%r1), {emit_reg dst}R\n` - end - -let emit_float_store addr arg src doubleword = - match addr with - Ibased(s, 0) -> - use_symbol s; - load_symbol_high s; - ` ldo {emit_symbol_low s}(%r1), %r1\n`; - ` fstws {emit_reg src}L, 0(%r1)\n`; - if doubleword then - ` fstws {emit_reg src}R, 4(%r1)\n` - | Ibased(s, ofs) -> - use_symbol s; - load_symbol_offset_high s ofs; - ` ldo {emit_symbol_low s}+{emit_int ofs}(%r1), %r1\n`; - ` fstws {emit_reg src}L, 0(%r1)\n`; - if doubleword then - ` fstws {emit_reg src}R, 4(%r1)\n` - | Iindexed ofs -> - if is_immediate ofs && (is_immediate (ofs+4) || not doubleword) - then begin - ` fstws {emit_reg src}L, {emit_int ofs}({emit_reg arg.(1)})\n`; - if doubleword then - ` fstws {emit_reg src}R, {emit_int(ofs+4)}({emit_reg arg.(1)})\n` - end else begin - if is_offset ofs then - ` ldo {emit_int ofs}({emit_reg arg.(1)}), %r1\n` - else begin - ` addil {emit_int_high ofs}, {emit_reg arg.(1)}\n`; - ` ldo {emit_int_low ofs}(%r1), %r1\n` - end; - ` fstws {emit_reg src}L, 0(%r1)\n`; - if doubleword then - ` fstws {emit_reg src}R, 4(%r1)\n` - end - -(* Output an align directive. *) - -let emit_align n = - ` .align {emit_int n}\n` - -(* Record live pointers at call points *) - -type frame_descr = - { fd_lbl: int; (* Return address *) - fd_frame_size: int; (* Size of stack frame *) - fd_live_offset: int list } (* Offsets/regs of live addresses *) - -let frame_descriptors = ref([] : frame_descr list) - -let record_frame live = - let lbl = new_label() in - let live_offset = ref [] in - Reg.Set.iter - (function - {typ = Addr; loc = Reg r} -> - live_offset := ((r lsl 1) + 1) :: !live_offset - | {typ = Addr; loc = Stack s} as reg -> - live_offset := slot_offset s (register_class reg) :: !live_offset - | _ -> ()) - live; - frame_descriptors := - { fd_lbl = lbl; - fd_frame_size = frame_size(); - fd_live_offset = !live_offset } :: !frame_descriptors; - `{emit_label lbl}:\n` - -let emit_frame fd = - ` .long {emit_label fd.fd_lbl} + 3\n`; - ` .short {emit_int fd.fd_frame_size}\n`; - ` .short {emit_int (List.length fd.fd_live_offset)}\n`; - List.iter - (fun n -> - ` .short {emit_int n}\n`) - fd.fd_live_offset; - emit_align 4 - -(* Record floating-point constants *) - -let float_constants = ref ([] : (int * string) list) - -let emit_float_constants () = - if Config.system = "hpux" then begin - ` .space $TEXT$\n`; - ` .subspa $LIT$\n` - end else - ` .text\n`; - emit_align 8; - List.iter - (fun (lbl, cst) -> - `{emit_label lbl}:`; - emit_float64_split_directive ".long" cst) - !float_constants; - float_constants := [] - -(* Describe the registers used to pass arguments to a C function *) - -let describe_call arg = - ` .CALL RTNVAL=NO`; - let pos = ref 0 in - for i = 0 to Array.length arg - 1 do - if !pos < 4 then begin - match arg.(i).typ with - Float -> `, ARGW{emit_int !pos}=FR, ARGW{emit_int(!pos + 1)}=FU`; - pos := !pos + 2 - | _ -> `, ARGW{emit_int !pos}=GR`; - pos := !pos + 1 - end - done; - `\n` - -(* Output a function call *) - -let emit_call s retreg = - call_symbol s; - ` bl {emit_symbol s}, {emit_string retreg}\n` - -(* Names of various instructions *) - -let name_for_int_operation = function - Iadd -> "add" - | Isub -> "sub" - | Iand -> "and" - | Ior -> "or" - | Ixor -> "xor" - | _ -> assert false - -let name_for_float_operation = function - Iaddf -> "fadd,dbl" - | Isubf -> "fsub,dbl" - | Imulf -> "fmpy,dbl" - | Idivf -> "fdiv,dbl" - | _ -> assert false - -let name_for_specific_operation = function - Ishift1add -> "sh1add" - | Ishift2add -> "sh2add" - | Ishift3add -> "sh3add" - -let name_for_int_comparison = function - Isigned Ceq -> "=" | Isigned Cne -> "<>" - | Isigned Cle -> "<=" | Isigned Cgt -> ">" - | Isigned Clt -> "<" | Isigned Cge -> ">=" - | Iunsigned Ceq -> "=" | Iunsigned Cne -> "<>" - | Iunsigned Cle -> "<<=" | Iunsigned Cgt -> ">>" - | Iunsigned Clt -> "<<" | Iunsigned Cge -> ">>=" - -let name_for_float_comparison cmp neg = - match cmp with - Ceq -> if neg then "=" else "!=" - | Cne -> if neg then "!=" else "=" - | Cle -> if neg then "<=" else "!<=" - | Cgt -> if neg then ">" else "!>" - | Clt -> if neg then "<" else "!<" - | Cge -> if neg then ">=" else "!>=" - -let negate_int_comparison = function - Isigned cmp -> Isigned(Cmm.negate_comparison cmp) - | Iunsigned cmp -> Iunsigned(Cmm.negate_comparison cmp) - -let swap_int_comparison = function - Isigned cmp -> Isigned(Cmm.swap_comparison cmp) - | Iunsigned cmp -> Iunsigned(Cmm.swap_comparison cmp) - - -(* Output the assembly code for an instruction *) - -(* Name of current function *) -let function_name = ref "" -(* Entry point for tail recursive calls *) -let tailrec_entry_point = ref 0 -(* Label of trap for out-of-range accesses *) -let range_check_trap = ref 0 - -let rec emit_instr i dslot = - match i.desc with - Lend -> () - | Lop(Imove | Ispill | Ireload) -> - let src = i.arg.(0) and dst = i.res.(0) in - begin match (src, dst) with - {loc = Reg rs; typ = (Int | Addr)}, {loc = Reg rd} -> - ` copy {emit_reg src}, {emit_reg dst}\n` - | {loc = Reg rs; typ = Float}, {loc = Reg rd; typ = Float} -> - ` fcpy,dbl {emit_reg src}, {emit_reg dst}\n` - | {loc = Reg rs; typ = (Int | Addr)}, {loc = Stack sd} -> - let ofs = slot_offset sd 0 in - ` stw {emit_reg src}, {emit_int ofs}(%r30)\n` - | {loc = Reg rs; typ = Float}, {loc = Stack sd} -> - let ofs = slot_offset sd 1 in - if is_immediate ofs then - ` fstds {emit_reg src}, {emit_int ofs}(%r30)\n` - else begin - ` ldo {emit_int ofs}(%r30), %r1\n`; - ` fstds {emit_reg src}, 0(%r1)\n` - end - | {loc = Stack ss; typ = (Int | Addr)}, {loc = Reg rd} -> - let ofs = slot_offset ss 0 in - ` ldw {emit_int ofs}(%r30), {emit_reg dst}\n` - | {loc = Stack ss; typ = Float}, {loc = Reg rd} -> - let ofs = slot_offset ss 1 in - if is_immediate ofs then - ` fldds {emit_int ofs}(%r30), {emit_reg dst}\n` - else begin - ` ldo {emit_int ofs}(%r30), %r1\n`; - ` fldds 0(%r1), {emit_reg dst}\n` - end - | (_, _) -> - assert false - end - | Lop(Iconst_int n) -> - if is_offset_native n then - ` ldi {emit_nativeint n}, {emit_reg i.res.(0)}\n` - else begin - ` ldil {emit_nativeint_high n}, {emit_reg i.res.(0)}\n`; - ` ldo {emit_nativeint_low n}({emit_reg i.res.(0)}), {emit_reg i.res.(0)}\n` - end - | Lop(Iconst_float s) -> - let lbl = new_label() in - float_constants := (lbl, s) :: !float_constants; - ` ldil {emit_string high_prefix}{emit_label lbl}, %r1\n`; - ` ldo {emit_string low_prefix}{emit_label lbl}(%r1), %r1\n`; - ` fldds 0(%r1), {emit_reg i.res.(0)}\n` - | Lop(Iconst_symbol s) -> - use_symbol s; - load_symbol_high s; - ` ldo {emit_symbol_low s}(%r1), {emit_reg i.res.(0)}\n` - | Lop(Icall_ind) -> - ` ble 0(4, {emit_reg i.arg.(0)})\n`; (* retaddr in %r31 *) - ` copy %r31, %r2\n`; (* in delay slot: save retaddr in %r2 *) - record_frame i.live - | Lop(Icall_imm s) -> - emit_call s "%r2"; - fill_delay_slot dslot; - record_frame i.live - | Lop(Itailcall_ind) -> - let n = frame_size() in - ` bv 0({emit_reg i.arg.(0)})\n`; - if !contains_calls (* in delay slot *) - then ` ldwm {emit_int(-n)}(%r30), %r2\n` - else ` ldo {emit_int(-n)}(%r30), %r30\n` - | Lop(Itailcall_imm s) -> - let n = frame_size() in - if s = !function_name then begin - ` b,n {emit_label !tailrec_entry_point}\n` - end else begin - emit_call s "%r0"; - if !contains_calls (* in delay slot *) - then ` ldwm {emit_int(-n)}(%r30), %r2\n` - else ` ldo {emit_int(-n)}(%r30), %r30\n` - end - | Lop(Iextcall(s, alloc)) -> - call_symbol s; - if alloc then begin - ` ldil LR%{emit_symbol s}, %r22\n`; - describe_call i.arg; - emit_call "caml_c_call" "%r2"; - ` ldo RR%{emit_symbol s}(%r22), %r22\n`; (* in delay slot *) - record_frame i.live - end else begin - describe_call i.arg; - emit_call s "%r2"; - fill_delay_slot dslot - end - | Lop(Istackoffset n) -> - ` ldo {emit_int n}(%r30), %r30\n`; - stack_offset := !stack_offset + n - | Lop(Iload(chunk, addr)) -> - let dest = i.res.(0) in - begin match chunk with - Byte_unsigned -> - emit_load "ldb" addr i.arg dest - | Byte_signed -> - emit_load "ldb" addr i.arg dest; - ` extrs {emit_reg dest}, 31, 8, {emit_reg dest}\n` - | Sixteen_unsigned -> - emit_load "ldh" addr i.arg dest - | Sixteen_signed -> - emit_load "ldh" addr i.arg dest; - ` extrs {emit_reg dest}, 31, 16, {emit_reg dest}\n` - | Single -> - emit_float_load addr i.arg dest false; - ` fcnvff,sgl,dbl {emit_reg dest}L, {emit_reg dest}\n` - | Double | Double_u -> - emit_float_load addr i.arg dest true - | _ -> - emit_load "ldw" addr i.arg dest - end - | Lop(Istore(chunk, addr)) -> - let src = i.arg.(0) in - begin match chunk with - Byte_unsigned | Byte_signed -> - emit_store "stb" addr i.arg src - | Sixteen_unsigned | Sixteen_signed -> - emit_store "sth" addr i.arg src - | Single -> - ` fcnvff,dbl,sgl {emit_reg src}, %fr31L\n`; - emit_float_store addr i.arg (phys_reg 127) (* %fr31 *) false - | Double | Double_u -> - emit_float_store addr i.arg src true - | _ -> - emit_store "stw" addr i.arg src - end - | Lop(Ialloc n) -> - if !fastcode_flag then begin - let lbl_cont = new_label() in - ` ldw 0(%r4), %r1\n`; - ` ldo {emit_int (-n)}(%r3), %r3\n`; - ` comb,>>= %r3, %r1, {emit_label lbl_cont}\n`; - ` addi 4, %r3, {emit_reg i.res.(0)}\n`; (* in delay slot *) - emit_call "caml_call_gc" "%r2"; - (* Cannot use %r1 to pass size, since clobbered by glue call code *) - ` ldi {emit_int n}, %r29\n`; (* in delay slot *) - record_frame i.live; - ` addi 4, %r3, {emit_reg i.res.(0)}\n`; - `{emit_label lbl_cont}:\n` - end else begin - emit_call "caml_allocN" "%r2"; - (* Cannot use %r1 either *) - ` ldi {emit_int n}, %r29\n`; (* in delay slot *) - record_frame i.live; - ` addi 4, %r3, {emit_reg i.res.(0)}\n` - end - | Lop(Iintop Imul) -> - ` stws,ma {emit_reg i.arg.(0)}, 8(%r30)\n`; - ` stw {emit_reg i.arg.(1)}, -4(%r30)\n`; - ` fldws -8(%r30), %fr31L\n`; - ` fldws -4(%r30), %fr31R\n`; - ` xmpyu %fr31L, %fr31R, %fr31\n`; - ` fstws %fr31R, -8(%r30)\n`; (* poor scheduling *) - ` ldws,mb -8(%r30), {emit_reg i.res.(0)}\n` - | Lop(Iintop Idiv) -> - (* Arguments are assumed to be in %r26 and %r25, result in %r29 *) - ` bl $$divI, %r31\n`; - fill_delay_slot dslot - | Lop(Iintop Imod) -> - (* Arguments are assumed to be in %r26 and %r25, result in %r29 *) - ` bl $$remI, %r31\n`; - fill_delay_slot dslot - | Lop(Iintop Ilsl) -> - ` subi 31, {emit_reg i.arg.(1)}, %r1\n`; - ` mtsar %r1\n`; - ` zvdep {emit_reg i.arg.(0)}, 32, {emit_reg i.res.(0)}\n` - | Lop(Iintop Ilsr) -> - ` mtsar {emit_reg i.arg.(1)}\n`; - ` vshd %r0, {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n` - | Lop(Iintop Iasr) -> - ` subi 31, {emit_reg i.arg.(1)}, %r1\n`; - ` mtsar %r1\n`; - ` vextrs {emit_reg i.arg.(0)}, 32, {emit_reg i.res.(0)}\n` - | Lop(Iintop(Icomp cmp)) -> - let comp = name_for_int_comparison(negate_int_comparison cmp) in - ` comclr,{emit_string comp} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`; - ` ldi 1, {emit_reg i.res.(0)}\n` - | Lop(Iintop Icheckbound) -> - if !range_check_trap = 0 then range_check_trap := new_label(); - ` comclr,>> {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, %r0\n`; - ` b,n {emit_label !range_check_trap}\n` - | Lop(Iintop op) -> - let instr = name_for_int_operation op in - ` {emit_string instr} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n` - | Lop(Iintop_imm(Iadd, n)) -> - ` addi {emit_int n}, {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n` - | Lop(Iintop_imm(Isub, n)) -> - ` addi {emit_int(-n)}, {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n` - | Lop(Iintop_imm(Idiv, n)) -> - let l = Misc.log2 n in - ` comclr,>= {emit_reg i.arg.(0)}, %r0, %r1\n`; - if not (l = 0) then - ` zdepi -1, 31, {emit_int l}, %r1\n` - else - ` xor %r1, %r1, %r1\n`; - ` add {emit_reg i.arg.(0)}, %r1, %r1\n`; - ` extrs %r1, {emit_int(31-l)}, {emit_int(32-l)}, {emit_reg i.res.(0)}\n` - | Lop(Iintop_imm(Imod, n)) -> - let l = Misc.log2 n in - ` comclr,>= {emit_reg i.arg.(0)}, %r0, %r1\n`; - if not (l = 0) then - ` zdepi -1, 31, {emit_int l}, %r1\n` - else - ` xor %r1, %r1, %r1\n`; - ` add {emit_reg i.arg.(0)}, %r1, %r1\n`; - ` depi 0, 31, {emit_int l}, %r1\n`; - ` sub {emit_reg i.arg.(0)}, %r1, {emit_reg i.res.(0)}\n` - | Lop(Iintop_imm(Ilsl, n)) -> - let n = n land 31 in - ` zdep {emit_reg i.arg.(0)}, {emit_int(31-n)}, {emit_int(32-n)}, {emit_reg i.res.(0)}\n` - | Lop(Iintop_imm(Ilsr, n)) -> - let n = n land 31 in - ` extru {emit_reg i.arg.(0)}, {emit_int(31-n)}, {emit_int(32-n)}, {emit_reg i.res.(0)}\n` - | Lop(Iintop_imm(Iasr, n)) -> - let n = n land 31 in - ` extrs {emit_reg i.arg.(0)}, {emit_int(31-n)}, {emit_int(32-n)}, {emit_reg i.res.(0)}\n` - | Lop(Iintop_imm(Icomp cmp, n)) -> - let comp = name_for_int_comparison(negate_int_comparison(swap_int_comparison cmp)) in - ` comiclr,{emit_string comp} {emit_int n}, {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n`; - ` ldi 1, {emit_reg i.res.(0)}\n` - | Lop(Iintop_imm(Icheckbound, n)) -> - if !range_check_trap = 0 then range_check_trap := new_label(); - ` comiclr,<< {emit_int n}, {emit_reg i.arg.(0)}, %r0\n`; - ` b,n {emit_label !range_check_trap}\n` - | Lop(Iintop_imm(op, n)) -> - assert false - | Lop(Iaddf | Isubf | Imulf | Idivf as op) -> - let instr = name_for_float_operation op in - ` {emit_string instr} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n` - | Lop(Inegf) -> - ` fsub,dbl 0, {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n` - | Lop(Iabsf) -> - ` fabs,dbl {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n` - | Lop(Ifloatofint) -> - ` stws,ma {emit_reg i.arg.(0)}, 8(%r30)\n`; - ` fldws,mb -8(%r30), %fr31L\n`; - ` fcnvxf,sgl,dbl %fr31L, {emit_reg i.res.(0)}\n` - | Lop(Iintoffloat) -> - ` fcnvfxt,dbl,sgl {emit_reg i.arg.(0)}, %fr31L\n`; - ` fstws,ma %fr31L, 8(%r30)\n`; - ` ldws,mb -8(%r30), {emit_reg i.res.(0)}\n` - | Lop(Ispecific sop) -> - let instr = name_for_specific_operation sop in - ` {emit_string instr} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n` - | Lreloadretaddr -> - let n = frame_size() in - ` ldw {emit_int(-n)}(%r30), %r2\n` - | Lreturn -> - let n = frame_size() in - ` bv 0(%r2)\n`; - ` ldo {emit_int(-n)}(%r30), %r30\n` (* in delay slot *) - | Llabel lbl -> - `{emit_label lbl}:\n` - | Lbranch lbl -> - begin match dslot with - None -> - ` b,n {emit_label lbl}\n` - | Some i -> - ` b {emit_label lbl}\n`; - emit_instr i None - end - | Lcondbranch(tst, lbl) -> - begin match tst with - Itruetest -> - emit_comib "<>" "=" 0 i.arg lbl dslot - | Ifalsetest -> - emit_comib "=" "<>" 0 i.arg lbl dslot - | Iinttest cmp -> - let comp = name_for_int_comparison cmp - and negcomp = - name_for_int_comparison(negate_int_comparison cmp) in - emit_comb comp negcomp i.arg lbl dslot - | Iinttest_imm(cmp, n) -> - let scmp = swap_int_comparison cmp in - let comp = name_for_int_comparison scmp - and negcomp = - name_for_int_comparison(negate_int_comparison scmp) in - emit_comib comp negcomp n i.arg lbl dslot - | Ifloattest(cmp, neg) -> - let comp = name_for_float_comparison cmp neg in - ` fcmp,dbl,{emit_string comp} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; - ` ftest\n`; - ` b {emit_label lbl}\n`; - fill_delay_slot dslot - | Ioddtest -> - emit_comib "OD" "EV" 0 i.arg lbl dslot - | Ieventest -> - emit_comib "EV" "OD" 0 i.arg lbl dslot - end - | Lcondbranch3(lbl0, lbl1, lbl2) -> - begin match lbl0 with - None -> () - | Some lbl -> emit_comib "=" "<>" 0 i.arg lbl None - end; - begin match lbl1 with - None -> () - | Some lbl -> emit_comib "=" "<>" 1 i.arg lbl None - end; - begin match lbl2 with - None -> () - | Some lbl -> emit_comib "=" "<>" 2 i.arg lbl None - end - | Lswitch jumptbl -> - ` blr {emit_reg i.arg.(0)}, 0\n`; - fill_delay_slot dslot; - for i = 0 to Array.length jumptbl - 1 do - ` b {emit_label jumptbl.(i)}\n`; - ` nop\n` - done - | Lsetuptrap lbl -> - ` bl {emit_label lbl}, %r1\n`; - fill_delay_slot dslot - | Lpushtrap -> - stack_offset := !stack_offset + 8; - ` stws,ma %r5, 8(%r30)\n`; - ` stw %r1, -4(%r30)\n`; - ` copy %r30, %r5\n` - | Lpoptrap -> - ` ldws,mb -8(%r30), %r5\n`; - stack_offset := !stack_offset - 8 - | Lraise -> - ` ldw -4(%r5), %r1\n`; - ` copy %r5, %r30\n`; - ` bv 0(%r1)\n`; - ` ldws,mb -8(%r30), %r5\n` (* in delay slot *) - -and fill_delay_slot = function - None -> ` nop\n` - | Some i -> emit_instr i None - -and emit_delay_slot = function - None -> () - | Some i -> emit_instr i None - -and emit_comb comp negcomp arg lbl dslot = - if lbl >= 0 then begin - ` comb,{emit_string comp} {emit_reg arg.(0)}, {emit_reg arg.(1)}, {emit_label lbl}\n`; - fill_delay_slot dslot - end else begin - emit_delay_slot dslot; - ` comclr,{emit_string negcomp} {emit_reg arg.(0)}, {emit_reg arg.(1)}, %r0\n`; - ` b,n {emit_label (-lbl)}\n` - end - -and emit_comib comp negcomp cst arg lbl dslot = - if lbl >= 0 then begin - ` comib,{emit_string comp} {emit_int cst}, {emit_reg arg.(0)}, {emit_label lbl}\n`; - fill_delay_slot dslot - end else begin - emit_delay_slot dslot; - ` comiclr,{emit_string negcomp} {emit_int cst}, {emit_reg arg.(0)}, %r0\n`; - ` b,n {emit_label (-lbl)}\n` - end - -(* Checks if a pseudo-instruction expands to exactly one machine instruction - that does not branch. *) - -let is_one_instr i = - match i.desc with - Lop op -> - begin match op with - Imove | Ispill | Ireload -> - begin match (i.arg.(0), i.res.(0)) with - ({typ = Float; loc = Stack s}, _) -> is_immediate(slot_offset s 1) - | (_, {typ = Float; loc = Stack s}) -> is_immediate(slot_offset s 1) - | (_, _) -> true - end - | Iconst_int n -> is_offset_native n - | Istackoffset _ -> true - | Iload(_, Iindexed n) -> i.res.(0).typ <> Float & is_offset n - | Istore(_, Iindexed n) -> i.arg.(0).typ <> Float & is_offset n - | Iintop(Iadd | Isub | Iand | Ior | Ixor) -> true - | Iintop_imm((Iadd | Isub | Ilsl | Ilsr | Iasr), _) -> true - | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf -> true - | Ispecific _ -> true - | _ -> false - end - | Lreloadretaddr -> true - | _ -> false - -let no_interference res arg = - try - for i = 0 to Array.length arg - 1 do - for j = 0 to Array.length res - 1 do - if arg.(i).loc = res.(j).loc then raise Exit - done - done; - true - with Exit -> - false - -(* Emit a sequence of instructions, trying to fill delay slots for branches *) - -let rec emit_all i = - match i with - {desc = Lend} -> () - | {next = {desc = Lop(Icall_imm _) - | Lop(Iextcall(_, false)) - | Lop(Iintop(Idiv | Imod)) - | Lbranch _ - | Lsetuptrap _ }} - when is_one_instr i -> - emit_instr i.next (Some i); - emit_all i.next.next - | {next = {desc = Lcondbranch(_, _) | Lswitch _}} - when is_one_instr i & no_interference i.res i.next.arg -> - emit_instr i.next (Some i); - emit_all i.next.next - | _ -> - emit_instr i None; - emit_all i.next - -(* Estimate the size of an instruction, in actual HPPA instructions *) - -let is_float_stack r = - match r with {loc = Stack _; typ = Float} -> true | _ -> false - -let sizeof_instr i = - match i.desc with - Lend -> 0 - | Lop op -> - begin match op with - Imove | Ispill | Ireload -> - if is_float_stack i.arg.(0) || is_float_stack i.res.(0) - then 2 (* ldo/fxxx *) else 1 - | Iconst_int n -> - if is_offset_native n then 1 else 2 (* ldi or ldil/ldo *) - | Iconst_float _ -> 3 (* ldil/ldo/fldds *) - | Iconst_symbol _ -> 2 (* addil/ldo *) - | Icall_ind -> 2 (* ble/copy *) - | Icall_imm _ -> 2 (* bl/nop *) - | Itailcall_ind -> 2 (* bv/ldwm *) - | Itailcall_imm _ -> 2 (* bl/ldwm *) - | Iextcall(_, alloc) -> - if alloc then 3 (* ldil/bl/ldo *) else 2 (* bl/nop *) - | Istackoffset _ -> 1 (* ldo *) - | Iload(chunk, addr) -> - if i.res.(0).typ = Float - then 4 (* addil/ldo/fldws/fldws *) - else (match addr with Iindexed ofs when is_offset ofs -> 1 | _ -> 2) - + (match chunk with Byte_signed -> 1 | Sixteen_signed -> 1 | _ -> 0) - | Istore(chunk, addr) -> - if i.arg.(0).typ = Float - then 4 (* addil/ldo/fstws/fstws *) - else (match addr with Iindexed ofs when is_offset ofs -> 1 | _ -> 2) - | Ialloc _ -> if !fastcode_flag then 7 else 3 - | Iintop Imul -> 7 - | Iintop(Idiv | Imod) -> 3 (* ldil/ble/nop *) - | Iintop Ilsl -> 3 (* subi/mtsar/zvdep *) - | Iintop Ilsr -> 2 (* mtsar/vshd *) - | Iintop Iasr -> 3 (* subi/mtsar/vextrs *) - | Iintop(Icomp _) -> 2 (* comclr/ldi *) - | Iintop Icheckbound -> 2 (* comclr/b,n *) - | Iintop _ -> 1 - | Iintop_imm(Idiv, _) -> 4 (* comclr/zdepi/add/extrs *) - | Iintop_imm(Imod, _) -> 5 (* comclr/zdepi/add/extrs/sub *) - | Iintop_imm(Icomp _, _) -> 2 (* comiclr/ldi *) - | Iintop_imm(Icheckbound, _) -> 2 (* comiclr/b,n *) - | Iintop_imm(_, _) -> 1 - | Ifloatofint -> 3 (* stws,ma/fldws,mb/fcnvxf *) - | Iintoffloat -> 3 (* fcnfxt/fstws/ldws *) - | _ (* Inegf|Iabsf|Iaddf|Isubf|Imulf|Idivf|Ispecific _ *) -> 1 - end - | Lreloadretaddr -> 1 - | Lreturn -> 2 - | Llabel _ -> 0 - | Lbranch _ -> 1 (* b,n *) - | Lcondbranch(Ifloattest(_, _), _) -> 4 (* fcmp/ftest/b/nop *) - | Lcondbranch(_, _) -> 2 (* comb/nop or comclr/b,n *) - | Lcondbranch3(_, _, _) -> 6 (* worst case: three comib/nop or comclr/b,n *) - | Lswitch tbl -> 2 + 2 * Array.length tbl (* blr/nop b/nop *) - | Lsetuptrap _ -> 2 (* bl/nop *) - | Lpushtrap -> 3 (* stws,ma/stw/copy *) - | Lpoptrap -> 1 (* ldws,mb *) - | Lraise -> 4 (* ldw/copy/bv/ldws,mb *) - -(* Estimate the position of all labels in function body - and rewrite long conditional branches with a negative label. *) - -let fixup_cond_branches funbody = - let label_position = - (Hashtbl.create 87 : (label, int) Hashtbl.t) in - let rec estimate_labels pos i = - match i.desc with - Lend -> () - | Llabel lbl -> - Hashtbl.add label_position lbl pos; estimate_labels pos i.next - | _ -> estimate_labels (pos + sizeof_instr i) i.next in - let long_branch currpos lbl = - try - let displ = Hashtbl.find label_position lbl - currpos in - (* Branch offset is stored in 12 bits, giving a range of - -2048 to +2047. Here, we allow 10% error in estimating - the code positions. *) - displ < -1843 || displ > 1842 - with Not_found -> - assert false in - let rec fix_branches pos i = - match i.desc with - Lend -> () - | Lcondbranch(tst, lbl) -> - if long_branch pos lbl then i.desc <- Lcondbranch(tst, -lbl); - fix_branches (pos + sizeof_instr i) i.next - | Lcondbranch3(opt1, opt2, opt3) -> - let fix_opt = function - None -> None - | Some lbl -> Some(if long_branch pos lbl then -lbl else lbl) in - i.desc <- Lcondbranch3(fix_opt opt1, fix_opt opt2, fix_opt opt3); - fix_branches (pos + sizeof_instr i) i.next - | _ -> - fix_branches (pos + sizeof_instr i) i.next in - estimate_labels 0 funbody; - fix_branches 0 funbody - -(* Emission of a function declaration *) - -let fundecl fundecl = - fixup_cond_branches fundecl.fun_body; - function_name := fundecl.fun_name; - fastcode_flag := fundecl.fun_fast; - tailrec_entry_point := new_label(); - stack_offset := 0; - float_constants := []; - define_symbol fundecl.fun_name; - range_check_trap := 0; - let n = frame_size() in - begin match Config.system with - | "hpux" -> - ` .code\n`; - ` .align 4\n`; - ` .export {emit_symbol fundecl.fun_name}, entry, priv_lev=3\n`; - `{emit_symbol fundecl.fun_name}:\n`; - ` .proc\n`; - if !contains_calls then - ` .callinfo frame={emit_int n}, calls, save_rp\n` - else - ` .callinfo frame={emit_int n}, no_calls\n`; - ` .entry\n` - | "linux" | "gnu" -> - ` .text\n`; - ` .align 8\n`; - ` .globl {emit_symbol fundecl.fun_name}\n`; - `{emit_symbol fundecl.fun_name}:\n` - | _ -> - assert false - end; - if !contains_calls then - ` stwm %r2, {emit_int n}(%r30)\n` - else if n > 0 then - ` ldo {emit_int n}(%r30), %r30\n`; - `{emit_label !tailrec_entry_point}:\n`; - emit_all fundecl.fun_body; - if !range_check_trap > 0 then begin - `{emit_label !range_check_trap}:\n`; - emit_call "caml_ml_array_bound_error" "%r31"; - ` nop\n` - end; - if Config.system = "hpux"then begin - ` .exit\n`; - ` .procend\n` - end; - emit_float_constants() - -(* Emission of data *) - -let declare_global s = - define_symbol s; - if Config.system = "hpux" - then ` .export {emit_symbol s}, data\n` - else ` .globl {emit_symbol s}\n` - -let emit_item = function - Cglobal_symbol s -> - declare_global s - | Cdefine_symbol s -> - define_symbol s; - `{emit_symbol s}:\n` - | Cdefine_label lbl -> - `{emit_label (lbl + 100000)}:\n` - | Cint8 n -> - ` .byte {emit_int n}\n` - | Cint16 n -> - ` .short {emit_int n}\n` - | Cint32 n -> - ` .long {emit_nativeint n}\n` - | Cint n -> - ` .long {emit_nativeint n}\n` - | Csingle f -> - emit_float32_directive ".long" f - | Cdouble f -> - emit_float64_split_directive ".long" f - | Csymbol_address s -> - use_symbol s; - ` .long {emit_symbol s}\n` - | Clabel_address lbl -> - ` .long {emit_label(lbl + 100000)}\n` - | Cstring s -> - emit_string_directive " .ascii " s - | Cskip n -> - if n > 0 then - if Config.system = "hpux" - then ` .block {emit_int n}\n` - else ` .space {emit_int n}\n` - | Calign n -> - emit_align n - -let data l = - ` .data\n`; - List.iter emit_item l - -(* Beginning / end of an assembly file *) - -let begin_assembly() = - if Config.system = "hpux" then begin - ` .space $PRIVATE$\n`; - ` .subspa $DATA$,quad=1,align=8,access=31\n`; - ` .subspa $BSS$,quad=1,align=8,access=31,zero,sort=82\n`; - ` .space $TEXT$\n`; - ` .subspa $LIT$,quad=0,align=8,access=44\n`; - ` .subspa $CODE$,quad=0,align=8,access=44,code_only\n`; - ` .import $global$, data\n`; - ` .import $$divI, millicode\n`; - ` .import $$remI, millicode\n` - end; - used_symbols := StringSet.empty; - defined_symbols := StringSet.empty; - called_symbols := StringSet.empty; - let lbl_begin = Compilenv.make_symbol (Some "data_begin") in - ` .data\n`; - declare_global lbl_begin; - `{emit_symbol lbl_begin}:\n`; - let lbl_begin = Compilenv.make_symbol (Some "code_begin") in - ` .code\n`; - declare_global lbl_begin; - `{emit_symbol lbl_begin}:\n` - - -let end_assembly() = - ` .code\n`; - let lbl_end = Compilenv.make_symbol (Some "code_end") in - declare_global lbl_end; - `{emit_symbol lbl_end}:\n`; - ` .data\n`; - let lbl_end = Compilenv.make_symbol (Some "data_end") in - declare_global lbl_end; - `{emit_symbol lbl_end}:\n`; - ` .long 0\n`; - let lbl = Compilenv.make_symbol (Some "frametable") in - declare_global lbl; - `{emit_symbol lbl}:\n`; - ` .long {emit_int (List.length !frame_descriptors)}\n`; - List.iter emit_frame !frame_descriptors; - frame_descriptors := []; - emit_imports() diff -Nru ocaml-3.12.1/asmcomp/hppa/proc.ml ocaml-4.01.0/asmcomp/hppa/proc.ml --- ocaml-3.12.1/asmcomp/hppa/proc.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/hppa/proc.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,224 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: proc.ml 9547 2010-01-22 12:48:24Z doligez $ *) - -(* Description of the HP PA-RISC processor *) - -open Misc -open Cmm -open Reg -open Arch -open Mach - -(* Registers available for register allocation *) - -(* Register map: - %r0 always zero - %r1 temporary, target of ADDIL - %r2 return address - %r3 allocation pointer - %r4 allocation limit - %r5 trap pointer - %r6 - %r26 general purpose - %r27 global pointer - %r28 - %r29 general purpose, C function results - %r30 stack pointer - %r31 temporary, used by BLE - - %fr0 - %fr3 float status info - %fr4 - %fr30 general purpose - %fr31 temporary *) - -let int_reg_name = [| - (* 0-4 *) "%r6"; "%r7"; "%r8"; "%r9"; "%r10"; - (* 5-10 *) "%r11"; "%r12"; "%r13"; "%r14"; "%r15"; "%r16"; - (* 11-16 *) "%r17"; "%r18"; "%r19"; "%r20"; "%r21"; "%r22"; - (* 17-20 *) "%r23"; "%r24"; "%r25"; "%r26"; - (* 21-22 *) "%r28"; "%r29" -|] - -let float_reg_name = [| - (* 100-105 *) "%fr4"; "%fr5"; "%fr6"; "%fr7"; "%fr8"; "%fr9"; - (* 106-111 *) "%fr10"; "%fr11"; "%fr12"; "%fr13"; "%fr14"; "%fr15"; - (* 112-117 *) "%fr16"; "%fr17"; "%fr18"; "%fr19"; "%fr20"; "%fr21"; - (* 118-123 *) "%fr22"; "%fr23"; "%fr24"; "%fr25"; "%fr26"; "%fr27"; - (* 124-127 *) "%fr28"; "%fr29"; "%fr30"; "%fr31" -|] - -let num_register_classes = 2 - -let register_class r = - match r.typ with - Int -> 0 - | Addr -> 0 - | Float -> 1 - -let num_available_registers = [| 23; 27 |] - -let first_available_register = [| 0; 100 |] - -let register_name r = - if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100) - -let rotate_registers = true - -(* Representation of hard registers by pseudo-registers *) - -let hard_int_reg = - let v = Array.create 23 Reg.dummy in - for i = 0 to 22 do v.(i) <- Reg.at_location Int (Reg i) done; - v - -let hard_float_reg = - let v = Array.create 28 Reg.dummy in - for i = 0 to 27 do v.(i) <- Reg.at_location Float (Reg(100 + i)) done; - v - -let all_phys_regs = - Array.append hard_int_reg (Array.sub hard_float_reg 0 27) - (* No need to include the left/right parts of float registers *) - -let phys_reg n = - if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100) - -let stack_slot slot ty = - Reg.at_location ty (Stack slot) - -(* Instruction selection *) - -let word_addressed = false - -(* Calling conventions *) - -let calling_conventions first_int last_int first_float last_float make_stack - arg = - let loc = Array.create (Array.length arg) Reg.dummy in - let int = ref first_int in - let float = ref first_float in - let ofs = ref 0 in - for i = 0 to Array.length arg - 1 do - match arg.(i).typ with - Int | Addr as ty -> - if !int >= last_int then begin - loc.(i) <- phys_reg !int; - decr int - end else begin - ofs := !ofs + size_int; - loc.(i) <- stack_slot (make_stack !ofs) ty - end - | Float -> - if !float <= last_float then begin - loc.(i) <- phys_reg !float; - incr float - end else begin - ofs := Misc.align (!ofs + size_float) 8; - loc.(i) <- stack_slot (make_stack !ofs) Float - end - done; - (loc, Misc.align !ofs 8) (* Keep stack 8-aligned *) - -let incoming ofs = Incoming ofs -let outgoing ofs = Outgoing ofs -let not_supported ofs = fatal_error "Proc.loc_results: cannot call" - -(* Arguments and results: %r26-%r19, %fr4-%fr11. *) - -let loc_arguments arg = - calling_conventions 20 13 100 107 outgoing arg -let loc_parameters arg = - let (loc, ofs) = calling_conventions 20 13 100 107 incoming arg in loc -let loc_results res = - let (loc, ofs) = calling_conventions 20 13 100 107 not_supported res in loc - -(* Calling C functions: - when all arguments are integers, use %r26 - %r23, - then -52(%r30), -56(%r30), etc. - When some arguments are floats, we handle a couple of cases by hand - and fail otherwise. *) - -let loc_external_arguments arg = - match List.map register_class (Array.to_list arg) with - [1] -> ([| phys_reg 101 |], 56) (* %fr5 *) - | [1; 1] -> ([| phys_reg 101; phys_reg 103 |], 56) (* %fr5, %fr7 *) - | [1; 0] -> ([| phys_reg 101; phys_reg 18 |], 56) (* %fr5, %r24 *) - | [0; 1] -> ([| phys_reg 20; phys_reg 103 |], 56) (* %r26, %fr7 *) - | _ -> - let loc = Array.create (Array.length arg) Reg.dummy in - let int = ref 20 in - let ofs = ref 48 in - for i = 0 to Array.length arg - 1 do - match arg.(i).typ with - Int | Addr as ty -> - if !int >= 17 then begin - loc.(i) <- phys_reg (!int); - decr int - end else begin - ofs := !ofs + 4; - loc.(i) <- stack_slot (Outgoing !ofs) ty - end - | Float -> - fatal_error "Proc.external_calling_conventions: cannot call" - done; - (loc, Misc.align !ofs 8) - -let loc_external_results res = - let (loc, ofs) = calling_conventions 21 21 100 100 not_supported res in loc - -let loc_exn_bucket = phys_reg 20 (* %r26 *) - -(* Registers destroyed by operations *) - -let destroyed_at_c_call = (* %r3 - %r18, %fr12 - %fr21 preserved *) - Array.of_list(List.map phys_reg - [13;14;15;16;17;18;19;20;21;22; - 100;101;102;103;104;105;106;107;118;119;120;121;122;123;124;125;126]) - -let destroyed_by_millicode = (* %r25, %r26, %r28, %r29 -- more? *) - [| phys_reg 19; phys_reg 20; phys_reg 21; phys_reg 22 |] - -let destroyed_by_alloc = [| phys_reg 22 |] (* %r29 *) - -let destroyed_at_oper = function - Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs - | Iop(Iextcall(_, false)) -> destroyed_at_c_call - | Iop(Iintop(Idiv | Imod)) -> destroyed_by_millicode - | Iop(Ialloc _) -> destroyed_by_alloc - | _ -> [||] - -let destroyed_at_raise = all_phys_regs - -(* Maximal register pressure *) - -let safe_register_pressure = function - Iextcall(_, _) -> 16 - | Iintop(Idiv | Imod) -> 19 - | _ -> 23 - -let max_register_pressure = function - Iextcall(_, _) -> [| 16; 19 |] - | Iintop(Idiv | Imod) -> [| 19; 27 |] - | _ -> [| 23; 27 |] - -(* Layout of the stack *) - -let num_stack_slots = [| 0; 0 |] -let contains_calls = ref false - -(* Calling the assembler *) - -let assemble_file infile outfile = - Ccomp.command (Config.asm ^ " -o " ^ - Filename.quote outfile ^ " " ^ Filename.quote infile) - -open Clflags;; -open Config;; diff -Nru ocaml-3.12.1/asmcomp/hppa/reload.ml ocaml-4.01.0/asmcomp/hppa/reload.ml --- ocaml-3.12.1/asmcomp/hppa/reload.ml 2008-01-11 16:13:18.000000000 +0000 +++ ocaml-4.01.0/asmcomp/hppa/reload.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,38 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: reload.ml 8768 2008-01-11 16:13:18Z doligez $ *) - -(* Reloading for the HPPA *) - - -open Cmm -open Arch -open Reg -open Mach -open Proc - -class reload = object (self) - -inherit Reloadgen.reload_generic as super - -method reload_operation op arg res = - match op with - Iintop(Idiv | Imod) - | Iintop_imm((Idiv | Imod), _) -> (arg, res) - | _ -> super#reload_operation op arg res -end - - - -let fundecl f = - (new reload)#fundecl f diff -Nru ocaml-3.12.1/asmcomp/hppa/scheduling.ml ocaml-4.01.0/asmcomp/hppa/scheduling.ml --- ocaml-3.12.1/asmcomp/hppa/scheduling.ml 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/hppa/scheduling.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,59 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: scheduling.ml 2553 1999-11-17 18:59:06Z xleroy $ *) - -(* Instruction scheduling for the HPPA *) - -open Arch -open Mach - -class scheduler = object (self) - -inherit Schedgen.scheduler_generic - -(* Latencies (in cycles). Roughly based on the ``Mustang'' chips. *) - -method oper_latency = function - Ireload -> 2 - | Iload(_, _) -> 2 - | Iconst_float _ -> 2 (* turned into a load *) - | Iintop Imul -> 2 (* ends up with a load *) - | Iaddf | Isubf | Imulf -> 3 - | Idivf -> 12 - | _ -> 1 - -(* Issue cycles. Rough approximations. *) - -method oper_issue_cycles = function - Iconst_float _ -> 3 - | Iconst_symbol _ -> 2 - | Iload(_, Ibased(_, _)) -> 2 - | Istore(_, Ibased(_, _)) -> 2 - | Ialloc _ -> 5 - | Iintop Imul -> 10 - | Iintop Ilsl -> 3 - | Iintop Ilsr -> 2 - | Iintop Iasr -> 3 - | Iintop(Icomp _) -> 2 - | Iintop(Icheckbound) -> 2 - | Iintop_imm(Idiv, _) -> 4 - | Iintop_imm(Imod, _) -> 5 - | Iintop_imm(Icomp _, _) -> 2 - | Iintop_imm(Icheckbound, _) -> 2 - | Ifloatofint -> 4 - | Iintoffloat -> 4 - | _ -> 1 - -end - -let fundecl f = (new scheduler)#schedule_fundecl f diff -Nru ocaml-3.12.1/asmcomp/hppa/selection.ml ocaml-4.01.0/asmcomp/hppa/selection.ml --- ocaml-3.12.1/asmcomp/hppa/selection.ml 2010-04-22 12:51:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/hppa/selection.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,109 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1997 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: selection.ml 10296 2010-04-22 12:51:06Z xleroy $ *) - -(* Instruction selection for the HPPA processor *) - -open Misc -open Cmm -open Reg -open Arch -open Proc -open Mach - -let shiftadd = function - 2 -> Ishift1add - | 4 -> Ishift2add - | 8 -> Ishift3add - | _ -> fatal_error "Proc_hppa.shiftadd" - -class selector = object (self) - -inherit Selectgen.selector_generic as super - -method is_immediate n = (n < 16) && (n >= -16) (* 5 bits *) - -method select_addressing = function - Cconst_symbol s -> - (Ibased(s, 0), Ctuple []) - | Cop(Cadda, [Cconst_symbol s; Cconst_int n]) -> - (Ibased(s, n), Ctuple []) - | Cop(Cadda, [arg; Cconst_int n]) -> - (Iindexed n, arg) - | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) -> - (Iindexed n, Cop(Cadda, [arg1; arg2])) - | arg -> - (Iindexed 0, arg) - -method! select_operation op args = - match (op, args) with - (* Recognize shift-add operations. *) - ((Caddi|Cadda), - [arg2; Cop(Clsl, [arg1; Cconst_int(1|2|3 as shift)])]) -> - (Ispecific(shiftadd(1 lsl shift)), [arg1; arg2]) - | ((Caddi|Cadda), - [arg2; Cop(Cmuli, [arg1; Cconst_int(2|4|8 as mult)])]) -> - (Ispecific(shiftadd mult), [arg1; arg2]) - | ((Caddi|Cadda), - [arg2; Cop(Cmuli, [Cconst_int(2|4|8 as mult); arg1])]) -> - (Ispecific(shiftadd mult), [arg1; arg2]) - | (Caddi, [Cop(Clsl, [arg1; Cconst_int(1|2|3 as shift)]); arg2]) -> - (Ispecific(shiftadd(1 lsl shift)), [arg1; arg2]) - | (Caddi, [Cop(Cmuli, [arg1; Cconst_int(2|4|8 as mult)]); arg2]) -> - (Ispecific(shiftadd mult), [arg1; arg2]) - | (Caddi, [Cop(Cmuli, [Cconst_int(2|4|8 as mult); arg1]); arg2]) -> - (Ispecific(shiftadd mult), [arg1; arg2]) - (* Prevent the recognition of some immediate arithmetic operations *) - (* Cmuli : -> Ilsl if power of 2 - Cdivi, Cmodi : only if power of 2 - Cand, Cor, Cxor : never *) - | (Cmuli, ([arg1; Cconst_int n] as args)) -> - let l = Misc.log2 n in - if n = 1 lsl l - then (Iintop_imm(Ilsl, l), [arg1]) - else (Iintop Imul, args) - | (Cmuli, ([Cconst_int n; arg1] as args)) -> - let l = Misc.log2 n in - if n = 1 lsl l - then (Iintop_imm(Ilsl, l), [arg1]) - else (Iintop Imul, args) - | (Cmuli, args) -> (Iintop Imul, args) - | (Cdivi, [arg1; Cconst_int n]) when n = 1 lsl (Misc.log2 n) -> - (Iintop_imm(Idiv, n), [arg1]) - | (Cdivi, args) -> (Iintop Idiv, args) - | (Cmodi, [arg1; Cconst_int n]) when n = 1 lsl (Misc.log2 n) -> - (Iintop_imm(Imod, n), [arg1]) - | (Cmodi, args) -> (Iintop Imod, args) - | (Cand, args) -> (Iintop Iand, args) - | (Cor, args) -> (Iintop Ior, args) - | (Cxor, args) -> (Iintop Ixor, args) - | _ -> - super#select_operation op args - -(* Deal with register constraints *) - -method! insert_op_debug op dbg rs rd = - match op with - Iintop(Idiv | Imod) -> (* handled via calls to millicode *) - let rs' = [|phys_reg 20; phys_reg 19|] (* %r26, %r25 *) - and rd' = [|phys_reg 22|] (* %r29 *) in - self#insert_moves rs rs'; - self#insert_debug (Iop op) dbg rs' rd'; - self#insert_moves rd' rd; - rd - | _ -> - super#insert_op_debug op dbg rs rd - -end - -let fundecl f = (new selector)#emit_fundecl f diff -Nru ocaml-3.12.1/asmcomp/i386/arch.ml ocaml-4.01.0/asmcomp/i386/arch.ml --- ocaml-3.12.1/asmcomp/i386/arch.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/i386/arch.ml 2012-11-09 16:15:29.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: arch.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Machine-specific command-line options *) let fast_math = ref false @@ -22,7 +20,6 @@ (* Specific operations for the Intel 386 processor *) -open Misc open Format type addressing_mode = @@ -59,6 +56,12 @@ let size_int = 4 let size_float = 8 +let allow_unaligned_access = true + +(* Behavior of division *) + +let division_crashes_on_overflow = true + (* Operations on addressing modes *) let identity_addressing = Iindexed 0 diff -Nru ocaml-3.12.1/asmcomp/i386/emit.mlp ocaml-4.01.0/asmcomp/i386/emit.mlp --- ocaml-3.12.1/asmcomp/i386/emit.mlp 2011-03-13 13:33:17.000000000 +0000 +++ ocaml-4.01.0/asmcomp/i386/emit.mlp 2013-03-19 07:22:12.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,13 +10,11 @@ (* *) (***********************************************************************) -(* $Id: emit.mlp 10980 2011-03-13 13:33:17Z xleroy $ *) - (* Emission of Intel 386 assembly code *) -module StringSet = Set.Make(struct type t = string let compare = compare end) +module StringSet = + Set.Make(struct type t = string let compare (x:t) y = compare x y end) -open Location open Misc open Cmm open Arch @@ -82,6 +80,9 @@ let emit_label lbl = emit_string label_prefix; emit_int lbl +let emit_data_label lbl = + emit_string label_prefix; emit_string "d"; emit_int lbl + (* Some data directives have different names under Solaris *) @@ -309,9 +310,18 @@ (* Deallocate the stack frame before a return or tail call *) -let output_epilogue () = +let output_epilogue f = let n = frame_size() - 4 in - if n > 0 then ` addl ${emit_int n}, %esp\n` + if n > 0 then + begin + ` addl ${emit_int n}, %esp\n`; + cfi_adjust_cfa_offset (-n); + f (); + (* reset CFA back cause function body may continue *) + cfi_adjust_cfa_offset n + end + else + f () (* Determine if the given register is the top of the floating-point stack *) @@ -400,6 +410,23 @@ | "tan" -> ` fptan; fstp %st(0)\n` | _ -> assert false +(* Floating-point constants *) + +let float_constants = ref ([] : (string * int) list) + +let add_float_constant cst = + try + List.assoc cst !float_constants + with + Not_found -> + let lbl = new_label() in + float_constants := (cst, lbl) :: !float_constants; + lbl + +let emit_float_constant (cst, lbl) = + `{emit_label lbl}:`; + emit_float64_split_directive ".long" cst + (* Output the assembly code for an instruction *) (* Name of current function *) @@ -408,13 +435,12 @@ let tailrec_entry_point = ref 0 (* Label of trap for out-of-range accesses *) let range_check_trap = ref 0 -(* Record float literals to be emitted later *) -let float_constants = ref ([] : (int * string) list) (* Record references to external C functions (for MacOSX) *) let external_symbols_direct = ref StringSet.empty let external_symbols_indirect = ref StringSet.empty let emit_instr fallthrough i = + emit_debug_info i.dbg; match i.desc with Lend -> () | Lop(Imove | Ispill | Ireload) -> @@ -450,8 +476,7 @@ | 0xBFF0_0000_0000_0000L -> (* -1.0 *) ` fld1\n fchs\n` | _ -> - let lbl = new_label() in - float_constants := (lbl, s) :: !float_constants; + let lbl = add_float_constant s in ` fldl {emit_label lbl}\n` end | Lop(Iconst_symbol s) -> @@ -463,14 +488,16 @@ ` call {emit_symbol s}\n`; record_frame i.live i.dbg | Lop(Itailcall_ind) -> - output_epilogue(); + output_epilogue begin fun () -> ` jmp *{emit_reg i.arg.(0)}\n` + end | Lop(Itailcall_imm s) -> if s = !function_name then ` jmp {emit_label !tailrec_entry_point}\n` else begin - output_epilogue(); + output_epilogue begin fun () -> ` jmp {emit_symbol s}\n` + end end | Lop(Iextcall(s, alloc)) -> if alloc then begin @@ -496,6 +523,7 @@ if n < 0 then ` addl ${emit_int(-n)}, %esp\n` else ` subl ${emit_int(n)}, %esp\n`; + cfi_adjust_cfa_offset n; stack_offset := !stack_offset + n | Lop(Iload(chunk, addr)) -> let dest = i.res.(0) in @@ -649,6 +677,7 @@ ` fldl {emit_reg i.arg.(0)}\n`; stack_offset := !stack_offset - 8; ` subl $8, %esp\n`; + cfi_adjust_cfa_offset 8; ` fnstcw 4(%esp)\n`; ` movw 4(%esp), %ax\n`; ` movb $12, %ah\n`; @@ -663,6 +692,7 @@ end; ` fldcw 4(%esp)\n`; ` addl $8, %esp\n`; + cfi_adjust_cfa_offset (-8); stack_offset := !stack_offset + 8 | Lop(Ispecific(Ilea addr)) -> ` lea {emit_addressing addr i.arg 0}, {emit_reg i.res.(0)}\n` @@ -679,29 +709,36 @@ match r with {loc = Reg _; typ = Float} -> ` subl $8, %esp\n`; + cfi_adjust_cfa_offset 8; ` fstpl 0(%esp)\n`; stack_offset := !stack_offset + 8 | {loc = Stack sl; typ = Float} -> let ofs = slot_offset sl 1 in ` pushl {emit_int(ofs + 4)}(%esp)\n`; ` pushl {emit_int(ofs + 4)}(%esp)\n`; + cfi_adjust_cfa_offset 8; stack_offset := !stack_offset + 8 | _ -> ` pushl {emit_reg r}\n`; + cfi_adjust_cfa_offset 4; stack_offset := !stack_offset + 4 done | Lop(Ispecific(Ipush_int n)) -> ` pushl ${emit_nativeint n}\n`; + cfi_adjust_cfa_offset 4; stack_offset := !stack_offset + 4 | Lop(Ispecific(Ipush_symbol s)) -> ` pushl ${emit_symbol s}\n`; + cfi_adjust_cfa_offset 4; stack_offset := !stack_offset + 4 | Lop(Ispecific(Ipush_load addr)) -> ` pushl {emit_addressing addr i.arg 0}\n`; + cfi_adjust_cfa_offset 4; stack_offset := !stack_offset + 4 | Lop(Ispecific(Ipush_load_float addr)) -> ` pushl {emit_addressing (offset_addressing addr 4) i.arg 0}\n`; ` pushl {emit_addressing addr i.arg 0}\n`; + cfi_adjust_cfa_offset 8; stack_offset := !stack_offset + 8 | Lop(Ispecific(Ifloatarithmem(double, op, addr))) -> if not (is_tos i.arg.(0)) then @@ -719,8 +756,9 @@ | Lreloadretaddr -> () | Lreturn -> - output_epilogue(); + output_epilogue begin fun () -> ` ret\n` + end | Llabel lbl -> `{emit_Llabel fallthrough lbl}:\n` | Lbranch lbl -> @@ -784,11 +822,13 @@ if trap_frame_size > 8 then ` subl ${emit_int (trap_frame_size - 8)}, %esp\n`; ` pushl {emit_symbol "caml_exception_pointer"}\n`; + cfi_adjust_cfa_offset trap_frame_size; ` movl %esp, {emit_symbol "caml_exception_pointer"}\n`; stack_offset := !stack_offset + trap_frame_size | Lpoptrap -> ` popl {emit_symbol "caml_exception_pointer"}\n`; ` addl ${emit_int (trap_frame_size - 4)}, %esp\n`; + cfi_adjust_cfa_offset (-trap_frame_size); stack_offset := !stack_offset - trap_frame_size | Lraise -> if !Clflags.debug then begin @@ -811,13 +851,6 @@ (Linearize.has_fallthrough i.desc) i.next -(* Emission of the floating-point constants *) - -let emit_float_constant (lbl, cst) = - ` .data\n`; - `{emit_label lbl}:`; - emit_float64_split_directive ".long" cst - (* Emission of external symbol references (for MacOSX) *) let emit_external_symbol_direct s = @@ -883,7 +916,6 @@ fastcode_flag := fundecl.fun_fast; tailrec_entry_point := new_label(); stack_offset := 0; - float_constants := []; call_gc_sites := []; bound_error_sites := []; bound_error_call := 0; @@ -897,20 +929,25 @@ else ` .globl {emit_symbol fundecl.fun_name}\n`; `{emit_symbol fundecl.fun_name}:\n`; + emit_debug_info fundecl.fun_dbg; + cfi_startproc (); if !Clflags.gprofile then emit_profile(); let n = frame_size() - 4 in if n > 0 then + begin ` subl ${emit_int n}, %esp\n`; + cfi_adjust_cfa_offset n; + end; `{emit_label !tailrec_entry_point}:\n`; emit_all true fundecl.fun_body; List.iter emit_call_gc !call_gc_sites; emit_call_bound_errors (); + cfi_endproc (); begin match Config.system with "linux_elf" | "bsd_elf" | "gnu" -> ` .type {emit_symbol fundecl.fun_name},@function\n`; ` .size {emit_symbol fundecl.fun_name},.-{emit_symbol fundecl.fun_name}\n` - | _ -> () end; - List.iter emit_float_constant !float_constants + | _ -> () end (* Emission of data *) @@ -921,7 +958,7 @@ | Cdefine_symbol s -> `{emit_symbol s}:\n` | Cdefine_label lbl -> - `{emit_label (100000 + lbl)}:\n` + `{emit_data_label lbl}:\n` | Cint8 n -> ` .byte {emit_int n}\n` | Cint16 n -> @@ -937,7 +974,7 @@ | Csymbol_address s -> ` .long {emit_symbol s}\n` | Clabel_address lbl -> - ` .long {emit_label (100000 + lbl)}\n` + ` .long {emit_data_label lbl}\n` | Cstring s -> if use_ascii_dir then emit_string_directive " .ascii " s @@ -954,6 +991,8 @@ (* Beginning / end of an assembly file *) let begin_assembly() = + reset_debug_info(); (* PR#5603 *) + float_constants := []; let lbl_begin = Compilenv.make_symbol (Some "data_begin") in ` .data\n`; ` .globl {emit_symbol lbl_begin}\n`; @@ -965,6 +1004,10 @@ if macosx then ` nop\n` (* PR#4690 *) let end_assembly() = + if !float_constants <> [] then begin + ` .data\n`; + List.iter emit_float_constant !float_constants + end; let lbl_end = Compilenv.make_symbol (Some "code_end") in ` .text\n`; if macosx then ` nop\n`; (* suppress "ld warning: atom sorting error" *) diff -Nru ocaml-3.12.1/asmcomp/i386/emit_nt.mlp ocaml-4.01.0/asmcomp/i386/emit_nt.mlp --- ocaml-3.12.1/asmcomp/i386/emit_nt.mlp 2011-06-04 15:21:43.000000000 +0000 +++ ocaml-4.01.0/asmcomp/i386/emit_nt.mlp 2013-03-19 07:22:12.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,12 +10,10 @@ (* *) (***********************************************************************) -(* $Id: emit_nt.mlp 11067 2011-06-04 15:21:43Z xleroy $ *) - (* Emission of Intel 386 assembly code, MASM syntax. *) module StringSet = - Set.Make(struct type t = string let compare = compare end) + Set.Make(struct type t = string let compare (x:t) y = compare x y end) open Misc open Cmm @@ -71,6 +69,9 @@ let emit_label lbl = emit_string "L"; emit_int lbl +let emit_data_label lbl = + emit_string "Ld"; emit_int lbl + (* Output an align directive. *) let emit_align n = ` ALIGN {emit_int n}\n` @@ -358,6 +359,39 @@ | "tan" -> ` fptan\n\tfstp st(0)\n` | _ -> assert false +(* Floating-point constants *) + +let float_constants = ref ([] : (string * int) list) + +let add_float_constant cst = + try + List.assoc cst !float_constants + with + Not_found -> + let lbl = new_label() in + float_constants := (cst, lbl) :: !float_constants; + lbl + +let emit_float s = + (* MASM doesn't like floating-point constants such as 2e9. + Turn them into 2.0e9. *) + let pos_e = ref (-1) and pos_dot = ref (-1) in + for i = 0 to String.length s - 1 do + match s.[i] with + 'e'|'E' -> pos_e := i + | '.' -> pos_dot := i + | _ -> () + done; + if !pos_dot < 0 && !pos_e >= 0 then begin + emit_string (String.sub s 0 !pos_e); + emit_string ".0"; + emit_string (String.sub s !pos_e (String.length s - !pos_e)) + end else + emit_string s + +let emit_float_constant (cst, lbl) = + `{emit_label lbl} REAL8 {emit_float cst}\n` + (* Output the assembly code for an instruction *) (* Name of current function *) @@ -367,8 +401,6 @@ (* Label of trap for out-of-range accesses *) let range_check_trap = ref 0 -let float_constants = ref ([] : (int * string) list) - let emit_instr i = match i.desc with Lend -> () @@ -405,8 +437,7 @@ | 0xBFF0_0000_0000_0000L -> (* -1.0 *) ` fld1\n fchs\n` | _ -> - let lbl = new_label() in - float_constants := (lbl, s) :: !float_constants; + let lbl = add_float_constant s in ` fld {emit_label lbl}\n` end | Lop(Iconst_symbol s) -> @@ -751,28 +782,6 @@ let rec emit_all i = match i.desc with Lend -> () | _ -> emit_instr i; emit_all i.next -(* Emission of the floating-point constants *) - -let emit_float s = - (* MASM doesn't like floating-point constants such as 2e9. - Turn them into 2.0e9. *) - let pos_e = ref (-1) and pos_dot = ref (-1) in - for i = 0 to String.length s - 1 do - match s.[i] with - 'e'|'E' -> pos_e := i - | '.' -> pos_dot := i - | _ -> () - done; - if !pos_dot < 0 && !pos_e >= 0 then begin - emit_string (String.sub s 0 !pos_e); - emit_string ".0"; - emit_string (String.sub s !pos_e (String.length s - !pos_e)) - end else - emit_string s - -let emit_float_constant (lbl, cst) = - `{emit_label lbl} REAL8 {emit_float cst}\n` - (* Emission of a function declaration *) let fundecl fundecl = @@ -780,7 +789,6 @@ fastcode_flag := fundecl.fun_fast; tailrec_entry_point := new_label(); stack_offset := 0; - float_constants := []; call_gc_sites := []; bound_error_sites := []; bound_error_call := 0; @@ -795,14 +803,7 @@ `{emit_label !tailrec_entry_point}:\n`; emit_all fundecl.fun_body; List.iter emit_call_gc !call_gc_sites; - emit_call_bound_errors (); - begin match !float_constants with - [] -> () - | _ -> - ` .DATA\n`; - List.iter emit_float_constant !float_constants; - float_constants := [] - end + emit_call_bound_errors () (* Emission of data *) @@ -813,7 +814,7 @@ add_def_symbol s ; `{emit_symbol s} LABEL DWORD\n` | Cdefine_label lbl -> - `{emit_label (100000 + lbl)} LABEL DWORD\n` + `{emit_data_label lbl} LABEL DWORD\n` | Cint8 n -> ` BYTE {emit_int n}\n` | Cint16 n -> @@ -830,7 +831,7 @@ add_used_symbol s ; ` DWORD {emit_symbol s}\n` | Clabel_address lbl -> - ` DWORD {emit_label (100000 + lbl)}\n` + ` DWORD {emit_data_label lbl}\n` | Cstring s -> emit_bytes_directive " BYTE " s | Cskip n -> @@ -845,6 +846,7 @@ (* Beginning / end of an assembly file *) let begin_assembly() = + float_constants := []; `.386\n`; ` .MODEL FLAT\n\n`; ` EXTERN _caml_young_ptr: DWORD\n`; @@ -871,6 +873,10 @@ `{emit_symbol lbl_begin} LABEL DWORD\n` let end_assembly() = + if !float_constants <> [] then begin + ` .DATA\n`; + List.iter emit_float_constant !float_constants; + end; ` .CODE\n`; let lbl_end = Compilenv.make_symbol (Some "code_end") in add_def_symbol lbl_end; @@ -881,6 +887,7 @@ add_def_symbol lbl_end; ` PUBLIC {emit_symbol lbl_end}\n`; `{emit_symbol lbl_end} LABEL DWORD\n`; + ` DWORD 0\n`; let lbl = Compilenv.make_symbol (Some "frametable") in add_def_symbol lbl; ` PUBLIC {emit_symbol lbl}\n`; diff -Nru ocaml-3.12.1/asmcomp/i386/proc.ml ocaml-4.01.0/asmcomp/i386/proc.ml --- ocaml-3.12.1/asmcomp/i386/proc.ml 2007-10-30 12:37:16.000000000 +0000 +++ ocaml-4.01.0/asmcomp/i386/proc.ml 2013-07-23 14:48:47.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: proc.ml 8462 2007-10-30 12:37:16Z xleroy $ *) - (* Description of the Intel 386 processor *) open Misc @@ -20,6 +18,12 @@ open Reg open Mach +(* Which asm conventions to use *) +let masm = + match Config.ccomp_type with + | "msvc" -> true + | _ -> false + (* Registers available for register allocation *) (* Register map: @@ -34,10 +38,16 @@ tos 100 top of floating-point stack. *) let int_reg_name = - [| "%eax"; "%ebx"; "%ecx"; "%edx"; "%esi"; "%edi"; "%ebp" |] + if masm then + [| "eax"; "ebx"; "ecx"; "edx"; "esi"; "edi"; "ebp" |] + else + [| "%eax"; "%ebx"; "%ecx"; "%edx"; "%esi"; "%edi"; "%ebp" |] let float_reg_name = - [| "%tos" |] + if masm then + [| "tos" |] + else + [| "%tos" |] let num_register_classes = 2 @@ -181,8 +191,12 @@ (* Calling the assembler *) let assemble_file infile outfile = - Ccomp.command (Config.asm ^ " -o " ^ - Filename.quote outfile ^ " " ^ Filename.quote infile) + if masm then + Ccomp.command (Config.asm ^ + Filename.quote outfile ^ " " ^ Filename.quote infile ^ + (if !Clflags.verbose then "" else ">NUL")) + else + Ccomp.command (Config.asm ^ " -o " ^ + Filename.quote outfile ^ " " ^ Filename.quote infile) -open Clflags;; -open Config;; +let init () = () diff -Nru ocaml-3.12.1/asmcomp/i386/proc_nt.ml ocaml-4.01.0/asmcomp/i386/proc_nt.ml --- ocaml-3.12.1/asmcomp/i386/proc_nt.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/i386/proc_nt.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,186 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: proc_nt.ml 9547 2010-01-22 12:48:24Z doligez $ *) - -(* Description of the Intel 386 processor, for Windows NT *) - -open Misc -open Arch -open Cmm -open Reg -open Mach - -(* Registers available for register allocation *) - -(* Register map: - eax 0 eax - edi: function arguments and results - ebx 1 eax: C function results - ecx 2 ebx, esi, edi, ebp: preserved by C - edx 3 - esi 4 - edi 5 - ebp 6 - - tos 100 top of floating-point stack. *) - -let int_reg_name = - [| "eax"; "ebx"; "ecx"; "edx"; "esi"; "edi"; "ebp" |] - -let float_reg_name = - [| "tos" |] - -let num_register_classes = 2 - -let register_class r = - match r.typ with - Int -> 0 - | Addr -> 0 - | Float -> 1 - -let num_available_registers = [| 7; 0 |] - -let first_available_register = [| 0; 100 |] - -let register_name r = - if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100) - -(* There is little scheduling, and some operations are more compact - when their argument is %eax. *) - -let rotate_registers = false - -(* Representation of hard registers by pseudo-registers *) - -let hard_int_reg = - let v = Array.create 7 Reg.dummy in - for i = 0 to 6 do v.(i) <- Reg.at_location Int (Reg i) done; - v - -let hard_float_reg = [| Reg.at_location Float (Reg 100) |] - -let all_phys_regs = - Array.append hard_int_reg hard_float_reg - -let phys_reg n = - if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100) - -let eax = phys_reg 0 -let ecx = phys_reg 2 -let edx = phys_reg 3 -let tos = phys_reg 100 - -let stack_slot slot ty = - Reg.at_location ty (Stack slot) - -(* Instruction selection *) - -let word_addressed = false - -(* Calling conventions *) - -(* To supplement the processor's meagre supply of registers, we also - use some global memory locations to pass arguments beyond the 6th. - These globals are denoted by Incoming and Outgoing stack locations - with negative offsets, starting at -64. - Unlike arguments passed on stack, arguments passed in globals - do not prevent tail-call elimination. The caller stores arguments - in these globals immediately before the call, and the first thing the - callee does is copy them to registers or stack locations. - Neither GC nor thread context switches can occur between these two - times. *) - -let calling_conventions first_int last_int first_float last_float make_stack - arg = - let loc = Array.create (Array.length arg) Reg.dummy in - let int = ref first_int in - let float = ref first_float in - let ofs = ref (-64) in - for i = 0 to Array.length arg - 1 do - match arg.(i).typ with - Int | Addr as ty -> - if !int <= last_int then begin - loc.(i) <- phys_reg !int; - incr int - end else begin - loc.(i) <- stack_slot (make_stack !ofs) ty; - ofs := !ofs + size_int - end - | Float -> - if !float <= last_float then begin - loc.(i) <- phys_reg !float; - incr float - end else begin - loc.(i) <- stack_slot (make_stack !ofs) Float; - ofs := !ofs + size_float - end - done; - (loc, max 0 !ofs) - -let incoming ofs = Incoming ofs -let outgoing ofs = Outgoing ofs -let not_supported ofs = fatal_error "Proc.loc_results: cannot call" - -let loc_arguments arg = - calling_conventions 0 5 100 99 outgoing arg -let loc_parameters arg = - let (loc, ofs) = calling_conventions 0 5 100 99 incoming arg in loc -let loc_results res = - let (loc, ofs) = calling_conventions 0 5 100 100 not_supported res in loc -let extcall_use_push = true -let loc_external_arguments arg = - fatal_error "Proc.loc_external_arguments" -let loc_external_results res = - let (loc, ofs) = calling_conventions 0 0 100 100 not_supported res in loc - -let loc_exn_bucket = eax - -(* Registers destroyed by operations *) - -let destroyed_at_c_call = (* ebx, esi, edi, ebp preserved *) - Array.of_list(List.map phys_reg [0;2;3]) - -let destroyed_at_oper = function - Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs - | Iop(Iextcall(_, false)) -> destroyed_at_c_call - | Iop(Iintop(Idiv | Imod)) -> [| eax; edx |] - | Iop(Iintop_imm(Imod, _)) -> [| eax |] - | Iop(Ialloc _) -> [| eax |] - | Iop(Iintop(Icomp _) | Iintop_imm(Icomp _, _)) -> [| eax |] - | Iop(Iintoffloat) -> [| eax |] - | Iifthenelse(Ifloattest(_, _), _, _) -> [| eax |] - | _ -> [||] - -let destroyed_at_raise = all_phys_regs - -(* Maximal register pressure *) - -let safe_register_pressure op = 4 - -let max_register_pressure = function - Iextcall(_, _) -> [| 4; max_int |] - | Iintop(Idiv | Imod) -> [| 5; max_int |] - | Ialloc _ | Iintop(Icomp _) | Iintop_imm(Icomp _, _) | - Iintoffloat -> [| 6; max_int |] - | _ -> [|7; max_int |] - -(* Layout of the stack frame *) - -let num_stack_slots = [| 0; 0 |] -let contains_calls = ref false - -(* Calling the assembler *) - -let assemble_file infile outfile = - Ccomp.command (Config.asm ^ - Filename.quote outfile ^ " " ^ Filename.quote infile ^ - (if !Clflags.verbose then "" else ">NUL")) diff -Nru ocaml-3.12.1/asmcomp/i386/reload.ml ocaml-4.01.0/asmcomp/i386/reload.ml --- ocaml-3.12.1/asmcomp/i386/reload.ml 2010-04-08 03:58:41.000000000 +0000 +++ ocaml-4.01.0/asmcomp/i386/reload.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: reload.ml 10250 2010-04-08 03:58:41Z garrigue $ *) - open Cmm open Arch open Reg diff -Nru ocaml-3.12.1/asmcomp/i386/scheduling.ml ocaml-4.01.0/asmcomp/i386/scheduling.ml --- ocaml-3.12.1/asmcomp/i386/scheduling.ml 2000-02-04 12:43:18.000000000 +0000 +++ ocaml-4.01.0/asmcomp/i386/scheduling.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,9 +10,7 @@ (* *) (***********************************************************************) -(* $Id: scheduling.ml 2779 2000-02-04 12:43:18Z xleroy $ *) - -open Schedgen (* to create a dependency *) +let () = let module M = Schedgen in () (* to create a dependency *) (* Scheduling is turned off because our model does not fit the 486 nor the Pentium very well. In particular, it messes up with the diff -Nru ocaml-3.12.1/asmcomp/i386/selection.ml ocaml-4.01.0/asmcomp/i386/selection.ml --- ocaml-3.12.1/asmcomp/i386/selection.ml 2010-04-08 03:58:41.000000000 +0000 +++ ocaml-4.01.0/asmcomp/i386/selection.ml 2013-03-09 22:38:52.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,15 +10,12 @@ (* *) (***********************************************************************) -(* $Id: selection.ml 10250 2010-04-08 03:58:41Z garrigue $ *) - (* Instruction selection for the Intel x86 *) open Misc open Arch open Proc open Cmm -open Reg open Mach (* Auxiliary for recognizing addressing modes *) @@ -133,7 +130,7 @@ the result is always left at the top of the floating-point stack *) | Iconst_float _ | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf | Ifloatofint | Iload((Single | Double | Double_u), _) - | Ispecific(Isubfrev | Idivfrev | Ifloatarithmem(_, _, _) | Ifloatspecial _) -> + | Ispecific(Isubfrev | Idivfrev | Ifloatarithmem _ | Ifloatspecial _) -> (arg, [| tos |], false) (* don't move it immediately *) (* For storing a byte, the argument must be in eax...edx. (But for a short, any reg will do!) @@ -168,7 +165,7 @@ | _ -> super#is_simple_expr e -method select_addressing exp = +method select_addressing chunk exp = match select_addr exp with (Asymbol s, d) -> (Ibased(s, d), Ctuple []) @@ -200,7 +197,7 @@ match op with (* Recognize the LEA instruction *) Caddi | Cadda | Csubi | Csuba -> - begin match self#select_addressing (Cop(op, args)) with + begin match self#select_addressing Word (Cop(op, args)) with (Iindexed d, _) -> super#select_operation op args | (Iindexed2 0, _) -> super#select_operation op args | (addr, arg) -> (Ispecific(Ilea addr), [arg]) @@ -223,17 +220,19 @@ | Caddf -> self#select_floatarith Iaddf Iaddf Ifloatadd Ifloatadd args | Csubf -> - self#select_floatarith Isubf (Ispecific Isubfrev) Ifloatsub Ifloatsubrev args + self#select_floatarith Isubf (Ispecific Isubfrev) Ifloatsub Ifloatsubrev + args | Cmulf -> self#select_floatarith Imulf Imulf Ifloatmul Ifloatmul args | Cdivf -> - self#select_floatarith Idivf (Ispecific Idivfrev) Ifloatdiv Ifloatdivrev args + self#select_floatarith Idivf (Ispecific Idivfrev) Ifloatdiv Ifloatdivrev + args (* Recognize store instructions *) | Cstore Word -> begin match args with [loc; Cop(Caddi, [Cop(Cload _, [loc']); Cconst_int n])] when loc = loc' -> - let (addr, arg) = self#select_addressing loc in + let (addr, arg) = self#select_addressing Word loc in (Ispecific(Ioffset_loc(n, addr)), [arg]) | _ -> super#select_operation op args @@ -250,11 +249,11 @@ method select_floatarith regular_op reversed_op mem_op mem_rev_op args = match args with [arg1; Cop(Cload chunk, [loc2])] -> - let (addr, arg2) = self#select_addressing loc2 in + let (addr, arg2) = self#select_addressing chunk loc2 in (Ispecific(Ifloatarithmem(chunk_double chunk, mem_op, addr)), [arg1; arg2]) | [Cop(Cload chunk, [loc1]); arg2] -> - let (addr, arg1) = self#select_addressing loc1 in + let (addr, arg1) = self#select_addressing chunk loc1 in (Ispecific(Ifloatarithmem(chunk_double chunk, mem_rev_op, addr)), [arg2; arg1]) | [arg1; arg2] -> @@ -282,9 +281,6 @@ with Use_default -> super#insert_op_debug op dbg rs rd -method! insert_op op rs rd = - self#insert_op_debug op Debuginfo.none rs rd - (* Selection of push instructions for external calls *) method select_push exp = @@ -295,10 +291,10 @@ | Cconst_natpointer n -> (Ispecific(Ipush_int n), Ctuple []) | Cconst_symbol s -> (Ispecific(Ipush_symbol s), Ctuple []) | Cop(Cload Word, [loc]) -> - let (addr, arg) = self#select_addressing loc in + let (addr, arg) = self#select_addressing Word loc in (Ispecific(Ipush_load addr), arg) | Cop(Cload Double_u, [loc]) -> - let (addr, arg) = self#select_addressing loc in + let (addr, arg) = self#select_addressing Double_u loc in (Ispecific(Ipush_load_float addr), arg) | _ -> (Ispecific(Ipush), exp) diff -Nru ocaml-3.12.1/asmcomp/ia64/arch.ml ocaml-4.01.0/asmcomp/ia64/arch.ml --- ocaml-3.12.1/asmcomp/ia64/arch.ml 2002-11-29 15:03:37.000000000 +0000 +++ ocaml-4.01.0/asmcomp/ia64/arch.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,88 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2000 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: arch.ml 5304 2002-11-29 15:03:37Z xleroy $ *) - -(* Specific operations for the IA64 processor *) - -open Misc -open Format - -(* Machine-specific command-line options *) - -let command_line_options = [] - -(* Addressing modes -- only one! (register with no displacement) *) - -type addressing_mode = Iindexed - -(* Specific operations *) - -type specific_operation = - Iadd1 (* x + y + 1 or x + x + 1 *) - | Isub1 (* x - y - 1 *) - | Ishladd of int (* x << N + y *) - | Isignextend of int (* truncate 64-bit int to 8N-bit int *) - | Imultaddf (* x *. y +. z *) - | Imultsubf (* x *. y -. z *) - | Isubmultf (* z -. x *. y *) - | Istoreincr of int (* store y at x; x <- x + N *) - | Iinitbarrier (* end of object initialization *) - -(* Sizes, endianness *) - -let big_endian = false - -let size_addr = 8 -let size_int = 8 -let size_float = 8 - -(* Operations on addressing modes *) - -let identity_addressing = Iindexed - -let offset_addressing addr delta = assert false - -let num_args_addressing = function Iindexed -> 1 - -(* Printing operations and addressing modes *) - -let print_addressing printreg addr ppf arg = - printreg ppf arg.(0) - -let print_specific_operation printreg op ppf arg = - match op with - | Iadd1 -> - if Array.length arg >= 2 then - fprintf ppf "%a + %a + 1 " printreg arg.(0) printreg arg.(1) - else - fprintf ppf "%a << 1 + 1 " printreg arg.(0) - | Isub1 -> - fprintf ppf "%a - %a - 1 " printreg arg.(0) printreg arg.(1) - | Ishladd n -> - fprintf ppf "%a << %d + %a" printreg arg.(0) n printreg arg.(1) - | Isignextend n -> - fprintf ppf "truncate%d %a" (n * 8) printreg arg.(0) - | Imultaddf -> - fprintf ppf "%a * %a + %a" - printreg arg.(0) printreg arg.(1) printreg arg.(2) - | Imultsubf -> - fprintf ppf "%a * %a - %a" - printreg arg.(0) printreg arg.(1) printreg arg.(2) - | Isubmultf -> - fprintf ppf "%a - %a * %a" - printreg arg.(2) printreg arg.(0) printreg arg.(1) - | Istoreincr n -> - fprintf ppf "[%a] := %a; %a += %d" - printreg arg.(0) printreg arg.(1) printreg arg.(0) n - | Iinitbarrier -> - fprintf ppf "initbarrier" diff -Nru ocaml-3.12.1/asmcomp/ia64/emit.mlp ocaml-4.01.0/asmcomp/ia64/emit.mlp --- ocaml-3.12.1/asmcomp/ia64/emit.mlp 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/ia64/emit.mlp 1970-01-01 00:00:00.000000000 +0000 @@ -1,1327 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2000 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: emit.mlp 9547 2010-01-22 12:48:24Z doligez $ *) - -(* Emission of IA64 assembly code *) - -open Location -open Printf -open Misc -open Cmm -open Arch -open Proc -open Reg -open Mach -open Linearize -open Emitaux - -(************** Part 1: assembly-level scheduler *******************) - -(* Representation of resources accessed or produced by instructions *) - -type resource = string - (* A resource is either: - - a register name - - "stkN" for a stack location - - "heap" for the Caml heap - - "chkN" for the result of a checkbound instruction *) - -let is_memory_resource rsrc = - String.length rsrc >= 4 && - begin match String.sub rsrc 0 3 with - "stk" -> true - | "hea" -> true - | "chk" -> true - | _ -> false - end - -let is_mutable_resource rsrc = - rsrc <> "r0" && rsrc <> "p0" - -(* Description of instructions *) - -type instruction_kind = - KA (* A type instruction (int or mem unit) *) - | KB (* B type instruction (branch unit) *) - | KI (* I type instruction (int unit *) - | KF (* F type instruction (FP unit) *) - | KM (* M type instruction (mem unit) *) - | KB_exc (* B type instruction, exceptional condition, - can be moved around *) - -type instruction_format = - F_i (* op imm *) - | F_i_pred (* (pred) op imm *) - | F_ir_rr (* op p1,p2 = imm, r *) - | F_ir_r (* op r = imm, r *) - | F_ir_r_pred (* (pred) op r = imm, r *) - | F_ld (* op r = [r] *) - | F_ld_post (* op r = [r], imm *) - | F_r (* op r *) - | F_i_r (* op r = imm *) - | F_i_r_pred (* (pred) op r = imm *) - | F_ri_rr (* op p1,p2 = imm, r *) - | F_ri_r (* op r = imm, r *) - | F_r_r (* op r = r *) - | F_r_r_pred (* (pred) op r = r *) - | F_rr_rr (* op p1,p2 = r1, r2 *) - | F_r_rir (* op r = r1, imm, r2 *) - | F_rr_r (* op r = r1, r2 *) - | F_rr_r_pred (* (pred) op r = r1, r2 *) - | F_rri_r (* op r = r1, r2, imm *) - | F_rrr_r (* op r = r1, r2, r3 *) - | F_rrr_r_pred (* (pred) op r = r1, r2, r3 *) - | F_st (* op [r] = r *) - | F_st_post (* op [r] = r, imm *) - -type instruction_descr = - { opcode: string; (* actual opcode *) - latency: int; (* latency in cycles *) - kind: instruction_kind; (* kind of instruction *) - format: instruction_format } (* how to generate asm for it *) - -let instruction_table = create_hashtable 73 [ - "add", {opcode = "add"; latency = 1; kind = KA; format = F_rr_r}; - "add1", {opcode = "add"; latency = 1; kind = KA; format = F_rri_r}; - "addcond", {opcode = "add"; latency = 1; kind = KA; format = F_rr_r_pred}; - "addi", {opcode = "add"; latency = 1; kind = KA; format = F_ir_r}; - "addicond", {opcode = "add"; latency = 1; kind = KA; format = F_ir_r_pred}; - "and", {opcode = "and"; latency = 1; kind = KA; format = F_rr_r}; - "andi", {opcode = "and"; latency = 1; kind = KA; format = F_ir_r}; - "br", {opcode = "br.sptk.many"; latency = 1; kind = KB; format = F_i}; - "brret", {opcode = "br.ret.sptk"; latency = 1; kind = KB; format = F_r}; - "brcall", {opcode = "br.call.sptk.many"; latency = 1; kind = KB; format = F_i_r}; - "brcallcond", {opcode = "br.call.spnt.many"; latency = 1; kind = KB; format = F_i_r_pred}; - "brcallcondexc", {opcode = "br.call.spnt.many"; latency = 1; kind = KB_exc; format = F_i_r_pred}; - "brcallind", {opcode = "br.call.sptk.many"; latency = 1; kind = KB; format = F_r_r}; - "brcond", {opcode = "br.dpnt.many"; latency = 1; kind = KB; format = F_i_pred}; - "brind", {opcode = "br.sptk.many"; latency = 1; kind = KB; format = F_r}; - "cmp.eq", {opcode = "cmp.eq"; latency = 0; kind = KA; format = F_rr_rr}; - "cmp.ge", {opcode = "cmp.ge"; latency = 0; kind = KA; format = F_rr_rr}; - "cmp.geu", {opcode = "cmp.geu"; latency = 0; kind = KA; format = F_rr_rr}; - "cmp.gt", {opcode = "cmp.gt"; latency = 0; kind = KA; format = F_rr_rr}; - "cmp.gtu", {opcode = "cmp.gtu"; latency = 0; kind = KA; format = F_rr_rr}; - "cmp.le", {opcode = "cmp.le"; latency = 0; kind = KA; format = F_rr_rr}; - "cmp.leu", {opcode = "cmp.leu"; latency = 0; kind = KA; format = F_rr_rr}; - "cmp.lt", {opcode = "cmp.lt"; latency = 0; kind = KA; format = F_rr_rr}; - "cmp.ltu", {opcode = "cmp.ltu"; latency = 0; kind = KA; format = F_rr_rr}; - "cmp.ne", {opcode = "cmp.ne"; latency = 0; kind = KA; format = F_rr_rr}; - "cmpi.eq", {opcode = "cmp.eq"; latency = 0; kind = KA; format = F_ir_rr}; - "cmpi.ge", {opcode = "cmp.ge"; latency = 0; kind = KA; format = F_ir_rr}; - "cmpi.geu", {opcode = "cmp.geu"; latency = 0; kind = KA; format = F_ir_rr}; - "cmpi.gt", {opcode = "cmp.gt"; latency = 0; kind = KA; format = F_ir_rr}; - "cmpi.gtu", {opcode = "cmp.gtu"; latency = 0; kind = KA; format = F_ir_rr}; - "cmpi.le", {opcode = "cmp.le"; latency = 0; kind = KA; format = F_ir_rr}; - "cmpi.leu", {opcode = "cmp.leu"; latency = 0; kind = KA; format = F_ir_rr}; - "cmpi.lt", {opcode = "cmp.lt"; latency = 0; kind = KA; format = F_ir_rr}; - "cmpi.ltu", {opcode = "cmp.ltu"; latency = 0; kind = KA; format = F_ir_rr}; - "cmpi.ne", {opcode = "cmp.ne"; latency = 0; kind = KA; format = F_ir_rr}; - "cmpp.eq", {opcode = "cmp.eq"; latency = 1; kind = KA; format = F_rr_rr}; - "cmpp.ge", {opcode = "cmp.ge"; latency = 1; kind = KA; format = F_rr_rr}; - "cmpp.geu", {opcode = "cmp.geu"; latency = 1; kind = KA; format = F_rr_rr}; - "cmpp.gt", {opcode = "cmp.gt"; latency = 1; kind = KA; format = F_rr_rr}; - "cmpp.gtu", {opcode = "cmp.gtu"; latency = 1; kind = KA; format = F_rr_rr}; - "cmpp.le", {opcode = "cmp.le"; latency = 1; kind = KA; format = F_rr_rr}; - "cmpp.leu", {opcode = "cmp.leu"; latency = 1; kind = KA; format = F_rr_rr}; - "cmpp.lt", {opcode = "cmp.lt"; latency = 1; kind = KA; format = F_rr_rr}; - "cmpp.ltu", {opcode = "cmp.ltu"; latency = 1; kind = KA; format = F_rr_rr}; - "cmpp.ne", {opcode = "cmp.ne"; latency = 1; kind = KA; format = F_rr_rr}; - "cmpp.ne.and", {opcode = "cmp.ne.and"; latency = 1; kind = KA; format = F_rr_rr}; - "cmppi.eq", {opcode = "cmp.eq"; latency = 1; kind = KA; format = F_ir_rr}; - "cmppi.ge", {opcode = "cmp.ge"; latency = 1; kind = KA; format = F_ir_rr}; - "cmppi.geu", {opcode = "cmp.geu"; latency = 1; kind = KA; format = F_ir_rr}; - "cmppi.gt", {opcode = "cmp.gt"; latency = 1; kind = KA; format = F_ir_rr}; - "cmppi.gtu", {opcode = "cmp.gtu"; latency = 1; kind = KA; format = F_ir_rr}; - "cmppi.le", {opcode = "cmp.le"; latency = 1; kind = KA; format = F_ir_rr}; - "cmppi.leu", {opcode = "cmp.leu"; latency = 1; kind = KA; format = F_ir_rr}; - "cmppi.lt", {opcode = "cmp.lt"; latency = 1; kind = KA; format = F_ir_rr}; - "cmppi.ltu", {opcode = "cmp.ltu"; latency = 1; kind = KA; format = F_ir_rr}; - "cmppi.ne", {opcode = "cmp.ne"; latency = 1; kind = KA; format = F_ir_rr}; - "extr.u", {opcode = "extr.u"; latency = 1; kind = KI; format = F_ri_r}; - "fabs", {opcode = "fabs"; latency = 1; kind = KF; format = F_r_r}; - "fadd.d", {opcode = "fadd.d"; latency = 5; kind = KF; format = F_rr_r}; - "fcmp.eq", {opcode = "fcmp.eq"; latency = 1; kind = KF; format = F_rr_rr}; - "fcmp.ge", {opcode = "fcmp.ge"; latency = 1; kind = KF; format = F_rr_rr}; - "fcmp.gt", {opcode = "fcmp.gt"; latency = 1; kind = KF; format = F_rr_rr}; - "fcmp.le", {opcode = "fcmp.le"; latency = 1; kind = KF; format = F_rr_rr}; - "fcmp.lt", {opcode = "fcmp.lt"; latency = 1; kind = KF; format = F_rr_rr}; - "fcmp.neq", {opcode = "fcmp.neq"; latency = 1; kind = KF; format = F_rr_rr}; - "fcvt.fx.trunc", {opcode = "fcvt.fx.trunc"; latency = 7; kind = KF; format = F_r_r}; - "fcvt.xf", {opcode = "fcvt.xf"; latency = 5; kind = KF; format = F_r_r}; - "fma.d", {opcode = "fma.d"; latency = 5; kind = KF; format = F_rrr_r}; - "fmacond", {opcode = "fma.d.s0"; latency = 5; kind = KF; format = F_rrr_r_pred}; - "fmas1cond", {opcode = "fma.s1"; latency = 5; kind = KF; format = F_rrr_r_pred}; - "fmads1cond", {opcode = "fma.d.s1"; latency = 5; kind = KF; format = F_rrr_r_pred}; - "fmpy.d", {opcode = "fmpy.d"; latency = 5; kind = KF; format = F_rr_r}; - "fms.d", {opcode = "fms.d"; latency = 5; kind = KF; format = F_rrr_r}; - "fneg", {opcode = "fneg"; latency = 1; kind = KF; format = F_r_r}; - "fnma.d", {opcode = "fnma.d"; latency = 5; kind = KF; format = F_rrr_r}; - "fnmas1cond", {opcode = "fnma.s1"; latency = 5; kind = KF; format = F_rrr_r_pred}; - "fnmads1cond", {opcode = "fnma.d.s1"; latency = 5; kind = KF; format = F_rrr_r_pred}; - "fnorm.d", {opcode = "fnorm.d"; latency = 5; kind = KF; format = F_r_r}; - "frcpa", {opcode = "frcpa.s0"; latency = 5; kind = KF; format = F_rr_rr}; - "fsub.d", {opcode = "fsub.d"; latency = 5; kind = KF; format = F_rr_r}; - "getf.sig", {opcode = "getf.sig"; latency = 2; kind = KM; format = F_r_r}; - "ld1", {opcode = "ld1"; latency = 2; kind = KM; format = F_ld}; - "ld2", {opcode = "ld2"; latency = 2; kind = KM; format = F_ld}; - "ld4", {opcode = "ld4"; latency = 2; kind = KM; format = F_ld}; - "ld8", {opcode = "ld8"; latency = 2; kind = KM; format = F_ld}; - "ld8+", {opcode = "ld8"; latency = 2; kind = KM; format = F_ld_post}; - "ldfd", {opcode = "ldfd"; latency = 9; kind = KM; format = F_ld}; - "ldfd+", {opcode = "ldfd"; latency = 9; kind = KM; format = F_ld_post}; - "ldfs", {opcode = "ldfs"; latency = 9; kind = KM; format = F_ld}; - "mov", {opcode = "mov"; latency = 1; kind = KA; format = F_r_r}; - "movcond", {opcode = "mov"; latency = 1; kind = KA; format = F_r_r_pred}; - "movtb", {opcode = "mov"; latency = 9; kind = KI; format = F_r_r}; - "movfb", {opcode = "mov"; latency = 2; kind = KI; format = F_r_r}; - "movi", {opcode = "mov"; latency = 1; kind = KA; format = F_i_r}; - "movicond", {opcode = "mov"; latency = 1; kind = KA; format = F_i_r_pred}; - "movil", {opcode = "movl"; latency = 1; kind = KI; format = F_i_r}; - "movpr", {opcode = "mov"; latency = 1; kind = KI; format = F_ri_r}; - "or", {opcode = "or"; latency = 1; kind = KA; format = F_rr_r}; - "ori", {opcode = "or"; latency = 1; kind = KA; format = F_ir_r}; - "setf.d", {opcode = "setf.d"; latency = 8; kind = KM; format = F_r_r}; - "setf.sig", {opcode = "setf.sig"; latency = 8; kind = KM; format = F_r_r}; - "shl", {opcode = "shl"; latency = 2; kind = KI; format = F_rr_r}; - "shladd", {opcode = "shladd"; latency = 1; kind = KA; format = F_r_rir}; - "shli", {opcode = "shl"; latency = 1; kind = KI; format = F_ri_r}; - "shr", {opcode = "shr"; latency = 2; kind = KI; format = F_rr_r}; - "shri", {opcode = "shr"; latency = 1; kind = KI; format = F_ri_r}; - "shru", {opcode = "shr.u"; latency = 2; kind = KI; format = F_rr_r}; - "shrui", {opcode = "shr.u"; latency = 1; kind = KI; format = F_ri_r}; - "st1", {opcode = "st1"; latency = 0; kind = KM; format = F_st}; - "st2", {opcode = "st2"; latency = 0; kind = KM; format = F_st}; - "st4", {opcode = "st4"; latency = 0; kind = KM; format = F_st}; - "st8", {opcode = "st8"; latency = 0; kind = KM; format = F_st}; - "st8+", {opcode = "st8"; latency = 1; kind = KM; format = F_st_post}; - "stfd", {opcode = "stfd"; latency = 0; kind = KM; format = F_st}; - "stfd+", {opcode = "stfd"; latency = 1; kind = KM; format = F_st_post}; - "stfs", {opcode = "stfs"; latency = 0; kind = KM; format = F_st}; - "sub", {opcode = "sub"; latency = 1; kind = KA; format = F_rr_r}; - "sub1", {opcode = "sub"; latency = 1; kind = KA; format = F_rri_r}; - "subi", {opcode = "sub"; latency = 1; kind = KA; format = F_ir_r}; - "sxt1", {opcode = "sxt1"; latency = 1; kind = KI; format = F_r_r}; - "sxt2", {opcode = "sxt2"; latency = 1; kind = KI; format = F_r_r}; - "sxt4", {opcode = "sxt4"; latency = 1; kind = KI; format = F_r_r}; - "tbit.nz", {opcode = "tbit.nz"; latency = 0; kind = KI; format = F_ri_rr}; - "tbit.z", {opcode = "tbit.z"; latency = 0; kind = KI; format = F_ri_rr}; - "xmpy.l", {opcode = "xmpy.l"; latency = 7; kind = KF; format = F_rr_r}; - "xor", {opcode = "xor"; latency = 1; kind = KA; format = F_rr_r}; - "xori", {opcode = "xor"; latency = 1; kind = KA; format = F_ir_r}; - "#initbarrier", {opcode = "# init barrier"; latency = 0; kind = KI; format = F_i}; -] - -(* Nodes of the code DAG. Each node represents one instruction to be - emitted. *) - -type code_dag_node = - { instr: instruction_descr; (* the instruction *) - imm: string; (* its immediate argument, if any *) - iarg: resource array; (* arguments *) - ires: resource array; (* results *) - delay: int; (* how many cycles before result is available *) - mutable sons: (code_dag_node * int) list; - (* nodes that depend on this node *) - mutable date: int; (* start date *) - mutable length: int; (* length of longest path to result *) - mutable ancestors: int; (* number of ancestors *) - mutable emitted_ancestors: int } (* number of emitted ancestors *) - -(* The code dag itself is represented by two tables from resources to nodes: - - "results" maps resources to the instructions that produced them; - - "uses" maps resources to the instructions that use them. *) - -let code_results = (Hashtbl.create 31 : (resource, code_dag_node) Hashtbl.t) -let code_uses = (Hashtbl.create 31 : (resource, code_dag_node) Hashtbl.t) - -let clear_code_dag () = - Hashtbl.clear code_results; - Hashtbl.clear code_uses - -(* The ready queue: a list of nodes that can be computed immediately - (all arguments are available), kept sorted by decreasing length to results. - - The in progress queue: a list of nodes whose arguments are being computed, - and thus can be computed at a later date, kept sorted by increasing - availability date - - The branch list: a list of all branch instructions (to be emitted last) *) - -let ready_queue = ref ([] : code_dag_node list) -let in_progress_queue = ref ([] : code_dag_node list) -let branch_list = ref ([] : code_dag_node list) (* built in reverse order *) - -let clear_queues () = - ready_queue := []; in_progress_queue := []; branch_list := [] - -let rec insert_queue prio node = function - [] -> [node] - | hd :: tl as queue -> - if prio node hd then node :: queue else hd :: insert_queue prio node tl - -let length_prio n1 n2 = n1.length > n2.length -let date_prio n1 n2 = n1.date < n2.date - -let add_ready node = - ready_queue := insert_queue length_prio node !ready_queue -let add_in_progress node = - in_progress_queue := insert_queue date_prio node !in_progress_queue -let add_branch node = - branch_list := node :: !branch_list - -(* Add an edge to the code DAG *) - -let add_edge ancestor son delay = - ancestor.sons <- (son, delay) :: ancestor.sons; - son.ancestors <- son.ancestors + 1 - -let add_edge_after son ancestor = add_edge ancestor son 0 - -(* Add an instruction to the code DAG *) - -let insimm opc arg imm res = - let instr = - try - Hashtbl.find instruction_table opc - with Not_found -> - fatal_error ("Unknown instruction " ^ opc) in - let node = - { instr = instr; - imm = imm; - iarg = arg; - ires = res; - delay = instr.latency; - sons = []; (* to be filled later *) - date = 0; (* to be adjusted later *) - length = -1; (* to be computed later *) - ancestors = 0; (* ditto *) - emitted_ancestors = 0 } in (* ditto *) - (* RAW dependencies: add edges from all instrs that define one of the - resources used *) - for i = 0 to Array.length arg - 1 do - try - let rsrc = arg.(i) in - if is_mutable_resource rsrc then begin - let anc = Hashtbl.find code_results rsrc in - let delay = if is_memory_resource rsrc then 0 else anc.delay in - (* Memory accesses are ordered by the hardware, so we can emit - a memop 1, then a dependent memop 2 in the same cycle *) - add_edge anc node delay - end - with Not_found -> - () - done; - (* WAR dependencies: add edges from all instrs that use one of the - resources defined by this instruction - WAW dependencies: add edges from all instrs that define one of the - resources defined by this instruction *) - for i = 0 to Array.length res - 1 do - let rsrc = res.(i) in - if is_mutable_resource rsrc then begin - (* WAR *) - let anc = Hashtbl.find_all code_uses res.(i) in - List.iter (add_edge_after node) anc; - (* WAW *) - try - let anc = Hashtbl.find code_results rsrc in - let delay = if is_memory_resource rsrc then 0 else 1 in - add_edge anc node delay - with Not_found -> - () - end - done; - (* Remember the results and uses of this instruction *) - for i = 0 to Array.length res - 1 do - Hashtbl.add code_results res.(i) node - done; - for i = 0 to Array.length arg - 1 do - Hashtbl.add code_uses arg.(i) node - done; - (* Insert in appropriate queue *) - if node.instr.kind = KB - then add_branch node - else if node.ancestors = 0 then add_ready node - -let insert opc arg res = - insimm opc arg "" res - -(* Compute length of longest path to a result. *) - -let rec longest_path node = - if node.length < 0 then begin - node.length <- - List.fold_left - (fun len (son, delay) -> max len (longest_path son + delay)) - 0 node.sons - end; - node.length - -(* Emit the assembly code for a node *) - -let emit_r = emit_string - -let emit_instr node = - let opc = node.instr.opcode - and a = node.iarg - and r = node.ires - and imm = node.imm in - match node.instr.format with - F_i -> - ` {emit_string opc} {emit_string imm}\n` - | F_i_pred -> - ` ({emit_r a.(0)}) {emit_string opc} {emit_string imm}\n` - | F_ir_rr -> - ` {emit_string opc} {emit_r r.(0)}, {emit_r r.(1)} = {emit_string imm}, {emit_r a.(0)}\n` - | F_ir_r -> - ` {emit_string opc} {emit_r r.(0)} = {emit_string imm}, {emit_r a.(0)}\n` - | F_ir_r_pred -> - ` ({emit_r a.(0)}) {emit_string opc} {emit_r r.(0)} = {emit_string imm}, {emit_r a.(1)}\n` - | F_ld -> - ` {emit_string opc} {emit_r r.(0)} = [{emit_r a.(0)}]\n` - | F_ld_post -> - ` {emit_string opc} {emit_r r.(0)} = [{emit_r a.(0)}], {emit_string imm}\n` - | F_r -> - ` {emit_string opc} {emit_r a.(0)}\n` - | F_i_r -> - ` {emit_string opc} {emit_r r.(0)} = {emit_string imm}\n` - | F_i_r_pred -> - ` ({emit_r a.(0)}) {emit_string opc} {emit_r r.(0)} = {emit_string imm}\n` - | F_ri_rr -> - ` {emit_string opc} {emit_r r.(0)}, {emit_r r.(1)} = {emit_r a.(0)}, {emit_string imm}\n` - | F_ri_r -> - ` {emit_string opc} {emit_r r.(0)} = {emit_r a.(0)}, {emit_string imm}\n` - | F_r_r -> - ` {emit_string opc} {emit_r r.(0)} = {emit_r a.(0)}\n` - | F_r_r_pred -> - ` ({emit_r a.(0)}) {emit_string opc} {emit_r r.(0)} = {emit_r a.(1)}\n` - | F_rr_rr -> - ` {emit_string opc} {emit_r r.(0)}, {emit_r r.(1)} = {emit_r a.(0)}, {emit_r a.(1)}\n` - | F_r_rir -> - ` {emit_string opc} {emit_r r.(0)} = {emit_r a.(0)}, {emit_string imm}, {emit_r a.(1)}\n` - | F_rr_r -> - ` {emit_string opc} {emit_r r.(0)} = {emit_r a.(0)}, {emit_r a.(1)}\n` - | F_rr_r_pred -> - ` ({emit_r a.(0)}) {emit_string opc} {emit_r r.(0)} = {emit_r a.(1)}, {emit_r a.(2)}\n` - | F_rri_r -> - ` {emit_string opc} {emit_r r.(0)} = {emit_r a.(0)}, {emit_r a.(1)}, {emit_string imm}\n` - | F_rrr_r -> - ` {emit_string opc} {emit_r r.(0)} = {emit_r a.(0)}, {emit_r a.(1)}, {emit_r a.(2)}\n` - | F_rrr_r_pred -> - ` ({emit_r a.(0)}) {emit_string opc} {emit_r r.(0)} = {emit_r a.(1)}, {emit_r a.(2)}, {emit_r a.(3)}\n` - | F_st -> - ` {emit_string opc} [{emit_r a.(0)}] = {emit_r a.(1)}\n` - | F_st_post -> - ` {emit_string opc} [{emit_r a.(0)}] = {emit_r a.(1)}, {emit_string imm}\n` - -(* Little state machine reflecting how many instructions the chip can - issue in one cycle. We roughly follow the Itanium model: - 2 int units, 2 mem units, 2 FP units, and 3 branch units, - with a maximum of 6 instructions dispatched per clock cycle. *) - -let num_A = ref 0 -let num_I = ref 0 -let num_M = ref 0 -let num_F = ref 0 -let num_B = ref 0 - -let reset_issue () = - num_A := 0; num_I := 0; num_M := 0; num_F := 0; num_B := 0 - -let can_issue instr = - if !num_A + !num_I + !num_M + !num_F + !num_B >= 6 then false else begin - match instr.kind with - KA -> - if !num_A + !num_I + !num_M < 4 - then (incr num_A; true) - else false - | KF -> - if !num_F < 2 then (incr num_F; true) else false - | KI -> - if !num_I < 2 && !num_A + !num_I + !num_M < 4 - then (incr num_I; true) else false - | KM -> - if !num_M < 2 && !num_A + !num_I + !num_M < 4 - then (incr num_M; true) else false - | _ (* KB | KB_exc *) -> - if !num_B < 3 then (incr num_B; true) else false - end - -(* Emit one node, updating the completion date and number of ancestors - emitted for all nodes that depend on this node. Enter the nodes - that are no longer waiting on anything (all ancestors emitted) - in the ready queue or in the in_progress queue, depending on - latency. *) - -let emit_node date node = - begin try - (*`# Date: {emit_int date}; distance: {emit_int node.length}\n`;*) - emit_instr node - with x -> - fatal_error ("Error while emitting " ^ node.instr.opcode) - end; - List.iter - (fun (son, delay) -> - let completion_date = date + delay in - if son.date < completion_date then son.date <- completion_date; - son.emitted_ancestors <- son.emitted_ancestors + 1; - if son.emitted_ancestors = son.ancestors && son.instr.kind <> KB then - begin - (*`# {emit_string son.instr.opcode} will be ready at {emit_int son.date}\n`;*) - if son.date = date then add_ready son else add_in_progress son - end) - node.sons - -(* Emit all ready nodes that we can emit given the architectural - constraints. *) - -let rec emit_ready_nodes filter date = - match !ready_queue with - [] -> [] - | node :: rem -> - ready_queue := rem; - if filter node && can_issue node.instr then begin - emit_node date node; - emit_ready_nodes filter date - end else - node :: emit_ready_nodes filter date - -let filter_MF node = - match node.instr.kind with KM -> true | KF -> true | _ -> false -let filter_non_MF node = - not(filter_MF node) - -(* Add all instructions with date <= d to the ready queue, and remove them *) - -let rec extract_ready d = function - [] -> [] - | node :: rem as queue -> - if node.date <= d then (add_ready node; extract_ready d rem) else queue - -(* Say if a branch is ready to be emitted now *) - -let branch_is_ready date br = - br.emitted_ancestors = br.ancestors && br.date <= date - -(* Schedule the basic block, emitting all of its instructions *) - -let rec reschedule date = - match (!ready_queue, !in_progress_queue) with - ([], []) -> - (* We're done with the regular instructions; finish with the branches *) - begin match !branch_list with - [] -> () - | br -> List.iter emit_instr br; emit_string " ;;\n" - end - | ([], node :: _) -> - (* Advance to the time node.date, extracting from in_progress_queue - all instructions ready at that time and adding them to the - ready queue *) - in_progress_queue := extract_ready node.date !in_progress_queue; - (* Try again *) - reschedule node.date - | (_, _) -> - ` # time {emit_int date}\n`; - (* Emit and remove as many ready instructions as we can *) - (* Give priority to M and F instructions *) - reset_issue(); - ready_queue := emit_ready_nodes filter_MF date; - ready_queue := emit_ready_nodes filter_non_MF date; - (* Special hack: if the only remaining instructions are branches - and they are all ready now, emit them in the current - group of instructions *) - if !ready_queue = [] - && !in_progress_queue = [] - && List.for_all (branch_is_ready date) !branch_list - then begin - List.iter emit_instr !branch_list; - branch_list := [] - end; - (* Emit a stop to pause the processor *) - emit_string " ;;\n"; - (* Advance to the time date + 1, extracting from in_progress_queue - all instructions ready at that time and adding them to the - ready queue *) - in_progress_queue := extract_ready (date + 1) !in_progress_queue; - (* Try again *) - reschedule (date + 1) - -(* Emit the code for the current basic block *) - -let end_basic_block () = - (* Compute critical paths and rebuild ready queue sorted by - decreasing criticality *) - let r = !ready_queue in - ready_queue := []; - let max_length = - List.fold_left (fun len node -> max len (longest_path node)) 0 r in - List.iter add_ready r; - branch_list := List.rev !branch_list; - (* Emit the instructions by traversing the code DAG *) - reschedule 0; - if max_length > 0 then ` # basic block length {emit_int max_length}\n`; - clear_code_dag (); - clear_queues () - -(************** Part 2: the code emitter *******************) - -(* Tradeoff between code size and code speed *) - -let fastcode_flag = ref true - -(* Translate or output a label *) - -let label lbl = sprintf ".L%d" lbl - -let emit_label lbl = emit_string ".L"; emit_int lbl - -(* Translate or output a symbol *) - -let symbol s = - let b = Buffer.create (String.length s + 1) in - for i = 0 to String.length s - 1 do - let c = s.[i] in - match c with - 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' -> - Buffer.add_char b c - | _ -> - Buffer.add_string b (sprintf "$%02x" (Char.code c)) - done; - Buffer.add_char b '#'; - Buffer.contents b - -let emit_symbol s = Emitaux.emit_symbol '$' s - -(* Translate a pseudo-register *) - -let reg r = - match r.loc with Reg r -> register_name r | _ -> assert false - -let regs r = - Array.map reg r - -(* Output a pseudo-register *) - -let emit_reg r = - match r.loc with - Reg r -> emit_string (register_name r) - | _ -> fatal_error "Emit_ia64.emit_reg" - -(* Translate a float as a 64-bit integer *) - -let float_bits f = - let b = Buffer.create 18 in - let bytes = (Obj.magic f : string) in - Buffer.add_string b "0x"; - for i = 7 downto 0 do (* little-endian *) - Buffer.add_string b - (sprintf "%02x" (Char.code (String.unsafe_get bytes i))) - done; - Buffer.contents b - -(* Translate an "ltoffset" reference to a global *) - -let ltoffset s = sprintf "@ltoff(%s)" (symbol s) -let ltoffset_fptr s = sprintf "@ltoff(@fptr(%s))" (symbol s) - -(* Layout of the stack frame. - All stack offsets are shifted by 16 to preserve the scratch area at - bottom of stack. *) - -let stack_offset = ref 0 - -let frame_size () = - let size = - !stack_offset + - 8 * (num_stack_slots.(0) + num_stack_slots.(1)) + - (if !contains_calls then 8 else 0) in - Misc.align size 16 - -let slot_offset loc cl = - match loc with - Incoming n -> frame_size() + n + 16 - | Local n -> - if cl = 0 - then !stack_offset + n * 8 + 16 - else !stack_offset + (num_stack_slots.(0) + n) * 8 + 16 - | Outgoing n -> n + 16 - -let slot_offset_reg r = - match r.loc with - Stack l -> slot_offset l (register_class r) - | _ -> assert false - -(* Record live pointers at call points *) - -type frame_descr = - { fd_lbl: int; (* Return address *) - fd_frame_size: int; (* Size of stack frame *) - fd_live_offset: int list } (* Offsets/regs of live addresses *) - -let frame_descriptors = ref([] : frame_descr list) - -let record_frame_label live = - let lbl = new_label() in - let live_offset = ref [] in - Reg.Set.iter - (function - {typ = Addr; loc = Reg r} -> - live_offset := ((r lsl 1) + 1) :: !live_offset - | {typ = Addr; loc = Stack s} as reg -> - live_offset := slot_offset s (register_class reg) :: !live_offset - | _ -> ()) - live; - frame_descriptors := - { fd_lbl = lbl; - fd_frame_size = frame_size(); - fd_live_offset = !live_offset } :: !frame_descriptors; - lbl - -let record_frame live = - let lbl = record_frame_label live in `{emit_label lbl}:` - -let emit_frame fd = - ` data8 {emit_label fd.fd_lbl}\n`; - ` data2 {emit_int fd.fd_frame_size}\n`; - ` data2 {emit_int (List.length fd.fd_live_offset)}\n`; - List.iter - (fun n -> - ` data2 {emit_int n}\n`) - fd.fd_live_offset; - ` .align 8\n` - -(* Names of various instructions *) - -let name_for_int_operation = function - Iadd -> "add" - | Isub -> "sub" - | Iand -> "and" - | Ior -> "or" - | Ixor -> "xor" - | Ilsl -> "shl" - | Ilsr -> "shru" - | Iasr -> "shr" - | _ -> Misc.fatal_error "Emit.name_for_int_operation" - -let name_for_float_operation = function - Inegf -> "fneg" - | Iabsf -> "fabs" - | Iaddf -> "fadd.d" - | Isubf -> "fsub.d" - | Imulf -> "fmpy.d" - | _ -> Misc.fatal_error "Emit.name_for_float_operation" - -let name_for_specific_operation = function - Imultaddf -> "fma.d" - | Imultsubf -> "fms.d" - | Isubmultf -> "fnma.d" - | _ -> Misc.fatal_error "Emit.name_for_specific_operation" - -let name_for_int_comparison = function - Isigned Ceq -> "eq" | Isigned Cne -> "ne" - | Isigned Cle -> "le" | Isigned Cgt -> "gt" - | Isigned Clt -> "lt" | Isigned Cge -> "ge" - | Iunsigned Ceq -> "eq" | Iunsigned Cne -> "ne" - | Iunsigned Cle -> "leu" | Iunsigned Cgt -> "gtu" - | Iunsigned Clt -> "ltu" | Iunsigned Cge -> "geu" - -let name_for_swapped_int_comparison = function - Isigned Ceq -> "eq" | Isigned Cne -> "ne" - | Isigned Cle -> "ge" | Isigned Cgt -> "lt" - | Isigned Clt -> "gt" | Isigned Cge -> "le" - | Iunsigned Ceq -> "eq" | Iunsigned Cne -> "ne" - | Iunsigned Cle -> "geu" | Iunsigned Cgt -> "ltu" - | Iunsigned Clt -> "gtu" | Iunsigned Cge -> "leu" - -let name_for_float_comparison cmp = - match cmp with - Ceq -> "eq" | Cne -> "neq" - | Cle -> "le" | Cgt -> "gt" - | Clt -> "lt" | Cge -> "ge" - -(* Immediate range for addl (move) and adds (general add) instructions *) - -let is_immediate_addl n = n >= -0x200000 && n < 0x200000 -let is_immediate_addl_nat n = - n >= Nativeint.of_int (-0x200000) && n < Nativeint.of_int 0x200000 -let is_immediate_adds n = n >= -0x2000 && n < 0x2000 - -(* Return the positions of all "1" bits in the given integer, - most significant bits first *) - -let ones_pos n = - let rec ones p accu = - if p >= 63 - then accu - else ones (p+1) (if n land (1 lsl p) = 0 then accu else p :: accu) in - ones 0 [] - -(* Generate temporary registers *) - -let temp_generator temporaries = - let counter = ref 0 in - fun () -> - let r = temporaries.(!counter) in - incr counter; - if !counter >= Array.length temporaries then counter := 0; - r - -let new_temp_reg = - temp_generator [| "r2"; "r3"; "r14"; "r15" |] -let new_temp_float = - temp_generator [| "f64"; "f65"; "f66"; "f67"; - "f68"; "f69"; "f70"; "f71" |] -let new_pred = - temp_generator [| "p2"; "p3"; "p4"; "p5" |] - -(* Output the assembly code for an instruction *) - -(* Name of current function *) -let function_name = ref "" -(* Entry point for tail recursive calls *) -let tailrec_entry_point = ref 0 - -let emit_instr i = - match i.desc with - Lend -> () - | Lop(Imove | Ispill | Ireload) -> - let src = i.arg.(0) and dst = i.res.(0) in - if src.loc <> dst.loc then begin - match (src.loc, dst.loc) with - (Reg _, Reg _) -> - insert "mov" (regs i.arg) (regs i.res) - | (Reg _, Stack _) -> - let offset = string_of_int (slot_offset_reg dst) in - let r = new_temp_reg() in - insimm "addi" [| "sp" |] offset [| r |]; - insert (if i.res.(0).typ = Float then "stfd" else "st8") - [| r; reg src |] [| "stk" ^ offset |] - | (Stack _, Reg _) -> - let offset = string_of_int (slot_offset_reg src) in - let r = new_temp_reg() in - insimm "addi" [| "sp" |] offset [| r |]; - insert (if i.arg.(0).typ = Float then "ldfd" else "ld8") - [| r; "stk" ^ offset |] (regs i.res) - | (_, _) -> - assert false - end - | Lop(Iconst_int n) -> - let instr = - if is_immediate_addl_nat n then "movi" else "movil" in - insimm instr [||] (Nativeint.to_string n) (regs i.res) - | Lop(Iconst_float s) -> - let f = float_of_string s in - begin match Int64.bits_of_float f with - | 0x0000_0000_0000_0000L -> (* +0.0 *) - insert "mov" [| "f0" |] (regs i.res) - | 0x3FF0_0000_0000_0000L -> (* 1.0 *) - insert "mov" [| "f1" |] (regs i.res) - | _ -> - let tmp = new_temp_reg() in - insimm "movil" [||] (float_bits f) [| tmp |]; - insert "setf.d" [| tmp |] (regs i.res) - end - | Lop(Iconst_symbol s) -> - insimm "addi" [| "gp" |] (ltoffset s) (regs i.res); - insert "ld8" (regs i.res) (regs i.res) - | Lop(Icall_ind) -> - insert "movtb" (regs i.arg) [| "b0" |]; - insert "brcallind" [| "b0" |] [| "b0" |]; - end_basic_block(); - `{record_frame i.live}\n` - | Lop(Icall_imm s) -> - insimm "brcall" [||] (symbol s) [| "b0" |]; - end_basic_block(); - `{record_frame i.live}\n` - | Lop(Itailcall_ind) -> - let n = frame_size() in - insert "movtb" (regs i.arg) [| "b6" |]; - if !contains_calls then begin - let tmp = new_temp_reg() in - insimm "addi" [| "sp" |] (string_of_int (n + 8)) [| tmp |]; - insert "ld8" [| tmp |] [| tmp |]; - insert "mov" [| tmp |] [| "b0" |] - end; - if n > 0 then - insimm "addi" [| "sp" |] (string_of_int n) [| "sp" |]; - insert "brind" [| "b6" |] [||]; - end_basic_block() - | Lop(Itailcall_imm s) -> - if s = !function_name then begin - insimm "br" [||] (label !tailrec_entry_point) [||] - end else begin - let n = frame_size() in - if !contains_calls then begin - let tmp = new_temp_reg() in - insimm "addi" [| "sp" |] (string_of_int (n + 8)) [| tmp |]; - insert "ld8" [| tmp |] [| tmp |]; - insert "mov" [| tmp |] [| "b0" |] - end; - if n > 0 then - insimm "addi" [| "sp" |] (string_of_int n) [| "sp" |]; - insimm "br" [||] (symbol s) [||] - end; - end_basic_block() - | Lop(Iextcall(s, alloc)) -> - if alloc then begin - let tmp = new_temp_reg() in - insimm "addi" [| "gp" |] (ltoffset_fptr s) [| tmp |]; - insert "ld8" [| tmp |] [| "r2" |]; - insimm "brcall" [||] "caml_c_call#" [| "b0" |]; - end_basic_block(); - `{record_frame i.live}\n` - end else begin - insert "mov" [| "gp" |] [| "r7" |]; - insimm "brcall" [||] (symbol s) [| "b0" |]; - end_basic_block(); - insert "mov" [| "r7" |] [| "gp" |] - end - | Lop(Istackoffset n) -> - end_basic_block(); - insimm "addi" [| "sp" |] (string_of_int (-n)) [| "sp" |]; - stack_offset := !stack_offset + n - | Lop(Iload(chunk, addr)) -> - let load_instr = - match chunk with - | Byte_unsigned -> "ld1" - | Byte_signed -> "ld1" - | Sixteen_unsigned -> "ld2" - | Sixteen_signed -> "ld2" - | Thirtytwo_unsigned -> "ld4" - | Thirtytwo_signed -> "ld4" - | Word -> "ld8" - | Single -> "ldfs" - | Double -> "ldfd" - | Double_u -> "ldfd" in - insert load_instr [| reg i.arg.(0); "heap" |] (regs i.res); - let sext_instr = - match chunk with - Byte_signed -> "sxt1" - | Sixteen_signed -> "sxt2" - | Thirtytwo_signed -> "sxt4" - | _ -> "" in - if sext_instr <> "" then - insert sext_instr (regs i.res) (regs i.res) - | Lop(Istore(chunk, addr)) -> - let store_instr = - match chunk with - | Byte_unsigned -> "st1" - | Byte_signed -> "st1" - | Sixteen_unsigned -> "st2" - | Sixteen_signed -> "st2" - | Thirtytwo_unsigned -> "st4" - | Thirtytwo_signed -> "st4" - | Word -> "st8" - | Single -> "stfs" - | Double -> "stfd" - | Double_u -> "stfd" in - insert store_instr [| reg i.arg.(1); reg i.arg.(0) |] [| "heap" |] - | Lop(Ialloc n) -> - if !fastcode_flag then begin - insimm "addi" [| "r4" |] (string_of_int (-n)) [| "r4" |]; - insert "cmp.ltu" [| "r4"; "r5" |] [| "p6"; "p0" |]; - insimm "movi" [||] (string_of_int n) [| "r2" |]; - insimm "brcallcond" [| "p6" |] "caml_call_gc#" [| "b0" |]; - end_basic_block(); - `{record_frame i.live}\n`; - insimm "addi" [| "r4" |] "8" (regs i.res) - end else begin - insimm "movi" [||] (string_of_int n) [| "r2" |]; - insimm "brcall" [||] "caml_allocN#" [| "b0" |]; - end_basic_block(); - `{record_frame i.live}\n`; - insimm "addi" [| "r4" |] "8" (regs i.res) - end - | Lop(Iintop Imul) -> - let t1 = new_temp_float() and t2 = new_temp_float() in - insert "setf.sig" [|reg i.arg.(0)|] [| t1 |]; - insert "setf.sig" [|reg i.arg.(1)|] [| t2 |]; - insert "xmpy.l" [| t1; t2 |] [| t1 |]; - insert "getf.sig" [| t1 |] (regs i.res) - | Lop(Iintop(Icomp cmp)) -> - let comp = "cmpp." ^ name_for_int_comparison cmp in - let p1 = new_pred() and p2 = new_pred() in - insert comp (regs i.arg) [| p1; p2 |]; - insimm "movicond" [| p1 |] "1" (regs i.res); - insimm "movicond" [| p2 |] "0" (regs i.res) - | Lop(Iintop(Icheckbound)) -> - insert "cmp.leu" (regs i.arg) [| "p6"; "p0" |]; - insimm "brcallcondexc" [| "p6" |] "caml_ml_array_bound_error#" - [| "b0"; "heap" |] - | Lop(Iintop op) -> - let instr = name_for_int_operation op in - insert instr (regs i.arg) (regs i.res) - | Lop(Iintop_imm(Imul, n)) -> - let src = reg i.arg.(0) and dst = reg i.res.(0) in - begin match ones_pos n with - [] -> - insimm "movi" [||] "0" [|dst|] - | [n] -> - insimm "shli" [|src|] (string_of_int n) [|dst|] - | [n; 0] when n <= 4 -> - insimm "shladd" [|src; src|] (string_of_int n) [|dst|] - | n1::n2::lst -> - let acc1 = new_temp_reg() and acc2 = new_temp_reg() - and tmp1 = new_temp_reg() and tmp2 = new_temp_reg() in - insimm "shli" [|src|] (string_of_int n1) [|acc1|]; - insimm "shli" [|src|] (string_of_int n2) [|acc2|]; - let rec add_shifts a1 t1 a2 t2 = function - [] -> - insert "add" [|a1; a2|] [|dst|] - | n::rem -> - if n = 0 then - insert "add" [|src; a1|] [|a1|] - else if n <= 4 then - insimm "shladd" [|src; a1|] (string_of_int n) [|a1|] - else begin - insimm "shli" [|src|] (string_of_int n) [|t1|]; - insert "add" [|t1; a1|] [|a1|] - end; - add_shifts a2 t2 a1 t1 rem in - add_shifts acc1 tmp1 acc2 tmp2 lst - end - | Lop(Iintop_imm(Idiv, n)) -> (* n must be a power of 2 *) - let src = regs i.arg and dst = regs i.res in - let p1 = new_pred() and p2 = new_pred() in - let l = Misc.log2 n in - insert "cmpp.lt" [| src.(0); "r0" |] [| p1; p2 |]; - if is_immediate_adds (n-1) then - insimm "addicond" [| p1; src.(0) |] (string_of_int (n-1)) dst - else begin - let moveop = if is_immediate_addl (n-1) then "movi" else "movil" in - insimm moveop [||] (string_of_int (n-1)) [| "r2" |]; - insert "addcond" [| p1; src.(0); "r2" |] dst - end; - insert "movcond" [| p2; src.(0) |] dst; - insimm "shri" dst (string_of_int l) dst - | Lop(Iintop_imm(Imod, n)) -> (* n must be a power of 2 *) - let src = regs i.arg and dst = regs i.res in - let p = new_pred() in - let l = Misc.log2 n in - insert "cmpp.lt" [| src.(0); "r0" |] [| p; "p0" |]; - insimm "extr.u" src (sprintf "0, %d" l) dst; - insert "cmpp.ne.and" [| dst.(0); "r0"; p |] [| p; "p0" |]; - if is_immediate_adds (-n) then - insimm "addicond" [| p; dst.(0) |] (string_of_int (-n)) dst - else begin - let moveop = if is_immediate_addl (-n) then "movi" else "movil" in - insimm moveop [||] (string_of_int (-n)) [| "r2" |]; - insert "addcond" [| p; dst.(0); "r2" |] dst - end - | Lop(Iintop_imm(Icomp cmp, n)) -> - let comp = "cmppi." ^ name_for_swapped_int_comparison cmp in - let p1 = new_pred() and p2 = new_pred() in - insimm comp (regs i.arg) (string_of_int n) [| p1; p2 |]; - insimm "movicond" [| p1 |] "1" (regs i.res); - insimm "movicond" [| p2 |] "0" (regs i.res) - | Lop(Iintop_imm(Icheckbound, n)) -> - insimm "cmpi.geu" (regs i.arg) (string_of_int n) [| "p6"; "p0" |]; - insimm "brcallcondexc" [| "p6" |] "caml_ml_array_bound_error#" - [| "b0"; "heap" |] - | Lop(Iintop_imm(op, n)) -> - let instr = name_for_int_operation op ^ "i" in - insimm instr (regs i.arg) (string_of_int n) (regs i.res) - | Lop(Inegf | Iabsf | Iaddf | Isubf | Imulf as op) -> - let instr = name_for_float_operation op in - insert instr (regs i.arg) (regs i.res) - | Lop(Idivf) -> - (* Straight from the IA64 application developer's architecture guide, - section 13.3.3.1. Modified so that the destination may be equal - to one of the operands *) - let a = reg i.arg.(0) and b = reg i.arg.(1) and r = reg i.res.(0) - and t1 = new_temp_float() and t2 = new_temp_float() - and t3 = new_temp_float() and t4 = new_temp_float() - and p = new_pred() in - insert "frcpa" [| a; b |] [| t1; p |]; - insert "fmas1cond" [| p; a; t1; "f0" |] [| t2 |]; - insert "fnmas1cond" [| p; b; t1; "f1" |] [| t3 |]; - insert "fmas1cond" [| p; t3; t3; t2 |] [| t2 |]; - insert "fmas1cond" [| p; t3; t3; "f0" |] [| t4 |]; - insert "fmas1cond" [| p; t3; t1; t1 |] [| t1 |]; - insert "fmas1cond" [| p; t4; t2; t2 |] [| t2 |]; - insert "fmas1cond" [| p; t4; t4; "f0" |] [| t3 |]; - insert "fmas1cond" [| p; t4; t1; t1 |] [| t1 |]; - insert "fmads1cond" [| p; t3; t2; t2 |] [| t2 |]; - insert "fmas1cond" [| p; t3; t1; t1 |] [| t1 |]; - insert "fnmads1cond" [| p; b; t2; a |] [| t3 |]; - insert "mov" [| t1 |] [| r |]; - insert "fmacond" [| p; t3; t1; t2 |] [| r |] - | Lop(Ifloatofint) -> - let src = regs i.arg and dst = regs i.res in - insert "setf.sig" src dst; - insert "fcvt.xf" dst dst; - insert "fnorm.d" dst dst - | Lop(Iintoffloat) -> - let src = regs i.arg and dst = regs i.res and tmp = new_temp_float() in - insert "fcvt.fx.trunc" src [| tmp |]; - insert "getf.sig" [| tmp |] dst - | Lop(Ispecific(Iadd1)) -> - let s = if Array.length i.arg >= 2 then 1 else 0 in - insimm "add1" [| reg i.arg.(0); reg i.arg.(s) |] "1" (regs i.res) - | Lop(Ispecific(Isub1)) -> - insimm "sub1" (regs i.arg) "1" (regs i.res) - | Lop(Ispecific(Ishladd n)) -> - insimm "shladd" (regs i.arg) (string_of_int n) (regs i.res) - | Lop(Ispecific(Isignextend n)) -> - let op = "sxt" ^ string_of_int n in - insert op (regs i.arg) (regs i.res) - | Lop(Ispecific (Imultaddf | Imultsubf | Isubmultf as sop)) -> - let name = name_for_specific_operation sop in - insert name (regs i.arg) (regs i.res) - | Lop(Ispecific (Istoreincr n)) -> - let op = if i.arg.(1).typ = Float then "stfd+" else "st8+" in - insimm op [| reg i.arg.(0); reg i.arg.(1) |] - (string_of_int n) - [| reg i.res.(0); "heapinit" |] - | Lop(Ispecific Iinitbarrier) -> - insert "#initbarrier" [| "heapinit" |] [| "heap" |] - | Lreloadretaddr -> - let n = frame_size() + 8 in - let tmp = new_temp_reg() in - insimm "addi" [| "sp" |] (string_of_int n) [| tmp |]; - insert "ld8" [| tmp |] [| tmp |]; - insert "movtb" [| tmp |] [| "b0" |] - | Lreturn -> - let n = frame_size() in - if n > 0 then - insimm "addi" [| "sp" |] (string_of_int n) [| "sp" |]; - insert "brret" [| "b0" |] [||]; - end_basic_block() - | Llabel lbl -> - end_basic_block(); - `{emit_label lbl}:\n` - | Lbranch lbl -> - insimm "br" [||] (label lbl) [||]; - end_basic_block() - | Lcondbranch(tst, lbl) -> - begin match tst with - Itruetest -> - insimm "cmpi.ne" (regs i.arg) "0" [| "p6"; "p0" |] - | Ifalsetest -> - insimm "cmpi.eq" (regs i.arg) "0" [| "p6"; "p0" |] - | Iinttest cmp -> - let comp = "cmp." ^ name_for_int_comparison cmp in - insert comp (regs i.arg) [| "p6"; "p0" |] - | Iinttest_imm(cmp, n) -> - let comp = "cmpi." ^ name_for_swapped_int_comparison cmp in - insimm comp (regs i.arg) (string_of_int n) [| "p6"; "p0" |] - | Ifloattest(cmp, neg) -> - let comp = "fcmp." ^ name_for_float_comparison cmp in - insert comp (regs i.arg) - (if neg then [| "p0"; "p6" |] - else [| "p6"; "p0" |]) - | Ioddtest -> - insimm "tbit.nz" (regs i.arg) "0" [| "p6"; "p0" |] - | Ieventest -> - insimm "tbit.z" (regs i.arg) "0" [| "p6"; "p0" |] - end; - insimm "brcond" [| "p6" |] (label lbl) [||]; - end_basic_block() - | Lcondbranch3(lbl0, lbl1, lbl2) -> - end_basic_block(); - let emit_compare n p = function - None -> () - | Some lbl -> - ` cmp.eq p{emit_int p}, p0 = {emit_int n}, {emit_reg i.arg.(0)}\n` in - let emit_branch p = function - None -> () - | Some lbl -> - ` (p{emit_int p}) br {emit_label lbl}\n` in - emit_compare 0 5 lbl0; emit_compare 1 6 lbl1; emit_compare 2 7 lbl2; - emit_branch 5 lbl0; emit_branch 6 lbl1; emit_branch 7 lbl2; - ` ;;\n` - | Lswitch jumptbl -> - end_basic_block(); - let numcases = Array.length jumptbl in - if numcases <= 9 then begin - for j = 0 to numcases / 3 do - let n = j * 3 in - for k = 0 to 2 do - if n + k < numcases - 1 then - ` cmp.eq p{emit_int(k+5)}, p0 = {emit_int (n+k)}, {emit_reg i.arg.(0)}\n` - done; - for k = 0 to 2 do - if n + k < numcases - 1 then - ` (p{emit_int(k+5)}) br {emit_label jumptbl.(n+k)}\n` - else if n + k = numcases - 1 then - ` br {emit_label jumptbl.(n+k)}\n` - done; - ` ;;\n` - done - end else if numcases <= 47 then begin - ` mov r2 = 1\n`; - ` cmp.eq p6, p0 = 0, {emit_reg i.arg.(0)}\n`; - ` (p6) br {emit_label jumptbl.(0)} ;;\n`; - ` shl r2 = r2, {emit_reg i.arg.(0)}\n`; - ` cmp.eq p7, p0 = 1, {emit_reg i.arg.(0)}\n`; - ` (p7) br {emit_label jumptbl.(1)} ;;\n`; - ` mov pr = r2, -1 ;;\n`; - for i = 2 to numcases - 1 do - ` (p{emit_int i}) br {emit_label jumptbl.(i)}\n` - done; - ` ;;\n` - end else begin - let lbl_jumptbl = new_label() in - let lbl_ip = new_label() in - `{emit_label lbl_ip}: mov r2 = ip ;;\n`; - ` add r2 = {emit_label lbl_jumptbl} - {emit_label lbl_ip}, r2 ;;\n`; - ` shladd r3 = {emit_reg i.arg.(0)}, 2, r2 ;;\n`; - ` ld4 r3 = [r3] ;;\n`; - ` sxt4 r3 = r3 ;;\n`; - ` add r2 = r2, r3 ;;\n`; - ` mov b6 = r2 ;;\n`; - ` br b6 ;;\n`; - ` .align 4\n`; - `{emit_label lbl_jumptbl}:\n`; - for i = 0 to numcases - 1 do - ` data4 {emit_label jumptbl.(i)} - {emit_label lbl_jumptbl}\n` - done; - ` .align 16\n` - end - | Lsetuptrap lbl -> - end_basic_block(); - let lbl_ip = new_label() in - let lbl_next = new_label() in - `{emit_label lbl_ip}: mov r2 = ip ;;\n`; - ` add r2 = {emit_label lbl_next} - {emit_label lbl_ip}, r2\n`; - ` br.sptk {emit_label lbl} ;;\n`; - `{emit_label lbl_next}:\n` - | Lpushtrap -> - end_basic_block(); - stack_offset := !stack_offset + 16; - (* Store trap pointer at sp, handler addr at sp+8, - and decrement sp by 16. Remember, the bottom 16 bytes - of the stack must be left free. *) - ` add r3 = 8, sp\n`; - ` st8 [sp] = r6, -16 ;;\n`; - ` st8 [r3] = r2\n`; - ` add r6 = 16, sp ;;\n` - | Lpoptrap -> - end_basic_block(); - ` add sp = 16, sp ;;\n`; - ` ld8 r6 = [sp] ;;\n`; - stack_offset := !stack_offset - 16 - | Lraise -> - end_basic_block(); - ` mov sp = r6\n`; - ` add r2 = 8, r6\n`; - ` ld8 r6 = [r6] ;;\n`; - ` ld8 r2 = [r2] ;;\n`; - ` mov b6 = r2 ;;\n`; - ` br b6\n` - -let rec emit_all i = - match i.desc with Lend -> () | _ -> emit_instr i; emit_all i.next - -(* Check if a function contains a tail call to itself *) - -let rec is_tailrec i = - match i.desc with - Lend -> false - | Lop(Itailcall_imm s) when s = !function_name -> true - | _ -> is_tailrec i.next - -(* Emission of a function declaration *) - -let fundecl f = - function_name := f.fun_name; - fastcode_flag := f.fun_fast; - stack_offset := 0; - ` .text\n`; - ` .align 4\n`; - ` .global {emit_symbol f.fun_name}#\n`; - ` .proc {emit_symbol f.fun_name}#\n`; - `{emit_symbol f.fun_name}:\n`; - let n = frame_size() in - if !contains_calls then begin - insert "movfb" [| "b0" |] [| "r2" |]; - insimm "addi" [| "sp" |] "8" [| "r3" |]; - insimm "addi" [| "sp" |] (string_of_int (-n)) [| "sp" |]; - insert "st8" [| "r3"; "r2" |] [||] - end - else if n > 0 then - insimm "addi" [| "sp" |] (string_of_int (-n)) [| "sp" |]; - if is_tailrec f.fun_body then begin - tailrec_entry_point := new_label(); - end_basic_block(); - `{emit_label !tailrec_entry_point}:\n` - end; - emit_all f.fun_body; - end_basic_block(); - ` .endp {emit_symbol f.fun_name}#\n` - -(* Emission of data *) - -let emit_global_symbol s = - ` .global {emit_symbol s}#\n`; - ` .type {emit_symbol s}#, @object\n`; - ` .size {emit_symbol s}#, 8\n` - -let emit_define_symbol s = - emit_global_symbol s; - `{emit_symbol s}:\n` - -let emit_item = function - Cglobal_symbol s -> - emit_global_symbol s - | Cdefine_symbol s -> - `{emit_symbol s}:\n` - | Cdefine_label lbl -> - `{emit_label (100000 + lbl)}:\n` - | Cint8 n -> - ` data1 {emit_int n}\n` - | Cint16 n -> - ` data2 {emit_int n}\n` - | Cint32 n -> - let n' = Nativeint.shift_right (Nativeint.shift_left n 32) 32 in - ` data4 {emit_nativeint n'}\n` - | Cint n -> - ` data8 {emit_nativeint n}\n` - | Csingle f -> - emit_float32_directive "data4" f - | Cdouble f -> - emit_float64_directive "data8" f - | Csymbol_address s -> - ` data8 {emit_symbol s}#\n` - | Clabel_address lbl -> - ` data8 {emit_label (100000 + lbl)}\n` - | Cstring s -> - emit_string_directive " string " s - | Cskip n -> - if n > 0 then ` .skip {emit_int n}\n` - | Calign n -> - ` .align {emit_int n}\n` - -let data l = - ` .data\n`; - ` .align 8\n`; - List.iter emit_item l - -(* Beginning / end of an assembly file *) - -let begin_assembly() = - ` .data\n`; - emit_define_symbol (Compilenv.make_symbol (Some "data_begin")); - ` .text\n`; - emit_define_symbol (Compilenv.make_symbol (Some "code_begin")) - -let end_assembly () = - ` .data\n`; - emit_define_symbol (Compilenv.make_symbol (Some "data_end")); - ` .text\n`; - emit_define_symbol (Compilenv.make_symbol (Some "code_end")); - ` .rodata\n`; - ` .align 8\n`; - emit_define_symbol (Compilenv.make_symbol (Some "frametable")); - ` data8 {emit_int (List.length !frame_descriptors)}\n`; - List.iter emit_frame !frame_descriptors; - frame_descriptors := [] diff -Nru ocaml-3.12.1/asmcomp/ia64/proc.ml ocaml-4.01.0/asmcomp/ia64/proc.ml --- ocaml-3.12.1/asmcomp/ia64/proc.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/ia64/proc.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,217 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2000 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: proc.ml 9547 2010-01-22 12:48:24Z doligez $ *) - -(* Description of the IA64 processor *) - -open Misc -open Cmm -open Reg -open Arch -open Mach - -(* Instruction selection *) - -let word_addressed = false - -(* Registers available for register allocation *) - -(* Register map: - r0 always 0 - r1 global pointer (gp) - r2 - r3 temporaries (for the code generator) - r4 allocation pointer - r5 allocation limit - r6 trap pointer - r7 saved gp during C calls (preserved by C) - r8 - r11 0 - 3 function results - r12 stack pointer - r13 reserved by C (thread-specific data) - r14 - r15 80 - 81 temporaries (for accessing stack variables) - r16 - r31 4 - 19 general purpose - r32 - r63 20 - 51 function arguments - r64 - r91 52 - 79 general purpose - r92 - r95 used by C glue code - - We do not use register windows, but instead allocate 64 "out" registers - (r32-r95) when entering Caml code. - - f0 always 0.0 - f1 always 1.0 - f2 - f5 100 - 103 general purpose (preserved by C) - f6 - f7 104 - 105 general purpose - f8 - f15 106 - 113 function results - f16 - f31 114 - 129 function arguments (preserved by C) - f32 - f63 130 - 161 general purpose - f64 - f66 temporaries - f67 - f127 unused -*) - -let int_reg_name = [| - (* 0-3 *) "r8"; "r9"; "r10"; "r11"; - (* 4-19 *) "r16"; "r17"; "r18"; "r19"; "r20"; "r21"; "r22"; "r23"; - "r24"; "r25"; "r26"; "r27"; "r28"; "r29"; "r30"; "r31"; - (* 20-51 *) "r32"; "r33"; "r34"; "r35"; "r36"; "r37"; "r38"; "r39"; - "r40"; "r41"; "r42"; "r43"; "r44"; "r45"; "r46"; "r47"; - "r48"; "r49"; "r50"; "r51"; "r52"; "r53"; "r54"; "r55"; - "r56"; "r57"; "r58"; "r59"; "r60"; "r61"; "r62"; "r63"; - (* 52-79 *) "r64"; "r65"; "r66"; "r67"; "r68"; "r69"; "r70"; "r71"; - "r72"; "r73"; "r74"; "r75"; "r76"; "r77"; "r78"; "r79"; - "r80"; "r81"; "r82"; "r83"; "r84"; "r85"; "r86"; "r87"; - "r88"; "r89"; "r90"; "r91"; - (* 80-81 *) "r14"; "r15" -|] - -let float_reg_name = [| - (* 0-13 *) "f2"; "f3"; "f4"; "f5"; "f6"; "f7"; - "f8"; "f9"; "f10"; "f11"; "f12"; "f13"; "f14"; "f15"; - (* 14-29 *) "f16"; "f17"; "f18"; "f19"; "f20"; "f21"; "f22"; "f23"; - "f24"; "f25"; "f26"; "f27"; "f28"; "f29"; "f30"; "f31"; - (* 30-61 *) "f32"; "f33"; "f34"; "f35"; "f36"; "f37"; "f38"; "f39"; - "f40"; "f41"; "f42"; "f43"; "f44"; "f45"; "f46"; "f47"; - "f48"; "f49"; "f50"; "f51"; "f52"; "f53"; "f54"; "f55"; - "f56"; "f57"; "f58"; "f59"; "f60"; "f61"; "f62"; "f63" -|] - -let num_register_classes = 2 - -let register_class r = - match r.typ with - Int -> 0 - | Addr -> 0 - | Float -> 1 - -let num_available_registers = [| 80; 62 |] - -let first_available_register = [| 0; 100 |] - -let register_name r = - if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100) - -let rotate_registers = true - -(* Representation of hard registers by pseudo-registers *) - -let hard_int_reg = - let v = Array.create 82 Reg.dummy in - for i = 0 to 81 do v.(i) <- Reg.at_location Int (Reg i) done; - v - -let hard_float_reg = - let v = Array.create 62 Reg.dummy in - for i = 0 to 61 do v.(i) <- Reg.at_location Float (Reg(100 + i)) done; - v - -let all_phys_regs = - Array.append hard_int_reg hard_float_reg - -let phys_reg n = - if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100) - -let stack_slot slot ty = - Reg.at_location ty (Stack slot) - -(* Calling conventions *) - -let calling_conventions first_int last_int first_float last_float - lockstep make_stack arg = - let loc = Array.create (Array.length arg) Reg.dummy in - let int = ref first_int in - let float = ref first_float in - let ofs = ref 0 in - for i = 0 to Array.length arg - 1 do - match arg.(i).typ with - Int | Addr as ty -> - if !int <= last_int then begin - loc.(i) <- phys_reg !int; - incr int; - if lockstep then incr float - end else begin - loc.(i) <- stack_slot (make_stack !ofs) ty; - ofs := !ofs + size_int - end - | Float -> - if !float <= last_float then begin - loc.(i) <- phys_reg !float; - incr float; - if lockstep then incr int - end else begin - loc.(i) <- stack_slot (make_stack !ofs) Float; - ofs := !ofs + size_float - end - done; - (loc, Misc.align !ofs 16) (* Keep stack 16-aligned *) - -let incoming ofs = Incoming ofs -let outgoing ofs = Outgoing ofs -let not_supported ofs = fatal_error "Proc.loc_results: cannot call" - -let loc_arguments arg = - calling_conventions 20 51 114 129 false outgoing arg -let loc_parameters arg = - let (loc, ofs) = calling_conventions 20 51 114 129 false incoming arg in loc -let loc_results res = - let (loc, ofs) = calling_conventions 0 3 106 113 false not_supported res - in loc -(* Arguments in r32...r39, f8...f15 - Results in r8...r11, f8...f15 *) -let loc_external_arguments arg = - calling_conventions 20 27 106 113 true outgoing arg -let loc_external_results res = - let (loc, ofs) = calling_conventions 0 3 106 113 false not_supported res - in loc -let extcall_use_push = false - -let loc_exn_bucket = phys_reg 0 (* r8 *) - -(* Registers destroyed by operations *) - -let destroyed_at_c_call = (* f2...f5, f16...f31 preserved by C *) - Array.append - hard_int_reg - (Array.of_list(List.map phys_reg - [100;101;102;103;104;105;106;107;108;109;110;111;112;113; - 130;131;132;133;134;135;136;137;138;139; - 140;141;142;143;144;145;146;147;148;149; - 150;151;152;153;154;155;156;157;158;159; - 160;161])) - -let destroyed_at_oper = function - Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs - | Iop(Iextcall(_, false)) -> destroyed_at_c_call - | _ -> [||] - -let destroyed_at_raise = all_phys_regs - -(* Maximal register pressure *) - -let safe_register_pressure = function - Iextcall(_, _) -> 0 - | _ -> 62 -let max_register_pressure = function - Iextcall(_, _) -> [| 0; 20 |] - | _ -> num_available_registers - -(* Layout of the stack *) - -let num_stack_slots = [| 0; 0 |] -let contains_calls = ref false - -(* Calling the assembler *) - -let assemble_file infile outfile = - Ccomp.command (Config.asm ^ " -o " ^ - Filename.quote outfile ^ " " ^ Filename.quote infile) - -open Clflags;; -open Config;; diff -Nru ocaml-3.12.1/asmcomp/ia64/reload.ml ocaml-4.01.0/asmcomp/ia64/reload.ml --- ocaml-3.12.1/asmcomp/ia64/reload.ml 2000-07-16 02:57:31.000000000 +0000 +++ ocaml-4.01.0/asmcomp/ia64/reload.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,18 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2000 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: reload.ml 3235 2000-07-16 02:57:31Z xleroy $ *) - -(* Reloading for the IA64. *) - -let fundecl f = - (new Reloadgen.reload_generic)#fundecl f diff -Nru ocaml-3.12.1/asmcomp/ia64/scheduling.ml ocaml-4.01.0/asmcomp/ia64/scheduling.ml --- ocaml-3.12.1/asmcomp/ia64/scheduling.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/ia64/scheduling.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,20 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2000 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: scheduling.ml 9547 2010-01-22 12:48:24Z doligez $ *) - -open Schedgen (* to create a dependency *) - -(* We don't schedule here on the linearized code, but instead schedule the - assembly code generated in Emit. *) - -let fundecl f = f diff -Nru ocaml-3.12.1/asmcomp/ia64/selection.ml ocaml-4.01.0/asmcomp/ia64/selection.ml --- ocaml-3.12.1/asmcomp/ia64/selection.ml 2010-04-22 12:51:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/ia64/selection.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,178 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2000 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: selection.ml 10296 2010-04-22 12:51:06Z xleroy $ *) - -(* Instruction selection for the IA64 processor *) - -open Misc -open Cmm -open Reg -open Arch -open Mach - -(* Helper function for add selection *) - -let reassociate_add = function - [Cconst_int n; arg] -> - [arg; Cconst_int n] - | [Cop(Caddi, [arg1; Cconst_int n]); arg3] -> - [Cop(Caddi, [arg1; arg3]); Cconst_int n] - | [Cop(Caddi, [Cconst_int n; arg1]); arg3] -> - [Cop(Caddi, [arg1; arg3]); Cconst_int n] - | [arg1; Cop(Caddi, [Cconst_int n; arg3])] -> - [Cop(Caddi, [arg1; arg3]); Cconst_int n] - | [arg1; Cop(Caddi, [arg2; arg3])] -> - [Cop(Caddi, [arg1; arg2]); arg3] - | args -> args - -(* Helper function for mult-immediate selection *) - -let rec count_one_bits n = - if n = 0 then 0 - else if n land 1 = 0 then count_one_bits (n lsr 1) - else 1 + count_one_bits (n lsr 1) - -class selector = object (self) - -inherit Selectgen.selector_generic as super - -(* Range of immediate arguments: - add 14-bit signed - sub turned into add - sub reversed 8-bit signed - mul at most 16 "one" bits - div, mod powers of 2 - and, or, xor 8-bit signed - lsl, lsr, asr 6-bit unsigned - cmp 8-bit signed - For is_immediate, we put 8-bit signed and treat adds specially - (selectgen already does the right thing for shifts) *) - -method is_immediate n = n >= -128 && n < 128 - -method is_immediate_add n = n >= -8192 && n < 8192 - -method select_addressing arg = (Iindexed, arg) - -method! select_operation op args = - let norm_op = - match op with Cadda -> Caddi | Csuba -> Csubi | _ -> op in - let norm_args = - match norm_op with Caddi -> reassociate_add args | _ -> args in - match (norm_op, norm_args) with - (* Recognize x + y + 1 and x - y - 1 *) - | (Caddi, [Cop(Caddi, [arg1; arg2]); Cconst_int 1]) -> - (Ispecific Iadd1, [arg1; arg2]) - | (Caddi, [Cop(Clsl, [arg1; Cconst_int 1]); Cconst_int 1]) -> - (Ispecific Iadd1, [arg1]) - | (Csubi, [Cop(Csubi, [arg1; arg2]); Cconst_int 1]) -> - (Ispecific Isub1, [arg1; arg2]) - | (Csubi, [Cop(Csubi, [arg1; Cconst_int 1]); arg2]) -> - (Ispecific Isub1, [arg1; arg2]) - (* Recognize add immediate *) - | (Caddi, [arg; Cconst_int n]) when self#is_immediate_add n -> - (Iintop_imm(Iadd, n), [arg]) - (* Turn sub immediate into add immediate *) - | (Csubi, [arg; Cconst_int n]) when self#is_immediate_add (-n) -> - (Iintop_imm(Iadd, -n), [arg]) - (* Recognize imm - arg *) - | (Csubi, [Cconst_int n; arg]) when self#is_immediate n -> - (Iintop_imm(Isub, n), [arg]) - (* Recognize shift-add operations *) - | (Caddi, [arg2; Cop(Clsl, [arg1; Cconst_int(1|2|3|4 as shift)])]) -> - (Ispecific(Ishladd shift), [arg1; arg2]) - | (Caddi, [Cop(Clsl, [arg1; Cconst_int(1|2|3|4 as shift)]); arg2]) -> - (Ispecific(Ishladd shift), [arg1; arg2]) - (* Recognize truncation/normalization of 64-bit integers to 32 bits *) - | (Casr, [Cop(Clsl, [arg; Cconst_int 32]); Cconst_int 32]) -> - (Ispecific (Isignextend 4), [arg]) - (* Recognize x * cst and cst * x *) - | (Cmuli, [arg; Cconst_int n]) -> - self#select_imul_imm arg n - | (Cmuli, [Cconst_int n; arg]) -> - self#select_imul_imm arg n - (* Prevent the recognition of (x / cst) and (x % cst) when cst is not - a power of 2, which do not correspond to an instruction. - Turn general division and modulus into calls to C library functions *) - | (Cdivi, [arg; Cconst_int n]) when n = 1 lsl (Misc.log2 n) -> - (Iintop_imm(Idiv, n), [arg]) - | (Cdivi, _) -> - (Iextcall("__divdi3", false), args) - | (Cmodi, [arg; Cconst_int n]) when n = 1 lsl (Misc.log2 n) && n <> 1 -> - (Iintop_imm(Imod, n), [arg]) - | (Cmodi, _) -> - (Iextcall("__moddi3", false), args) - (* Recognize mult-add and mult-sub instructions *) - | (Caddf, [Cop(Cmulf, [arg1; arg2]); arg3]) -> - (Ispecific Imultaddf, [arg1; arg2; arg3]) - | (Caddf, [arg3; Cop(Cmulf, [arg1; arg2])]) -> - (Ispecific Imultaddf, [arg1; arg2; arg3]) - | (Csubf, [Cop(Cmulf, [arg1; arg2]); arg3]) -> - (Ispecific Imultsubf, [arg1; arg2; arg3]) - | (Csubf, [arg3; Cop(Cmulf, [arg1; arg2])]) -> - (Ispecific Isubmultf, [arg1; arg2; arg3]) - (* Use default selector otherwise *) - | _ -> - super#select_operation op args - -method private select_imul_imm arg n = - if count_one_bits n <= 16 - then (Iintop_imm(Imul, n), [arg]) - else (Iintop Imul, [arg; Cconst_int n]) - -(* To palliate the lack of addressing with displacement, multiple - stores to the address r are translated as follows - (t1 and t2 are two temp regs) - t1 := r - 8 - t2 := r - compute data1 in reg1 - compute data2 in reg2 - store reg1 at t1 and increment t1 by 16 - store reg2 at t2 and increment t2 by 16 - compute data3 in reg3 - compute data4 in reg4 - store reg3 at t1 and increment t1 by 16 - store reg4 at t2 and increment t2 by 16 - ... - Note: we use two temp regs and perform stores by groups of 2 - in order to expose more instruction-level parallelism. *) -method! emit_stores env data regs_addr = - let t1 = Reg.create Addr and t2 = Reg.create Addr in - self#insert (Iop(Iintop_imm(Iadd, -8))) regs_addr [|t1|]; - self#insert (Iop Imove) regs_addr [|t2|]; - (* Store components by batch of 2 *) - let backlog = ref None in - let do_store r = - match !backlog with - None -> (* keep it for later *) - backlog := Some r - | Some r' -> (* store r' at t1 and r at t2 *) - self#insert (Iop(Ispecific(Istoreincr 16))) [| t1; r' |] [| t1 |]; - self#insert (Iop(Ispecific(Istoreincr 16))) [| t2; r |] [| t2 |]; - backlog := None in - List.iter - (fun exp -> - match self#emit_expr env exp with - None -> assert false - | Some regs -> Array.iter do_store regs) - data; - (* Store the backlog if any *) - begin match !backlog with - None -> () - | Some r -> self#insert (Iop(Ispecific(Istoreincr 16))) [| t1; r |] [| t1 |] - end; - (* Insert an init barrier *) - self#insert (Iop(Ispecific Iinitbarrier)) [||] [||] -end - -let fundecl f = (new selector)#emit_fundecl f diff -Nru ocaml-3.12.1/asmcomp/interf.ml ocaml-4.01.0/asmcomp/interf.ml --- ocaml-3.12.1/asmcomp/interf.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/interf.ml 2013-03-19 07:22:12.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,15 +10,18 @@ (* *) (***********************************************************************) -(* $Id: interf.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Construction of the interference graph. Annotate pseudoregs with interference lists and preference lists. *) module IntPairSet = - Set.Make(struct type t = int * int let compare = compare end) + Set.Make(struct + type t = int * int + let compare ((a1,b1) : t) (a2,b2) = + match compare a1 a2 with + | 0 -> compare b1 b2 + | c -> c + end) -open Misc open Reg open Mach @@ -32,13 +35,21 @@ (* Record an interference between two registers *) let add_interf ri rj = - let i = ri.stamp and j = rj.stamp in - if i <> j then begin - let p = if i < j then (i, j) else (j, i) in - if not(IntPairSet.mem p !mat) then begin - mat := IntPairSet.add p !mat; - if ri.loc = Unknown then ri.interf <- rj :: ri.interf; - if rj.loc = Unknown then rj.interf <- ri :: rj.interf + if Proc.register_class ri = Proc.register_class rj then begin + let i = ri.stamp and j = rj.stamp in + if i <> j then begin + let p = if i < j then (i, j) else (j, i) in + if not(IntPairSet.mem p !mat) then begin + mat := IntPairSet.add p !mat; + if ri.loc = Unknown then begin + ri.interf <- rj :: ri.interf; + if not rj.spill then ri.degree <- ri.degree + 1 + end; + if rj.loc = Unknown then begin + rj.interf <- ri :: rj.interf; + if not ri.spill then rj.degree <- rj.degree + 1 + end + end end end in diff -Nru ocaml-3.12.1/asmcomp/interf.mli ocaml-4.01.0/asmcomp/interf.mli --- ocaml-3.12.1/asmcomp/interf.mli 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/interf.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: interf.mli 2553 1999-11-17 18:59:06Z xleroy $ *) - (* Construction of the interference graph. Annotate pseudoregs with interference lists and preference lists. *) diff -Nru ocaml-3.12.1/asmcomp/linearize.ml ocaml-4.01.0/asmcomp/linearize.ml --- ocaml-3.12.1/asmcomp/linearize.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/linearize.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: linearize.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Transformation of Mach code into a list of pseudo-instructions. *) open Reg @@ -54,7 +52,8 @@ type fundecl = { fun_name: string; fun_body: instruction; - fun_fast: bool } + fun_fast: bool; + fun_dbg : Debuginfo.t } (* Invert a test *) @@ -264,4 +263,5 @@ let fundecl f = { fun_name = f.Mach.fun_name; fun_body = linear f.Mach.fun_body end_instr; - fun_fast = f.Mach.fun_fast } + fun_fast = f.Mach.fun_fast; + fun_dbg = f.Mach.fun_dbg } diff -Nru ocaml-3.12.1/asmcomp/linearize.mli ocaml-4.01.0/asmcomp/linearize.mli --- ocaml-3.12.1/asmcomp/linearize.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/linearize.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: linearize.mli 9547 2010-01-22 12:48:24Z doligez $ *) - (* Transformation of Mach code into a list of pseudo-instructions. *) type label = int @@ -49,6 +47,7 @@ type fundecl = { fun_name: string; fun_body: instruction; - fun_fast: bool } + fun_fast: bool; + fun_dbg : Debuginfo.t } val fundecl: Mach.fundecl -> fundecl diff -Nru ocaml-3.12.1/asmcomp/liveness.ml ocaml-4.01.0/asmcomp/liveness.ml --- ocaml-3.12.1/asmcomp/liveness.ml 2007-01-29 12:11:18.000000000 +0000 +++ ocaml-4.01.0/asmcomp/liveness.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: liveness.ml 7812 2007-01-29 12:11:18Z xleroy $ *) - (* Liveness analysis. Annotate mach code with the set of regs live at each point. *) diff -Nru ocaml-3.12.1/asmcomp/liveness.mli ocaml-4.01.0/asmcomp/liveness.mli --- ocaml-3.12.1/asmcomp/liveness.mli 2000-04-21 08:13:22.000000000 +0000 +++ ocaml-4.01.0/asmcomp/liveness.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: liveness.mli 3123 2000-04-21 08:13:22Z weis $ *) - (* Liveness analysis. Annotate mach code with the set of regs live at each point. *) diff -Nru ocaml-3.12.1/asmcomp/m68k/README ocaml-4.01.0/asmcomp/m68k/README --- ocaml-3.12.1/asmcomp/m68k/README 2000-02-04 15:34:43.000000000 +0000 +++ ocaml-4.01.0/asmcomp/m68k/README 1970-01-01 00:00:00.000000000 +0000 @@ -1,8 +0,0 @@ -As of Feb 4th 2000, the native-code compiler for the Motorola 680x0 is -no longer maintained and thus deprecated. - -The only machines on which we could test this port (Sun 3, SunOS 4) -here at INRIA are being retired, and were so slow that the port wasn't -kept up-to-date with the remainder of the system. - -- Xavier Leroy, for the Objective Caml development team. diff -Nru ocaml-3.12.1/asmcomp/mach.ml ocaml-4.01.0/asmcomp/mach.ml --- ocaml-3.12.1/asmcomp/mach.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/mach.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: mach.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Representation of machine code by sequences of pseudoinstructions *) type integer_comparison = @@ -79,7 +77,8 @@ { fun_name: string; fun_args: Reg.t array; fun_body: instruction; - fun_fast: bool } + fun_fast: bool; + fun_dbg : Debuginfo.t } let rec dummy_instr = { desc = Iend; diff -Nru ocaml-3.12.1/asmcomp/mach.mli ocaml-4.01.0/asmcomp/mach.mli --- ocaml-3.12.1/asmcomp/mach.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/mach.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: mach.mli 9547 2010-01-22 12:48:24Z doligez $ *) - (* Representation of machine code by sequences of pseudoinstructions *) type integer_comparison = @@ -79,7 +77,8 @@ { fun_name: string; fun_args: Reg.t array; fun_body: instruction; - fun_fast: bool } + fun_fast: bool; + fun_dbg : Debuginfo.t } val dummy_instr: instruction val end_instr: unit -> instruction diff -Nru ocaml-3.12.1/asmcomp/mips/arch.ml ocaml-4.01.0/asmcomp/mips/arch.ml --- ocaml-3.12.1/asmcomp/mips/arch.ml 2002-11-29 15:03:37.000000000 +0000 +++ ocaml-4.01.0/asmcomp/mips/arch.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,71 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: arch.ml 5304 2002-11-29 15:03:37Z xleroy $ *) - -(* Specific operations for the Mips processor *) - -open Misc -open Format - -(* Machine-specific command-line options *) - -let command_line_options = [] - -(* Addressing modes *) - -type addressing_mode = - Ibased of string * int (* symbol + displ *) - | Iindexed of int (* reg + displ *) - -(* Specific operations *) - -type specific_operation = unit (* none *) - -(* Sizes, endianness *) - -let big_endian = - match Config.system with - "ultrix" -> false - | "irix" -> true - | _ -> fatal_error "Arch_mips.big_endian" - -let size_addr = 4 -let size_int = 4 -let size_float = 8 - -(* Operations on addressing modes *) - -let identity_addressing = Iindexed 0 - -let offset_addressing addr delta = - match addr with - Ibased(s, n) -> Ibased(s, n + delta) - | Iindexed n -> Iindexed(n + delta) - -let num_args_addressing = function - Ibased(s, n) -> 0 - | Iindexed n -> 1 - -(* Printing operations and addressing modes *) - -let print_addressing printreg addr ppf arg = - match addr with - | Ibased(s, n) -> - let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in - fprintf ppf "\"%s\"%s" s idx - | Iindexed n -> - let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in - fprintf ppf "%a%s" printreg arg.(0) idx - -let print_specific_operation printreg op ppf arg = - fatal_error "Arch_mips.print_specific_operation" diff -Nru ocaml-3.12.1/asmcomp/mips/emit.mlp ocaml-4.01.0/asmcomp/mips/emit.mlp --- ocaml-3.12.1/asmcomp/mips/emit.mlp 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/mips/emit.mlp 1970-01-01 00:00:00.000000000 +0000 @@ -1,593 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: emit.mlp 9547 2010-01-22 12:48:24Z doligez $ *) - -(* Emission of Mips assembly code *) - -open Location -open Misc -open Cmm -open Arch -open Proc -open Reg -open Mach -open Linearize -open Emitaux - -(* Tradeoff between code size and code speed *) - -let fastcode_flag = ref true - -(* Output a label *) - -let emit_label lbl = - emit_string "$"; emit_int lbl - -(* Output a symbol *) - -let emit_symbol s = - Emitaux.emit_symbol '$' s - -(* Output a pseudo-register *) - -let emit_reg r = - match r.loc with - Reg r -> emit_string (register_name r) - | _ -> fatal_error "Emit_mips.emit_reg" - -(* Record if $gp is needed *) - -let uses_gp = ref false - -(* Layout of the stack frame *) - -let stack_offset = ref 0 - -let frame_size () = - let size = - !stack_offset + - 4 * num_stack_slots.(0) + 8 * num_stack_slots.(1) + - (if !contains_calls then if !uses_gp then 8 else 4 else 0) in - Misc.align size 16 - -let slot_offset loc cl = - match loc with - Incoming n -> frame_size() + n - | Local n -> - if cl = 0 - then !stack_offset + num_stack_slots.(1) * 8 + n * 4 - else !stack_offset + n * 8 - | Outgoing n -> n - -(* Output a stack reference *) - -let emit_stack r = - match r.loc with - Stack s -> - let ofs = slot_offset s (register_class r) in `{emit_int ofs}($sp)` - | _ -> fatal_error "Emit_mips.emit_stack" - -(* Output an addressing mode *) - -let emit_addressing addr r n = - match addr with - Iindexed ofs -> - `{emit_int ofs}({emit_reg r.(n)})` - | Ibased(s, 0) -> - `{emit_symbol s}` - | Ibased(s, ofs) -> - `{emit_symbol s}`; - if ofs > 0 then ` + {emit_int ofs}`; - if ofs < 0 then ` - {emit_int(-ofs)}` - -(* Communicate live registers at call points to the assembler *) - -let int_reg_number = - [| 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 19; 20; 21 |] - -let float_reg_number = - [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 19; - 20; 21; 22; 23; 24; 25; 26; 27; 28; 29; 30 |] - -let liveregs instr extra_msk = - (* $22, $23, $30 always live *) - let int_mask = ref(0x00000302 lor extra_msk) - and float_mask = ref 0 in - let add_register = function - {loc = Reg r; typ = (Int | Addr)} -> - int_mask := !int_mask lor (1 lsl (31 - int_reg_number.(r))) - | {loc = Reg r; typ = Float} -> - float_mask := !float_mask lor (1 lsl (31 - float_reg_number.(r - 100))) - | _ -> () in - Reg.Set.iter add_register instr.live; - Array.iter add_register instr.arg; - emit_printf " .livereg 0x%08x, 0x%08x\n" !int_mask !float_mask - -let live_25 = 1 lsl (31 - 25) -let live_24 = 1 lsl (31 - 24) - -(* Record live pointers at call points *) - -type frame_descr = - { fd_lbl: int; (* Return address *) - fd_frame_size: int; (* Size of stack frame *) - fd_live_offset: int list } (* Offsets/regs of live addresses *) - -let frame_descriptors = ref([] : frame_descr list) - -let record_frame live = - let lbl = new_label() in - let live_offset = ref [] in - Reg.Set.iter - (function - {typ = Addr; loc = Reg r} -> - live_offset := ((int_reg_number.(r) lsl 1) + 1) :: !live_offset - | {typ = Addr; loc = Stack s} as reg -> - live_offset := slot_offset s (register_class reg) :: !live_offset - | _ -> ()) - live; - frame_descriptors := - { fd_lbl = lbl; - fd_frame_size = frame_size(); - fd_live_offset = !live_offset } :: !frame_descriptors; - `{emit_label lbl}:` - -let emit_frame fd = - ` .word {emit_label fd.fd_lbl}\n`; - ` .half {emit_int fd.fd_frame_size}\n`; - ` .half {emit_int (List.length fd.fd_live_offset)}\n`; - List.iter - (fun n -> - ` .half {emit_int n}\n`) - fd.fd_live_offset; - ` .align 2\n` - -(* Determine if $gp is used in the function *) - -let rec instr_uses_gp i = - match i.desc with - Lend -> false - | Lop(Iconst_symbol s) -> true - | Lop(Icall_imm s) -> true - | Lop(Itailcall_imm s) -> true - | Lop(Iextcall(_, _)) -> true - | Lop(Iload(_, Ibased(_, _))) -> true - | Lop(Istore(_, Ibased(_, _))) -> true - | Lop(Ialloc _) -> true - | Lop(Iintop(Icheckbound)) -> true - | Lop(Iintop_imm(Icheckbound, _)) -> true - | Lswitch jumptbl -> true - | _ -> instr_uses_gp i.next - -(* Names of various instructions *) - -let name_for_comparison = function - Isigned Ceq -> "eq" | Isigned Cne -> "ne" | Isigned Cle -> "le" - | Isigned Cge -> "ge" | Isigned Clt -> "lt" | Isigned Cgt -> "gt" - | Iunsigned Ceq -> "eq" | Iunsigned Cne -> "ne" | Iunsigned Cle -> "leu" - | Iunsigned Cge -> "geu" | Iunsigned Clt -> "ltu" | Iunsigned Cgt -> "gtu" - -let name_for_float_comparison cmp neg = - match cmp with - Ceq -> ("eq", neg) | Cne -> ("eq", not neg) - | Cle -> ("le", neg) | Cge -> ("ult", not neg) - | Clt -> ("lt", neg) | Cgt -> ("ule", not neg) - -let name_for_int_operation = function - Iadd -> "addu" - | Isub -> "subu" - | Imul -> "mul" - | Idiv -> "div" - | Imod -> "rem" - | Iand -> "and" - | Ior -> "or" - | Ixor -> "xor" - | Ilsl -> "sll" - | Ilsr -> "srl" - | Iasr -> "sra" - | Icomp cmp -> "s" ^ name_for_comparison cmp - | _ -> Misc.fatal_error "Emit.name_for_int_operation" - -let name_for_float_operation = function - Inegf -> "neg.d" - | Iabsf -> "abs.d" - | Iaddf -> "add.d" - | Isubf -> "sub.d" - | Imulf -> "mul.d" - | Idivf -> "div.d" - | _ -> Misc.fatal_error "Emit.name_for_float_operation" - -(* Output the assembly code for an instruction *) - -(* Name of current function *) -let function_name = ref "" -(* Entry point for tail recursive calls *) -let tailrec_entry_point = ref 0 -(* Label of jump to caml_call_gc *) -let call_gc_label = ref 0 -(* Label of trap for out-of-range accesses *) -let range_check_trap = ref 0 - -let emit_instr i = - match i.desc with - Lend -> () - | Lop(Imove | Ispill | Ireload) -> - let src = i.arg.(0) and dst = i.res.(0) in - if src.loc <> dst.loc then begin - match (src, dst) with - {loc = Reg rs; typ = Int|Addr}, {loc = Reg rd; typ = Int|Addr} -> - ` move {emit_reg dst}, {emit_reg src}\n` - | {loc = Reg rs; typ = Float}, {loc = Reg rd; typ = Float} -> - ` mov.d {emit_reg dst}, {emit_reg src}\n` - | {loc = Reg rs; typ = Int|Addr}, {loc = Stack sd} -> - ` sw {emit_reg src}, {emit_stack dst}\n` - | {loc = Reg rs; typ = Float}, {loc = Stack sd} -> - ` s.d {emit_reg src}, {emit_stack dst}\n` - | {loc = Stack ss; typ = Int|Addr}, {loc = Reg rd} -> - ` lw {emit_reg dst}, {emit_stack src}\n` - | {loc = Stack ss; typ = Float}, {loc = Reg rd} -> - ` l.d {emit_reg dst}, {emit_stack src}\n` - | _ -> - fatal_error "Emit_mips: Imove" - end - | Lop(Iconst_int n) -> - if n = 0n then - ` move {emit_reg i.res.(0)}, $0\n` - else - ` li {emit_reg i.res.(0)}, {emit_nativeint n}\n` - | Lop(Iconst_float s) -> - ` li.d {emit_reg i.res.(0)}, {emit_string s}\n` - | Lop(Iconst_symbol s) -> - ` la {emit_reg i.res.(0)}, {emit_symbol s}\n` - | Lop(Icall_ind) -> - ` move $25, {emit_reg i.arg.(0)}\n`; - liveregs i live_25; - ` jal {emit_reg i.arg.(0)}\n`; - `{record_frame i.live}\n` - | Lop(Icall_imm s) -> - liveregs i 0; - ` jal {emit_symbol s}\n`; - `{record_frame i.live}\n` - | Lop(Itailcall_ind) -> - let n = frame_size() in - if !contains_calls then - ` lw $31, {emit_int(n - 4)}($sp)\n`; - if !uses_gp then - ` lw $gp, {emit_int(n - 8)}($sp)\n`; - if n > 0 then - ` addu $sp, $sp, {emit_int n}\n`; - liveregs i 0; - ` move $25, {emit_reg i.arg.(0)}\n`; - liveregs i live_25; - ` j {emit_reg i.arg.(0)}\n` - | Lop(Itailcall_imm s) -> - if s = !function_name then begin - ` b {emit_label !tailrec_entry_point}\n` - end else begin - let n = frame_size() in - if !contains_calls then - ` lw $31, {emit_int(n - 4)}($sp)\n`; - if !uses_gp then - ` lw $gp, {emit_int(n - 8)}($sp)\n`; - if n > 0 then - ` addu $sp, $sp, {emit_int n}\n`; - ` la $25, {emit_symbol s}\n`; - liveregs i live_25; - ` j $25\n` - end - | Lop(Iextcall(s, alloc)) -> - if alloc then begin - ` la $24, {emit_symbol s}\n`; - liveregs i live_24; - ` jal caml_c_call\n`; - `{record_frame i.live}\n` - end else begin - ` jal {emit_symbol s}\n` - end - | Lop(Istackoffset n) -> - if n >= 0 then - ` subu $sp, $sp, {emit_int n}\n` - else - ` addu $sp, $sp, {emit_int (-n)}\n`; - stack_offset := !stack_offset + n - | Lop(Iload(chunk, addr)) -> - let dest = i.res.(0) in - begin match chunk with - Double_u -> - (* Destination is not 8-aligned, hence cannot use l.d *) - ` ldl $24, {emit_addressing addr i.arg 0}\n`; - ` ldr $24, {emit_addressing (offset_addressing addr 7) i.arg 0}\n`; - ` dmtc1 $24, {emit_reg dest}\n` - | Single -> - ` l.s {emit_reg dest}, {emit_addressing addr i.arg 0}\n`; - ` cvt.d.s {emit_reg dest}, {emit_reg dest}\n` - | _ -> - let load_instr = - match chunk with - Byte_unsigned -> "lbu" - | Byte_signed -> "lb" - | Sixteen_unsigned -> "lhu" - | Sixteen_signed -> "lh" - | Double -> "l.d" - | _ -> "lw" in - ` {emit_string load_instr} {emit_reg dest}, {emit_addressing addr i.arg 0}\n` - end - | Lop(Istore(chunk, addr)) -> - let src = i.arg.(0) in - begin match chunk with - Double_u -> - (* Destination is not 8-aligned, hence cannot use l.d *) - ` dmfc1 $24, {emit_reg src}\n`; - ` sdl $24, {emit_addressing addr i.arg 1}\n`; - ` sdr $24, {emit_addressing (offset_addressing addr 7) i.arg 1}\n` - | Single -> - ` cvt.s.d $f31, {emit_reg src}\n`; - ` s.s $f31, {emit_addressing addr i.arg 1}\n` - | _ -> - let store_instr = - match chunk with - Byte_unsigned | Byte_signed -> "sb" - | Sixteen_unsigned | Sixteen_signed -> "sh" - | Double -> "s.d" - | _ -> "sw" in - ` {emit_string store_instr} {emit_reg src}, {emit_addressing addr i.arg 1}\n` - end - | Lop(Ialloc n) -> - if !call_gc_label = 0 then call_gc_label := new_label(); - ` .set noreorder\n`; - ` subu $22, $22, {emit_int n}\n`; - ` subu $24, $22, $23\n`; - ` bltzal $24, {emit_label !call_gc_label}\n`; - ` addu {emit_reg i.res.(0)}, $22, 4\n`; - `{record_frame i.live}\n`; - ` .set reorder\n` - | Lop(Iintop(Icheckbound)) -> - if !range_check_trap = 0 then range_check_trap := new_label(); - ` bleu {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label !range_check_trap}\n` - | Lop(Iintop op) -> - let instr = name_for_int_operation op in - ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` - | Lop(Iintop_imm(Icheckbound, n)) -> - if !range_check_trap = 0 then range_check_trap := new_label(); - ` bleu {emit_reg i.arg.(0)}, {emit_int n}, {emit_label !range_check_trap}\n` - | Lop(Iintop_imm(op, n)) -> - let instr = name_for_int_operation op in - ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int n}\n` - | Lop(Inegf | Iabsf as op) -> - let instr = name_for_float_operation op in - ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n` - | Lop(Iaddf | Isubf | Imulf | Idivf as op) -> - let instr = name_for_float_operation op in - ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` - | Lop(Ifloatofint) -> - ` mtc1 {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n`; - ` cvt.d.w {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` - | Lop(Iintoffloat) -> - ` trunc.w.d $f31, {emit_reg i.arg.(0)}, $24\n`; - ` mfc1 {emit_reg i.res.(0)}, $f31\n` - | Lop(Ispecific sop) -> - fatal_error "Emit_mips: Ispecific" - | Lreloadretaddr -> - let n = frame_size() in - ` lw $31, {emit_int(n - 4)}($sp)\n`; - | Lreturn -> - let n = frame_size() in - if !uses_gp then - ` lw $gp, {emit_int(n - 8)}($sp)\n`; - if n > 0 then - ` addu $sp, $sp, {emit_int n}\n`; - liveregs i 0; - ` j $31\n` - | Llabel lbl -> - `{emit_label lbl}:\n` - | Lbranch lbl -> - ` b {emit_label lbl}\n` - | Lcondbranch(tst, lbl) -> - begin match tst with - Itruetest -> - ` bne {emit_reg i.arg.(0)}, $0, {emit_label lbl}\n` - | Ifalsetest -> - ` beq {emit_reg i.arg.(0)}, $0, {emit_label lbl}\n` - | Iinttest cmp -> - let comp = name_for_comparison cmp in - ` b{emit_string comp} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n` - | Iinttest_imm(cmp, n) -> - let comp = name_for_comparison cmp in - ` b{emit_string comp} {emit_reg i.arg.(0)}, {emit_int n}, {emit_label lbl}\n` - | Ifloattest(cmp, neg) -> - let (comp, branch) = name_for_float_comparison cmp neg in - ` c.{emit_string comp}.d {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; - if branch - then ` bc1f {emit_label lbl}\n` - else ` bc1t {emit_label lbl}\n` - | Ioddtest -> - ` and $24, {emit_reg i.arg.(0)}, 1\n`; - ` bne $24, $0, {emit_label lbl}\n` - | Ieventest -> - ` and $24, {emit_reg i.arg.(0)}, 1\n`; - ` beq $24, $0, {emit_label lbl}\n` - end - | Lcondbranch3(lbl0, lbl1, lbl2) -> - ` subu $24, {emit_reg i.arg.(0)}, 1\n`; - begin match lbl0 with - None -> () - | Some lbl -> ` beq {emit_reg i.arg.(0)}, $0, {emit_label lbl}\n` - end; - begin match lbl1 with - None -> () - | Some lbl -> ` beq $24, $0, {emit_label lbl}\n` - end; - begin match lbl2 with - None -> () - | Some lbl -> ` bgtz $24, {emit_label lbl}\n` - end - | Lswitch jumptbl -> - let lbl_jumptbl = new_label() in - ` sll $24, {emit_reg i.arg.(0)}, 2\n`; - ` lw $24, {emit_label lbl_jumptbl}($24)\n`; - liveregs i live_24; - ` j $24\n`; - ` .rdata\n`; - `{emit_label lbl_jumptbl}:\n`; - for i = 0 to Array.length jumptbl - 1 do - ` .word {emit_label jumptbl.(i)}\n` - done; - ` .text\n` - | Lsetuptrap lbl -> - ` subu $sp, $sp, 16\n`; - ` bal {emit_label lbl}\n` - | Lpushtrap -> - stack_offset := !stack_offset + 16; - ` sw $30, 0($sp)\n`; - ` sw $31, 4($sp)\n`; - ` sw $gp, 8($sp)\n`; - ` move $30, $sp\n` - | Lpoptrap -> - ` lw $30, 0($sp)\n`; - ` addu $sp, $sp, 16\n`; - stack_offset := !stack_offset - 16 - | Lraise -> - ` lw $25, 4($30)\n`; - ` move $sp, $30\n`; - ` lw $30, 0($sp)\n`; - ` lw $gp, 8($sp)\n`; - ` addu $sp, $sp, 16\n`; - liveregs i live_25; - ` jal $25\n` (* Keep retaddr in $31 for debugging *) - -let rec emit_all i = - match i.desc with Lend -> () | _ -> emit_instr i; emit_all i.next - -(* Emission of a function declaration *) - -let fundecl fundecl = - function_name := fundecl.fun_name; - fastcode_flag := fundecl.fun_fast; - uses_gp := instr_uses_gp fundecl.fun_body; - if !uses_gp then contains_calls := true; - tailrec_entry_point := new_label(); - stack_offset := 0; - call_gc_label := 0; - range_check_trap := 0; - ` .text\n`; - ` .align 2\n`; - ` .globl {emit_symbol fundecl.fun_name}\n`; - ` .ent {emit_symbol fundecl.fun_name}\n`; - `{emit_symbol fundecl.fun_name}:\n`; - let n = frame_size() in - if n > 0 then - ` subu $sp, $sp, {emit_int n}\n`; - if !contains_calls then - ` sw $31, {emit_int(n - 4)}($sp)\n`; - if !uses_gp then begin - ` sw $gp, {emit_int(n - 8)}($sp)\n`; - ` lui $24, %hi(%neg(%gp_rel({emit_symbol fundecl.fun_name})))\n`; - ` addiu $24, $24, %lo(%neg(%gp_rel({emit_symbol fundecl.fun_name})))\n`; - ` daddu $gp, $25, $24\n` - end; - `{emit_label !tailrec_entry_point}:\n`; - emit_all fundecl.fun_body; - if !call_gc_label > 0 then begin - `{emit_label !call_gc_label}:\n`; - ` la $25, caml_call_gc\n`; - ` j $25\n` - end; - if !range_check_trap > 0 then begin - `{emit_label !range_check_trap}:\n`; - ` la $25, caml_ml_array_bound_error\n`; - ` j $25\n` - end; - ` .end {emit_symbol fundecl.fun_name}\n` - -(* Emission of data *) - -let emit_item = function - Cglobal_symbol s -> - ` .globl {emit_symbol s}\n`; - | Cdefine_symbol s -> - `{emit_symbol s}:\n` - | Cdefine_label lbl -> - `{emit_label (100000 + lbl)}:\n` - | Cint8 n -> - ` .byte {emit_int n}\n` - | Cint16 n -> - ` .half {emit_int n}\n` - | Cint32 n -> - ` .word {emit_nativeint n}\n` - | Cint n -> - ` .word {emit_nativeint n}\n` - | Csingle f -> - emit_float32_directive ".word" f - | Cdouble f -> - emit_float64_split_directive ".word" f - | Csymbol_address s -> - ` .word {emit_symbol s}\n` - | Clabel_address lbl -> - ` .word {emit_label (100000 + lbl)}\n` - | Cstring s -> - emit_string_directive " .ascii " s - | Cskip n -> - if n > 0 then ` .space {emit_int n}\n` - | Calign n -> - ` .align {emit_int(Misc.log2 n)}\n` - -let data l = - ` .data\n`; - List.iter emit_item l - -(* Beginning / end of an assembly file *) - -let begin_assembly() = - (* There are really two groups of registers: - $sp and $30 always point to stack locations - $2 - $21 never point to stack locations. *) - ` .noalias $2,$sp; .noalias $2,$30; .noalias $3,$sp; .noalias $3,$30\n`; - ` .noalias $4,$sp; .noalias $4,$30; .noalias $5,$sp; .noalias $5,$30\n`; - ` .noalias $6,$sp; .noalias $6,$30; .noalias $7,$sp; .noalias $7,$30\n`; - ` .noalias $8,$sp; .noalias $8,$30; .noalias $9,$sp; .noalias $9,$30\n`; - ` .noalias $10,$sp; .noalias $10,$30; .noalias $11,$sp; .noalias $11,$30\n`; - ` .noalias $12,$sp; .noalias $12,$30; .noalias $13,$sp; .noalias $13,$30\n`; - ` .noalias $14,$sp; .noalias $14,$30; .noalias $15,$sp; .noalias $15,$30\n`; - ` .noalias $16,$sp; .noalias $16,$30; .noalias $17,$sp; .noalias $17,$30\n`; - ` .noalias $18,$sp; .noalias $18,$30; .noalias $19,$sp; .noalias $19,$30\n`; - ` .noalias $20,$sp; .noalias $20,$30; .noalias $21,$sp; .noalias $21,$30\n\n`; - let lbl_begin = Compilenv.make_symbol (Some "data_begin") in - ` .data\n`; - ` .globl {emit_symbol lbl_begin}\n`; - `{emit_symbol lbl_begin}:\n`; - let lbl_begin = Compilenv.make_symbol (Some "code_begin") in - ` .text\n`; - ` .globl {emit_symbol lbl_begin}\n`; - ` .ent {emit_symbol lbl_begin}\n`; - `{emit_symbol lbl_begin}:\n`; - ` .end {emit_symbol lbl_begin}\n` - -let end_assembly () = - let lbl_end = Compilenv.make_symbol (Some "code_end") in - ` .text\n`; - ` .globl {emit_symbol lbl_end}\n`; - ` .ent {emit_symbol lbl_end}\n`; - `{emit_symbol lbl_end}:\n`; - ` .end {emit_symbol lbl_end}\n`; - let lbl_end = Compilenv.make_symbol (Some "data_end") in - ` .data\n`; - ` .globl {emit_symbol lbl_end}\n`; - `{emit_symbol lbl_end}:\n`; - ` .word 0\n`; - let lbl = Compilenv.make_symbol (Some "frametable") in - ` .rdata\n`; - ` .globl {emit_symbol lbl}\n`; - `{emit_symbol lbl}:\n`; - ` .word {emit_int (List.length !frame_descriptors)}\n`; - List.iter emit_frame !frame_descriptors; - frame_descriptors := [] diff -Nru ocaml-3.12.1/asmcomp/mips/proc.ml ocaml-4.01.0/asmcomp/mips/proc.ml --- ocaml-3.12.1/asmcomp/mips/proc.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/mips/proc.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,210 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: proc.ml 9547 2010-01-22 12:48:24Z doligez $ *) - -(* Description of the Mips processor *) - -open Misc -open Cmm -open Reg -open Arch -open Mach - -(* Instruction selection *) - -let word_addressed = false - -(* Registers available for register allocation *) - -(* Register map: - $0 always 0 - $1 temporary for the assembler - $2 - $7 0 - 5 function results - $8 - $15 6 - 13 function arguments - $16 - $21 14 - 19 general purpose (preserved by C) - $22 allocation pointer (preserved by C) - $23 allocation limit (preserved by C) - $24 - $25 temporaries - $26 - $29 kernel regs, stack pointer, global pointer - $30 trap pointer (preserved by C) - $31 return address - - $f0 - $f3 100 - 103 function results - $f4 - $f11 104 - 111 general purpose - $f12 - $f19 112 - 119 function arguments - $f20 - $f30 120 - 130 general purpose (even numbered preserved by C) - $f31 temporary *) - -let int_reg_name = [| - (* 0-5 *) "$2"; "$3"; "$4"; "$5"; "$6"; "$7"; - (* 6-13 *) "$8"; "$9"; "$10"; "$11"; "$12"; "$13"; "$14"; "$15"; - (* 14-19 *) "$16"; "$17"; "$18"; "$19"; "$20"; "$21" -|] - -let float_reg_name = [| - "$f0"; "$f1"; "$f2"; "$f3"; "$f4"; - "$f5"; "$f6"; "$f7"; "$f8"; "$f9"; - "$f10"; "$f11"; "$f12"; "$f13"; "$f14"; - "$f15"; "$f16"; "$f17"; "$f18"; "$f19"; - "$f20"; "$f21"; "$f22"; "$f23"; "$f24"; - "$f25"; "$f26"; "$f27"; "$f28"; "$f29"; "$f30" -|] - -let num_register_classes = 2 - -let register_class r = - match r.typ with - Int -> 0 - | Addr -> 0 - | Float -> 1 - -let num_available_registers = [| 20; 31 |] - -let first_available_register = [| 0; 100 |] - -let register_name r = - if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100) - -let rotate_registers = true - -(* Representation of hard registers by pseudo-registers *) - -let hard_int_reg = - let v = Array.create 20 Reg.dummy in - for i = 0 to 19 do v.(i) <- Reg.at_location Int (Reg i) done; - v - -let hard_float_reg = - let v = Array.create 31 Reg.dummy in - for i = 0 to 30 do v.(i) <- Reg.at_location Float (Reg(100 + i)) done; - v - -let all_phys_regs = - Array.append hard_int_reg hard_float_reg - -let phys_reg n = - if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100) - -let stack_slot slot ty = - Reg.at_location ty (Stack slot) - -(* Calling conventions *) - -let calling_conventions first_int last_int first_float last_float - make_stack arg = - let loc = Array.create (Array.length arg) Reg.dummy in - let int = ref first_int in - let float = ref first_float in - let ofs = ref 0 in - for i = 0 to Array.length arg - 1 do - match arg.(i).typ with - Int | Addr as ty -> - if !int <= last_int then begin - loc.(i) <- phys_reg !int; - incr int - end else begin - loc.(i) <- stack_slot (make_stack !ofs) ty; - ofs := !ofs + size_int - end - | Float -> - if !float <= last_float then begin - loc.(i) <- phys_reg !float; - incr float - end else begin - loc.(i) <- stack_slot (make_stack !ofs) Float; - ofs := !ofs + size_float - end - done; - (loc, Misc.align !ofs 16) (* Keep stack 16-aligned *) - -let incoming ofs = Incoming ofs -let outgoing ofs = Outgoing ofs -let not_supported ofs = fatal_error "Proc.loc_results: cannot call" - -let loc_arguments arg = - calling_conventions 6 13 112 119 outgoing arg -let loc_parameters arg = - let (loc, ofs) = calling_conventions 6 13 112 119 incoming arg in loc -let loc_results res = - let (loc, ofs) = calling_conventions 0 5 100 103 not_supported res in loc - -(* The C calling conventions are as follows: - the first 8 arguments are passed either in integer regs $4...$11 - or float regs $f12...$f19. Each argument "consumes" both one slot - in the int register file and one slot in the float register file. - Extra arguments are passed on stack, in a 64-bits slot, right-justified - (i.e. at +4 from natural address). *) - -let loc_external_arguments arg = - let loc = Array.create (Array.length arg) Reg.dummy in - let int = ref 2 in - let float = ref 112 in - let ofs = ref 0 in - for i = 0 to Array.length arg - 1 do - if i < 8 then begin - loc.(i) <- phys_reg (if arg.(i).typ = Float then !float else !int); - incr int; - incr float - end else begin - begin match arg.(i).typ with - Float -> loc.(i) <- stack_slot (Outgoing !ofs) Float - | ty -> loc.(i) <- stack_slot (Outgoing (!ofs + 4)) ty - end; - ofs := !ofs + 8 - end - done; - (loc, Misc.align !ofs 16) - -let loc_external_results res = - let (loc, ofs) = calling_conventions 0 0 100 100 not_supported res in loc - -let loc_exn_bucket = phys_reg 0 (* $2 *) - -(* Registers destroyed by operations *) - -let destroyed_at_c_call = - (* $16 - $21, $f20, $f22, $f24, $f26, $f28, $f30 preserved *) - Array.of_list(List.map phys_reg - [0;1;2;3;4;5;6;7;8;9;10;11;12;13; - 100;101;102;103;104;105;106;107;108;109;110;111;112;113;114; - 115;116;117;118;119;121;123;125;127;129]) - -let destroyed_at_oper = function - Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs - | Iop(Iextcall(_, false)) -> destroyed_at_c_call - | _ -> [||] - -let destroyed_at_raise = all_phys_regs - -(* Maximal register pressure *) - -let safe_register_pressure = function - Iextcall(_, _) -> 6 - | _ -> 20 -let max_register_pressure = function - Iextcall(_, _) -> [| 6; 6 |] - | _ -> [| 20; 31 |] - -(* Layout of the stack *) - -let num_stack_slots = [| 0; 0 |] -let contains_calls = ref false - -(* Calling the assembler *) - -let assemble_file infile outfile = - Ccomp.command (Config.asm ^ " -o " ^ - Filename.quote outfile ^ " " ^ Filename.quote infile) - -open Clflags;; -open Config;; diff -Nru ocaml-3.12.1/asmcomp/mips/reload.ml ocaml-4.01.0/asmcomp/mips/reload.ml --- ocaml-3.12.1/asmcomp/mips/reload.ml 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/mips/reload.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,18 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: reload.ml 2553 1999-11-17 18:59:06Z xleroy $ *) - -(* Reloading for the Mips *) - -let fundecl f = - (new Reloadgen.reload_generic)#fundecl f diff -Nru ocaml-3.12.1/asmcomp/mips/scheduling.ml ocaml-4.01.0/asmcomp/mips/scheduling.ml --- ocaml-3.12.1/asmcomp/mips/scheduling.ml 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/mips/scheduling.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,20 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: scheduling.ml 2553 1999-11-17 18:59:06Z xleroy $ *) - -open Schedgen (* to create a dependency *) - -(* No scheduling is needed for the Mips, the assembler - does it better than us. *) - -let fundecl f = f diff -Nru ocaml-3.12.1/asmcomp/mips/selection.ml ocaml-4.01.0/asmcomp/mips/selection.ml --- ocaml-3.12.1/asmcomp/mips/selection.ml 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/mips/selection.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,43 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1997 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: selection.ml 2553 1999-11-17 18:59:06Z xleroy $ *) - -(* Instruction selection for the Mips processor *) - -open Misc -open Cmm -open Reg -open Arch -open Mach - -class selector = object - -inherit Selectgen.selector_generic - -method is_immediate (n : int) = true - -method select_addressing = function - Cconst_symbol s -> - (Ibased(s, 0), Ctuple []) - | Cop(Cadda, [Cconst_symbol s; Cconst_int n]) -> - (Ibased(s, n), Ctuple []) - | Cop(Cadda, [arg; Cconst_int n]) -> - (Iindexed n, arg) - | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) -> - (Iindexed n, Cop(Cadda, [arg1; arg2])) - | arg -> - (Iindexed 0, arg) - -end - -let fundecl f = (new selector)#emit_fundecl f diff -Nru ocaml-3.12.1/asmcomp/power/arch.ml ocaml-4.01.0/asmcomp/power/arch.ml --- ocaml-3.12.1/asmcomp/power/arch.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/power/arch.ml 2013-06-21 15:00:10.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,11 +10,8 @@ (* *) (***********************************************************************) -(* $Id: arch.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Specific operations for the PowerPC processor *) -open Misc open Format (* Machine-specific command-line options *) @@ -46,6 +43,12 @@ let size_int = size_addr let size_float = 8 +let allow_unaligned_access = false + +(* Behavior of division *) + +let division_crashes_on_overflow = true + (* Operations on addressing modes *) let identity_addressing = Iindexed 0 diff -Nru ocaml-3.12.1/asmcomp/power/emit.mlp ocaml-4.01.0/asmcomp/power/emit.mlp --- ocaml-3.12.1/asmcomp/power/emit.mlp 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/power/emit.mlp 2013-06-24 08:16:27.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,13 +10,11 @@ (* *) (***********************************************************************) -(* $Id: emit.mlp 9547 2010-01-22 12:48:24Z doligez $ *) - (* Emission of PowerPC assembly code *) -module StringSet = Set.Make(struct type t = string let compare = compare end) +module StringSet = + Set.Make(struct type t = string let compare (x:t) y = compare x y end) -open Location open Misc open Cmm open Arch @@ -58,7 +56,7 @@ let emit_symbol = match Config.system with - | "elf" | "bsd" -> (fun s -> Emitaux.emit_symbol '.' s) + | "elf" | "bsd" | "bsd_elf" -> (fun s -> Emitaux.emit_symbol '.' s) | "rhapsody" -> (fun s -> emit_char '_'; Emitaux.emit_symbol '$' s) | _ -> assert false @@ -66,30 +64,33 @@ let label_prefix = match Config.system with - | "elf" | "bsd" -> ".L" + | "elf" | "bsd" | "bsd_elf" -> ".L" | "rhapsody" -> "L" | _ -> assert false let emit_label lbl = emit_string label_prefix; emit_int lbl +let emit_data_label lbl = + emit_string label_prefix; emit_string "d"; emit_int lbl + (* Section switching *) let data_space = match Config.system with - | "elf" | "bsd" -> " .section \".data\"\n" + | "elf" | "bsd" | "bsd_elf" -> " .section \".data\"\n" | "rhapsody" -> " .data\n" | _ -> assert false let code_space = match Config.system with - | "elf" | "bsd" -> " .section \".text\"\n" + | "elf" | "bsd" | "bsd_elf" -> " .section \".text\"\n" | "rhapsody" -> " .text\n" | _ -> assert false let rodata_space = match Config.system with - | "elf" | "bsd" -> " .section \".rodata\"\n" + | "elf" | "bsd" | "bsd_elf" -> " .section \".rodata\"\n" | "rhapsody" -> " .const\n" | _ -> assert false @@ -157,7 +158,7 @@ let emit_upper emit_fun arg = match Config.system with - | "elf" | "bsd" -> + | "elf" | "bsd" | "bsd_elf" -> emit_fun arg; emit_string "@ha" | "rhapsody" -> emit_string "ha16("; emit_fun arg; emit_string ")" @@ -165,7 +166,7 @@ let emit_lower emit_fun arg = match Config.system with - | "elf" | "bsd" -> + | "elf" | "bsd" | "bsd_elf" -> emit_fun arg; emit_string "@l" | "rhapsody" -> emit_string "lo16("; emit_fun arg; emit_string ")" @@ -818,7 +819,7 @@ match i with {desc = Lend} -> () | {next = {desc = (Lcondbranch(_, _) | Lcondbranch3(_, _, _))}} - when is_simple_instr i & no_interference i.res i.next.arg -> + when is_simple_instr i && no_interference i.res i.next.arg -> emit_instr i.next (Some i); emit_all i.next.next | _ -> @@ -843,7 +844,7 @@ else ` .globl {emit_symbol fundecl.fun_name}\n`; begin match Config.system with - | "elf" | "bsd" -> + | "elf" | "bsd" | "bsd_elf" -> ` .type {emit_symbol fundecl.fun_name}, @function\n` | _ -> () end; @@ -888,8 +889,11 @@ let declare_global_data s = ` .globl {emit_symbol s}\n`; - if Config.system = "elf" || Config.system = "bsd" then + match Config.system with + | "elf" | "bsd" | "bsd_elf" -> ` .type {emit_symbol s}, @object\n` + | "rhapsody" -> () + | _ -> assert false let emit_item = function Cglobal_symbol s -> @@ -897,7 +901,7 @@ | Cdefine_symbol s -> `{emit_symbol s}:\n`; | Cdefine_label lbl -> - `{emit_label (lbl + 100000)}:\n` + `{emit_data_label lbl}:\n` | Cint8 n -> ` .byte {emit_int n}\n` | Cint16 n -> @@ -915,7 +919,7 @@ | Csymbol_address s -> ` {emit_string datag} {emit_symbol s}\n` | Clabel_address lbl -> - ` {emit_string datag} {emit_label (lbl + 100000)}\n` + ` {emit_string datag} {emit_data_label lbl}\n` | Cstring s -> emit_bytes_directive " .byte " s | Cskip n -> diff -Nru ocaml-3.12.1/asmcomp/power/proc.ml ocaml-4.01.0/asmcomp/power/proc.ml --- ocaml-3.12.1/asmcomp/power/proc.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/power/proc.ml 2013-06-24 08:16:27.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: proc.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Description of the Power PC *) open Misc @@ -188,7 +186,7 @@ let loc_external_arguments = match Config.system with | "rhapsody" -> poweropen_external_conventions 0 7 100 112 - | "elf" | "bsd" -> calling_conventions 0 7 100 107 outgoing 8 + | "elf" | "bsd" | "bsd_elf" -> calling_conventions 0 7 100 107 outgoing 8 | _ -> assert false let extcall_use_push = false @@ -237,5 +235,4 @@ Ccomp.command (Config.asm ^ " -o " ^ Filename.quote outfile ^ " " ^ Filename.quote infile) -open Clflags;; -open Config;; +let init () = () diff -Nru ocaml-3.12.1/asmcomp/power/reload.ml ocaml-4.01.0/asmcomp/power/reload.ml --- ocaml-3.12.1/asmcomp/power/reload.ml 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/power/reload.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: reload.ml 2553 1999-11-17 18:59:06Z xleroy $ *) - (* Reloading for the PowerPC *) let fundecl f = diff -Nru ocaml-3.12.1/asmcomp/power/scheduling.ml ocaml-4.01.0/asmcomp/power/scheduling.ml --- ocaml-3.12.1/asmcomp/power/scheduling.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/power/scheduling.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: scheduling.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Instruction scheduling for the Power PC *) open Arch diff -Nru ocaml-3.12.1/asmcomp/power/selection.ml ocaml-4.01.0/asmcomp/power/selection.ml --- ocaml-3.12.1/asmcomp/power/selection.ml 2010-04-22 12:51:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/power/selection.ml 2013-06-21 15:00:10.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,13 +10,9 @@ (* *) (***********************************************************************) -(* $Id: selection.ml 10296 2010-04-22 12:51:06Z xleroy $ *) - (* Instruction selection for the Power PC processor *) -open Misc open Cmm -open Reg open Arch open Mach @@ -52,7 +48,7 @@ method is_immediate n = (n <= 32767) && (n >= -32768) -method select_addressing exp = +method select_addressing chunk exp = match select_addr exp with (Asymbol s, d) -> (Ibased(s, d), Ctuple []) diff -Nru ocaml-3.12.1/asmcomp/printclambda.ml ocaml-4.01.0/asmcomp/printclambda.ml --- ocaml-3.12.1/asmcomp/printclambda.ml 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/asmcomp/printclambda.ml 2013-03-09 22:38:52.000000000 +0000 @@ -0,0 +1,134 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + + +open Format +open Asttypes +open Clambda + +let rec pr_idents ppf = function + | [] -> () + | h::t -> fprintf ppf "%a %a" Ident.print h pr_idents t + +let rec lam ppf = function + | Uvar id -> + Ident.print ppf id + | Uconst (cst,_) -> + Printlambda.structured_constant ppf cst + | Udirect_apply(f, largs, _) -> + let lams ppf largs = + List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in + fprintf ppf "@[<2>(apply*@ %s %a)@]" f lams largs + | Ugeneric_apply(lfun, largs, _) -> + let lams ppf largs = + List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in + fprintf ppf "@[<2>(apply@ %a%a)@]" lam lfun lams largs + | Uclosure(clos, fv) -> + let idents ppf = + List.iter (fprintf ppf "@ %a" Ident.print)in + let one_fun ppf f = + fprintf ppf "(fun@ %s@ %d @[<2>%a@] @[<2>%a@])" + f.label f.arity idents f.params lam f.body in + let funs ppf = + List.iter (fprintf ppf "@ %a" one_fun) in + let lams ppf = + List.iter (fprintf ppf "@ %a" lam) in + fprintf ppf "@[<2>(closure@ %a %a)@]" funs clos lams fv + | Uoffset(l,i) -> fprintf ppf "@[<2>(offset %a %d)@]" lam l i + | Ulet(id, arg, body) -> + let rec letbody ul = match ul with + | Ulet(id, arg, body) -> + fprintf ppf "@ @[<2>%a@ %a@]" Ident.print id lam arg; + letbody body + | _ -> ul in + fprintf ppf "@[<2>(let@ @[(@[<2>%a@ %a@]" Ident.print id lam arg; + let expr = letbody body in + fprintf ppf ")@]@ %a)@]" lam expr + | Uletrec(id_arg_list, body) -> + let bindings ppf id_arg_list = + let spc = ref false in + List.iter + (fun (id, l) -> + if !spc then fprintf ppf "@ " else spc := true; + fprintf ppf "@[<2>%a@ %a@]" Ident.print id lam l) + id_arg_list in + fprintf ppf + "@[<2>(letrec@ (@[%a@])@ %a)@]" bindings id_arg_list lam body + | Uprim(prim, largs, _) -> + let lams ppf largs = + List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in + fprintf ppf "@[<2>(%a%a)@]" Printlambda.primitive prim lams largs + | Uswitch(larg, sw) -> + let switch ppf sw = + let spc = ref false in + for i = 0 to Array.length sw.us_index_consts - 1 do + let n = sw.us_index_consts.(i) in + let l = sw.us_actions_consts.(n) in + if !spc then fprintf ppf "@ " else spc := true; + fprintf ppf "@[case int %i:@ %a@]" i lam l; + done; + for i = 0 to Array.length sw.us_index_blocks - 1 do + let n = sw.us_index_blocks.(i) in + let l = sw.us_actions_blocks.(n) in + if !spc then fprintf ppf "@ " else spc := true; + fprintf ppf "@[case tag %i:@ %a@]" i lam l; + done in + fprintf ppf + "@[<1>(switch %a@ @[%a@])@]" + lam larg switch sw + | Ustaticfail (i, ls) -> + let lams ppf largs = + List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in + fprintf ppf "@[<2>(exit@ %d%a)@]" i lams ls; + | Ucatch(i, vars, lbody, lhandler) -> + fprintf ppf "@[<2>(catch@ %a@;<1 -1>with (%d%a)@ %a)@]" + lam lbody i + (fun ppf vars -> match vars with + | [] -> () + | _ -> + List.iter + (fun x -> fprintf ppf " %a" Ident.print x) + vars) + vars + lam lhandler + | Utrywith(lbody, param, lhandler) -> + fprintf ppf "@[<2>(try@ %a@;<1 -1>with %a@ %a)@]" + lam lbody Ident.print param lam lhandler + | Uifthenelse(lcond, lif, lelse) -> + fprintf ppf "@[<2>(if@ %a@ %a@ %a)@]" lam lcond lam lif lam lelse + | Usequence(l1, l2) -> + fprintf ppf "@[<2>(seq@ %a@ %a)@]" lam l1 sequence l2 + | Uwhile(lcond, lbody) -> + fprintf ppf "@[<2>(while@ %a@ %a)@]" lam lcond lam lbody + | Ufor(param, lo, hi, dir, body) -> + fprintf ppf "@[<2>(for %a@ %a@ %s@ %a@ %a)@]" + Ident.print param lam lo + (match dir with Upto -> "to" | Downto -> "downto") + lam hi lam body + | Uassign(id, expr) -> + fprintf ppf "@[<2>(assign@ %a@ %a)@]" Ident.print id lam expr + | Usend (k, met, obj, largs, _) -> + let args ppf largs = + List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in + let kind = + if k = Lambda.Self then "self" + else if k = Lambda.Cached then "cache" + else "" in + fprintf ppf "@[<2>(send%s@ %a@ %a%a)@]" kind lam obj lam met args largs + +and sequence ppf ulam = match ulam with + | Usequence(l1, l2) -> + fprintf ppf "%a@ %a" sequence l1 sequence l2 + | _ -> lam ppf ulam + +let clambda ppf ulam = + fprintf ppf "%a@." lam ulam diff -Nru ocaml-3.12.1/asmcomp/printclambda.mli ocaml-4.01.0/asmcomp/printclambda.mli --- ocaml-3.12.1/asmcomp/printclambda.mli 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/asmcomp/printclambda.mli 2012-02-22 08:43:39.000000000 +0000 @@ -0,0 +1,16 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +open Clambda +open Format + +val clambda: formatter -> ulambda -> unit diff -Nru ocaml-3.12.1/asmcomp/printcmm.ml ocaml-4.01.0/asmcomp/printcmm.ml --- ocaml-3.12.1/asmcomp/printcmm.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/printcmm.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: printcmm.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Pretty-printing of C-- code *) open Format @@ -176,8 +174,9 @@ if !first then first := false else fprintf ppf "@ "; fprintf ppf "%a: %a" Ident.print id machtype ty) cases in - fprintf ppf "@[<1>(function %s@;<1 4>@[<1>(%a)@]@ @[%a@])@]@." - f.fun_name print_cases f.fun_args sequence f.fun_body + fprintf ppf "@[<1>(function%s %s@;<1 4>@[<1>(%a)@]@ @[%a@])@]@." + (Debuginfo.to_string f.fun_dbg) f.fun_name + print_cases f.fun_args sequence f.fun_body let data_item ppf = function | Cdefine_symbol s -> fprintf ppf "\"%s\":" s diff -Nru ocaml-3.12.1/asmcomp/printcmm.mli ocaml-4.01.0/asmcomp/printcmm.mli --- ocaml-3.12.1/asmcomp/printcmm.mli 2000-04-21 08:13:22.000000000 +0000 +++ ocaml-4.01.0/asmcomp/printcmm.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: printcmm.mli 3123 2000-04-21 08:13:22Z weis $ *) - (* Pretty-printing of C-- code *) open Format diff -Nru ocaml-3.12.1/asmcomp/printlinear.ml ocaml-4.01.0/asmcomp/printlinear.ml --- ocaml-3.12.1/asmcomp/printlinear.ml 2007-01-29 12:11:18.000000000 +0000 +++ ocaml-4.01.0/asmcomp/printlinear.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: printlinear.ml 7812 2007-01-29 12:11:18Z xleroy $ *) - (* Pretty-printing of linearized machine code *) open Format @@ -65,7 +63,7 @@ | Lraise -> fprintf ppf "raise %a" reg i.arg.(0) end; - if i.dbg != Debuginfo.none then + if not (Debuginfo.is_none i.dbg) then fprintf ppf " %s" (Debuginfo.to_string i.dbg) let rec all_instr ppf i = @@ -74,4 +72,9 @@ | _ -> fprintf ppf "%a@,%a" instr i all_instr i.next let fundecl ppf f = - fprintf ppf "@[%s:@,%a@]" f.fun_name all_instr f.fun_body + let dbg = + if Debuginfo.is_none f.fun_dbg then + "" + else + " " ^ Debuginfo.to_string f.fun_dbg in + fprintf ppf "@[%s:%s@,%a@]" f.fun_name dbg all_instr f.fun_body diff -Nru ocaml-3.12.1/asmcomp/printlinear.mli ocaml-4.01.0/asmcomp/printlinear.mli --- ocaml-3.12.1/asmcomp/printlinear.mli 2000-04-21 08:13:22.000000000 +0000 +++ ocaml-4.01.0/asmcomp/printlinear.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: printlinear.mli 3123 2000-04-21 08:13:22Z weis $ *) - (* Pretty-printing of linearized machine code *) open Format diff -Nru ocaml-3.12.1/asmcomp/printmach.ml ocaml-4.01.0/asmcomp/printmach.ml --- ocaml-3.12.1/asmcomp/printmach.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/printmach.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: printmach.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Pretty-printing of pseudo machine code *) open Format @@ -182,16 +180,21 @@ | Iraise -> fprintf ppf "raise %a" reg i.arg.(0) end; - if i.dbg != Debuginfo.none then - fprintf ppf " %s" (Debuginfo.to_string i.dbg); + if not (Debuginfo.is_none i.dbg) then + fprintf ppf "%s" (Debuginfo.to_string i.dbg); begin match i.next.desc with Iend -> () | _ -> fprintf ppf "@,%a" instr i.next end let fundecl ppf f = - fprintf ppf "@[%s(%a)@,%a@]" - f.fun_name regs f.fun_args instr f.fun_body + let dbg = + if Debuginfo.is_none f.fun_dbg then + "" + else + " " ^ Debuginfo.to_string f.fun_dbg in + fprintf ppf "@[%s(%a)%s@,%a@]" + f.fun_name regs f.fun_args dbg instr f.fun_body let phase msg ppf f = fprintf ppf "*** %s@.%a@." msg fundecl f diff -Nru ocaml-3.12.1/asmcomp/printmach.mli ocaml-4.01.0/asmcomp/printmach.mli --- ocaml-3.12.1/asmcomp/printmach.mli 2000-04-21 08:13:22.000000000 +0000 +++ ocaml-4.01.0/asmcomp/printmach.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: printmach.mli 3123 2000-04-21 08:13:22Z weis $ *) - (* Pretty-printing of pseudo machine code *) open Format diff -Nru ocaml-3.12.1/asmcomp/proc.mli ocaml-4.01.0/asmcomp/proc.mli --- ocaml-3.12.1/asmcomp/proc.mli 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/proc.mli 2013-06-03 18:03:59.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: proc.mli 2553 1999-11-17 18:59:06Z xleroy $ *) - (* Processor descriptions *) (* Instruction selection *) @@ -48,3 +46,6 @@ (* Calling the assembler *) val assemble_file: string -> string -> int + +(* Called before translating a fundecl. *) +val init : unit -> unit diff -Nru ocaml-3.12.1/asmcomp/reg.ml ocaml-4.01.0/asmcomp/reg.ml --- ocaml-3.12.1/asmcomp/reg.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/reg.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: reg.ml 9547 2010-01-22 12:48:24Z doligez $ *) - open Cmm type t = diff -Nru ocaml-3.12.1/asmcomp/reg.mli ocaml-4.01.0/asmcomp/reg.mli --- ocaml-3.12.1/asmcomp/reg.mli 2009-03-31 09:44:50.000000000 +0000 +++ ocaml-4.01.0/asmcomp/reg.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: reg.mli 9210 2009-03-31 09:44:50Z xleroy $ *) - (* Pseudo-registers *) type t = diff -Nru ocaml-3.12.1/asmcomp/reload.mli ocaml-4.01.0/asmcomp/reload.mli --- ocaml-3.12.1/asmcomp/reload.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/reload.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: reload.mli 9547 2010-01-22 12:48:24Z doligez $ *) - (* Insert load/stores for pseudoregs that got assigned to stack locations. *) val fundecl: Mach.fundecl -> Mach.fundecl * bool diff -Nru ocaml-3.12.1/asmcomp/reloadgen.ml ocaml-4.01.0/asmcomp/reloadgen.ml --- ocaml-3.12.1/asmcomp/reloadgen.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/reloadgen.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: reloadgen.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Insert load/stores for pseudoregs that got assigned to stack locations. *) open Misc @@ -134,7 +132,8 @@ redo_regalloc <- false; let new_body = self#reload f.fun_body in ({fun_name = f.fun_name; fun_args = f.fun_args; - fun_body = new_body; fun_fast = f.fun_fast}, + fun_body = new_body; fun_fast = f.fun_fast; + fun_dbg = f.fun_dbg}, redo_regalloc) end diff -Nru ocaml-3.12.1/asmcomp/reloadgen.mli ocaml-4.01.0/asmcomp/reloadgen.mli --- ocaml-3.12.1/asmcomp/reloadgen.mli 2010-05-21 12:00:49.000000000 +0000 +++ ocaml-4.01.0/asmcomp/reloadgen.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: reloadgen.mli 10450 2010-05-21 12:00:49Z doligez $ *) - class reload_generic : object method reload_operation : Mach.operation -> Reg.t array -> Reg.t array -> Reg.t array * Reg.t array diff -Nru ocaml-3.12.1/asmcomp/schedgen.ml ocaml-4.01.0/asmcomp/schedgen.ml --- ocaml-3.12.1/asmcomp/schedgen.ml 2010-05-21 12:00:49.000000000 +0000 +++ ocaml-4.01.0/asmcomp/schedgen.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,11 +10,8 @@ (* *) (***********************************************************************) -(* $Id: schedgen.ml 10450 2010-05-21 12:00:49Z doligez $ *) - (* Instruction scheduling *) -open Misc open Reg open Mach open Linearize @@ -65,6 +62,33 @@ let add_edge_after son ancestor = add_edge ancestor son 0 +(* Add edges from all instructions that define a pseudoregister [arg] being used + as argument to node [node] (RAW dependencies *) + +let add_RAW_dependencies node arg = + try + let ancestor = Hashtbl.find code_results arg.loc in + add_edge ancestor node ancestor.delay + with Not_found -> + () + +(* Add edges from all instructions that use a pseudoregister [res] that is + defined by node [node] (WAR dependencies). *) + +let add_WAR_dependencies node res = + let ancestors = Hashtbl.find_all code_uses res.loc in + List.iter (add_edge_after node) ancestors + +(* Add edges from all instructions that have already defined a pseudoregister + [res] that is defined by node [node] (WAW dependencies). *) + +let add_WAW_dependencies node res = + try + let ancestor = Hashtbl.find code_results res.loc in + add_edge ancestor node 0 + with Not_found -> + () + (* Compute length of longest path to a result. For leafs of the DAG, see whether their result is used in the instruction immediately following the basic block (a "critical" output). *) @@ -200,10 +224,19 @@ | Lreloadretaddr -> self#reload_retaddr_issue_cycles | _ -> assert false +(* Pseudoregisters destroyed by an instruction *) + +method private destroyed_by_instr instr = + match instr.desc with + | Lop op -> Proc.destroyed_at_oper (Iop op) + | Lreloadretaddr -> [||] + | _ -> assert false + (* Add an instruction to the code dag *) method private add_instruction ready_queue instr = let delay = self#instr_latency instr in + let destroyed = self#destroyed_by_instr instr in let node = { instr = instr; delay = delay; @@ -214,28 +247,17 @@ emitted_ancestors = 0 } in (* Add edges from all instructions that define one of the registers used (RAW dependencies) *) - for i = 0 to Array.length instr.arg - 1 do - try - let ancestor = Hashtbl.find code_results instr.arg.(i).loc in - add_edge ancestor node ancestor.delay - with Not_found -> - () - done; + Array.iter (add_RAW_dependencies node) instr.arg; (* Also add edges from all instructions that use one of the result regs - of this instruction (WAR dependencies). *) - for i = 0 to Array.length instr.res - 1 do - let ancestors = Hashtbl.find_all code_uses instr.res.(i).loc in - List.iter (add_edge_after node) ancestors - done; + of this instruction, or a reg destroyed by this instruction + (WAR dependencies). *) + Array.iter (add_WAR_dependencies node) instr.res; + Array.iter (add_WAR_dependencies node) destroyed; (* PR#5731 *) (* Also add edges from all instructions that have already defined one - of the results of this instruction (WAW dependencies). *) - for i = 0 to Array.length instr.res - 1 do - try - let ancestor = Hashtbl.find code_results instr.res.(i).loc in - add_edge ancestor node 0 - with Not_found -> - () - done; + of the results of this instruction, or a reg destroyed by + this instruction (WAW dependencies). *) + Array.iter (add_WAW_dependencies node) instr.res; + Array.iter (add_WAW_dependencies node) destroyed; (* PR#5731 *) (* If this is a load, add edges from the most recent store viewed so far (if any) and remember the load. Also add edges from the most recent checkbound and forget that checkbound. *) @@ -264,6 +286,9 @@ for i = 0 to Array.length instr.res - 1 do Hashtbl.add code_results instr.res.(i).loc node done; + for i = 0 to Array.length destroyed - 1 do + Hashtbl.add code_results destroyed.(i).loc node (* PR#5731 *) + done; for i = 0 to Array.length instr.arg - 1 do Hashtbl.add code_uses instr.arg.(i).loc node done; @@ -349,7 +374,8 @@ clear_code_dag(); { fun_name = f.fun_name; fun_body = new_body; - fun_fast = f.fun_fast } + fun_fast = f.fun_fast; + fun_dbg = f.fun_dbg } end else f diff -Nru ocaml-3.12.1/asmcomp/schedgen.mli ocaml-4.01.0/asmcomp/schedgen.mli --- ocaml-3.12.1/asmcomp/schedgen.mli 2010-05-21 12:00:49.000000000 +0000 +++ ocaml-4.01.0/asmcomp/schedgen.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: schedgen.mli 10450 2010-05-21 12:00:49Z doligez $ *) - (* Instruction scheduling *) type code_dag_node = diff -Nru ocaml-3.12.1/asmcomp/scheduling.mli ocaml-4.01.0/asmcomp/scheduling.mli --- ocaml-3.12.1/asmcomp/scheduling.mli 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/scheduling.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: scheduling.mli 2553 1999-11-17 18:59:06Z xleroy $ *) - (* Instruction scheduling *) val fundecl: Linearize.fundecl -> Linearize.fundecl diff -Nru ocaml-3.12.1/asmcomp/selectgen.ml ocaml-4.01.0/asmcomp/selectgen.ml --- ocaml-3.12.1/asmcomp/selectgen.ml 2010-09-02 13:29:21.000000000 +0000 +++ ocaml-4.01.0/asmcomp/selectgen.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: selectgen.ml 10667 2010-09-02 13:29:21Z xclerc $ *) - (* Selection of pseudo-instructions, assignment of pseudo-registers, sequentialization. *) @@ -204,7 +202,7 @@ (* Selection of addressing modes *) method virtual select_addressing : - Cmm.expression -> Arch.addressing_mode * Cmm.expression + Cmm.memory_chunk -> Cmm.expression -> Arch.addressing_mode * Cmm.expression (* Default instruction selection for stores (of words) *) @@ -219,10 +217,10 @@ | (Capply(ty, dbg), _) -> (Icall_ind, args) | (Cextcall(s, ty, alloc, dbg), _) -> (Iextcall(s, alloc), args) | (Cload chunk, [arg]) -> - let (addr, eloc) = self#select_addressing arg in + let (addr, eloc) = self#select_addressing chunk arg in (Iload(chunk, addr), [eloc]) | (Cstore chunk, [arg1; arg2]) -> - let (addr, eloc) = self#select_addressing arg1 in + let (addr, eloc) = self#select_addressing chunk arg1 in if chunk = Word then begin let (op, newarg2) = self#select_store addr arg2 in (op, [newarg2; eloc]) @@ -366,7 +364,7 @@ self#insert (Iop Imove) [|src|] [|dst|] method insert_moves src dst = - for i = 0 to Array.length src - 1 do + for i = 0 to min (Array.length src) (Array.length dst) - 1 do self#insert_move src.(i) dst.(i) done @@ -389,8 +387,7 @@ rd method insert_op op rs rd = - self#insert (Iop op) rs rd; - rd + self#insert_op_debug op Debuginfo.none rs rd (* Add the instructions for the given expression at the end of the self sequence *) @@ -490,9 +487,8 @@ let (loc_arg, stack_ofs) = self#emit_extcall_args env new_args in let rd = self#regs_for ty in - let loc_res = Proc.loc_external_results rd in - self#insert_debug (Iop(Iextcall(lbl, alloc))) dbg - loc_arg loc_res; + let loc_res = self#insert_op_debug (Iextcall(lbl, alloc)) dbg + loc_arg (Proc.loc_external_results rd) in self#insert_move_results loc_res rd stack_ofs; Some rd | Ialloc _ -> @@ -821,12 +817,13 @@ { fun_name = f.Cmm.fun_name; fun_args = loc_arg; fun_body = self#extract; - fun_fast = f.Cmm.fun_fast } + fun_fast = f.Cmm.fun_fast; + fun_dbg = f.Cmm.fun_dbg } end (* Tail call criterion (estimated). Assumes: -- all arguments are of type "int" (always the case for Caml function calls) +- all arguments are of type "int" (always the case for OCaml function calls) - one extra argument representing the closure environment (conservative). *) diff -Nru ocaml-3.12.1/asmcomp/selectgen.mli ocaml-4.01.0/asmcomp/selectgen.mli --- ocaml-3.12.1/asmcomp/selectgen.mli 2010-05-21 12:00:49.000000000 +0000 +++ ocaml-4.01.0/asmcomp/selectgen.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: selectgen.mli 10450 2010-05-21 12:00:49Z doligez $ *) - (* Selection of pseudo-instructions, assignment of pseudo-registers, sequentialization. *) @@ -26,7 +24,7 @@ (* Must be defined to indicate whether a constant is a suitable immediate operand to arithmetic instructions *) method virtual select_addressing : - Cmm.expression -> Arch.addressing_mode * Cmm.expression + Cmm.memory_chunk -> Cmm.expression -> Arch.addressing_mode * Cmm.expression (* Must be defined to select addressing modes *) method is_simple_expr: Cmm.expression -> bool (* Can be overridden to reflect special extcalls known to be pure *) diff -Nru ocaml-3.12.1/asmcomp/selection.mli ocaml-4.01.0/asmcomp/selection.mli --- ocaml-3.12.1/asmcomp/selection.mli 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/selection.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: selection.mli 2553 1999-11-17 18:59:06Z xleroy $ *) - (* Selection of pseudo-instructions, assignment of pseudo-registers, sequentialization. *) diff -Nru ocaml-3.12.1/asmcomp/sparc/arch.ml ocaml-4.01.0/asmcomp/sparc/arch.ml --- ocaml-3.12.1/asmcomp/sparc/arch.ml 2002-11-29 15:03:08.000000000 +0000 +++ ocaml-4.01.0/asmcomp/sparc/arch.ml 2012-11-09 16:15:29.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,11 +10,8 @@ (* *) (***********************************************************************) -(* $Id: arch.ml 5303 2002-11-29 15:03:08Z xleroy $ *) - (* Specific operations for the Sparc processor *) -open Misc open Format (* SPARC V8 adds multiply and divide. @@ -47,6 +44,12 @@ let size_int = 4 let size_float = 8 +let allow_unaligned_access = false + +(* Behavior of division *) + +let division_crashes_on_overflow = false + (* Operations on addressing modes *) let identity_addressing = Iindexed 0 diff -Nru ocaml-3.12.1/asmcomp/sparc/emit.mlp ocaml-4.01.0/asmcomp/sparc/emit.mlp --- ocaml-3.12.1/asmcomp/sparc/emit.mlp 2010-01-20 16:26:46.000000000 +0000 +++ ocaml-4.01.0/asmcomp/sparc/emit.mlp 2013-03-09 22:38:52.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,11 +10,8 @@ (* *) (***********************************************************************) -(* $Id: emit.mlp 9540 2010-01-20 16:26:46Z doligez $ *) - (* Emission of Sparc assembly code *) -open Location open Misc open Cmm open Arch @@ -98,6 +95,9 @@ let emit_label lbl = emit_string label_prefix; emit_int lbl +let emit_data_label lbl = + emit_string label_prefix; emit_string "d"; emit_int lbl + (* Output a pseudo-register *) let emit_reg r = @@ -714,7 +714,7 @@ | Cdefine_symbol s -> `{emit_symbol s}:\n` | Cdefine_label lbl -> - `{emit_label (lbl + 100000)}:\n` + `{emit_data_label lbl}:\n` | Cint8 n -> ` .byte {emit_int n}\n` | Cint16 n -> @@ -730,7 +730,7 @@ | Csymbol_address s -> ` .word {emit_symbol s}\n` | Clabel_address lbl -> - ` .word {emit_label (lbl + 100000)}\n` + ` .word {emit_data_label lbl}\n` | Cstring s -> emit_string_directive " .ascii " s | Cskip n -> diff -Nru ocaml-3.12.1/asmcomp/sparc/proc.ml ocaml-4.01.0/asmcomp/sparc/proc.ml --- ocaml-3.12.1/asmcomp/sparc/proc.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/sparc/proc.ml 2013-06-03 18:03:59.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: proc.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Description of the Sparc processor *) open Misc @@ -213,3 +211,5 @@ end in Ccomp.command (Config.asm ^ asflags ^ Filename.quote outfile ^ " " ^ Filename.quote infile) + +let init () = () diff -Nru ocaml-3.12.1/asmcomp/sparc/reload.ml ocaml-4.01.0/asmcomp/sparc/reload.ml --- ocaml-3.12.1/asmcomp/sparc/reload.ml 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/sparc/reload.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: reload.ml 2553 1999-11-17 18:59:06Z xleroy $ *) - (* Reloading for the Sparc *) let fundecl f = diff -Nru ocaml-3.12.1/asmcomp/sparc/scheduling.ml ocaml-4.01.0/asmcomp/sparc/scheduling.ml --- ocaml-3.12.1/asmcomp/sparc/scheduling.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/sparc/scheduling.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: scheduling.ml 9547 2010-01-22 12:48:24Z doligez $ *) - open Cmm open Mach diff -Nru ocaml-3.12.1/asmcomp/sparc/selection.ml ocaml-4.01.0/asmcomp/sparc/selection.ml --- ocaml-3.12.1/asmcomp/sparc/selection.ml 2010-04-22 12:51:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/sparc/selection.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,11 +10,8 @@ (* *) (***********************************************************************) -(* $Id: selection.ml 10296 2010-04-22 12:51:06Z xleroy $ *) - (* Instruction selection for the Sparc processor *) -open Misc open Cmm open Reg open Arch @@ -26,7 +23,7 @@ method is_immediate n = (n <= 4095) && (n >= -4096) -method select_addressing = function +method select_addressing chunk = function Cconst_symbol s -> (Ibased(s, 0), Ctuple []) | Cop(Cadda, [Cconst_symbol s; Cconst_int n]) -> diff -Nru ocaml-3.12.1/asmcomp/spill.ml ocaml-4.01.0/asmcomp/spill.ml --- ocaml-3.12.1/asmcomp/spill.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/spill.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: spill.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Insertion of moves to suggest possible spilling / reloading points before register allocation. *) @@ -399,4 +397,5 @@ { fun_name = f.fun_name; fun_args = f.fun_args; fun_body = new_body; - fun_fast = f.fun_fast } + fun_fast = f.fun_fast; + fun_dbg = f.fun_dbg } diff -Nru ocaml-3.12.1/asmcomp/spill.mli ocaml-4.01.0/asmcomp/spill.mli --- ocaml-3.12.1/asmcomp/spill.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/spill.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: spill.mli 9547 2010-01-22 12:48:24Z doligez $ *) - (* Insertion of moves to suggest possible spilling / reloading points before register allocation. *) diff -Nru ocaml-3.12.1/asmcomp/split.ml ocaml-4.01.0/asmcomp/split.ml --- ocaml-3.12.1/asmcomp/split.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmcomp/split.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: split.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Renaming of registers at reload points to split live ranges. *) open Reg @@ -21,7 +19,7 @@ type subst = Reg.t Reg.Map.t -let subst_reg r sub = +let subst_reg r (sub : subst) = try Reg.Map.find r sub with Not_found -> @@ -207,4 +205,5 @@ { fun_name = f.fun_name; fun_args = new_args; fun_body = new_body; - fun_fast = f.fun_fast } + fun_fast = f.fun_fast; + fun_dbg = f.fun_dbg } diff -Nru ocaml-3.12.1/asmcomp/split.mli ocaml-4.01.0/asmcomp/split.mli --- ocaml-3.12.1/asmcomp/split.mli 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/asmcomp/split.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: split.mli 2553 1999-11-17 18:59:06Z xleroy $ *) - (* Renaming of registers at reload points to split live ranges. *) val fundecl: Mach.fundecl -> Mach.fundecl diff -Nru ocaml-3.12.1/asmrun/.cvsignore ocaml-4.01.0/asmrun/.cvsignore --- ocaml-3.12.1/asmrun/.cvsignore 2010-05-19 14:52:34.000000000 +0000 +++ ocaml-4.01.0/asmrun/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,38 +0,0 @@ -libasmrun.a -libasmrunp.a -main.c -misc.c -freelist.c -major_gc.c -minor_gc.c -memory.c -alloc.c -array.c -compare.c -ints.c -floats.c -str.c -io.c -extern.c -intern.c -hash.c -sys.c -parsing.c -gc_ctrl.c -terminfo.c -md5.c -obj.c -lexing.c -printexc.c -callback.c -weak.c -compact.c -finalise.c -custom.c -meta.c -globroots.c -unix.c -dynlink.c -signals.c -debugger.c -.depend.nt diff -Nru ocaml-3.12.1/asmrun/.depend ocaml-4.01.0/asmrun/.depend --- ocaml-3.12.1/asmrun/.depend 2010-07-23 15:30:37.000000000 +0000 +++ ocaml-4.01.0/asmrun/.depend 2013-08-15 16:13:16.000000000 +0000 @@ -37,9 +37,10 @@ ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \ ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/mlvalues.h -debugger.o: debugger.c ../byterun/config.h ../byterun/../config/m.h \ - ../byterun/../config/s.h ../byterun/debugger.h ../byterun/misc.h \ - ../byterun/config.h ../byterun/mlvalues.h ../byterun/misc.h +debugger.o: debugger.c ../byterun/alloc.h ../byterun/misc.h \ + ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ + ../byterun/mlvalues.h ../byterun/config.h ../byterun/debugger.h \ + ../byterun/misc.h dynlink.o: dynlink.c ../byterun/config.h ../byterun/../config/m.h \ ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/mlvalues.h ../byterun/dynlink.h \ @@ -51,9 +52,9 @@ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ ../byterun/gc.h ../byterun/intext.h ../byterun/io.h ../byterun/io.h \ - ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \ - ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/misc.h \ - ../byterun/mlvalues.h ../byterun/reverse.h + ../byterun/md5.h ../byterun/memory.h ../byterun/gc.h \ + ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ + ../byterun/misc.h ../byterun/mlvalues.h ../byterun/reverse.h fail.o: fail.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \ ../byterun/fail.h ../byterun/io.h ../byterun/gc.h ../byterun/memory.h \ @@ -96,14 +97,14 @@ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \ ../byterun/custom.h ../byterun/mlvalues.h ../byterun/memory.h \ ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \ - ../byterun/minor_gc.h + ../byterun/minor_gc.h ../byterun/hash.h ../byterun/int64_native.h intern.o: intern.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ - ../byterun/gc.h ../byterun/intext.h ../byterun/io.h ../byterun/io.h \ - ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \ - ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/mlvalues.h \ - ../byterun/misc.h ../byterun/reverse.h ../byterun/md5.h + ../byterun/mlvalues.h ../byterun/callback.h ../byterun/custom.h \ + ../byterun/fail.h ../byterun/gc.h ../byterun/intext.h ../byterun/io.h \ + ../byterun/io.h ../byterun/md5.h ../byterun/memory.h ../byterun/gc.h \ + ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ + ../byterun/mlvalues.h ../byterun/misc.h ../byterun/reverse.h ints.o: ints.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \ ../byterun/custom.h ../byterun/fail.h ../byterun/intext.h \ @@ -174,7 +175,8 @@ ../byterun/misc.h ../byterun/memory.h ../byterun/gc.h \ ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \ ../byterun/minor_gc.h stack.h ../byterun/callback.h ../byterun/alloc.h \ - natdynlink.h ../byterun/osdeps.h ../byterun/fail.h + ../byterun/intext.h ../byterun/io.h ../byterun/osdeps.h \ + ../byterun/fail.h obj.o: obj.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \ ../byterun/fail.h ../byterun/gc.h ../byterun/interp.h \ @@ -216,14 +218,16 @@ startup.o: startup.c ../byterun/callback.h ../byterun/mlvalues.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/misc.h ../byterun/backtrace.h ../byterun/custom.h \ - ../byterun/fail.h ../byterun/freelist.h ../byterun/gc.h \ - ../byterun/gc_ctrl.h ../byterun/memory.h ../byterun/gc.h \ + ../byterun/debugger.h ../byterun/fail.h ../byterun/freelist.h \ + ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/intext.h \ + ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \ ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ ../byterun/misc.h ../byterun/mlvalues.h ../byterun/osdeps.h \ - ../byterun/printexc.h stack.h ../byterun/sys.h natdynlink.h + ../byterun/printexc.h stack.h ../byterun/sys.h str.o: str.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \ - ../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h + ../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h \ + ../byterun/int64_native.h sys.o: sys.c ../byterun/config.h ../byterun/../config/m.h \ ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/mlvalues.h ../byterun/debugger.h \ @@ -284,9 +288,10 @@ ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \ ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/mlvalues.h -debugger.d.o: debugger.c ../byterun/config.h ../byterun/../config/m.h \ - ../byterun/../config/s.h ../byterun/debugger.h ../byterun/misc.h \ - ../byterun/config.h ../byterun/mlvalues.h ../byterun/misc.h +debugger.d.o: debugger.c ../byterun/alloc.h ../byterun/misc.h \ + ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ + ../byterun/mlvalues.h ../byterun/config.h ../byterun/debugger.h \ + ../byterun/misc.h dynlink.d.o: dynlink.c ../byterun/config.h ../byterun/../config/m.h \ ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/mlvalues.h ../byterun/dynlink.h \ @@ -298,9 +303,9 @@ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ ../byterun/gc.h ../byterun/intext.h ../byterun/io.h ../byterun/io.h \ - ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \ - ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/misc.h \ - ../byterun/mlvalues.h ../byterun/reverse.h + ../byterun/md5.h ../byterun/memory.h ../byterun/gc.h \ + ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ + ../byterun/misc.h ../byterun/mlvalues.h ../byterun/reverse.h fail.d.o: fail.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \ ../byterun/fail.h ../byterun/io.h ../byterun/gc.h ../byterun/memory.h \ @@ -343,14 +348,14 @@ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \ ../byterun/custom.h ../byterun/mlvalues.h ../byterun/memory.h \ ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \ - ../byterun/minor_gc.h + ../byterun/minor_gc.h ../byterun/hash.h ../byterun/int64_native.h intern.d.o: intern.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ - ../byterun/gc.h ../byterun/intext.h ../byterun/io.h ../byterun/io.h \ - ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \ - ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/mlvalues.h \ - ../byterun/misc.h ../byterun/reverse.h ../byterun/md5.h + ../byterun/mlvalues.h ../byterun/callback.h ../byterun/custom.h \ + ../byterun/fail.h ../byterun/gc.h ../byterun/intext.h ../byterun/io.h \ + ../byterun/io.h ../byterun/md5.h ../byterun/memory.h ../byterun/gc.h \ + ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ + ../byterun/mlvalues.h ../byterun/misc.h ../byterun/reverse.h ints.d.o: ints.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \ ../byterun/custom.h ../byterun/fail.h ../byterun/intext.h \ @@ -421,7 +426,8 @@ ../byterun/misc.h ../byterun/memory.h ../byterun/gc.h \ ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \ ../byterun/minor_gc.h stack.h ../byterun/callback.h ../byterun/alloc.h \ - natdynlink.h ../byterun/osdeps.h ../byterun/fail.h + ../byterun/intext.h ../byterun/io.h ../byterun/osdeps.h \ + ../byterun/fail.h obj.d.o: obj.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \ ../byterun/fail.h ../byterun/gc.h ../byterun/interp.h \ @@ -463,14 +469,16 @@ startup.d.o: startup.c ../byterun/callback.h ../byterun/mlvalues.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/misc.h ../byterun/backtrace.h ../byterun/custom.h \ - ../byterun/fail.h ../byterun/freelist.h ../byterun/gc.h \ - ../byterun/gc_ctrl.h ../byterun/memory.h ../byterun/gc.h \ + ../byterun/debugger.h ../byterun/fail.h ../byterun/freelist.h \ + ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/intext.h \ + ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \ ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ ../byterun/misc.h ../byterun/mlvalues.h ../byterun/osdeps.h \ - ../byterun/printexc.h stack.h ../byterun/sys.h natdynlink.h + ../byterun/printexc.h stack.h ../byterun/sys.h str.d.o: str.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \ - ../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h + ../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h \ + ../byterun/int64_native.h sys.d.o: sys.c ../byterun/config.h ../byterun/../config/m.h \ ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/mlvalues.h ../byterun/debugger.h \ @@ -531,9 +539,10 @@ ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \ ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/mlvalues.h -debugger.p.o: debugger.c ../byterun/config.h ../byterun/../config/m.h \ - ../byterun/../config/s.h ../byterun/debugger.h ../byterun/misc.h \ - ../byterun/config.h ../byterun/mlvalues.h ../byterun/misc.h +debugger.p.o: debugger.c ../byterun/alloc.h ../byterun/misc.h \ + ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ + ../byterun/mlvalues.h ../byterun/config.h ../byterun/debugger.h \ + ../byterun/misc.h dynlink.p.o: dynlink.c ../byterun/config.h ../byterun/../config/m.h \ ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/mlvalues.h ../byterun/dynlink.h \ @@ -545,9 +554,9 @@ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ ../byterun/gc.h ../byterun/intext.h ../byterun/io.h ../byterun/io.h \ - ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \ - ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/misc.h \ - ../byterun/mlvalues.h ../byterun/reverse.h + ../byterun/md5.h ../byterun/memory.h ../byterun/gc.h \ + ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ + ../byterun/misc.h ../byterun/mlvalues.h ../byterun/reverse.h fail.p.o: fail.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \ ../byterun/fail.h ../byterun/io.h ../byterun/gc.h ../byterun/memory.h \ @@ -590,14 +599,14 @@ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \ ../byterun/custom.h ../byterun/mlvalues.h ../byterun/memory.h \ ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \ - ../byterun/minor_gc.h + ../byterun/minor_gc.h ../byterun/hash.h ../byterun/int64_native.h intern.p.o: intern.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ - ../byterun/gc.h ../byterun/intext.h ../byterun/io.h ../byterun/io.h \ - ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \ - ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/mlvalues.h \ - ../byterun/misc.h ../byterun/reverse.h ../byterun/md5.h + ../byterun/mlvalues.h ../byterun/callback.h ../byterun/custom.h \ + ../byterun/fail.h ../byterun/gc.h ../byterun/intext.h ../byterun/io.h \ + ../byterun/io.h ../byterun/md5.h ../byterun/memory.h ../byterun/gc.h \ + ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ + ../byterun/mlvalues.h ../byterun/misc.h ../byterun/reverse.h ints.p.o: ints.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \ ../byterun/custom.h ../byterun/fail.h ../byterun/intext.h \ @@ -668,7 +677,8 @@ ../byterun/misc.h ../byterun/memory.h ../byterun/gc.h \ ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \ ../byterun/minor_gc.h stack.h ../byterun/callback.h ../byterun/alloc.h \ - natdynlink.h ../byterun/osdeps.h ../byterun/fail.h + ../byterun/intext.h ../byterun/io.h ../byterun/osdeps.h \ + ../byterun/fail.h obj.p.o: obj.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \ ../byterun/fail.h ../byterun/gc.h ../byterun/interp.h \ @@ -710,14 +720,16 @@ startup.p.o: startup.c ../byterun/callback.h ../byterun/mlvalues.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/misc.h ../byterun/backtrace.h ../byterun/custom.h \ - ../byterun/fail.h ../byterun/freelist.h ../byterun/gc.h \ - ../byterun/gc_ctrl.h ../byterun/memory.h ../byterun/gc.h \ + ../byterun/debugger.h ../byterun/fail.h ../byterun/freelist.h \ + ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/intext.h \ + ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \ ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ ../byterun/misc.h ../byterun/mlvalues.h ../byterun/osdeps.h \ - ../byterun/printexc.h stack.h ../byterun/sys.h natdynlink.h + ../byterun/printexc.h stack.h ../byterun/sys.h str.p.o: str.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \ - ../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h + ../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h \ + ../byterun/int64_native.h sys.p.o: sys.c ../byterun/config.h ../byterun/../config/m.h \ ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/mlvalues.h ../byterun/debugger.h \ diff -Nru ocaml-3.12.1/asmrun/.ignore ocaml-4.01.0/asmrun/.ignore --- ocaml-3.12.1/asmrun/.ignore 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/asmrun/.ignore 2012-07-17 15:31:12.000000000 +0000 @@ -0,0 +1,40 @@ +*.p.c +*.d.c +libasmrun.a +libasmrunp.a +main.c +misc.c +freelist.c +major_gc.c +minor_gc.c +memory.c +alloc.c +array.c +compare.c +ints.c +floats.c +str.c +io.c +extern.c +intern.c +hash.c +sys.c +parsing.c +gc_ctrl.c +terminfo.c +md5.c +obj.c +lexing.c +printexc.c +callback.c +weak.c +compact.c +finalise.c +custom.c +meta.c +globroots.c +unix.c +dynlink.c +signals.c +debugger.c +.depend.nt diff -Nru ocaml-3.12.1/asmrun/Makefile ocaml-4.01.0/asmrun/Makefile --- ocaml-3.12.1/asmrun/Makefile 2010-04-20 15:47:15.000000000 +0000 +++ ocaml-4.01.0/asmrun/Makefile 2013-06-24 08:16:27.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -11,8 +11,6 @@ # # ######################################################################### -# $Id: Makefile 10287 2010-04-20 15:47:15Z doligez $ - include ../config/Makefile CC=$(NATIVECC) @@ -26,7 +24,8 @@ misc.o freelist.o major_gc.o minor_gc.o memory.o alloc.o compare.o ints.o \ floats.o str.o array.o io.o extern.o intern.o hash.o sys.o parsing.o \ gc_ctrl.o terminfo.o md5.o obj.o lexing.o printexc.o callback.o weak.o \ - compact.o finalise.o custom.o unix.o backtrace.o natdynlink.o debugger.o + compact.o finalise.o custom.o unix.o backtrace.o natdynlink.o debugger.o \ + meta.o dynlink.o ASMOBJS=$(ARCH).o @@ -34,13 +33,19 @@ DOBJS=$(COBJS:.o=.d.o) $(ASMOBJS) POBJS=$(COBJS:.o=.p.o) $(ASMOBJS:.o=.p.o) -all: libasmrun.a all-$(PROFILING) +all: libasmrun.a all-$(RUNTIMED) all-$(PROFILING) libasmrun.a: $(OBJS) rm -f libasmrun.a ar rc libasmrun.a $(OBJS) $(RANLIB) libasmrun.a +all-noruntimed: +.PHONY: all-noruntimed + +all-runtimed: libasmrund.a +.PHONY: all-runtimed + libasmrund.a: $(DOBJS) rm -f libasmrund.a ar rc libasmrund.a $(DOBJS) @@ -55,12 +60,20 @@ ar rc libasmrunp.a $(POBJS) $(RANLIB) libasmrunp.a -install: install-default install-$(PROFILING) +install: install-default install-$(RUNTIMED) install-$(PROFILING) install-default: cp libasmrun.a $(LIBDIR)/libasmrun.a cd $(LIBDIR); $(RANLIB) libasmrun.a +install-noruntimed: +.PHONY: install-noruntimed + +install-runtimed: + cp libasmrund.a $(LIBDIR)/libasmrund.a + cd $(LIBDIR); $(RANLIB) libasmrund.a +.PHONY: install-runtimed + install-noprof: rm -f $(LIBDIR)/libasmrunp.a; ln -s libasmrun.a $(LIBDIR)/libasmrunp.a @@ -68,6 +81,9 @@ cp libasmrunp.a $(LIBDIR)/libasmrunp.a cd $(LIBDIR); $(RANLIB) libasmrunp.a +power-bsd_elf.S: power-elf.S + cp power-elf.S power-bsd_elf.S + power.o: power-$(SYSTEM).o cp power-$(SYSTEM).o power.o @@ -157,23 +173,24 @@ .SUFFIXES: .S .d.o .p.o .S.o: - $(ASPP) -DSYS_$(SYSTEM) -o $*.o $*.S || \ - { echo "If your assembler produced syntax errors, it is probably unhappy with the"; echo "preprocessor. Check your assembler, or try producing $*.o by hand."; exit 2; } + $(ASPP) -DSYS_$(SYSTEM) -DMODEL_$(MODEL) -o $*.o $*.S || \ + { echo "If your assembler produced syntax errors, it is probably";\ + echo "unhappy with the preprocessor. Check your assembler, or";\ + echo "try producing $*.o by hand.";\ + exit 2; } .S.p.o: $(ASPP) -DSYS_$(SYSTEM) $(ASPPPROFFLAGS) -o $*.p.o $*.S .c.d.o: - @ if test -f $*.o; then mv $*.o $*.f.o; else :; fi - $(CC) -c $(DFLAGS) $< - mv $*.o $*.d.o - @ if test -f $*.f.o; then mv $*.f.o $*.o; else :; fi + ln -s -f $*.c $*.d.c + $(CC) -c $(DFLAGS) $*.d.c + rm -f $*.d.c .c.p.o: - @ if test -f $*.o; then mv $*.o $*.f.o; else :; fi - $(CC) -c $(PFLAGS) $< - mv $*.o $*.p.o - @ if test -f $*.f.o; then mv $*.f.o $*.o; else :; fi + ln -s -f $*.c $*.p.c + $(CC) -c $(PFLAGS) $*.p.c + rm -f $*.p.c .s.o: $(ASPP) -DSYS_$(SYSTEM) -o $*.o $*.s diff -Nru ocaml-3.12.1/asmrun/Makefile.nt ocaml-4.01.0/asmrun/Makefile.nt --- ocaml-3.12.1/asmrun/Makefile.nt 2010-04-28 12:00:27.000000000 +0000 +++ ocaml-4.01.0/asmrun/Makefile.nt 2013-04-30 09:25:14.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -11,20 +11,19 @@ # # ######################################################################### -# $Id: Makefile.nt 10325 2010-04-28 12:00:27Z xleroy $ - include ../config/Makefile CC=$(NATIVECC) -CFLAGS=-I../byterun -DNATIVE_CODE -DTARGET_$(ARCH) -DSYS_$(SYSTEM) $(NATIVECCCOMPOPTS) +CFLAGS=-I../byterun -DNATIVE_CODE -DTARGET_$(ARCH) -DSYS_$(SYSTEM) \ + $(NATIVECCCOMPOPTS) -COBJS=startup.$(O) main.$(O) fail.$(O) roots.$(O) signals.$(O) signals_asm.$(O) \ +COBJS=startup.$(O) main.$(O) fail.$(O) roots.$(O) signals.$(O) signals_asm.$(O)\ misc.$(O) freelist.$(O) major_gc.$(O) minor_gc.$(O) memory.$(O) alloc.$(O) \ compare.$(O) ints.$(O) floats.$(O) str.$(O) array.$(O) io.$(O) extern.$(O) \ intern.$(O) hash.$(O) sys.$(O) parsing.$(O) gc_ctrl.$(O) terminfo.$(O) \ md5.$(O) obj.$(O) lexing.$(O) win32.$(O) printexc.$(O) callback.$(O) \ weak.$(O) compact.$(O) finalise.$(O) custom.$(O) globroots.$(O) \ - backtrace.$(O) natdynlink.$(O) debugger.$(O) + backtrace.$(O) natdynlink.$(O) debugger.$(O) meta.$(O) dynlink.$(O) LINKEDFILES=misc.c freelist.c major_gc.c minor_gc.c memory.c alloc.c array.c \ compare.c ints.c floats.c str.c io.c extern.c intern.c hash.c sys.c \ @@ -52,7 +51,10 @@ $(ASM)amd64nt.obj amd64nt.asm i386.o: i386.S - $(CC) -c -DSYS_$(SYSTEM) i386.S + $(ASPP) -DSYS_$(SYSTEM) i386.S + +amd64.o: amd64.S + $(ASPP) -DSYS_$(SYSTEM) amd64.S install: cp libasmrun.$(A) $(LIBDIR) diff -Nru ocaml-3.12.1/asmrun/alpha.S ocaml-4.01.0/asmrun/alpha.S --- ocaml-3.12.1/asmrun/alpha.S 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmrun/alpha.S 1970-01-01 00:00:00.000000000 +0000 @@ -1,440 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id: alpha.S 9547 2010-01-22 12:48:24Z doligez $ */ - -/* Asm part of the runtime system, Alpha processor */ - -/* Allocation */ - - .text - .globl caml_alloc2 - .globl caml_alloc3 - .globl caml_allocN - .globl caml_call_gc - -/* Note: the profiling code sets $27 to the address of the "normal" entrypoint. - So don't pass parameters to those routines in $27. */ - -/* caml_alloc* : all code generator registers preserved, - $gp preserved, $27 not necessarily valid on entry */ - - .globl caml_alloc1 - .ent caml_alloc1 - .align 3 -caml_alloc1: - .prologue 0 - subq $13, 16, $13 - cmpult $13, $14, $25 - bne $25, $100 - ret ($26) -$100: ldiq $25, 16 - br $110 - .end caml_alloc1 - - .globl caml_alloc2 - .ent caml_alloc2 - .align 3 -caml_alloc2: - .prologue 0 - subq $13, 24, $13 - cmpult $13, $14, $25 - bne $25, $101 - ret ($26) -$101: ldiq $25, 24 - br $110 - .end caml_alloc2 - - .globl caml_alloc3 - .ent caml_alloc3 - .align 3 -caml_alloc3: - .prologue 0 - subq $13, 32, $13 - cmpult $13, $14, $25 - bne $25, $102 - ret ($26) -$102: ldiq $25, 32 - br $110 - .end caml_alloc3 - - .globl caml_allocN - .ent caml_allocN - .align 3 -caml_allocN: - .prologue 0 - subq $13, $25, $13 - .set noat - cmpult $13, $14, $at - bne $at, $110 - .set at - ret ($26) - .end caml_allocN - - .globl caml_call_gc - .ent caml_call_gc - .align 3 -caml_call_gc: - .prologue 0 - ldiq $25, 0 -$110: lda $sp, -0x200($sp) - /* 0x200 = 32*8 (ints) + 32*8 (floats) */ - stq $26, 0x1F8($sp) /* return address */ - stq $gp, 0x1F0($sp) /* caller's $gp */ - stq $25, 0x1E8($sp) /* desired size */ - /* Rebuild $gp */ - br $27, $103 -$103: ldgp $gp, 0($27) - /* Record lowest stack address, return address, GC regs */ - stq $26, caml_last_return_address - lda $24, 0x200($sp) - stq $24, caml_bottom_of_stack - lda $24, 0x100($sp) - stq $24, caml_gc_regs - /* Save current allocation pointer for debugging purposes */ -$113: stq $13, caml_young_ptr - /* Save trap pointer in case an exception is raised (e.g. sighandler) */ - stq $15, caml_exception_pointer - /* Save all integer regs used by the code generator in the context */ - stq $0, 0 * 8 ($24) - stq $1, 1 * 8 ($24) - stq $2, 2 * 8 ($24) - stq $3, 3 * 8 ($24) - stq $4, 4 * 8 ($24) - stq $5, 5 * 8 ($24) - stq $6, 6 * 8 ($24) - stq $7, 7 * 8 ($24) - stq $8, 8 * 8 ($24) - stq $9, 9 * 8 ($24) - stq $10, 10 * 8 ($24) - stq $11, 11 * 8 ($24) - stq $12, 12 * 8 ($24) - stq $16, 16 * 8 ($24) - stq $17, 17 * 8 ($24) - stq $18, 18 * 8 ($24) - stq $19, 19 * 8 ($24) - stq $20, 20 * 8 ($24) - stq $21, 21 * 8 ($24) - stq $22, 22 * 8 ($24) - /* Save all float regs that are not callee-save on the stack */ - stt $f0, 0 * 8 ($sp) - stt $f1, 1 * 8 ($sp) - stt $f10, 10 * 8 ($sp) - stt $f11, 11 * 8 ($sp) - stt $f12, 12 * 8 ($sp) - stt $f13, 13 * 8 ($sp) - stt $f14, 14 * 8 ($sp) - stt $f15, 15 * 8 ($sp) - stt $f16, 16 * 8 ($sp) - stt $f17, 17 * 8 ($sp) - stt $f18, 18 * 8 ($sp) - stt $f19, 19 * 8 ($sp) - stt $f20, 20 * 8 ($sp) - stt $f21, 21 * 8 ($sp) - stt $f22, 22 * 8 ($sp) - stt $f23, 23 * 8 ($sp) - stt $f24, 24 * 8 ($sp) - stt $f25, 25 * 8 ($sp) - stt $f26, 26 * 8 ($sp) - stt $f27, 27 * 8 ($sp) - stt $f29, 29 * 8 ($sp) - stt $f30, 30 * 8 ($sp) - /* Call the garbage collector */ - jsr caml_garbage_collection - ldgp $gp, 0($26) - /* Restore all regs used by the code generator */ - lda $24, 0x100($sp) - ldq $0, 0 * 8 ($24) - ldq $1, 1 * 8 ($24) - ldq $2, 2 * 8 ($24) - ldq $3, 3 * 8 ($24) - ldq $4, 4 * 8 ($24) - ldq $5, 5 * 8 ($24) - ldq $6, 6 * 8 ($24) - ldq $7, 7 * 8 ($24) - ldq $8, 8 * 8 ($24) - ldq $9, 9 * 8 ($24) - ldq $10, 10 * 8 ($24) - ldq $11, 11 * 8 ($24) - ldq $12, 12 * 8 ($24) - ldq $16, 16 * 8 ($24) - ldq $17, 17 * 8 ($24) - ldq $18, 18 * 8 ($24) - ldq $19, 19 * 8 ($24) - ldq $20, 20 * 8 ($24) - ldq $21, 21 * 8 ($24) - ldq $22, 22 * 8 ($24) - ldt $f0, 0 * 8 ($sp) - ldt $f1, 1 * 8 ($sp) - ldt $f10, 10 * 8 ($sp) - ldt $f11, 11 * 8 ($sp) - ldt $f12, 12 * 8 ($sp) - ldt $f13, 13 * 8 ($sp) - ldt $f14, 14 * 8 ($sp) - ldt $f15, 15 * 8 ($sp) - ldt $f16, 16 * 8 ($sp) - ldt $f17, 17 * 8 ($sp) - ldt $f18, 18 * 8 ($sp) - ldt $f19, 19 * 8 ($sp) - ldt $f20, 20 * 8 ($sp) - ldt $f21, 21 * 8 ($sp) - ldt $f22, 22 * 8 ($sp) - ldt $f23, 23 * 8 ($sp) - ldt $f24, 24 * 8 ($sp) - ldt $f25, 25 * 8 ($sp) - ldt $f26, 26 * 8 ($sp) - ldt $f27, 27 * 8 ($sp) - ldt $f29, 29 * 8 ($sp) - ldt $f30, 30 * 8 ($sp) - /* Reload new allocation pointer and allocation limit */ - ldq $13, caml_young_ptr - ldq $14, caml_young_limit - /* Allocate space for the block */ - ldq $25, 0x1E8($sp) - subq $13, $25, $13 - cmpult $13, $14, $25 /* Check that we have enough free space */ - bne $25, $113 /* If not, call GC again */ - /* Say that we are back into Caml code */ - stq $31, caml_last_return_address - /* Return to caller */ - ldq $26, 0x1F8($sp) - ldq $gp, 0x1F0($sp) - lda $sp, 0x200($sp) - ret ($26) - - .end caml_call_gc - -/* Call a C function from Caml */ -/* Function to call is in $25 */ - - .globl caml_c_call - .ent caml_c_call - .align 3 -caml_c_call: - .prologue 0 - /* Preserve return address and caller's $gp in callee-save registers */ - mov $26, $9 - mov $gp, $10 - /* Rebuild $gp */ - br $27, $104 -$104: ldgp $gp, 0($27) - /* Record lowest stack address and return address */ - lda $11, caml_last_return_address - stq $26, 0($11) - stq $sp, caml_bottom_of_stack - /* Make the exception handler and alloc ptr available to the C code */ - lda $12, caml_young_ptr - stq $13, 0($12) - lda $14, caml_young_limit - stq $15, caml_exception_pointer - /* Call the function */ - mov $25, $27 - jsr ($25) - /* Reload alloc ptr and alloc limit */ - ldq $13, 0($12) /* $12 still points to caml_young_ptr */ - ldq $14, 0($14) /* $14 still points to caml_young_limit */ - /* Say that we are back into Caml code */ - stq $31, 0($11) /* $11 still points to caml_last_return_address */ - /* Restore $gp */ - mov $10, $gp - /* Return */ - ret ($9) - - .end caml_c_call - -/* Start the Caml program */ - - .globl caml_start_program - .ent caml_start_program - .align 3 -caml_start_program: - ldgp $gp, 0($27) - lda $25, caml_program - -/* Code shared with caml_callback* */ -$107: - /* Save return address */ - lda $sp, -128($sp) - stq $26, 0($sp) - /* Save all callee-save registers */ - stq $9, 8($sp) - stq $10, 16($sp) - stq $11, 24($sp) - stq $12, 32($sp) - stq $13, 40($sp) - stq $14, 48($sp) - stq $15, 56($sp) - stt $f2, 64($sp) - stt $f3, 72($sp) - stt $f4, 80($sp) - stt $f5, 88($sp) - stt $f6, 96($sp) - stt $f7, 104($sp) - stt $f8, 112($sp) - stt $f9, 120($sp) - /* Set up a callback link on the stack. */ - lda $sp, -32($sp) - ldq $0, caml_bottom_of_stack - stq $0, 0($sp) - ldq $1, caml_last_return_address - stq $1, 8($sp) - ldq $1, caml_gc_regs - stq $1, 16($sp) - /* Set up a trap frame to catch exceptions escaping the Caml code */ - lda $sp, -16($sp) - ldq $15, caml_exception_pointer - stq $15, 0($sp) - lda $0, $109 - stq $0, 8($sp) - mov $sp, $15 - /* Reload allocation pointers */ - ldq $13, caml_young_ptr - ldq $14, caml_young_limit - /* We are back into Caml code */ - stq $31, caml_last_return_address - /* Call the Caml code */ - mov $25, $27 -$108: jsr ($25) - /* Reload $gp, masking off low bit in retaddr (might have been marked) */ - bic $26, 1, $26 - ldgp $gp, 4($26) - /* Pop the trap frame, restoring caml_exception_pointer */ - ldq $15, 0($sp) - stq $15, caml_exception_pointer - lda $sp, 16($sp) - /* Pop the callback link, restoring the global variables */ -$112: ldq $24, 0($sp) - stq $24, caml_bottom_of_stack - ldq $25, 8($sp) - stq $25, caml_last_return_address - ldq $24, 16($sp) - stq $24, caml_gc_regs - lda $sp, 32($sp) - /* Update allocation pointer */ - stq $13, caml_young_ptr - /* Reload callee-save registers */ - ldq $9, 8($sp) - ldq $10, 16($sp) - ldq $11, 24($sp) - ldq $12, 32($sp) - ldq $13, 40($sp) - ldq $14, 48($sp) - ldq $15, 56($sp) - ldt $f2, 64($sp) - ldt $f3, 72($sp) - ldt $f4, 80($sp) - ldt $f5, 88($sp) - ldt $f6, 96($sp) - ldt $f7, 104($sp) - ldt $f8, 112($sp) - ldt $f9, 120($sp) - /* Return to caller */ - ldq $26, 0($sp) - lda $sp, 128($sp) - ret ($26) - - /* The trap handler */ -$109: ldgp $gp, 0($26) - /* Save exception pointer */ - stq $15, caml_exception_pointer - /* Encode exception bucket as an exception result */ - or $0, 2, $0 - /* Return it */ - br $112 - - .end caml_start_program - -/* Raise an exception from C */ - - .globl caml_raise_exception - .ent caml_raise_exception - .align 3 -caml_raise_exception: - ldgp $gp, 0($27) - mov $16, $0 /* Move exn bucket */ - ldq $13, caml_young_ptr - ldq $14, caml_young_limit - stq $31, caml_last_return_address /* We're back into Caml */ - ldq $sp, caml_exception_pointer - ldq $15, 0($sp) - ldq $26, 8($sp) - lda $sp, 16($sp) - jmp $25, ($26) /* Keep retaddr in $25 to help debugging */ - .end caml_raise_exception - -/* Callback from C to Caml */ - - .globl caml_callback_exn - .ent caml_callback_exn - .align 3 -caml_callback_exn: - /* Initial shuffling of arguments */ - ldgp $gp, 0($27) - mov $16, $25 - mov $17, $16 /* first arg */ - mov $25, $17 /* environment */ - ldq $25, 0($25) /* code pointer */ - br $107 - .end caml_callback_exn - - .globl caml_callback2_exn - .ent caml_callback2_exn - .align 3 -caml_callback2_exn: - ldgp $gp, 0($27) - mov $16, $25 - mov $17, $16 /* first arg */ - mov $18, $17 /* second arg */ - mov $25, $18 /* environment */ - lda $25, caml_apply2 - br $107 - .end caml_callback2_exn - - .globl caml_callback3_exn - .ent caml_callback3_exn - .align 3 -caml_callback3_exn: - ldgp $gp, 0($27) - mov $16, $25 - mov $17, $16 /* first arg */ - mov $18, $17 /* second arg */ - mov $19, $18 /* third arg */ - mov $25, $19 /* environment */ - lda $25, caml_apply3 - br $107 - .end caml_callback3_exn - -/* Glue code to call [caml_array_bound_error] */ - - .globl caml_ml_array_bound_error - .ent caml_ml_array_bound_error - .align 3 -caml_ml_array_bound_error: - br $27, $111 -$111: ldgp $gp, 0($27) - lda $25, caml_array_bound_error - br caml_c_call /* never returns */ - .end caml_ml_array_bound_error - -#if defined(SYS_digital) - .rdata -#else - .section .rodata -#endif - .globl caml_system__frametable -caml_system__frametable: - .quad 1 /* one descriptor */ - .quad $108 + 4 /* return address into callback */ - .word -1 /* negative frame size => use callback link */ - .word 0 /* no roots here */ - .align 3 diff -Nru ocaml-3.12.1/asmrun/amd64.S ocaml-4.01.0/asmrun/amd64.S --- ocaml-3.12.1/asmrun/amd64.S 2010-11-27 17:19:24.000000000 +0000 +++ ocaml-4.01.0/asmrun/amd64.S 2013-07-23 14:48:47.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,15 +11,16 @@ /* */ /***********************************************************************/ -/* $Id: amd64.S 10862 2010-11-27 17:19:24Z xleroy $ */ - /* Asm part of the runtime system, AMD64 processor */ /* Must be preprocessed by cpp */ /* PIC mode support based on contribution by Paul Stravers (see PR#4795) */ -#ifdef SYS_macosx +#include "../config/m.h" + +#if defined(SYS_macosx) +#define LBL(x) L##x #define G(r) _##r #define GREL(r) _##r@GOTPCREL #define GCALL(r) _##r @@ -31,8 +32,23 @@ .align FUNCTION_ALIGN; \ name: +#elif defined(SYS_mingw64) + +#define LBL(x) .L##x +#define G(r) r +#undef GREL +#define GCALL(r) r +#define FUNCTION_ALIGN 4 +#define EIGHT_ALIGN 8 +#define SIXTEEN_ALIGN 16 +#define FUNCTION(name) \ + .globl name; \ + .align FUNCTION_ALIGN; \ + name: + #else +#define LBL(x) .L##x #define G(r) r #define GREL(r) r@GOTPCREL #define GCALL(r) r@PLT @@ -47,7 +63,34 @@ #endif -#ifdef __PIC__ +#ifdef ASM_CFI_SUPPORTED +#define CFI_STARTPROC .cfi_startproc +#define CFI_ENDPROC .cfi_endproc +#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n +#else +#define CFI_STARTPROC +#define CFI_ENDPROC +#define CFI_ADJUST(n) +#endif + +#ifdef WITH_FRAME_POINTERS + +#define ENTER_FUNCTION \ + pushq %rbp; CFI_ADJUST(8); \ + movq %rsp, %rbp +#define LEAVE_FUNCTION \ + popq %rbp; CFI_ADJUST(-8); + +#else + +#define ENTER_FUNCTION \ + subq $8, %rsp; CFI_ADJUST (8); +#define LEAVE_FUNCTION \ + addq $8, %rsp; CFI_ADJUST (-8); + +#endif + +#if defined(__PIC__) && !defined(SYS_mingw64) /* Position-independent operations on global variables. */ @@ -74,24 +117,28 @@ /* Push global [label] on stack. Clobbers %r11. */ #define PUSH_VAR(srclabel) \ movq GREL(srclabel)(%rip), %r11 ; \ - pushq (%r11) + pushq (%r11); CFI_ADJUST (8) /* Pop global [label] off stack. Clobbers %r11. */ #define POP_VAR(dstlabel) \ movq GREL(dstlabel)(%rip), %r11 ; \ - popq (%r11) + popq (%r11); CFI_ADJUST (-8) /* Record lowest stack address and return address. Clobbers %rax. */ #define RECORD_STACK_FRAME(OFFSET) \ - pushq %r11 ; \ + pushq %r11 ; CFI_ADJUST(8); \ movq 8+OFFSET(%rsp), %rax ; \ - STORE_VAR(%rax,caml_last_return_address) ; \ + STORE_VAR(%rax,caml_last_return_address) ; \ leaq 16+OFFSET(%rsp), %rax ; \ - STORE_VAR(%rax,caml_bottom_of_stack) ; \ - popq %r11 + STORE_VAR(%rax,caml_bottom_of_stack) ; \ + popq %r11; CFI_ADJUST(-8) + +/* Load address of global [label] in register [dst]. */ +#define LEA_VAR(label,dst) \ + movq GREL(label)(%rip), dst #else - + /* Non-PIC operations on global variables. Slightly faster. */ #define STORE_VAR(srcreg,dstlabel) \ @@ -107,46 +154,147 @@ testl imm, G(label)(%rip) #define PUSH_VAR(srclabel) \ - pushq G(srclabel)(%rip) + pushq G(srclabel)(%rip) ; CFI_ADJUST(8) #define POP_VAR(dstlabel) \ - popq G(dstlabel)(%rip) + popq G(dstlabel)(%rip); CFI_ADJUST(-8) #define RECORD_STACK_FRAME(OFFSET) \ movq OFFSET(%rsp), %rax ; \ - STORE_VAR(%rax,caml_last_return_address) ; \ + STORE_VAR(%rax,caml_last_return_address) ; \ leaq 8+OFFSET(%rsp), %rax ; \ - STORE_VAR(%rax,caml_bottom_of_stack) + STORE_VAR(%rax,caml_bottom_of_stack) + +#define LEA_VAR(label,dst) \ + leaq G(label)(%rip), dst +#endif + +/* Save and restore all callee-save registers on stack. + Keep the stack 16-aligned. */ + +#if defined(SYS_mingw64) + +/* Win64 API: callee-save regs are rbx, rbp, rsi, rdi, r12-r15, xmm6-xmm15 */ + +#define PUSH_CALLEE_SAVE_REGS \ + pushq %rbx; CFI_ADJUST (8); \ + pushq %rbp; CFI_ADJUST (8); \ + pushq %rsi; CFI_ADJUST (8); \ + pushq %rdi; CFI_ADJUST (8); \ + pushq %r12; CFI_ADJUST (8); \ + pushq %r13; CFI_ADJUST (8); \ + pushq %r14; CFI_ADJUST (8); \ + pushq %r15; CFI_ADJUST (8); \ + subq $(8+10*16), %rsp; CFI_ADJUST (8+10*16); \ + movupd %xmm6, 0*16(%rsp); \ + movupd %xmm7, 1*16(%rsp); \ + movupd %xmm8, 2*16(%rsp); \ + movupd %xmm9, 3*16(%rsp); \ + movupd %xmm10, 4*16(%rsp); \ + movupd %xmm11, 5*16(%rsp); \ + movupd %xmm12, 6*16(%rsp); \ + movupd %xmm13, 7*16(%rsp); \ + movupd %xmm14, 8*16(%rsp); \ + movupd %xmm15, 9*16(%rsp) + +#define POP_CALLEE_SAVE_REGS \ + movupd 0*16(%rsp), %xmm6; \ + movupd 1*16(%rsp), %xmm7; \ + movupd 2*16(%rsp), %xmm8; \ + movupd 3*16(%rsp), %xmm9; \ + movupd 4*16(%rsp), %xmm10; \ + movupd 5*16(%rsp), %xmm11; \ + movupd 6*16(%rsp), %xmm12; \ + movupd 7*16(%rsp), %xmm13; \ + movupd 8*16(%rsp), %xmm14; \ + movupd 9*16(%rsp), %xmm15; \ + addq $(8+10*16), %rsp; CFI_ADJUST (-8-10*16); \ + popq %r15; CFI_ADJUST(-8); \ + popq %r14; CFI_ADJUST(-8); \ + popq %r13; CFI_ADJUST(-8); \ + popq %r12; CFI_ADJUST(-8); \ + popq %rdi; CFI_ADJUST(-8); \ + popq %rsi; CFI_ADJUST(-8); \ + popq %rbp; CFI_ADJUST(-8); \ + popq %rbx; CFI_ADJUST(-8) + +#else + +/* Unix API: callee-save regs are rbx, rbp, r12-r15 */ + +#define PUSH_CALLEE_SAVE_REGS \ + pushq %rbx; CFI_ADJUST(8); \ + pushq %rbp; CFI_ADJUST(8); \ + pushq %r12; CFI_ADJUST(8); \ + pushq %r13; CFI_ADJUST(8); \ + pushq %r14; CFI_ADJUST(8); \ + pushq %r15; CFI_ADJUST(8); \ + subq $8, %rsp; CFI_ADJUST(8) + +#define POP_CALLEE_SAVE_REGS \ + addq $8, %rsp; CFI_ADJUST(-8); \ + popq %r15; CFI_ADJUST(-8); \ + popq %r14; CFI_ADJUST(-8); \ + popq %r13; CFI_ADJUST(-8); \ + popq %r12; CFI_ADJUST(-8); \ + popq %rbp; CFI_ADJUST(-8); \ + popq %rbx; CFI_ADJUST(-8); #endif +#ifdef SYS_mingw64 + /* Calls from OCaml to C must reserve 32 bytes of extra stack space */ +# define PREPARE_FOR_C_CALL subq $32, %rsp; CFI_ADJUST(32) +# define CLEANUP_AFTER_C_CALL addq $32, %rsp; CFI_ADJUST(-32) +#else +# define PREPARE_FOR_C_CALL +# define CLEANUP_AFTER_C_CALL +#endif + .text + .globl G(caml_system__code_begin) +G(caml_system__code_begin): + ret /* just one instruction, so that debuggers don't display + caml_system__code_begin instead of caml_call_gc */ + /* Allocation */ FUNCTION(G(caml_call_gc)) + CFI_STARTPROC RECORD_STACK_FRAME(0) -.Lcaml_call_gc: +LBL(caml_call_gc): +#ifndef SYS_mingw64 + /* Touch the stack to trigger a recoverable segfault + if insufficient space remains */ + subq $32768, %rsp + movq %rax, 0(%rsp) + addq $32768, %rsp +#endif /* Build array of registers, save it into caml_gc_regs */ - pushq %r13 - pushq %r12 - pushq %rbp - pushq %r11 - pushq %r10 - pushq %r9 - pushq %r8 - pushq %rcx - pushq %rdx - pushq %rsi - pushq %rdi - pushq %rbx - pushq %rax +#ifdef WITH_FRAME_POINTERS + ENTER_FUNCTION ; +#else + pushq %rbp; CFI_ADJUST(8); +#endif + pushq %r11; CFI_ADJUST (8); + pushq %r10; CFI_ADJUST (8); + pushq %r13; CFI_ADJUST (8); + pushq %r12; CFI_ADJUST (8); + pushq %r9; CFI_ADJUST (8); + pushq %r8; CFI_ADJUST (8); + pushq %rcx; CFI_ADJUST (8); + pushq %rdx; CFI_ADJUST (8); + pushq %rsi; CFI_ADJUST (8); + pushq %rdi; CFI_ADJUST (8); + pushq %rbx; CFI_ADJUST (8); + pushq %rax; CFI_ADJUST (8); STORE_VAR(%rsp, caml_gc_regs) /* Save caml_young_ptr, caml_exception_pointer */ - STORE_VAR(%r15, caml_young_ptr) - STORE_VAR(%r14, caml_exception_pointer) + STORE_VAR(%r15, caml_young_ptr) + STORE_VAR(%r14, caml_exception_pointer) /* Save floating-point registers */ - subq $(16*8), %rsp + subq $(16*8), %rsp; CFI_ADJUST (16*8); movsd %xmm0, 0*8(%rsp) movsd %xmm1, 1*8(%rsp) movsd %xmm2, 2*8(%rsp) @@ -164,10 +312,12 @@ movsd %xmm14, 14*8(%rsp) movsd %xmm15, 15*8(%rsp) /* Call the garbage collector */ + PREPARE_FOR_C_CALL call GCALL(caml_garbage_collection) + CLEANUP_AFTER_C_CALL /* Restore caml_young_ptr, caml_exception_pointer */ - LOAD_VAR(caml_young_ptr, %r15) - LOAD_VAR(caml_exception_pointer, %r14) + LOAD_VAR(caml_young_ptr, %r15) + LOAD_VAR(caml_exception_pointer, %r14) /* Restore all regs used by the code generator */ movsd 0*8(%rsp), %xmm0 movsd 1*8(%rsp), %xmm1 @@ -185,274 +335,340 @@ movsd 13*8(%rsp), %xmm13 movsd 14*8(%rsp), %xmm14 movsd 15*8(%rsp), %xmm15 - addq $(16*8), %rsp - popq %rax - popq %rbx - popq %rdi - popq %rsi - popq %rdx - popq %rcx - popq %r8 - popq %r9 - popq %r10 - popq %r11 - popq %rbp - popq %r12 - popq %r13 + addq $(16*8), %rsp; CFI_ADJUST(-16*8) + popq %rax; CFI_ADJUST(-8) + popq %rbx; CFI_ADJUST(-8) + popq %rdi; CFI_ADJUST(-8) + popq %rsi; CFI_ADJUST(-8) + popq %rdx; CFI_ADJUST(-8) + popq %rcx; CFI_ADJUST(-8) + popq %r8; CFI_ADJUST(-8) + popq %r9; CFI_ADJUST(-8) + popq %r12; CFI_ADJUST(-8) + popq %r13; CFI_ADJUST(-8) + popq %r10; CFI_ADJUST(-8) + popq %r11; CFI_ADJUST(-8) +#ifdef WITH_FRAME_POINTERS + LEAVE_FUNCTION +#else + popq %rbp; CFI_ADJUST(-8); +#endif /* Return to caller */ ret +CFI_ENDPROC FUNCTION(G(caml_alloc1)) -.Lcaml_alloc1: +CFI_STARTPROC +LBL(caml_alloc1): subq $16, %r15 CMP_VAR(caml_young_limit, %r15) - jb .L100 + jb LBL(100) ret -.L100: +LBL(100): RECORD_STACK_FRAME(0) - subq $8, %rsp - call .Lcaml_call_gc - addq $8, %rsp - jmp .Lcaml_alloc1 + ENTER_FUNCTION +/* subq $8, %rsp; CFI_ADJUST (8); */ + call LBL(caml_call_gc) +/* addq $8, %rsp; CFI_ADJUST (-8); */ + LEAVE_FUNCTION + jmp LBL(caml_alloc1) +CFI_ENDPROC FUNCTION(G(caml_alloc2)) -.Lcaml_alloc2: +CFI_STARTPROC +LBL(caml_alloc2): subq $24, %r15 CMP_VAR(caml_young_limit, %r15) - jb .L101 + jb LBL(101) ret -.L101: +LBL(101): RECORD_STACK_FRAME(0) - subq $8, %rsp - call .Lcaml_call_gc - addq $8, %rsp - jmp .Lcaml_alloc2 + ENTER_FUNCTION +/* subq $8, %rsp; CFI_ADJUST (8); */ + call LBL(caml_call_gc) +/* addq $8, %rsp; CFI_ADJUST (-8); */ + LEAVE_FUNCTION + jmp LBL(caml_alloc2) +CFI_ENDPROC FUNCTION(G(caml_alloc3)) -.Lcaml_alloc3: +CFI_STARTPROC +LBL(caml_alloc3): subq $32, %r15 CMP_VAR(caml_young_limit, %r15) - jb .L102 + jb LBL(102) ret -.L102: +LBL(102): RECORD_STACK_FRAME(0) - subq $8, %rsp - call .Lcaml_call_gc - addq $8, %rsp - jmp .Lcaml_alloc3 + ENTER_FUNCTION +/* subq $8, %rsp; CFI_ADJUST (8) */ + call LBL(caml_call_gc) +/* addq $8, %rsp; CFI_ADJUST (-8) */ + LEAVE_FUNCTION + jmp LBL(caml_alloc3) +CFI_ENDPROC FUNCTION(G(caml_allocN)) -.Lcaml_allocN: - pushq %rax /* save desired size */ +CFI_STARTPROC +LBL(caml_allocN): + pushq %rax; CFI_ADJUST(8) /* save desired size */ subq %rax, %r15 CMP_VAR(caml_young_limit, %r15) - jb .L103 - addq $8, %rsp /* drop desired size */ + jb LBL(103) + addq $8, %rsp; CFI_ADJUST (-8) /* drop desired size */ ret -.L103: +LBL(103): RECORD_STACK_FRAME(8) - call .Lcaml_call_gc - popq %rax /* recover desired size */ - jmp .Lcaml_allocN +#ifdef WITH_FRAME_POINTERS + /* Do we need 16-byte alignment here ? */ + ENTER_FUNCTION +#endif + call LBL(caml_call_gc) +#ifdef WITH_FRAME_POINTERS + LEAVE_FUNCTION +#endif + popq %rax; CFI_ADJUST(-8) /* recover desired size */ + jmp LBL(caml_allocN) +CFI_ENDPROC -/* Call a C function from Caml */ +/* Call a C function from OCaml */ FUNCTION(G(caml_c_call)) -.Lcaml_c_call: +CFI_STARTPROC +LBL(caml_c_call): /* Record lowest stack address and return address */ - popq %r12 + popq %r12; CFI_ADJUST(-8) STORE_VAR(%r12, caml_last_return_address) STORE_VAR(%rsp, caml_bottom_of_stack) + subq $8, %rsp; CFI_ADJUST(8) /* equivalent to pushq %r12 */ +#ifndef SYS_mingw64 + /* Touch the stack to trigger a recoverable segfault + if insufficient space remains */ + subq $32768, %rsp + movq %rax, 0(%rsp) + addq $32768, %rsp +#endif /* Make the exception handler and alloc ptr available to the C code */ - STORE_VAR(%r15, caml_young_ptr) - STORE_VAR(%r14, caml_exception_pointer) + STORE_VAR(%r15, caml_young_ptr) + STORE_VAR(%r14, caml_exception_pointer) /* Call the function (address in %rax) */ - call *%rax - /* Reload alloc ptr */ - LOAD_VAR(caml_young_ptr, %r15) - /* Return to caller */ - pushq %r12 - ret + /* No need to PREPARE_FOR_C_CALL since the caller already + reserved the stack space if needed (cf. amd64/proc.ml) */ + jmp *%rax +CFI_ENDPROC -/* Start the Caml program */ +/* Start the OCaml program */ FUNCTION(G(caml_start_program)) + CFI_STARTPROC /* Save callee-save registers */ - pushq %rbx - pushq %rbp - pushq %r12 - pushq %r13 - pushq %r14 - pushq %r15 - subq $8, %rsp /* stack 16-aligned */ + PUSH_CALLEE_SAVE_REGS /* Initial entry point is G(caml_program) */ leaq GCALL(caml_program)(%rip), %r12 /* Common code for caml_start_program and caml_callback* */ -.Lcaml_start_program: +LBL(caml_start_program): /* Build a callback link */ - subq $8, %rsp /* stack 16-aligned */ + subq $8, %rsp; CFI_ADJUST (8) /* stack 16-aligned */ PUSH_VAR(caml_gc_regs) PUSH_VAR(caml_last_return_address) PUSH_VAR(caml_bottom_of_stack) /* Setup alloc ptr and exception ptr */ - LOAD_VAR(caml_young_ptr, %r15) - LOAD_VAR(caml_exception_pointer, %r14) + LOAD_VAR(caml_young_ptr, %r15) + LOAD_VAR(caml_exception_pointer, %r14) /* Build an exception handler */ - lea .L108(%rip), %r13 - pushq %r13 - pushq %r14 + lea LBL(108)(%rip), %r13 + pushq %r13; CFI_ADJUST(8) + pushq %r14; CFI_ADJUST(8) + CFI_ADJUST(16) movq %rsp, %r14 - /* Call the Caml code */ + /* Call the OCaml code */ call *%r12 -.L107: +LBL(107): /* Pop the exception handler */ - popq %r14 - popq %r12 /* dummy register */ -.L109: + popq %r14; CFI_ADJUST(-8) + popq %r12; CFI_ADJUST(-8) /* dummy register */ + CFI_ADJUST(-16) +LBL(109): /* Update alloc ptr and exception ptr */ - STORE_VAR(%r15,caml_young_ptr) - STORE_VAR(%r14,caml_exception_pointer) + STORE_VAR(%r15,caml_young_ptr) + STORE_VAR(%r14,caml_exception_pointer) /* Pop the callback link, restoring the global variables */ - POP_VAR(caml_bottom_of_stack) + POP_VAR(caml_bottom_of_stack) POP_VAR(caml_last_return_address) POP_VAR(caml_gc_regs) - addq $8, %rsp + addq $8, %rsp; CFI_ADJUST (-8); /* Restore callee-save registers. */ - addq $8, %rsp - popq %r15 - popq %r14 - popq %r13 - popq %r12 - popq %rbp - popq %rbx + POP_CALLEE_SAVE_REGS /* Return to caller. */ ret -.L108: +LBL(108): /* Exception handler*/ /* Mark the bucket as an exception result and return it */ orq $2, %rax - jmp .L109 + jmp LBL(109) +CFI_ENDPROC + +/* Registers holding arguments of C functions. */ + +#ifdef SYS_mingw64 +#define C_ARG_1 %rcx +#define C_ARG_2 %rdx +#define C_ARG_3 %r8 +#define C_ARG_4 %r9 +#else +#define C_ARG_1 %rdi +#define C_ARG_2 %rsi +#define C_ARG_3 %rdx +#define C_ARG_4 %rcx +#endif -/* Raise an exception from Caml */ +/* Raise an exception from OCaml */ FUNCTION(G(caml_raise_exn)) +CFI_STARTPROC TESTL_VAR($1, caml_backtrace_active) - jne .L110 + jne LBL(110) movq %r14, %rsp popq %r14 ret -.L110: +LBL(110): movq %rax, %r12 /* Save exception bucket */ - movq %rax, %rdi /* arg 1: exception bucket */ - movq 0(%rsp), %rsi /* arg 2: pc of raise */ - leaq 8(%rsp), %rdx /* arg 3: sp of raise */ - movq %r14, %rcx /* arg 4: sp of handler */ + movq %rax, C_ARG_1 /* arg 1: exception bucket */ +#ifdef WITH_FRAME_POINTERS + ENTER_FUNCTION + movq 8(%rsp), C_ARG_2 /* arg 2: pc of raise */ + leaq 16(%rsp), C_ARG_3 /* arg 3: sp at raise */ +#else + popq C_ARG_2 /* arg 2: pc of raise */ + movq %rsp, C_ARG_3 /* arg 3: sp at raise */ +#endif + movq %r14, C_ARG_4 /* arg 4: sp of handler */ + /* PR#5700: thanks to popq above, stack is now 16-aligned */ + /* Thanks to ENTER_FUNCTION, stack is now 16-aligned */ + PREPARE_FOR_C_CALL /* no need to cleanup after */ call GCALL(caml_stash_backtrace) movq %r12, %rax /* Recover exception bucket */ movq %r14, %rsp popq %r14 ret +CFI_ENDPROC /* Raise an exception from C */ FUNCTION(G(caml_raise_exception)) +CFI_STARTPROC TESTL_VAR($1, caml_backtrace_active) - jne .L111 - movq %rdi, %rax + jne LBL(111) + movq C_ARG_1, %rax LOAD_VAR(caml_exception_pointer, %rsp) /* Cut stack */ - popq %r14 /* Recover previous exception handler */ + popq %r14 /* Recover previous exception handler */ LOAD_VAR(caml_young_ptr, %r15) /* Reload alloc ptr */ ret -.L111: - movq %rdi, %r12 /* Save exception bucket */ +LBL(111): +#ifdef WITH_FRAME_POINTERS + ENTER_FUNCTION ; +#endif + movq C_ARG_1, %r12 /* Save exception bucket */ /* arg 1: exception bucket */ - LOAD_VAR(caml_last_return_address,%rsi) /* arg 2: pc of raise */ - LOAD_VAR(caml_bottom_of_stack,%rdx) /* arg 3: sp of raise */ - LOAD_VAR(caml_exception_pointer,%rcx) /* arg 4: sp of handler */ + LOAD_VAR(caml_last_return_address,C_ARG_2) /* arg 2: pc of raise */ + LOAD_VAR(caml_bottom_of_stack,C_ARG_3) /* arg 3: sp of raise */ + LOAD_VAR(caml_exception_pointer,C_ARG_4) /* arg 4: sp of handler */ +#ifndef WITH_FRAME_POINTERS + subq $8, %rsp /* PR#5700: maintain stack alignment */ +#endif + PREPARE_FOR_C_CALL /* no need to cleanup after */ call GCALL(caml_stash_backtrace) movq %r12, %rax /* Recover exception bucket */ - LOAD_VAR(caml_exception_pointer,%rsp) + LOAD_VAR(caml_exception_pointer,%rsp) popq %r14 /* Recover previous exception handler */ - LOAD_VAR(caml_young_ptr,%r15) /* Reload alloc ptr */ + LOAD_VAR(caml_young_ptr,%r15) /* Reload alloc ptr */ ret +CFI_ENDPROC + +/* Raise a Stack_overflow exception on return from segv_handler() + (in asmrun/signals_asm.c). On entry, the stack is full, so we + cannot record a backtrace. + No CFI information here since this function disrupts the stack + backtrace anyway. */ + +FUNCTION(G(caml_stack_overflow)) + LEA_VAR(caml_bucket_Stack_overflow, %rax) + movq %r14, %rsp /* cut the stack */ + popq %r14 /* recover previous exn handler */ + ret /* jump to handler's code */ -/* Callback from C to Caml */ +/* Callback from C to OCaml */ FUNCTION(G(caml_callback_exn)) +CFI_STARTPROC /* Save callee-save registers */ - pushq %rbx - pushq %rbp - pushq %r12 - pushq %r13 - pushq %r14 - pushq %r15 - subq $8, %rsp /* stack 16-aligned */ + PUSH_CALLEE_SAVE_REGS /* Initial loading of arguments */ - movq %rdi, %rbx /* closure */ - movq %rsi, %rax /* argument */ - movq 0(%rbx), %r12 /* code pointer */ - jmp .Lcaml_start_program + movq C_ARG_1, %rbx /* closure */ + movq C_ARG_2, %rax /* argument */ + movq 0(%rbx), %r12 /* code pointer */ + jmp LBL(caml_start_program) +CFI_ENDPROC FUNCTION(G(caml_callback2_exn)) +CFI_STARTPROC /* Save callee-save registers */ - pushq %rbx - pushq %rbp - pushq %r12 - pushq %r13 - pushq %r14 - pushq %r15 - subq $8, %rsp /* stack 16-aligned */ + PUSH_CALLEE_SAVE_REGS /* Initial loading of arguments */ - /* closure stays in %rdi */ - movq %rsi, %rax /* first argument */ - movq %rdx, %rbx /* second argument */ + movq C_ARG_1, %rdi /* closure -- no op with Unix conventions */ + movq C_ARG_2, %rax /* first argument */ + movq C_ARG_3, %rbx /* second argument */ leaq GCALL(caml_apply2)(%rip), %r12 /* code pointer */ - jmp .Lcaml_start_program + jmp LBL(caml_start_program) +CFI_ENDPROC FUNCTION(G(caml_callback3_exn)) +CFI_STARTPROC /* Save callee-save registers */ - pushq %rbx - pushq %rbp - pushq %r12 - pushq %r13 - pushq %r14 - pushq %r15 - subq $8, %rsp /* stack 16-aligned */ + PUSH_CALLEE_SAVE_REGS /* Initial loading of arguments */ - movq %rsi, %rax /* first argument */ - movq %rdx, %rbx /* second argument */ - movq %rdi, %rsi /* closure */ - movq %rcx, %rdi /* third argument */ + movq C_ARG_2, %rax /* first argument */ + movq C_ARG_3, %rbx /* second argument */ + movq C_ARG_1, %rsi /* closure */ + movq C_ARG_4, %rdi /* third argument */ leaq GCALL(caml_apply3)(%rip), %r12 /* code pointer */ - jmp .Lcaml_start_program + jmp LBL(caml_start_program) +CFI_ENDPROC FUNCTION(G(caml_ml_array_bound_error)) +CFI_STARTPROC leaq GCALL(caml_array_bound_error)(%rip), %rax - jmp .Lcaml_c_call + jmp LBL(caml_c_call) +CFI_ENDPROC + + .globl G(caml_system__code_end) +G(caml_system__code_end): .data .globl G(caml_system__frametable) .align EIGHT_ALIGN G(caml_system__frametable): .quad 1 /* one descriptor */ - .quad .L107 /* return address into callback */ + .quad LBL(107) /* return address into callback */ .value -1 /* negative frame size => use callback link */ .value 0 /* no roots here */ .align EIGHT_ALIGN -#ifdef SYS_macosx - .literal16 +#if defined(SYS_macosx) + .literal16 +#elif defined(SYS_mingw64) + .section .rdata,"dr" #else - .section .rodata.cst8,"a",@progbits + .section .rodata.cst8,"a",@progbits #endif .globl G(caml_negf_mask) .align SIXTEEN_ALIGN G(caml_negf_mask): - .quad 0x8000000000000000, 0 + .quad 0x8000000000000000, 0 .globl G(caml_absf_mask) .align SIXTEEN_ALIGN G(caml_absf_mask): - .quad 0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF + .quad 0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF #if defined(SYS_linux) /* Mark stack as non-executable, PR#4564 */ diff -Nru ocaml-3.12.1/asmrun/amd64nt.asm ocaml-4.01.0/asmrun/amd64nt.asm --- ocaml-3.12.1/asmrun/amd64nt.asm 2010-11-27 17:19:24.000000000 +0000 +++ ocaml-4.01.0/asmrun/amd64nt.asm 2013-06-03 18:03:59.000000000 +0000 @@ -1,17 +1,15 @@ -;********************************************************************* -; -; Objective Caml -; -; Xavier Leroy, projet Gallium, INRIA Rocquencourt -; -; Copyright 2006 Institut National de Recherche en Informatique et -; en Automatique. All rights reserved. This file is distributed -; under the terms of the GNU Library General Public License, with -; the special exception on linking described in file ../LICENSE. -; -;********************************************************************* - -; $Id: amd64nt.asm 10862 2010-11-27 17:19:24Z xleroy $ +;*********************************************************************** +;* * +;* OCaml * +;* * +;* Xavier Leroy, projet Gallium, INRIA Rocquencourt * +;* * +;* Copyright 2006 Institut National de Recherche en Informatique et * +;* en Automatique. All rights reserved. This file is distributed * +;* under the terms of the GNU Library General Public License, with * +;* the special exception on linking described in file ../LICENSE. * +;* * +;*********************************************************************** ; Asm part of the runtime system, AMD64 processor, Intel syntax @@ -30,7 +28,7 @@ EXTRN caml_bottom_of_stack: QWORD EXTRN caml_last_return_address: QWORD EXTRN caml_gc_regs: QWORD - EXTRN caml_exception_pointer: QWORD + EXTRN caml_exception_pointer: QWORD EXTRN caml_backtrace_active: DWORD EXTRN caml_stash_backtrace: NEAR @@ -48,14 +46,14 @@ mov caml_bottom_of_stack, rax L105: ; Save caml_young_ptr, caml_exception_pointer - mov caml_young_ptr, r15 - mov caml_exception_pointer, r14 + mov caml_young_ptr, r15 + mov caml_exception_pointer, r14 ; Build array of registers, save it into caml_gc_regs - push r13 - push r12 push rbp push r11 push r10 + push r13 + push r12 push r9 push r8 push rcx @@ -113,14 +111,14 @@ pop rcx pop r8 pop r9 + pop r12 + pop r13 pop r10 pop r11 pop rbp - pop r12 - pop r13 ; Restore caml_young_ptr, caml_exception_pointer - mov r15, caml_young_ptr - mov r14, caml_exception_pointer + mov r15, caml_young_ptr + mov r14, caml_exception_pointer ; Return to caller ret @@ -136,9 +134,9 @@ mov caml_last_return_address, rax lea rax, [rsp + 8] mov caml_bottom_of_stack, rax - sub rsp, 8 + sub rsp, 8 call L105 - add rsp, 8 + add rsp, 8 jmp caml_alloc1 PUBLIC caml_alloc2 @@ -153,9 +151,9 @@ mov caml_last_return_address, rax lea rax, [rsp + 8] mov caml_bottom_of_stack, rax - sub rsp, 8 + sub rsp, 8 call L105 - add rsp, 8 + add rsp, 8 jmp caml_alloc2 PUBLIC caml_alloc3 @@ -170,9 +168,9 @@ mov caml_last_return_address, rax lea rax, [rsp + 8] mov caml_bottom_of_stack, rax - sub rsp, 8 + sub rsp, 8 call L105 - add rsp, 8 + add rsp, 8 jmp caml_alloc3 PUBLIC caml_allocN @@ -192,7 +190,7 @@ pop rax ; recover desired size jmp caml_allocN -; Call a C function from Caml +; Call a C function from OCaml PUBLIC caml_c_call ALIGN 16 @@ -202,17 +200,17 @@ mov caml_last_return_address, r12 mov caml_bottom_of_stack, rsp ; Make the exception handler and alloc ptr available to the C code - mov caml_young_ptr, r15 - mov caml_exception_pointer, r14 + mov caml_young_ptr, r15 + mov caml_exception_pointer, r14 ; Call the function (address in rax) call rax ; Reload alloc ptr - mov r15, caml_young_ptr + mov r15, caml_young_ptr ; Return to caller - push r12 - ret + push r12 + ret -; Start the Caml program +; Start the OCaml program PUBLIC caml_start_program ALIGN 16 @@ -242,19 +240,19 @@ ; Common code for caml_start_program and caml_callback* L106: ; Build a callback link - sub rsp, 8 ; stack 16-aligned + sub rsp, 8 ; stack 16-aligned push caml_gc_regs push caml_last_return_address push caml_bottom_of_stack ; Setup alloc ptr and exception ptr - mov r15, caml_young_ptr - mov r14, caml_exception_pointer + mov r15, caml_young_ptr + mov r14, caml_exception_pointer ; Build an exception handler lea r13, L108 push r13 push r14 mov r14, rsp - ; Call the Caml code + ; Call the OCaml code call r12 L107: ; Pop the exception handler @@ -262,13 +260,13 @@ pop r12 ; dummy register L109: ; Update alloc ptr and exception ptr - mov caml_young_ptr, r15 - mov caml_exception_pointer, r14 + mov caml_young_ptr, r15 + mov caml_exception_pointer, r14 ; Pop the callback restoring, link the global variables pop caml_bottom_of_stack pop caml_last_return_address pop caml_gc_regs - add rsp, 8 + add rsp, 8 ; Restore callee-save registers. movapd xmm6, OWORD PTR [rsp + 0*16] movapd xmm7, OWORD PTR [rsp + 1*16] @@ -297,7 +295,7 @@ or rax, 2 jmp L109 -; Raise an exception from Caml +; Raise an exception from OCaml PUBLIC caml_raise_exn ALIGN 16 @@ -346,7 +344,7 @@ mov r15, caml_young_ptr ; Reload alloc ptr ret -; Callback from C to Caml +; Callback from C to OCaml PUBLIC caml_callback_exn ALIGN 16 @@ -441,8 +439,8 @@ PUBLIC caml_ml_array_bound_error ALIGN 16 caml_ml_array_bound_error: - lea rax, caml_array_bound_error - jmp caml_c_call + lea rax, caml_array_bound_error + jmp caml_c_call .DATA PUBLIC caml_system__frametable @@ -456,11 +454,11 @@ PUBLIC caml_negf_mask ALIGN 16 caml_negf_mask LABEL QWORD - QWORD 8000000000000000H, 0 + QWORD 8000000000000000H, 0 PUBLIC caml_absf_mask ALIGN 16 caml_absf_mask LABEL QWORD - QWORD 7FFFFFFFFFFFFFFFH, 0FFFFFFFFFFFFFFFFH + QWORD 7FFFFFFFFFFFFFFFH, 0FFFFFFFFFFFFFFFFH END diff -Nru ocaml-3.12.1/asmrun/arm.S ocaml-4.01.0/asmrun/arm.S --- ocaml-3.12.1/asmrun/arm.S 2009-05-04 13:46:46.000000000 +0000 +++ ocaml-4.01.0/asmrun/arm.S 2013-01-13 17:20:36.000000000 +0000 @@ -1,275 +1,452 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* Benedikt Meurer, University of Siegen */ /* */ -/* Copyright 1998 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../LICENSE. */ +/* Copyright 1998 Institut National de Recherche en Informatique */ +/* et en Automatique. Copyright 2012 Benedikt Meurer. All rights */ +/* reserved. This file is distributed under the terms of the GNU */ +/* Library General Public License, with the special exception on */ +/* linking described in file ../LICENSE. */ /* */ /***********************************************************************/ -/* $Id: arm.S 9252 2009-05-04 13:46:46Z xleroy $ */ - /* Asm part of the runtime system, ARM processor */ +/* Must be preprocessed by cpp */ -trap_ptr .req r11 -alloc_ptr .req r8 -alloc_limit .req r10 - + .syntax unified .text +#if defined(SYS_linux_eabihf) && defined(MODEL_armv6) + .arch armv6 + .fpu vfpv2 + .arm + + /* Compatibility macros */ + .macro cbz reg, lbl + cmp \reg, #0 + beq \lbl + .endm +#elif defined(SYS_linux_eabihf) + .arch armv7-a + .fpu vfpv3-d16 + .thumb +#elif defined(SYS_linux_eabi) + .arch armv4t + .arm + + /* Compatibility macros */ + .macro blx reg + mov lr, pc + bx \reg + .endm + .macro cbz reg, lbl + cmp \reg, #0 + beq \lbl + .endm +#endif + +trap_ptr .req r8 +alloc_ptr .req r10 +alloc_limit .req r11 + +/* Support for CFI directives */ + +#if defined(ASM_CFI_SUPPORTED) +#define CFI_STARTPROC .cfi_startproc +#define CFI_ENDPROC .cfi_endproc +#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n +#else +#define CFI_STARTPROC +#define CFI_ENDPROC +#define CFI_ADJUST(n) +#endif + +/* Support for profiling with gprof */ + +#if defined(PROFILING) && (defined(SYS_linux_eabihf) || defined(SYS_linux_eabi)) +#define PROFILE \ + push {lr}; CFI_ADJUST(4); \ + bl __gnu_mcount_nc; CFI_ADJUST(-4) +#else +#define PROFILE +#endif /* Allocation functions and GC interface */ - .globl caml_call_gc + .globl caml_system__code_begin +caml_system__code_begin: + + .align 2 + .globl caml_call_gc caml_call_gc: - /* Record return address and desired size */ - /* Can use alloc_limit as a temporary since it will be reloaded by - invoke_gc */ - ldr alloc_limit, .Lcaml_last_return_address - str lr, [alloc_limit, #0] - ldr alloc_limit, .Lcaml_requested_size - str r12, [alloc_limit, #0] - /* Branch to shared GC code */ - bl .Linvoke_gc - /* Finish allocation */ - ldr r12, .Lcaml_requested_size - ldr r12, [r12, #0] - sub alloc_ptr, alloc_ptr, r12 + CFI_STARTPROC + PROFILE + /* Record return address */ + ldr r12, =caml_last_return_address + str lr, [r12] +.Lcaml_call_gc: + /* Record lowest stack address */ + ldr r12, =caml_bottom_of_stack + str sp, [r12] +#if defined(SYS_linux_eabihf) + /* Save caller floating-point registers on the stack */ + vpush {d0-d7}; CFI_ADJUST(64) +#endif + /* Save integer registers and return address on the stack */ + push {r0-r7,r12,lr}; CFI_ADJUST(40) + /* Store pointer to saved integer registers in caml_gc_regs */ + ldr r12, =caml_gc_regs + str sp, [r12] + /* Save current allocation pointer for debugging purposes */ + ldr alloc_limit, =caml_young_ptr + str alloc_ptr, [alloc_limit] + /* Save trap pointer in case an exception is raised during GC */ + ldr r12, =caml_exception_pointer + str trap_ptr, [r12] + /* Call the garbage collector */ + bl caml_garbage_collection + /* Restore integer registers and return address from the stack */ + pop {r0-r7,r12,lr}; CFI_ADJUST(-40) +#if defined(SYS_linux_eabihf) + /* Restore floating-point registers from the stack */ + vpop {d0-d7}; CFI_ADJUST(-64) +#endif + /* Reload new allocation pointer and limit */ + /* alloc_limit still points to caml_young_ptr */ + ldr r12, =caml_young_limit + ldr alloc_ptr, [alloc_limit] + ldr alloc_limit, [r12] + /* Return to caller */ bx lr + CFI_ENDPROC + .type caml_call_gc, %function + .size caml_call_gc, .-caml_call_gc - .globl caml_alloc1 + .align 2 + .globl caml_alloc1 caml_alloc1: - sub alloc_ptr, alloc_ptr, #8 + CFI_STARTPROC + PROFILE +.Lcaml_alloc1: + sub alloc_ptr, alloc_ptr, 8 cmp alloc_ptr, alloc_limit - movcs pc, lr /* Return if alloc_ptr >= alloc_limit */ - /* Record return address */ - ldr r12, .Lcaml_last_return_address - str lr, [r12, #0] - /* Invoke GC */ - bl .Linvoke_gc + bcc 1f + bx lr +1: /* Record return address */ + ldr r7, =caml_last_return_address + str lr, [r7] + /* Call GC (preserves r7) */ + bl .Lcaml_call_gc + /* Restore return address */ + ldr lr, [r7] /* Try again */ - b caml_alloc1 + b .Lcaml_alloc1 + CFI_ENDPROC + .type caml_alloc1, %function + .size caml_alloc1, .-caml_alloc1 - .globl caml_alloc2 + .align 2 + .globl caml_alloc2 caml_alloc2: - sub alloc_ptr, alloc_ptr, #12 + CFI_STARTPROC + PROFILE +.Lcaml_alloc2: + sub alloc_ptr, alloc_ptr, 12 cmp alloc_ptr, alloc_limit - movcs pc, lr /* Return if alloc_ptr >= alloc_limit */ - /* Record return address */ - ldr r12, .Lcaml_last_return_address - str lr, [r12, #0] - /* Invoke GC */ - bl .Linvoke_gc + bcc 1f + bx lr +1: /* Record return address */ + ldr r7, =caml_last_return_address + str lr, [r7] + /* Call GC (preserves r7) */ + bl .Lcaml_call_gc + /* Restore return address */ + ldr lr, [r7] /* Try again */ - b caml_alloc2 + b .Lcaml_alloc2 + CFI_ENDPROC + .type caml_alloc2, %function + .size caml_alloc2, .-caml_alloc2 - .globl caml_alloc3 + .align 2 + .globl caml_alloc3 + .type caml_alloc3, %function caml_alloc3: - sub alloc_ptr, alloc_ptr, #16 + CFI_STARTPROC + PROFILE +.Lcaml_alloc3: + sub alloc_ptr, alloc_ptr, 16 cmp alloc_ptr, alloc_limit - movcs pc, lr /* Return if alloc_ptr >= alloc_limit */ - /* Record return address */ - ldr r12, .Lcaml_last_return_address - str lr, [r12, #0] - /* Invoke GC */ - bl .Linvoke_gc + bcc 1f + bx lr +1: /* Record return address */ + ldr r7, =caml_last_return_address + str lr, [r7] + /* Call GC (preserves r7) */ + bl .Lcaml_call_gc + /* Restore return address */ + ldr lr, [r7] /* Try again */ - b caml_alloc3 + b .Lcaml_alloc3 + CFI_ENDPROC + .type caml_alloc3, %function + .size caml_alloc3, .-caml_alloc3 - .globl caml_allocN + .align 2 + .globl caml_allocN caml_allocN: - sub alloc_ptr, alloc_ptr, r12 + CFI_STARTPROC + PROFILE +.Lcaml_allocN: + sub alloc_ptr, alloc_ptr, r7 cmp alloc_ptr, alloc_limit - movcs pc, lr /* Return if alloc_ptr >= alloc_limit */ - /* Record return address and desired size */ - /* Can use alloc_limit as a temporary since it will be reloaded by - invoke_gc */ - ldr alloc_limit, .Lcaml_last_return_address - str lr, [alloc_limit, #0] - ldr alloc_limit, .Lcaml_requested_size - str r12, [alloc_limit, #0] - /* Invoke GC */ - bl .Linvoke_gc + bcc 1f + bx lr +1: /* Record return address */ + ldr r12, =caml_last_return_address + str lr, [r12] + /* Call GC (preserves r7) */ + bl .Lcaml_call_gc + /* Restore return address */ + ldr r12, =caml_last_return_address + ldr lr, [r12] /* Try again */ - ldr r12, .Lcaml_requested_size - ldr r12, [r12, #0] - b caml_allocN - -/* Shared code to invoke the GC */ -.Linvoke_gc: - /* Record lowest stack address */ - ldr r12, .Lcaml_bottom_of_stack - str sp, [r12, #0] - /* Save integer registers and return address on stack */ - stmfd sp!, {r0,r1,r2,r3,r4,r5,r6,r7,r12,lr} - /* Store pointer to saved integer registers in caml_gc_regs */ - ldr r12, .Lcaml_gc_regs - str sp, [r12, #0] - /* Save current allocation pointer for debugging purposes */ - ldr r12, .Lcaml_young_ptr - str alloc_ptr, [r12, #0] - /* Save trap pointer in case an exception is raised during GC */ - ldr r12, .Lcaml_exception_pointer - str trap_ptr, [r12, #0] - /* Call the garbage collector */ - bl caml_garbage_collection - /* Restore the registers from the stack */ - ldmfd sp!, {r0,r1,r2,r3,r4,r5,r6,r7,r12} - /* Reload return address */ - ldr r12, .Lcaml_last_return_address - ldr lr, [r12, #0] - /* Reload new allocation pointer and allocation limit */ - ldr r12, .Lcaml_young_ptr - ldr alloc_ptr, [r12, #0] - ldr r12, .Lcaml_young_limit - ldr alloc_limit, [r12, #0] - /* Return to caller */ - ldr r12, [sp], #4 - bx r12 + b .Lcaml_allocN + CFI_ENDPROC + .type caml_allocN, %function + .size caml_allocN, .-caml_allocN -/* Call a C function from Caml */ -/* Function to call is in r12 */ +/* Call a C function from OCaml */ +/* Function to call is in r7 */ - .globl caml_c_call + .align 2 + .globl caml_c_call caml_c_call: + CFI_STARTPROC + PROFILE + /* Record lowest stack address and return address */ + ldr r5, =caml_last_return_address + ldr r6, =caml_bottom_of_stack + str lr, [r5] + str sp, [r6] /* Preserve return address in callee-save register r4 */ mov r4, lr - /* Record lowest stack address and return address */ - ldr r5, .Lcaml_last_return_address - ldr r6, .Lcaml_bottom_of_stack - str lr, [r5, #0] - str sp, [r6, #0] - /* Make the exception handler and alloc ptr available to the C code */ - ldr r6, .Lcaml_young_ptr - ldr r7, .Lcaml_exception_pointer - str alloc_ptr, [r6, #0] - str trap_ptr, [r7, #0] + /* Make the exception handler alloc ptr available to the C code */ + ldr r5, =caml_young_ptr + ldr r6, =caml_exception_pointer + str alloc_ptr, [r5] + str trap_ptr, [r6] /* Call the function */ - mov lr, pc - bx r12 + blx r7 /* Reload alloc ptr and alloc limit */ - ldr r5, .Lcaml_young_limit - ldr alloc_ptr, [r6, #0] /* r6 still points to caml_young_ptr */ - ldr alloc_limit, [r5, #0] + ldr r6, =caml_young_limit + ldr alloc_ptr, [r5] /* r5 still points to caml_young_ptr */ + ldr alloc_limit, [r6] /* Return */ bx r4 + CFI_ENDPROC + .type caml_c_call, %function + .size caml_c_call, .-caml_c_call -/* Start the Caml program */ +/* Start the OCaml program */ - .globl caml_start_program + .align 2 + .globl caml_start_program caml_start_program: - ldr r12, .Lcaml_program + CFI_STARTPROC + PROFILE + ldr r12, =caml_program /* Code shared with caml_callback* */ -/* Address of Caml code to call is in r12 */ -/* Arguments to the Caml code are in r0...r3 */ +/* Address of OCaml code to call is in r12 */ +/* Arguments to the OCaml code are in r0...r3 */ .Ljump_to_caml: +#if defined(SYS_linux_eabihf) + /* Save callee-save floating-point registers */ + vpush {d8-d15}; CFI_ADJUST(64) +#endif /* Save return address and callee-save registers */ - stmfd sp!, {r4,r5,r6,r7,r8,r10,r11,lr} /* 8-alignment */ + push {r4-r8,r10,r11,lr}; CFI_ADJUST(32) /* 8-byte alignment */ /* Setup a callback link on the stack */ - sub sp, sp, #4*4 /* 8-alignment */ - ldr r4, .Lcaml_bottom_of_stack - ldr r4, [r4, #0] - str r4, [sp, #0] - ldr r4, .Lcaml_last_return_address - ldr r4, [r4, #0] - str r4, [sp, #4] - ldr r4, .Lcaml_gc_regs - ldr r4, [r4, #0] - str r4, [sp, #8] - /* Setup a trap frame to catch exceptions escaping the Caml code */ - sub sp, sp, #4*2 - ldr r4, .Lcaml_exception_pointer - ldr r4, [r4, #0] - str r4, [sp, #0] - ldr r4, .LLtrap_handler - str r4, [sp, #4] + sub sp, sp, 16; CFI_ADJUST(16) /* 8-byte alignment */ + ldr r4, =caml_bottom_of_stack + ldr r5, =caml_last_return_address + ldr r6, =caml_gc_regs + ldr r4, [r4] + ldr r5, [r5] + ldr r6, [r6] + str r4, [sp, 0] + str r5, [sp, 4] + str r6, [sp, 8] + /* Setup a trap frame to catch exceptions escaping the OCaml code */ + sub sp, sp, 8; CFI_ADJUST(8) + ldr r6, =caml_exception_pointer + ldr r5, =.Ltrap_handler + ldr r4, [r6] + str r4, [sp, 0] + str r5, [sp, 4] mov trap_ptr, sp /* Reload allocation pointers */ - ldr r4, .Lcaml_young_ptr - ldr alloc_ptr, [r4, #0] - ldr r4, .Lcaml_young_limit - ldr alloc_limit, [r4, #0] - /* Call the Caml code */ - mov lr, pc - bx r12 + ldr r4, =caml_young_ptr + ldr alloc_ptr, [r4] + ldr r4, =caml_young_limit + ldr alloc_limit, [r4] + /* Call the OCaml code */ + blx r12 .Lcaml_retaddr: /* Pop the trap frame, restoring caml_exception_pointer */ - ldr r4, .Lcaml_exception_pointer - ldr r5, [sp, #0] - str r5, [r4, #0] - add sp, sp, #2 * 4 + ldr r4, =caml_exception_pointer + ldr r5, [sp, 0] + str r5, [r4] + add sp, sp, 8; CFI_ADJUST(-8) /* Pop the callback link, restoring the global variables */ .Lreturn_result: - ldr r4, .Lcaml_bottom_of_stack - ldr r5, [sp, #0] - str r5, [r4, #0] - ldr r4, .Lcaml_last_return_address - ldr r5, [sp, #4] - str r5, [r4, #0] - ldr r4, .Lcaml_gc_regs - ldr r5, [sp, #8] - str r5, [r4, #0] - add sp, sp, #4*4 + ldr r4, =caml_bottom_of_stack + ldr r5, [sp, 0] + str r5, [r4] + ldr r4, =caml_last_return_address + ldr r5, [sp, 4] + str r5, [r4] + ldr r4, =caml_gc_regs + ldr r5, [sp, 8] + str r5, [r4] + add sp, sp, 16; CFI_ADJUST(-16) /* Update allocation pointer */ - ldr r4, .Lcaml_young_ptr - str alloc_ptr, [r4, #0] - /* Reload callee-save registers and return */ - ldmfd sp!, {r4,r5,r6,r7,r8,r10,r11,lr} - bx lr + ldr r4, =caml_young_ptr + str alloc_ptr, [r4] + /* Reload callee-save registers and return address */ + pop {r4-r8,r10,r11,lr}; CFI_ADJUST(-32) +#if defined(SYS_linux_eabihf) + /* Reload callee-save floating-point registers */ + vpop {d8-d15}; CFI_ADJUST(-64) +#endif + bx lr + CFI_ENDPROC + .type .Lcaml_retaddr, %function + .size .Lcaml_retaddr, .-.Lcaml_retaddr + .type caml_start_program, %function + .size caml_start_program, .-caml_start_program + +/* The trap handler */ - /* The trap handler */ + .align 2 .Ltrap_handler: + CFI_STARTPROC /* Save exception pointer */ - ldr r4, .Lcaml_exception_pointer - str trap_ptr, [r4, #0] + ldr r12, =caml_exception_pointer + str trap_ptr, [r12] /* Encode exception bucket as an exception result */ - orr r0, r0, #2 + orr r0, r0, 2 /* Return it */ b .Lreturn_result + CFI_ENDPROC + .type .Ltrap_handler, %function + .size .Ltrap_handler, .-.Ltrap_handler + +/* Raise an exception from OCaml */ + + .align 2 + .globl caml_raise_exn +caml_raise_exn: + CFI_STARTPROC + PROFILE + /* Test if backtrace is active */ + ldr r1, =caml_backtrace_active + ldr r1, [r1] + cbz r1, 1f + /* Preserve exception bucket in callee-save register r4 */ + mov r4, r0 + /* Stash the backtrace */ + mov r1, lr /* arg2: pc of raise */ + mov r2, sp /* arg3: sp of raise */ + mov r3, trap_ptr /* arg4: sp of handler */ + bl caml_stash_backtrace + /* Restore exception bucket */ + mov r0, r4 +1: /* Cut stack at current trap handler */ + mov sp, trap_ptr + /* Pop previous handler and addr of trap, and jump to it */ + pop {trap_ptr, pc} + CFI_ENDPROC + .type caml_raise_exn, %function + .size caml_raise_exn, .-caml_raise_exn /* Raise an exception from C */ - .globl caml_raise_exception + .align 2 + .globl caml_raise_exception caml_raise_exception: - /* Reload Caml allocation pointers */ - ldr r12, .Lcaml_young_ptr - ldr alloc_ptr, [r12, #0] - ldr r12, .Lcaml_young_limit - ldr alloc_limit, [r12, #0] - /* Cut stack at current trap handler */ - ldr r12, .Lcaml_exception_pointer - ldr sp, [r12, #0] + CFI_STARTPROC + PROFILE + /* Reload trap ptr, alloc ptr and alloc limit */ + ldr trap_ptr, =caml_exception_pointer + ldr alloc_ptr, =caml_young_ptr + ldr alloc_limit, =caml_young_limit + ldr trap_ptr, [trap_ptr] + ldr alloc_ptr, [alloc_ptr] + ldr alloc_limit, [alloc_limit] + /* Test if backtrace is active */ + ldr r1, =caml_backtrace_active + ldr r1, [r1] + cbz r1, 1f + /* Preserve exception bucket in callee-save register r4 */ + mov r4, r0 + ldr r1, =caml_last_return_address /* arg2: pc of raise */ + ldr r1, [r1] + ldr r2, =caml_bottom_of_stack /* arg3: sp of raise */ + ldr r2, [r2] + mov r3, trap_ptr /* arg4: sp of handler */ + bl caml_stash_backtrace + /* Restore exception bucket */ + mov r0, r4 +1: /* Cut stack at current trap handler */ + mov sp, trap_ptr /* Pop previous handler and addr of trap, and jump to it */ - ldmfd sp!, {trap_ptr, pc} + pop {trap_ptr, pc} + CFI_ENDPROC + .type caml_raise_exception, %function + .size caml_raise_exception, .-caml_raise_exception -/* Callback from C to Caml */ +/* Callback from C to OCaml */ - .globl caml_callback_exn + .align 2 + .globl caml_callback_exn caml_callback_exn: + CFI_STARTPROC + PROFILE /* Initial shuffling of arguments (r0 = closure, r1 = first arg) */ mov r12, r0 - mov r0, r1 /* r0 = first arg */ - mov r1, r12 /* r1 = closure environment */ - ldr r12, [r12, #0] /* code pointer */ + mov r0, r1 /* r0 = first arg */ + mov r1, r12 /* r1 = closure environment */ + ldr r12, [r12] /* code pointer */ b .Ljump_to_caml + CFI_ENDPROC + .type caml_callback_exn, %function + .size caml_callback_exn, .-caml_callback_exn - .globl caml_callback2_exn + .align 2 + .globl caml_callback2_exn caml_callback2_exn: + CFI_STARTPROC + PROFILE /* Initial shuffling of arguments (r0 = closure, r1 = arg1, r2 = arg2) */ mov r12, r0 - mov r0, r1 /* r0 = first arg */ - mov r1, r2 /* r1 = second arg */ - mov r2, r12 /* r2 = closure environment */ - ldr r12, .Lcaml_apply2 + mov r0, r1 /* r0 = first arg */ + mov r1, r2 /* r1 = second arg */ + mov r2, r12 /* r2 = closure environment */ + ldr r12, =caml_apply2 b .Ljump_to_caml + CFI_ENDPROC + .type caml_callback2_exn, %function + .size caml_callback2_exn, .-caml_callback2_exn - .globl caml_callback3_exn + .align 2 + .globl caml_callback3_exn caml_callback3_exn: + CFI_STARTPROC + PROFILE /* Initial shuffling of arguments */ /* (r0 = closure, r1 = arg1, r2 = arg2, r3 = arg3) */ mov r12, r0 @@ -277,42 +454,38 @@ mov r1, r2 /* r1 = second arg */ mov r2, r3 /* r2 = third arg */ mov r3, r12 /* r3 = closure environment */ - ldr r12, .Lcaml_apply3 + ldr r12, =caml_apply3 b .Ljump_to_caml + CFI_ENDPROC + .type caml_callback3_exn, %function + .size caml_callback3_exn, .-caml_callback3_exn - .globl caml_ml_array_bound_error + .align 2 + .globl caml_ml_array_bound_error caml_ml_array_bound_error: - /* Load address of [caml_array_bound_error] in r12 */ - ldr r12, .Lcaml_array_bound_error + CFI_STARTPROC + PROFILE + /* Load address of [caml_array_bound_error] in r7 */ + ldr r7, =caml_array_bound_error /* Call that function */ b caml_c_call + CFI_ENDPROC + .type caml_ml_array_bound_error, %function + .size caml_ml_array_bound_error, .-caml_ml_array_bound_error -/* Global references */ - -.Lcaml_last_return_address: .word caml_last_return_address -.Lcaml_bottom_of_stack: .word caml_bottom_of_stack -.Lcaml_gc_regs: .word caml_gc_regs -.Lcaml_young_ptr: .word caml_young_ptr -.Lcaml_young_limit: .word caml_young_limit -.Lcaml_exception_pointer: .word caml_exception_pointer -.Lcaml_program: .word caml_program -.LLtrap_handler: .word .Ltrap_handler -.Lcaml_apply2: .word caml_apply2 -.Lcaml_apply3: .word caml_apply3 -.Lcaml_array_bound_error: .word caml_array_bound_error -.Lcaml_requested_size: .word caml_requested_size - - .data -caml_requested_size: - .word 0 + .globl caml_system__code_end +caml_system__code_end: /* GC roots for callback */ .data - .globl caml_system__frametable + .align 2 + .globl caml_system__frametable caml_system__frametable: .word 1 /* one descriptor */ .word .Lcaml_retaddr /* return address into callback */ .short -1 /* negative frame size => use callback link */ .short 0 /* no roots */ .align 2 + .type caml_system__frametable, %object + .size caml_system__frametable, .-caml_system__frametable diff -Nru ocaml-3.12.1/asmrun/backtrace.c ocaml-4.01.0/asmrun/backtrace.c --- ocaml-3.12.1/asmrun/backtrace.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmrun/backtrace.c 2013-07-23 14:48:47.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Gallium, INRIA Rocquencourt */ /* */ @@ -11,11 +11,12 @@ /* */ /***********************************************************************/ -/* $Id: backtrace.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* Stack backtrace for uncaught exceptions */ #include +#include +#include + #include "alloc.h" #include "backtrace.h" #include "memory.h" @@ -54,56 +55,75 @@ return Val_bool(caml_backtrace_active); } -/* Store the return addresses contained in the given stack fragment - into the backtrace array */ +/* returns the next frame descriptor (or NULL if none is available), + and updates *pc and *sp to point to the following one. */ -void caml_stash_backtrace(value exn, uintnat pc, char * sp, char * trapsp) +frame_descr * caml_next_frame_descriptor(uintnat * pc, char ** sp) { frame_descr * d; uintnat h; - if (exn != caml_backtrace_last_exn) { - caml_backtrace_pos = 0; - caml_backtrace_last_exn = exn; - } - if (caml_backtrace_buffer == NULL) { - caml_backtrace_buffer = malloc(BACKTRACE_BUFFER_SIZE * sizeof(code_t)); - if (caml_backtrace_buffer == NULL) return; - } if (caml_frame_descriptors == NULL) caml_init_frame_descriptors(); while (1) { - /* Find the descriptor corresponding to the return address */ - h = Hash_retaddr(pc); - while(1) { + h = Hash_retaddr(*pc); + while (1) { d = caml_frame_descriptors[h]; - if (d == 0) return; /* can happen if some code not compiled with -g */ - if (d->retaddr == pc) break; + if (d == 0) return NULL; /* can happen if some code compiled without -g */ + if (d->retaddr == *pc) break; h = (h+1) & caml_frame_descriptors_mask; } /* Skip to next frame */ if (d->frame_size != 0xFFFF) { - /* Regular frame, store its descriptor in the backtrace buffer */ - if (caml_backtrace_pos >= BACKTRACE_BUFFER_SIZE) return; - caml_backtrace_buffer[caml_backtrace_pos++] = (code_t) d; + /* Regular frame, update sp/pc and return the frame descriptor */ #ifndef Stack_grows_upwards - sp += (d->frame_size & 0xFFFC); + *sp += (d->frame_size & 0xFFFC); #else - sp -= (d->frame_size & 0xFFFC); + *sp -= (d->frame_size & 0xFFFC); #endif - pc = Saved_return_address(sp); + *pc = Saved_return_address(*sp); #ifdef Mask_already_scanned - pc = Mask_already_scanned(pc); + *pc = Mask_already_scanned(*pc); #endif + return d; } else { /* Special frame marking the top of a stack chunk for an ML callback. Skip C portion of stack and continue with next ML stack chunk. */ - struct caml_context * next_context = Callback_link(sp); - sp = next_context->bottom_of_stack; - pc = next_context->last_retaddr; + struct caml_context * next_context = Callback_link(*sp); + *sp = next_context->bottom_of_stack; + *pc = next_context->last_retaddr; /* A null sp means no more ML stack chunks; stop here. */ - if (sp == NULL) return; + if (*sp == NULL) return NULL; } + } +} + +/* Stores the return addresses contained in the given stack fragment + into the backtrace array ; this version is performance-sensitive as + it is called at each [raise] in a program compiled with [-g], so we + preserved the global, statically bounded buffer of the old + implementation -- before the more flexible + [caml_get_current_callstack] was implemented. */ + +void caml_stash_backtrace(value exn, uintnat pc, char * sp, char * trapsp) +{ + if (exn != caml_backtrace_last_exn) { + caml_backtrace_pos = 0; + caml_backtrace_last_exn = exn; + } + if (caml_backtrace_buffer == NULL) { + caml_backtrace_buffer = malloc(BACKTRACE_BUFFER_SIZE * sizeof(code_t)); + if (caml_backtrace_buffer == NULL) return; + } + + /* iterate on each frame */ + while (1) { + frame_descr * descr = caml_next_frame_descriptor(&pc, &sp); + if (descr == NULL) return; + /* store its descriptor in the backtrace buffer */ + if (caml_backtrace_pos >= BACKTRACE_BUFFER_SIZE) return; + caml_backtrace_buffer[caml_backtrace_pos++] = (code_t) descr; + /* Stop when we reach the current exception handler */ #ifndef Stack_grows_upwards if (sp > trapsp) return; @@ -113,6 +133,67 @@ } } +/* Stores upto [max_frames_value] frames of the current call stack to + return to the user. This is used not in an exception-raising + context, but only when the user requests to save the trace + (hopefully less often). Instead of using a bounded buffer as + [caml_stash_backtrace], we first traverse the stack to compute the + right size, then allocate space for the trace. */ + +CAMLprim value caml_get_current_callstack(value max_frames_value) { + CAMLparam1(max_frames_value); + CAMLlocal1(trace); + + /* we use `intnat` here because, were it only `int`, passing `max_int` + from the OCaml side would overflow on 64bits machines. */ + intnat max_frames = Long_val(max_frames_value); + intnat trace_size; + + /* first compute the size of the trace */ + { + uintnat pc = caml_last_return_address; + /* note that [caml_bottom_of_stack] always points to the most recent + * frame, independently of the [Stack_grows_upwards] setting */ + char * sp = caml_bottom_of_stack; + char * limitsp = caml_top_of_stack; + + trace_size = 0; + while (1) { + frame_descr * descr = caml_next_frame_descriptor(&pc, &sp); + if (descr == NULL) break; + if (trace_size >= max_frames) break; + ++trace_size; + +#ifndef Stack_grows_upwards + if (sp > limitsp) break; +#else + if (sp < limitsp) break; +#endif + } + } + + trace = caml_alloc((mlsize_t) trace_size, Abstract_tag); + + /* then collect the trace */ + { + uintnat pc = caml_last_return_address; + char * sp = caml_bottom_of_stack; + intnat trace_pos; + + for (trace_pos = 0; trace_pos < trace_size; trace_pos++) { + frame_descr * descr = caml_next_frame_descriptor(&pc, &sp); + Assert(descr != NULL); + /* The assignment below is safe without [caml_initialize], even + if the trace is large and allocated on the old heap, because + we assign values that are outside the OCaml heap. */ + Assert(!(Is_block((value) descr) && Is_in_heap((value) descr))); + Field(trace, trace_pos) = (value) descr; + } + } + + CAMLreturn(trace); +} + /* Extract location information for the given frame descriptor */ struct loc_info { @@ -162,22 +243,41 @@ li->loc_endchr = ((info2 & 0xF) << 6) | (info1 >> 26); } +/* Print location information -- same behavior as in Printexc + + note that the test for compiler-inserted raises is slightly redundant: + (!li->loc_valid && li->loc_is_raise) + extract_location_info above guarantees that when li->loc_valid is + 0, then li->loc_is_raise is always 1, so the latter test is + useless. We kept it to keep code identical to the byterun/ + implementation. */ + static void print_location(struct loc_info * li, int index) { char * info; /* Ignore compiler-inserted raise */ - if (!li->loc_valid) return; + if (!li->loc_valid && li->loc_is_raise) return; - if (index == 0) - info = "Raised at"; - else if (li->loc_is_raise) - info = "Re-raised at"; - else - info = "Called from"; - fprintf (stderr, "%s file \"%s\", line %d, characters %d-%d\n", - info, li->loc_filename, li->loc_lnum, - li->loc_startchr, li->loc_endchr); + if (li->loc_is_raise) { + /* Initial raise if index == 0, re-raise otherwise */ + if (index == 0) + info = "Raised at"; + else + info = "Re-raised at"; + } else { + if (index == 0) + info = "Raised by primitive operation at"; + else + info = "Called from"; + } + if (! li->loc_valid) { + fprintf(stderr, "%s unknown location\n", info); + } else { + fprintf (stderr, "%s file \"%s\", line %d, characters %d-%d\n", + info, li->loc_filename, li->loc_lnum, + li->loc_startchr, li->loc_endchr); + } } /* Print a backtrace */ @@ -193,18 +293,17 @@ } } -/* Convert the backtrace to a data structure usable from Caml */ +/* Convert the raw backtrace to a data structure usable from OCaml */ -CAMLprim value caml_get_exception_backtrace(value unit) -{ - CAMLparam0(); +CAMLprim value caml_convert_raw_backtrace(value backtrace) { + CAMLparam1(backtrace); CAMLlocal4(res, arr, p, fname); int i; struct loc_info li; - arr = caml_alloc(caml_backtrace_pos, 0); - for (i = 0; i < caml_backtrace_pos; i++) { - extract_location_info((frame_descr *) (caml_backtrace_buffer[i]), &li); + arr = caml_alloc(Wosize_val(backtrace), 0); + for (i = 0; i < Wosize_val(backtrace); i++) { + extract_location_info((frame_descr *) Field(backtrace, i), &li); if (li.loc_valid) { fname = caml_copy_string(li.loc_filename); p = caml_alloc_small(5, 0); @@ -222,3 +321,35 @@ res = caml_alloc_small(1, 0); Field(res, 0) = arr; /* Some */ CAMLreturn(res); } + +/* Get a copy of the latest backtrace */ + +CAMLprim value caml_get_exception_raw_backtrace(value unit) +{ + CAMLparam0(); + CAMLlocal1(res); + res = caml_alloc(caml_backtrace_pos, Abstract_tag); + if(caml_backtrace_buffer != NULL) + memcpy(&Field(res, 0), caml_backtrace_buffer, + caml_backtrace_pos * sizeof(code_t)); + CAMLreturn(res); +} + +/* the function below is deprecated: we previously returned directly + the OCaml-usable representation, instead of the raw backtrace as an + abstract type, but this has a large performance overhead if you + store a lot of backtraces and print only some of them. + + It is not used by the Printexc library anymore, or anywhere else in + the compiler, but we have kept it in case some user still depends + on it as an external. +*/ + +CAMLprim value caml_get_exception_backtrace(value unit) +{ + CAMLparam0(); + CAMLlocal2(raw,res); + raw = caml_get_exception_raw_backtrace(unit); + res = caml_convert_raw_backtrace(raw); + CAMLreturn(res); +} diff -Nru ocaml-3.12.1/asmrun/fail.c ocaml-4.01.0/asmrun/fail.c --- ocaml-3.12.1/asmrun/fail.c 2008-09-18 11:23:28.000000000 +0000 +++ ocaml-4.01.0/asmrun/fail.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: fail.c 9030 2008-09-18 11:23:28Z xleroy $ */ - /* Raising exceptions from C. */ #include @@ -41,7 +39,9 @@ caml_exn_Not_found, caml_exn_Match_failure, caml_exn_Sys_blocked_io, - caml_exn_Stack_overflow; + caml_exn_Stack_overflow, + caml_exn_Assert_failure, + caml_exn_Undefined_recursive_module; extern caml_generated_constant caml_bucket_Out_of_memory, caml_bucket_Stack_overflow; @@ -205,3 +205,9 @@ } caml_raise((value) &array_bound_error_bucket.exn); } + +int caml_is_special_exception(value exn) { + return exn == (value) caml_exn_Match_failure + || exn == (value) caml_exn_Assert_failure + || exn == (value) caml_exn_Undefined_recursive_module; +} diff -Nru ocaml-3.12.1/asmrun/hppa.S ocaml-4.01.0/asmrun/hppa.S --- ocaml-3.12.1/asmrun/hppa.S 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmrun/hppa.S 1970-01-01 00:00:00.000000000 +0000 @@ -1,534 +0,0 @@ -;********************************************************************* -;* * -;* Objective Caml * -;* * -;* Xavier Leroy, projet Cristal, INRIA Rocquencourt * -;* * -;* Copyright 1996 Institut National de Recherche en Informatique et * -;* en Automatique. All rights reserved. This file is distributed * -;* under the terms of the GNU Library General Public License, with * -;* the special exception on linking described in file ../LICENSE. * -;* * -;********************************************************************* - -; $Id: hppa.S 9547 2010-01-22 12:48:24Z doligez $ - -; Asm part of the runtime system for the HP PA-RISC processor. -; Must be preprocessed by cpp - -#ifdef SYS_hpux -#define G(x) x -#define CODESPACE .code -#define CODE_ALIGN 4 -#define EXPORT_CODE(x) .export x, entry, priv_lev=3 -#define EXPORT_DATA(x) .export x, data -#define STARTPROC .proc ! .callinfo frame=0, no_calls ! .entry -#define ENDPROC .exit ! .procend -#define LOADHIGH(x) addil LR%x-$global$, %r27 -#define LOW(x) RR%x-$global$ -#define LOADHIGHLABEL(x) ldil LR%x, %r1 -#define LOWLABEL(x) RR%x -#endif - -#if defined(SYS_linux) || defined(SYS_gnu) -#define G(x) x -#define CODESPACE .text -#define CODE_ALIGN 8 -#define EXPORT_CODE(x) .globl x -#define EXPORT_DATA(x) .globl x -#define STARTPROC -#define ENDPROC -#define LOADHIGH(x) addil LR%x-$global$, %r27 -#define LOW(x) RR%x-$global$ -#define LOADHIGHLABEL(x) ldil LR%x, %r1 -#define LOWLABEL(x) RR%x -#endif - -#ifdef SYS_hpux - .space $PRIVATE$ - .subspa $DATA$,quad=1,align=8,access=31 - .subspa $BSS$,quad=1,align=8,access=31,zero,sort=82 - .space $TEXT$ - .subspa $LIT$,quad=0,align=8,access=44 - .subspa $CODE$,quad=0,align=8,access=44,code_only - .import $global$, data - .import $$dyncall, millicode - .import caml_garbage_collection, code - .import caml_program, code - .import caml_raise, code - .import caml_apply2, code - .import caml_apply3, code - .import caml_array_bound_error, code - -caml_young_limit .comm 8 -caml_young_ptr .comm 8 -caml_bottom_of_stack .comm 8 -caml_last_return_address .comm 8 -caml_gc_regs .comm 8 -caml_exception_pointer .comm 8 -caml_required_size .comm 8 -#endif - -#if defined(SYS_linux) || defined(SYS_gnu) - .align 8 - .comm G(young_limit), 4 - .comm G(young_ptr), 4 - .comm G(caml_bottom_of_stack), 4 - .comm G(caml_last_return_address), 4 - .comm G(caml_gc_regs), 4 - .comm G(caml_exception_pointer), 4 - .comm G(caml_required_size), 4 -#endif - -; Allocation functions - - CODESPACE - .align CODE_ALIGN - EXPORT_CODE(G(caml_allocN)) -G(caml_allocN): - STARTPROC -; Required size in %r29 - ldw 0(%r4), %r1 - sub %r3, %r29, %r3 - comb,<<,n %r3, %r1, G(caml_call_gc) ; nullify if taken (forward br.) - bv 0(%r2) - nop - ENDPROC - - EXPORT_CODE(G(caml_call_gc)) -G(caml_call_gc): - STARTPROC -; Save required size (%r29) - LOADHIGH(G(caml_required_size)) - stw %r29, LOW(G(caml_required_size))(%r1) -; Save current allocation pointer for debugging purposes - LOADHIGH(G(caml_young_ptr)) - stw %r3, LOW(G(caml_young_ptr))(%r1) -; Record lowest stack address - LOADHIGH(G(caml_bottom_of_stack)) - stw %r30, LOW(G(caml_bottom_of_stack))(%r1) -; Record return address - LOADHIGH(G(caml_last_return_address)) - stw %r2, LOW(G(caml_last_return_address))(%r1) -; Save the exception handler (if e.g. a sighandler raises) - LOADHIGH(G(caml_exception_pointer)) - stw %r5, LOW(G(caml_exception_pointer))(%r1) -; Reserve stack space -; 0x1C0 = 4 * 32 (int regs) + 8 * 32 (float regs) + 64 (for calling C) - ldo 0x1C0(%r30), %r30 -; Save caml_gc_regs -L100: ldo -(64 + 4*32)(%r30), %r31 - LOADHIGH(G(caml_gc_regs)) - stw %r31, LOW(G(caml_gc_regs))(%r1) -; Save all regs used by the code generator - copy %r31, %r1 - stws,ma %r6, 4(%r1) - stws,ma %r7, 4(%r1) - stws,ma %r8, 4(%r1) - stws,ma %r9, 4(%r1) - stws,ma %r10, 4(%r1) - stws,ma %r11, 4(%r1) - stws,ma %r12, 4(%r1) - stws,ma %r13, 4(%r1) - stws,ma %r14, 4(%r1) - stws,ma %r15, 4(%r1) - stws,ma %r16, 4(%r1) - stws,ma %r17, 4(%r1) - stws,ma %r18, 4(%r1) - stws,ma %r19, 4(%r1) - stws,ma %r20, 4(%r1) - stws,ma %r21, 4(%r1) - stws,ma %r22, 4(%r1) - stws,ma %r23, 4(%r1) - stws,ma %r24, 4(%r1) - stws,ma %r25, 4(%r1) - stws,ma %r26, 4(%r1) - stws,ma %r28, 4(%r1) - ldo -0x1C0(%r30), %r1 - fstds,ma %fr4, 8(%r1) - fstds,ma %fr5, 8(%r1) - fstds,ma %fr6, 8(%r1) - fstds,ma %fr7, 8(%r1) - fstds,ma %fr8, 8(%r1) - fstds,ma %fr9, 8(%r1) - fstds,ma %fr10, 8(%r1) - fstds,ma %fr11, 8(%r1) - fstds,ma %fr12, 8(%r1) - fstds,ma %fr13, 8(%r1) - fstds,ma %fr14, 8(%r1) - fstds,ma %fr15, 8(%r1) - fstds,ma %fr16, 8(%r1) - fstds,ma %fr17, 8(%r1) - fstds,ma %fr18, 8(%r1) - fstds,ma %fr19, 8(%r1) - fstds,ma %fr20, 8(%r1) - fstds,ma %fr21, 8(%r1) - fstds,ma %fr22, 8(%r1) - fstds,ma %fr23, 8(%r1) - fstds,ma %fr24, 8(%r1) - fstds,ma %fr25, 8(%r1) - fstds,ma %fr26, 8(%r1) - fstds,ma %fr27, 8(%r1) - fstds,ma %fr28, 8(%r1) - fstds,ma %fr29, 8(%r1) - fstds,ma %fr30, 8(%r1) - -; Call the garbage collector - bl G(caml_garbage_collection), %r2 - nop - -; Restore all regs used by the code generator - ldo -(64 + 4*32)(%r30), %r1 - ldws,ma 4(%r1), %r6 - ldws,ma 4(%r1), %r7 - ldws,ma 4(%r1), %r8 - ldws,ma 4(%r1), %r9 - ldws,ma 4(%r1), %r10 - ldws,ma 4(%r1), %r11 - ldws,ma 4(%r1), %r12 - ldws,ma 4(%r1), %r13 - ldws,ma 4(%r1), %r14 - ldws,ma 4(%r1), %r15 - ldws,ma 4(%r1), %r16 - ldws,ma 4(%r1), %r17 - ldws,ma 4(%r1), %r18 - ldws,ma 4(%r1), %r19 - ldws,ma 4(%r1), %r20 - ldws,ma 4(%r1), %r21 - ldws,ma 4(%r1), %r22 - ldws,ma 4(%r1), %r23 - ldws,ma 4(%r1), %r24 - ldws,ma 4(%r1), %r25 - ldws,ma 4(%r1), %r26 - ldws,ma 4(%r1), %r28 - ldo -0x1C0(%r30), %r1 - fldds,ma 8(%r1), %fr4 - fldds,ma 8(%r1), %fr5 - fldds,ma 8(%r1), %fr6 - fldds,ma 8(%r1), %fr7 - fldds,ma 8(%r1), %fr8 - fldds,ma 8(%r1), %fr9 - fldds,ma 8(%r1), %fr10 - fldds,ma 8(%r1), %fr11 - fldds,ma 8(%r1), %fr12 - fldds,ma 8(%r1), %fr13 - fldds,ma 8(%r1), %fr14 - fldds,ma 8(%r1), %fr15 - fldds,ma 8(%r1), %fr16 - fldds,ma 8(%r1), %fr17 - fldds,ma 8(%r1), %fr18 - fldds,ma 8(%r1), %fr19 - fldds,ma 8(%r1), %fr20 - fldds,ma 8(%r1), %fr21 - fldds,ma 8(%r1), %fr22 - fldds,ma 8(%r1), %fr23 - fldds,ma 8(%r1), %fr24 - fldds,ma 8(%r1), %fr25 - fldds,ma 8(%r1), %fr26 - fldds,ma 8(%r1), %fr27 - fldds,ma 8(%r1), %fr28 - fldds,ma 8(%r1), %fr29 - fldds,ma 8(%r1), %fr30 - -; Reload the allocation pointer - LOADHIGH(G(caml_young_ptr)) - ldw LOW(G(caml_young_ptr))(%r1), %r3 -; Allocate space for block - LOADHIGH(G(caml_required_size)) - ldw LOW(G(caml_required_size))(%r1), %r29 - ldw 0(%r4), %r1 - sub %r3, %r29, %r3 - comb,<< %r3, %r1, L100 - nop -; Return to caller - LOADHIGH(G(caml_last_return_address)) - ldw LOW(G(caml_last_return_address))(%r1), %r2 - bv 0(%r2) - ldo -0x1C0(%r30), %r30 - ENDPROC - -; Call a C function from Caml -; Function to call is in %r22 - - .align CODE_ALIGN -#ifdef SYS_hpux - .export G(caml_c_call), ENTRY, ARGW0=GR, ARGW1=GR, ARGW2=GR, ARGW3=GR -#else - EXPORT_CODE(G(caml_c_call)) -#endif -G(caml_c_call): - STARTPROC -; Record lowest stack address - LOADHIGH(G(caml_bottom_of_stack)) - stw %r30, LOW(G(caml_bottom_of_stack))(%r1) -; Record return address - LOADHIGH(G(caml_last_return_address)) - stw %r2, LOW(G(caml_last_return_address))(%r1) -; Save the exception handler - LOADHIGH(G(caml_exception_pointer)) - stw %r5, LOW(G(caml_exception_pointer))(%r1) -; Save the allocation pointer - LOADHIGH(G(caml_young_ptr)) - stw %r3, LOW(G(caml_young_ptr))(%r1) -; Call the C function -#ifdef SYS_hpux - bl $$dyncall, %r31 -#else - ble 0(4, %r22) -#endif - copy %r31, %r2 ; in delay slot -; Reload return address - LOADHIGH(G(caml_last_return_address)) - ldw LOW(G(caml_last_return_address))(%r1), %r2 -; Reload allocation pointer - LOADHIGH(G(caml_young_ptr)) -; Return to caller - bv 0(%r2) - ldw LOW(G(caml_young_ptr))(%r1), %r3 ; in delay slot - ENDPROC - -; Start the Caml program - - .align CODE_ALIGN - EXPORT_CODE(G(caml_start_program)) -G(caml_start_program): - STARTPROC - LOADHIGH(G(caml_program)) - ldo LOW(G(caml_program))(%r1), %r22 - -; Code shared with caml_callback* -L102: -; Save return address - stw %r2,-20(%r30) - ldo 256(%r30), %r30 -; Save the callee-save registers - ldo -32(%r30), %r1 - stws,ma %r3, -4(%r1) - stws,ma %r4, -4(%r1) - stws,ma %r5, -4(%r1) - stws,ma %r6, -4(%r1) - stws,ma %r7, -4(%r1) - stws,ma %r8, -4(%r1) - stws,ma %r9, -4(%r1) - stws,ma %r10, -4(%r1) - stws,ma %r11, -4(%r1) - stws,ma %r12, -4(%r1) - stws,ma %r13, -4(%r1) - stws,ma %r14, -4(%r1) - stws,ma %r15, -4(%r1) - stws,ma %r16, -4(%r1) - stws,ma %r17, -4(%r1) - stws,ma %r18, -4(%r1) - fstds,ma %fr12, -8(%r1) - fstds,ma %fr13, -8(%r1) - fstds,ma %fr14, -8(%r1) - fstds,ma %fr15, -8(%r1) - fstds,ma %fr16, -8(%r1) - fstds,ma %fr17, -8(%r1) - fstds,ma %fr18, -8(%r1) - fstds,ma %fr19, -8(%r1) - fstds,ma %fr20, -8(%r1) - fstds,ma %fr21, -8(%r1) - fstds,ma %fr22, -8(%r1) - fstds,ma %fr23, -8(%r1) - fstds,ma %fr24, -8(%r1) - fstds,ma %fr25, -8(%r1) - fstds,ma %fr26, -8(%r1) - fstds,ma %fr27, -8(%r1) - fstds,ma %fr28, -8(%r1) - fstds,ma %fr29, -8(%r1) - fstds,ma %fr30, -8(%r1) - fstds,ma %fr31, -8(%r1) -; Set up a callback link - ldo 16(%r30), %r30 - LOADHIGH(G(caml_bottom_of_stack)) - ldw LOW(G(caml_bottom_of_stack))(%r1), %r1 - stw %r1, -16(%r30) - LOADHIGH(G(caml_last_return_address)) - ldw LOW(G(caml_last_return_address))(%r1), %r1 - stw %r1, -12(%r30) - LOADHIGH(G(caml_gc_regs)) - ldw LOW(G(caml_gc_regs))(%r1), %r1 - stw %r1, -8(%r30) -; Set up a trap frame to catch exceptions escaping the Caml code - ldo 8(%r30), %r30 - LOADHIGH(G(caml_exception_pointer)) - ldw LOW(G(caml_exception_pointer))(%r1), %r1 - stw %r1, -8(%r30) - LOADHIGHLABEL(L103) - ldo LOWLABEL(L103)(%r1), %r1 - stw %r1, -4(%r30) - copy %r30, %r5 -; Reload allocation pointers - LOADHIGH(G(caml_young_ptr)) - ldw LOW(G(caml_young_ptr))(%r1), %r3 - LOADHIGH(G(caml_young_limit)) - ldo LOW(G(caml_young_limit))(%r1), %r4 -; Call the Caml code - ble 0(4, %r22) - copy %r31, %r2 -L104: -; Pop the trap frame - ldw -8(%r30), %r31 - LOADHIGH(G(caml_exception_pointer)) - stw %r31, LOW(G(caml_exception_pointer))(%r1) - ldo -8(%r30), %r30 -; Pop the callback link -L105: - ldw -16(%r30), %r31 - LOADHIGH(G(caml_bottom_of_stack)) - stw %r31, LOW(G(caml_bottom_of_stack))(%r1) - ldw -12(%r30), %r31 - LOADHIGH(G(caml_last_return_address)) - stw %r31, LOW(G(caml_last_return_address))(%r1) - ldw -8(%r30), %r31 - LOADHIGH(G(caml_gc_regs)) - stw %r31, LOW(G(caml_gc_regs))(%r1) - ldo -16(%r30), %r30 -; Save allocation pointer - LOADHIGH(G(caml_young_ptr)) - stw %r3, LOW(G(caml_young_ptr))(%r1) -; Move result where C function expects it - copy %r26, %r28 -; Reload callee-save registers - ldo -32(%r30), %r1 - ldws,ma -4(%r1), %r3 - ldws,ma -4(%r1), %r4 - ldws,ma -4(%r1), %r5 - ldws,ma -4(%r1), %r6 - ldws,ma -4(%r1), %r7 - ldws,ma -4(%r1), %r8 - ldws,ma -4(%r1), %r9 - ldws,ma -4(%r1), %r10 - ldws,ma -4(%r1), %r11 - ldws,ma -4(%r1), %r12 - ldws,ma -4(%r1), %r13 - ldws,ma -4(%r1), %r14 - ldws,ma -4(%r1), %r15 - ldws,ma -4(%r1), %r16 - ldws,ma -4(%r1), %r17 - ldws,ma -4(%r1), %r18 - fldds,ma -8(%r1), %fr12 - fldds,ma -8(%r1), %fr13 - fldds,ma -8(%r1), %fr14 - fldds,ma -8(%r1), %fr15 - fldds,ma -8(%r1), %fr16 - fldds,ma -8(%r1), %fr17 - fldds,ma -8(%r1), %fr18 - fldds,ma -8(%r1), %fr19 - fldds,ma -8(%r1), %fr20 - fldds,ma -8(%r1), %fr21 - fldds,ma -8(%r1), %fr22 - fldds,ma -8(%r1), %fr23 - fldds,ma -8(%r1), %fr24 - fldds,ma -8(%r1), %fr25 - fldds,ma -8(%r1), %fr26 - fldds,ma -8(%r1), %fr27 - fldds,ma -8(%r1), %fr28 - fldds,ma -8(%r1), %fr29 - fldds,ma -8(%r1), %fr30 - fldds,ma -8(%r1), %fr31 -; Return to C - ldo -256(%r30), %r30 - ldw -20(%r30), %r2 - bv 0(%r2) - nop -; The trap handler -L103: -; Save exception pointer - LOADHIGH(G(caml_exception_pointer)) - stw %r5, LOW(G(caml_exception_pointer))(%r1) -; Encode exception bucket as an exception result and return it - ldi 2, %r1 - or %r26, %r1, %r26 -; Return it - b L105 - nop - -; Re-raise the exception through caml_raise, to clean up local C roots - ldo 64(%r30), %r30 - bl G(caml_raise), %r2 - nop - ENDPROC - -; Raise an exception from C - - .align CODE_ALIGN - EXPORT_CODE(G(caml_raise_exception)) -G(caml_raise_exception): - STARTPROC -; Cut the stack - LOADHIGH(G(caml_exception_pointer)) - ldw LOW(G(caml_exception_pointer))(%r1), %r30 -; Reload allocation registers - LOADHIGH(G(caml_young_ptr)) - ldw LOW(G(caml_young_ptr))(%r1), %r3 - LOADHIGH(G(caml_young_limit)) - ldo LOW(G(caml_young_limit))(%r1), %r4 -; Raise the exception - ldw -4(%r30), %r1 - ldw -8(%r30), %r5 - bv 0(%r1) - ldo -8(%r30), %r30 ; in delay slot - ENDPROC - -; Callbacks C -> ML - - .align CODE_ALIGN - EXPORT_CODE(G(caml_callback_exn)) -G(caml_callback_exn): - STARTPROC -; Initial shuffling of arguments - copy %r26, %r1 ; Closure - copy %r25, %r26 ; Argument - copy %r1, %r25 - b L102 - ldw 0(%r1), %r22 ; Code to call (in delay slot) - ENDPROC - - .align CODE_ALIGN - EXPORT_CODE(G(caml_callback2_exn)) -G(caml_callback2_exn): - STARTPROC - copy %r26, %r1 ; Closure - copy %r25, %r26 ; First argument - copy %r24, %r25 ; Second argument - copy %r1, %r24 - LOADHIGH(G(caml_apply2)) - b L102 - ldo LOW(G(caml_apply2))(%r1), %r22 - ENDPROC - - .align CODE_ALIGN - EXPORT_CODE(G(caml_callback3_exn)) -G(caml_callback3_exn): - STARTPROC - copy %r26, %r1 ; Closure - copy %r25, %r26 ; First argument - copy %r24, %r25 ; Second argument - copy %r23, %r24 ; Third argument - copy %r1, %r23 - LOADHIGH(G(caml_apply3)) - b L102 - ldo LOW(G(caml_apply3))(%r1), %r22 - ENDPROC - - .align CODE_ALIGN - EXPORT_CODE(G(caml_ml_array_bound_error)) -G(caml_ml_array_bound_error): - STARTPROC -; Load address of [caml_array_bound_error] in %r22 - ldil LR%caml_array_bound_error, %r22 - ldo RR%caml_array_bound_error(%r22), %r22 -; Reserve 48 bytes of stack space and jump to caml_c_call - b G(caml_c_call) - ldo 48(%r30), %r30 /* in delay slot */ - ENDPROC - - .data - EXPORT_DATA(G(caml_system__frametable)) -G(caml_system__frametable): - .long 1 /* one descriptor */ - .long L104 + 3 /* return address into callback */ - .short -1 /* negative frame size => use callback link */ - .short 0 /* no roots */ diff -Nru ocaml-3.12.1/asmrun/i386.S ocaml-4.01.0/asmrun/i386.S --- ocaml-3.12.1/asmrun/i386.S 2008-08-01 08:04:57.000000000 +0000 +++ ocaml-4.01.0/asmrun/i386.S 2013-03-22 18:21:34.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,11 +11,11 @@ /* */ /***********************************************************************/ -/* $Id: i386.S 8962 2008-08-01 08:04:57Z xleroy $ */ - /* Asm part of the runtime system, Intel 386 processor */ /* Must be preprocessed by cpp */ +#include "../config/m.h" + /* Linux/BSD with ELF binaries and Solaris do not prefix identifiers with _. Linux/BSD with a.out binaries and NextStep do. */ @@ -42,28 +42,73 @@ #define FUNCTION_ALIGN 2 #endif +#define FUNCTION(name) \ + .globl G(name); \ + .align FUNCTION_ALIGN; \ + G(name): + +#ifdef ASM_CFI_SUPPORTED +#define CFI_STARTPROC .cfi_startproc +#define CFI_ENDPROC .cfi_endproc +#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n +#else +#define CFI_STARTPROC +#define CFI_ENDPROC +#define CFI_ADJUST(n) +#endif + #if defined(PROFILING) #if defined(SYS_linux_elf) || defined(SYS_gnu) #define PROFILE_CAML \ - pushl %ebp; movl %esp, %ebp; pushl %eax; pushl %ecx; pushl %edx; \ + pushl %ebp; CFI_ADJUST(4); \ + movl %esp, %ebp; \ + pushl %eax; CFI_ADJUST(4); \ + pushl %ecx; CFI_ADJUST(4); \ + pushl %edx; CFI_ADJUST(4); \ call mcount; \ - popl %edx; popl %ecx; popl %eax; popl %ebp + popl %edx; CFI_ADJUST(-4); \ + popl %ecx; CFI_ADJUST(-4); \ + popl %eax; CFI_ADJUST(-4); \ + popl %ebp; CFI_ADJUST(-4) #define PROFILE_C \ - pushl %ebp; movl %esp, %ebp; call mcount; popl %ebp + pushl %ebp; CFI_ADJUST(4); \ + movl %esp, %ebp; \ + call mcount; \ + popl %ebp; CFI_ADJUST(-4) #elif defined(SYS_bsd_elf) #define PROFILE_CAML \ - pushl %ebp; movl %esp, %ebp; pushl %eax; pushl %ecx; pushl %edx; \ + pushl %ebp; CFI_ADJUST(4); \ + movl %esp, %ebp; \ + pushl %eax; CFI_ADJUST(4); \ + pushl %ecx; CFI_ADJUST(4); \ + pushl %edx; CFI_ADJUST(4); \ call .mcount; \ - popl %edx; popl %ecx; popl %eax; popl %ebp + popl %edx; CFI_ADJUST(-4); \ + popl %ecx; CFI_ADJUST(-4); \ + popl %eax; CFI_ADJUST(-4); \ + popl %ebp; CFI_ADJUST(-4) #define PROFILE_C \ - pushl %ebp; movl %esp, %ebp; call .mcount; popl %ebp + pushl %ebp; CFI_ADJUST(4); \ + movl %esp, %ebp; \ + call .mcount; \ + popl %ebp; CFI_ADJUST(-4) #elif defined(SYS_macosx) #define PROFILE_CAML \ - pushl %ebp; movl %esp, %ebp; pushl %eax; pushl %ecx; pushl %edx; \ + pushl %ebp; CFI_ADJUST(4); \ + movl %esp, %ebp; \ + pushl %eax; CFI_ADJUST(4); \ + pushl %ecx; CFI_ADJUST(4); \ + pushl %edx; CFI_ADJUST(4); \ call Lmcount$stub; \ - popl %edx; popl %ecx; popl %eax; popl %ebp + popl %edx; CFI_ADJUST(-4); \ + popl %ecx; CFI_ADJUST(-4); \ + popl %eax; CFI_ADJUST(-4); \ + popl %ebp; CFI_ADJUST(-4) #define PROFILE_C \ - pushl %ebp; movl %esp, %ebp; call Lmcount$stub; popl %ebp + pushl %ebp; CFI_ADJUST(4); \ + movl %esp, %ebp; \ + call Lmcount$stub; \ + popl %ebp; CFI_ADJUST(-4) #endif #else #define PROFILE_CAML @@ -71,8 +116,8 @@ #endif #ifdef SYS_macosx -#define ALIGN_STACK(amount) subl $ amount, %esp -#define UNDO_ALIGN_STACK(amount) addl $ amount, %esp +#define ALIGN_STACK(amount) subl $ amount, %esp ; CFI_ADJUST(amount) +#define UNDO_ALIGN_STACK(amount) addl $ amount, %esp ; CFI_ADJUST(-amount) #else #define ALIGN_STACK(amount) #define UNDO_ALIGN_STACK(amount) @@ -81,46 +126,51 @@ /* Allocation */ .text - .globl G(caml_call_gc) - .globl G(caml_alloc1) - .globl G(caml_alloc2) - .globl G(caml_alloc3) - .globl G(caml_allocN) + .globl G(caml_system__code_begin) +G(caml_system__code_begin): - .align FUNCTION_ALIGN -G(caml_call_gc): +FUNCTION(caml_call_gc) + CFI_STARTPROC PROFILE_CAML /* Record lowest stack address and return address */ movl 0(%esp), %eax movl %eax, G(caml_last_return_address) leal 4(%esp), %eax movl %eax, G(caml_bottom_of_stack) - /* Build array of registers, save it into caml_gc_regs */ LBL(105): - pushl %ebp - pushl %edi - pushl %esi - pushl %edx - pushl %ecx - pushl %ebx - pushl %eax +#if !defined(SYS_mingw) && !defined(SYS_cygwin) + /* Touch the stack to trigger a recoverable segfault + if insufficient space remains */ + subl $16384, %esp + movl %eax, 0(%esp) + addl $16384, %esp +#endif + /* Build array of registers, save it into caml_gc_regs */ + pushl %ebp; CFI_ADJUST(4) + pushl %edi; CFI_ADJUST(4) + pushl %esi; CFI_ADJUST(4) + pushl %edx; CFI_ADJUST(4) + pushl %ecx; CFI_ADJUST(4) + pushl %ebx; CFI_ADJUST(4) + pushl %eax; CFI_ADJUST(4) movl %esp, G(caml_gc_regs) /* MacOSX note: 16-alignment of stack preserved at this point */ /* Call the garbage collector */ call G(caml_garbage_collection) /* Restore all regs used by the code generator */ - popl %eax - popl %ebx - popl %ecx - popl %edx - popl %esi - popl %edi - popl %ebp + popl %eax; CFI_ADJUST(-4) + popl %ebx; CFI_ADJUST(-4) + popl %ecx; CFI_ADJUST(-4) + popl %edx; CFI_ADJUST(-4) + popl %esi; CFI_ADJUST(-4) + popl %edi; CFI_ADJUST(-4) + popl %ebp; CFI_ADJUST(-4) /* Return to caller */ ret + CFI_ENDPROC - .align FUNCTION_ALIGN -G(caml_alloc1): +FUNCTION(caml_alloc1) + CFI_STARTPROC PROFILE_CAML movl G(caml_young_ptr), %eax subl $8, %eax @@ -137,9 +187,10 @@ call LBL(105) UNDO_ALIGN_STACK(12) jmp G(caml_alloc1) + CFI_ENDPROC - .align FUNCTION_ALIGN -G(caml_alloc2): +FUNCTION(caml_alloc2) + CFI_STARTPROC PROFILE_CAML movl G(caml_young_ptr), %eax subl $12, %eax @@ -156,9 +207,10 @@ call LBL(105) UNDO_ALIGN_STACK(12) jmp G(caml_alloc2) + CFI_ENDPROC - .align FUNCTION_ALIGN -G(caml_alloc3): +FUNCTION(caml_alloc3) + CFI_STARTPROC PROFILE_CAML movl G(caml_young_ptr), %eax subl $16, %eax @@ -175,9 +227,10 @@ call LBL(105) UNDO_ALIGN_STACK(12) jmp G(caml_alloc3) + CFI_ENDPROC - .align FUNCTION_ALIGN -G(caml_allocN): +FUNCTION(caml_allocN) + CFI_STARTPROC PROFILE_CAML subl G(caml_young_ptr), %eax /* eax = size - caml_young_ptr */ negl %eax /* eax = caml_young_ptr - size */ @@ -188,7 +241,7 @@ LBL(103): subl G(caml_young_ptr), %eax /* eax = - size */ negl %eax /* eax = size */ - pushl %eax /* save desired size */ + pushl %eax; CFI_ADJUST(4) /* save desired size */ subl %eax, G(caml_young_ptr) /* must update young_ptr */ movl 4(%esp), %eax movl %eax, G(caml_last_return_address) @@ -197,68 +250,75 @@ ALIGN_STACK(8) call LBL(105) UNDO_ALIGN_STACK(8) - popl %eax /* recover desired size */ + popl %eax; CFI_ADJUST(-4) /* recover desired size */ jmp G(caml_allocN) + CFI_ENDPROC -/* Call a C function from Caml */ +/* Call a C function from OCaml */ - .globl G(caml_c_call) - .align FUNCTION_ALIGN -G(caml_c_call): +FUNCTION(caml_c_call) + CFI_STARTPROC PROFILE_CAML /* Record lowest stack address and return address */ movl (%esp), %edx movl %edx, G(caml_last_return_address) leal 4(%esp), %edx movl %edx, G(caml_bottom_of_stack) +#if !defined(SYS_mingw) && !defined(SYS_cygwin) + /* Touch the stack to trigger a recoverable segfault + if insufficient space remains */ + subl $16384, %esp + movl %eax, 0(%esp) + addl $16384, %esp +#endif /* Call the function (address in %eax) */ jmp *%eax + CFI_ENDPROC -/* Start the Caml program */ +/* Start the OCaml program */ - .globl G(caml_start_program) - .align FUNCTION_ALIGN -G(caml_start_program): +FUNCTION(caml_start_program) + CFI_STARTPROC PROFILE_C /* Save callee-save registers */ - pushl %ebx - pushl %esi - pushl %edi - pushl %ebp + pushl %ebx; CFI_ADJUST(4) + pushl %esi; CFI_ADJUST(4) + pushl %edi; CFI_ADJUST(4) + pushl %ebp; CFI_ADJUST(4) /* Initial entry point is caml_program */ movl $ G(caml_program), %esi /* Common code for caml_start_program and caml_callback* */ LBL(106): /* Build a callback link */ - pushl G(caml_gc_regs) - pushl G(caml_last_return_address) - pushl G(caml_bottom_of_stack) + pushl G(caml_gc_regs); CFI_ADJUST(4) + pushl G(caml_last_return_address); CFI_ADJUST(4) + pushl G(caml_bottom_of_stack); CFI_ADJUST(4) /* Note: 16-alignment preserved on MacOSX at this point */ /* Build an exception handler */ - pushl $ LBL(108) + pushl $ LBL(108); CFI_ADJUST(4) ALIGN_STACK(8) - pushl G(caml_exception_pointer) + pushl G(caml_exception_pointer); CFI_ADJUST(4) movl %esp, G(caml_exception_pointer) - /* Call the Caml code */ + /* Call the OCaml code */ call *%esi LBL(107): /* Pop the exception handler */ - popl G(caml_exception_pointer) + popl G(caml_exception_pointer); CFI_ADJUST(-4) #ifdef SYS_macosx - addl $12, %esp + addl $12, %esp ; CFI_ADJUST(-12) #else - addl $4, %esp + addl $4, %esp ; CFI_ADJUST(-4) #endif LBL(109): /* Pop the callback link, restoring the global variables */ - popl G(caml_bottom_of_stack) - popl G(caml_last_return_address) - popl G(caml_gc_regs) + popl G(caml_bottom_of_stack); CFI_ADJUST(-4) + popl G(caml_last_return_address); CFI_ADJUST(-4) + popl G(caml_gc_regs); CFI_ADJUST(-4) /* Restore callee-save registers. */ - popl %ebp - popl %edi - popl %esi - popl %ebx + popl %ebp; CFI_ADJUST(-4) + popl %edi; CFI_ADJUST(-4) + popl %esi; CFI_ADJUST(-4) + popl %ebx; CFI_ADJUST(-4) /* Return to caller. */ ret LBL(108): @@ -266,16 +326,16 @@ /* Mark the bucket as an exception result and return it */ orl $2, %eax jmp LBL(109) + CFI_ENDPROC -/* Raise an exception from Caml */ +/* Raise an exception from OCaml */ - .globl G(caml_raise_exn) - .align FUNCTION_ALIGN -G(caml_raise_exn): +FUNCTION(caml_raise_exn) + CFI_STARTPROC testl $1, G(caml_backtrace_active) jne LBL(110) movl G(caml_exception_pointer), %esp - popl G(caml_exception_pointer) + popl G(caml_exception_pointer); CFI_ADJUST(-4) UNDO_ALIGN_STACK(8) ret LBL(110): @@ -284,86 +344,86 @@ movl 0(%esp), %eax /* PC of raise */ leal 4(%esp), %edx /* SP of raise */ ALIGN_STACK(12) - pushl %edi /* arg 4: sp of handler */ - pushl %edx /* arg 3: sp of raise */ - pushl %eax /* arg 2: pc of raise */ - pushl %esi /* arg 1: exception bucket */ + pushl %edi; CFI_ADJUST(4) /* arg 4: sp of handler */ + pushl %edx; CFI_ADJUST(4) /* arg 3: sp of raise */ + pushl %eax; CFI_ADJUST(4) /* arg 2: pc of raise */ + pushl %esi; CFI_ADJUST(4) /* arg 1: exception bucket */ call G(caml_stash_backtrace) movl %esi, %eax /* Recover exception bucket */ movl %edi, %esp - popl G(caml_exception_pointer) + popl G(caml_exception_pointer); CFI_ADJUST(-4) UNDO_ALIGN_STACK(8) ret + CFI_ENDPROC /* Raise an exception from C */ - .globl G(caml_raise_exception) - .align FUNCTION_ALIGN -G(caml_raise_exception): +FUNCTION(caml_raise_exception) + CFI_STARTPROC PROFILE_C - testl $1, G(caml_backtrace_active) + testl $1, G(caml_backtrace_active) jne LBL(111) movl 4(%esp), %eax movl G(caml_exception_pointer), %esp - popl G(caml_exception_pointer) + popl G(caml_exception_pointer); CFI_ADJUST(-4) UNDO_ALIGN_STACK(8) ret LBL(111): movl 4(%esp), %esi /* Save exception bucket in esi */ ALIGN_STACK(12) - pushl G(caml_exception_pointer) /* arg 4: sp of handler */ - pushl G(caml_bottom_of_stack) /* arg 3: sp of raise */ - pushl G(caml_last_return_address) /* arg 2: pc of raise */ - pushl %esi /* arg 1: exception bucket */ + pushl G(caml_exception_pointer); CFI_ADJUST(4) /* 4: sp of handler */ + pushl G(caml_bottom_of_stack); CFI_ADJUST(4) /* 3: sp of raise */ + pushl G(caml_last_return_address); CFI_ADJUST(4)/* 2: pc of raise */ + pushl %esi; CFI_ADJUST(4) /* 1: exception bucket */ call G(caml_stash_backtrace) movl %esi, %eax /* Recover exception bucket */ movl G(caml_exception_pointer), %esp - popl G(caml_exception_pointer) + popl G(caml_exception_pointer); CFI_ADJUST(-4) UNDO_ALIGN_STACK(8) ret + CFI_ENDPROC -/* Callback from C to Caml */ +/* Callback from C to OCaml */ - .globl G(caml_callback_exn) - .align FUNCTION_ALIGN -G(caml_callback_exn): +FUNCTION(caml_callback_exn) + CFI_STARTPROC PROFILE_C /* Save callee-save registers */ - pushl %ebx - pushl %esi - pushl %edi - pushl %ebp + pushl %ebx; CFI_ADJUST(4) + pushl %esi; CFI_ADJUST(4) + pushl %edi; CFI_ADJUST(4) + pushl %ebp; CFI_ADJUST(4) /* Initial loading of arguments */ movl 20(%esp), %ebx /* closure */ movl 24(%esp), %eax /* argument */ movl 0(%ebx), %esi /* code pointer */ jmp LBL(106) + CFI_ENDPROC - .globl G(caml_callback2_exn) - .align FUNCTION_ALIGN -G(caml_callback2_exn): +FUNCTION(caml_callback2_exn) + CFI_STARTPROC PROFILE_C /* Save callee-save registers */ - pushl %ebx - pushl %esi - pushl %edi - pushl %ebp + pushl %ebx; CFI_ADJUST(4) + pushl %esi; CFI_ADJUST(4) + pushl %edi; CFI_ADJUST(4) + pushl %ebp; CFI_ADJUST(4) /* Initial loading of arguments */ movl 20(%esp), %ecx /* closure */ movl 24(%esp), %eax /* first argument */ movl 28(%esp), %ebx /* second argument */ movl $ G(caml_apply2), %esi /* code pointer */ jmp LBL(106) + CFI_ENDPROC - .globl G(caml_callback3_exn) - .align FUNCTION_ALIGN -G(caml_callback3_exn): +FUNCTION(caml_callback3_exn) + CFI_STARTPROC PROFILE_C /* Save callee-save registers */ - pushl %ebx - pushl %esi - pushl %edi - pushl %ebp + pushl %ebx; CFI_ADJUST(4) + pushl %esi; CFI_ADJUST(4) + pushl %edi; CFI_ADJUST(4) + pushl %ebp; CFI_ADJUST(4) /* Initial loading of arguments */ movl 20(%esp), %edx /* closure */ movl 24(%esp), %eax /* first argument */ @@ -371,10 +431,10 @@ movl 32(%esp), %ecx /* third argument */ movl $ G(caml_apply3), %esi /* code pointer */ jmp LBL(106) + CFI_ENDPROC - .globl G(caml_ml_array_bound_error) - .align FUNCTION_ALIGN -G(caml_ml_array_bound_error): +FUNCTION(caml_ml_array_bound_error) + CFI_STARTPROC /* Empty the floating-point stack */ ffree %st(0) ffree %st(1) @@ -391,10 +451,14 @@ movl %edx, G(caml_bottom_of_stack) /* For MacOS X: re-align the stack */ #ifdef SYS_macosx - andl $-16, %esp + andl $-16, %esp #endif /* Branch to [caml_array_bound_error] (never returns) */ call G(caml_array_bound_error) + CFI_ENDPROC + + .globl G(caml_system__code_end) +G(caml_system__code_end): .data .globl G(caml_system__frametable) diff -Nru ocaml-3.12.1/asmrun/i386nt.asm ocaml-4.01.0/asmrun/i386nt.asm --- ocaml-3.12.1/asmrun/i386nt.asm 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmrun/i386nt.asm 2012-10-15 17:50:56.000000000 +0000 @@ -1,22 +1,20 @@ -;********************************************************************* -; -; Objective Caml -; -; Xavier Leroy, projet Cristal, INRIA Rocquencourt -; -; Copyright 1996 Institut National de Recherche en Informatique et -; en Automatique. All rights reserved. This file is distributed -; under the terms of the GNU Library General Public License, with -; the special exception on linking described in file ../LICENSE. -; -;********************************************************************* - -; $Id: i386nt.asm 9547 2010-01-22 12:48:24Z doligez $ +;*********************************************************************** +;* * +;* OCaml * +;* * +;* Xavier Leroy, projet Cristal, INRIA Rocquencourt * +;* * +;* Copyright 1996 Institut National de Recherche en Informatique et * +;* en Automatique. All rights reserved. This file is distributed * +;* under the terms of the GNU Library General Public License, with * +;* the special exception on linking described in file ../LICENSE. * +;* * +;*********************************************************************** ; Asm part of the runtime system, Intel 386 processor, Intel syntax - .386 - .MODEL FLAT + .386 + .MODEL FLAT EXTERN _caml_garbage_collection: PROC EXTERN _caml_apply2: PROC @@ -25,10 +23,10 @@ EXTERN _caml_array_bound_error: PROC EXTERN _caml_young_limit: DWORD EXTERN _caml_young_ptr: DWORD - EXTERN _caml_bottom_of_stack: DWORD - EXTERN _caml_last_return_address: DWORD - EXTERN _caml_gc_regs: DWORD - EXTERN _caml_exception_pointer: DWORD + EXTERN _caml_bottom_of_stack: DWORD + EXTERN _caml_last_return_address: DWORD + EXTERN _caml_gc_regs: DWORD + EXTERN _caml_exception_pointer: DWORD EXTERN _caml_backtrace_active: DWORD EXTERN _caml_stash_backtrace: PROC @@ -39,11 +37,11 @@ PUBLIC _caml_alloc2 PUBLIC _caml_alloc3 PUBLIC _caml_allocN - PUBLIC _caml_call_gc + PUBLIC _caml_call_gc _caml_call_gc: ; Record lowest stack address and return address - mov eax, [esp] + mov eax, [esp] mov _caml_last_return_address, eax lea eax, [esp+4] mov _caml_bottom_of_stack, eax @@ -57,9 +55,9 @@ push eax mov _caml_gc_regs, esp ; Call the garbage collector - call _caml_garbage_collection + call _caml_garbage_collection ; Restore all regs used by the code generator - pop eax + pop eax pop ebx pop ecx pop edx @@ -71,13 +69,13 @@ ALIGN 4 _caml_alloc1: - mov eax, _caml_young_ptr - sub eax, 8 - mov _caml_young_ptr, eax - cmp eax, _caml_young_limit - jb L100 + mov eax, _caml_young_ptr + sub eax, 8 + mov _caml_young_ptr, eax + cmp eax, _caml_young_limit + jb L100 ret -L100: mov eax, [esp] +L100: mov eax, [esp] mov _caml_last_return_address, eax lea eax, [esp+4] mov _caml_bottom_of_stack, eax @@ -86,13 +84,13 @@ ALIGN 4 _caml_alloc2: - mov eax, _caml_young_ptr - sub eax, 12 - mov _caml_young_ptr, eax - cmp eax, _caml_young_limit - jb L101 + mov eax, _caml_young_ptr + sub eax, 12 + mov _caml_young_ptr, eax + cmp eax, _caml_young_limit + jb L101 ret -L101: mov eax, [esp] +L101: mov eax, [esp] mov _caml_last_return_address, eax lea eax, [esp+4] mov _caml_bottom_of_stack, eax @@ -101,13 +99,13 @@ ALIGN 4 _caml_alloc3: - mov eax, _caml_young_ptr - sub eax, 16 - mov _caml_young_ptr, eax - cmp eax, _caml_young_limit - jb L102 + mov eax, _caml_young_ptr + sub eax, 16 + mov _caml_young_ptr, eax + cmp eax, _caml_young_limit + jb L102 ret -L102: mov eax, [esp] +L102: mov eax, [esp] mov _caml_last_return_address, eax lea eax, [esp+4] mov _caml_bottom_of_stack, eax @@ -126,7 +124,7 @@ neg eax ; eax = size push eax ; save desired size sub _caml_young_ptr, eax ; must update young_ptr - mov eax, [esp+4] + mov eax, [esp+4] mov _caml_last_return_address, eax lea eax, [esp+8] mov _caml_bottom_of_stack, eax @@ -134,29 +132,29 @@ pop eax ; recover desired size jmp _caml_allocN -; Call a C function from Caml +; Call a C function from OCaml PUBLIC _caml_c_call ALIGN 4 _caml_c_call: ; Record lowest stack address and return address - mov edx, [esp] - mov _caml_last_return_address, edx - lea edx, [esp+4] - mov _caml_bottom_of_stack, edx + mov edx, [esp] + mov _caml_last_return_address, edx + lea edx, [esp+4] + mov _caml_bottom_of_stack, edx ; Call the function (address in %eax) - jmp eax + jmp eax -; Start the Caml program +; Start the OCaml program PUBLIC _caml_start_program ALIGN 4 _caml_start_program: ; Save callee-save registers - push ebx - push esi - push edi - push ebp + push ebx + push esi + push edi + push ebp ; Initial code pointer is caml_program mov esi, offset _caml_program @@ -165,29 +163,29 @@ L106: ; Build a callback link push _caml_gc_regs - push _caml_last_return_address - push _caml_bottom_of_stack + push _caml_last_return_address + push _caml_bottom_of_stack ; Build an exception handler - push L108 - push _caml_exception_pointer - mov _caml_exception_pointer, esp - ; Call the Caml code - call esi + push L108 + push _caml_exception_pointer + mov _caml_exception_pointer, esp + ; Call the OCaml code + call esi L107: ; Pop the exception handler - pop _caml_exception_pointer - pop esi ; dummy register + pop _caml_exception_pointer + pop esi ; dummy register L109: ; Pop the callback link, restoring the global variables ; used by caml_c_call - pop _caml_bottom_of_stack - pop _caml_last_return_address + pop _caml_bottom_of_stack + pop _caml_last_return_address pop _caml_gc_regs ; Restore callee-save registers. - pop ebp - pop edi - pop esi - pop ebx + pop ebp + pop edi + pop esi + pop ebx ; Return to caller. ret L108: @@ -196,15 +194,15 @@ or eax, 2 jmp L109 -; Raise an exception for Caml +; Raise an exception for OCaml PUBLIC _caml_raise_exn ALIGN 4 _caml_raise_exn: test _caml_backtrace_active, 1 jne L110 - mov esp, _caml_exception_pointer - pop _caml_exception_pointer + mov esp, _caml_exception_pointer + pop _caml_exception_pointer ret L110: mov esi, eax ; Save exception bucket in esi @@ -228,9 +226,9 @@ _caml_raise_exception: test _caml_backtrace_active, 1 jne L111 - mov eax, [esp+4] - mov esp, _caml_exception_pointer - pop _caml_exception_pointer + mov eax, [esp+4] + mov esp, _caml_exception_pointer + pop _caml_exception_pointer ret L111: mov esi, [esp+4] ; Save exception bucket in esi @@ -244,52 +242,52 @@ pop _caml_exception_pointer ret -; Callback from C to Caml +; Callback from C to OCaml PUBLIC _caml_callback_exn ALIGN 4 _caml_callback_exn: ; Save callee-save registers - push ebx - push esi - push edi - push ebp + push ebx + push esi + push edi + push ebp ; Initial loading of arguments - mov ebx, [esp+20] ; closure - mov eax, [esp+24] ; argument - mov esi, [ebx] ; code pointer + mov ebx, [esp+20] ; closure + mov eax, [esp+24] ; argument + mov esi, [ebx] ; code pointer jmp L106 PUBLIC _caml_callback2_exn ALIGN 4 _caml_callback2_exn: ; Save callee-save registers - push ebx - push esi - push edi - push ebp + push ebx + push esi + push edi + push ebp ; Initial loading of arguments - mov ecx, [esp+20] ; closure - mov eax, [esp+24] ; first argument - mov ebx, [esp+28] ; second argument - mov esi, offset _caml_apply2 ; code pointer - jmp L106 + mov ecx, [esp+20] ; closure + mov eax, [esp+24] ; first argument + mov ebx, [esp+28] ; second argument + mov esi, offset _caml_apply2 ; code pointer + jmp L106 PUBLIC _caml_callback3_exn - ALIGN 4 + ALIGN 4 _caml_callback3_exn: ; Save callee-save registers - push ebx - push esi - push edi - push ebp + push ebx + push esi + push edi + push ebp ; Initial loading of arguments - mov edx, [esp+20] ; closure - mov eax, [esp+24] ; first argument - mov ebx, [esp+28] ; second argument - mov ecx, [esp+32] ; third argument - mov esi, offset _caml_apply3 ; code pointer - jmp L106 + mov edx, [esp+20] ; closure + mov eax, [esp+24] ; first argument + mov ebx, [esp+28] ; second argument + mov ecx, [esp+32] ; third argument + mov esi, offset _caml_apply3 ; code pointer + jmp L106 PUBLIC _caml_ml_array_bound_error ALIGN 4 diff -Nru ocaml-3.12.1/asmrun/ia64.S ocaml-4.01.0/asmrun/ia64.S --- ocaml-3.12.1/asmrun/ia64.S 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmrun/ia64.S 1970-01-01 00:00:00.000000000 +0000 @@ -1,523 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the Q Public License version 1.0. */ -/* */ -/***********************************************************************/ - -/* $Id: ia64.S 9547 2010-01-22 12:48:24Z doligez $ */ - -/* Asm part of the runtime system, IA64 processor */ - -#undef BROKEN_POSTINCREMENT - -#define ADDRGLOBAL(reg,symb) \ - add reg = @ltoff(symb), gp;; ld8 reg = [reg] -#define LOADGLOBAL(reg,symb) \ - add r3 = @ltoff(symb), gp;; ld8 r3 = [r3];; ld8 reg = [r3] -#define STOREGLOBAL(reg,symb) \ - add r3 = @ltoff(symb), gp;; ld8 r3 = [r3];; st8 [r3] = reg - -#define ST8OFF(a,b,d) st8 [a] = b, d -#define LD8OFF(a,b,d) ld8 a = [b], d -#define STFDOFF(a,b,d) stfd [a] = b, d -#define LDFDOFF(a,b,d) ldfd a = [b], d -#define STFSPILLOFF(a,b,d) stf.spill [a] = b, d -#define LDFFILLOFF(a,b,d) ldf.fill a = [b], d - -#define SAVE2(a,b) ST8OFF(r2, a, 16); ST8OFF(r3, b, 16) -#define SAVE4(a,b,c,d) SAVE2(a,b);; SAVE2(c,d) -#define SAVE8(a,b,c,d,e,f,g,h) SAVE4(a,b,c,d);; SAVE4(e,f,g,h) - -#define LOAD2(a,b) LD8OFF(a, r2, 16); LD8OFF(b, r3, 16) -#define LOAD4(a,b,c,d) LOAD2(a,b);; LOAD2(c,d) -#define LOAD8(a,b,c,d,e,f,g,h) LOAD4(a,b,c,d);; LOAD4(e,f,g,h) - -#define FSAVE2(a,b) STFDOFF(r2, a, 16); STFDOFF(r3, b, 16) -#define FSAVE4(a,b,c,d) FSAVE2(a,b);; FSAVE2(c,d) -#define FSAVE8(a,b,c,d,e,f,g,h) FSAVE4(a,b,c,d);; FSAVE4(e,f,g,h) - -#define FLOAD2(a,b) LDFDOFF(a, r2, 16); LDFDOFF(b, r3, 16) -#define FLOAD4(a,b,c,d) FLOAD2(a,b);; FLOAD2(c,d) -#define FLOAD8(a,b,c,d,e,f,g,h) FLOAD4(a,b,c,d);; FLOAD4(e,f,g,h) - -#define FSPILL2(a,b) STFSPILLOFF(r2, a, 32); STFSPILLOFF(r3, b, 32) -#define FSPILL4(a,b,c,d) FSPILL2(a,b);; FSPILL2(c,d) -#define FSPILL8(a,b,c,d,e,f,g,h) FSPILL4(a,b,c,d);; FSPILL4(e,f,g,h) - -#define FFILL2(a,b) LDFFILLOFF(a, r2, 32); LDFFILLOFF(b, r3, 32) -#define FFILL4(a,b,c,d) FFILL2(a,b);; FFILL2(c,d) -#define FFILL8(a,b,c,d,e,f,g,h) FFILL4(a,b,c,d);; FFILL4(e,f,g,h) - -/* Allocation */ - .text - - .global caml_allocN# - .proc caml_allocN# - .align 16 - -/* caml_allocN: all code generator registers preserved, - gp preserved, r2 = requested size */ - -caml_allocN: - sub r4 = r4, r2 ;; - cmp.ltu p0, p6 = r4, r5 - (p6) br.ret.sptk b0 ;; - /* Fall through caml_call_gc */ - br.sptk.many caml_call_gc# - - .endp caml_allocN# - -/* caml_call_gc: all code generator registers preserved, - gp preserved, r2 = requested size */ - - .global caml_call_gc# - .proc caml_call_gc# - .align 16 -caml_call_gc: - /* Allocate stack frame */ - add sp = -(16 + 16 + 80*8 + 42*8), sp ;; - - /* Save requested size and GP on stack */ - add r3 = 16, sp ;; - ST8OFF(r3, r2, 8) ;; - st8 [r3] = gp - - /* Record lowest stack address, return address, GC regs */ - mov r2 = b0 ;; - STOREGLOBAL(r2, caml_last_return_address#) - add r2 = (16 + 16 + 80*8 + 42*8), sp ;; - STOREGLOBAL(r2, caml_bottom_of_stack#) - add r2 = (16 + 16), sp ;; - STOREGLOBAL(r2, caml_gc_regs#) - - /* Save all integer regs used by the code generator in the context */ -.L100: add r3 = 8, r2 ;; - SAVE4(r8,r9,r10,r11) ;; - SAVE8(r16,r17,r18,r19,r20,r21,r22,r23) ;; - SAVE8(r24,r25,r26,r27,r28,r29,r30,r31) ;; - SAVE8(r32,r33,r34,r35,r36,r37,r38,r39) ;; - SAVE8(r40,r41,r42,r43,r44,r45,r46,r47) ;; - SAVE8(r48,r49,r50,r51,r52,r53,r54,r55) ;; - SAVE8(r56,r57,r58,r59,r60,r61,r62,r63) ;; - SAVE8(r64,r65,r66,r67,r68,r69,r70,r71) ;; - SAVE8(r72,r73,r74,r75,r76,r77,r78,r79) ;; - SAVE8(r80,r81,r82,r83,r84,r85,r86,r87) ;; - SAVE4(r88,r89,r90,r91) ;; - - /* Save all floating-point registers not preserved by C */ - FSAVE2(f6,f7) ;; - FSAVE8(f8,f9,f10,f11,f12,f13,f14,f15) ;; - FSAVE8(f32,f33,f34,f35,f36,f37,f38,f39) ;; - FSAVE8(f40,f41,f42,f43,f44,f45,f46,f47) ;; - FSAVE8(f48,f49,f50,f51,f52,f53,f54,f55) ;; - FSAVE8(f56,f57,f58,f59,f60,f61,f62,f63) ;; - - /* Save current allocation pointer for debugging purposes */ - STOREGLOBAL(r4, caml_young_ptr#) - - /* Save trap pointer in case an exception is raised */ - STOREGLOBAL(r6, caml_exception_pointer#) - - /* Call the garbage collector */ - br.call.sptk b0 = caml_garbage_collection# ;; - - /* Restore gp */ - add r3 = 24, sp ;; - ld8 gp = [r3] - - /* Restore all integer regs from GC context */ - add r2 = (16 + 16), sp ;; - add r3 = 8, r2 ;; - LOAD4(r8,r9,r10,r11) ;; - LOAD8(r16,r17,r18,r19,r20,r21,r22,r23) ;; - LOAD8(r24,r25,r26,r27,r28,r29,r30,r31) ;; - LOAD8(r32,r33,r34,r35,r36,r37,r38,r39) ;; - LOAD8(r40,r41,r42,r43,r44,r45,r46,r47) ;; - LOAD8(r48,r49,r50,r51,r52,r53,r54,r55) ;; - LOAD8(r56,r57,r58,r59,r60,r61,r62,r63) ;; - LOAD8(r64,r65,r66,r67,r68,r69,r70,r71) ;; - LOAD8(r72,r73,r74,r75,r76,r77,r78,r79) ;; - LOAD8(r80,r81,r82,r83,r84,r85,r86,r87) ;; - LOAD4(r88,r89,r90,r91) ;; - - /* Restore all floating-point registers not preserved by C */ - FLOAD2(f6,f7) ;; - FLOAD8(f8,f9,f10,f11,f12,f13,f14,f15) ;; - FLOAD8(f32,f33,f34,f35,f36,f37,f38,f39) ;; - FLOAD8(f40,f41,f42,f43,f44,f45,f46,f47) ;; - FLOAD8(f48,f49,f50,f51,f52,f53,f54,f55) ;; - FLOAD8(f56,f57,f58,f59,f60,f61,f62,f63) ;; - - /* Reload new allocation pointer and allocation limit */ - LOADGLOBAL(r4, caml_young_ptr#) - LOADGLOBAL(r5, caml_young_limit#) - - /* Allocate space for the block */ - add r3 = 16, sp ;; - ld8 r2 = [r3] ;; - sub r4 = r4, r2 ;; - cmp.ltu p6, p0 = r4, r5 /* enough space? */ - (p6) br.cond.spnt .L100 ;; /* no: call GC again */ - - /* Reload return address and say that we are back into Caml code */ - ADDRGLOBAL(r3, caml_last_return_address#) ;; - ld8 r2 = [r3] - st8 [r3] = r0 ;; - - /* Return to caller */ - mov b0 = r2 - add sp = (16 + 16 + 80*8 + 42*8), sp ;; - br.ret.sptk b0 - - .endp caml_call_gc# - -/* Call a C function from Caml */ -/* Function to call is in r2 */ - - .global caml_c_call# - .proc caml_c_call# - .align 16 - -caml_c_call: - /* The Caml code that called us does not expect any - code-generator registers to be preserved */ - - /* Recover entry point from the function pointer in r2 */ - LD8OFF(r3, r2, 8) ;; - mov b6 = r3 - - /* Preserve gp in r7 */ - mov r7 = gp - - /* Record lowest stack address and return address */ - mov r14 = b0 - STOREGLOBAL(sp, caml_bottom_of_stack#) ;; - STOREGLOBAL(r14, caml_last_return_address#) - - /* Make the exception handler and alloc ptr available to the C code */ - STOREGLOBAL(r4, caml_young_ptr#) - STOREGLOBAL(r6, caml_exception_pointer#) - - /* Recover gp from the function pointer in r2 */ - ld8 gp = [r2] - - /* Call the function */ - br.call.sptk b0 = b6 ;; - - /* Restore gp */ - mov gp = r7 ;; - - /* Reload alloc ptr and alloc limit */ - LOADGLOBAL(r4, caml_young_ptr#) - LOADGLOBAL(r5, caml_young_limit#) - - /* Reload return address and say that we are back into Caml code */ - ADDRGLOBAL(r3, caml_last_return_address#) ;; - ld8 r2 = [r3] - st8 [r3] = r0 ;; - - /* Return to caller */ - mov b0 = r2 ;; - br.ret.sptk b0 - - .endp caml_c_call# - -/* Start the Caml program */ - - .global caml_start_program# - .proc caml_start_program# - .align 16 - -caml_start_program: - ADDRGLOBAL(r2, caml_program#) ;; - mov b6 = r2 - - /* Code shared with caml_callback* */ -.L103: - /* Allocate 64 "out" registers (for the Caml code) and no locals */ - alloc r3 = ar.pfs, 0, 0, 64, 0 - add sp = -(56 * 8), sp ;; - - /* Save all callee-save registers on stack */ - add r2 = 16, sp ;; - ST8OFF(r2, r3, 8) /* 0 : ar.pfs */ - mov r3 = b0 ;; - ST8OFF(r2, r3, 8) ;; /* 1 : return address */ - ST8OFF(r2, gp, 8) /* 2 : gp */ - mov r3 = pr ;; - ST8OFF(r2, r3, 8) /* 3 : predicates */ - mov r3 = ar.fpsr ;; - ST8OFF(r2, r3, 8) /* 4 : ar.fpsr */ - mov r3 = ar.unat ;; - ST8OFF(r2, r3, 8) /* 5 : ar.unat */ - mov r3 = ar.lc ;; - ST8OFF(r2, r3, 8) /* 6 : ar.lc */ - mov r3 = b1 ;; - ST8OFF(r2, r3, 8) /* 7 - 11 : b1 - b5 */ - mov r3 = b2 ;; - ST8OFF(r2, r3, 8) - mov r3 = b3 ;; - ST8OFF(r2, r3, 8) - mov r3 = b4 ;; - ST8OFF(r2, r3, 8) - mov r3 = b5 ;; - ST8OFF(r2, r3, 8) ;; - - add r3 = 8, r2 ;; - SAVE4(r4,r5,r6,r7) ;; /* 12 - 15 : r4 - r7 */ - - add r3 = 16, r2 ;; /* 16 - 55 : f2 - f5, f16 - f31 */ - FSPILL4(f2,f3,f4,f5) ;; - FSPILL8(f16,f17,f18,f19,f20,f21,f22,f23) ;; - FSPILL8(f24,f25,f26,f27,f28,f29,f30,f31) ;; - - /* Set up a callback link on the stack. In addition to - the normal callback link contents (saved values of - caml_bottom_of_stack, caml_last_return_address and - caml_gc_regs), we also save there caml_saved_bsp - and caml_saved_rnat */ - add sp = -48, sp - LOADGLOBAL(r3, caml_bottom_of_stack#) - add r2 = 16, sp ;; - ST8OFF(r2, r3, 8) - LOADGLOBAL(r3, caml_last_return_address#) ;; - ST8OFF(r2, r3, 8) - LOADGLOBAL(r3, caml_gc_regs#) ;; - ST8OFF(r2, r3, 8) - LOADGLOBAL(r3, caml_saved_bsp#) ;; - ST8OFF(r2, r3, 8) - LOADGLOBAL(r3, caml_saved_rnat#) ;; - ST8OFF(r2, r3, 8) - - /* Set up a trap frame to catch exceptions escaping the Caml code */ - mov r6 = sp - add sp = -16, sp ;; - LOADGLOBAL(r3, caml_exception_pointer#) - add r2 = 16, sp ;; - ST8OFF(r2, r3, 8) -.L110: mov r3 = ip ;; - add r3 = .L101 - .L110, r3 ;; - ST8OFF(r2, r3, 8) ;; - - /* Save ar.bsp, flush register window, and save ar.rnat */ - mov r2 = ar.bsp ;; - STOREGLOBAL(r2, caml_saved_bsp#) ;; - mov r14 = ar.rsc ;; - and r2 = ~0x3, r14;; /* set rsc.mode = 0 */ - mov ar.rsc = r2 ;; /* RSE is in enforced lazy mode */ - flushrs ;; /* must be first instr in group */ - mov r2 = ar.rnat ;; - STOREGLOBAL(r2, caml_saved_rnat#) - mov ar.rsc = r14 /* restore original RSE mode */ - - /* Reload allocation pointers */ - LOADGLOBAL(r4, caml_young_ptr#) - LOADGLOBAL(r5, caml_young_limit#) - - /* We are back into Caml code */ - STOREGLOBAL(r0, caml_last_return_address#) - - /* Call the Caml code */ - br.call.sptk b0 = b6 ;; -.L102: - - /* Pop the trap frame, restoring caml_exception_pointer */ - add sp = 16, sp ;; - ld8 r2 = [sp] ;; - STOREGLOBAL(r2, caml_exception_pointer#) - -.L104: - /* Pop the callback link, restoring the global variables */ - add r14 = 16, sp ;; - LD8OFF(r2, r14, 8) ;; - STOREGLOBAL(r2, caml_bottom_of_stack#) - LD8OFF(r2, r14, 8) ;; - STOREGLOBAL(r2, caml_last_return_address#) - LD8OFF(r2, r14, 8) ;; - STOREGLOBAL(r2, caml_gc_regs#) - LD8OFF(r2, r14, 8) ;; - STOREGLOBAL(r2, caml_saved_bsp#) - LD8OFF(r2, r14, 8) ;; - STOREGLOBAL(r2, caml_saved_rnat#) - add sp = 48, sp - - /* Update allocation pointer */ - STOREGLOBAL(r4, caml_young_ptr#) - - /* Restore all callee-save registers from stack */ - add r2 = 16, sp ;; - LD8OFF(r3, r2, 8) ;; /* 0 : ar.pfs */ - mov ar.pfs = r3 - LD8OFF(r3, r2, 8) ;; /* 1 : return address */ - mov b0 = r3 - LD8OFF(gp, r2, 8) ;; /* 2 : gp */ - LD8OFF(r3, r2, 8) ;; /* 3 : predicates */ - mov pr = r3, -1 - LD8OFF(r3, r2, 8) ;; /* 4 : ar.fpsr */ - mov ar.fpsr = r3 - LD8OFF(r3, r2, 8) ;; /* 5 : ar.unat */ - mov ar.unat = r3 - LD8OFF(r3, r2, 8) ;; /* 6 : ar.lc */ - mov ar.lc = r3 - LD8OFF(r3, r2, 8) ;; /* 7 - 11 : b1 - b5 */ - mov b1 = r3 - LD8OFF(r3, r2, 8) ;; - mov b2 = r3 - LD8OFF(r3, r2, 8) ;; - mov b3 = r3 - LD8OFF(r3, r2, 8) ;; - mov b4 = r3 - LD8OFF(r3, r2, 8) ;; - mov b5 = r3 - - add r3 = 8, r2 ;; - LOAD4(r4,r5,r6,r7) ;; /* 12 - 15 : r4 - r7 */ - - add r3 = 16, r2 ;; /* 16 - 55 : f2 - f5, f16 - f31 */ - FFILL4(f2,f3,f4,f5) ;; - FFILL8(f16,f17,f18,f19,f20,f21,f22,f23) ;; - FFILL8(f24,f25,f26,f27,f28,f29,f30,f31) ;; - - /* Pop stack frame and return */ - add sp = (56 * 8), sp - br.ret.sptk.many b0 ;; - - /* The trap handler */ -.L101: - /* Save exception pointer */ - STOREGLOBAL(r6, caml_exception_pointer#) - - /* Encode exception bucket as exception result */ - or r8 = 2, r8 - - /* Return it */ - br.sptk .L104 ;; - - .endp caml_start_program# - -/* Raise an exception from C */ - - .global caml_raise_exception# - .proc caml_raise_exception# - .align 16 -caml_raise_exception: - /* Allocate 64 "out" registers (for the Caml code) and no locals */ - /* Since we don't return, don't bother saving the PFS */ - alloc r2 = ar.pfs, 0, 0, 64, 0 - - /* Move exn bucket where Caml expects it */ - mov r8 = r32 ;; - - /* Perform "context switch" as per the Software Conventions Guide, - chapter 10 */ - flushrs ;; /* flush dirty registers to stack */ - mov r14 = ar.rsc ;; - and r2 = ~0x3, r14;; /* set rsc.mode = 0 */ - dep r2 = r0, r2, 16, 4 ;; /* clear rsc.loadrs */ - mov ar.rsc = r2 ;; /* RSE is in enforced lazy mode */ - invala ;; /* Invalidate ALAT */ - LOADGLOBAL(r2, caml_saved_bsp#) ;; - mov ar.bspstore = r2 /* Restore ar.bspstore */ - LOADGLOBAL(r2, caml_saved_rnat#) ;; - mov ar.rnat = r2 /* Restore ar.rnat */ - mov ar.rsc = r14 ;; /* Restore original RSE mode */ - - /* Reload allocation pointers and exception pointer */ - LOADGLOBAL(r4, caml_young_ptr#) - LOADGLOBAL(r5, caml_young_limit#) - LOADGLOBAL(r6, caml_exception_pointer#) - - /* Say that we're back into Caml */ - STOREGLOBAL(r0, caml_last_return_address#) - - /* Raise the exception proper */ - mov sp = r6 - add r2 = 8, r6 ;; - ld8 r6 = [r6] - ld8 r2 = [r2] ;; - mov b6 = r2 ;; - - /* Branch to handler. Must use a call so as to set up the - CFM and PFS correctly. */ - br.call.sptk.many b0 = b6 - - .endp caml_raise_exception - -/* Callbacks from C to Caml */ - - .global caml_callback_exn# - .proc caml_callback_exn# - .align 16 -caml_callback_exn: - /* Initial shuffling of arguments */ - ld8 r3 = [r32] /* code pointer */ - mov r2 = r32 - mov r32 = r33 ;; /* first arg */ - mov r33 = r2 /* environment */ - mov b6 = r3 - br.sptk .L103 ;; - - .endp caml_callback_exn# - - .global caml_callback2_exn# - .proc caml_callback2_exn# - .align 16 -caml_callback2_exn: - /* Initial shuffling of arguments */ - ADDRGLOBAL(r3, caml_apply2) /* code pointer */ - mov r2 = r32 - mov r32 = r33 /* first arg */ - mov r33 = r34 ;; /* second arg */ - mov r34 = r2 /* environment */ - mov b6 = r3 - br.sptk .L103 ;; - - .endp caml_callback2_exn# - - .global caml_callback3_exn# - .proc caml_callback3_exn# - .align 16 -caml_callback3_exn: - /* Initial shuffling of arguments */ - ADDRGLOBAL(r3, caml_apply3) /* code pointer */ - mov r2 = r32 - mov r32 = r33 /* first arg */ - mov r33 = r34 /* second arg */ - mov r34 = r35 ;; /* third arg */ - mov r35 = r2 /* environment */ - mov b6 = r3 - br.sptk .L103 ;; - - .endp caml_callback3_exn# - -/* Glue code to call [caml_array_bound_error] */ - - .global caml_ml_array_bound_error# - .proc caml_ml_array_bound_error# - .align 16 -caml_ml_array_bound_error: - ADDRGLOBAL(r2, @fptr(caml_array_bound_error#)) - br.sptk caml_c_call /* never returns */ - - .rodata - - .global caml_system__frametable# - .type caml_system__frametable#, @object - .size caml_system__frametable#, 8 -caml_system__frametable: - data8 1 /* one descriptor */ - data8 .L102 /* return address into callback */ - data2 -1 /* negative frame size => use callback link */ - data2 0 /* no roots here */ - .align 8 - -/* Global variables used by caml_raise_exception */ - - .common caml_saved_bsp#, 8, 8 - .common caml_saved_rnat#, 8, 8 diff -Nru ocaml-3.12.1/asmrun/m68k.S ocaml-4.01.0/asmrun/m68k.S --- ocaml-3.12.1/asmrun/m68k.S 2004-01-03 12:51:20.000000000 +0000 +++ ocaml-4.01.0/asmrun/m68k.S 1970-01-01 00:00:00.000000000 +0000 @@ -1,244 +0,0 @@ -|*********************************************************************** -|* * -|* Objective Caml * -|* * -|* Xavier Leroy, projet Cristal, INRIA Rocquencourt * -|* * -|* Copyright 1996 Institut National de Recherche en Informatique et * -|* en Automatique. All rights reserved. This file is distributed * -|* under the terms of the GNU Library General Public License, with * -|* the special exception on linking described in file ../LICENSE. * -|* * -|*********************************************************************** - -| $Id: m68k.S 6050 2004-01-03 12:51:20Z doligez $ - -| Asm part of the runtime system, Motorola 68k processor - - .comm _caml_requested_size, 4 - -| Allocation - - .text - .globl _caml_call_gc - .globl _caml_alloc1 - .globl _caml_alloc2 - .globl _caml_alloc3 - .globl _caml_allocN - -_caml_call_gc: - | Save desired size - movel d5, _caml_requested_size - | Record lowest stack address and return address - movel a7@, _caml_last_return_address - movel a7, d5 - addql #4, d5 - movel d5, _caml_bottom_of_stack - | Record current allocation pointer (for debugging) - movel d6, _caml_young_ptr - | Save all regs used by the code generator - movel d4, a7@- - movel d3, a7@- - movel d2, a7@- - movel d1, a7@- - movel d0, a7@- - movel a6, a7@- - movel a5, a7@- - movel a4, a7@- - movel a3, a7@- - movel a2, a7@- - movel a1, a7@- - movel a0, a7@- - movel a7, _caml_gc_regs - fmovem fp0-fp7, a7@- - | Call the garbage collector - jbsr _caml_garbage_collection - | Restore all regs used by the code generator - fmovem a7@+, fp0-fp7 - movel a7@+, a0 - movel a7@+, a1 - movel a7@+, a2 - movel a7@+, a3 - movel a7@+, a4 - movel a7@+, a5 - movel a7@+, a6 - movel a7@+, d0 - movel a7@+, d1 - movel a7@+, d2 - movel a7@+, d3 - movel a7@+, d4 - | Reload allocation pointer and allocate block - movel _caml_young_ptr, d6 - subl _caml_requested_size, d6 - | Return to caller - rts - -_caml_alloc1: - subql #8, d6 - cmpl _caml_young_limit, d6 - bcs L100 - rts -L100: moveq #8, d5 - bra _caml_call_gc - -_caml_alloc2: - subl #12, d6 - cmpl _caml_young_limit, d6 - bcs L101 - rts -L101: moveq #12, d5 - bra _caml_call_gc - -_caml_alloc3: - subl #16, d6 - cmpl _caml_young_limit, d6 - bcs L102 - rts -L102: moveq #16, d5 - bra _caml_call_gc - -_caml_allocN: - subl d5, d6 - cmpl _caml_young_limit, d6 - bcs _caml_call_gc - rts - -| Call a C function from Caml - - .globl _caml_c_call - -_caml_c_call: - | Record lowest stack address and return address - movel a7@+, _caml_last_return_address - movel a7, _caml_bottom_of_stack - | Save allocation pointer and exception pointer - movel d6, _caml_young_ptr - movel d7, _caml_exception_pointer - | Call the function (address in a0) - jbsr a0@ - | Reload allocation pointer - movel _caml_young_ptr, d6 - | Return to caller - movel _caml_last_return_address, a1 - jmp a1@ - -| Start the Caml program - - .globl _caml_start_program - -_caml_start_program: - | Save callee-save registers - moveml a2-a6/d2-d7, a7@- - fmovem fp2-fp7, a7@- - | Initial code point is caml_program - lea _caml_program, a5 - -| Code shared between caml_start_program and caml_callback* - -L106: - | Build a callback link - movel _caml_gc_regs, a7@- - movel _caml_last_return_address, a7@- - movel _caml_bottom_of_stack, a7@- - | Build an exception handler - pea L108 - movel _caml_exception_pointer, a7@- - movel a7, d7 - | Load allocation pointer - movel _caml_young_ptr, d6 - | Call the Caml code - jbsr a5@ -L107: - | Move result where C code expects it - movel a0, d0 - | Save allocation pointer - movel d6, _caml_young_ptr - | Pop the exception handler - movel a7@+, _caml_exception_pointer - addql #4, a7 -L109: - | Pop the callback link, restoring the global variables - | used by caml_c_call - movel a7@+, _caml_bottom_of_stack - movel a7@+, _caml_last_return_address - movel a7@+, _caml_gc_regs - | Restore callee-save registers and return - fmovem a7@+, fp2-fp7 - moveml a7@+, a2-a6/d2-d7 - unlk a6 - rts -L108: - | Exception handler - | Save allocation pointer and exception pointer - movel d6, _caml_young_ptr - movel d7, _caml_exception_pointer - | Encode exception bucket as an exception result - movel a0, d0 - orl #2, d0 - | Return it - bra L109 - -| Raise an exception from C - - .globl _caml_raise_exception -_caml_raise_exception: - movel a7@(4), a0 | exception bucket - movel _caml_young_ptr, d6 - movel _caml_exception_pointer, a7 - movel a7@+, d7 - rts - -| Callback from C to Caml - - .globl _caml_callback_exn -_caml_callback_exn: - link a6, #0 - | Save callee-save registers - moveml a2-a6/d2-d7, a7@- - fmovem fp2-fp7, a7@- - | Initial loading of arguments - movel a6@(8), a1 | closure - movel a6@(12), a0 | argument - movel a1@(0), a5 | code pointer - bra L106 - - .globl _caml_callback2_exn -_caml_callback2_exn: - link a6, #0 - | Save callee-save registers - moveml a2-a6/d2-d7, a7@- - fmovem fp2-fp7, a7@- - | Initial loading of arguments - movel a6@(8), a2 | closure - movel a6@(12), a0 | first argument - movel a6@(16), a1 | second argument - lea _caml_apply2, a5 | code pointer - bra L106 - - .globl _caml_callback3_exn -_caml_callback3_exn: - link a6, #0 - | Save callee-save registers - moveml a2-a6/d2-d7, a7@- - fmovem fp2-fp7, a7@- - | Initial loading of arguments - movel a6@(8), a3 | closure - movel a6@(12), a0 | first argument - movel a6@(16), a1 | second argument - movel a6@(20), a2 | third argument - lea _caml_apply3, a5 | code pointer - bra L106 - - .globl _caml_ml_array_bound_error -_caml_ml_array_bound_error: - | Load address of [caml_array_bound_error] in a0 and call it - lea _caml_array_bound_error, a0 - bra _caml_c_call - - .data - .globl _caml_system__frametable -_caml_system__frametable: - .long 1 | one descriptor - .long L107 | return address into callback - .word -1 | negative frame size => use callback link - .word 0 | no roots here diff -Nru ocaml-3.12.1/asmrun/mips.s ocaml-4.01.0/asmrun/mips.s --- ocaml-3.12.1/asmrun/mips.s 2004-07-13 12:19:15.000000000 +0000 +++ ocaml-4.01.0/asmrun/mips.s 1970-01-01 00:00:00.000000000 +0000 @@ -1,386 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id: mips.s 6552 2004-07-13 12:19:15Z xleroy $ */ - -/* Asm part of the runtime system, Mips processor, IRIX n32 conventions */ - -/* Allocation */ - - .text - - .globl caml_call_gc - .ent caml_call_gc - -caml_call_gc: - /* Reserve stack space for registers and saved $gp */ - /* 32 * 8 = 0x100 for float regs - 22 * 4 = 0x58 for integer regs - 8 = 0x8 for saved $gp ====> 0x160 total */ - subu $sp, $sp, 0x160 - /* Reinit $gp */ - .cpsetup $25, 0x158, caml_call_gc - /* Record return address */ - sw $31, caml_last_return_address - /* Record lowest stack address */ - addu $24, $sp, 0x160 - sw $24, caml_bottom_of_stack - /* Save pointer to register array */ - addu $24, $sp, 0x100 - sw $24, caml_gc_regs - /* Save current allocation pointer for debugging purposes */ - sw $22, caml_young_ptr - /* Save the exception handler (if e.g. a sighandler raises) */ - sw $30, caml_exception_pointer - /* Save all regs used by the code generator on the stack */ - sw $2, 2 * 4($24) - sw $3, 3 * 4($24) - sw $4, 4 * 4($24) - sw $5, 5 * 4($24) - sw $6, 6 * 4($24) - sw $7, 7 * 4($24) - sw $8, 8 * 4($24) - sw $9, 9 * 4($24) - sw $10, 10 * 4($24) - sw $11, 11 * 4($24) - sw $12, 12 * 4($24) - sw $13, 13 * 4($24) - sw $14, 14 * 4($24) - sw $15, 15 * 4($24) - sw $16, 16 * 4($24) - sw $17, 17 * 4($24) - sw $18, 18 * 4($24) - sw $19, 19 * 4($24) - sw $20, 20 * 4($24) - sw $21, 21 * 4($24) - s.d $f0, 0 * 8($sp) - s.d $f1, 1 * 8($sp) - s.d $f2, 2 * 8($sp) - s.d $f3, 3 * 8($sp) - s.d $f4, 4 * 8($sp) - s.d $f5, 5 * 8($sp) - s.d $f6, 6 * 8($sp) - s.d $f7, 7 * 8($sp) - s.d $f8, 8 * 8($sp) - s.d $f9, 9 * 8($sp) - s.d $f10, 10 * 8($sp) - s.d $f11, 11 * 8($sp) - s.d $f12, 12 * 8($sp) - s.d $f13, 13 * 8($sp) - s.d $f14, 14 * 8($sp) - s.d $f15, 15 * 8($sp) - s.d $f16, 16 * 8($sp) - s.d $f17, 17 * 8($sp) - s.d $f18, 18 * 8($sp) - s.d $f19, 19 * 8($sp) - s.d $f20, 20 * 8($sp) - s.d $f21, 21 * 8($sp) - s.d $f22, 22 * 8($sp) - s.d $f23, 23 * 8($sp) - s.d $f24, 24 * 8($sp) - s.d $f25, 25 * 8($sp) - s.d $f26, 26 * 8($sp) - s.d $f27, 27 * 8($sp) - s.d $f28, 28 * 8($sp) - s.d $f29, 29 * 8($sp) - s.d $f30, 30 * 8($sp) - s.d $f31, 31 * 8($sp) - /* Call the garbage collector */ - jal caml_garbage_collection - /* Restore all regs used by the code generator */ - addu $24, $sp, 0x100 - lw $2, 2 * 4($24) - lw $3, 3 * 4($24) - lw $4, 4 * 4($24) - lw $5, 5 * 4($24) - lw $6, 6 * 4($24) - lw $7, 7 * 4($24) - lw $8, 8 * 4($24) - lw $9, 9 * 4($24) - lw $10, 10 * 4($24) - lw $11, 11 * 4($24) - lw $12, 12 * 4($24) - lw $13, 13 * 4($24) - lw $14, 14 * 4($24) - lw $15, 15 * 4($24) - lw $16, 16 * 4($24) - lw $17, 17 * 4($24) - lw $18, 18 * 4($24) - lw $19, 19 * 4($24) - lw $20, 20 * 4($24) - lw $21, 21 * 4($24) - l.d $f0, 0 * 8($sp) - l.d $f1, 1 * 8($sp) - l.d $f2, 2 * 8($sp) - l.d $f3, 3 * 8($sp) - l.d $f4, 4 * 8($sp) - l.d $f5, 5 * 8($sp) - l.d $f6, 6 * 8($sp) - l.d $f7, 7 * 8($sp) - l.d $f8, 8 * 8($sp) - l.d $f9, 9 * 8($sp) - l.d $f10, 10 * 8($sp) - l.d $f11, 11 * 8($sp) - l.d $f12, 12 * 8($sp) - l.d $f13, 13 * 8($sp) - l.d $f14, 14 * 8($sp) - l.d $f15, 15 * 8($sp) - l.d $f16, 16 * 8($sp) - l.d $f17, 17 * 8($sp) - l.d $f18, 18 * 8($sp) - l.d $f19, 19 * 8($sp) - l.d $f20, 20 * 8($sp) - l.d $f21, 21 * 8($sp) - l.d $f22, 22 * 8($sp) - l.d $f23, 23 * 8($sp) - l.d $f24, 24 * 8($sp) - l.d $f25, 25 * 8($sp) - l.d $f26, 26 * 8($sp) - l.d $f27, 27 * 8($sp) - l.d $f28, 28 * 8($sp) - l.d $f29, 29 * 8($sp) - l.d $f30, 30 * 8($sp) - l.d $f31, 31 * 8($sp) - /* Reload new allocation pointer and allocation limit */ - lw $22, caml_young_ptr - lw $23, caml_young_limit - /* Reload return address */ - lw $31, caml_last_return_address - /* Say that we are back into Caml code */ - sw $0, caml_last_return_address - /* Adjust return address to restart the allocation sequence */ - subu $31, $31, 16 - /* Return */ - .cpreturn - addu $sp, $sp, 0x160 - j $31 - - .end caml_call_gc - -/* Call a C function from Caml */ - - .globl caml_c_call - .ent caml_c_call - -caml_c_call: - /* Function to call is in $24 */ - /* Set up $gp, saving caller's $gp in callee-save register $19 */ - .cpsetup $25, $19, caml_c_call - /* Preload addresses of interesting global variables - in callee-save registers */ - la $16, caml_last_return_address - la $17, caml_young_ptr - /* Save return address, bottom of stack, alloc ptr, exn ptr */ - sw $31, 0($16) /* caml_last_return_address */ - sw $sp, caml_bottom_of_stack - sw $22, 0($17) /* caml_young_ptr */ - sw $30, caml_exception_pointer - /* Call C function */ - move $25, $24 - jal $24 - /* Reload return address, alloc ptr, alloc limit */ - lw $31, 0($16) /* caml_last_return_address */ - lw $22, 0($17) /* caml_young_ptr */ - lw $23, caml_young_limit /* caml_young_limit */ - /* Zero caml_last_return_address, indicating we're back in Caml code */ - sw $0, 0($16) /* caml_last_return_address */ - /* Restore $gp and return */ - move $gp, $19 - j $31 - .end caml_c_call - -/* Start the Caml program */ - - .globl caml_start_program - .globl stray_exn_handler - .ent caml_start_program -caml_start_program: - /* Reserve space for callee-save registers */ - subu $sp, $sp, 0x90 - /* Setup $gp */ - .cpsetup $25, 0x80, caml_start_program - /* Load in $24 the code address to call */ - la $24, caml_program - /* Code shared with caml_callback* */ -$103: - /* Save return address */ - sd $31, 0x88($sp) - /* Save all callee-save registers */ - sd $16, 0x0($sp) - sd $17, 0x8($sp) - sd $18, 0x10($sp) - sd $19, 0x18($sp) - sd $20, 0x20($sp) - sd $21, 0x28($sp) - sd $22, 0x30($sp) - sd $23, 0x38($sp) - sd $30, 0x40($sp) - s.d $f20, 0x48($sp) - s.d $f22, 0x50($sp) - s.d $f24, 0x58($sp) - s.d $f26, 0x60($sp) - s.d $f28, 0x68($sp) - s.d $f30, 0x70($sp) - /* Set up a callback link on the stack. */ - subu $sp, $sp, 16 - lw $2, caml_bottom_of_stack - sw $2, 0($sp) - lw $3, caml_last_return_address - sw $3, 4($sp) - lw $4, caml_gc_regs - sw $4, 8($sp) - /* Set up a trap frame to catch exceptions escaping the Caml code */ - subu $sp, $sp, 16 - lw $30, caml_exception_pointer - sw $30, 0($sp) - la $2, $105 - sw $2, 4($sp) - sw $gp, 8($sp) - move $30, $sp - /* Reload allocation pointers */ - lw $22, caml_young_ptr - lw $23, caml_young_limit - /* Say that we are back into Caml code */ - sw $0, caml_last_return_address - /* Call the Caml code */ - move $25, $24 - jal $24 -$104: - /* Pop the trap frame, restoring caml_exception_pointer */ - lw $24, 0($sp) - sw $24, caml_exception_pointer - addu $sp, $sp, 16 -$106: - /* Pop the callback link, restoring the global variables */ - lw $24, 0($sp) - sw $24, caml_bottom_of_stack - lw $25, 4($sp) - sw $25, caml_last_return_address - lw $24, 8($sp) - sw $24, caml_gc_regs - addu $sp, $sp, 16 - /* Update allocation pointer */ - sw $22, caml_young_ptr - /* Reload callee-save registers and return */ - ld $31, 0x88($sp) - ld $16, 0x0($sp) - ld $17, 0x8($sp) - ld $18, 0x10($sp) - ld $19, 0x18($sp) - ld $20, 0x20($sp) - ld $21, 0x28($sp) - ld $22, 0x30($sp) - ld $23, 0x38($sp) - ld $30, 0x40($sp) - l.d $f20, 0x48($sp) - l.d $f22, 0x50($sp) - l.d $f24, 0x58($sp) - l.d $f26, 0x60($sp) - l.d $f28, 0x68($sp) - l.d $f30, 0x70($sp) - .cpreturn - addu $sp, $sp, 0x90 - j $31 - - /* The trap handler: encode exception bucket as an exception result - and return it */ -$105: - sw $30, caml_exception_pointer - or $2, $2, 2 - b $106 - - .end caml_start_program - -/* Raise an exception from C */ - - .globl caml_raise_exception - .ent caml_raise_exception -caml_raise_exception: - /* Setup $gp, discarding caller's $gp (we won't return) */ - .cpsetup $25, $24, caml_raise_exception - /* Branch to exn handler */ - move $2, $4 - lw $22, caml_young_ptr - lw $23, caml_young_limit - lw $sp, caml_exception_pointer - lw $30, 0($sp) - lw $24, 4($sp) - lw $gp, 8($sp) - addu $sp, $sp, 16 - j $24 - - .end caml_raise_exception - -/* Callback from C to Caml */ - - .globl caml_callback_exn - .ent caml_callback_exn -caml_callback_exn: - subu $sp, $sp, 0x90 - .cpsetup $25, 0x80, caml_callback_exn - /* Initial shuffling of arguments */ - move $9, $4 /* closure */ - move $8, $5 /* argument */ - lw $24, 0($4) /* code pointer */ - b $103 - .end caml_callback_exn - - .globl caml_callback2_exn - .ent caml_callback2_exn -caml_callback2_exn: - subu $sp, $sp, 0x90 - .cpsetup $25, 0x80, caml_callback2_exn - /* Initial shuffling of arguments */ - move $10, $4 /* closure */ - move $8, $5 /* first argument */ - move $9, $6 /* second argument */ - la $24, caml_apply2 /* code pointer */ - b $103 - - .end caml_callback2_exn - - .globl caml_callback3_exn - .ent caml_callback3_exn -caml_callback3_exn: - subu $sp, $sp, 0x90 - .cpsetup $25, 0x80, caml_callback3_exn - /* Initial shuffling of arguments */ - move $11, $4 /* closure */ - move $8, $5 /* first argument */ - move $9, $6 /* second argument */ - move $10, $7 /* third argument */ - la $24, caml_apply3 /* code pointer */ - b $103 - - .end caml_callback3_exn - -/* Glue code to call [caml_array_bound_error] */ - - .globl caml_ml_array_bound_error - .ent caml_ml_array_bound_error - -caml_ml_array_bound_error: - /* Setup $gp, discarding caller's $gp (we won't return) */ - .cpsetup $25, $24, caml_ml_array_bound_error - la $24, caml_array_bound_error - jal caml_c_call /* never returns */ - - .end caml_ml_array_bound_error - - .rdata - .globl caml_system__frametable -caml_system__frametable: - .word 1 /* one descriptor */ - .word $104 /* return address into callback */ - .half -1 /* negative frame size => use callback link */ - .half 0 /* no roots here */ diff -Nru ocaml-3.12.1/asmrun/natdynlink.c ocaml-4.01.0/asmrun/natdynlink.c --- ocaml-3.12.1/asmrun/natdynlink.c 2008-04-22 12:24:10.000000000 +0000 +++ ocaml-4.01.0/asmrun/natdynlink.c 2012-08-01 15:37:29.000000000 +0000 @@ -1,10 +1,23 @@ +/***********************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Alain Frisch, projet Gallium, INRIA Rocquencourt */ +/* */ +/* Copyright 2007 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../LICENSE. */ +/* */ +/***********************************************************************/ + #include "misc.h" #include "mlvalues.h" #include "memory.h" #include "stack.h" #include "callback.h" #include "alloc.h" -#include "natdynlink.h" +#include "intext.h" #include "osdeps.h" #include "fail.h" @@ -61,6 +74,7 @@ CAMLparam1 (symbol); CAMLlocal1 (result); void *sym,*sym2; + struct code_fragment * cf; #define optsym(n) getsym(handle,unit,n) char *unit; @@ -81,8 +95,14 @@ sym = optsym("__code_begin"); sym2 = optsym("__code_end"); - if (NULL != sym && NULL != sym2) + if (NULL != sym && NULL != sym2) { caml_page_table_add(In_code_area, sym, sym2); + cf = caml_stat_alloc(sizeof(struct code_fragment)); + cf->code_start = (char *) sym; + cf->code_end = (char *) sym2; + cf->digest_computed = 0; + caml_ext_table_add(&caml_code_fragments_table, cf); + } entrypoint = optsym("__entry"); if (NULL != entrypoint) result = caml_callback((value)(&entrypoint), 0); diff -Nru ocaml-3.12.1/asmrun/power-aix.S ocaml-4.01.0/asmrun/power-aix.S --- ocaml-3.12.1/asmrun/power-aix.S 2004-01-03 12:51:20.000000000 +0000 +++ ocaml-4.01.0/asmrun/power-aix.S 1970-01-01 00:00:00.000000000 +0000 @@ -1,513 +0,0 @@ -#********************************************************************* -#* * -#* Objective Caml * -#* * -#* Xavier Leroy, projet Cristal, INRIA Rocquencourt * -#* * -#* Copyright 1996 Institut National de Recherche en Informatique et * -#* en Automatique. All rights reserved. This file is distributed * -#* under the terms of the GNU Library General Public License, with * -#* the special exception on linking described in file ../LICENSE. * -#* * -#********************************************************************* - -# $Id: power-aix.S 6050 2004-01-03 12:51:20Z doligez $ - - .csect .text[PR] - -#### Invoke the garbage collector. r0 contains the return address - - .globl .caml_call_gc -.caml_call_gc: - # Set up stack frame - stwu 1, -0x1C0(1) - # 0x1C0 = 4*32 (int regs) + 8*32 (float regs) + 64 (space for C call) - # Record last return address into Caml code - lwz 11, L..caml_last_return_address(2) - stw 0, 0(11) - # Record return address into call_gc stub code - mflr 0 - stw 0, 0x1C0+8(1) - # Record lowest stack address - lwz 11, L..caml_bottom_of_stack(2) - addi 0, 1, 0x1C0 - stw 0, 0(11) - # Record pointer to register array - lwz 11, L..caml_gc_regs(2) - addi 0, 1, 8*32 + 64 - stw 0, 0(11) - # Save current allocation pointer for debugging purposes - lwz 11, L..caml_young_ptr(2) - stw 31, 0(11) - # Save exception pointer (if e.g. a sighandler raises) - lwz 11, L..caml_exception_pointer(2) - stw 29, 0(11) - # Save all registers used by the code generator - addi 11, 1, 8*32 + 64 - 4 - stwu 3, 4(11) - stwu 4, 4(11) - stwu 5, 4(11) - stwu 6, 4(11) - stwu 7, 4(11) - stwu 8, 4(11) - stwu 9, 4(11) - stwu 10, 4(11) - stwu 14, 4(11) - stwu 15, 4(11) - stwu 16, 4(11) - stwu 17, 4(11) - stwu 18, 4(11) - stwu 19, 4(11) - stwu 20, 4(11) - stwu 21, 4(11) - stwu 22, 4(11) - stwu 23, 4(11) - stwu 24, 4(11) - stwu 25, 4(11) - stwu 26, 4(11) - stwu 27, 4(11) - stwu 28, 4(11) - addi 11, 1, 64 - 8 - stfdu 1, 8(11) - stfdu 2, 8(11) - stfdu 3, 8(11) - stfdu 4, 8(11) - stfdu 5, 8(11) - stfdu 6, 8(11) - stfdu 7, 8(11) - stfdu 8, 8(11) - stfdu 9, 8(11) - stfdu 10, 8(11) - stfdu 11, 8(11) - stfdu 12, 8(11) - stfdu 13, 8(11) - stfdu 14, 8(11) - stfdu 15, 8(11) - stfdu 16, 8(11) - stfdu 17, 8(11) - stfdu 18, 8(11) - stfdu 19, 8(11) - stfdu 20, 8(11) - stfdu 21, 8(11) - stfdu 22, 8(11) - stfdu 23, 8(11) - stfdu 24, 8(11) - stfdu 25, 8(11) - stfdu 26, 8(11) - stfdu 27, 8(11) - stfdu 28, 8(11) - stfdu 29, 8(11) - stfdu 30, 8(11) - stfdu 31, 8(11) - # Call the GC - bl .caml_garbage_collection - or 0, 0, 0 - # Reload new allocation pointer and allocation limit - lwz 11, L..caml_young_ptr(2) - lwz 31, 0(11) - lwz 11, L..caml_young_limit(2) - lwz 30, 0(11) - # Restore all regs used by the code generator - addi 11, 1, 8*32 + 64 - 4 - lwzu 3, 4(11) - lwzu 4, 4(11) - lwzu 5, 4(11) - lwzu 6, 4(11) - lwzu 7, 4(11) - lwzu 8, 4(11) - lwzu 9, 4(11) - lwzu 10, 4(11) - lwzu 14, 4(11) - lwzu 15, 4(11) - lwzu 16, 4(11) - lwzu 17, 4(11) - lwzu 18, 4(11) - lwzu 19, 4(11) - lwzu 20, 4(11) - lwzu 21, 4(11) - lwzu 22, 4(11) - lwzu 23, 4(11) - lwzu 24, 4(11) - lwzu 25, 4(11) - lwzu 26, 4(11) - lwzu 27, 4(11) - lwzu 28, 4(11) - addi 11, 1, 64 - 8 - lfdu 1, 8(11) - lfdu 2, 8(11) - lfdu 3, 8(11) - lfdu 4, 8(11) - lfdu 5, 8(11) - lfdu 6, 8(11) - lfdu 7, 8(11) - lfdu 8, 8(11) - lfdu 9, 8(11) - lfdu 10, 8(11) - lfdu 11, 8(11) - lfdu 12, 8(11) - lfdu 13, 8(11) - lfdu 14, 8(11) - lfdu 15, 8(11) - lfdu 16, 8(11) - lfdu 17, 8(11) - lfdu 18, 8(11) - lfdu 19, 8(11) - lfdu 20, 8(11) - lfdu 21, 8(11) - lfdu 22, 8(11) - lfdu 23, 8(11) - lfdu 24, 8(11) - lfdu 25, 8(11) - lfdu 26, 8(11) - lfdu 27, 8(11) - lfdu 28, 8(11) - lfdu 29, 8(11) - lfdu 30, 8(11) - lfdu 31, 8(11) - # Return to caller (the stub code), leaving return address into - # Caml code in the link register - lwz 0, 0x1C0+8(1) - mtctr 0 - lwz 11, L..caml_last_return_address(2) - lwz 0, 0(11) - addic 0, 0, -16 # Restart the allocation (4 instructions) - mtlr 0 - # Say we are back into Caml code - li 12, 0 - stw 12, 0(11) # 11 still points to caml_last_return_address - # Deallocate stack frame - addi 1, 1, 0x1C0 - # Return - bctr - -#### Call a C function from Caml - - .globl .caml_c_call -.caml_c_call: - # Save return address in 25 - mflr 25 - # Record lowest stack address and return address - lwz 27, L..caml_bottom_of_stack(2) - lwz 24, L..caml_last_return_address(2) - stw 1, 0(27) - stw 25, 0(24) - # Make the exception handler and alloc ptr available to the C code - lwz 27, L..caml_young_ptr(2) - lwz 26, L..caml_exception_pointer(2) - stw 31, 0(27) - stw 29, 0(26) - # Preserve RTOC and return address in callee-save registers - # The C function will preserve them, and the Caml code does not - # expect them to be preserved - # Return address is in 25, RTOC is in 26, pointer to caml_young_ptr in 27, - # pointer to caml_last_return_address is in 24 - # Call the function (descriptor in 11) - lwz 0, 0(11) - mr 26, 2 - mtlr 0 - lwz 2, 4(11) - lwz 11, 8(11) - blrl - # Restore return address - mtlr 25 - # Restore RTOC - mr 2, 26 - # Reload allocation pointer - lwz 31, 0(27) # 27 still points to caml_young_ptr - # Say we are back into Caml code - li 12, 0 - stw 12, 0(24) # 24 still points to caml_last_return_address - # Return to caller - blr - -#### Raise an exception from C - - .globl .caml_raise_exception -.caml_raise_exception: - # Reload Caml global registers - lwz 4, L..caml_exception_pointer(2) - lwz 5, L..caml_young_ptr(2) - lwz 6, L..caml_young_limit(2) - lwz 1, 0(4) - lwz 31, 0(5) - lwz 30, 0(6) - # Say we are back into Caml code - lwz 4, L..caml_last_return_address(2) - li 0, 0 - stw 0, 0(4) - # Pop trap frame - lwz 0, 0(1) - lwz 29, 4(1) - mtlr 0 - lwz 2, 20(1) - addi 1, 1, 32 - # Branch to handler - blr - -#### Start the Caml program - - .globl .caml_start_program -.caml_start_program: - lwz 11, L..caml_program(2) - -#### Code shared between caml_start_program and caml_callback* - -L..102: - mflr 0 - # Save return address - stw 0, 8(1) - # Save all callee-save registers - stw 13, -76(1) - stw 14, -72(1) - stw 15, -68(1) - stw 16, -64(1) - stw 17, -60(1) - stw 18, -56(1) - stw 19, -52(1) - stw 20, -48(1) - stw 21, -44(1) - stw 22, -40(1) - stw 23, -36(1) - stw 24, -32(1) - stw 25, -28(1) - stw 26, -24(1) - stw 27, -20(1) - stw 28, -16(1) - stw 29, -12(1) - stw 30, -8(1) - stw 31, -4(1) - stfd 14, -224(1) - stfd 15, -216(1) - stfd 16, -208(1) - stfd 17, -200(1) - stfd 18, -192(1) - stfd 19, -184(1) - stfd 20, -176(1) - stfd 21, -168(1) - stfd 22, -160(1) - stfd 23, -152(1) - stfd 24, -144(1) - stfd 25, -136(1) - stfd 26, -128(1) - stfd 27, -120(1) - stfd 28, -112(1) - stfd 29, -104(1) - stfd 30, -96(1) - stfd 31, -88(1) - # Allocate and link stack frame - stwu 1, -288(1) - # Set up a callback link - addi 1, 1, -32 - lwz 9, L..caml_bottom_of_stack(2) - lwz 10, L..caml_last_return_address(2) - lwz 12, L..caml_gc_regs(2) - lwz 9, 0(9) - lwz 10, 0(10) - lwz 12, 0(12) - stw 9, 0(1) - stw 10, 4(1) - stw 12, 8(1) - # Build an exception handler to catch exceptions escaping out of Caml - bl L..103 - b L..104 -L..103: - addi 1, 1, -32 - lwz 9, L..caml_exception_pointer(2) - mflr 0 - lwz 29, 0(9) - stw 0, 0(1) - stw 29, 4(1) - stw 2, 20(1) - mr 29, 1 - # Reload allocation pointers - lwz 9, L..caml_young_ptr(2) - lwz 10, L..caml_young_limit(2) - lwz 31, 0(9) - lwz 30, 0(10) - # Say we are back into Caml code - lwz 9, L..caml_last_return_address(2) - li 0, 0 - stw 0, 0(9) - # Call the Caml code - lwz 0, 0(11) - stw 2, 20(1) - mtlr 0 - lwz 2, 4(11) -L..105: - blrl - lwz 2, 20(1) - # Pop the trap frame, restoring caml_exception_pointer - lwz 9, 4(1) - lwz 10, L..caml_exception_pointer(2) - addi 1, 1, 32 - stw 9, 0(10) - # Pop the callback link, restoring the global variables -L..106: - lwz 7, 0(1) - lwz 8, 4(1) - lwz 9, 8(1) - lwz 10, L..caml_bottom_of_stack(2) - lwz 11, L..caml_last_return_address(2) - lwz 12, L..caml_gc_regs(2) - stw 7, 0(10) - stw 8, 0(11) - stw 9, 0(12) - addi 1, 1, 32 - # Update allocation pointer - lwz 11, L..caml_young_ptr(2) - stw 31, 0(11) - # Deallocate stack frame - addi 1, 1, 288 - # Restore callee-save registers - lwz 13, -76(1) - lwz 14, -72(1) - lwz 15, -68(1) - lwz 16, -64(1) - lwz 17, -60(1) - lwz 18, -56(1) - lwz 19, -52(1) - lwz 20, -48(1) - lwz 21, -44(1) - lwz 22, -40(1) - lwz 23, -36(1) - lwz 24, -32(1) - lwz 25, -28(1) - lwz 26, -24(1) - lwz 27, -20(1) - lwz 28, -16(1) - lwz 29, -12(1) - lwz 30, -8(1) - lwz 31, -4(1) - lfd 14, -224(1) - lfd 15, -216(1) - lfd 16, -208(1) - lfd 17, -200(1) - lfd 18, -192(1) - lfd 19, -184(1) - lfd 20, -176(1) - lfd 21, -168(1) - lfd 22, -160(1) - lfd 23, -152(1) - lfd 24, -144(1) - lfd 25, -136(1) - lfd 26, -128(1) - lfd 27, -120(1) - lfd 28, -112(1) - lfd 29, -104(1) - lfd 30, -96(1) - lfd 31, -88(1) - # Reload return address - lwz 0, 8(1) - mtlr 0 - # Return - blr - # The trap handler: -L..104: - # Update caml_exception_pointer - lwz 9, L..caml_exception_pointer(2) - stw 29, 0(9) - # Encode exception bucket as an exception result and return it - ori 3, 3, 2 - b L..106 - -#### Callback from C to Caml - - .globl .caml_callback_exn -.caml_callback_exn: - # Initial shuffling of arguments - mr 0, 3 # Closure - mr 3, 4 # Argument - mr 4, 0 - lwz 11, 0(4) # Code pointer - b L..102 - - .globl .caml_callback2_exn -.caml_callback2_exn: - mr 0, 3 # Closure - mr 3, 4 # First argument - mr 4, 5 # Second argument - mr 5, 0 - lwz 11, L..caml_apply2(2) - b L..102 - - .globl .caml_callback3_exn -.caml_callback3_exn: - mr 0, 3 # Closure - mr 3, 4 # First argument - mr 4, 5 # Second argument - mr 5, 6 # Third argument - mr 6, 0 - lwz 11, L..caml_apply3(2) - b L..102 - -#### Frame table - - .csect .data[RW] - .globl caml_system__frametable -caml_system__frametable: - .long 1 # one descriptor - .long L..105 + 4 # return address into callback - .short -1 # negative size count => use callback link - .short 0 # no roots here - -#### TOC entries - - .toc -L..caml_young_limit: - .tc caml_young_limit[TC], caml_young_limit -L..caml_young_ptr: - .tc caml_young_ptr[TC], caml_young_ptr -L..caml_bottom_of_stack: - .tc caml_bottom_of_stack[TC], caml_bottom_of_stack -L..caml_last_return_address: - .tc caml_last_return_address[TC], caml_last_return_address -L..caml_gc_regs: - .tc caml_gc_regs[TC], caml_gc_regs -L..caml_exception_pointer: - .tc caml_exception_pointer[TC], caml_exception_pointer -L..gc_entry_regs: - .tc gc_entry_regs[TC], gc_entry_regs -L..gc_entry_float_regs: - .tc gc_entry_float_regs[TC], gc_entry_float_regs -L..caml_program: - .tc caml_program[TC], caml_program -L..caml_apply2: - .tc caml_apply2[TC], caml_apply2 -L..caml_apply3: - .tc caml_apply3[TC], caml_apply3 - -#### Function closures - - .csect caml_call_gc[DS] -caml_call_gc: - .long .caml_call_gc, TOC[tc0], 0 - - .globl caml_c_call - .csect caml_c_call[DS] -caml_c_call: - .long .caml_c_call, TOC[tc0], 0 - - .globl caml_raise_exception - .csect caml_raise_exception[DS] -caml_raise_exception: - .long .caml_raise_exception, TOC[tc0], 0 - - .globl caml_start_program - .csect caml_start_program[DS] -caml_start_program: - .long .caml_start_program, TOC[tc0], 0 - - .globl caml_callback_exn - .csect caml_callback_exn[DS] -caml_callback_exn: - .long .caml_callback_exn, TOC[tc0], 0 - - .globl caml_callback2_exn - .csect caml_callback2_exn[DS] -caml_callback2_exn: - .long .caml_callback2_exn, TOC[tc0], 0 - - .globl caml_callback3_exn - .csect caml_callback3_exn[DS] -caml_callback3_exn: - .long .caml_callback3_exn, TOC[tc0], 0 diff -Nru ocaml-3.12.1/asmrun/power-elf.S ocaml-4.01.0/asmrun/power-elf.S --- ocaml-3.12.1/asmrun/power-elf.S 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/asmrun/power-elf.S 2012-10-15 17:50:56.000000000 +0000 @@ -1,17 +1,15 @@ -/*********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../LICENSE. */ -/* */ -/*********************************************************************/ - -/* $Id: power-elf.S 9547 2010-01-22 12:48:24Z doligez $ */ +/***********************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../LICENSE. */ +/* */ +/***********************************************************************/ #define Addrglobal(reg,glob) \ addis reg, 0, glob@ha; \ @@ -27,13 +25,16 @@ /* Invoke the garbage collector. */ + .globl caml_system__code_begin +caml_system__code_begin: + .globl caml_call_gc .type caml_call_gc, @function caml_call_gc: /* Set up stack frame */ stwu 1, -0x1A0(1) /* 0x1A0 = 4*32 (int regs) + 8*32 (float regs) + 32 (space for C call) */ - /* Record return address into Caml code */ + /* Record return address into OCaml code */ mflr 0 Storeglobal(0, caml_last_return_address, 11) /* Record lowest stack address */ @@ -169,7 +170,7 @@ Loadglobal(0, caml_last_return_address, 11) addic 0, 0, -16 /* Restart the allocation (4 instructions) */ mtlr 0 - /* Say we are back into Caml code */ + /* Say we are back into OCaml code */ li 12, 0 Storeglobal(12, caml_last_return_address, 11) /* Deallocate stack frame */ @@ -177,7 +178,7 @@ /* Return */ blr -/* Call a C function from Caml */ +/* Call a C function from OCaml */ .globl caml_c_call .type caml_c_call, @function @@ -185,21 +186,21 @@ /* Save return address */ mflr 25 /* Get ready to call C function (address in 11) */ - mtlr 11 + mtctr 11 /* Record lowest stack address and return address */ Storeglobal(1, caml_bottom_of_stack, 12) Storeglobal(25, caml_last_return_address, 12) /* Make the exception handler and alloc ptr available to the C code */ Storeglobal(31, caml_young_ptr, 11) Storeglobal(29, caml_exception_pointer, 11) - /* Call the function (address in link register) */ - blrl + /* Call the function (address in CTR register) */ + bctrl /* Restore return address (in 25, preserved by the C function) */ mtlr 25 /* Reload allocation pointer and allocation limit*/ Loadglobal(31, caml_young_ptr, 11) Loadglobal(30, caml_young_limit, 11) - /* Say we are back into Caml code */ + /* Say we are back into OCaml code */ li 12, 0 Storeglobal(12, caml_last_return_address, 11) /* Return to caller */ @@ -210,11 +211,11 @@ .globl caml_raise_exception .type caml_raise_exception, @function caml_raise_exception: - /* Reload Caml global registers */ + /* Reload OCaml global registers */ Loadglobal(1, caml_exception_pointer, 11) Loadglobal(31, caml_young_ptr, 11) Loadglobal(30, caml_young_limit, 11) - /* Say we are back into Caml code */ + /* Say we are back into OCaml code */ li 0, 0 Storeglobal(0, caml_last_return_address, 11) /* Pop trap frame */ @@ -225,7 +226,7 @@ /* Branch to handler */ blr -/* Start the Caml program */ +/* Start the OCaml program */ .globl caml_start_program .type caml_start_program, @function @@ -287,7 +288,7 @@ stw 9, 0(1) stw 10, 4(1) stw 11, 8(1) - /* Build an exception handler to catch exceptions escaping out of Caml */ + /* Build an exception handler to catch exceptions escaping out of OCaml */ bl .L103 b .L104 .L103: @@ -300,10 +301,10 @@ /* Reload allocation pointers */ Loadglobal(31, caml_young_ptr, 11) Loadglobal(30, caml_young_limit, 11) - /* Say we are back into Caml code */ + /* Say we are back into OCaml code */ li 0, 0 Storeglobal(0, caml_last_return_address, 11) - /* Call the Caml code */ + /* Call the OCaml code */ mtlr 12 .L105: blrl @@ -375,7 +376,7 @@ ori 3, 3, 2 b .L106 -/* Callback from C to Caml */ +/* Callback from C to OCaml */ .globl caml_callback_exn .type caml_callback_exn, @function @@ -408,6 +409,9 @@ Addrglobal(12, caml_apply3) b .L102 + .globl caml_system__code_end +caml_system__code_end: + /* Frame table */ .section ".data" diff -Nru ocaml-3.12.1/asmrun/power-rhapsody.S ocaml-4.01.0/asmrun/power-rhapsody.S --- ocaml-3.12.1/asmrun/power-rhapsody.S 2007-01-29 12:11:18.000000000 +0000 +++ ocaml-4.01.0/asmrun/power-rhapsody.S 2012-10-15 17:50:56.000000000 +0000 @@ -1,17 +1,15 @@ -/*********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../LICENSE. */ -/* */ -/*********************************************************************/ - -/* $Id: power-rhapsody.S 7812 2007-01-29 12:11:18Z xleroy $ */ +/***********************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../LICENSE. */ +/* */ +/***********************************************************************/ #ifdef __ppc64__ #define X(a,b) b @@ -41,6 +39,9 @@ .text + .globl _caml_system__code_begin +_caml_system__code_begin: + /* Invoke the garbage collector. */ .globl _caml_call_gc @@ -48,12 +49,17 @@ /* Set up stack frame */ #define FRAMESIZE (32*WORD + 32*8 + 32) stwu r1, -FRAMESIZE(r1) - /* Record return address into Caml code */ + /* Record return address into OCaml code */ mflr r0 Storeglobal r0, _caml_last_return_address, r11 /* Record lowest stack address */ addi r0, r1, FRAMESIZE Storeglobal r0, _caml_bottom_of_stack, r11 + /* Touch the stack to trigger a recoverable segfault + if insufficient space remains */ + addi r1, r1, -4096*WORD + stg r0, 0(r1) + addi r1, r1, 4096*WORD /* Record pointer to register array */ addi r0, r1, 8*32 + 32 Storeglobal r0, _caml_gc_regs, r11 @@ -184,7 +190,7 @@ Loadglobal r0, _caml_last_return_address, r11 addic r0, r0, -16 /* Restart the allocation (4 instructions) */ mtlr r0 - /* Say we are back into Caml code */ + /* Say we are back into OCaml code */ li r12, 0 Storeglobal r12, _caml_last_return_address, r11 /* Deallocate stack frame */ @@ -193,7 +199,7 @@ blr #undef FRAMESIZE -/* Call a C function from Caml */ +/* Call a C function from OCaml */ .globl _caml_c_call _caml_c_call: @@ -204,6 +210,11 @@ /* Record lowest stack address and return address */ Storeglobal r1, _caml_bottom_of_stack, r12 Storeglobal r25, _caml_last_return_address, r12 + /* Touch the stack to trigger a recoverable segfault + if insufficient space remains */ + addi r1, r1, -4096*WORD + stg r0, 0(r1) + addi r1, r1, 4096*WORD /* Make the exception handler and alloc ptr available to the C code */ Storeglobal r31, _caml_young_ptr, r11 Storeglobal r29, _caml_exception_pointer, r11 @@ -214,13 +225,13 @@ /* Reload allocation pointer and allocation limit*/ Loadglobal r31, _caml_young_ptr, r11 Loadglobal r30, _caml_young_limit, r11 - /* Say we are back into Caml code */ + /* Say we are back into OCaml code */ li r12, 0 Storeglobal r12, _caml_last_return_address, r11 /* Return to caller */ blr -/* Raise an exception from Caml */ +/* Raise an exception from OCaml */ .globl _caml_raise_exn _caml_raise_exn: addis r11, 0, ha16(_caml_backtrace_active) @@ -257,11 +268,11 @@ cmpwi r11, 0 bne L112 L113: - /* Reload Caml global registers */ + /* Reload OCaml global registers */ Loadglobal r1, _caml_exception_pointer, r11 Loadglobal r31, _caml_young_ptr, r11 Loadglobal r30, _caml_young_limit, r11 - /* Say we are back into Caml code */ + /* Say we are back into OCaml code */ li r0, 0 Storeglobal r0, _caml_last_return_address, r11 /* Pop trap frame */ @@ -274,15 +285,15 @@ L112: mr r28, r3 /* preserve exn bucket in callee-save */ /* arg 1: exception bucket (already in r3) */ - Loadglobal r4, _caml_last_return_address, r11 /* arg 2: PC of raise */ - Loadglobal r5, _caml_bottom_of_stack, r11 /* arg 3: SP of raise */ + Loadglobal r4, _caml_last_return_address, r11 /* arg 2: PC of raise */ + Loadglobal r5, _caml_bottom_of_stack, r11 /* arg 3: SP of raise */ Loadglobal r6, _caml_exception_pointer, r11 /* arg 4: SP of handler */ addi r1, r1, -(16*WORD) /* reserve stack space for C call */ bl _caml_stash_backtrace mr r3, r28 b L113 -/* Start the Caml program */ +/* Start the OCaml program */ .globl _caml_start_program _caml_start_program: @@ -343,7 +354,7 @@ stg r9, 0(r1) stg r10, WORD(r1) stg r11, 2*WORD(r1) - /* Build an exception handler to catch exceptions escaping out of Caml */ + /* Build an exception handler to catch exceptions escaping out of OCaml */ bl L103 b L104 L103: @@ -356,10 +367,10 @@ /* Reload allocation pointers */ Loadglobal r31, _caml_young_ptr, r11 Loadglobal r30, _caml_young_limit, r11 - /* Say we are back into Caml code */ + /* Say we are back into OCaml code */ li r0, 0 Storeglobal r0, _caml_last_return_address, r11 - /* Call the Caml code */ + /* Call the OCaml code */ mtctr r12 L105: bctrl @@ -432,7 +443,7 @@ b L106 #undef FRAMESIZE -/* Callback from C to Caml */ +/* Callback from C to OCaml */ .globl _caml_callback_exn _caml_callback_exn: @@ -462,6 +473,9 @@ Addrglobal r12, _caml_apply3 b L102 + .globl _caml_system__code_end +_caml_system__code_end: + /* Frame table */ .const @@ -471,4 +485,4 @@ gdata L105 + 4 /* return address into callback */ .short -1 /* negative size count => use callback link */ .short 0 /* no roots here */ - .align X(2,3) + .align X(2,3) diff -Nru ocaml-3.12.1/asmrun/roots.c ocaml-4.01.0/asmrun/roots.c --- ocaml-3.12.1/asmrun/roots.c 2010-04-27 07:55:08.000000000 +0000 +++ ocaml-4.01.0/asmrun/roots.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: roots.c 10315 2010-04-27 07:55:08Z xleroy $ */ - /* To walk the memory roots for garbage collection */ #include "finalise.h" @@ -129,7 +127,7 @@ char * caml_top_of_stack; char * caml_bottom_of_stack = NULL; /* no stack initially */ -uintnat caml_last_return_address = 1; /* not in Caml code initially */ +uintnat caml_last_return_address = 1; /* not in OCaml code initially */ value * caml_gc_regs; intnat caml_globals_inited = 0; static intnat caml_globals_scanned = 0; @@ -369,5 +367,3 @@ sz += (*caml_stack_usage_hook)(); return sz; } - - diff -Nru ocaml-3.12.1/asmrun/signals_asm.c ocaml-4.01.0/asmrun/signals_asm.c --- ocaml-3.12.1/asmrun/signals_asm.c 2008-01-11 16:13:18.000000000 +0000 +++ ocaml-4.01.0/asmrun/signals_asm.c 2013-07-23 14:48:47.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Gallium, INRIA Rocquencourt */ /* */ @@ -11,14 +11,13 @@ /* */ /***********************************************************************/ -/* $Id: signals_asm.c 8768 2008-01-11 16:13:18Z doligez $ */ - /* Signal handling, code specific to the native-code compiler */ #if defined(TARGET_amd64) && defined (SYS_linux) #define _GNU_SOURCE #endif #include +#include #include #include "fail.h" #include "memory.h" @@ -46,14 +45,17 @@ #endif extern char * caml_code_area_start, * caml_code_area_end; +extern char caml_system__code_begin, caml_system__code_end; #define Is_in_code_area(pc) \ ( ((char *)(pc) >= caml_code_area_start && \ (char *)(pc) <= caml_code_area_end) \ - || (Classify_addr(pc) & In_code_area) ) +|| ((char *)(pc) >= &caml_system__code_begin && \ + (char *)(pc) <= &caml_system__code_end) \ +|| (Classify_addr(pc) & In_code_area) ) /* This routine is the common entry point for garbage collection - and signal handling. It can trigger a callback to Caml code. + and signal handling. It can trigger a callback to OCaml code. With system threads, this callback can cause a context switch. Hence [caml_garbage_collection] must not be called from regular C code (e.g. the [caml_alloc] function) because the context of the call @@ -72,6 +74,9 @@ DECLARE_SIGNAL_HANDLER(handle_signal) { + int saved_errno; + /* Save the value of errno (PR#5982). */ + saved_errno = errno; #if !defined(POSIX_SIGNALS) && !defined(BSD_SIGNALS) signal(sig, handle_signal); #endif @@ -83,12 +88,13 @@ caml_record_signal(sig); /* Some ports cache [caml_young_limit] in a register. Use the signal context to modify that register too, but only if - we are inside Caml code (not inside C code). */ + we are inside OCaml code (not inside C code). */ #if defined(CONTEXT_PC) && defined(CONTEXT_YOUNG_LIMIT) if (Is_in_code_area(CONTEXT_PC)) CONTEXT_YOUNG_LIMIT = (context_reg) caml_young_limit; #endif } + errno = saved_errno; } int caml_set_signal_action(int signo, int action) @@ -175,6 +181,19 @@ static char * system_stack_top; static char sig_alt_stack[SIGSTKSZ]; +#if defined(SYS_linux) +/* PR#4746: recent Linux kernels with support for stack randomization + silently add 2 Mb of stack space on top of RLIMIT_STACK. + 2 Mb = 0x200000, to which we add 8 kB (=0x2000) for overshoot. */ +#define EXTRA_STACK 0x202000 +#else +#define EXTRA_STACK 0x2000 +#endif + +#ifdef RETURN_AFTER_STACK_OVERFLOW +extern void caml_stack_overflow(void); +#endif + DECLARE_SIGNAL_HANDLER(segv_handler) { struct rlimit limit; @@ -184,29 +203,41 @@ /* Sanity checks: - faulting address is word-aligned - faulting address is within the stack - - we are in Caml code */ + - we are in OCaml code */ fault_addr = CONTEXT_FAULTING_ADDRESS; if (((uintnat) fault_addr & (sizeof(intnat) - 1)) == 0 && getrlimit(RLIMIT_STACK, &limit) == 0 && fault_addr < system_stack_top - && fault_addr >= system_stack_top - limit.rlim_cur - 0x2000 + && fault_addr >= system_stack_top - limit.rlim_cur - EXTRA_STACK #ifdef CONTEXT_PC && Is_in_code_area(CONTEXT_PC) #endif ) { - /* Turn this into a Stack_overflow exception */ +#ifdef RETURN_AFTER_STACK_OVERFLOW + /* Tweak the PC part of the context so that on return from this + handler, we jump to the asm function [caml_stack_overflow] + (from $ARCH.S). */ +#ifdef CONTEXT_PC + CONTEXT_PC = (context_reg) &caml_stack_overflow; +#else +#error "CONTEXT_PC must be defined if RETURN_AFTER_STACK_OVERFLOW is" +#endif +#else + /* Raise a Stack_overflow exception straight from this signal handler */ #if defined(CONTEXT_YOUNG_PTR) && defined(CONTEXT_EXCEPTION_POINTER) caml_exception_pointer = (char *) CONTEXT_EXCEPTION_POINTER; caml_young_ptr = (char *) CONTEXT_YOUNG_PTR; #endif caml_raise_stack_overflow(); +#endif + } else { + /* Otherwise, deactivate our exception handler and return, + causing fatal signal to be generated at point of error. */ + act.sa_handler = SIG_DFL; + act.sa_flags = 0; + sigemptyset(&act.sa_mask); + sigaction(SIGSEGV, &act, NULL); } - /* Otherwise, deactivate our exception handler and return, - causing fatal signal to be generated at point of error. */ - act.sa_handler = SIG_DFL; - act.sa_flags = 0; - sigemptyset(&act.sa_mask); - sigaction(SIGSEGV, &act, NULL); } #endif diff -Nru ocaml-3.12.1/asmrun/signals_osdep.h ocaml-4.01.0/asmrun/signals_osdep.h --- ocaml-3.12.1/asmrun/signals_osdep.h 2009-05-20 11:52:42.000000000 +0000 +++ ocaml-4.01.0/asmrun/signals_osdep.h 2013-06-24 08:16:27.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,30 +11,11 @@ /* */ /***********************************************************************/ -/* $Id: signals_osdep.h 9270 2009-05-20 11:52:42Z doligez $ */ - /* Processor- and OS-dependent signal interface */ -/****************** Alpha, all OS */ - -#if defined(TARGET_alpha) - - #define DECLARE_SIGNAL_HANDLER(name) \ - static void name(int sig, int code, struct sigcontext * context) - - #define SET_SIGACT(sigact,name) \ - sigact.sa_handler = (void (*)(int)) (name); \ - sigact.sa_flags = 0 - - typedef long context_reg; - #define CONTEXT_PC (context->sc_pc) - #define CONTEXT_EXCEPTION_POINTER (context->sc_regs[15]) - #define CONTEXT_YOUNG_LIMIT (context->sc_regs[13]) - #define CONTEXT_YOUNG_PTR (context->sc_regs[14]) - /****************** AMD64, Linux */ -#elif defined(TARGET_amd64) && defined (SYS_linux) +#if defined(TARGET_amd64) && defined (SYS_linux) #define DECLARE_SIGNAL_HANDLER(name) \ static void name(int sig, siginfo_t * info, ucontext_t * context) @@ -47,7 +28,7 @@ #define CONTEXT_PC (context->uc_mcontext.gregs[REG_RIP]) #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.gregs[REG_R14]) #define CONTEXT_YOUNG_PTR (context->uc_mcontext.gregs[REG_R15]) - #define CONTEXT_FAULTING_ADDRESS ((char *) context->uc_mcontext.gregs[REG_CR2]) + #define CONTEXT_FAULTING_ADDRESS ((char *)context->uc_mcontext.gregs[REG_CR2]) /****************** AMD64, MacOSX */ @@ -63,12 +44,14 @@ #include #include -#if !defined(MAC_OS_X_VERSION_10_5) || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5 + #if !defined(MAC_OS_X_VERSION_10_5) \ + || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5 #define CONTEXT_REG(r) r #else #define CONTEXT_REG(r) __##r #endif + typedef unsigned long long context_reg; #define CONTEXT_STATE (((ucontext_t *)context)->uc_mcontext->CONTEXT_REG(ss)) #define CONTEXT_PC (CONTEXT_STATE.CONTEXT_REG(rip)) #define CONTEXT_EXCEPTION_POINTER (CONTEXT_STATE.CONTEXT_REG(r14)) @@ -76,11 +59,25 @@ #define CONTEXT_SP (CONTEXT_STATE.CONTEXT_REG(rsp)) #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr) + #define RETURN_AFTER_STACK_OVERFLOW + /****************** ARM, Linux */ -#elif defined(TARGET_arm) && defined (SYS_linux) +#elif defined(TARGET_arm) && (defined(SYS_linux_eabi) \ + || defined(SYS_linux_eabihf)) - #include + #if defined(__ANDROID__) + // The Android NDK does not have sys/ucontext.h yet. + typedef struct ucontext { + uint32_t uc_flags; + struct ucontext *uc_link; + stack_t uc_stack; + struct sigcontext uc_mcontext; + // Other fields omitted... + } ucontext_t; + #else + #include + #endif #define DECLARE_SIGNAL_HANDLER(name) \ static void name(int sig, siginfo_t * info, ucontext_t * context) @@ -154,7 +151,8 @@ #include #include -#if !defined(MAC_OS_X_VERSION_10_5) || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5 + #if !defined(MAC_OS_X_VERSION_10_5) \ + || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5 #define CONTEXT_REG(r) r #else #define CONTEXT_REG(r) __##r @@ -177,23 +175,6 @@ #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr) -/****************** MIPS, all OS */ - -#elif defined(TARGET_mips) - - #define DECLARE_SIGNAL_HANDLER(name) \ - static void name(int sig, int code, struct sigcontext * context) - - #define SET_SIGACT(sigact,name) \ - sigact.sa_handler = (void (*)(int)) (name); \ - sigact.sa_flags = 0 - - typedef int context_reg; - #define CONTEXT_PC (context->sc_pc) - #define CONTEXT_EXCEPTION_POINTER (context->sc_regs[30]) - #define CONTEXT_YOUNG_LIMIT (context->sc_regs[22]) - #define CONTEXT_YOUNG_PTR (context->sc_regs[23]) - /****************** PowerPC, MacOS X */ #elif defined(TARGET_power) && defined(SYS_rhapsody) @@ -222,7 +203,8 @@ #define CONTEXT_MCONTEXT (((ucontext_t *)context)->uc_mcontext) #endif -#if !defined(MAC_OS_X_VERSION_10_5) || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5 + #if !defined(MAC_OS_X_VERSION_10_5) \ + || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5 #define CONTEXT_REG(r) r #else #define CONTEXT_REG(r) __##r @@ -255,7 +237,7 @@ /****************** PowerPC, BSD */ -#elif defined(TARGET_power) && defined(SYS_bsd) +#elif defined(TARGET_power) && (defined(SYS_bsd) || defined(SYS_bsd_elf)) #define DECLARE_SIGNAL_HANDLER(name) \ static void name(int sig, int code, struct sigcontext * context) diff -Nru ocaml-3.12.1/asmrun/sparc.S ocaml-4.01.0/asmrun/sparc.S --- ocaml-3.12.1/asmrun/sparc.S 2004-10-06 06:33:25.000000000 +0000 +++ ocaml-4.01.0/asmrun/sparc.S 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,65 +11,9 @@ /* */ /***********************************************************************/ -/* $Id: sparc.S 6631 2004-10-06 06:33:25Z garrigue $ */ - /* Asm part of the runtime system for the Sparc processor. */ /* Must be preprocessed by cpp */ -/* SunOS 4 prefixes identifiers with _ */ - -#if defined(SYS_sunos) - -#define Caml_young_limit _caml_young_limit -#define Caml_young_ptr _caml_young_ptr -#define Caml_bottom_of_stack _caml_bottom_of_stack -#define Caml_last_return_address _caml_last_return_address -#define Caml_gc_regs _caml_gc_regs -#define Caml_exception_pointer _caml_exception_pointer -#define Caml_allocN _caml_allocN -#define Caml_call_gc _caml_call_gc -#define Caml_garbage_collection _caml_garbage_collection -#define Caml_c_call _caml_c_call -#define Caml_start_program _caml_start_program -#define Caml_program _caml_program -#define Caml_raise_exception _caml_raise_exception -#define Caml_callback_exn _caml_callback_exn -#define Caml_callback2_exn _caml_callback2_exn -#define Caml_callback3_exn _caml_callback3_exn -#define Caml_apply2 _caml_apply2 -#define Caml_apply3 _caml_apply3 -#define Caml_raise _caml_raise -#define Caml_system__frametable _caml_system__frametable -#define Caml_ml_array_bound_error _caml_ml_array_bound_error -#define Caml_array_bound_error _caml_array_bound_error - -#else - -#define Caml_young_limit caml_young_limit -#define Caml_young_ptr caml_young_ptr -#define Caml_bottom_of_stack caml_bottom_of_stack -#define Caml_last_return_address caml_last_return_address -#define Caml_gc_regs caml_gc_regs -#define Caml_exception_pointer caml_exception_pointer -#define Caml_allocN caml_allocN -#define Caml_call_gc caml_call_gc -#define Caml_garbage_collection caml_garbage_collection -#define Caml_c_call caml_c_call -#define Caml_start_program caml_start_program -#define Caml_program caml_program -#define Caml_raise_exception caml_raise_exception -#define Caml_callback_exn caml_callback_exn -#define Caml_callback2_exn caml_callback2_exn -#define Caml_callback3_exn caml_callback3_exn -#define Caml_apply2 caml_apply2 -#define Caml_apply3 caml_apply3 -#define Caml_raise caml_raise -#define Caml_system__frametable caml_system__frametable -#define Caml_ml_array_bound_error caml_ml_array_bound_error -#define Caml_array_bound_error caml_array_bound_error - -#endif - #ifndef SYS_solaris #define INDIRECT_LIMIT #endif @@ -85,11 +29,15 @@ /* Allocation functions */ .text - .global Caml_allocN - .global Caml_call_gc + + .global caml_system__code_begin +caml_system__code_begin: + + .global caml_allocN + .global caml_call_gc /* Required size in %g2 */ -Caml_allocN: +caml_allocN: #ifdef INDIRECT_LIMIT ld [Alloc_limit], %g1 sub Alloc_ptr, %g2, Alloc_ptr @@ -98,22 +46,22 @@ sub Alloc_ptr, %g2, Alloc_ptr cmp Alloc_ptr, Alloc_limit #endif - /*blu,pt %icc, Caml_call_gc*/ - blu Caml_call_gc + /*blu,pt %icc, caml_call_gc*/ + blu caml_call_gc nop retl nop /* Required size in %g2 */ -Caml_call_gc: +caml_call_gc: /* Save exception pointer if GC raises */ - Store(Exn_ptr, Caml_exception_pointer) + Store(Exn_ptr, caml_exception_pointer) /* Save current allocation pointer for debugging purposes */ - Store(Alloc_ptr, Caml_young_ptr) + Store(Alloc_ptr, caml_young_ptr) /* Record lowest stack address */ - Store(%sp, Caml_bottom_of_stack) + Store(%sp, caml_bottom_of_stack) /* Record last return address */ - Store(%o7, Caml_last_return_address) + Store(%o7, caml_last_return_address) /* Allocate space on stack for caml_context structure and float regs */ sub %sp, 20*4 + 15*8, %sp /* Save int regs on stack and save it into caml_gc_regs */ @@ -139,7 +87,7 @@ st %g4, [%g1 + 0x48] st %g2, [%g1 + 0x4C] /* Save required size */ mov %g1, %g2 - Store(%g2, Caml_gc_regs) + Store(%g2, caml_gc_regs) /* Save the floating-point registers */ add %sp, 96, %g1 std %f0, [%g1] @@ -158,7 +106,7 @@ std %f26, [%g1 + 0x68] std %f28, [%g1 + 0x70] /* Call the garbage collector */ - call Caml_garbage_collection + call caml_garbage_collection nop /* Restore all regs used by the code generator */ add %sp, 96 + 15*8, %g1 @@ -199,116 +147,116 @@ ldd [%g1 + 0x68], %f26 ldd [%g1 + 0x70], %f28 /* Reload alloc ptr */ - Load(Caml_young_ptr, Alloc_ptr) + Load(caml_young_ptr, Alloc_ptr) /* Allocate space for block */ #ifdef INDIRECT_LIMIT ld [Alloc_limit], %g1 sub Alloc_ptr, %g2, Alloc_ptr cmp Alloc_ptr, %g1 /* Check that we have enough free space */ #else - Load(Caml_young_limit,Alloc_limit) + Load(caml_young_limit,Alloc_limit) sub Alloc_ptr, %g2, Alloc_ptr cmp Alloc_ptr, Alloc_limit #endif blu L100 /* If not, call GC again */ nop /* Return to caller */ - Load(Caml_last_return_address, %o7) + Load(caml_last_return_address, %o7) retl add %sp, 20*4 + 15*8, %sp /* in delay slot */ -/* Call a C function from Caml */ +/* Call a C function from Ocaml */ - .global Caml_c_call + .global caml_c_call /* Function to call is in %g2 */ -Caml_c_call: +caml_c_call: /* Record lowest stack address and return address */ - Store(%sp, Caml_bottom_of_stack) - Store(%o7, Caml_last_return_address) + Store(%sp, caml_bottom_of_stack) + Store(%o7, caml_last_return_address) /* Save the exception handler and alloc pointer */ - Store(Exn_ptr, Caml_exception_pointer) - sethi %hi(Caml_young_ptr), %g1 + Store(Exn_ptr, caml_exception_pointer) + sethi %hi(caml_young_ptr), %g1 /* Call the C function */ call %g2 - st Alloc_ptr, [%g1 + %lo(Caml_young_ptr)] /* in delay slot */ + st Alloc_ptr, [%g1 + %lo(caml_young_ptr)] /* in delay slot */ /* Reload return address */ - Load(Caml_last_return_address, %o7) + Load(caml_last_return_address, %o7) /* Reload alloc pointer */ - sethi %hi(Caml_young_ptr), %g1 + sethi %hi(caml_young_ptr), %g1 /* Return to caller */ retl - ld [%g1 + %lo(Caml_young_ptr)], Alloc_ptr /* in delay slot */ + ld [%g1 + %lo(caml_young_ptr)], Alloc_ptr /* in delay slot */ -/* Start the Caml program */ +/* Start the Ocaml program */ - .global Caml_start_program -Caml_start_program: + .global caml_start_program +caml_start_program: /* Save all callee-save registers */ save %sp, -96, %sp /* Address of code to call */ - Address(Caml_program, %l2) + Address(caml_program, %l2) /* Code shared with caml_callback* */ L108: /* Set up a callback link on the stack. */ sub %sp, 16, %sp - Load(Caml_bottom_of_stack, %l0) - Load(Caml_last_return_address, %l1) - Load(Caml_gc_regs, %l3) + Load(caml_bottom_of_stack, %l0) + Load(caml_last_return_address, %l1) + Load(caml_gc_regs, %l3) st %l0, [%sp + 96] st %l1, [%sp + 100] - /* Set up a trap frame to catch exceptions escaping the Caml code */ + /* Set up a trap frame to catch exceptions escaping the Ocaml code */ call L111 st %l3, [%sp + 104] b L110 nop L111: sub %sp, 8, %sp - Load(Caml_exception_pointer, Exn_ptr) + Load(caml_exception_pointer, Exn_ptr) st %o7, [%sp + 96] st Exn_ptr, [%sp + 100] mov %sp, Exn_ptr /* Reload allocation pointers */ - Load(Caml_young_ptr, Alloc_ptr) + Load(caml_young_ptr, Alloc_ptr) #ifdef INDIRECT_LIMIT - Address(Caml_young_limit, Alloc_limit) + Address(caml_young_limit, Alloc_limit) #else - Load(Caml_young_limit, Alloc_limit) + Load(caml_young_limit, Alloc_limit) #endif - /* Call the Caml code */ + /* Call the Ocaml code */ L109: call %l2 nop /* Pop trap frame and restore caml_exception_pointer */ ld [%sp + 100], Exn_ptr add %sp, 8, %sp - Store(Exn_ptr, Caml_exception_pointer) + Store(Exn_ptr, caml_exception_pointer) /* Pop callback link, restoring the global variables */ L112: ld [%sp + 96], %l0 ld [%sp + 100], %l1 ld [%sp + 104], %l2 - Store(%l0, Caml_bottom_of_stack) - Store(%l1, Caml_last_return_address) - Store(%l2, Caml_gc_regs) + Store(%l0, caml_bottom_of_stack) + Store(%l1, caml_last_return_address) + Store(%l2, caml_gc_regs) add %sp, 16, %sp /* Save allocation pointer */ - Store(Alloc_ptr, Caml_young_ptr) + Store(Alloc_ptr, caml_young_ptr) /* Reload callee-save registers and return */ ret restore %o0, 0, %o0 /* copy %o0 in this window to caller's %o0 */ L110: /* The trap handler */ - Store(Exn_ptr, Caml_exception_pointer) + Store(Exn_ptr, caml_exception_pointer) /* Encode exception bucket as an exception result */ b L112 or %o0, 2, %o0 /* Raise an exception from C */ - .global Caml_raise_exception -Caml_raise_exception: + .global caml_raise_exception +caml_raise_exception: /* Save exception bucket in a register outside the reg windows */ mov %o0, %g2 /* Load exception pointer in a register outside the reg windows */ - Load(Caml_exception_pointer, %g3) + Load(caml_exception_pointer, %g3) /* Pop some frames until the trap pointer is in the current frame. */ cmp %g3, %fp blt L107 /* if Exn_ptr < %fp, over */ @@ -319,11 +267,11 @@ nop L107: /* Reload allocation registers */ - Load(Caml_young_ptr, Alloc_ptr) + Load(caml_young_ptr, Alloc_ptr) #ifdef INDIRECT_LIMIT - Address(Caml_young_limit, Alloc_limit) + Address(caml_young_limit, Alloc_limit) #else - Load(Caml_young_limit, Alloc_limit) + Load(caml_young_limit, Alloc_limit) #endif /* Branch to exception handler */ mov %g3, %sp @@ -336,8 +284,8 @@ /* Callbacks C -> ML */ - .global Caml_callback_exn -Caml_callback_exn: + .global caml_callback_exn +caml_callback_exn: /* Save callee-save registers and return address */ save %sp, -96, %sp /* Initial shuffling of arguments */ @@ -347,8 +295,8 @@ b L108 ld [%g1], %l2 /* code pointer */ - .global Caml_callback2_exn -Caml_callback2_exn: + .global caml_callback2_exn +caml_callback2_exn: /* Save callee-save registers and return address */ save %sp, -104, %sp /* Initial shuffling of arguments */ @@ -356,12 +304,12 @@ mov %i1, %i0 /* first arg */ mov %i2, %i1 /* second arg */ mov %g1, %i2 /* environment */ - sethi %hi(Caml_apply2), %l2 + sethi %hi(caml_apply2), %l2 b L108 - or %l2, %lo(Caml_apply2), %l2 + or %l2, %lo(caml_apply2), %l2 - .global Caml_callback3_exn -Caml_callback3_exn: + .global caml_callback3_exn +caml_callback3_exn: /* Save callee-save registers and return address */ save %sp, -104, %sp /* Initial shuffling of arguments */ @@ -370,38 +318,41 @@ mov %i2, %i1 /* second arg */ mov %i3, %i2 /* third arg */ mov %g1, %i3 /* environment */ - sethi %hi(Caml_apply3), %l2 + sethi %hi(caml_apply3), %l2 b L108 - or %l2, %lo(Caml_apply3), %l2 + or %l2, %lo(caml_apply3), %l2 #ifndef SYS_solaris /* Glue code to call [caml_array_bound_error] */ - .global Caml_ml_array_bound_error -Caml_ml_array_bound_error: - Address(Caml_array_bound_error, %g2) - b Caml_c_call + .global caml_ml_array_bound_error +caml_ml_array_bound_error: + Address(caml_array_bound_error, %g2) + b caml_c_call nop #endif + .global caml_system__code_end +caml_system__code_end: + #ifdef SYS_solaris .section ".rodata" #else .data #endif - .global Caml_system__frametable + .global caml_system__frametable .align 4 /* required for gas? */ -Caml_system__frametable: +caml_system__frametable: .word 1 /* one descriptor */ .word L109 /* return address into callback */ .half -1 /* negative frame size => use callback link */ .half 0 /* no roots */ #ifdef SYS_solaris - .type Caml_allocN, #function - .type Caml_call_gc, #function - .type Caml_c_call, #function - .type Caml_start_program, #function - .type Caml_raise_exception, #function - .type Caml_system__frametable, #object + .type caml_allocN, #function + .type caml_call_gc, #function + .type caml_c_call, #function + .type caml_start_program, #function + .type caml_raise_exception, #function + .type caml_system__frametable, #object #endif diff -Nru ocaml-3.12.1/asmrun/stack.h ocaml-4.01.0/asmrun/stack.h --- ocaml-3.12.1/asmrun/stack.h 2010-04-27 07:55:08.000000000 +0000 +++ ocaml-4.01.0/asmrun/stack.h 2013-03-09 22:38:52.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,21 +11,12 @@ /* */ /***********************************************************************/ -/* $Id: stack.h 10315 2010-04-27 07:55:08Z xleroy $ */ - /* Machine-dependent interface with the asm code */ #ifndef CAML_STACK_H #define CAML_STACK_H /* Macros to access the stack frame */ -#ifdef TARGET_alpha -#define Saved_return_address(sp) *((intnat *)((sp) - 8)) -#define Already_scanned(sp, retaddr) ((retaddr) & 1L) -#define Mark_scanned(sp, retaddr) (*((intnat *)((sp) - 8)) = (retaddr) | 1L) -#define Mask_already_scanned(retaddr) ((retaddr) & ~1L) -#define Callback_link(sp) ((struct caml_context *)((sp) + 16)) -#endif #ifdef TARGET_sparc #define Saved_return_address(sp) *((intnat *)((sp) + 92)) @@ -41,21 +32,11 @@ #endif #endif -#ifdef TARGET_mips -#define Saved_return_address(sp) *((intnat *)((sp) - 4)) -#define Callback_link(sp) ((struct caml_context *)((sp) + 16)) -#endif - -#ifdef TARGET_hppa -#define Stack_grows_upwards -#define Saved_return_address(sp) *((intnat *)(sp)) -#define Callback_link(sp) ((struct caml_context *)((sp) - 24)) -#endif - #ifdef TARGET_power #define Saved_return_address(sp) *((intnat *)((sp) - SIZEOF_PTR)) #define Already_scanned(sp, retaddr) ((retaddr) & 1) -#define Mark_scanned(sp, retaddr) (*((intnat *)((sp) - SIZEOF_PTR)) = (retaddr) | 1) +#define Mark_scanned(sp, retaddr) \ + (*((intnat *)((sp) - SIZEOF_PTR)) = (retaddr) | 1) #define Mask_already_scanned(retaddr) ((retaddr) & ~1) #ifdef SYS_aix #define Trap_frame_size 32 @@ -65,34 +46,21 @@ #define Callback_link(sp) ((struct caml_context *)((sp) + Trap_frame_size)) #endif -#ifdef TARGET_m68k -#define Saved_return_address(sp) *((intnat *)((sp) - 4)) -#define Callback_link(sp) ((struct caml_context *)((sp) + 8)) -#endif - #ifdef TARGET_arm #define Saved_return_address(sp) *((intnat *)((sp) - 4)) #define Callback_link(sp) ((struct caml_context *)((sp) + 8)) #endif -#ifdef TARGET_ia64 -#define Saved_return_address(sp) *((intnat *)((sp) + 8)) -#define Already_scanned(sp, retaddr) ((retaddr) & 1L) -#define Mark_scanned(sp, retaddr) (*((intnat *)((sp) + 8)) = (retaddr) | 1L) -#define Mask_already_scanned(retaddr) ((retaddr) & ~1L) -#define Callback_link(sp) ((struct caml_context *)((sp) + 32)) -#endif - #ifdef TARGET_amd64 #define Saved_return_address(sp) *((intnat *)((sp) - 8)) #define Callback_link(sp) ((struct caml_context *)((sp) + 16)) #endif -/* Structure of Caml callback contexts */ +/* Structure of OCaml callback contexts */ struct caml_context { - char * bottom_of_stack; /* beginning of Caml stack chunk */ - uintnat last_retaddr; /* last return address in Caml code */ + char * bottom_of_stack; /* beginning of OCaml stack chunk */ + uintnat last_retaddr; /* last return address in OCaml code */ value * gc_regs; /* pointer to register block */ }; diff -Nru ocaml-3.12.1/asmrun/startup.c ocaml-4.01.0/asmrun/startup.c --- ocaml-3.12.1/asmrun/startup.c 2010-04-27 07:55:08.000000000 +0000 +++ ocaml-4.01.0/asmrun/startup.c 2013-03-09 22:38:52.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: startup.c 10315 2010-04-27 07:55:08Z xleroy $ */ - /* Start-up code */ #include @@ -20,10 +18,12 @@ #include "callback.h" #include "backtrace.h" #include "custom.h" +#include "debugger.h" #include "fail.h" #include "freelist.h" #include "gc.h" #include "gc_ctrl.h" +#include "intext.h" #include "memory.h" #include "misc.h" #include "mlvalues.h" @@ -31,7 +31,6 @@ #include "printexc.h" #include "stack.h" #include "sys.h" -#include "natdynlink.h" #ifdef HAS_UI #include "ui.h" #endif @@ -48,19 +47,22 @@ { extern struct segment caml_data_segments[], caml_code_segments[]; int i; + struct code_fragment * cf; for (i = 0; i < 256; i++) { caml_atom_table[i] = Make_header(0, i, Caml_white); } if (caml_page_table_add(In_static_data, caml_atom_table, caml_atom_table + 256) != 0) - caml_fatal_error("Fatal error: not enough memory for the initial page table"); + caml_fatal_error("Fatal error: not enough memory for initial page table"); for (i = 0; caml_data_segments[i].begin != 0; i++) { + /* PR#5509: we must include the zero word at end of data segment, + because pointers equal to caml_data_segments[i].end are static data. */ if (caml_page_table_add(In_static_data, caml_data_segments[i].begin, - caml_data_segments[i].end) != 0) - caml_fatal_error("Fatal error: not enough memory for the initial page table"); + caml_data_segments[i].end + sizeof(value)) != 0) + caml_fatal_error("Fatal error: not enough memory for initial page table"); } caml_code_area_start = caml_code_segments[0].begin; @@ -71,6 +73,13 @@ if (caml_code_segments[i].end > caml_code_area_end) caml_code_area_end = caml_code_segments[i].end; } + /* Register the code in the table of code fragments */ + cf = caml_stat_alloc(sizeof(struct code_fragment)); + cf->code_start = caml_code_area_start; + cf->code_end = caml_code_area_end; + cf->digest_computed = 0; + caml_ext_table_init(&caml_code_fragments_table, 8); + caml_ext_table_add(&caml_code_fragments_table, cf); } /* Configuration parameters and flags */ @@ -138,6 +147,14 @@ extern void caml_init_ieee_floats (void); extern void caml_init_signals (void); +#ifdef _MSC_VER + +/* PR 4887: avoid crash box of windows runtime on some system calls */ +extern void caml_install_invalid_parameter_handler(); + +#endif + + void caml_main(char **argv) { char * exe_name; @@ -148,6 +165,9 @@ char tos; caml_init_ieee_floats(); +#ifdef _MSC_VER + caml_install_invalid_parameter_handler(); +#endif caml_init_custom_operations(); #ifdef DEBUG caml_verb_gc = 63; diff -Nru ocaml-3.12.1/boot/.cvsignore ocaml-4.01.0/boot/.cvsignore --- ocaml-3.12.1/boot/.cvsignore 2010-01-20 16:26:46.000000000 +0000 +++ ocaml-4.01.0/boot/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,7 +0,0 @@ -Saved -ocamlrun -ocamlyacc -camlheader -myocamlbuild -myocamlbuild.native -libcamlrun.a diff -Nru ocaml-3.12.1/boot/.ignore ocaml-4.01.0/boot/.ignore --- ocaml-3.12.1/boot/.ignore 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/boot/.ignore 2012-07-26 19:21:54.000000000 +0000 @@ -0,0 +1,8 @@ +Saved +ocamlrun +ocamlrun.exe +ocamlyacc +ocamlyacc.exe +camlheader +myocamlbuild +myocamlbuild.native Binary files /tmp/5SbiyyMZML/ocaml-3.12.1/boot/myocamlbuild.boot and /tmp/1rMNMMQJtH/ocaml-4.01.0/boot/myocamlbuild.boot differ Binary files /tmp/5SbiyyMZML/ocaml-3.12.1/boot/ocamlc and /tmp/1rMNMMQJtH/ocaml-4.01.0/boot/ocamlc differ Binary files /tmp/5SbiyyMZML/ocaml-3.12.1/boot/ocamldep and /tmp/1rMNMMQJtH/ocaml-4.01.0/boot/ocamldep differ Binary files /tmp/5SbiyyMZML/ocaml-3.12.1/boot/ocamllex and /tmp/1rMNMMQJtH/ocaml-4.01.0/boot/ocamllex differ diff -Nru ocaml-3.12.1/build/.cvsignore ocaml-4.01.0/build/.cvsignore --- ocaml-3.12.1/build/.cvsignore 2008-12-03 18:09:09.000000000 +0000 +++ ocaml-4.01.0/build/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -ocamlbuild_mixed_mode diff -Nru ocaml-3.12.1/build/.ignore ocaml-4.01.0/build/.ignore --- ocaml-3.12.1/build/.ignore 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/build/.ignore 2012-07-17 15:31:12.000000000 +0000 @@ -0,0 +1 @@ +ocamlbuild_mixed_mode diff -Nru ocaml-3.12.1/build/boot-c-parts.sh ocaml-4.01.0/build/boot-c-parts.sh --- ocaml-3.12.1/build/boot-c-parts.sh 2010-05-20 09:44:25.000000000 +0000 +++ ocaml-4.01.0/build/boot-c-parts.sh 2012-07-17 15:31:12.000000000 +0000 @@ -1,4 +1,17 @@ #!/bin/sh + +######################################################################### +# # +# OCaml # +# # +# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# # +# Copyright 2007 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + cd `dirname $0`/.. set -ex diff -Nru ocaml-3.12.1/build/boot.sh ocaml-4.01.0/build/boot.sh --- ocaml-3.12.1/build/boot.sh 2011-02-21 15:09:49.000000000 +0000 +++ ocaml-4.01.0/build/boot.sh 2013-02-18 12:09:06.000000000 +0000 @@ -1,9 +1,25 @@ #!/bin/sh -# $Id: boot.sh 10956 2011-02-21 15:09:49Z xclerc $ + +######################################################################### +# # +# OCaml # +# # +# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# # +# Copyright 2007 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + cd `dirname $0`/.. set -ex TAG_LINE='true: -use_stdlib' -./boot/ocamlrun boot/myocamlbuild.boot \ + +# If you modify this list, modify it also in camlp4-native-only.sh +STDLIB_MODULES='Pervasives,Arg,Array,Buffer,Char,Digest,Filename,Format,Hashtbl,Lazy,Lexing,List,Map,Printexc,Printf,Scanf,Set,String,Sys,Parsing,Int32,Int64,Nativeint,Obj,Queue,Sort,Stream,Stack' + +./boot/ocamlrun boot/myocamlbuild.boot -ignore "$STDLIB_MODULES" \ -tag-line "$TAG_LINE" \ boot/stdlib.cma boot/std_exit.cmo diff -Nru ocaml-3.12.1/build/buildbot ocaml-4.01.0/build/buildbot --- ocaml-3.12.1/build/buildbot 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/build/buildbot 2012-07-17 15:31:12.000000000 +0000 @@ -1,5 +1,17 @@ #!/bin/sh +######################################################################### +# # +# OCaml # +# # +# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# # +# Copyright 2007 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + # If you want to help me by participating to the build/test effort: # http://gallium.inria.fr/~pouillar/ocaml-testing.html # -- Nicolas Pouillard diff -Nru ocaml-3.12.1/build/camlp4-bootstrap-recipe.txt ocaml-4.01.0/build/camlp4-bootstrap-recipe.txt --- ocaml-3.12.1/build/camlp4-bootstrap-recipe.txt 2011-02-02 16:06:31.000000000 +0000 +++ ocaml-4.01.0/build/camlp4-bootstrap-recipe.txt 2012-08-02 08:17:59.000000000 +0000 @@ -1,7 +1,20 @@ +######################################################################### +# # +# OCaml # +# # +# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# # +# Copyright 2010 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + === Initial setup === make clean ./build/distclean.sh ./configure -prefix `pwd`/_install + (cd otherlibs/labltk/browser; make help.ml) ./build/fastworld.sh # Go to "Bootstrap camlp4" @@ -121,7 +134,7 @@ In Camlp4/Printers/OCaml.ml: | <:expr< let open $i$ in $e$ >> -> - pp f "@[<2>let open %a@]@ @[<2>in@ %a@]" + pp f "@[<2>let open %a@]@ @[<2>in@ %a@]" o#ident i o#reset_semi#expr e And at the end of #simple_expr: <:expr< let open $_$ in $_$ >> diff -Nru ocaml-3.12.1/build/camlp4-bootstrap.sh ocaml-4.01.0/build/camlp4-bootstrap.sh --- ocaml-3.12.1/build/camlp4-bootstrap.sh 2010-06-09 14:21:20.000000000 +0000 +++ ocaml-4.01.0/build/camlp4-bootstrap.sh 2013-08-30 11:39:33.000000000 +0000 @@ -1,5 +1,17 @@ #!/bin/sh +######################################################################### +# # +# OCaml # +# # +# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# # +# Copyright 2007 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + # README: to bootstrap camlp4 have a look at build/camlp4-bootstrap-recipe.txt set -e diff -Nru ocaml-3.12.1/build/camlp4-byte-only.sh ocaml-4.01.0/build/camlp4-byte-only.sh --- ocaml-3.12.1/build/camlp4-byte-only.sh 2011-05-13 08:40:05.000000000 +0000 +++ ocaml-4.01.0/build/camlp4-byte-only.sh 2012-10-15 17:50:56.000000000 +0000 @@ -2,7 +2,7 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # # # @@ -12,8 +12,6 @@ # # ######################################################################### -# $Id: camlp4-byte-only.sh 11041 2011-05-13 08:40:05Z doligez $ - set -e cd `dirname $0`/.. . build/targets.sh diff -Nru ocaml-3.12.1/build/camlp4-mkCamlp4Ast.sh ocaml-4.01.0/build/camlp4-mkCamlp4Ast.sh --- ocaml-3.12.1/build/camlp4-mkCamlp4Ast.sh 2011-05-13 08:37:04.000000000 +0000 +++ ocaml-4.01.0/build/camlp4-mkCamlp4Ast.sh 2012-10-15 17:50:56.000000000 +0000 @@ -1,5 +1,17 @@ #!/bin/sh -# $Id: camlp4-mkCamlp4Ast.sh 11040 2011-05-13 08:37:04Z doligez $ + +######################################################################### +# # +# OCaml # +# # +# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# # +# Copyright 2010 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + set -e cd `dirname $0`/.. diff -Nru ocaml-3.12.1/build/camlp4-native-only.sh ocaml-4.01.0/build/camlp4-native-only.sh --- ocaml-3.12.1/build/camlp4-native-only.sh 2011-05-13 08:40:05.000000000 +0000 +++ ocaml-4.01.0/build/camlp4-native-only.sh 2013-02-18 12:09:06.000000000 +0000 @@ -2,7 +2,7 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # # # @@ -12,10 +12,12 @@ # # ######################################################################### -# $Id: camlp4-native-only.sh 11041 2011-05-13 08:40:05Z doligez $ - set -e cd `dirname $0`/.. . build/targets.sh set -x -$OCAMLBUILD $@ native_stdlib_mixed_mode $OCAMLOPT_BYTE $OCAMLLEX_BYTE $CAMLP4_NATIVE + +# If you modify this list, modify it also in boot.sh +STDLIB_MODULES='Pervasives,Arg,Array,Buffer,Char,Digest,Filename,Format,Hashtbl,Lazy,Lexing,List,Map,Printexc,Printf,Scanf,Set,String,Sys,Parsing,Int32,Int64,Nativeint,Obj,Queue,Sort,Stream,Stack' + +$OCAMLBUILD -ignore "$STDLIB_MODULES" $@ native_stdlib_mixed_mode $OCAMLOPT_BYTE $OCAMLLEX_BYTE $CAMLP4_NATIVE diff -Nru ocaml-3.12.1/build/camlp4-targets.sh ocaml-4.01.0/build/camlp4-targets.sh --- ocaml-3.12.1/build/camlp4-targets.sh 2010-05-20 09:44:25.000000000 +0000 +++ ocaml-4.01.0/build/camlp4-targets.sh 2012-10-15 17:50:56.000000000 +0000 @@ -1,5 +1,17 @@ #!/bin/sh -# $Id: camlp4-targets.sh 10443 2010-05-20 09:44:25Z doligez $ + +######################################################################### +# # +# OCaml # +# # +# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# # +# Copyright 2007 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + CAMLP4_COMMON="\ camlp4/Camlp4/Camlp4Ast.partial.ml \ camlp4/boot/camlp4boot.byte" diff -Nru ocaml-3.12.1/build/distclean.sh ocaml-4.01.0/build/distclean.sh --- ocaml-3.12.1/build/distclean.sh 2010-05-20 09:44:25.000000000 +0000 +++ ocaml-4.01.0/build/distclean.sh 2012-10-15 17:50:56.000000000 +0000 @@ -2,7 +2,7 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # # # @@ -12,8 +12,6 @@ # # ######################################################################### -# $Id: distclean.sh 10443 2010-05-20 09:44:25Z doligez $ - cd `dirname $0`/.. set -ex (cd byterun && make clean) || : diff -Nru ocaml-3.12.1/build/fastworld.sh ocaml-4.01.0/build/fastworld.sh --- ocaml-3.12.1/build/fastworld.sh 2011-05-13 08:40:05.000000000 +0000 +++ ocaml-4.01.0/build/fastworld.sh 2012-10-15 17:50:56.000000000 +0000 @@ -2,7 +2,7 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # # # @@ -12,8 +12,6 @@ # # ######################################################################### -# $Id: fastworld.sh 11041 2011-05-13 08:40:05Z doligez $ - cd `dirname $0` set -e if [ -e ocamlbuild_mixed_mode ]; then diff -Nru ocaml-3.12.1/build/install.sh ocaml-4.01.0/build/install.sh --- ocaml-3.12.1/build/install.sh 2010-11-25 13:57:43.000000000 +0000 +++ ocaml-4.01.0/build/install.sh 2013-01-01 04:53:49.000000000 +0000 @@ -2,7 +2,7 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # # # @@ -12,8 +12,6 @@ # # ######################################################################### -# $Id: install.sh 10856 2010-11-25 13:57:43Z xclerc $ - set -e cd `dirname $0`/.. @@ -553,6 +551,8 @@ ocamlbuildlib.cmxa \ ocamlbuildlib.cma \ ocamlbuild_plugin.cmi \ + ocamlbuild_plugin.cmo \ + ocamlbuild_plugin.cmx \ ocamlbuild_pack.cmi \ ocamlbuild_unix_plugin.cmi \ ocamlbuild_unix_plugin.cmo \ diff -Nru ocaml-3.12.1/build/mixed-boot.sh ocaml-4.01.0/build/mixed-boot.sh --- ocaml-3.12.1/build/mixed-boot.sh 2010-05-20 09:44:25.000000000 +0000 +++ ocaml-4.01.0/build/mixed-boot.sh 2012-07-17 15:31:12.000000000 +0000 @@ -2,7 +2,7 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # # # diff -Nru ocaml-3.12.1/build/mkconfig.sh ocaml-4.01.0/build/mkconfig.sh --- ocaml-3.12.1/build/mkconfig.sh 2010-05-20 09:44:25.000000000 +0000 +++ ocaml-4.01.0/build/mkconfig.sh 2012-07-17 15:31:12.000000000 +0000 @@ -1,5 +1,17 @@ #!/bin/sh +######################################################################### +# # +# OCaml # +# # +# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# # +# Copyright 2007 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + cd `dirname $0`/.. sed -e 's/^\(.*\$([0-9]).*\)$/# \1/' \ diff -Nru ocaml-3.12.1/build/mkmyocamlbuild_config.sh ocaml-4.01.0/build/mkmyocamlbuild_config.sh --- ocaml-3.12.1/build/mkmyocamlbuild_config.sh 2010-05-20 09:44:25.000000000 +0000 +++ ocaml-4.01.0/build/mkmyocamlbuild_config.sh 2013-05-17 12:03:58.000000000 +0000 @@ -2,7 +2,7 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # # # @@ -12,12 +12,11 @@ # # ######################################################################### -# $Id: mkmyocamlbuild_config.sh 10443 2010-05-20 09:44:25Z doligez $ - cd `dirname $0`/.. sed \ -e 's/^.*FLEXDIR.*$//g' \ + -e '/^SET_LD_PATH/d' \ -e 's/^#ml \(.*\)/\1/' \ -e 's/^\([^"][^"]*\("[^"]*"[^"]*\)*\)#.*$/\1/' \ -e 's/^\(#.*\)$/(* \1 *)/' \ diff -Nru ocaml-3.12.1/build/mkruntimedef.sh ocaml-4.01.0/build/mkruntimedef.sh --- ocaml-3.12.1/build/mkruntimedef.sh 2010-05-20 09:44:25.000000000 +0000 +++ ocaml-4.01.0/build/mkruntimedef.sh 2012-10-15 17:50:56.000000000 +0000 @@ -1,5 +1,17 @@ #!/bin/sh -# $Id: mkruntimedef.sh 10443 2010-05-20 09:44:25Z doligez $ + +######################################################################### +# # +# OCaml # +# # +# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# # +# Copyright 2007 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + echo 'let builtin_exceptions = [|'; \ sed -n -e 's|.*/\* \("[A-Za-z_]*"\) \*/$| \1;|p' byterun/fail.h | \ sed -e '$s/;$//'; \ diff -Nru ocaml-3.12.1/build/myocamlbuild.sh ocaml-4.01.0/build/myocamlbuild.sh --- ocaml-3.12.1/build/myocamlbuild.sh 2010-05-21 11:48:35.000000000 +0000 +++ ocaml-4.01.0/build/myocamlbuild.sh 2012-10-15 17:50:56.000000000 +0000 @@ -2,7 +2,7 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt # # # @@ -12,8 +12,6 @@ # # ######################################################################### -# $Id: myocamlbuild.sh 10449 2010-05-21 11:48:35Z doligez $ - cd `dirname $0`/.. set -xe if [ ! -x _build/ocamlbuild/ocamlbuildlight.byte ]; then diff -Nru ocaml-3.12.1/build/new-build-system ocaml-4.01.0/build/new-build-system --- ocaml-3.12.1/build/new-build-system 2010-05-11 13:28:31.000000000 +0000 +++ ocaml-4.01.0/build/new-build-system 2012-08-02 08:17:59.000000000 +0000 @@ -1,3 +1,15 @@ +######################################################################### +# # +# OCaml # +# # +# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# # +# Copyright 2007 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + _tags # Defines tags to setup exceptions myocamlbuild.ml # Contains all needed rules that are differents boot/ocamldep diff -Nru ocaml-3.12.1/build/ocamlbuild-byte-only.sh ocaml-4.01.0/build/ocamlbuild-byte-only.sh --- ocaml-3.12.1/build/ocamlbuild-byte-only.sh 2011-05-13 08:40:05.000000000 +0000 +++ ocaml-4.01.0/build/ocamlbuild-byte-only.sh 2012-10-15 17:50:56.000000000 +0000 @@ -2,7 +2,7 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # # # @@ -12,8 +12,6 @@ # # ######################################################################### -# $Id: ocamlbuild-byte-only.sh 11041 2011-05-13 08:40:05Z doligez $ - set -e cd `dirname $0`/.. . build/targets.sh diff -Nru ocaml-3.12.1/build/ocamlbuild-native-only.sh ocaml-4.01.0/build/ocamlbuild-native-only.sh --- ocaml-3.12.1/build/ocamlbuild-native-only.sh 2011-05-13 08:40:05.000000000 +0000 +++ ocaml-4.01.0/build/ocamlbuild-native-only.sh 2012-10-15 17:50:56.000000000 +0000 @@ -2,7 +2,7 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # # # @@ -12,8 +12,6 @@ # # ######################################################################### -# $Id: ocamlbuild-native-only.sh 11041 2011-05-13 08:40:05Z doligez $ - set -e cd `dirname $0`/.. . build/targets.sh diff -Nru ocaml-3.12.1/build/ocamlbuildlib-native-only.sh ocaml-4.01.0/build/ocamlbuildlib-native-only.sh --- ocaml-3.12.1/build/ocamlbuildlib-native-only.sh 2011-05-13 08:40:05.000000000 +0000 +++ ocaml-4.01.0/build/ocamlbuildlib-native-only.sh 2012-10-15 17:50:56.000000000 +0000 @@ -2,7 +2,7 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # # # @@ -12,8 +12,6 @@ # # ######################################################################### -# $Id: ocamlbuildlib-native-only.sh 11041 2011-05-13 08:40:05Z doligez $ - set -e cd `dirname $0`/.. . build/targets.sh diff -Nru ocaml-3.12.1/build/otherlibs-targets.sh ocaml-4.01.0/build/otherlibs-targets.sh --- ocaml-3.12.1/build/otherlibs-targets.sh 2011-05-13 08:40:05.000000000 +0000 +++ ocaml-4.01.0/build/otherlibs-targets.sh 2012-10-15 17:50:56.000000000 +0000 @@ -2,7 +2,7 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # # # @@ -12,8 +12,6 @@ # # ######################################################################### -# $Id: otherlibs-targets.sh 11041 2011-05-13 08:40:05Z doligez $ - OTHERLIBS_BYTE="" OTHERLIBS_NATIVE="" OTHERLIBS_UNIX_NATIVE="" diff -Nru ocaml-3.12.1/build/partial-install.sh ocaml-4.01.0/build/partial-install.sh --- ocaml-3.12.1/build/partial-install.sh 2010-05-20 09:44:25.000000000 +0000 +++ ocaml-4.01.0/build/partial-install.sh 2013-01-01 04:53:49.000000000 +0000 @@ -2,7 +2,7 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # # # @@ -12,8 +12,6 @@ # # ######################################################################### -# $Id: partial-install.sh 10443 2010-05-20 09:44:25Z doligez $ - ###################################### ######### Copied from build/install.sh ###################################### @@ -131,26 +129,28 @@ installbin camlp4/camlp4r.native$EXE $BINDIR/camlp4r.opt$EXE installbin camlp4/camlp4rf.native$EXE $BINDIR/camlp4rf.opt$EXE -cd camlp4 -CAMLP4DIR=$LIBDIR/camlp4 -for dir in Camlp4Parsers Camlp4Printers Camlp4Filters Camlp4Top; do - echo "Installing $dir..." - mkdir -p $CAMLP4DIR/$dir - installdir \ - $dir/*.cm* \ - $dir/*.$O \ - $CAMLP4DIR/$dir -done -installdir \ - camlp4lib.cma camlp4lib.cmxa Camlp4.cmi \ - camlp4fulllib.cma camlp4fulllib.cmxa \ - camlp4o.cma camlp4of.cma camlp4oof.cma \ - camlp4orf.cma camlp4r.cma camlp4rf.cma \ - Camlp4Bin.cm[iox] Camlp4Bin.$O Camlp4Top.cm[io] \ - Camlp4_config.cmi camlp4prof.cm[iox] camlp4prof.$O Camlp4_import.cmi \ - $CAMLP4DIR -installlibdir camlp4lib.$A camlp4fulllib.$A $CAMLP4DIR -cd .. +if test -d camlp4; then + cd camlp4 + CAMLP4DIR=$LIBDIR/camlp4 + for dir in Camlp4Parsers Camlp4Printers Camlp4Filters Camlp4Top; do + echo "Installing $dir..." + mkdir -p $CAMLP4DIR/$dir + installdir \ + $dir/*.cm* \ + $dir/*.$O \ + $CAMLP4DIR/$dir + done + installdir \ + camlp4lib.cma camlp4lib.cmxa Camlp4.cmi \ + camlp4fulllib.cma camlp4fulllib.cmxa \ + camlp4o.cma camlp4of.cma camlp4oof.cma \ + camlp4orf.cma camlp4r.cma camlp4rf.cma \ + Camlp4Bin.cm[iox] Camlp4Bin.$O Camlp4Top.cm[io] \ + Camlp4_config.cmi camlp4prof.cm[iox] camlp4prof.$O Camlp4_import.cmi \ + $CAMLP4DIR + installlibdir camlp4lib.$A camlp4fulllib.$A $CAMLP4DIR + cd .. +fi echo "Installing ocamlbuild..." cd ocamlbuild @@ -166,6 +166,8 @@ ocamlbuildlib.cmxa \ ocamlbuildlib.cma \ ocamlbuild_plugin.cmi \ + ocamlbuild_plugin.cmo \ + ocamlbuild_plugin.cmx \ ocamlbuild_pack.cmi \ ocamlbuild_unix_plugin.cmi \ ocamlbuild_unix_plugin.cmo \ diff -Nru ocaml-3.12.1/build/targets.sh ocaml-4.01.0/build/targets.sh --- ocaml-3.12.1/build/targets.sh 2010-11-25 13:57:43.000000000 +0000 +++ ocaml-4.01.0/build/targets.sh 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # # # @@ -10,8 +10,6 @@ # # ######################################################################### -# $Id: targets.sh 10856 2010-11-25 13:57:43Z xclerc $ - . config/config.sh . build/otherlibs-targets.sh . build/camlp4-targets.sh diff -Nru ocaml-3.12.1/build/tolower.sed ocaml-4.01.0/build/tolower.sed --- ocaml-3.12.1/build/tolower.sed 2007-02-07 22:57:25.000000000 +0000 +++ ocaml-4.01.0/build/tolower.sed 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,15 @@ +######################################################################### +# # +# OCaml # +# # +# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# # +# Copyright 2007 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + # tolower.sed expands one ...<:lower>... to ...foo... per line h s/.*<:lower<\(.*\)>>.*/\1/ diff -Nru ocaml-3.12.1/build/world.all.sh ocaml-4.01.0/build/world.all.sh --- ocaml-3.12.1/build/world.all.sh 2010-05-20 09:44:25.000000000 +0000 +++ ocaml-4.01.0/build/world.all.sh 2012-10-15 17:50:56.000000000 +0000 @@ -1,5 +1,17 @@ #!/bin/sh -# $Id: world.all.sh 10443 2010-05-20 09:44:25Z doligez $ + +######################################################################### +# # +# OCaml # +# # +# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# # +# Copyright 2007 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + set -e cd `dirname $0`/.. . build/targets.sh diff -Nru ocaml-3.12.1/build/world.byte.sh ocaml-4.01.0/build/world.byte.sh --- ocaml-3.12.1/build/world.byte.sh 2010-05-20 09:44:25.000000000 +0000 +++ ocaml-4.01.0/build/world.byte.sh 2012-10-15 17:50:56.000000000 +0000 @@ -1,5 +1,17 @@ #!/bin/sh -# $Id: world.byte.sh 10443 2010-05-20 09:44:25Z doligez $ + +######################################################################### +# # +# OCaml # +# # +# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# # +# Copyright 2007 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + set -e cd `dirname $0`/.. . build/targets.sh diff -Nru ocaml-3.12.1/build/world.native.sh ocaml-4.01.0/build/world.native.sh --- ocaml-3.12.1/build/world.native.sh 2010-05-20 09:44:25.000000000 +0000 +++ ocaml-4.01.0/build/world.native.sh 2012-10-15 17:50:56.000000000 +0000 @@ -1,5 +1,17 @@ #!/bin/sh -# $Id: world.native.sh 10443 2010-05-20 09:44:25Z doligez $ + +######################################################################### +# # +# OCaml # +# # +# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# # +# Copyright 2007 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + set -e cd `dirname $0`/.. . build/targets.sh diff -Nru ocaml-3.12.1/build/world.sh ocaml-4.01.0/build/world.sh --- ocaml-3.12.1/build/world.sh 2011-05-13 08:40:05.000000000 +0000 +++ ocaml-4.01.0/build/world.sh 2012-07-17 15:31:12.000000000 +0000 @@ -2,7 +2,7 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # # # diff -Nru ocaml-3.12.1/bytecomp/.cvsignore ocaml-4.01.0/bytecomp/.cvsignore --- ocaml-3.12.1/bytecomp/.cvsignore 1995-08-29 08:33:39.000000000 +0000 +++ ocaml-4.01.0/bytecomp/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -runtimedef.ml -opcodes.ml diff -Nru ocaml-3.12.1/bytecomp/.ignore ocaml-4.01.0/bytecomp/.ignore --- ocaml-3.12.1/bytecomp/.ignore 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/bytecomp/.ignore 2012-07-17 15:31:12.000000000 +0000 @@ -0,0 +1,2 @@ +runtimedef.ml +opcodes.ml diff -Nru ocaml-3.12.1/bytecomp/bytegen.ml ocaml-4.01.0/bytecomp/bytegen.ml --- ocaml-3.12.1/bytecomp/bytegen.ml 2010-09-02 13:29:21.000000000 +0000 +++ ocaml-4.01.0/bytecomp/bytegen.ml 2012-11-29 09:55:00.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: bytegen.ml 10667 2010-09-02 13:29:21Z xclerc $ *) - (* bytegen.ml : translation of lambda terms to lists of instructions. *) open Misc @@ -332,6 +330,12 @@ | Pstringsets -> Kccall("caml_string_set", 3) | Pstringrefu -> Kgetstringchar | Pstringsetu -> Ksetstringchar + | Pstring_load_16(_) -> Kccall("caml_string_get16", 2) + | Pstring_load_32(_) -> Kccall("caml_string_get32", 2) + | Pstring_load_64(_) -> Kccall("caml_string_get64", 2) + | Pstring_set_16(_) -> Kccall("caml_string_set16", 3) + | Pstring_set_32(_) -> Kccall("caml_string_set32", 3) + | Pstring_set_64(_) -> Kccall("caml_string_set64", 3) | Parraylength kind -> Kvectlength | Parrayrefs Pgenarray -> Kccall("caml_array_get", 2) | Parrayrefs Pfloatarray -> Kccall("caml_array_get_float", 2) @@ -345,6 +349,14 @@ | Parraysetu Pgenarray -> Kccall("caml_array_unsafe_set", 3) | Parraysetu Pfloatarray -> Kccall("caml_array_unsafe_set_float", 3) | Parraysetu _ -> Ksetvectitem + | Pctconst c -> + let const_name = match c with + | Big_endian -> "big_endian" + | Word_size -> "word_size" + | Ostype_unix -> "ostype_unix" + | Ostype_win32 -> "ostype_win32" + | Ostype_cygwin -> "ostype_cygwin" in + Kccall(Printf.sprintf "caml_sys_const_%s" const_name, 1) | Pisint -> Kisint | Pisout -> Kisout | Pbittest -> Kccall("caml_bitvect_test", 2) @@ -376,6 +388,15 @@ | Pbintcomp(bi, Cge) -> Kccall("caml_greaterequal", 2) | Pbigarrayref(_, n, _, _) -> Kccall("caml_ba_get_" ^ string_of_int n, n + 1) | Pbigarrayset(_, n, _, _) -> Kccall("caml_ba_set_" ^ string_of_int n, n + 2) + | Pbigarraydim(n) -> Kccall("caml_ba_dim_" ^ string_of_int n, 1) + | Pbigstring_load_16(_) -> Kccall("caml_ba_uint8_get16", 2) + | Pbigstring_load_32(_) -> Kccall("caml_ba_uint8_get32", 2) + | Pbigstring_load_64(_) -> Kccall("caml_ba_uint8_get64", 2) + | Pbigstring_set_16(_) -> Kccall("caml_ba_uint8_set16", 3) + | Pbigstring_set_32(_) -> Kccall("caml_ba_uint8_set32", 3) + | Pbigstring_set_64(_) -> Kccall("caml_ba_uint8_set64", 3) + | Pbswap16 -> Kccall("caml_bswap16", 1) + | Pbbswap(bi) -> comp_bint_primitive bi "bswap" args | _ -> fatal_error "Bytegen.comp_primitive" let is_immed n = immed_min <= n && n <= immed_max @@ -524,6 +545,10 @@ comp_expr env arg sz cont | Lprim(Pignore, [arg]) -> comp_expr env arg sz (add_const_unit cont) + | Lprim(Pdirapply loc, [func;arg]) + | Lprim(Prevapply loc, [arg;func]) -> + let exp = Lapply(func, [arg], loc) in + comp_expr env exp sz cont | Lprim(Pnot, [arg]) -> let newcont = match cont with diff -Nru ocaml-3.12.1/bytecomp/bytegen.mli ocaml-4.01.0/bytecomp/bytegen.mli --- ocaml-3.12.1/bytecomp/bytegen.mli 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/bytecomp/bytegen.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: bytegen.mli 2553 1999-11-17 18:59:06Z xleroy $ *) - (* Generation of bytecode from lambda terms *) open Lambda diff -Nru ocaml-3.12.1/bytecomp/bytelibrarian.ml ocaml-4.01.0/bytecomp/bytelibrarian.ml --- ocaml-3.12.1/bytecomp/bytelibrarian.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/bytecomp/bytelibrarian.ml 2013-06-05 16:34:40.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: bytelibrarian.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Build libraries of .cmo files *) open Misc @@ -38,7 +36,6 @@ (* Add C objects and options and "custom" info from a library descriptor *) -let lib_sharedobjs = ref [] let lib_ccobjs = ref [] let lib_ccopts = ref [] let lib_dllibs = ref [] @@ -55,7 +52,7 @@ lib_dllibs := !lib_dllibs @ l.lib_dllibs end -let copy_object_file oc name = +let copy_object_file ppf oc name = let file_name = try find_in_path !load_path name @@ -63,13 +60,12 @@ raise(Error(File_not_found name)) in let ic = open_in_bin file_name in try - let buffer = String.create (String.length cmo_magic_number) in - really_input ic buffer 0 (String.length cmo_magic_number); + let buffer = input_bytes ic (String.length cmo_magic_number) in if buffer = cmo_magic_number then begin let compunit_pos = input_binary_int ic in seek_in ic compunit_pos; let compunit = (input_value ic : compilation_unit) in - Bytelink.check_consistency file_name compunit; + Bytelink.check_consistency ppf file_name compunit; copy_compunit ic oc compunit; close_in ic; [compunit] @@ -78,7 +74,7 @@ let toc_pos = input_binary_int ic in seek_in ic toc_pos; let toc = (input_value ic : library) in - List.iter (Bytelink.check_consistency file_name) toc.lib_units; + List.iter (Bytelink.check_consistency ppf file_name) toc.lib_units; add_ccobjs toc; List.iter (copy_compunit ic oc) toc.lib_units; close_in ic; @@ -89,18 +85,19 @@ End_of_file -> close_in ic; raise(Error(Not_an_object_file file_name)) | x -> close_in ic; raise x -let create_archive file_list lib_name = +let create_archive ppf file_list lib_name = let outchan = open_out_bin lib_name in try output_string outchan cma_magic_number; let ofs_pos_toc = pos_out outchan in output_binary_int outchan 0; - let units = List.flatten(List.map (copy_object_file outchan) file_list) in + let units = + List.flatten(List.map (copy_object_file ppf outchan) file_list) in let toc = { lib_units = units; lib_custom = !Clflags.custom_runtime; lib_ccobjs = !Clflags.ccobjs @ !lib_ccobjs; - lib_ccopts = !Clflags.ccopts @ !lib_ccopts; + lib_ccopts = !Clflags.all_ccopts @ !lib_ccopts; lib_dllibs = !Clflags.dllibs @ !lib_dllibs } in let pos_toc = pos_out outchan in output_value outchan toc; @@ -118,4 +115,5 @@ | File_not_found name -> fprintf ppf "Cannot find file %s" name | Not_an_object_file name -> - fprintf ppf "The file %s is not a bytecode object file" name + fprintf ppf "The file %a is not a bytecode object file" + Location.print_filename name diff -Nru ocaml-3.12.1/bytecomp/bytelibrarian.mli ocaml-4.01.0/bytecomp/bytelibrarian.mli --- ocaml-3.12.1/bytecomp/bytelibrarian.mli 2000-03-06 22:12:09.000000000 +0000 +++ ocaml-4.01.0/bytecomp/bytelibrarian.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: bytelibrarian.mli 2908 2000-03-06 22:12:09Z weis $ *) - (* Build libraries of .cmo files *) (* Format of a library file: @@ -21,7 +19,7 @@ content table = list of compilation units *) -val create_archive: string list -> string -> unit +val create_archive: Format.formatter -> string list -> string -> unit type error = File_not_found of string diff -Nru ocaml-3.12.1/bytecomp/bytelink.ml ocaml-4.01.0/bytecomp/bytelink.ml --- ocaml-3.12.1/bytecomp/bytelink.ml 2010-09-29 16:46:54.000000000 +0000 +++ ocaml-4.01.0/bytecomp/bytelink.ml 2013-07-23 14:48:47.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,24 +10,22 @@ (* *) (***********************************************************************) -(* $Id: bytelink.ml 10695 2010-09-29 16:46:54Z doligez $ *) - (* Link a set of .cmo files and produce a bytecode executable. *) -open Sys open Misc open Config -open Instruct open Cmo_format type error = File_not_found of string | Not_an_object_file of string + | Wrong_object_name of string | Symbol_error of string * Symtable.error | Inconsistent_import of string * string * string | Custom_runtime | File_exists of string | Cannot_open_dll of string + | Not_compatible_32 exception Error of error @@ -115,8 +113,7 @@ raise(Error(File_not_found obj_name)) in let ic = open_in_bin file_name in try - let buffer = String.create (String.length cmo_magic_number) in - really_input ic buffer 0 (String.length cmo_magic_number); + let buffer = input_bytes ic (String.length cmo_magic_number) in if buffer = cmo_magic_number then begin (* This is a .cmo file. It must be linked in any case. Read the relocation information to see which modules it @@ -161,9 +158,10 @@ (* Consistency check between interfaces *) let crc_interfaces = Consistbl.create () +let implementations_defined = ref ([] : (string * string) list) -let check_consistency file_name cu = - try +let check_consistency ppf file_name cu = + begin try List.iter (fun (name, crc) -> if name = cu.cu_name @@ -172,38 +170,47 @@ cu.cu_imports with Consistbl.Inconsistency(name, user, auth) -> raise(Error(Inconsistent_import(name, user, auth))) + end; + begin try + let source = List.assoc cu.cu_name !implementations_defined in + Location.print_warning (Location.in_file file_name) ppf + (Warnings.Multiple_definition(cu.cu_name, + Location.show_filename file_name, + Location.show_filename source)) + with Not_found -> () + end; + implementations_defined := + (cu.cu_name, file_name) :: !implementations_defined let extract_crc_interfaces () = Consistbl.extract crc_interfaces (* Record compilation events *) -let debug_info = ref ([] : (int * string) list) +let debug_info = ref ([] : (int * LongString.t) list) (* Link in a compilation unit *) -let link_compunit output_fun currpos_fun inchan file_name compunit = - check_consistency file_name compunit; +let link_compunit ppf output_fun currpos_fun inchan file_name compunit = + check_consistency ppf file_name compunit; seek_in inchan compunit.cu_pos; - let code_block = String.create compunit.cu_codesize in - really_input inchan code_block 0 compunit.cu_codesize; - Symtable.patch_object code_block compunit.cu_reloc; + let code_block = LongString.input_bytes inchan compunit.cu_codesize in + Symtable.ls_patch_object code_block compunit.cu_reloc; if !Clflags.debug && compunit.cu_debug > 0 then begin seek_in inchan compunit.cu_debug; - let buffer = String.create compunit.cu_debugsize in - really_input inchan buffer 0 compunit.cu_debugsize; + let buffer = LongString.input_bytes inchan compunit.cu_debugsize in debug_info := (currpos_fun(), buffer) :: !debug_info end; - output_fun code_block; + Array.iter output_fun code_block; if !Clflags.link_everything then List.iter Symtable.require_primitive compunit.cu_primitives (* Link in a .cmo file *) -let link_object output_fun currpos_fun file_name compunit = +let link_object ppf output_fun currpos_fun file_name compunit = let inchan = open_in_bin file_name in try - link_compunit output_fun currpos_fun inchan file_name compunit; + link_compunit ppf output_fun currpos_fun inchan file_name compunit; close_in inchan with Symtable.Error msg -> @@ -213,14 +220,14 @@ (* Link in a .cma file *) -let link_archive output_fun currpos_fun file_name units_required = +let link_archive ppf output_fun currpos_fun file_name units_required = let inchan = open_in_bin file_name in try List.iter (fun cu -> let name = file_name ^ "(" ^ cu.cu_name ^ ")" in try - link_compunit output_fun currpos_fun inchan name cu + link_compunit ppf output_fun currpos_fun inchan name cu with Symtable.Error msg -> raise(Error(Symbol_error(name, msg)))) units_required; @@ -229,11 +236,11 @@ (* Link in a .cmo or .cma file *) -let link_file output_fun currpos_fun = function +let link_file ppf output_fun currpos_fun = function Link_object(file_name, unit) -> - link_object output_fun currpos_fun file_name unit + link_object ppf output_fun currpos_fun file_name unit | Link_archive(file_name, units) -> - link_archive output_fun currpos_fun file_name units + link_archive ppf output_fun currpos_fun file_name units (* Output the debugging information *) (* Format is: @@ -247,7 +254,9 @@ let output_debug_info oc = output_binary_int oc (List.length !debug_info); List.iter - (fun (ofs, evl) -> output_binary_int oc ofs; output_string oc evl) + (fun (ofs, evl) -> + output_binary_int oc ofs; + Array.iter (output_string oc) evl) !debug_info; debug_info := [] @@ -265,7 +274,13 @@ (* Create a bytecode executable file *) -let link_bytecode tolink exec_name standalone = +let link_bytecode ppf tolink exec_name standalone = + (* Avoid the case where the specified exec output file is the same as + one of the objects to be linked *) + List.iter (function + | Link_object(file_name, _) when file_name = exec_name -> + raise (Error (Wrong_object_name exec_name)); + | _ -> ()) tolink; Misc.remove_file exec_name; (* avoid permission problems, cf PR#1911 *) let outchan = open_out_gen [Open_wronly; Open_trunc; Open_creat; Open_binary] @@ -276,7 +291,7 @@ try let header = if String.length !Clflags.use_runtime > 0 - then "camlheader_ur" else "camlheader" in + then "camlheader_ur" else "camlheader" ^ !Clflags.runtime_variant in let inchan = open_in_bin (find_in_path !load_path header) in copy_file inchan outchan; close_in inchan @@ -303,7 +318,7 @@ end; let output_fun = output_string outchan and currpos_fun () = pos_out outchan - start_code in - List.iter (link_file output_fun currpos_fun) tolink; + List.iter (link_file ppf output_fun currpos_fun) tolink; if standalone then Dll.close_all_dlls(); (* The final STOP instruction *) output_byte outchan Opcodes.opSTOP; @@ -322,7 +337,13 @@ Symtable.output_primitive_names outchan; Bytesections.record outchan "PRIM"; (* The table of global data *) - output_value outchan (Symtable.initial_global_table()); + begin try + Marshal.to_channel outchan (Symtable.initial_global_table()) + (if !Clflags.bytecode_compatible_32 + then [Marshal.Compat_32] else []) + with Failure _ -> + raise (Error Not_compatible_32) + end; Bytesections.record outchan "DATA"; (* The map of global identifiers *) Symtable.output_global_map outchan; @@ -402,7 +423,7 @@ (* Output a bytecode executable as a C file *) -let link_bytecode_as_c tolink outfile = +let link_bytecode_as_c ppf tolink outfile = let outchan = open_out outfile in begin try (* The bytecode *) @@ -424,7 +445,7 @@ output_code_string outchan code; currpos := !currpos + String.length code and currpos_fun () = !currpos in - List.iter (link_file output_fun currpos_fun) tolink; + List.iter (link_file ppf output_fun currpos_fun) tolink; (* The final STOP instruction *) Printf.fprintf outchan "\n0x%x};\n\n" Opcodes.opSTOP; (* The table of global data *) @@ -458,6 +479,7 @@ close_out outchan with x -> close_out outchan; + remove_file outfile; raise x end; if !Clflags.debug then @@ -466,8 +488,9 @@ (* Build a custom runtime *) let build_custom_runtime prim_name exec_name = + let runtime_lib = "-lcamlrun" ^ !Clflags.runtime_variant in Ccomp.call_linker Ccomp.Exe exec_name - ([prim_name] @ List.rev !Clflags.ccobjs @ ["-lcamlrun"]) + ([prim_name] @ List.rev !Clflags.ccobjs @ [runtime_lib]) (Clflags.std_include_flag "-I" ^ " " ^ Config.bytecomp_c_libraries) let append_bytecode_and_cleanup bytecode_name exec_name prim_name = @@ -490,29 +513,34 @@ (* Main entry point (build a custom runtime if needed) *) -let link objfiles output_name = +let link ppf objfiles output_name = let objfiles = if !Clflags.nopervasives then objfiles else if !Clflags.output_c_object then "stdlib.cma" :: objfiles else "stdlib.cma" :: (objfiles @ ["std_exit.cmo"]) in let tolink = List.fold_right scan_file objfiles [] in Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs; (* put user's libs last *) - Clflags.ccopts := !lib_ccopts @ !Clflags.ccopts; (* put user's opts first *) + Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts; + (* put user's opts first *) Clflags.dllibs := !lib_dllibs @ !Clflags.dllibs; (* put user's DLLs first *) if not !Clflags.custom_runtime then - link_bytecode tolink output_name true + link_bytecode ppf tolink output_name true else if not !Clflags.output_c_object then begin let bytecode_name = Filename.temp_file "camlcode" "" in let prim_name = Filename.temp_file "camlprim" ".c" in try - link_bytecode tolink bytecode_name false; + link_bytecode ppf tolink bytecode_name false; let poc = open_out prim_name in output_string poc "\ #ifdef __cplusplus\n\ extern \"C\" {\n\ #endif\n\ #ifdef _WIN64\n\ + #ifdef __MINGW32__\n\ + typedef long long value;\n\ + #else\n\ typedef __int64 value;\n\ + #endif\n\ #else\n\ typedef long value;\n\ #endif\n"; @@ -539,15 +567,16 @@ if Sys.file_exists c_file then raise(Error(File_exists c_file)); let temps = ref [] in try - link_bytecode_as_c tolink c_file; + link_bytecode_as_c ppf tolink c_file; if not (Filename.check_suffix output_name ".c") then begin temps := c_file :: !temps; if Ccomp.compile_file c_file <> 0 then raise(Error Custom_runtime); if not (Filename.check_suffix output_name Config.ext_obj) then begin temps := obj_file :: !temps; if not ( + let runtime_lib = "-lcamlrun" ^ !Clflags.runtime_variant in Ccomp.call_linker Ccomp.MainDll output_name - ([obj_file] @ List.rev !Clflags.ccobjs @ ["-lcamlrun"]) + ([obj_file] @ List.rev !Clflags.ccobjs @ [runtime_lib]) Config.bytecomp_c_libraries ) then raise (Error Custom_runtime); end @@ -564,20 +593,31 @@ let report_error ppf = function | File_not_found name -> - fprintf ppf "Cannot find file %s" name + fprintf ppf "Cannot find file %a" Location.print_filename name | Not_an_object_file name -> - fprintf ppf "The file %s is not a bytecode object file" name + fprintf ppf "The file %a is not a bytecode object file" + Location.print_filename name + | Wrong_object_name name -> + fprintf ppf "The output file %s has the wrong name. The extension implies\ + \ an object file but the link step was requested" name | Symbol_error(name, err) -> - fprintf ppf "Error while linking %s:@ %a" name + fprintf ppf "Error while linking %a:@ %a" Location.print_filename name Symtable.report_error err | Inconsistent_import(intf, file1, file2) -> fprintf ppf - "@[Files %s@ and %s@ \ + "@[Files %a@ and %a@ \ make inconsistent assumptions over interface %s@]" - file1 file2 intf + Location.print_filename file1 + Location.print_filename file2 + intf | Custom_runtime -> fprintf ppf "Error while building custom runtime system" | File_exists file -> - fprintf ppf "Cannot overwrite existing file %s" file + fprintf ppf "Cannot overwrite existing file %a" + Location.print_filename file | Cannot_open_dll file -> - fprintf ppf "Error on dynamically loaded library: %s" file + fprintf ppf "Error on dynamically loaded library: %a" + Location.print_filename file + | Not_compatible_32 -> + fprintf ppf "Generated bytecode executable cannot be run\ + \ on a 32-bit platform" diff -Nru ocaml-3.12.1/bytecomp/bytelink.mli ocaml-4.01.0/bytecomp/bytelink.mli --- ocaml-3.12.1/bytecomp/bytelink.mli 2006-05-11 15:50:53.000000000 +0000 +++ ocaml-4.01.0/bytecomp/bytelink.mli 2013-04-18 11:58:59.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,24 +10,25 @@ (* *) (***********************************************************************) -(* $Id: bytelink.mli 7422 2006-05-11 15:50:53Z xleroy $ *) - (* Link .cmo files and produce a bytecode executable. *) -val link: string list -> string -> unit +val link : Format.formatter -> string list -> string -> unit -val check_consistency: string -> Cmo_format.compilation_unit -> unit +val check_consistency: + Format.formatter -> string -> Cmo_format.compilation_unit -> unit val extract_crc_interfaces: unit -> (string * Digest.t) list type error = File_not_found of string | Not_an_object_file of string + | Wrong_object_name of string | Symbol_error of string * Symtable.error | Inconsistent_import of string * string * string | Custom_runtime | File_exists of string | Cannot_open_dll of string + | Not_compatible_32 exception Error of error diff -Nru ocaml-3.12.1/bytecomp/bytepackager.ml ocaml-4.01.0/bytecomp/bytepackager.ml --- ocaml-3.12.1/bytecomp/bytepackager.ml 2011-06-11 07:24:12.000000000 +0000 +++ ocaml-4.01.0/bytecomp/bytepackager.ml 2013-07-23 14:48:47.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: bytepackager.ml 11083 2011-06-11 07:24:12Z xleroy $ *) - (* "Package" a set of .cmo files into one .cmo file having the original compilation units as sub-modules. *) @@ -23,7 +21,7 @@ Forward_reference of string * Ident.t | Multiple_definition of string * Ident.t | Not_an_object_file of string - | Illegal_renaming of string * string + | Illegal_renaming of string * string * string | File_not_found of string exception Error of error @@ -68,7 +66,7 @@ (* PR#5276, as above *) let name = Ident.name id in if String.contains name '.' then - Reloc_setglobal (Ident.create_persistent (packagename ^ "." ^ name)) + Reloc_setglobal (Ident.create_persistent (packagename ^ "." ^ name)) else rel end @@ -93,22 +91,21 @@ pm_name: string; pm_kind: pack_member_kind } -let read_member_info file = +let read_member_info file = ( let name = String.capitalize(Filename.basename(chop_extensions file)) in let kind = if Filename.check_suffix file ".cmo" then begin let ic = open_in_bin file in try - let buffer = String.create (String.length Config.cmo_magic_number) in - really_input ic buffer 0 (String.length Config.cmo_magic_number); + let buffer = input_bytes ic (String.length Config.cmo_magic_number) in if buffer <> Config.cmo_magic_number then raise(Error(Not_an_object_file file)); let compunit_pos = input_binary_int ic in seek_in ic compunit_pos; let compunit = (input_value ic : compilation_unit) in if compunit.cu_name <> name - then raise(Error(Illegal_renaming(file, compunit.cu_name))); + then raise(Error(Illegal_renaming(name, file, compunit.cu_name))); close_in ic; PM_impl compunit with x -> @@ -117,6 +114,7 @@ end else PM_intf in { pm_file = file; pm_name = name; pm_kind = kind } +) (* Read the bytecode from a .cmo file. Write bytecode to channel [oc]. @@ -124,10 +122,11 @@ Accumulate relocs, debug info, etc. Return size of bytecode. *) -let rename_append_bytecode packagename oc mapping defined ofs prefix subst objfile compunit = +let rename_append_bytecode ppf packagename oc mapping defined ofs prefix subst + objfile compunit = let ic = open_in_bin objfile in try - Bytelink.check_consistency objfile compunit; + Bytelink.check_consistency ppf objfile compunit; List.iter (rename_relocation packagename objfile mapping defined ofs) compunit.cu_reloc; @@ -148,22 +147,27 @@ (* Same, for a list of .cmo and .cmi files. Return total size of bytecode. *) -let rec rename_append_bytecode_list packagename oc mapping defined ofs prefix subst = function +let rec rename_append_bytecode_list ppf packagename oc mapping defined ofs + prefix subst = + function [] -> ofs | m :: rem -> match m.pm_kind with | PM_intf -> - rename_append_bytecode_list packagename oc mapping defined ofs prefix subst rem + rename_append_bytecode_list ppf packagename oc mapping defined ofs + prefix subst rem | PM_impl compunit -> let size = - rename_append_bytecode packagename oc mapping defined ofs prefix subst - m.pm_file compunit in + rename_append_bytecode ppf packagename oc mapping defined ofs + prefix subst m.pm_file compunit in let id = Ident.create_persistent m.pm_name in let root = Path.Pident (Ident.create_persistent prefix) in - rename_append_bytecode_list packagename - oc mapping (id :: defined) - (ofs + size) prefix (Subst.add_module id (Path.Pdot (root, Ident.name id, Path.nopos)) subst) rem + rename_append_bytecode_list ppf packagename oc mapping (id :: defined) + (ofs + size) prefix + (Subst.add_module id (Path.Pdot (root, Ident.name id, Path.nopos)) + subst) + rem (* Generate the code that builds the tuple representing the package module *) @@ -186,7 +190,7 @@ (* Build the .cmo file obtained by packaging the given .cmo files. *) -let package_object_files files targetfile targetname coercion = +let package_object_files ppf files targetfile targetname coercion = let members = map_left_right read_member_info files in let unit_names = @@ -203,7 +207,8 @@ let pos_depl = pos_out oc in output_binary_int oc 0; let pos_code = pos_out oc in - let ofs = rename_append_bytecode_list targetname oc mapping [] 0 targetname Subst.identity members in + let ofs = rename_append_bytecode_list ppf targetname oc mapping [] 0 + targetname Subst.identity members in build_global_target oc targetname members mapping ofs coercion; let pos_debug = pos_out oc in if !Clflags.debug && !events <> [] then @@ -233,19 +238,20 @@ (* The entry point *) -let package_files files targetfile = - let files = +let package_files ppf files targetfile = + let files = List.map - (fun f -> + (fun f -> try find_in_path !Config.load_path f with Not_found -> raise(Error(File_not_found f))) - files in - let prefix = chop_extensions targetfile in - let targetcmi = prefix ^ ".cmi" in - let targetname = String.capitalize(Filename.basename prefix) in - try - let coercion = Typemod.package_units files targetcmi targetname in - package_object_files files targetfile targetname coercion + files in + let prefix = chop_extensions targetfile in + let targetcmi = prefix ^ ".cmi" in + let targetname = String.capitalize(Filename.basename prefix) in + try + let coercion = Typemod.package_units files targetcmi targetname in + let ret = package_object_files ppf files targetfile targetname coercion in + ret with x -> remove_file targetfile; raise x @@ -255,13 +261,18 @@ let report_error ppf = function Forward_reference(file, ident) -> - fprintf ppf "Forward reference to %s in file %s" (Ident.name ident) file + fprintf ppf "Forward reference to %s in file %a" (Ident.name ident) + Location.print_filename file | Multiple_definition(file, ident) -> - fprintf ppf "File %s redefines %s" file (Ident.name ident) + fprintf ppf "File %a redefines %s" + Location.print_filename file + (Ident.name ident) | Not_an_object_file file -> - fprintf ppf "%s is not a bytecode object file" file - | Illegal_renaming(file, id) -> - fprintf ppf "Wrong file naming: %s@ contains the code for@ %s" - file id + fprintf ppf "%a is not a bytecode object file" + Location.print_filename file + | Illegal_renaming(name, file, id) -> + fprintf ppf "Wrong file naming: %a@ contains the code for\ + @ %s when %s was expected" + Location.print_filename file name id | File_not_found file -> fprintf ppf "File %s not found" file diff -Nru ocaml-3.12.1/bytecomp/bytepackager.mli ocaml-4.01.0/bytecomp/bytepackager.mli --- ocaml-3.12.1/bytecomp/bytepackager.mli 2002-02-08 16:55:44.000000000 +0000 +++ ocaml-4.01.0/bytecomp/bytepackager.mli 2013-04-29 14:57:38.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,18 +10,16 @@ (* *) (***********************************************************************) -(* $Id: bytepackager.mli 4367 2002-02-08 16:55:44Z xleroy $ *) - (* "Package" a set of .cmo files into one .cmo file having the original compilation units as sub-modules. *) -val package_files: string list -> string -> unit +val package_files: Format.formatter -> string list -> string -> unit type error = Forward_reference of string * Ident.t | Multiple_definition of string * Ident.t | Not_an_object_file of string - | Illegal_renaming of string * string + | Illegal_renaming of string * string * string | File_not_found of string exception Error of error diff -Nru ocaml-3.12.1/bytecomp/bytesections.ml ocaml-4.01.0/bytecomp/bytesections.ml --- ocaml-3.12.1/bytecomp/bytesections.ml 2004-02-22 15:07:51.000000000 +0000 +++ ocaml-4.01.0/bytecomp/bytesections.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: bytesections.ml 6130 2004-02-22 15:07:51Z xleroy $ *) - (* Handling of sections in bytecode executable files *) (* List of all sections, in reverse order *) @@ -48,14 +46,12 @@ let pos_trailer = in_channel_length ic - 16 in seek_in ic pos_trailer; let num_sections = input_binary_int ic in - let header = String.create(String.length Config.exec_magic_number) in - really_input ic header 0 (String.length Config.exec_magic_number); + let header = Misc.input_bytes ic (String.length Config.exec_magic_number) in if header <> Config.exec_magic_number then raise Bad_magic_number; seek_in ic (pos_trailer - 8 * num_sections); section_table := []; - for i = 1 to num_sections do - let name = String.create 4 in - really_input ic name 0 4; + for _i = 1 to num_sections do + let name = Misc.input_bytes ic 4 in let len = input_binary_int ic in section_table := (name, len) :: !section_table done @@ -81,10 +77,7 @@ (* Return the contents of a section, as a string *) let read_section_string ic name = - let len = seek_section ic name in - let res = String.create len in - really_input ic res 0 len; - res + Misc.input_bytes ic (seek_section ic name) (* Return the contents of a section, as marshalled data *) diff -Nru ocaml-3.12.1/bytecomp/bytesections.mli ocaml-4.01.0/bytecomp/bytesections.mli --- ocaml-3.12.1/bytecomp/bytesections.mli 2004-02-22 15:07:51.000000000 +0000 +++ ocaml-4.01.0/bytecomp/bytesections.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: bytesections.mli 6130 2004-02-22 15:07:51Z xleroy $ *) - (* Handling of sections in bytecode executable files *) (** Recording sections written to a bytecode executable file *) diff -Nru ocaml-3.12.1/bytecomp/cmo_format.mli ocaml-4.01.0/bytecomp/cmo_format.mli --- ocaml-3.12.1/bytecomp/cmo_format.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/bytecomp/cmo_format.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: cmo_format.mli 9547 2010-01-22 12:48:24Z doligez $ *) - (* Symbol table information for .cmo and .cma files *) (* Relocation information *) diff -Nru ocaml-3.12.1/bytecomp/dll.ml ocaml-4.01.0/bytecomp/dll.ml --- ocaml-3.12.1/bytecomp/dll.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/bytecomp/dll.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: dll.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Handling of dynamically-linked libraries *) type dll_handle @@ -40,6 +38,9 @@ let add_path dirs = search_path := dirs @ !search_path +let remove_path dirs = + search_path := List.filter (fun d -> not (List.mem d dirs)) !search_path + (* Extract the name of a DLLs from its external name (xxx.so or -lxxx) *) let extract_dll_name file = diff -Nru ocaml-3.12.1/bytecomp/dll.mli ocaml-4.01.0/bytecomp/dll.mli --- ocaml-3.12.1/bytecomp/dll.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/bytecomp/dll.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: dll.mli 9547 2010-01-22 12:48:24Z doligez $ *) - (* Handling of dynamically-linked libraries *) (* Extract the name of a DLLs from its external name (xxx.so or -lxxx) *) @@ -46,6 +44,9 @@ (* Add the given directories at the head of the search path for DLLs *) val add_path: string list -> unit +(* Remove the given directories from the search path for DLLs *) +val remove_path: string list -> unit + (* Initialization for separate compilation. Initialize the DLL search path to the directories given in the environment variable CAML_LD_LIBRARY_PATH, plus contents of ld.conf file diff -Nru ocaml-3.12.1/bytecomp/emitcode.ml ocaml-4.01.0/bytecomp/emitcode.ml --- ocaml-3.12.1/bytecomp/emitcode.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/bytecomp/emitcode.ml 2013-04-17 09:07:00.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: emitcode.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Generation of bytecode + relocation information *) open Config @@ -24,21 +22,21 @@ (* Buffering of bytecode *) -let out_buffer = ref(String.create 1024) +let out_buffer = ref(LongString.create 1024) and out_position = ref 0 let out_word b1 b2 b3 b4 = let p = !out_position in - if p >= String.length !out_buffer then begin - let len = String.length !out_buffer in - let new_buffer = String.create (2 * len) in - String.blit !out_buffer 0 new_buffer 0 len; + if p >= LongString.length !out_buffer then begin + let len = LongString.length !out_buffer in + let new_buffer = LongString.create (2 * len) in + LongString.blit !out_buffer 0 new_buffer 0 len; out_buffer := new_buffer end; - String.unsafe_set !out_buffer p (Char.unsafe_chr b1); - String.unsafe_set !out_buffer (p+1) (Char.unsafe_chr b2); - String.unsafe_set !out_buffer (p+2) (Char.unsafe_chr b3); - String.unsafe_set !out_buffer (p+3) (Char.unsafe_chr b4); + LongString.set !out_buffer p (Char.unsafe_chr b1); + LongString.set !out_buffer (p+1) (Char.unsafe_chr b2); + LongString.set !out_buffer (p+2) (Char.unsafe_chr b3); + LongString.set !out_buffer (p+3) (Char.unsafe_chr b4); out_position := p + 4 let out opcode = @@ -88,10 +86,10 @@ let backpatch (pos, orig) = let displ = (!out_position - orig) asr 2 in - !out_buffer.[pos] <- Char.unsafe_chr displ; - !out_buffer.[pos+1] <- Char.unsafe_chr (displ asr 8); - !out_buffer.[pos+2] <- Char.unsafe_chr (displ asr 16); - !out_buffer.[pos+3] <- Char.unsafe_chr (displ asr 24) + LongString.set !out_buffer pos (Char.unsafe_chr displ); + LongString.set !out_buffer (pos+1) (Char.unsafe_chr (displ asr 8)); + LongString.set !out_buffer (pos+2) (Char.unsafe_chr (displ asr 16)); + LongString.set !out_buffer (pos+3) (Char.unsafe_chr (displ asr 24)) let define_label lbl = if lbl >= Array.length !label_table then extend_label_table lbl; @@ -342,7 +340,8 @@ (Kgetglobal _ as instr1) :: (Kgetfield _ as instr2) :: c -> emit (Kpush :: instr1 :: instr2 :: ev :: c) | Kpush :: (Kevent {ev_kind = Event_before} as ev) :: - (Kacc _ | Kenvacc _ | Koffsetclosure _ | Kgetglobal _ | Kconst _ as instr) :: c -> + (Kacc _ | Kenvacc _ | Koffsetclosure _ | Kgetglobal _ | Kconst _ as instr):: + c -> emit (Kpush :: instr :: ev :: c) | Kgetglobal id :: Kgetfield n :: c -> out opGETGLOBALFIELD; slot_for_getglobal id; out_int n; emit c @@ -359,7 +358,7 @@ output_binary_int outchan 0; let pos_code = pos_out outchan in emit code; - output outchan !out_buffer 0 !out_position; + LongString.output outchan !out_buffer 0 !out_position; let (pos_debug, size_debug) = if !Clflags.debug then begin let p = pos_out outchan in @@ -373,7 +372,8 @@ cu_codesize = !out_position; cu_reloc = List.rev !reloc_info; cu_imports = Env.imported_units(); - cu_primitives = List.map Primitive.byte_name !Translmod.primitive_declarations; + cu_primitives = List.map Primitive.byte_name + !Translmod.primitive_declarations; cu_force_link = false; cu_debug = pos_debug; cu_debugsize = size_debug } in @@ -392,7 +392,7 @@ emit init_code; emit fun_code; let code = Meta.static_alloc !out_position in - String.unsafe_blit !out_buffer 0 code 0 !out_position; + LongString.unsafe_blit_to_string !out_buffer 0 code 0 !out_position; let reloc = List.rev !reloc_info and code_size = !out_position in init(); @@ -403,7 +403,7 @@ let to_packed_file outchan code = init(); emit code; - output outchan !out_buffer 0 !out_position; + LongString.output outchan !out_buffer 0 !out_position; let reloc = !reloc_info in init(); reloc diff -Nru ocaml-3.12.1/bytecomp/emitcode.mli ocaml-4.01.0/bytecomp/emitcode.mli --- ocaml-3.12.1/bytecomp/emitcode.mli 2006-05-11 15:50:53.000000000 +0000 +++ ocaml-4.01.0/bytecomp/emitcode.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: emitcode.mli 7422 2006-05-11 15:50:53Z xleroy $ *) - (* Generation of bytecode for .cmo files *) open Cmo_format diff -Nru ocaml-3.12.1/bytecomp/instruct.ml ocaml-4.01.0/bytecomp/instruct.ml --- ocaml-3.12.1/bytecomp/instruct.ml 2009-05-20 11:52:42.000000000 +0000 +++ ocaml-4.01.0/bytecomp/instruct.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: instruct.ml 9270 2009-05-20 11:52:42Z doligez $ *) - open Lambda type compilation_env = @@ -107,5 +105,5 @@ and immed_max = 0x3FFFFFFF (* Actually the abstract machine accomodates -0x80000000 to 0x7FFFFFFF, - but these numbers overflow the Caml type int if the compiler runs on + but these numbers overflow the OCaml type int if the compiler runs on a 32-bit processor. *) diff -Nru ocaml-3.12.1/bytecomp/instruct.mli ocaml-4.01.0/bytecomp/instruct.mli --- ocaml-3.12.1/bytecomp/instruct.mli 2009-05-20 11:52:42.000000000 +0000 +++ ocaml-4.01.0/bytecomp/instruct.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: instruct.mli 9270 2009-05-20 11:52:42Z doligez $ *) - (* The type of the instructions of the abstract machine *) open Lambda diff -Nru ocaml-3.12.1/bytecomp/lambda.ml ocaml-4.01.0/bytecomp/lambda.ml --- ocaml-3.12.1/bytecomp/lambda.ml 2010-09-02 13:29:21.000000000 +0000 +++ ocaml-4.01.0/bytecomp/lambda.ml 2012-11-29 09:55:00.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,15 +10,22 @@ (* *) (***********************************************************************) -(* $Id: lambda.ml 10667 2010-09-02 13:29:21Z xclerc $ *) - open Misc open Path open Asttypes +type compile_time_constant = + | Big_endian + | Word_size + | Ostype_unix + | Ostype_win32 + | Ostype_cygwin + type primitive = Pidentity | Pignore + | Prevapply of Location.t + | Pdirapply of Location.t (* Globals *) | Pgetglobal of Ident.t | Psetglobal of Ident.t @@ -84,6 +91,28 @@ (* Operations on big arrays: (unsafe, #dimensions, kind, layout) *) | Pbigarrayref of bool * int * bigarray_kind * bigarray_layout | Pbigarrayset of bool * int * bigarray_kind * bigarray_layout + (* size of the nth dimension of a big array *) + | Pbigarraydim of int + (* load/set 16,32,64 bits from a string: (unsafe)*) + | Pstring_load_16 of bool + | Pstring_load_32 of bool + | Pstring_load_64 of bool + | Pstring_set_16 of bool + | Pstring_set_32 of bool + | Pstring_set_64 of bool + (* load/set 16,32,64 bits from a + (char, int8_unsigned_elt, c_layout) Bigarray.Array1.t : (unsafe) *) + | Pbigstring_load_16 of bool + | Pbigstring_load_32 of bool + | Pbigstring_load_64 of bool + | Pbigstring_set_16 of bool + | Pbigstring_set_32 of bool + | Pbigstring_set_64 of bool + (* Compile time constants *) + | Pctconst of compile_time_constant + (* byte swap *) + | Pbswap16 + | Pbbswap of boxed_integer and comparison = Ceq | Cneq | Clt | Cgt | Cle | Cge @@ -239,7 +268,7 @@ Llet(Strict, id, arg, name_list (Lvar id :: names) rem) in name_list [] args -let rec iter f = function +let iter f = function Lvar _ | Lconst _ -> () | Lapply(fn, args, _) -> diff -Nru ocaml-3.12.1/bytecomp/lambda.mli ocaml-4.01.0/bytecomp/lambda.mli --- ocaml-3.12.1/bytecomp/lambda.mli 2010-09-02 13:29:21.000000000 +0000 +++ ocaml-4.01.0/bytecomp/lambda.mli 2012-11-29 09:55:00.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,15 +10,22 @@ (* *) (***********************************************************************) -(* $Id: lambda.mli 10667 2010-09-02 13:29:21Z xclerc $ *) - (* The "lambda" intermediate code *) open Asttypes +type compile_time_constant = + | Big_endian + | Word_size + | Ostype_unix + | Ostype_win32 + | Ostype_cygwin + type primitive = Pidentity | Pignore + | Prevapply of Location.t + | Pdirapply of Location.t (* Globals *) | Pgetglobal of Ident.t | Psetglobal of Ident.t @@ -84,6 +91,28 @@ (* Operations on big arrays: (unsafe, #dimensions, kind, layout) *) | Pbigarrayref of bool * int * bigarray_kind * bigarray_layout | Pbigarrayset of bool * int * bigarray_kind * bigarray_layout + (* size of the nth dimension of a big array *) + | Pbigarraydim of int + (* load/set 16,32,64 bits from a string: (unsafe)*) + | Pstring_load_16 of bool + | Pstring_load_32 of bool + | Pstring_load_64 of bool + | Pstring_set_16 of bool + | Pstring_set_32 of bool + | Pstring_set_64 of bool + (* load/set 16,32,64 bits from a + (char, int8_unsigned_elt, c_layout) Bigarray.Array1.t : (unsafe) *) + | Pbigstring_load_16 of bool + | Pbigstring_load_32 of bool + | Pbigstring_load_64 of bool + | Pbigstring_set_16 of bool + | Pbigstring_set_32 of bool + | Pbigstring_set_64 of bool + (* Compile time constants *) + | Pctconst of compile_time_constant + (* byte swap *) + | Pbswap16 + | Pbbswap of boxed_integer and comparison = Ceq | Cneq | Clt | Cgt | Cle | Cge diff -Nru ocaml-3.12.1/bytecomp/matching.ml ocaml-4.01.0/bytecomp/matching.ml --- ocaml-3.12.1/bytecomp/matching.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/bytecomp/matching.ml 2013-07-23 14:48:47.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: matching.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Compilation of pattern matching *) open Misc @@ -32,12 +30,12 @@ (* - Many functions on the various data structures ofthe algorithm : + Many functions on the various data structures of the algorithm : - Pattern matrices. - Default environments: mapping from matrices to exit numbers. - Contexts: matrices whose column are partitioned into left and right. - - Jump sumaries: mapping from exit numbers to contexts + - Jump summaries: mapping from exit numbers to contexts *) type matrix = pattern list list @@ -124,7 +122,7 @@ let rec filter_rec = function | (p::ps)::rem -> begin match p.pat_desc with - | Tpat_alias (p,_) -> + | Tpat_alias (p,_,_) -> filter_rec ((p::ps)::rem) | Tpat_var _ -> filter_rec ((omega::ps)::rem) @@ -162,15 +160,15 @@ let ctx_matcher p = let p = normalize_pat p in match p.pat_desc with - | Tpat_construct (cstr,omegas) -> + | Tpat_construct (_, cstr,omegas,_) -> (fun q rem -> match q.pat_desc with - | Tpat_construct (cstr',args) when cstr.cstr_tag=cstr'.cstr_tag -> + | Tpat_construct (_, cstr',args,_) when cstr.cstr_tag=cstr'.cstr_tag -> p,args @ rem | Tpat_any -> p,omegas @ rem | _ -> raise NoMatch) | Tpat_constant cst -> (fun q rem -> match q.pat_desc with - | Tpat_constant cst' when cst=cst' -> + | Tpat_constant cst' when const_compare cst cst' = 0 -> p,rem | Tpat_any -> p,rem | _ -> raise NoMatch) @@ -197,12 +195,12 @@ (fun q rem -> match q.pat_desc with | Tpat_tuple args -> p,args @ rem | _ -> p, omegas @ rem) - | Tpat_record l -> (* Records are normalized *) + | Tpat_record (l,_) -> (* Records are normalized *) (fun q rem -> match q.pat_desc with - | Tpat_record l' -> + | Tpat_record (l',_) -> let l' = all_record_args l' in - p, List.fold_right (fun (_,p) r -> p::r) l' rem - | _ -> p,List.fold_right (fun (_,p) r -> p::r) l rem) + p, List.fold_right (fun (_, _,p) r -> p::r) l' rem + | _ -> p,List.fold_right (fun (_, _,p) r -> p::r) l rem) | Tpat_lazy omega -> (fun q rem -> match q.pat_desc with | Tpat_lazy arg -> p, (arg::rem) @@ -221,7 +219,7 @@ begin match p.pat_desc with | Tpat_or (p1,p2,_) -> filter_rec ({l with right=p1::ps}::{l with right=p2::ps}::rem) - | Tpat_alias (p,_) -> + | Tpat_alias (p,_,_) -> filter_rec ({l with right=p::ps}::rem) | Tpat_var _ -> filter_rec ({l with right=omega::ps}::rem) @@ -274,9 +272,9 @@ pss) ctx -type jumps = (int * ctx ) list +type jumps = (int * ctx list) list -let pretty_jumps env = match env with +let pretty_jumps (env : jumps) = match env with | [] -> () | _ -> List.iter @@ -321,7 +319,7 @@ add jumps -let rec jumps_union env1 env2 = match env1,env2 with +let rec jumps_union (env1:(int*ctx list)list) env2 = match env1,env2 with | [],_ -> env2 | _,[] -> env1 | ((i1,pss1) as x1::rem1), ((i2,pss2) as x2::rem2) -> @@ -342,7 +340,7 @@ | [env] -> env | _ -> jumps_unions (merge envs) -let rec jumps_map f env = +let jumps_map f env = List.map (fun (i,pss) -> i,f pss) env @@ -433,7 +431,7 @@ (* A slight attempt to identify semantically equivalent lambda-expressions *) exception Not_simple -let rec raw_rec env = function +let rec raw_rec env : lambda -> lambda = function | Llet(Alias,x,ex, body) -> raw_rec ((x,raw_rec env ex)::env) body | Lvar id as l -> begin try List.assoc id env with @@ -507,11 +505,11 @@ let simplify_or p = let rec simpl_rec p = match p with | {pat_desc = Tpat_any|Tpat_var _} -> raise (Var p) - | {pat_desc = Tpat_alias (q,id)} -> + | {pat_desc = Tpat_alias (q,id,s)} -> begin try - {p with pat_desc = Tpat_alias (simpl_rec q,id)} + {p with pat_desc = Tpat_alias (simpl_rec q,id,s)} with - | Var q -> raise (Var {p with pat_desc = Tpat_alias (q,id)}) + | Var q -> raise (Var {p with pat_desc = Tpat_alias (q,id,s)}) end | {pat_desc = Tpat_or (p1,p2,o)} -> let q1 = simpl_rec p1 in @@ -521,35 +519,36 @@ with | Var q2 -> raise (Var {p with pat_desc = Tpat_or (q1, q2, o)}) end - | {pat_desc = Tpat_record lbls} -> + | {pat_desc = Tpat_record (lbls,closed)} -> let all_lbls = all_record_args lbls in - {p with pat_desc=Tpat_record all_lbls} + {p with pat_desc=Tpat_record (all_lbls, closed)} | _ -> p in try simpl_rec p with | Var p -> p -let rec simplify_cases args cls = match args with +let simplify_cases args cls = match args with | [] -> assert false | (arg,_)::_ -> let rec simplify = function | [] -> [] | ((pat :: patl, action) as cl) :: rem -> begin match pat.pat_desc with - | Tpat_var id -> + | Tpat_var (id, _) -> (omega :: patl, bind Alias id arg action) :: simplify rem | Tpat_any -> cl :: simplify rem - | Tpat_alias(p, id) -> + | Tpat_alias(p, id,_) -> simplify ((p :: patl, bind Alias id arg action) :: rem) - | Tpat_record [] -> + | Tpat_record ([],_) -> (omega :: patl, action):: simplify rem - | Tpat_record lbls -> + | Tpat_record (lbls, closed) -> let all_lbls = all_record_args lbls in - let full_pat = {pat with pat_desc=Tpat_record all_lbls} in + let full_pat = + {pat with pat_desc=Tpat_record (all_lbls, closed)} in (full_pat::patl,action):: simplify rem | Tpat_or _ -> @@ -574,7 +573,7 @@ let rec what_is_cases cases = match cases with | ({pat_desc=Tpat_any} :: _, _) :: rem -> what_is_cases rem -| (({pat_desc=(Tpat_var _|Tpat_or (_,_,_)|Tpat_alias (_,_))}::_),_)::_ +| (({pat_desc=(Tpat_var _|Tpat_or (_,_,_)|Tpat_alias (_,_,_))}::_),_)::_ -> assert false (* applies to simplified matchings only *) | (p::_,_)::_ -> p | [] -> omega @@ -606,16 +605,16 @@ (* Or-pattern expansion, variables are a complication w.r.t. the article *) let rec extract_vars r p = match p.pat_desc with -| Tpat_var id -> IdentSet.add id r -| Tpat_alias (p, id) -> +| Tpat_var (id, _) -> IdentSet.add id r +| Tpat_alias (p, id,_ ) -> extract_vars (IdentSet.add id r) p | Tpat_tuple pats -> List.fold_left extract_vars r pats -| Tpat_record lpats -> +| Tpat_record (lpats,_) -> List.fold_left - (fun r (_,p) -> extract_vars r p) + (fun r (_, _, p) -> extract_vars r p) r lpats -| Tpat_construct (_,pats) -> +| Tpat_construct (_, _, pats,_) -> List.fold_left extract_vars r pats | Tpat_array pats -> List.fold_left extract_vars r pats @@ -643,9 +642,9 @@ arg patl mk_action (explode_or_pat arg patl mk_action rem vars aliases p2) vars aliases p1 - | {pat_desc = Tpat_alias (p,id)} -> + | {pat_desc = Tpat_alias (p,id, _)} -> explode_or_pat arg patl mk_action rem vars (id::aliases) p - | {pat_desc = Tpat_var x} -> + | {pat_desc = Tpat_var (x, _)} -> let env = mk_alpha_env arg (x::aliases) vars in (omega::patl,mk_action (List.map snd env))::rem | p -> @@ -665,7 +664,7 @@ | _ -> false and group_constructor = function - | {pat_desc = Tpat_construct (_, _)} -> true + | {pat_desc = Tpat_construct _} -> true | _ -> false and group_variant = function @@ -695,7 +694,7 @@ let get_group p = match p.pat_desc with | Tpat_any -> group_var | Tpat_constant _ -> group_constant -| Tpat_construct (_, _) -> group_constructor +| Tpat_construct _ -> group_constructor | Tpat_tuple _ -> group_tuple | Tpat_record _ -> group_record | Tpat_array _ -> group_array @@ -1023,9 +1022,9 @@ ctx : ctx list ; pat : pattern} -let add make_matching_fun division key patl_action args = +let add make_matching_fun division eq_key key patl_action args = try - let cell = List.assoc key division in + let (_,cell) = List.find (fun (k,_) -> eq_key key k) division in cell.pm.cases <- patl_action :: cell.pm.cases; division with Not_found -> @@ -1034,14 +1033,14 @@ (key, cell) :: division -let divide make get_key get_args ctx pm = +let divide make eq_key get_key get_args ctx pm = let rec divide_rec = function | (p::patl,action) :: rem -> let this_match = divide_rec rem in add (make p pm.default ctx) - this_match (get_key p) (get_args p patl,action) pm.args + this_match eq_key (get_key p) (get_args p patl,action) pm.args | _ -> [] in divide_rec pm.cases @@ -1084,8 +1083,8 @@ matcher_const cst p1 rem with | NoMatch -> matcher_const cst p2 rem end -| Tpat_constant c1 when c1=cst -> rem -| Tpat_any -> rem +| Tpat_constant c1 when const_compare c1 cst = 0 -> rem +| Tpat_any -> rem | _ -> raise NoMatch let get_key_constant caller = function @@ -1114,7 +1113,8 @@ let divide_constant ctx m = divide - make_constant_matching (get_key_constant "divide") + make_constant_matching + (fun c d -> const_compare c d = 0) (get_key_constant "divide") get_args_constant ctx m @@ -1129,15 +1129,15 @@ in make_args first_pos let get_key_constr = function - | {pat_desc=Tpat_construct (cstr,_)} -> cstr.cstr_tag + | {pat_desc=Tpat_construct (_, cstr,_,_)} -> cstr.cstr_tag | _ -> assert false let get_args_constr p rem = match p with -| {pat_desc=Tpat_construct (_,args)} -> args @ rem +| {pat_desc=Tpat_construct (_, _, args, _)} -> args @ rem | _ -> assert false let pat_as_constr = function - | {pat_desc=Tpat_construct (cstr,_)} -> cstr + | {pat_desc=Tpat_construct (_, cstr,_,_)} -> cstr | _ -> fatal_error "Matching.pat_as_constr" @@ -1151,7 +1151,7 @@ with | NoMatch -> matcher_rec p2 rem end - | Tpat_construct (cstr1, []) when cstr.cstr_tag = cstr1.cstr_tag -> + | Tpat_construct (_, cstr1, [],_) when cstr.cstr_tag = cstr1.cstr_tag -> rem | Tpat_any -> rem | _ -> raise NoMatch in @@ -1167,21 +1167,21 @@ | None, Some r2 -> r2 | Some (a1::rem1), Some (a2::_) -> {a1 with -pat_loc = Location.none ; -pat_desc = Tpat_or (a1, a2, None)}:: + pat_loc = Location.none ; + pat_desc = Tpat_or (a1, a2, None)}:: rem | _, _ -> assert false end - | Tpat_construct (cstr1, [arg]) when cstr.cstr_tag = cstr1.cstr_tag -> - arg::rem + | Tpat_construct (_, cstr1, [arg],_) + when cstr.cstr_tag = cstr1.cstr_tag -> arg::rem | Tpat_any -> omega::rem | _ -> raise NoMatch in matcher_rec | _ -> fun q rem -> match q.pat_desc with | Tpat_or (_,_,_) -> raise OrPat - | Tpat_construct (cstr1, args) - when cstr.cstr_tag = cstr1.cstr_tag -> args @ rem + | Tpat_construct (_, cstr1, args,_) + when cstr.cstr_tag = cstr1.cstr_tag -> args @ rem | Tpat_any -> Parmatch.omegas cstr.cstr_arity @ rem | _ -> raise NoMatch @@ -1205,7 +1205,7 @@ let divide_constructor ctx pm = divide make_constr_matching - get_key_constr get_args_constr + (=) get_key_constr get_args_constr ctx pm (* Matching against a variant *) @@ -1269,10 +1269,10 @@ match pato with None -> add (make_variant_matching_constant p lab def ctx) variants - (Cstr_constant tag) (patl, action) al + (=) (Cstr_constant tag) (patl, action) al | Some pat -> add (make_variant_matching_nonconst p lab def ctx) variants - (Cstr_block tag) (pat :: patl, action) al + (=) (Cstr_block tag) (pat :: patl, action) al end | cl -> [] in @@ -1329,7 +1329,8 @@ match Env.lookup_value (Longident.Lident field) env with | (Path.Pdot(_,_,i), _) -> i | _ -> fatal_error ("Primitive "^modname^"."^field^" not found.") - with Not_found -> fatal_error ("Primitive "^modname^"."^field^" not found.") + with Not_found -> + fatal_error ("Primitive "^modname^"."^field^" not found.") in Lprim(Pfield p, [Lprim(Pgetglobal mod_ident, [])]) with Not_found -> fatal_error ("Module "^modname^" unavailable.") @@ -1379,21 +1380,21 @@ (Lswitch (varg, { sw_numconsts = 0; sw_consts = []; - sw_numblocks = (max Obj.lazy_tag Obj.forward_tag) + 1; + sw_numblocks = 256; (* PR#6033 - tag ranges from 0 to 255 *) sw_blocks = [ (Obj.forward_tag, Lprim(Pfield 0, [varg])); (Obj.lazy_tag, Lapply(force_fun, [varg], loc)) ]; sw_failaction = Some varg } )))) -let inline_lazy_force = +let inline_lazy_force arg loc = if !Clflags.native_code then (* Lswitch generates compact and efficient native code *) - inline_lazy_force_switch + inline_lazy_force_switch arg loc else (* generating bytecode: Lswitch would generate too many rather big tables (~ 250 elts); conditionals are better *) - inline_lazy_force_cond + inline_lazy_force_cond arg loc let make_lazy_matching def = function [] -> fatal_error "Matching.make_lazy_matching" @@ -1446,13 +1447,13 @@ let record_matching_line num_fields lbl_pat_list = let patv = Array.create num_fields omega in - List.iter (fun (lbl, pat) -> patv.(lbl.lbl_pos) <- pat) lbl_pat_list; + List.iter (fun (_, lbl, pat) -> patv.(lbl.lbl_pos) <- pat) lbl_pat_list; Array.to_list patv let get_args_record num_fields p rem = match p with | {pat_desc=Tpat_any} -> record_matching_line num_fields [] @ rem -| {pat_desc=Tpat_record lbl_pat_list} -> +| {pat_desc=Tpat_record (lbl_pat_list,_)} -> record_matching_line num_fields lbl_pat_list @ rem | _ -> assert false @@ -1524,20 +1525,12 @@ let divide_array kind ctx pm = divide (make_array_matching kind) - get_key_array get_args_array ctx pm + (=) get_key_array get_args_array ctx pm (* To combine sub-matchings together *) -let float_compare s1 s2 = - let f1 = float_of_string s1 and f2 = float_of_string s2 in - Pervasives.compare f1 f2 - let sort_lambda_list l = - List.sort - (fun (x,_) (y,_) -> match x,y with - | Const_float f1, Const_float f2 -> float_compare f1 f2 - | _, _ -> Pervasives.compare x y) - l + List.sort (fun (x,_) (y,_) -> const_compare x y) l let rec cut n l = if n = 0 then [],l @@ -1761,7 +1754,7 @@ (cur_low,i-1,0):: nofail_rec i i index rem in - let rec init_rec = function + let init_rec = function | [] -> [] | (i,act_i)::rem -> let index = store.act_store act_i in @@ -1846,7 +1839,7 @@ | Tpat_or (p1,p2,_) -> let k1,seen1 = extract_pat seen k p1 in extract_pat seen1 k1 p2 -| Tpat_alias (p,_) -> +| Tpat_alias (p,_,_) -> extract_pat seen k p | Tpat_var _|Tpat_any -> raise All @@ -2037,7 +2030,7 @@ List.fold_right (fun (ex, act) rem -> match ex with - | Cstr_exception path -> + | Cstr_exception (path, _) -> Lifthenelse(Lprim(Pintcomp Ceq, [Lprim(Pfield 0, [arg]); transl_path path]), act, rem) @@ -2323,13 +2316,14 @@ | Alias,_ -> lower_bind v arg lam | _,_ -> bind str v arg lam -let rec comp_exit ctx m = match m.default with +let comp_exit ctx m = match m.default with | (_,i)::_ -> Lstaticraise (i,[]), jumps_singleton i ctx | _ -> fatal_error "Matching.comp_exit" -let rec comp_match_handlers comp_fun partial ctx arg first_match next_matchs = match next_matchs with +let rec comp_match_handlers comp_fun partial ctx arg first_match next_matchs = + match next_matchs with | [] -> comp_fun partial ctx arg first_match | rem -> let rec c_rec body total_body = function @@ -2367,8 +2361,8 @@ let rec name_pattern default = function (pat :: patl, action) :: rem -> begin match pat.pat_desc with - Tpat_var id -> id - | Tpat_alias(p, id) -> id + Tpat_var (id, _) -> id + | Tpat_alias(p, id, _) -> id | _ -> name_pattern default rem end | _ -> Ident.create default @@ -2391,6 +2385,7 @@ Output: a lambda term, a jump summary {..., exit number -> context, .. } *) +let dbg = false let rec compile_match repr partial ctx m = match m with | { cases = [] } -> comp_exit ctx m @@ -2408,13 +2403,14 @@ { m with args = (newarg, Alias) :: argl } in let (lam, total) = comp_match_handlers - (do_compile_matching repr) partial ctx newarg first_match rem in + ((if dbg then do_compile_matching_pr else do_compile_matching) repr) + partial ctx newarg first_match rem in bind_check str v arg lam, total | _ -> assert false (* verbose version of do_compile_matching, for debug *) -(* + and do_compile_matching_pr repr partial ctx arg x = prerr_string "COMPILE: " ; prerr_endline (match partial with Partial -> "Partial" | Total -> "Total") ; @@ -2426,7 +2422,7 @@ prerr_endline "JUMPS" ; pretty_jumps jumps ; r -*) + and do_compile_matching repr partial ctx arg pmh = match pmh with | Pm pm -> let pat = what_is_cases pm.cases in @@ -2438,7 +2434,7 @@ compile_no_test (divide_tuple (List.length patl) (normalize_pat pat)) ctx_combine repr partial ctx pm - | Tpat_record ((lbl,_)::_) -> + | Tpat_record ((_, lbl,_)::_,_) -> compile_no_test (divide_record lbl.lbl_all (normalize_pat pat)) ctx_combine repr partial ctx pm @@ -2448,7 +2444,7 @@ divide_constant (combine_constant arg cst partial) ctx pm - | Tpat_construct (cstr, _) -> + | Tpat_construct (_, cstr, _, _) -> compile_test (compile_match repr partial) partial divide_constructor (combine_constructor arg pat cstr partial) @@ -2488,21 +2484,86 @@ (* The entry points *) (* - If there is a guard in a matching, then - set exhaustiveness info to Partial. - (because of side effects in guards, assume the worst) + If there is a guard in a matching or a lazy pattern, + then set exhaustiveness info to Partial. + (because of side effects, assume the worst). + + Notice that exhaustiveness information is trusted by the compiler, + that is, a match flagged as Total should not fail at runtime. + More specifically, for instance if match y with x::_ -> x uis flagged + total (as it happens during JoCaml compilation) then y cannot be [] + at runtime. As a consequence, the static Total exhaustiveness information + have to to be downgraded to Partial, in the dubious cases where guards + or lazy pattern execute arbitrary code that may perform side effects + and change the subject values. +LM: + Lazy pattern was PR #5992, initial patch by lwp25. + I have generalized teh patch, so as to also find mutable fields. *) -let check_partial pat_act_list partial = - if +let find_in_pat pred = + let rec find_rec p = + pred p.pat_desc || + begin match p.pat_desc with + | Tpat_alias (p,_,_) | Tpat_variant (_,Some p,_) | Tpat_lazy p -> + find_rec p + | Tpat_tuple ps|Tpat_construct (_,_,ps,_) | Tpat_array ps -> + List.exists find_rec ps + | Tpat_record (lpats,_) -> + List.exists + (fun (_, _, p) -> find_rec p) + lpats + | Tpat_or (p,q,_) -> + find_rec p || find_rec q + | Tpat_constant _ | Tpat_var _ + | Tpat_any | Tpat_variant (_,None,_) -> false + end in + find_rec + +let is_lazy_pat = function + | Tpat_lazy _ -> true + | Tpat_alias _ | Tpat_variant _ | Tpat_record _ + | Tpat_tuple _|Tpat_construct _ | Tpat_array _ + | Tpat_or _ | Tpat_constant _ | Tpat_var _ | Tpat_any + -> false + +let is_lazy p = find_in_pat is_lazy_pat p + +let have_mutable_field p = match p with +| Tpat_record (lps,_) -> List.exists - (fun (_,lam) -> is_guarded lam) - pat_act_list - then begin - Partial - end else - partial + (fun (_,lbl,_) -> + match lbl.Types.lbl_mut with + | Mutable -> true + | Immutable -> false) + lps +| Tpat_alias _ | Tpat_variant _ | Tpat_lazy _ +| Tpat_tuple _|Tpat_construct _ | Tpat_array _ +| Tpat_or _ +| Tpat_constant _ | Tpat_var _ | Tpat_any + -> false + +let is_mutable p = find_in_pat have_mutable_field p + +(* Downgrade Total when + 1. Matching accesses some mutable fields; + 2. And there are guards or lazy patterns. +*) +let check_partial is_mutable is_lazy pat_act_list = function + | Partial -> Partial + | Total -> + if + List.exists + (fun (pats, lam) -> + is_mutable pats && (is_guarded lam || is_lazy pats)) + pat_act_list + then Partial + else Total + +let check_partial_list = + check_partial (List.exists is_mutable) (List.exists is_lazy) +let check_partial = check_partial is_mutable is_lazy (* have toplevel handler when appropriate *) @@ -2542,13 +2603,7 @@ let partial_function loc () = (* [Location.get_pos_info] is too expensive *) - let fname = match loc.Location.loc_start.Lexing.pos_fname with - | "" -> !Location.input_name - | x -> x - in - let pos = loc.Location.loc_start in - let line = pos.Lexing.pos_lnum in - let char = pos.Lexing.pos_cnum - pos.Lexing.pos_bol in + let (fname, line, char) = Location.get_pos_info loc.Location.loc_start in Lprim(Praise, [Lprim(Pmakeblock(0, Immutable), [transl_path Predef.path_match_failure; Lconst(Const_block(0, @@ -2571,7 +2626,7 @@ (* Easy case since variables are available *) let for_tupled_function loc paraml pats_act_list partial = - let partial = check_partial pats_act_list partial in + let partial = check_partial_list pats_act_list partial in let raise_num = next_raise_count () in let omegas = [List.map (fun _ -> omega) paraml] in let pm = @@ -2597,8 +2652,8 @@ | Tpat_any -> omegas size::k | Tpat_tuple args -> args::k | Tpat_or (p1,p2,_) -> flatten_pat_line size p1 (flatten_pat_line size p2 k) -| Tpat_alias (p,_) -> (* Note: if this 'as' pat is here, then this is a useless - binding, solves PR #3780 *) +| Tpat_alias (p,_,_) -> (* Note: if this 'as' pat is here, then this is a + useless binding, solves PR #3780 *) flatten_pat_line size p k | _ -> fatal_error "Matching.flatten_pat_line" @@ -2626,7 +2681,7 @@ default = flatten_def size pm.default} -let rec flatten_precompiled size args pmh = match pmh with +let flatten_precompiled size args pmh = match pmh with | Pm pm -> Pm (flatten_pm size args pm) | PmOr {body=b ; handlers=hs ; or_matrix=m} -> PmOr @@ -2715,7 +2770,7 @@ v,Lvar v -let rec param_to_var param = match param with +let param_to_var param = match param with | Lvar v -> v,None | _ -> Ident.create "match",Some param diff -Nru ocaml-3.12.1/bytecomp/matching.mli ocaml-4.01.0/bytecomp/matching.mli --- ocaml-3.12.1/bytecomp/matching.mli 2008-08-01 16:57:10.000000000 +0000 +++ ocaml-4.01.0/bytecomp/matching.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: matching.mli 8974 2008-08-01 16:57:10Z mauny $ *) - (* Compilation of pattern-matching *) open Typedtree diff -Nru ocaml-3.12.1/bytecomp/meta.ml ocaml-4.01.0/bytecomp/meta.ml --- ocaml-3.12.1/bytecomp/meta.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/bytecomp/meta.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: meta.ml 9547 2010-01-22 12:48:24Z doligez $ *) - external global_data : unit -> Obj.t array = "caml_get_global_data" external realloc_global_data : int -> unit = "caml_realloc_global" external static_alloc : int -> string = "caml_static_alloc" diff -Nru ocaml-3.12.1/bytecomp/meta.mli ocaml-4.01.0/bytecomp/meta.mli --- ocaml-3.12.1/bytecomp/meta.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/bytecomp/meta.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: meta.mli 9547 2010-01-22 12:48:24Z doligez $ *) - (* To control the runtime system and bytecode interpreter *) external global_data : unit -> Obj.t array = "caml_get_global_data" diff -Nru ocaml-3.12.1/bytecomp/printinstr.ml ocaml-4.01.0/bytecomp/printinstr.ml --- ocaml-3.12.1/bytecomp/printinstr.ml 2005-08-25 15:35:16.000000000 +0000 +++ ocaml-4.01.0/bytecomp/printinstr.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: printinstr.ml 7031 2005-08-25 15:35:16Z doligez $ *) - (* Pretty-print lists of instructions *) open Format diff -Nru ocaml-3.12.1/bytecomp/printinstr.mli ocaml-4.01.0/bytecomp/printinstr.mli --- ocaml-3.12.1/bytecomp/printinstr.mli 2000-03-06 22:12:09.000000000 +0000 +++ ocaml-4.01.0/bytecomp/printinstr.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: printinstr.mli 2908 2000-03-06 22:12:09Z weis $ *) - (* Pretty-print lists of instructions *) open Instruct diff -Nru ocaml-3.12.1/bytecomp/printlambda.ml ocaml-4.01.0/bytecomp/printlambda.ml --- ocaml-3.12.1/bytecomp/printlambda.ml 2010-09-02 13:29:21.000000000 +0000 +++ ocaml-4.01.0/bytecomp/printlambda.ml 2012-11-29 09:55:00.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: printlambda.ml 10667 2010-09-02 13:29:21Z xclerc $ *) - open Format open Asttypes open Primitive @@ -92,6 +90,8 @@ let primitive ppf = function | Pidentity -> fprintf ppf "id" | Pignore -> fprintf ppf "ignore" + | Prevapply _ -> fprintf ppf "revapply" + | Pdirapply _ -> fprintf ppf "dirapply" | Pgetglobal id -> fprintf ppf "global %a" Ident.print id | Psetglobal id -> fprintf ppf "setglobal %a" Ident.print id | Pmakeblock(tag, Immutable) -> fprintf ppf "makeblock %i" tag @@ -154,6 +154,14 @@ | Parraysetu _ -> fprintf ppf "array.unsafe_set" | Parrayrefs _ -> fprintf ppf "array.get" | Parraysets _ -> fprintf ppf "array.set" + | Pctconst c -> + let const_name = match c with + | Big_endian -> "big_endian" + | Word_size -> "word_size" + | Ostype_unix -> "ostype_unix" + | Ostype_win32 -> "ostype_win32" + | Ostype_cygwin -> "ostype_cygwin" in + fprintf ppf "sys.constant_%s" const_name | Pisint -> fprintf ppf "isint" | Pisout -> fprintf ppf "isout" | Pbittest -> fprintf ppf "testbit" @@ -182,6 +190,45 @@ print_bigarray "get" unsafe kind ppf layout | Pbigarrayset(unsafe, n, kind, layout) -> print_bigarray "set" unsafe kind ppf layout + | Pbigarraydim(n) -> fprintf ppf "Bigarray.dim_%i" n + | Pstring_load_16(unsafe) -> + if unsafe then fprintf ppf "string.unsafe_get16" + else fprintf ppf "string.get16" + | Pstring_load_32(unsafe) -> + if unsafe then fprintf ppf "string.unsafe_get32" + else fprintf ppf "string.get32" + | Pstring_load_64(unsafe) -> + if unsafe then fprintf ppf "string.unsafe_get64" + else fprintf ppf "string.get64" + | Pstring_set_16(unsafe) -> + if unsafe then fprintf ppf "string.unsafe_set16" + else fprintf ppf "string.set16" + | Pstring_set_32(unsafe) -> + if unsafe then fprintf ppf "string.unsafe_set32" + else fprintf ppf "string.set32" + | Pstring_set_64(unsafe) -> + if unsafe then fprintf ppf "string.unsafe_set64" + else fprintf ppf "string.set64" + | Pbigstring_load_16(unsafe) -> + if unsafe then fprintf ppf "bigarray.array1.unsafe_get16" + else fprintf ppf "bigarray.array1.get16" + | Pbigstring_load_32(unsafe) -> + if unsafe then fprintf ppf "bigarray.array1.unsafe_get32" + else fprintf ppf "bigarray.array1.get32" + | Pbigstring_load_64(unsafe) -> + if unsafe then fprintf ppf "bigarray.array1.unsafe_get64" + else fprintf ppf "bigarray.array1.get64" + | Pbigstring_set_16(unsafe) -> + if unsafe then fprintf ppf "bigarray.array1.unsafe_set16" + else fprintf ppf "bigarray.array1.set16" + | Pbigstring_set_32(unsafe) -> + if unsafe then fprintf ppf "bigarray.array1.unsafe_set32" + else fprintf ppf "bigarray.array1.set32" + | Pbigstring_set_64(unsafe) -> + if unsafe then fprintf ppf "bigarray.array1.unsafe_set64" + else fprintf ppf "bigarray.array1.set64" + | Pbswap16 -> fprintf ppf "bswap16" + | Pbbswap(bi) -> print_boxed_integer "bswap" ppf bi let rec lam ppf = function | Lvar id -> @@ -297,7 +344,10 @@ | Lev_before -> "before" | Lev_after _ -> "after" | Lev_function -> "funct-body" in - fprintf ppf "@[<2>(%s %i-%i@ %a)@]" kind + fprintf ppf "@[<2>(%s %s(%i)%s:%i-%i@ %a)@]" kind + ev.lev_loc.Location.loc_start.Lexing.pos_fname + ev.lev_loc.Location.loc_start.Lexing.pos_lnum + (if ev.lev_loc.Location.loc_ghost then "" else "") ev.lev_loc.Location.loc_start.Lexing.pos_cnum ev.lev_loc.Location.loc_end.Lexing.pos_cnum lam expr diff -Nru ocaml-3.12.1/bytecomp/printlambda.mli ocaml-4.01.0/bytecomp/printlambda.mli --- ocaml-3.12.1/bytecomp/printlambda.mli 2000-03-06 22:12:09.000000000 +0000 +++ ocaml-4.01.0/bytecomp/printlambda.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,11 +10,10 @@ (* *) (***********************************************************************) -(* $Id: printlambda.mli 2908 2000-03-06 22:12:09Z weis $ *) - open Lambda open Format val structured_constant: formatter -> structured_constant -> unit val lambda: formatter -> lambda -> unit +val primitive: formatter -> primitive -> unit diff -Nru ocaml-3.12.1/bytecomp/runtimedef.mli ocaml-4.01.0/bytecomp/runtimedef.mli --- ocaml-3.12.1/bytecomp/runtimedef.mli 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/bytecomp/runtimedef.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: runtimedef.mli 2553 1999-11-17 18:59:06Z xleroy $ *) - (* Values and functions known and/or provided by the runtime system *) val builtin_exceptions: string array diff -Nru ocaml-3.12.1/bytecomp/simplif.ml ocaml-4.01.0/bytecomp/simplif.ml --- ocaml-3.12.1/bytecomp/simplif.ml 2010-09-02 13:29:21.000000000 +0000 +++ ocaml-4.01.0/bytecomp/simplif.ml 2013-03-09 22:38:52.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: simplif.ml 10667 2010-09-02 13:29:21Z xclerc $ *) - (* Elimination of useless Llet(Alias) bindings. Also transform let-bound references into variables. *) @@ -190,7 +188,23 @@ | Llet(kind, v, l1, l2) -> Llet(kind, v, simplif l1, simplif l2) | Lletrec(bindings, body) -> Lletrec(List.map (fun (v, l) -> (v, simplif l)) bindings, simplif body) - | Lprim(p, ll) -> Lprim(p, List.map simplif ll) + | Lprim(p, ll) -> begin + let ll = List.map simplif ll in + match p, ll with + (* Simplify %revapply, for n-ary functions with n > 1 *) + | Prevapply loc, [x; Lapply(f, args, _)] + | Prevapply loc, [x; Levent (Lapply(f, args, _),_)] -> + Lapply(f, args@[x], loc) + | Prevapply loc, [x; f] -> Lapply(f, [x], loc) + + (* Simplify %apply, for n-ary functions with n > 1 *) + | Pdirapply loc, [Lapply(f, args, _); x] + | Pdirapply loc, [Levent (Lapply(f, args, _),_); x] -> + Lapply(f, args@[x], loc) + | Pdirapply loc, [f; x] -> Lapply(f, [x], loc) + + | _ -> Lprim(p, ll) + end | Lswitch(l, sw) -> let new_l = simplif l and new_consts = List.map (fun (n, e) -> (n, simplif e)) sw.sw_consts @@ -250,75 +264,120 @@ | Lfor(v, l1, l2, dir, l3) -> Lfor(v, simplif l1, simplif l2, dir, simplif l3) | Lassign(v, l) -> Lassign(v, simplif l) - | Lsend(k, m, o, ll, loc) -> Lsend(k, simplif m, simplif o, List.map simplif ll, loc) + | Lsend(k, m, o, ll, loc) -> + Lsend(k, simplif m, simplif o, List.map simplif ll, loc) | Levent(l, ev) -> Levent(simplif l, ev) | Lifused(v, l) -> Lifused (v,simplif l) in simplif lam +(* Compile-time beta-reduction of functions immediately applied: + Lapply(Lfunction(Curried, params, body), args, loc) -> + let paramN = argN in ... let param1 = arg1 in body + Lapply(Lfunction(Tupled, params, body), [Lprim(Pmakeblock(args))], loc) -> + let paramN = argN in ... let param1 = arg1 in body + Assumes |args| = |params|. +*) + +let beta_reduce params body args = + List.fold_left2 (fun l param arg -> Llet(Strict, param, arg, l)) + body params args + (* Simplification of lets *) let simplify_lets lam = - (* First pass: count the occurrences of all identifiers *) - let occ = Hashtbl.create 83 in + (* Disable optimisations for bytecode compilation with -g flag *) + let optimize = !Clflags.native_code || not !Clflags.debug in + + (* First pass: count the occurrences of all let-bound identifiers *) + + let occ = (Hashtbl.create 83: (Ident.t, int ref) Hashtbl.t) in + (* The global table [occ] associates to each let-bound identifier + the number of its uses (as a reference): + - 0 if never used + - 1 if used exactly once in and not under a lambda or within a loop + - > 1 if used several times or under a lambda or within a loop. + The local table [bv] associates to each locally-let-bound variable + its reference count, as above. [bv] is enriched at let bindings + but emptied when crossing lambdas and loops. *) + + (* Current use count of a variable. *) let count_var v = try !(Hashtbl.find occ v) with Not_found -> 0 - and incr_var v = + + (* Entering a [let]. Returns updated [bv]. *) + and bind_var bv v = + let r = ref 0 in + Hashtbl.add occ v r; + Tbl.add v r bv + + (* Record a use of a variable *) + and use_var bv v n = + try + let r = Tbl.find v bv in r := !r + n + with Not_found -> + (* v is not locally bound, therefore this is a use under a lambda + or within a loop. Increase use count by 2 -- enough so + that single-use optimizations will not apply. *) try - incr(Hashtbl.find occ v) + let r = Hashtbl.find occ v in r := !r + 2 with Not_found -> - Hashtbl.add occ v (ref 1) in + (* Not a let-bound variable, ignore *) + () in - let rec count = function - | Lvar v -> incr_var v + let rec count bv = function | Lconst cst -> () - | Lapply(l1, ll, _) -> count l1; List.iter count ll - | Lfunction(kind, params, l) -> count l - | Llet(str, v, Lvar w, l2) when not !Clflags.debug -> + | Lvar v -> + use_var bv v 1 + | Lapply(Lfunction(Curried, params, body), args, _) + when optimize && List.length params = List.length args -> + count bv (beta_reduce params body args) + | Lapply(Lfunction(Tupled, params, body), [Lprim(Pmakeblock _, args)], _) + when optimize && List.length params = List.length args -> + count bv (beta_reduce params body args) + | Lapply(l1, ll, _) -> + count bv l1; List.iter (count bv) ll + | Lfunction(kind, params, l) -> + count Tbl.empty l + | Llet(str, v, Lvar w, l2) when optimize -> (* v will be replaced by w in l2, so each occurrence of v in l2 increases w's refcount *) - count l2; - let vc = count_var v in - begin try - let r = Hashtbl.find occ w in r := !r + vc - with Not_found -> - Hashtbl.add occ w (ref vc) - end + count (bind_var bv v) l2; + use_var bv w (count_var v) | Llet(str, v, l1, l2) -> - count l2; + count (bind_var bv v) l2; (* If v is unused, l1 will be removed, so don't count its variables *) - if str = Strict || count_var v > 0 then count l1 + if str = Strict || count_var v > 0 then count bv l1 | Lletrec(bindings, body) -> - List.iter (fun (v, l) -> count l) bindings; - count body - | Lprim(p, ll) -> List.iter count ll + List.iter (fun (v, l) -> count bv l) bindings; + count bv body + | Lprim(p, ll) -> List.iter (count bv) ll | Lswitch(l, sw) -> - count_default sw ; - count l; - List.iter (fun (_, l) -> count l) sw.sw_consts; - List.iter (fun (_, l) -> count l) sw.sw_blocks - | Lstaticraise (i,ls) -> List.iter count ls - | Lstaticcatch(l1, (i,_), l2) -> - count l1; count l2 - | Ltrywith(l1, v, l2) -> count l1; count l2 - | Lifthenelse(l1, l2, l3) -> count l1; count l2; count l3 - | Lsequence(l1, l2) -> count l1; count l2 - | Lwhile(l1, l2) -> count l1; count l2 - | Lfor(_, l1, l2, dir, l3) -> count l1; count l2; count l3 + count_default bv sw ; + count bv l; + List.iter (fun (_, l) -> count bv l) sw.sw_consts; + List.iter (fun (_, l) -> count bv l) sw.sw_blocks + | Lstaticraise (i,ls) -> List.iter (count bv) ls + | Lstaticcatch(l1, (i,_), l2) -> count bv l1; count bv l2 + | Ltrywith(l1, v, l2) -> count bv l1; count bv l2 + | Lifthenelse(l1, l2, l3) -> count bv l1; count bv l2; count bv l3 + | Lsequence(l1, l2) -> count bv l1; count bv l2 + | Lwhile(l1, l2) -> count Tbl.empty l1; count Tbl.empty l2 + | Lfor(_, l1, l2, dir, l3) -> count bv l1; count bv l2; count Tbl.empty l3 | Lassign(v, l) -> (* Lalias-bound variables are never assigned, so don't increase v's refcount *) - count l - | Lsend(_, m, o, ll, _) -> List.iter count (m::o::ll) - | Levent(l, _) -> count l + count bv l + | Lsend(_, m, o, ll, _) -> List.iter (count bv) (m::o::ll) + | Levent(l, _) -> count bv l | Lifused(v, l) -> - if count_var v > 0 then count l + if count_var v > 0 then count bv l - and count_default sw = match sw.sw_failaction with + and count_default bv sw = match sw.sw_failaction with | None -> () | Some al -> let nconsts = List.length sw.sw_consts @@ -326,18 +385,27 @@ if nconsts < sw.sw_numconsts && nblocks < sw.sw_numblocks then begin (* default action will occur twice in native code *) - count al ; count al + count bv al ; count bv al end else begin (* default action will occur once *) assert (nconsts < sw.sw_numconsts || nblocks < sw.sw_numblocks) ; - count al + count bv al end in - count lam; + count Tbl.empty lam; + (* Second pass: remove Lalias bindings of unused variables, and substitute the bindings of variables used exactly once. *) let subst = Hashtbl.create 83 in +(* This (small) optimisation is always legal, it may uncover some + tail call later on. *) + + let mklet (kind,v,e1,e2) = match e2 with + | Lvar w when optimize && Ident.same v w -> e1 + | _ -> Llet (kind,v,e1,e2) in + + let rec simplif = function Lvar v as l -> begin try @@ -346,33 +414,38 @@ l end | Lconst cst as l -> l + | Lapply(Lfunction(Curried, params, body), args, _) + when optimize && List.length params = List.length args -> + simplif (beta_reduce params body args) + | Lapply(Lfunction(Tupled, params, body), [Lprim(Pmakeblock _, args)], _) + when optimize && List.length params = List.length args -> + simplif (beta_reduce params body args) | Lapply(l1, ll, loc) -> Lapply(simplif l1, List.map simplif ll, loc) | Lfunction(kind, params, l) -> Lfunction(kind, params, simplif l) - | Llet(str, v, Lvar w, l2) when not !Clflags.debug -> + | Llet(str, v, Lvar w, l2) when optimize -> Hashtbl.add subst v (simplif (Lvar w)); simplif l2 | Llet(Strict, v, Lprim(Pmakeblock(0, Mutable), [linit]), lbody) - when not !Clflags.debug -> + when optimize -> let slinit = simplif linit in let slbody = simplif lbody in begin try - Llet(Variable, v, slinit, eliminate_ref v slbody) + mklet (Variable, v, slinit, eliminate_ref v slbody) with Real_reference -> - Llet(Strict, v, Lprim(Pmakeblock(0, Mutable), [slinit]), slbody) + mklet(Strict, v, Lprim(Pmakeblock(0, Mutable), [slinit]), slbody) end | Llet(Alias, v, l1, l2) -> begin match count_var v with 0 -> simplif l2 - | 1 when not !Clflags.debug -> - Hashtbl.add subst v (simplif l1); simplif l2 + | 1 when optimize -> Hashtbl.add subst v (simplif l1); simplif l2 | n -> Llet(Alias, v, simplif l1, simplif l2) end | Llet(StrictOpt, v, l1, l2) -> begin match count_var v with 0 -> simplif l2 - | n -> Llet(Alias, v, simplif l1, simplif l2) + | n -> mklet(Alias, v, simplif l1, simplif l2) end - | Llet(kind, v, l1, l2) -> Llet(kind, v, simplif l1, simplif l2) + | Llet(kind, v, l1, l2) -> mklet(kind, v, simplif l1, simplif l2) | Lletrec(bindings, body) -> Lletrec(List.map (fun (v, l) -> (v, simplif l)) bindings, simplif body) | Lprim(p, ll) -> Lprim(p, List.map simplif ll) @@ -402,7 +475,8 @@ | Lfor(v, l1, l2, dir, l3) -> Lfor(v, simplif l1, simplif l2, dir, simplif l3) | Lassign(v, l) -> Lassign(v, simplif l) - | Lsend(k, m, o, ll, loc) -> Lsend(k, simplif m, simplif o, List.map simplif ll, loc) + | Lsend(k, m, o, ll, loc) -> + Lsend(k, simplif m, simplif o, List.map simplif ll, loc) | Levent(l, ev) -> Levent(simplif l, ev) | Lifused(v, l) -> if count_var v > 0 then simplif l else lambda_unit diff -Nru ocaml-3.12.1/bytecomp/simplif.mli ocaml-4.01.0/bytecomp/simplif.mli --- ocaml-3.12.1/bytecomp/simplif.mli 2010-09-02 13:29:21.000000000 +0000 +++ ocaml-4.01.0/bytecomp/simplif.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: simplif.mli 10667 2010-09-02 13:29:21Z xclerc $ *) - (* Elimination of useless Llet(Alias) bindings. Transformation of let-bound references into variables. Simplification over staticraise/staticcatch constructs. diff -Nru ocaml-3.12.1/bytecomp/switch.ml ocaml-4.01.0/bytecomp/switch.ml --- ocaml-3.12.1/bytecomp/switch.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/bytecomp/switch.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) diff -Nru ocaml-3.12.1/bytecomp/switch.mli ocaml-4.01.0/bytecomp/switch.mli --- ocaml-3.12.1/bytecomp/switch.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/bytecomp/switch.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) diff -Nru ocaml-3.12.1/bytecomp/symtable.ml ocaml-4.01.0/bytecomp/symtable.ml --- ocaml-3.12.1/bytecomp/symtable.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/bytecomp/symtable.ml 2013-04-17 09:07:00.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: symtable.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* To assign numbers to globals and primitives *) open Misc @@ -55,6 +53,9 @@ let global_table = ref(empty_numtable : Ident.t numtable) and literal_table = ref([] : (int * structured_constant) list) +let is_global_defined id = + Tbl.mem id (!global_table).num_tbl + let slot_for_getglobal id = try find_numtable !global_table id @@ -123,7 +124,7 @@ fprintf outchan " %s,\n" prim.(i) done; fprintf outchan " (primitive) 0 };\n"; - fprintf outchan "char * caml_names_of_builtin_cprim[] = {\n"; + fprintf outchan "const char * caml_names_of_builtin_cprim[] = {\n"; for i = 0 to Array.length prim - 1 do fprintf outchan " \"%s\",\n" prim.(i) done; @@ -174,25 +175,28 @@ (* Must use the unsafe String.set here because the block may be a "fake" string as returned by Meta.static_alloc. *) -let patch_int buff pos n = - String.unsafe_set buff pos (Char.unsafe_chr n); - String.unsafe_set buff (pos + 1) (Char.unsafe_chr (n asr 8)); - String.unsafe_set buff (pos + 2) (Char.unsafe_chr (n asr 16)); - String.unsafe_set buff (pos + 3) (Char.unsafe_chr (n asr 24)) +let gen_patch_int str_set buff pos n = + str_set buff pos (Char.unsafe_chr n); + str_set buff (pos + 1) (Char.unsafe_chr (n asr 8)); + str_set buff (pos + 2) (Char.unsafe_chr (n asr 16)); + str_set buff (pos + 3) (Char.unsafe_chr (n asr 24)) -let patch_object buff patchlist = +let gen_patch_object str_set buff patchlist = List.iter (function (Reloc_literal sc, pos) -> - patch_int buff pos (slot_for_literal sc) + gen_patch_int str_set buff pos (slot_for_literal sc) | (Reloc_getglobal id, pos) -> - patch_int buff pos (slot_for_getglobal id) + gen_patch_int str_set buff pos (slot_for_getglobal id) | (Reloc_setglobal id, pos) -> - patch_int buff pos (slot_for_setglobal id) + gen_patch_int str_set buff pos (slot_for_setglobal id) | (Reloc_primitive name, pos) -> - patch_int buff pos (num_of_prim name)) + gen_patch_int str_set buff pos (num_of_prim name)) patchlist +let patch_object = gen_patch_object String.unsafe_set +let ls_patch_object = gen_patch_object LongString.set + (* Translate structured constants *) let rec transl_const = function diff -Nru ocaml-3.12.1/bytecomp/symtable.mli ocaml-4.01.0/bytecomp/symtable.mli --- ocaml-3.12.1/bytecomp/symtable.mli 2006-05-11 15:50:53.000000000 +0000 +++ ocaml-4.01.0/bytecomp/symtable.mli 2013-04-17 09:07:00.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: symtable.mli 7422 2006-05-11 15:50:53Z xleroy $ *) - (* Assign locations and numbers to globals and primitives *) open Cmo_format @@ -20,6 +18,7 @@ val init: unit -> unit val patch_object: string -> (reloc_info * int) list -> unit +val ls_patch_object: Misc.LongString.t -> (reloc_info * int) list -> unit val require_primitive: string -> unit val initial_global_table: unit -> Obj.t array val output_global_map: out_channel -> unit @@ -33,6 +32,7 @@ val init_toplevel: unit -> (string * Digest.t) list val update_global_table: unit -> unit val get_global_value: Ident.t -> Obj.t +val is_global_defined: Ident.t -> bool val assign_global_value: Ident.t -> Obj.t -> unit val get_global_position: Ident.t -> int val check_global_initialized: (reloc_info * int) list -> unit diff -Nru ocaml-3.12.1/bytecomp/translclass.ml ocaml-4.01.0/bytecomp/translclass.ml --- ocaml-3.12.1/bytecomp/translclass.ml 2010-09-02 13:29:21.000000000 +0000 +++ ocaml-4.01.0/bytecomp/translclass.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,9 +10,6 @@ (* *) (***********************************************************************) -(* $Id: translclass.ml 10667 2010-09-02 13:29:21Z xclerc $ *) - -open Misc open Asttypes open Types open Typedtree @@ -50,7 +47,7 @@ let transl_label l = share (Const_immstring l) -let rec transl_meth_list lst = +let transl_meth_list lst = if lst = [] then Lconst (Const_pointer 0) else share (Const_block (0, List.map (fun lab -> Const_immstring lab) lst)) @@ -114,7 +111,7 @@ let rec build_object_init cl_table obj params inh_init obj_init cl = match cl.cl_desc with - Tclass_ident path -> + Tcl_ident ( path, _, _) -> let obj_init = Ident.create "obj_init" in let envs, inh_init = inh_init in let env = @@ -123,35 +120,27 @@ in ((envs, (obj_init, path)::inh_init), mkappl(Lvar obj_init, env @ [obj])) - | Tclass_structure str -> + | Tcl_structure str -> create_object cl_table obj (fun obj -> let (inh_init, obj_init, has_init) = List.fold_right (fun field (inh_init, obj_init, has_init) -> - match field with - Cf_inher (cl, _, _) -> + match field.cf_desc with + Tcf_inher (_, cl, _, _, _) -> let (inh_init, obj_init') = build_object_init cl_table (Lvar obj) [] inh_init (fun _ -> lambda_unit) cl in (inh_init, lsequence obj_init' obj_init, true) - | Cf_val (_, id, Some exp, _) -> + | Tcf_val (_, _, _, id, Tcfk_concrete exp, _) -> (inh_init, lsequence (set_inst_var obj id exp) obj_init, has_init) - | Cf_meth _ | Cf_val _ -> + | Tcf_meth _ | Tcf_val _ | Tcf_constr _ -> (inh_init, obj_init, has_init) - | Cf_init _ -> + | Tcf_init _ -> (inh_init, obj_init, true) - | Cf_let (rec_flag, defs, vals) -> - (inh_init, - Translcore.transl_let rec_flag defs - (List.fold_right - (fun (id, expr) rem -> - lsequence (Lifused(id, set_inst_var obj id expr)) - rem) - vals obj_init), - has_init)) - str.cl_field + ) + str.cstr_fields (inh_init, obj_init obj, false) in (inh_init, @@ -160,7 +149,8 @@ lsequence (Lifused (id, set_inst_var obj id expr)) rem) params obj_init, has_init)) - | Tclass_fun (pat, vals, cl, partial) -> + | Tcl_fun (_, pat, vals, cl, partial) -> + let vals = List.map (fun (id, _, e) -> id,e) vals in let (inh_init, obj_init) = build_object_init cl_table obj (vals @ params) inh_init obj_init cl in @@ -175,22 +165,24 @@ Lfunction (Curried, params, rem) -> build params rem | rem -> build [] rem end) - | Tclass_apply (cl, oexprs) -> + | Tcl_apply (cl, oexprs) -> let (inh_init, obj_init) = build_object_init cl_table obj params inh_init obj_init cl in (inh_init, transl_apply obj_init oexprs Location.none) - | Tclass_let (rec_flag, defs, vals, cl) -> + | Tcl_let (rec_flag, defs, vals, cl) -> + let vals = List.map (fun (id, _, e) -> id,e) vals in let (inh_init, obj_init) = build_object_init cl_table obj (vals @ params) inh_init obj_init cl in (inh_init, Translcore.transl_let rec_flag defs obj_init) - | Tclass_constraint (cl, vals, pub_meths, concr_meths) -> + | Tcl_constraint (cl, _, vals, pub_meths, concr_meths) -> build_object_init cl_table obj params inh_init obj_init cl let rec build_object_init_0 cl_table params cl copy_env subst_env top ids = match cl.cl_desc with - Tclass_let (rec_flag, defs, vals, cl) -> + Tcl_let (rec_flag, defs, vals, cl) -> + let vals = List.map (fun (id, _, e) -> id,e) vals in build_object_init_0 cl_table (vals@params) cl copy_env subst_env top ids | _ -> let self = Ident.create "self" in @@ -239,8 +231,8 @@ let rec ignore_cstrs cl = match cl.cl_desc with - Tclass_constraint (cl, _, _, _) -> ignore_cstrs cl - | Tclass_apply (cl, _) -> ignore_cstrs cl + Tcl_constraint (cl, _, _, _, _) -> ignore_cstrs cl + | Tcl_apply (cl, _) -> ignore_cstrs cl | _ -> cl let rec index a = function @@ -248,11 +240,11 @@ | b :: l -> if b = a then 0 else 1 + index a l -let bind_id_as_val (id, _) = ("", id) +let bind_id_as_val (id, _, _) = ("", id) let rec build_class_init cla cstr super inh_init cl_init msubst top cl = match cl.cl_desc with - Tclass_ident path -> + Tcl_ident ( path, _, _) -> begin match inh_init with (obj_init, path')::inh_init -> let lpath = transl_path path in @@ -264,23 +256,27 @@ | _ -> assert false end - | Tclass_structure str -> + | Tcl_structure str -> let cl_init = bind_super cla super cl_init in let (inh_init, cl_init, methods, values) = List.fold_right (fun field (inh_init, cl_init, methods, values) -> - match field with - Cf_inher (cl, vals, meths) -> + match field.cf_desc with + Tcf_inher (_, cl, _, vals, meths) -> let cl_init = output_methods cla methods cl_init in let inh_init, cl_init = build_class_init cla false - (vals, meths_super cla str.cl_meths meths) + (vals, meths_super cla str.cstr_meths meths) inh_init cl_init msubst top cl in (inh_init, cl_init, [], values) - | Cf_val (name, id, exp, over) -> + | Tcf_val (name, _, _, id, exp, over) -> let values = if over then values else (name, id) :: values in (inh_init, cl_init, methods, values) - | Cf_meth (name, exp) -> + | Tcf_meth (_, _, _, Tcfk_virtual _, _) + | Tcf_constr _ + -> + (inh_init, cl_init, methods, values) + | Tcf_meth (name, _, _, Tcfk_concrete exp, over) -> let met_code = msubst true (transl_exp exp) in let met_code = if !Clflags.native_code && List.length met_code = 1 then @@ -290,39 +286,34 @@ else met_code in (inh_init, cl_init, - Lvar (Meths.find name str.cl_meths) :: met_code @ methods, + Lvar (Meths.find name str.cstr_meths) :: met_code @ methods, values) - | Cf_let (rec_flag, defs, vals) -> - let vals = - List.map (function (id, _) -> (Ident.name id, id)) vals - in - (inh_init, cl_init, methods, vals @ values) - | Cf_init exp -> + | Tcf_init exp -> (inh_init, Lsequence(mkappl (oo_prim "add_initializer", Lvar cla :: msubst false (transl_exp exp)), cl_init), methods, values)) - str.cl_field + str.cstr_fields (inh_init, cl_init, [], []) in let cl_init = output_methods cla methods cl_init in - (inh_init, bind_methods cla str.cl_meths values cl_init) - | Tclass_fun (pat, vals, cl, _) -> + (inh_init, bind_methods cla str.cstr_meths values cl_init) + | Tcl_fun (_, pat, vals, cl, _) -> let (inh_init, cl_init) = build_class_init cla cstr super inh_init cl_init msubst top cl in let vals = List.map bind_id_as_val vals in (inh_init, transl_vals cla true StrictOpt vals cl_init) - | Tclass_apply (cl, exprs) -> + | Tcl_apply (cl, exprs) -> build_class_init cla cstr super inh_init cl_init msubst top cl - | Tclass_let (rec_flag, defs, vals, cl) -> + | Tcl_let (rec_flag, defs, vals, cl) -> let (inh_init, cl_init) = build_class_init cla cstr super inh_init cl_init msubst top cl in let vals = List.map bind_id_as_val vals in (inh_init, transl_vals cla true StrictOpt vals cl_init) - | Tclass_constraint (cl, vals, meths, concr_meths) -> + | Tcl_constraint (cl, _, vals, meths, concr_meths) -> let virt_meths = List.filter (fun lab -> not (Concr.mem lab concr_meths)) meths in let concr_meths = Concr.elements concr_meths in @@ -333,7 +324,7 @@ transl_meth_list concr_meths] in let cl = ignore_cstrs cl in begin match cl.cl_desc, inh_init with - Tclass_ident path, (obj_init, path')::inh_init -> + Tcl_ident (path, _, _), (obj_init, path')::inh_init -> assert (Path.same path path'); let lpath = transl_path path in let inh = Ident.create "inh" @@ -368,23 +359,27 @@ cl_init)) end -let rec build_class_lets cl = +let rec build_class_lets cl ids = match cl.cl_desc with - Tclass_let (rec_flag, defs, vals, cl) -> - let env, wrap = build_class_lets cl in - (env, fun x -> Translcore.transl_let rec_flag defs (wrap x)) + Tcl_let (rec_flag, defs, vals, cl') -> + let env, wrap = build_class_lets cl' [] in + (env, fun x -> + let lam = Translcore.transl_let rec_flag defs (wrap x) in + (* Check recursion in toplevel let-definitions *) + if ids = [] || Translcore.check_recursive_lambda ids lam then lam + else raise(Error(cl.cl_loc, Illegal_class_expr))) | _ -> (cl.cl_env, fun x -> x) let rec get_class_meths cl = match cl.cl_desc with - Tclass_structure cl -> - Meths.fold (fun _ -> IdentSet.add) cl.cl_meths IdentSet.empty - | Tclass_ident _ -> IdentSet.empty - | Tclass_fun (_, _, cl, _) - | Tclass_let (_, _, _, cl) - | Tclass_apply (cl, _) - | Tclass_constraint (cl, _, _, _) -> get_class_meths cl + Tcl_structure cl -> + Meths.fold (fun _ -> IdentSet.add) cl.cstr_meths IdentSet.empty + | Tcl_ident _ -> IdentSet.empty + | Tcl_fun (_, _, _, cl, _) + | Tcl_let (_, _, _, cl) + | Tcl_apply (cl, _) + | Tcl_constraint (cl, _, _, _, _) -> get_class_meths cl (* XXX Il devrait etre peu couteux d'ecrire des classes : @@ -392,13 +387,13 @@ *) let rec transl_class_rebind obj_init cl vf = match cl.cl_desc with - Tclass_ident path -> + Tcl_ident (path, _, _) -> if vf = Concrete then begin try if (Env.find_class path cl.cl_env).cty_new = None then raise Exit with Not_found -> raise Exit end; (path, obj_init) - | Tclass_fun (pat, _, cl, partial) -> + | Tcl_fun (_, pat, _, cl, partial) -> let path, obj_init = transl_class_rebind obj_init cl vf in let build params rem = let param = name_pattern "param" [pat, ()] in @@ -410,18 +405,18 @@ match obj_init with Lfunction (Curried, params, rem) -> build params rem | rem -> build [] rem) - | Tclass_apply (cl, oexprs) -> + | Tcl_apply (cl, oexprs) -> let path, obj_init = transl_class_rebind obj_init cl vf in (path, transl_apply obj_init oexprs Location.none) - | Tclass_let (rec_flag, defs, vals, cl) -> + | Tcl_let (rec_flag, defs, vals, cl) -> let path, obj_init = transl_class_rebind obj_init cl vf in (path, Translcore.transl_let rec_flag defs obj_init) - | Tclass_structure _ -> raise Exit - | Tclass_constraint (cl', _, _, _) -> + | Tcl_structure _ -> raise Exit + | Tcl_constraint (cl', _, _, _, _) -> let path, obj_init = transl_class_rebind obj_init cl' vf in let rec check_constraint = function - Tcty_constr(path', _, _) when Path.same path path' -> () - | Tcty_fun (_, _, cty) -> check_constraint cty + Cty_constr(path', _, _) when Path.same path path' -> () + | Cty_fun (_, _, cty) -> check_constraint cty | _ -> raise Exit in check_constraint cl.cl_type; @@ -429,7 +424,7 @@ let rec transl_class_rebind_0 self obj_init cl vf = match cl.cl_desc with - Tclass_let (rec_flag, defs, vals, cl) -> + Tcl_let (rec_flag, defs, vals, cl) -> let path, obj_init = transl_class_rebind_0 self obj_init cl vf in (path, Translcore.transl_let rec_flag defs obj_init) | _ -> @@ -592,7 +587,7 @@ let names = List.map Ident.unique_toplevel_name ids in prerr_endline (String.concat " " (msg :: names)) -let transl_class ids cl_id arity pub_meths cl vflag = +let transl_class ids cl_id pub_meths cl vflag = (* First check if it is not only a rebind *) let rebind = transl_class_rebind ids cl vflag in if rebind <> lambda_unit then rebind else @@ -601,7 +596,7 @@ let tables = Ident.create (Ident.name cl_id ^ "_tables") in let (top_env, req) = oo_add_class tables in let top = not req in - let cl_env, llets = build_class_lets cl in + let cl_env, llets = build_class_lets cl ids in let new_ids = if top then [] else Env.diff top_env cl_env in let env2 = Ident.create "env" in let meth_ids = get_class_meths cl in @@ -668,8 +663,6 @@ let cla = Ident.create "class" in let (inh_init, obj_init) = build_object_init_0 cla [] cl copy_env subst_env top ids in - if not (Translcore.check_recursive_lambda ids obj_init) then - raise(Error(cl.cl_loc, Illegal_class_expr)); let inh_init' = List.rev inh_init in let (inh_init', cl_init) = build_class_init cla true ([],[]) inh_init' obj_init msubst top cl @@ -802,12 +795,20 @@ ))))) (* Wrapper for class compilation *) +(* + let cl_id = ci.ci_id_class in +(* TODO: cl_id is used somewhere else as typesharp ? *) + let _arity = List.length (fst ci.ci_params) in + let pub_meths = m in + let cl = ci.ci_expr in + let vflag = vf in +*) -let transl_class ids cl_id arity pub_meths cl vf = - oo_wrap cl.cl_env false (transl_class ids cl_id arity pub_meths cl) vf +let transl_class ids id pub_meths cl vf = + oo_wrap cl.cl_env false (transl_class ids id pub_meths cl) vf let () = - transl_object := (fun id meths cl -> transl_class [] id 0 meths cl Concrete) + transl_object := (fun id meths cl -> transl_class [] id meths cl Concrete) (* Error report *) @@ -815,7 +816,7 @@ let report_error ppf = function | Illegal_class_expr -> - fprintf ppf "This kind of class expression is not allowed" + fprintf ppf "This kind of recursive class expression is not allowed" | Tags (lab1, lab2) -> fprintf ppf "Method labels `%s' and `%s' are incompatible.@ %s" lab1 lab2 "Change one of them." diff -Nru ocaml-3.12.1/bytecomp/translclass.mli ocaml-4.01.0/bytecomp/translclass.mli --- ocaml-3.12.1/bytecomp/translclass.mli 2006-04-05 02:28:13.000000000 +0000 +++ ocaml-4.01.0/bytecomp/translclass.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,14 +10,12 @@ (* *) (***********************************************************************) -(* $Id: translclass.mli 7372 2006-04-05 02:28:13Z garrigue $ *) - open Typedtree open Lambda val transl_class : Ident.t list -> Ident.t -> - int -> string list -> class_expr -> Asttypes.virtual_flag -> lambda;; + string list -> class_expr -> Asttypes.virtual_flag -> lambda;; type error = Illegal_class_expr | Tags of string * string diff -Nru ocaml-3.12.1/bytecomp/translcore.ml ocaml-4.01.0/bytecomp/translcore.ml --- ocaml-3.12.1/bytecomp/translcore.ml 2010-09-02 13:29:21.000000000 +0000 +++ ocaml-4.01.0/bytecomp/translcore.ml 2013-05-28 11:05:58.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,15 +10,12 @@ (* *) (***********************************************************************) -(* $Id: translcore.ml 10667 2010-09-02 13:29:21Z xclerc $ *) - (* Translation from typed abstract syntax to lambda terms, for the core language *) open Misc open Asttypes open Primitive -open Path open Types open Typedtree open Typeopt @@ -28,6 +25,7 @@ Illegal_letrec_pat | Illegal_letrec_expr | Free_super_var + | Unknown_builtin_primitive of string exception Error of Location.t * error @@ -152,6 +150,11 @@ "%sequand", Psequand; "%sequor", Psequor; "%boolnot", Pnot; + "%big_endian", Pctconst Big_endian; + "%word_size", Pctconst Word_size; + "%ostype_unix", Pctconst Ostype_unix; + "%ostype_win32", Pctconst Ostype_win32; + "%ostype_cygwin", Pctconst Ostype_cygwin; "%negint", Pnegint; "%succint", Poffsetint 1; "%predint", Poffsetint(-1); @@ -274,7 +277,38 @@ "%caml_ba_unsafe_set_2", Pbigarrayset(true, 2, Pbigarray_unknown, Pbigarray_unknown_layout); "%caml_ba_unsafe_set_3", - Pbigarrayset(true, 3, Pbigarray_unknown, Pbigarray_unknown_layout) + Pbigarrayset(true, 3, Pbigarray_unknown, Pbigarray_unknown_layout); + "%caml_ba_dim_1", Pbigarraydim(1); + "%caml_ba_dim_2", Pbigarraydim(2); + "%caml_ba_dim_3", Pbigarraydim(3); + "%caml_string_get16", Pstring_load_16(false); + "%caml_string_get16u", Pstring_load_16(true); + "%caml_string_get32", Pstring_load_32(false); + "%caml_string_get32u", Pstring_load_32(true); + "%caml_string_get64", Pstring_load_64(false); + "%caml_string_get64u", Pstring_load_64(true); + "%caml_string_set16", Pstring_set_16(false); + "%caml_string_set16u", Pstring_set_16(true); + "%caml_string_set32", Pstring_set_32(false); + "%caml_string_set32u", Pstring_set_32(true); + "%caml_string_set64", Pstring_set_64(false); + "%caml_string_set64u", Pstring_set_64(true); + "%caml_bigstring_get16", Pbigstring_load_16(false); + "%caml_bigstring_get16u", Pbigstring_load_16(true); + "%caml_bigstring_get32", Pbigstring_load_32(false); + "%caml_bigstring_get32u", Pbigstring_load_32(true); + "%caml_bigstring_get64", Pbigstring_load_64(false); + "%caml_bigstring_get64u", Pbigstring_load_64(true); + "%caml_bigstring_set16", Pbigstring_set_16(false); + "%caml_bigstring_set16u", Pbigstring_set_16(true); + "%caml_bigstring_set32", Pbigstring_set_32(false); + "%caml_bigstring_set32u", Pbigstring_set_32(true); + "%caml_bigstring_set64", Pbigstring_set_64(false); + "%caml_bigstring_set64u", Pbigstring_set_64(true); + "%bswap16", Pbswap16; + "%bswap_int32", Pbbswap(Pint32); + "%bswap_int64", Pbbswap(Pint64); + "%bswap_native", Pbbswap(Pnativeint); ] let prim_makearray = @@ -285,17 +319,24 @@ { prim_name = "caml_obj_dup"; prim_arity = 1; prim_alloc = true; prim_native_name = ""; prim_native_float = false } -let transl_prim prim args = +let find_primitive loc prim_name = + match prim_name with + "%revapply" -> Prevapply loc + | "%apply" -> Pdirapply loc + | name -> Hashtbl.find primitives_table name + +let transl_prim loc prim args = + let prim_name = prim.prim_name in try let (gencomp, intcomp, floatcomp, stringcomp, nativeintcomp, int32comp, int64comp, simplify_constant_constructor) = - Hashtbl.find comparisons_table prim.prim_name in + Hashtbl.find comparisons_table prim_name in begin match args with - [arg1; {exp_desc = Texp_construct({cstr_tag = Cstr_constant _}, _)}] + [arg1; {exp_desc = Texp_construct(_, {cstr_tag = Cstr_constant _}, _, _)}] when simplify_constant_constructor -> intcomp - | [{exp_desc = Texp_construct({cstr_tag = Cstr_constant _}, _)}; arg2] + | [{exp_desc = Texp_construct(_, {cstr_tag = Cstr_constant _}, _, _)}; arg2] when simplify_constant_constructor -> intcomp | [arg1; {exp_desc = Texp_variant(_, None)}] @@ -322,7 +363,7 @@ end with Not_found -> try - let p = Hashtbl.find primitives_table prim.prim_name in + let p = find_primitive loc prim_name in (* Try strength reduction based on the type of the argument *) begin match (p, args) with (Psetfield(n, _), [arg1; arg2]) -> Psetfield(n, maybe_pointer arg2) @@ -342,12 +383,14 @@ | _ -> p end with Not_found -> + if String.length prim_name > 0 && prim_name.[0] = '%' then + raise(Error(loc, Unknown_builtin_primitive prim_name)); Pccall prim (* Eta-expand a primitive without knowing the types of its arguments *) -let transl_primitive p = +let transl_primitive loc p = let prim = try let (gencomp, _, _, _, _, _, _, _) = @@ -355,18 +398,20 @@ gencomp with Not_found -> try - Hashtbl.find primitives_table p.prim_name + find_primitive loc p.prim_name with Not_found -> Pccall p in match prim with Plazyforce -> let parm = Ident.create "prim" in - Lfunction(Curried, [parm], Matching.inline_lazy_force (Lvar parm) Location.none) + Lfunction(Curried, [parm], + Matching.inline_lazy_force (Lvar parm) Location.none) | _ -> let rec make_params n = if n <= 0 then [] else Ident.create "prim" :: make_params (n-1) in let params = make_params p.prim_arity in - Lfunction(Curried, params, Lprim(prim, List.map (fun id -> Lvar id) params)) + Lfunction(Curried, params, + Lprim(prim, List.map (fun id -> Lvar id) params)) (* To check the well-formedness of r.h.s. of "let rec" definitions *) @@ -452,17 +497,17 @@ [] -> Ident.create default | (p, e) :: rem -> match p.pat_desc with - Tpat_var id -> id - | Tpat_alias(p, id) -> id + Tpat_var (id, _) -> id + | Tpat_alias(p, id, _) -> id | _ -> name_pattern default rem (* Push the default values under the functional abstractions *) let rec push_defaults loc bindings pat_expr_list partial = match pat_expr_list with - [pat, ({exp_desc = Texp_function(pl,partial)} as exp)] -> + [pat, ({exp_desc = Texp_function(l, pl,partial)} as exp)] -> let pl = push_defaults exp.exp_loc bindings pl partial in - [pat, {exp with exp_desc = Texp_function(pl, partial)}] + [pat, {exp with exp_desc = Texp_function(l, pl, partial)}] | [pat, {exp_desc = Texp_let (Default, cases, ({exp_desc = Texp_function _} as e2))}] -> push_defaults loc (cases :: bindings) [pat, e2] partial @@ -476,16 +521,19 @@ [pat, exp] | (pat, exp) :: _ when bindings <> [] -> let param = name_pattern "param" pat_expr_list in + let name = Ident.name param in let exp = { exp with exp_loc = loc; exp_desc = Texp_match ({exp with exp_type = pat.pat_type; exp_desc = - Texp_ident (Path.Pident param, - {val_type = pat.pat_type; val_kind = Val_reg})}, + Texp_ident (Path.Pident param, mknoloc (Longident.Lident name), + {val_type = pat.pat_type; val_kind = Val_reg; + Types.val_loc = Location.none; + })}, pat_expr_list, partial) } in push_defaults loc bindings - [{pat with pat_desc = Tpat_var param}, exp] Total + [{pat with pat_desc = Tpat_var (param, mknoloc name)}, exp] Total | _ -> pat_expr_list @@ -530,21 +578,16 @@ (* Assertions *) -let assert_failed loc = - (* [Location.get_pos_info] is too expensive *) - let fname = match loc.Location.loc_start.Lexing.pos_fname with - | "" -> !Location.input_name - | x -> x - in - let pos = loc.Location.loc_start in - let line = pos.Lexing.pos_lnum in - let char = pos.Lexing.pos_cnum - pos.Lexing.pos_bol in - Lprim(Praise, [Lprim(Pmakeblock(0, Immutable), +let assert_failed exp = + let (fname, line, char) = + Location.get_pos_info exp.exp_loc.Location.loc_start in + Lprim(Praise, [event_after exp + (Lprim(Pmakeblock(0, Immutable), [transl_path Predef.path_assert_failure; Lconst(Const_block(0, [Const_base(Const_string fname); Const_base(Const_int line); - Const_base(Const_int char)]))])]) + Const_base(Const_int char)]))]))]) ;; let rec cut n l = @@ -566,29 +609,31 @@ and transl_exp0 e = match e.exp_desc with - Texp_ident(path, {val_kind = Val_prim p}) -> + Texp_ident(path, _, {val_kind = Val_prim p}) -> let public_send = p.prim_name = "%send" in if public_send || p.prim_name = "%sendself" then let kind = if public_send then Public else Self in let obj = Ident.create "obj" and meth = Ident.create "meth" in - Lfunction(Curried, [obj; meth], Lsend(kind, Lvar meth, Lvar obj, [], e.exp_loc)) + Lfunction(Curried, [obj; meth], Lsend(kind, Lvar meth, Lvar obj, [], + e.exp_loc)) else if p.prim_name = "%sendcache" then let obj = Ident.create "obj" and meth = Ident.create "meth" in let cache = Ident.create "cache" and pos = Ident.create "pos" in Lfunction(Curried, [obj; meth; cache; pos], - Lsend(Cached, Lvar meth, Lvar obj, [Lvar cache; Lvar pos], e.exp_loc)) + Lsend(Cached, Lvar meth, Lvar obj, [Lvar cache; Lvar pos], + e.exp_loc)) else - transl_primitive p - | Texp_ident(path, {val_kind = Val_anc _}) -> + transl_primitive e.exp_loc p + | Texp_ident(path, _, {val_kind = Val_anc _}) -> raise(Error(e.exp_loc, Free_super_var)) - | Texp_ident(path, {val_kind = Val_reg | Val_self _}) -> + | Texp_ident(path, _, {val_kind = Val_reg | Val_self _}) -> transl_path path | Texp_ident _ -> fatal_error "Translcore.transl_exp: bad Texp_ident" | Texp_constant cst -> Lconst(Const_base cst) | Texp_let(rec_flag, pat_expr_list, body) -> transl_let rec_flag pat_expr_list (event_before body (transl_exp body)) - | Texp_function (pat_expr_list, partial) -> + | Texp_function (_, pat_expr_list, partial) -> let ((kind, params), body) = event_function e (function repr -> @@ -596,9 +641,10 @@ transl_function e.exp_loc !Clflags.native_code repr partial pl) in Lfunction(kind, params, body) - | Texp_apply({exp_desc = Texp_ident(path, {val_kind = Val_prim p})}, oargs) + | Texp_apply({exp_desc = Texp_ident(path, _, {val_kind = Val_prim p})} as fn, + oargs) when List.length oargs >= p.prim_arity - && List.for_all (fun (arg,_) -> arg <> None) oargs -> + && List.for_all (fun (_, arg,_) -> arg <> None) oargs -> let args, args' = cut p.prim_arity oargs in let wrap f = if args' = [] @@ -607,7 +653,8 @@ in let wrap0 f = if args' = [] then f else wrap f in - let args = List.map (function Some x, _ -> x | _ -> assert false) args in + let args = + List.map (function _, Some x, _ -> x | _ -> assert false) args in let argl = transl_list args in let public_send = p.prim_name = "%send" || not !Clflags.native_code && p.prim_name = "%sendcache"in @@ -620,7 +667,13 @@ wrap (Lsend(Cached, meth, obj, [cache; pos], e.exp_loc)) | _ -> assert false else begin - let prim = transl_prim p args in + if p.prim_name = "%sequand" && Path.last path = "&" then + Location.prerr_warning fn.exp_loc + (Warnings.Deprecated "operator (&); you should use (&&) instead"); + if p.prim_name = "%sequor" && Path.last path = "or" then + Location.prerr_warning fn.exp_loc + (Warnings.Deprecated "operator (or); you should use (||) instead"); + let prim = transl_prim e.exp_loc p args in match (prim, args) with (Praise, [arg1]) -> wrap0 (Lprim(Praise, [event_after arg1 (List.hd argl)])) @@ -652,7 +705,7 @@ with Not_constant -> Lprim(Pmakeblock(0, Immutable), ll) end - | Texp_construct(cstr, args) -> + | Texp_construct(_, cstr, args, _) -> let ll = transl_list args in begin match cstr.cstr_tag with Cstr_constant n -> @@ -663,7 +716,7 @@ with Not_constant -> Lprim(Pmakeblock(n, Immutable), ll) end - | Cstr_exception path -> + | Cstr_exception (path, _) -> Lprim(Pmakeblock(0, Immutable), transl_path path :: ll) end | Texp_variant(l, arg) -> @@ -679,17 +732,17 @@ Lprim(Pmakeblock(0, Immutable), [Lconst(Const_base(Const_int tag)); lam]) end - | Texp_record ((lbl1, _) :: _ as lbl_expr_list, opt_init_expr) -> + | Texp_record ((_, lbl1, _) :: _ as lbl_expr_list, opt_init_expr) -> transl_record lbl1.lbl_all lbl1.lbl_repres lbl_expr_list opt_init_expr | Texp_record ([], _) -> fatal_error "Translcore.transl_exp: bad Texp_record" - | Texp_field(arg, lbl) -> + | Texp_field(arg, _, lbl) -> let access = match lbl.lbl_repres with Record_regular -> Pfield lbl.lbl_pos | Record_float -> Pfloatfield lbl.lbl_pos in Lprim(access, [transl_exp arg]) - | Texp_setfield(arg, lbl, newval) -> + | Texp_setfield(arg, _, lbl, newval) -> let access = match lbl.lbl_repres with Record_regular -> Psetfield(lbl.lbl_pos, maybe_pointer newval) @@ -726,14 +779,15 @@ Lsequence(transl_exp expr1, event_before expr2 (transl_exp expr2)) | Texp_while(cond, body) -> Lwhile(transl_exp cond, event_before body (transl_exp body)) - | Texp_for(param, low, high, dir, body) -> + | Texp_for(param, _, low, high, dir, body) -> Lfor(param, transl_exp low, transl_exp high, dir, event_before body (transl_exp body)) | Texp_when(cond, body) -> event_before cond (Lifthenelse(transl_exp cond, event_before body (transl_exp body), staticfail)) - | Texp_send(expr, met) -> + | Texp_send(_, _, Some exp) -> transl_exp exp + | Texp_send(expr, met, None) -> let obj = transl_exp expr in let lam = match met with @@ -744,11 +798,11 @@ Lsend (kind, tag, obj, cache, e.exp_loc) in event_after e lam - | Texp_new (cl, _) -> + | Texp_new (cl, _, _) -> Lapply(Lprim(Pfield 0, [transl_path cl]), [lambda_unit], Location.none) - | Texp_instvar(path_self, path) -> + | Texp_instvar(path_self, path, _) -> Lprim(Parrayrefu Paddrarray, [transl_path path_self; transl_path path]) - | Texp_setinstvar(path_self, path, expr) -> + | Texp_setinstvar(path_self, path, _, expr) -> transl_setinstvar (transl_path path_self) path expr | Texp_override(path_self, modifs) -> let cpy = Ident.create "copy" in @@ -756,19 +810,19 @@ Lapply(Translobj.oo_prim "copy", [transl_path path_self], Location.none), List.fold_right - (fun (path, expr) rem -> + (fun (path, _, expr) rem -> Lsequence(transl_setinstvar (Lvar cpy) path expr, rem)) modifs (Lvar cpy)) - | Texp_letmodule(id, modl, body) -> + | Texp_letmodule(id, _, modl, body) -> Llet(Strict, id, !transl_module Tcoerce_none None modl, transl_exp body) | Texp_pack modl -> !transl_module Tcoerce_none None modl | Texp_assert (cond) -> if !Clflags.noassert then lambda_unit - else Lifthenelse (transl_exp cond, lambda_unit, assert_failed e.exp_loc) - | Texp_assertfalse -> assert_failed e.exp_loc + else Lifthenelse (transl_exp cond, lambda_unit, assert_failed e) + | Texp_assertfalse -> assert_failed e | Texp_lazy e -> (* when e needs no computation (constants, identifiers, ...), we optimize the translation just as Lazy.lazy_from_val would @@ -778,21 +832,22 @@ | Texp_constant ( Const_int _ | Const_char _ | Const_string _ | Const_int32 _ | Const_int64 _ | Const_nativeint _ ) - | Texp_function(_, _) - | Texp_construct ({cstr_arity = 0}, _) + | Texp_function(_, _, _) + | Texp_construct (_, {cstr_arity = 0}, _, _) -> transl_exp e | Texp_constant(Const_float _) -> Lprim(Pmakeblock(Obj.forward_tag, Immutable), [transl_exp e]) - | Texp_ident(_, _) -> (* according to the type *) + | Texp_ident(_, _, _) -> (* according to the type *) begin match e.exp_type.desc with (* the following may represent a float/forward/lazy: need a forward_tag *) - | Tvar | Tlink _ | Tsubst _ | Tunivar + | Tvar _ | Tlink _ | Tsubst _ | Tunivar _ | Tpoly(_,_) | Tfield(_,_,_,_) -> Lprim(Pmakeblock(Obj.forward_tag, Immutable), [transl_exp e]) (* the following cannot be represented as float/forward/lazy: optimize *) - | Tarrow(_,_,_,_) | Ttuple _ | Tpackage _ | Tobject(_,_) | Tnil | Tvariant _ + | Tarrow(_,_,_,_) | Ttuple _ | Tpackage _ | Tobject(_,_) | Tnil + | Tvariant _ -> transl_exp e (* optimize predefined types (excepted float) *) | Tconstr(_,_,_) -> @@ -818,12 +873,13 @@ let fn = Lfunction (Curried, [Ident.create "param"], transl_exp e) in Lprim(Pmakeblock(Config.lazy_tag, Immutable), [fn]) end - | Texp_object (cs, cty, meths) -> + | Texp_object (cs, meths) -> + let cty = cs.cstr_type in let cl = Ident.create "class" in !transl_object cl meths - { cl_desc = Tclass_structure cs; + { cl_desc = Tcl_structure cs; cl_loc = e.exp_loc; - cl_type = Tcty_signature cty; + cl_type = Cty_signature cty; cl_env = e.exp_env } and transl_list expr_list = @@ -885,11 +941,11 @@ | [] -> lapply lam (List.rev_map fst args) in - build_apply lam [] (List.map (fun (x,o) -> may_map transl_exp x, o) sargs) + build_apply lam [] (List.map (fun (l, x,o) -> may_map transl_exp x, o) sargs) and transl_function loc untuplify_fn repr partial pat_expr_list = match pat_expr_list with - [pat, ({exp_desc = Texp_function(pl,partial')} as exp)] + [pat, ({exp_desc = Texp_function(_, pl,partial')} as exp)] when Parmatch.fluid pat -> let param = name_pattern "param" pat_expr_list in let ((_, params), body) = @@ -931,9 +987,9 @@ | Recursive -> let idlist = List.map - (fun (pat, expr) -> - match pat.pat_desc with - Tpat_var id -> id + (fun (pat, expr) -> match pat.pat_desc with + Tpat_var (id,_) -> id + | Tpat_alias ({pat_desc=Tpat_any}, id,_) -> id | _ -> raise(Error(pat.pat_loc, Illegal_letrec_pat))) pat_expr_list in let transl_case (pat, expr) id = @@ -968,11 +1024,11 @@ done end; List.iter - (fun (lbl, expr) -> lv.(lbl.lbl_pos) <- transl_exp expr) + (fun (_, lbl, expr) -> lv.(lbl.lbl_pos) <- transl_exp expr) lbl_expr_list; let ll = Array.to_list lv in let mut = - if List.exists (fun (lbl, expr) -> lbl.lbl_mut = Mutable) lbl_expr_list + if List.exists (fun (_, lbl, expr) -> lbl.lbl_mut = Mutable) lbl_expr_list then Mutable else Immutable in let lam = @@ -997,7 +1053,7 @@ (* If you change anything here, you will likely have to change [check_recursive_recordwith] in this file. *) let copy_id = Ident.create "newrecord" in - let rec update_field (lbl, expr) cont = + let update_field (_, lbl, expr) cont = let upd = match lbl.lbl_repres with Record_regular -> Psetfield(lbl.lbl_pos, maybe_pointer expr) @@ -1048,3 +1104,5 @@ | Free_super_var -> fprintf ppf "Ancestor names can only be used to select inherited methods" + | Unknown_builtin_primitive prim_name -> + fprintf ppf "Unknown builtin primitive \"%s\"" prim_name diff -Nru ocaml-3.12.1/bytecomp/translcore.mli ocaml-4.01.0/bytecomp/translcore.mli --- ocaml-3.12.1/bytecomp/translcore.mli 2007-05-16 08:21:41.000000000 +0000 +++ ocaml-4.01.0/bytecomp/translcore.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,24 +10,21 @@ (* *) (***********************************************************************) -(* $Id: translcore.mli 8232 2007-05-16 08:21:41Z doligez $ *) - (* Translation from typed abstract syntax to lambda terms, for the core language *) open Asttypes -open Types open Typedtree open Lambda val name_pattern: string -> (pattern * 'a) list -> Ident.t val transl_exp: expression -> lambda -val transl_apply: lambda -> (expression option * optional) list +val transl_apply: lambda -> (label * expression option * optional) list -> Location.t -> lambda val transl_let: rec_flag -> (pattern * expression) list -> lambda -> lambda -val transl_primitive: Primitive.description -> lambda +val transl_primitive: Location.t -> Primitive.description -> lambda val transl_exception: Ident.t -> Path.t option -> exception_declaration -> lambda @@ -37,6 +34,7 @@ Illegal_letrec_pat | Illegal_letrec_expr | Free_super_var + | Unknown_builtin_primitive of string exception Error of Location.t * error diff -Nru ocaml-3.12.1/bytecomp/translmod.ml ocaml-4.01.0/bytecomp/translmod.ml --- ocaml-3.12.1/bytecomp/translmod.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/bytecomp/translmod.ml 2013-07-17 15:20:26.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: translmod.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Translation from typed abstract syntax to lambda terms, for the module language *) @@ -21,7 +19,6 @@ open Path open Types open Typedtree -open Primitive open Lambda open Translobj open Translcore @@ -50,7 +47,7 @@ (Lapply(Lvar id, [apply_coercion cc_arg (Lvar param)], Location.none)))) | Tcoerce_primitive p -> - transl_primitive p + transl_primitive Location.none p and apply_coercion_field id (pos, cc) = apply_coercion cc (Lprim(Pfield pos, [Lvar id])) @@ -82,7 +79,8 @@ let primitive_declarations = ref ([] : Primitive.description list) let record_primitive = function - | {val_kind=Val_prim p} -> primitive_declarations := p :: !primitive_declarations + | {val_kind=Val_prim p} -> + primitive_declarations := p :: !primitive_declarations | _ -> () (* Keep track of the root path (from the root of the namespace to the @@ -109,13 +107,7 @@ fatal_error ("Primitive " ^ name ^ " not found.") let undefined_location loc = - (* Confer Translcore.assert_failed *) - let fname = match loc.Location.loc_start.Lexing.pos_fname with - | "" -> !Location.input_name - | x -> x in - let pos = loc.Location.loc_start in - let line = pos.Lexing.pos_lnum in - let char = pos.Lexing.pos_cnum - pos.Lexing.pos_bol in + let (fname, line, char) = Location.get_pos_info loc.Location.loc_start in Lconst(Const_block(0, [Const_base(Const_string fname); Const_base(Const_int line); @@ -124,16 +116,16 @@ let init_shape modl = let rec init_shape_mod env mty = match Mtype.scrape env mty with - Tmty_ident _ -> + Mty_ident _ -> raise Not_found - | Tmty_signature sg -> + | Mty_signature sg -> Const_block(0, [Const_block(0, init_shape_struct env sg)]) - | Tmty_functor(id, arg, res) -> + | Mty_functor(id, arg, res) -> raise Not_found (* can we do better? *) and init_shape_struct env sg = match sg with [] -> [] - | Tsig_value(id, vdesc) :: rem -> + | Sig_value(id, vdesc) :: rem -> let init_v = match Ctype.expand_head env vdesc.val_type with {desc = Tarrow(_,_,_,_)} -> @@ -142,19 +134,19 @@ Const_pointer 1 (* camlinternalMod.Lazy *) | _ -> raise Not_found in init_v :: init_shape_struct env rem - | Tsig_type(id, tdecl, _) :: rem -> + | Sig_type(id, tdecl, _) :: rem -> init_shape_struct (Env.add_type id tdecl env) rem - | Tsig_exception(id, edecl) :: rem -> + | Sig_exception(id, edecl) :: rem -> raise Not_found - | Tsig_module(id, mty, _) :: rem -> + | Sig_module(id, mty, _) :: rem -> init_shape_mod env mty :: init_shape_struct (Env.add_module id mty env) rem - | Tsig_modtype(id, minfo) :: rem -> + | Sig_modtype(id, minfo) :: rem -> init_shape_struct (Env.add_modtype id minfo env) rem - | Tsig_class(id, cdecl, _) :: rem -> + | Sig_class(id, cdecl, _) :: rem -> Const_pointer 2 (* camlinternalMod.Class *) :: init_shape_struct env rem - | Tsig_cltype(id, ctyp, _) :: rem -> + | Sig_class_type(id, ctyp, _) :: rem -> init_shape_struct env rem in try @@ -231,20 +223,34 @@ eval_rec_bindings (reorder_rec_bindings (List.map - (fun (id, modl) -> + (fun ( id, _, _, modl) -> (id, modl.mod_loc, init_shape modl, compile_rhs id modl)) bindings)) cont +(* Extract the list of "value" identifiers bound by a signature. + "Value" identifiers are identifiers for signature components that + correspond to a run-time value: values, exceptions, modules, classes. + Note: manifest primitives do not correspond to a run-time value! *) + +let rec bound_value_identifiers = function + [] -> [] + | Sig_value(id, {val_kind = Val_reg}) :: rem -> + id :: bound_value_identifiers rem + | Sig_exception(id, decl) :: rem -> id :: bound_value_identifiers rem + | Sig_module(id, mty, _) :: rem -> id :: bound_value_identifiers rem + | Sig_class(id, decl, _) :: rem -> id :: bound_value_identifiers rem + | _ :: rem -> bound_value_identifiers rem + (* Compile a module expression *) let rec transl_module cc rootpath mexp = match mexp.mod_desc with - Tmod_ident path -> + Tmod_ident (path,_) -> apply_coercion cc (transl_path path) | Tmod_structure str -> - transl_structure [] cc rootpath str - | Tmod_functor(param, mty, body) -> + transl_struct [] cc rootpath str + | Tmod_functor( param, _, mty, body) -> let bodypath = functor_path rootpath param in oo_wrap mexp.mod_env true (function @@ -264,10 +270,13 @@ (apply_coercion cc) (Lapply(transl_module Tcoerce_none None funct, [transl_module ccarg None arg], mexp.mod_loc)) - | Tmod_constraint(arg, mty, ccarg) -> + | Tmod_constraint(arg, mty, _, ccarg) -> transl_module (compose_coercions cc ccarg) rootpath arg | Tmod_unpack(arg, _) -> - Translcore.transl_exp arg + apply_coercion cc (Translcore.transl_exp arg) + +and transl_struct fields cc rootpath str = + transl_structure fields cc rootpath str.str_items and transl_structure fields cc rootpath = function [] -> @@ -281,54 +290,60 @@ List.map (fun (pos, cc) -> match cc with - Tcoerce_primitive p -> transl_primitive p + Tcoerce_primitive p -> transl_primitive Location.none p | _ -> apply_coercion cc (Lvar v.(pos))) pos_cc_list) | _ -> fatal_error "Translmod.transl_structure" end - | Tstr_eval expr :: rem -> + | item :: rem -> + match item.str_desc with + | Tstr_eval expr -> Lsequence(transl_exp expr, transl_structure fields cc rootpath rem) - | Tstr_value(rec_flag, pat_expr_list) :: rem -> + | Tstr_value(rec_flag, pat_expr_list) -> let ext_fields = rev_let_bound_idents pat_expr_list @ fields in transl_let rec_flag pat_expr_list (transl_structure ext_fields cc rootpath rem) - | Tstr_primitive(id, descr) :: rem -> - record_primitive descr; + | Tstr_primitive(id, _, descr) -> + record_primitive descr.val_val; transl_structure fields cc rootpath rem - | Tstr_type(decls) :: rem -> + | Tstr_type(decls) -> transl_structure fields cc rootpath rem - | Tstr_exception(id, decl) :: rem -> + | Tstr_exception( id, _, decl) -> Llet(Strict, id, transl_exception id (field_path rootpath id) decl, transl_structure (id :: fields) cc rootpath rem) - | Tstr_exn_rebind(id, path) :: rem -> + | Tstr_exn_rebind( id, _, path, _) -> Llet(Strict, id, transl_path path, transl_structure (id :: fields) cc rootpath rem) - | Tstr_module(id, modl) :: rem -> + | Tstr_module( id, _, modl) -> Llet(Strict, id, transl_module Tcoerce_none (field_path rootpath id) modl, transl_structure (id :: fields) cc rootpath rem) - | Tstr_recmodule bindings :: rem -> - let ext_fields = List.rev_append (List.map fst bindings) fields in + | Tstr_recmodule bindings -> + let ext_fields = + List.rev_append (List.map (fun (id, _,_,_) -> id) bindings) fields in compile_recmodule (fun id modl -> transl_module Tcoerce_none (field_path rootpath id) modl) bindings (transl_structure ext_fields cc rootpath rem) - | Tstr_modtype(id, decl) :: rem -> + | Tstr_modtype(id, _, decl) -> transl_structure fields cc rootpath rem - | Tstr_open path :: rem -> + | Tstr_open _ -> transl_structure fields cc rootpath rem - | Tstr_class cl_list :: rem -> - let ids = List.map (fun (i, _, _, _, _) -> i) cl_list in + | Tstr_class cl_list -> + let ids = List.map (fun (ci,_,_) -> ci.ci_id_class) cl_list in Lletrec(List.map - (fun (id, arity, meths, cl, vf) -> - (id, transl_class ids id arity meths cl vf)) + (fun (ci, meths, vf) -> + let id = ci.ci_id_class in + let cl = ci.ci_expr in + (id, transl_class ids id meths cl vf )) cl_list, transl_structure (List.rev ids @ fields) cc rootpath rem) - | Tstr_cltype cl_list :: rem -> + | Tstr_class_type cl_list -> transl_structure fields cc rootpath rem - | Tstr_include(modl, ids) :: rem -> + | Tstr_include(modl, sg) -> + let ids = bound_value_identifiers sg in let mid = Ident.create "include" in let rec rebind_idents pos newfields = function [] -> @@ -351,7 +366,78 @@ let module_id = Ident.create_persistent module_name in Lprim(Psetglobal module_id, [transl_label_init - (transl_structure [] cc (global_path module_id) str)]) + (transl_struct [] cc (global_path module_id) str)]) + + +(* Build the list of value identifiers defined by a toplevel structure + (excluding primitive declarations). *) + +let rec defined_idents = function + [] -> [] + | item :: rem -> + match item.str_desc with + | Tstr_eval expr -> defined_idents rem + | Tstr_value(rec_flag, pat_expr_list) -> + let_bound_idents pat_expr_list @ defined_idents rem + | Tstr_primitive(id, _, descr) -> defined_idents rem + | Tstr_type decls -> defined_idents rem + | Tstr_exception(id, _, decl) -> id :: defined_idents rem + | Tstr_exn_rebind(id, _, path, _) -> id :: defined_idents rem + | Tstr_module(id, _, modl) -> id :: defined_idents rem + | Tstr_recmodule decls -> + List.map (fun (id, _, _, _) -> id) decls @ defined_idents rem + | Tstr_modtype(id, _, decl) -> defined_idents rem + | Tstr_open _ -> defined_idents rem + | Tstr_class cl_list -> + List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list @ defined_idents rem + | Tstr_class_type cl_list -> defined_idents rem + | Tstr_include(modl, sg) -> bound_value_identifiers sg @ defined_idents rem + +(* second level idents (module M = struct ... let id = ... end), + and all sub-levels idents *) +let rec more_idents = function + [] -> [] + | item :: rem -> + match item.str_desc with + | Tstr_eval expr -> more_idents rem + | Tstr_value(rec_flag, pat_expr_list) -> more_idents rem + | Tstr_primitive(id, _, descr) -> more_idents rem + | Tstr_type decls -> more_idents rem + | Tstr_exception(id, _, decl) -> more_idents rem + | Tstr_exn_rebind(id, _, path, _) -> more_idents rem + | Tstr_recmodule decls -> more_idents rem + | Tstr_modtype(id, _, decl) -> more_idents rem + | Tstr_open _ -> more_idents rem + | Tstr_class cl_list -> more_idents rem + | Tstr_class_type cl_list -> more_idents rem + | Tstr_include(modl, _) -> more_idents rem + | Tstr_module(id, _, { mod_desc = Tmod_structure str }) -> + all_idents str.str_items @ more_idents rem + | Tstr_module(id, _, _) -> more_idents rem + +and all_idents = function + [] -> [] + | item :: rem -> + match item.str_desc with + | Tstr_eval expr -> all_idents rem + | Tstr_value(rec_flag, pat_expr_list) -> + let_bound_idents pat_expr_list @ all_idents rem + | Tstr_primitive(id, _, descr) -> all_idents rem + | Tstr_type decls -> all_idents rem + | Tstr_exception(id, _, decl) -> id :: all_idents rem + | Tstr_exn_rebind(id, _, path, _) -> id :: all_idents rem + | Tstr_recmodule decls -> + List.map (fun (id, _, _, _) -> id) decls @ all_idents rem + | Tstr_modtype(id, _, decl) -> all_idents rem + | Tstr_open _ -> all_idents rem + | Tstr_class cl_list -> + List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list @ all_idents rem + | Tstr_class_type cl_list -> all_idents rem + | Tstr_include(modl, sg) -> bound_value_identifiers sg @ all_idents rem + | Tstr_module(id, _, { mod_desc = Tmod_structure str }) -> + id :: all_idents str.str_items @ all_idents rem + | Tstr_module(id, _, _) -> id :: all_idents rem + (* A variant of transl_structure used to compile toplevel structure definitions for the native-code compiler. Store the defined values in the fields @@ -374,34 +460,49 @@ fatal_error("Translmod.nat_toplevel_name: " ^ Ident.unique_name id) let transl_store_structure glob map prims str = - let rec transl_store subst = function + let rec transl_store rootpath subst = function [] -> transl_store_subst := subst; - lambda_unit - | Tstr_eval expr :: rem -> + lambda_unit + | item :: rem -> + match item.str_desc with + | Tstr_eval expr -> Lsequence(subst_lambda subst (transl_exp expr), - transl_store subst rem) - | Tstr_value(rec_flag, pat_expr_list) :: rem -> + transl_store rootpath subst rem) + | Tstr_value(rec_flag, pat_expr_list) -> let ids = let_bound_idents pat_expr_list in let lam = transl_let rec_flag pat_expr_list (store_idents ids) in Lsequence(subst_lambda subst lam, - transl_store (add_idents false ids subst) rem) - | Tstr_primitive(id, descr) :: rem -> - record_primitive descr; - transl_store subst rem - | Tstr_type(decls) :: rem -> - transl_store subst rem - | Tstr_exception(id, decl) :: rem -> - let lam = transl_exception id (field_path (global_path glob) id) decl in + transl_store rootpath (add_idents false ids subst) rem) + | Tstr_primitive(id, _, descr) -> + record_primitive descr.val_val; + transl_store rootpath subst rem + | Tstr_type(decls) -> + transl_store rootpath subst rem + | Tstr_exception( id, _, decl) -> + let lam = transl_exception id (field_path rootpath id) decl in Lsequence(Llet(Strict, id, lam, store_ident id), - transl_store (add_ident false id subst) rem) - | Tstr_exn_rebind(id, path) :: rem -> + transl_store rootpath (add_ident false id subst) rem) + | Tstr_exn_rebind( id, _, path, _) -> let lam = subst_lambda subst (transl_path path) in Lsequence(Llet(Strict, id, lam, store_ident id), - transl_store (add_ident false id subst) rem) - | Tstr_module(id, modl) :: rem -> + transl_store rootpath (add_ident false id subst) rem) + | Tstr_module(id, _, { mod_desc = Tmod_structure str }) -> + let lam = transl_store (field_path rootpath id) subst str.str_items in + (* Careful: see next case *) + let subst = !transl_store_subst in + Lsequence(lam, + Llet(Strict, id, + subst_lambda subst + (Lprim(Pmakeblock(0, Immutable), + List.map (fun id -> Lvar id) + (defined_idents str.str_items))), + Lsequence(store_ident id, + transl_store rootpath (add_ident true id subst) + rem))) + | Tstr_module( id, _, modl) -> let lam = - transl_module Tcoerce_none (field_path (global_path glob) id) modl in + transl_module Tcoerce_none (field_path rootpath id) modl in (* Careful: the module value stored in the global may be different from the local module value, in case a coercion is applied. If so, keep using the local module value (id) in the remainder of @@ -409,37 +510,41 @@ If not, we can use the value from the global (add_ident true adds id -> Pgetglobal... to subst). *) Llet(Strict, id, subst_lambda subst lam, - Lsequence(store_ident id, transl_store(add_ident true id subst) rem)) - | Tstr_recmodule bindings :: rem -> - let ids = List.map fst bindings in + Lsequence(store_ident id, + transl_store rootpath (add_ident true id subst) rem)) + | Tstr_recmodule bindings -> + let ids = List.map fst4 bindings in compile_recmodule (fun id modl -> subst_lambda subst (transl_module Tcoerce_none - (field_path (global_path glob) id) modl)) + (field_path rootpath id) modl)) bindings (Lsequence(store_idents ids, - transl_store (add_idents true ids subst) rem)) - | Tstr_modtype(id, decl) :: rem -> - transl_store subst rem - | Tstr_open path :: rem -> - transl_store subst rem - | Tstr_class cl_list :: rem -> - let ids = List.map (fun (i, _, _, _, _) -> i) cl_list in + transl_store rootpath (add_idents true ids subst) rem)) + | Tstr_modtype(id, _, decl) -> + transl_store rootpath subst rem + | Tstr_open _ -> + transl_store rootpath subst rem + | Tstr_class cl_list -> + let ids = List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list in let lam = Lletrec(List.map - (fun (id, arity, meths, cl, vf) -> - (id, transl_class ids id arity meths cl vf)) + (fun (ci, meths, vf) -> + let id = ci.ci_id_class in + let cl = ci.ci_expr in + (id, transl_class ids id meths cl vf)) cl_list, store_idents ids) in Lsequence(subst_lambda subst lam, - transl_store (add_idents false ids subst) rem) - | Tstr_cltype cl_list :: rem -> - transl_store subst rem - | Tstr_include(modl, ids) :: rem -> + transl_store rootpath (add_idents false ids subst) rem) + | Tstr_class_type cl_list -> + transl_store rootpath subst rem + | Tstr_include(modl, sg) -> + let ids = bound_value_identifiers sg in let mid = Ident.create "include" in let rec store_idents pos = function - [] -> transl_store (add_idents true ids subst) rem + [] -> transl_store rootpath (add_idents true ids subst) rem | id :: idl -> Llet(Alias, id, Lprim(Pfield pos, [Lvar mid]), Lsequence(store_ident id, store_idents (pos + 1) idl)) in @@ -474,31 +579,12 @@ and store_primitive (pos, prim) cont = Lsequence(Lprim(Psetfield(pos, false), - [Lprim(Pgetglobal glob, []); transl_primitive prim]), + [Lprim(Pgetglobal glob, []); + transl_primitive Location.none prim]), cont) - in List.fold_right store_primitive prims (transl_store !transl_store_subst str) - -(* Build the list of value identifiers defined by a toplevel structure - (excluding primitive declarations). *) - -let rec defined_idents = function - [] -> [] - | Tstr_eval expr :: rem -> defined_idents rem - | Tstr_value(rec_flag, pat_expr_list) :: rem -> - let_bound_idents pat_expr_list @ defined_idents rem - | Tstr_primitive(id, descr) :: rem -> defined_idents rem - | Tstr_type decls :: rem -> defined_idents rem - | Tstr_exception(id, decl) :: rem -> id :: defined_idents rem - | Tstr_exn_rebind(id, path) :: rem -> id :: defined_idents rem - | Tstr_module(id, modl) :: rem -> id :: defined_idents rem - | Tstr_recmodule decls :: rem -> List.map fst decls @ defined_idents rem - | Tstr_modtype(id, decl) :: rem -> defined_idents rem - | Tstr_open path :: rem -> defined_idents rem - | Tstr_class cl_list :: rem -> - List.map (fun (i, _, _, _, _) -> i) cl_list @ defined_idents rem - | Tstr_cltype cl_list :: rem -> defined_idents rem - | Tstr_include(modl, ids) :: rem -> ids @ defined_idents rem + in List.fold_right store_primitive prims + (transl_store (global_path glob) !transl_store_subst str) (* Transform a coercion and the list of value identifiers defined by a toplevel structure into a table [id -> (pos, coercion)], @@ -512,40 +598,44 @@ Also compute the total size of the global block, and the list of all primitives exported as values. *) -let build_ident_map restr idlist = +let build_ident_map restr idlist more_ids = let rec natural_map pos map prims = function [] -> (map, prims, pos) | id :: rem -> natural_map (pos+1) (Ident.add id (pos, Tcoerce_none) map) prims rem in - match restr with - Tcoerce_none -> - natural_map 0 Ident.empty [] idlist - | Tcoerce_structure pos_cc_list -> - let idarray = Array.of_list idlist in - let rec export_map pos map prims undef = function + let (map, prims, pos) = + match restr with + Tcoerce_none -> + natural_map 0 Ident.empty [] idlist + | Tcoerce_structure pos_cc_list -> + let idarray = Array.of_list idlist in + let rec export_map pos map prims undef = function [] -> natural_map pos map prims undef - | (source_pos, Tcoerce_primitive p) :: rem -> - export_map (pos + 1) map ((pos, p) :: prims) undef rem - | (source_pos, cc) :: rem -> - let id = idarray.(source_pos) in - export_map (pos + 1) (Ident.add id (pos, cc) map) - prims (list_remove id undef) rem - in export_map 0 Ident.empty [] idlist pos_cc_list - | _ -> - fatal_error "Translmod.build_ident_map" + | (source_pos, Tcoerce_primitive p) :: rem -> + export_map (pos + 1) map ((pos, p) :: prims) undef rem + | (source_pos, cc) :: rem -> + let id = idarray.(source_pos) in + export_map (pos + 1) (Ident.add id (pos, cc) map) + prims (list_remove id undef) rem + in export_map 0 Ident.empty [] idlist pos_cc_list + | _ -> + fatal_error "Translmod.build_ident_map" + in + natural_map pos map prims more_ids (* Compile an implementation using transl_store_structure (for the native-code compiler). *) -let transl_store_gen module_name (str, restr) topl = +let transl_store_gen module_name ({ str_items = str }, restr) topl = reset_labels (); primitive_declarations := []; let module_id = Ident.create_persistent module_name in - let (map, prims, size) = build_ident_map restr (defined_idents str) in + let (map, prims, size) = + build_ident_map restr (defined_idents str) (more_idents str) in let f = function - | [ Tstr_eval expr ] when topl -> + | [ { str_desc = Tstr_eval expr } ] when topl -> assert (size = 0); subst_lambda !transl_store_subst (transl_exp expr) | str -> transl_store_structure module_id map prims str in @@ -596,52 +686,56 @@ IdentSet.fold (fun id l -> Llet(Strict, id, toploop_getvalue id, l)) (free_variables lam) lam -let transl_toplevel_item = function +let transl_toplevel_item item = + match item.str_desc with Tstr_eval expr -> transl_exp expr | Tstr_value(rec_flag, pat_expr_list) -> let idents = let_bound_idents pat_expr_list in transl_let rec_flag pat_expr_list (make_sequence toploop_setvalue_id idents) - | Tstr_primitive(id, descr) -> + | Tstr_primitive(id, _, descr) -> lambda_unit | Tstr_type(decls) -> lambda_unit - | Tstr_exception(id, decl) -> + | Tstr_exception(id, _, decl) -> toploop_setvalue id (transl_exception id None decl) - | Tstr_exn_rebind(id, path) -> + | Tstr_exn_rebind(id, _, path, _) -> toploop_setvalue id (transl_path path) - | Tstr_module(id, modl) -> + | Tstr_module(id, _, modl) -> (* we need to use the unique name for the module because of issues with "open" (PR#1672) *) set_toplevel_unique_name id; toploop_setvalue id (transl_module Tcoerce_none (Some(Pident id)) modl) | Tstr_recmodule bindings -> - let idents = List.map fst bindings in + let idents = List.map fst4 bindings in compile_recmodule (fun id modl -> transl_module Tcoerce_none (Some(Pident id)) modl) bindings (make_sequence toploop_setvalue_id idents) - | Tstr_modtype(id, decl) -> + | Tstr_modtype(id, _, decl) -> lambda_unit - | Tstr_open path -> + | Tstr_open _ -> lambda_unit | Tstr_class cl_list -> (* we need to use unique names for the classes because there might be a value named identically *) - let ids = List.map (fun (i, _, _, _, _) -> i) cl_list in + let ids = List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list in List.iter set_toplevel_unique_name ids; Lletrec(List.map - (fun (id, arity, meths, cl, vf) -> - (id, transl_class ids id arity meths cl vf)) + (fun (ci, meths, vf) -> + let id = ci.ci_id_class in + let cl = ci.ci_expr in + (id, transl_class ids id meths cl vf)) cl_list, make_sequence - (fun (id, _, _, _, _) -> toploop_setvalue_id id) + (fun (ci, _, _) -> toploop_setvalue_id ci.ci_id_class) cl_list) - | Tstr_cltype cl_list -> + | Tstr_class_type cl_list -> lambda_unit - | Tstr_include(modl, ids) -> + | Tstr_include(modl, sg) -> + let ids = bound_value_identifiers sg in let mid = Ident.create "include" in let rec set_idents pos = function [] -> @@ -656,7 +750,7 @@ let transl_toplevel_definition str = reset_labels (); - make_sequence transl_toplevel_item_and_close str + make_sequence transl_toplevel_item_and_close str.str_items (* Compile the initialization code for a packed library *) @@ -710,5 +804,6 @@ let report_error ppf = function Circular_dependency id -> fprintf ppf - "@[Cannot safely evaluate the definition@ of the recursively-defined module %a@]" + "@[Cannot safely evaluate the definition@ \ + of the recursively-defined module %a@]" Printtyp.ident id diff -Nru ocaml-3.12.1/bytecomp/translmod.mli ocaml-4.01.0/bytecomp/translmod.mli --- ocaml-3.12.1/bytecomp/translmod.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/bytecomp/translmod.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: translmod.mli 9547 2010-01-22 12:48:24Z doligez $ *) - (* Translation from typed abstract syntax to lambda terms, for the module language *) diff -Nru ocaml-3.12.1/bytecomp/translobj.ml ocaml-4.01.0/bytecomp/translobj.ml --- ocaml-3.12.1/bytecomp/translobj.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/bytecomp/translobj.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: translobj.ml 9547 2010-01-22 12:48:24Z doligez $ *) - open Misc open Primitive open Asttypes diff -Nru ocaml-3.12.1/bytecomp/translobj.mli ocaml-4.01.0/bytecomp/translobj.mli --- ocaml-3.12.1/bytecomp/translobj.mli 2008-12-03 18:09:09.000000000 +0000 +++ ocaml-4.01.0/bytecomp/translobj.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: translobj.mli 9153 2008-12-03 18:09:09Z doligez $ *) - open Lambda val oo_prim: string -> lambda diff -Nru ocaml-3.12.1/bytecomp/typeopt.ml ocaml-4.01.0/bytecomp/typeopt.ml --- ocaml-3.12.1/bytecomp/typeopt.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/bytecomp/typeopt.ml 2013-03-09 22:38:52.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,13 +10,8 @@ (* *) (***********************************************************************) -(* $Id: typeopt.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Auxiliaries for type-based optimizations, e.g. array kinds *) -open Misc -open Asttypes -open Primitive open Path open Types open Typedtree @@ -37,9 +32,9 @@ not (Path.same p Predef.path_char) && begin try match Env.find_type p exp.exp_env with - {type_kind = Type_variant []} -> true (* type exn *) + | {type_kind = Type_variant []} -> true (* type exn *) | {type_kind = Type_variant cstrs} -> - List.exists (fun (name, args) -> args <> []) cstrs + List.exists (fun (name, args,_) -> args <> []) cstrs | _ -> true with Not_found -> true (* This can happen due to e.g. missing -I options, @@ -50,7 +45,7 @@ let array_element_kind env ty = match scrape env ty with - | Tvar | Tunivar -> + | Tvar _ | Tunivar _ -> Pgenarray | Tconstr(p, args, abbrev) -> if Path.same p Predef.path_int || Path.same p Predef.path_char then @@ -69,7 +64,7 @@ {type_kind = Type_abstract} -> Pgenarray | {type_kind = Type_variant cstrs} - when List.for_all (fun (name, args) -> args = []) cstrs -> + when List.for_all (fun (name, args,_) -> args = []) cstrs -> Pintarray | {type_kind = _} -> Paddrarray @@ -125,6 +120,7 @@ match scrape exp.exp_env exp.exp_type with | Tconstr(p, [caml_type; elt_type; layout_type], abbrev) -> (bigarray_decode_type exp.exp_env elt_type kind_table Pbigarray_unknown, - bigarray_decode_type exp.exp_env layout_type layout_table Pbigarray_unknown_layout) + bigarray_decode_type exp.exp_env layout_type layout_table + Pbigarray_unknown_layout) | _ -> (Pbigarray_unknown, Pbigarray_unknown_layout) diff -Nru ocaml-3.12.1/bytecomp/typeopt.mli ocaml-4.01.0/bytecomp/typeopt.mli --- ocaml-3.12.1/bytecomp/typeopt.mli 2000-02-28 15:45:50.000000000 +0000 +++ ocaml-4.01.0/bytecomp/typeopt.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: typeopt.mli 2873 2000-02-28 15:45:50Z xleroy $ *) - (* Auxiliaries for type-based optimizations, e.g. array kinds *) val has_base_type : Typedtree.expression -> Path.t -> bool diff -Nru ocaml-3.12.1/byterun/.cvsignore ocaml-4.01.0/byterun/.cvsignore --- ocaml-3.12.1/byterun/.cvsignore 2010-05-19 14:52:34.000000000 +0000 +++ ocaml-4.01.0/byterun/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,20 +0,0 @@ -jumptbl.h -primitives -prims.c -opnames.h -version.h -ocamlrun -ocamlrund -ld.conf -libcamlrun.x -libcamlrun-gui.x -*.c.x -ocamlrun.xcoff -ocamlrun.dbg -interp.a.lst -*.[sd]obj -*.lib -.gdb_history -*.so -*.a -.depend.nt diff -Nru ocaml-3.12.1/byterun/.depend ocaml-4.01.0/byterun/.depend --- ocaml-3.12.1/byterun/.depend 2010-07-23 15:30:37.000000000 +0000 +++ ocaml-4.01.0/byterun/.depend 2013-08-15 16:13:16.000000000 +0000 @@ -6,7 +6,7 @@ minor_gc.h backtrace.o: backtrace.c config.h ../config/m.h ../config/s.h \ compatibility.h mlvalues.h misc.h alloc.h io.h instruct.h intext.h \ - fix_code.h exec.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ + exec.h fix_code.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ startup.h stacks.h sys.h backtrace.h callback.o: callback.c callback.h compatibility.h mlvalues.h config.h \ ../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \ @@ -20,15 +20,15 @@ custom.o: custom.c alloc.h compatibility.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h custom.h fail.h memory.h gc.h major_gc.h \ freelist.h minor_gc.h -debugger.o: debugger.c config.h ../config/m.h ../config/s.h \ - compatibility.h debugger.h misc.h mlvalues.h fail.h fix_code.h \ +debugger.o: debugger.c alloc.h compatibility.h misc.h config.h \ + ../config/m.h ../config/s.h mlvalues.h debugger.h fail.h fix_code.h \ instruct.h intext.h io.h stacks.h memory.h gc.h major_gc.h freelist.h \ minor_gc.h sys.h dynlink.o: dynlink.c config.h ../config/m.h ../config/s.h compatibility.h \ alloc.h misc.h mlvalues.h dynlink.h fail.h memory.h gc.h major_gc.h \ freelist.h minor_gc.h osdeps.h prims.h extern.o: extern.c alloc.h compatibility.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h custom.h fail.h gc.h intext.h io.h fix_code.h \ + ../config/s.h mlvalues.h custom.h fail.h gc.h intext.h io.h md5.h \ memory.h major_gc.h freelist.h minor_gc.h reverse.h fail.o: fail.c alloc.h compatibility.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h fail.h io.h gc.h memory.h major_gc.h \ @@ -38,7 +38,8 @@ major_gc.h freelist.h minor_gc.h signals.h fix_code.o: fix_code.c config.h ../config/m.h ../config/s.h \ compatibility.h debugger.h misc.h mlvalues.h fix_code.h instruct.h \ - md5.h io.h memory.h gc.h major_gc.h freelist.h minor_gc.h reverse.h + intext.h io.h md5.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ + reverse.h floats.o: floats.c alloc.h compatibility.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h \ minor_gc.h reverse.h stacks.h @@ -54,18 +55,18 @@ roots.h globroots.h hash.o: hash.c mlvalues.h compatibility.h config.h ../config/m.h \ ../config/s.h misc.h custom.h memory.h gc.h major_gc.h freelist.h \ - minor_gc.h + minor_gc.h hash.h int64_native.h instrtrace.o: instrtrace.c intern.o: intern.c alloc.h compatibility.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h custom.h fail.h gc.h intext.h io.h fix_code.h \ - memory.h major_gc.h freelist.h minor_gc.h reverse.h + ../config/s.h mlvalues.h callback.h custom.h fail.h gc.h intext.h io.h \ + md5.h memory.h major_gc.h freelist.h minor_gc.h reverse.h interp.o: interp.c alloc.h compatibility.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h backtrace.h callback.h debugger.h fail.h \ fix_code.h instrtrace.h instruct.h interp.h major_gc.h freelist.h \ memory.h gc.h minor_gc.h prims.h signals.h stacks.h jumptbl.h ints.o: ints.c alloc.h compatibility.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h custom.h fail.h intext.h io.h fix_code.h \ - memory.h gc.h major_gc.h freelist.h minor_gc.h int64_native.h + ../config/s.h mlvalues.h custom.h fail.h intext.h io.h memory.h gc.h \ + major_gc.h freelist.h minor_gc.h int64_native.h io.o: io.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \ misc.h mlvalues.h custom.h fail.h io.h memory.h gc.h major_gc.h \ freelist.h minor_gc.h signals.h sys.h @@ -122,7 +123,7 @@ prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h \ version.h str.o: str.c alloc.h compatibility.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h fail.h + ../config/s.h mlvalues.h fail.h int64_native.h sys.o: sys.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \ misc.h mlvalues.h debugger.h fail.h instruct.h osdeps.h signals.h \ stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h @@ -134,6 +135,9 @@ weak.o: weak.c alloc.h compatibility.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h fail.h major_gc.h freelist.h memory.h gc.h \ minor_gc.h +win32.o: win32.c fail.h compatibility.h misc.h config.h ../config/m.h \ + ../config/s.h mlvalues.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ + osdeps.h signals.h sys.h alloc.d.o: alloc.c alloc.h compatibility.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h custom.h major_gc.h freelist.h memory.h gc.h \ minor_gc.h stacks.h @@ -142,7 +146,7 @@ minor_gc.h backtrace.d.o: backtrace.c config.h ../config/m.h ../config/s.h \ compatibility.h mlvalues.h misc.h alloc.h io.h instruct.h intext.h \ - fix_code.h exec.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ + exec.h fix_code.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ startup.h stacks.h sys.h backtrace.h callback.d.o: callback.c callback.h compatibility.h mlvalues.h config.h \ ../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \ @@ -156,15 +160,15 @@ custom.d.o: custom.c alloc.h compatibility.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h custom.h fail.h memory.h gc.h major_gc.h \ freelist.h minor_gc.h -debugger.d.o: debugger.c config.h ../config/m.h ../config/s.h \ - compatibility.h debugger.h misc.h mlvalues.h fail.h fix_code.h \ +debugger.d.o: debugger.c alloc.h compatibility.h misc.h config.h \ + ../config/m.h ../config/s.h mlvalues.h debugger.h fail.h fix_code.h \ instruct.h intext.h io.h stacks.h memory.h gc.h major_gc.h freelist.h \ minor_gc.h sys.h dynlink.d.o: dynlink.c config.h ../config/m.h ../config/s.h compatibility.h \ alloc.h misc.h mlvalues.h dynlink.h fail.h memory.h gc.h major_gc.h \ freelist.h minor_gc.h osdeps.h prims.h extern.d.o: extern.c alloc.h compatibility.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h custom.h fail.h gc.h intext.h io.h fix_code.h \ + ../config/s.h mlvalues.h custom.h fail.h gc.h intext.h io.h md5.h \ memory.h major_gc.h freelist.h minor_gc.h reverse.h fail.d.o: fail.c alloc.h compatibility.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h fail.h io.h gc.h memory.h major_gc.h \ @@ -174,7 +178,8 @@ major_gc.h freelist.h minor_gc.h signals.h fix_code.d.o: fix_code.c config.h ../config/m.h ../config/s.h \ compatibility.h debugger.h misc.h mlvalues.h fix_code.h instruct.h \ - md5.h io.h memory.h gc.h major_gc.h freelist.h minor_gc.h reverse.h + intext.h io.h md5.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ + reverse.h floats.d.o: floats.c alloc.h compatibility.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h \ minor_gc.h reverse.h stacks.h @@ -190,20 +195,20 @@ roots.h globroots.h hash.d.o: hash.c mlvalues.h compatibility.h config.h ../config/m.h \ ../config/s.h misc.h custom.h memory.h gc.h major_gc.h freelist.h \ - minor_gc.h + minor_gc.h hash.h int64_native.h instrtrace.d.o: instrtrace.c instruct.h misc.h compatibility.h config.h \ ../config/m.h ../config/s.h mlvalues.h opnames.h prims.h stacks.h \ memory.h gc.h major_gc.h freelist.h minor_gc.h intern.d.o: intern.c alloc.h compatibility.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h custom.h fail.h gc.h intext.h io.h fix_code.h \ - memory.h major_gc.h freelist.h minor_gc.h reverse.h + ../config/s.h mlvalues.h callback.h custom.h fail.h gc.h intext.h io.h \ + md5.h memory.h major_gc.h freelist.h minor_gc.h reverse.h interp.d.o: interp.c alloc.h compatibility.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h backtrace.h callback.h debugger.h fail.h \ fix_code.h instrtrace.h instruct.h interp.h major_gc.h freelist.h \ memory.h gc.h minor_gc.h prims.h signals.h stacks.h ints.d.o: ints.c alloc.h compatibility.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h custom.h fail.h intext.h io.h fix_code.h \ - memory.h gc.h major_gc.h freelist.h minor_gc.h int64_native.h + ../config/s.h mlvalues.h custom.h fail.h intext.h io.h memory.h gc.h \ + major_gc.h freelist.h minor_gc.h int64_native.h io.d.o: io.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \ misc.h mlvalues.h custom.h fail.h io.h memory.h gc.h major_gc.h \ freelist.h minor_gc.h signals.h sys.h @@ -260,7 +265,7 @@ prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h \ version.h str.d.o: str.c alloc.h compatibility.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h fail.h + ../config/s.h mlvalues.h fail.h int64_native.h sys.d.o: sys.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \ misc.h mlvalues.h debugger.h fail.h instruct.h osdeps.h signals.h \ stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h @@ -272,6 +277,9 @@ weak.d.o: weak.c alloc.h compatibility.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h fail.h major_gc.h freelist.h memory.h gc.h \ minor_gc.h +win32.d.o: win32.c fail.h compatibility.h misc.h config.h ../config/m.h \ + ../config/s.h mlvalues.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ + osdeps.h signals.h sys.h alloc.pic.o: alloc.c alloc.h compatibility.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h custom.h major_gc.h freelist.h memory.h gc.h \ minor_gc.h stacks.h @@ -280,7 +288,7 @@ minor_gc.h backtrace.pic.o: backtrace.c config.h ../config/m.h ../config/s.h \ compatibility.h mlvalues.h misc.h alloc.h io.h instruct.h intext.h \ - fix_code.h exec.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ + exec.h fix_code.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ startup.h stacks.h sys.h backtrace.h callback.pic.o: callback.c callback.h compatibility.h mlvalues.h config.h \ ../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \ @@ -294,15 +302,15 @@ custom.pic.o: custom.c alloc.h compatibility.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h custom.h fail.h memory.h gc.h major_gc.h \ freelist.h minor_gc.h -debugger.pic.o: debugger.c config.h ../config/m.h ../config/s.h \ - compatibility.h debugger.h misc.h mlvalues.h fail.h fix_code.h \ +debugger.pic.o: debugger.c alloc.h compatibility.h misc.h config.h \ + ../config/m.h ../config/s.h mlvalues.h debugger.h fail.h fix_code.h \ instruct.h intext.h io.h stacks.h memory.h gc.h major_gc.h freelist.h \ minor_gc.h sys.h dynlink.pic.o: dynlink.c config.h ../config/m.h ../config/s.h compatibility.h \ alloc.h misc.h mlvalues.h dynlink.h fail.h memory.h gc.h major_gc.h \ freelist.h minor_gc.h osdeps.h prims.h extern.pic.o: extern.c alloc.h compatibility.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h custom.h fail.h gc.h intext.h io.h fix_code.h \ + ../config/s.h mlvalues.h custom.h fail.h gc.h intext.h io.h md5.h \ memory.h major_gc.h freelist.h minor_gc.h reverse.h fail.pic.o: fail.c alloc.h compatibility.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h fail.h io.h gc.h memory.h major_gc.h \ @@ -312,7 +320,8 @@ major_gc.h freelist.h minor_gc.h signals.h fix_code.pic.o: fix_code.c config.h ../config/m.h ../config/s.h \ compatibility.h debugger.h misc.h mlvalues.h fix_code.h instruct.h \ - md5.h io.h memory.h gc.h major_gc.h freelist.h minor_gc.h reverse.h + intext.h io.h md5.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ + reverse.h floats.pic.o: floats.c alloc.h compatibility.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h \ minor_gc.h reverse.h stacks.h @@ -328,18 +337,18 @@ roots.h globroots.h hash.pic.o: hash.c mlvalues.h compatibility.h config.h ../config/m.h \ ../config/s.h misc.h custom.h memory.h gc.h major_gc.h freelist.h \ - minor_gc.h + minor_gc.h hash.h int64_native.h instrtrace.pic.o: instrtrace.c intern.pic.o: intern.c alloc.h compatibility.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h custom.h fail.h gc.h intext.h io.h fix_code.h \ - memory.h major_gc.h freelist.h minor_gc.h reverse.h + ../config/s.h mlvalues.h callback.h custom.h fail.h gc.h intext.h io.h \ + md5.h memory.h major_gc.h freelist.h minor_gc.h reverse.h interp.pic.o: interp.c alloc.h compatibility.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h backtrace.h callback.h debugger.h fail.h \ fix_code.h instrtrace.h instruct.h interp.h major_gc.h freelist.h \ memory.h gc.h minor_gc.h prims.h signals.h stacks.h jumptbl.h ints.pic.o: ints.c alloc.h compatibility.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h custom.h fail.h intext.h io.h fix_code.h \ - memory.h gc.h major_gc.h freelist.h minor_gc.h int64_native.h + ../config/s.h mlvalues.h custom.h fail.h intext.h io.h memory.h gc.h \ + major_gc.h freelist.h minor_gc.h int64_native.h io.pic.o: io.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \ misc.h mlvalues.h custom.h fail.h io.h memory.h gc.h major_gc.h \ freelist.h minor_gc.h signals.h sys.h @@ -396,7 +405,7 @@ prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h \ version.h str.pic.o: str.c alloc.h compatibility.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h fail.h + ../config/s.h mlvalues.h fail.h int64_native.h sys.pic.o: sys.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \ misc.h mlvalues.h debugger.h fail.h instruct.h osdeps.h signals.h \ stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h @@ -408,3 +417,6 @@ weak.pic.o: weak.c alloc.h compatibility.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h fail.h major_gc.h freelist.h memory.h gc.h \ minor_gc.h +win32.pic.o: win32.c fail.h compatibility.h misc.h config.h ../config/m.h \ + ../config/s.h mlvalues.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ + osdeps.h signals.h sys.h diff -Nru ocaml-3.12.1/byterun/.ignore ocaml-4.01.0/byterun/.ignore --- ocaml-3.12.1/byterun/.ignore 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/byterun/.ignore 2012-07-26 19:21:54.000000000 +0000 @@ -0,0 +1,16 @@ +jumptbl.h +primitives +prims.c +opnames.h +version.h +ocamlrun +ocamlrun.exe +ocamlrund +ocamlrund.exe +ld.conf +interp.a.lst +*.[sd]obj +*.lib +.gdb_history +*.d.c +*.pic.c diff -Nru ocaml-3.12.1/byterun/Makefile ocaml-4.01.0/byterun/Makefile --- ocaml-3.12.1/byterun/Makefile 2010-07-28 13:19:44.000000000 +0000 +++ ocaml-4.01.0/byterun/Makefile 2013-03-28 16:10:24.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -11,8 +11,6 @@ # # ######################################################################### -# $Id: Makefile 10638 2010-07-28 13:19:44Z doligez $ - include Makefile.common CFLAGS=-DCAML_NAME_SPACE -O $(BYTECCCOMPOPTS) $(IFLEXDIR) @@ -32,7 +30,7 @@ prims.o libcamlrun.a $(BYTECCLIBS) ocamlrund$(EXE): libcamlrund.a prims.o - $(MKEXE) -g $(BYTECCLINKOPTS) -o ocamlrund$(EXE) \ + $(MKEXE) $(MKEXEDEBUGFLAG) $(BYTECCLINKOPTS) -o ocamlrund$(EXE) \ prims.o libcamlrund.a $(BYTECCLIBS) libcamlrun.a: $(OBJS) @@ -53,20 +51,20 @@ clean:: rm -f libcamlrun_shared.so - .SUFFIXES: .d.o .pic.o .c.d.o: - @ if test -f $*.o; then mv $*.o $*.f.o; else :; fi - $(CC) -c $(DFLAGS) $< - mv $*.o $*.d.o - @ if test -f $*.f.o; then mv $*.f.o $*.o; else :; fi + ln -s -f $*.c $*.d.c + $(CC) -c $(DFLAGS) $*.d.c + rm $*.d.c .c.pic.o: - @ if test -f $*.o; then mv $*.o $*.f.o; else :; fi - $(CC) -c $(CFLAGS) $(SHAREDCCCOMPOPTS) $< - mv $*.o $*.pic.o - @ if test -f $*.f.o; then mv $*.f.o $*.o; else :; fi + ln -s -f $*.c $*.pic.c + $(CC) -c $(CFLAGS) $(SHAREDCCCOMPOPTS) $*.pic.c + rm $*.pic.c + +clean:: + rm -f *.pic.c *.d.c depend : prims.c opnames.h jumptbl.h version.h -gcc -MM $(BYTECCCOMPOPTS) *.c > .depend diff -Nru ocaml-3.12.1/byterun/Makefile.common ocaml-4.01.0/byterun/Makefile.common --- ocaml-3.12.1/byterun/Makefile.common 2010-05-21 11:28:21.000000000 +0000 +++ ocaml-4.01.0/byterun/Makefile.common 2013-08-19 18:21:47.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -11,8 +11,6 @@ # # ######################################################################### -# $Id: Makefile.common 10448 2010-05-21 11:28:21Z doligez $ - include ../config/Makefile CC=$(BYTECC) @@ -33,13 +31,19 @@ dynlink.c backtrace.c PUBLIC_INCLUDES=\ - alloc.h callback.h config.h custom.h fail.h intext.h \ + alloc.h callback.h config.h custom.h fail.h hash.h intext.h \ memory.h misc.h mlvalues.h printexc.h signals.h compatibility.h -all:: ocamlrun$(EXE) ld.conf libcamlrun.$(A) +all:: ocamlrun$(EXE) ld.conf libcamlrun.$(A) all-$(RUNTIMED) .PHONY: all +all-noruntimed: +.PHONY: all-noruntimed + +all-runtimed: ocamlrund$(EXE) libcamlrund.$(A) +.PHONY: all-runtimed + ld.conf: ../config/Makefile echo "$(STUBLIBDIR)" > ld.conf echo "$(LIBDIR)" >> ld.conf @@ -55,10 +59,33 @@ cp ld.conf $(LIBDIR)/ld.conf .PHONY: install +install:: install-$(RUNTIMED) + +install-noruntimed: +.PHONY: install-noruntimed + +install-runtimed: + cp ocamlrund$(EXE) $(BINDIR)/ocamlrund$(EXE) + cp libcamlrund.$(A) $(LIBDIR)/libcamlrund.$(A) +.PHONY: install-runtimed + +# If primitives contain duplicated lines (e.g. because the code is defined +# like +# #ifdef X +# CAMLprim value caml_foo() ... +# #else +# CAMLprim value caml_foo() ... +# end), horrible things will happen (duplicated entries in Runtimedef -> +# double registration in Symtable -> empty entry in the PRIM table -> +# the bytecode interpreter is confused). +# We sort the primitive file and remove duplicates to avoid this problem. + +# Warning: we use "sort | uniq" instead of "sort -u" because in the MSVC +# port, the "sort" program in the path is Microsoft's and not cygwin's primitives : $(PRIMS) - sed -n -e "s/CAMLprim value \([a-z0-9_][a-z0-9_]*\).*/\1/p" \ - $(PRIMS) > primitives + sed -n -e "s/CAMLprim value \([a-z0-9_][a-z0-9_]*\).*/\1/p" $(PRIMS) \ + | sort | uniq > primitives prims.c : primitives (echo '#include "mlvalues.h"'; \ diff -Nru ocaml-3.12.1/byterun/Makefile.nt ocaml-4.01.0/byterun/Makefile.nt --- ocaml-3.12.1/byterun/Makefile.nt 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/Makefile.nt 2013-03-09 22:38:52.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -11,8 +11,6 @@ # # ######################################################################### -# $Id: Makefile.nt 9547 2010-01-22 12:48:24Z doligez $ - include Makefile.common CFLAGS=-DOCAML_STDLIB_DIR='"$(LIBDIR)"' $(IFLEXDIR) @@ -22,10 +20,12 @@ DOBJS=$(OBJS:.$(O)=.$(DBGO)) instrtrace.$(DBGO) ocamlrun$(EXE): libcamlrun.$(A) prims.$(O) - $(MKEXE) -o ocamlrun$(EXE) prims.$(O) $(call SYSLIB,ws2_32) $(EXTRALIBS) libcamlrun.$(A) + $(MKEXE) -o ocamlrun$(EXE) prims.$(O) $(call SYSLIB,ws2_32) \ + $(EXTRALIBS) libcamlrun.$(A) ocamlrund$(EXE): libcamlrund.$(A) prims.$(O) main.$(O) - $(MKEXE) -o ocamlrun$(EXE) $(BYTECCDBGCOMPOPTS) prims.$(O) $(call SYSLIB,ws2_32) $(EXTRALIBS) libcamlrund.$(A) + $(MKEXE) -o ocamlrun$(EXE) $(BYTECCDBGCOMPOPTS) prims.$(O) \ + $(call SYSLIB,ws2_32) $(EXTRALIBS) libcamlrund.$(A) libcamlrun.$(A): $(OBJS) $(call MKLIB,libcamlrun.$(A),$(OBJS)) @@ -44,11 +44,13 @@ .depend.nt: .depend rm -f .depend.win32 - echo "win32.o: win32.c fail.h compatibility.h misc.h config.h \\" >> .depend.win32 - echo " ../config/m.h ../config/s.h mlvalues.h memory.h gc.h \\" >> .depend.win32 - echo " major_gc.h freelist.h minor_gc.h osdeps.h signals.h" >> .depend.win32 + echo "win32.o: win32.c fail.h compatibility.h \\" >> .depend.win32 + echo " misc.h config.h ../config/m.h ../config/s.h \\" >> .depend.win32 + echo " mlvalues.h memory.h gc.h major_gc.h \\" >> .depend.win32 + echo " freelist.h minor_gc.h osdeps.h signals.h" >> .depend.win32 cat .depend >> .depend.win32 - sed -e '/\.d\.o/q' -e 's/^\(.*\)\.o:/\1.$$(O) \1.$$(DBGO):/' .depend.win32 > .depend.nt + sed -e '/\.d\.o/q' -e 's/^\(.*\)\.o:/\1.$$(O) \1.$$(DBGO):/' \ + .depend.win32 > .depend.nt rm -f .depend.win32 include .depend.nt diff -Nru ocaml-3.12.1/byterun/alloc.c ocaml-4.01.0/byterun/alloc.c --- ocaml-3.12.1/byterun/alloc.c 2007-02-09 13:31:15.000000000 +0000 +++ ocaml-4.01.0/byterun/alloc.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: alloc.c 7849 2007-02-09 13:31:15Z doligez $ */ - /* 1. Allocation functions doing the same work as the macros in the case where [Setup_for_gc] and [Restore_after_gc] are no-ops. 2. Convenience functions related to allocation. diff -Nru ocaml-3.12.1/byterun/alloc.h ocaml-4.01.0/byterun/alloc.h --- ocaml-3.12.1/byterun/alloc.h 2005-09-22 14:21:50.000000000 +0000 +++ ocaml-4.01.0/byterun/alloc.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: alloc.h 7064 2005-09-22 14:21:50Z xleroy $ */ - #ifndef CAML_ALLOC_H #define CAML_ALLOC_H @@ -23,6 +21,10 @@ #include "misc.h" #include "mlvalues.h" +#ifdef __cplusplus +extern "C" { +#endif + CAMLextern value caml_alloc (mlsize_t, tag_t); CAMLextern value caml_alloc_small (mlsize_t, tag_t); CAMLextern value caml_alloc_tuple (mlsize_t); @@ -44,4 +46,8 @@ CAMLextern int caml_convert_flag_list (value, int *); +#ifdef __cplusplus +} +#endif + #endif /* CAML_ALLOC_H */ diff -Nru ocaml-3.12.1/byterun/array.c ocaml-4.01.0/byterun/array.c --- ocaml-3.12.1/byterun/array.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/array.c 2012-12-06 15:39:30.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,16 +11,28 @@ /* */ /***********************************************************************/ -/* $Id: array.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* Operations on arrays */ +#include #include "alloc.h" #include "fail.h" #include "memory.h" #include "misc.h" #include "mlvalues.h" +CAMLexport mlsize_t caml_array_length(value array) +{ + if (Tag_val(array) == Double_array_tag) + return Wosize_val(array) / Double_wosize; + else + return Wosize_val(array); +} + +CAMLexport int caml_is_double_array(value array) +{ + return (Tag_val(array) == Double_array_tag); +} + CAMLprim value caml_array_get_addr(value array, value index) { intnat idx = Long_val(index); @@ -191,3 +203,182 @@ } } } + +/* Blitting */ + +CAMLprim value caml_array_blit(value a1, value ofs1, value a2, value ofs2, + value n) +{ + value * src, * dst; + intnat count; + + if (Tag_val(a2) == Double_array_tag) { + /* Arrays of floats. The values being copied are floats, not + pointer, so we can do a direct copy. memmove takes care of + potential overlap between the copied areas. */ + memmove((double *)a2 + Long_val(ofs2), + (double *)a1 + Long_val(ofs1), + Long_val(n) * sizeof(double)); + return Val_unit; + } + if (Is_young(a2)) { + /* Arrays of values, destination is in young generation. + Here too we can do a direct copy since this cannot create + old-to-young pointers, nor mess up with the incremental major GC. + Again, memmove takes care of overlap. */ + memmove(&Field(a2, Long_val(ofs2)), + &Field(a1, Long_val(ofs1)), + Long_val(n) * sizeof(value)); + return Val_unit; + } + /* Array of values, destination is in old generation. + We must use caml_modify. */ + count = Long_val(n); + if (a1 == a2 && Long_val(ofs1) < Long_val(ofs2)) { + /* Copy in descending order */ + for (dst = &Field(a2, Long_val(ofs2) + count - 1), + src = &Field(a1, Long_val(ofs1) + count - 1); + count > 0; + count--, src--, dst--) { + caml_modify(dst, *src); + } + } else { + /* Copy in ascending order */ + for (dst = &Field(a2, Long_val(ofs2)), src = &Field(a1, Long_val(ofs1)); + count > 0; + count--, src++, dst++) { + caml_modify(dst, *src); + } + } + /* Many caml_modify in a row can create a lot of old-to-young refs. + Give the minor GC a chance to run if it needs to. */ + caml_check_urgent_gc(Val_unit); + return Val_unit; +} + +/* A generic function for extraction and concatenation of sub-arrays */ + +static value caml_array_gather(intnat num_arrays, + value arrays[/*num_arrays*/], + intnat offsets[/*num_arrays*/], + intnat lengths[/*num_arrays*/]) +{ + CAMLparamN(arrays, num_arrays); + value res; /* no need to register it as a root */ + int isfloat; + mlsize_t i, size, wsize, count, pos; + value * src; + + /* Determine total size and whether result array is an array of floats */ + size = 0; + isfloat = 0; + for (i = 0; i < num_arrays; i++) { + size += lengths[i]; + if (Tag_val(arrays[i]) == Double_array_tag) isfloat = 1; + } + if (size == 0) { + /* If total size = 0, just return empty array */ + res = Atom(0); + } + else if (isfloat) { + /* This is an array of floats. We can use memcpy directly. */ + wsize = size * Double_wosize; + if (wsize > Max_wosize) caml_invalid_argument("Array.concat"); + res = caml_alloc(wsize, Double_array_tag); + for (i = 0, pos = 0; i < num_arrays; i++) { + memcpy((double *)res + pos, + (double *)arrays[i] + offsets[i], + lengths[i] * sizeof(double)); + pos += lengths[i]; + } + Assert(pos == size); + } + else if (size > Max_wosize) { + /* Array of values, too big. */ + caml_invalid_argument("Array.concat"); + } + else if (size < Max_young_wosize) { + /* Array of values, small enough to fit in young generation. + We can use memcpy directly. */ + res = caml_alloc_small(size, 0); + for (i = 0, pos = 0; i < num_arrays; i++) { + memcpy(&Field(res, pos), + &Field(arrays[i], offsets[i]), + lengths[i] * sizeof(value)); + pos += lengths[i]; + } + Assert(pos == size); + } else { + /* Array of values, must be allocated in old generation and filled + using caml_initialize. */ + res = caml_alloc_shr(size, 0); + pos = 0; + for (i = 0, pos = 0; i < num_arrays; i++) { + for (src = &Field(arrays[i], offsets[i]), count = lengths[i]; + count > 0; + count--, src++, pos++) { + caml_initialize(&Field(res, pos), *src); + } + } + Assert(pos == size); + + /* Many caml_initialize in a row can create a lot of old-to-young + refs. Give the minor GC a chance to run if it needs to. */ + res = caml_check_urgent_gc(res); + } + CAMLreturn (res); +} + +CAMLprim value caml_array_sub(value a, value ofs, value len) +{ + value arrays[1] = { a }; + intnat offsets[1] = { Long_val(ofs) }; + intnat lengths[1] = { Long_val(len) }; + return caml_array_gather(1, arrays, offsets, lengths); +} + +CAMLprim value caml_array_append(value a1, value a2) +{ + value arrays[2] = { a1, a2 }; + intnat offsets[2] = { 0, 0 }; + intnat lengths[2] = { caml_array_length(a1), caml_array_length(a2) }; + return caml_array_gather(2, arrays, offsets, lengths); +} + +CAMLprim value caml_array_concat(value al) +{ +#define STATIC_SIZE 16 + value static_arrays[STATIC_SIZE], * arrays; + intnat static_offsets[STATIC_SIZE], * offsets; + intnat static_lengths[STATIC_SIZE], * lengths; + intnat n, i; + value l, res; + + /* Length of list = number of arrays */ + for (n = 0, l = al; l != Val_int(0); l = Field(l, 1)) n++; + /* Allocate extra storage if too many arrays */ + if (n <= STATIC_SIZE) { + arrays = static_arrays; + offsets = static_offsets; + lengths = static_lengths; + } else { + arrays = caml_stat_alloc(n * sizeof(value)); + offsets = caml_stat_alloc(n * sizeof(intnat)); + lengths = caml_stat_alloc(n * sizeof(value)); + } + /* Build the parameters to caml_array_gather */ + for (i = 0, l = al; l != Val_int(0); l = Field(l, 1), i++) { + arrays[i] = Field(l, 0); + offsets[i] = 0; + lengths[i] = caml_array_length(Field(l, 0)); + } + /* Do the concatenation */ + res = caml_array_gather(n, arrays, offsets, lengths); + /* Free the extra storage if needed */ + if (n > STATIC_SIZE) { + caml_stat_free(arrays); + caml_stat_free(offsets); + caml_stat_free(lengths); + } + return res; +} diff -Nru ocaml-3.12.1/byterun/backtrace.c ocaml-4.01.0/byterun/backtrace.c --- ocaml-3.12.1/byterun/backtrace.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/backtrace.c 2013-08-02 13:54:22.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,17 +11,18 @@ /* */ /***********************************************************************/ -/* $Id: backtrace.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* Stack backtrace for uncaught exceptions */ +#include #include #include -#include +#include + #include "config.h" #ifdef HAS_UNISTD #include #endif + #include "mlvalues.h" #include "alloc.h" #include "io.h" @@ -106,6 +107,7 @@ } if (caml_backtrace_pos >= BACKTRACE_BUFFER_SIZE) return; if (pc >= caml_start_code && pc < end_code){ + /* testing the code region is needed: PR#1554 */ caml_backtrace_buffer[caml_backtrace_pos++] = pc; } for (/*nothing*/; sp < caml_trapsp; sp++) { @@ -117,14 +119,83 @@ } } +/* returns the next frame pointer (or NULL if none is available); + updates *sp to point to the following one, and *trapsp to the next + trap frame, which we will skip when we reach it */ + +code_t caml_next_frame_pointer(value ** sp, value ** trapsp) +{ + code_t end_code = (code_t) ((char *) caml_start_code + caml_code_size); + + while (*sp < caml_stack_high) { + code_t *p = (code_t*) (*sp)++; + if(&Trap_pc(*trapsp) == p) { + *trapsp = Trap_link(*trapsp); + continue; + } + if (*p >= caml_start_code && *p < end_code) return *p; + } + return NULL; +} + +/* Stores upto [max_frames_value] frames of the current call stack to + return to the user. This is used not in an exception-raising + context, but only when the user requests to save the trace + (hopefully less often). Instead of using a bounded buffer as + [caml_stash_backtrace], we first traverse the stack to compute the + right size, then allocate space for the trace. */ + +CAMLprim value caml_get_current_callstack(value max_frames_value) { + CAMLparam1(max_frames_value); + CAMLlocal1(trace); + + /* we use `intnat` here because, were it only `int`, passing `max_int` + from the OCaml side would overflow on 64bits machines. */ + intnat max_frames = Long_val(max_frames_value); + intnat trace_size; + + /* first compute the size of the trace */ + { + value * sp = caml_extern_sp; + value * trapsp = caml_trapsp; + + for (trace_size = 0; trace_size < max_frames; trace_size++) { + code_t p = caml_next_frame_pointer(&sp, &trapsp); + if (p == NULL) break; + } + } + + trace = caml_alloc(trace_size, Abstract_tag); + + /* then collect the trace */ + { + value * sp = caml_extern_sp; + value * trapsp = caml_trapsp; + uintnat trace_pos; + + for (trace_pos = 0; trace_pos < trace_size; trace_pos++) { + code_t p = caml_next_frame_pointer(&sp, &trapsp); + Assert(p != NULL); + /* The assignment below is safe without [caml_initialize], even + if the trace is large and allocated on the old heap, because + we assign values that are outside the OCaml heap. */ + Assert(!(Is_block((value) p) && Is_in_heap((value) p))); + Field(trace, trace_pos) = (value) p; + } + } + + CAMLreturn(trace); +} + /* Read the debugging info contained in the current bytecode executable. - Return a Caml array of Caml lists of debug_event records in "events", + Return an OCaml array of OCaml lists of debug_event records in "events", or Val_false on failure. */ #ifndef O_BINARY #define O_BINARY 0 #endif +static char *read_debug_info_error = ""; static value read_debug_info(void) { CAMLparam0(); @@ -142,10 +213,14 @@ exec_name = caml_exe_name; } fd = caml_attempt_open(&exec_name, &trail, 1); - if (fd < 0) CAMLreturn(Val_false); + if (fd < 0){ + read_debug_info_error = "executable program file not found"; + CAMLreturn(Val_false); + } caml_read_section_descriptors(fd, &trail); if (caml_seek_optional_section(fd, &trail, "DBUG") == -1) { close(fd); + read_debug_info_error = "program not linked with -g"; CAMLreturn(Val_false); } chan = caml_open_descriptor_in(fd); @@ -224,7 +299,7 @@ - Int_val (Field (ev_start, POS_BOL)); } -/* Print location information */ +/* Print location information -- same behavior as in Printexc */ static void print_location(struct loc_info * li, int index) { @@ -264,8 +339,8 @@ events = read_debug_info(); if (events == Val_false) { - fprintf(stderr, - "(Program not linked with -g, cannot print stack backtrace)\n"); + fprintf(stderr, "(Cannot print stack backtrace: %s)\n", + read_debug_info_error); return; } for (i = 0; i < caml_backtrace_pos; i++) { @@ -274,11 +349,11 @@ } } -/* Convert the backtrace to a data structure usable from Caml */ +/* Convert the backtrace to a data structure usable from OCaml */ -CAMLprim value caml_get_exception_backtrace(value unit) +CAMLprim value caml_convert_raw_backtrace(value backtrace) { - CAMLparam0(); + CAMLparam1(backtrace); CAMLlocal5(events, res, arr, p, fname); int i; struct loc_info li; @@ -287,9 +362,9 @@ if (events == Val_false) { res = Val_int(0); /* None */ } else { - arr = caml_alloc(caml_backtrace_pos, 0); - for (i = 0; i < caml_backtrace_pos; i++) { - extract_location_info(events, caml_backtrace_buffer[i], &li); + arr = caml_alloc(Wosize_val(backtrace), 0); + for (i = 0; i < Wosize_val(backtrace); i++) { + extract_location_info(events, (code_t)Field(backtrace, i), &li); if (li.loc_valid) { fname = caml_copy_string(li.loc_filename); p = caml_alloc_small(5, 0); @@ -308,3 +383,27 @@ } CAMLreturn(res); } + +/* Get a copy of the latest backtrace */ + +CAMLprim value caml_get_exception_raw_backtrace(value unit) +{ + CAMLparam0(); + CAMLlocal1(res); + res = caml_alloc(caml_backtrace_pos, Abstract_tag); + if(caml_backtrace_buffer != NULL) + memcpy(&Field(res, 0), caml_backtrace_buffer, + caml_backtrace_pos * sizeof(code_t)); + CAMLreturn(res); +} + +/* the function below is deprecated: see asmrun/backtrace.c */ + +CAMLprim value caml_get_exception_backtrace(value unit) +{ + CAMLparam0(); + CAMLlocal2(raw, res); + raw = caml_get_exception_raw_backtrace(unit); + res = caml_convert_raw_backtrace(raw); + CAMLreturn(res); +} diff -Nru ocaml-3.12.1/byterun/backtrace.h ocaml-4.01.0/byterun/backtrace.h --- ocaml-3.12.1/byterun/backtrace.h 2010-01-20 16:26:46.000000000 +0000 +++ ocaml-4.01.0/byterun/backtrace.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: backtrace.h 9540 2010-01-20 16:26:46Z doligez $ */ - #ifndef CAML_BACKTRACE_H #define CAML_BACKTRACE_H diff -Nru ocaml-3.12.1/byterun/callback.c ocaml-4.01.0/byterun/callback.c --- ocaml-3.12.1/byterun/callback.c 2006-09-11 12:12:24.000000000 +0000 +++ ocaml-4.01.0/byterun/callback.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,9 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: callback.c 7596 2006-09-11 12:12:24Z doligez $ */ - -/* Callbacks from C to Caml */ +/* Callbacks from C to OCaml */ #include #include "callback.h" @@ -195,7 +193,7 @@ return res; } -/* Naming of Caml values */ +/* Naming of OCaml values */ struct named_value { value val; diff -Nru ocaml-3.12.1/byterun/callback.h ocaml-4.01.0/byterun/callback.h --- ocaml-3.12.1/byterun/callback.h 2006-09-11 12:12:24.000000000 +0000 +++ ocaml-4.01.0/byterun/callback.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,9 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: callback.h 7596 2006-09-11 12:12:24Z doligez $ */ - -/* Callbacks from C to Caml */ +/* Callbacks from C to OCaml */ #ifndef CAML_CALLBACK_H #define CAML_CALLBACK_H @@ -23,6 +21,10 @@ #endif #include "mlvalues.h" +#ifdef __cplusplus +extern "C" { +#endif + CAMLextern value caml_callback (value closure, value arg); CAMLextern value caml_callback2 (value closure, value arg1, value arg2); CAMLextern value caml_callback3 (value closure, value arg1, value arg2, @@ -46,4 +48,8 @@ CAMLextern int caml_callback_depth; +#ifdef __cplusplus +} +#endif + #endif diff -Nru ocaml-3.12.1/byterun/compact.c ocaml-4.01.0/byterun/compact.c --- ocaml-3.12.1/byterun/compact.c 2008-02-29 12:56:15.000000000 +0000 +++ ocaml-4.01.0/byterun/compact.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: compact.c 8822 2008-02-29 12:56:15Z doligez $ */ - #include #include "config.h" @@ -144,7 +142,7 @@ return adr; } -void caml_compact_heap (void) +static void do_compaction (void) { char *ch, *chend; Assert (caml_gc_phase == Phase_idle); @@ -331,7 +329,7 @@ word q = *p; if (Color_hd (q) == Caml_white){ size_t sz = Bhsize_hd (q); - char *newadr = compact_allocate (sz); Assert (newadr <= (char *)p); + char *newadr = compact_allocate (sz); memmove (newadr, p, sz); p += Wsize_bsize (sz); }else{ @@ -384,7 +382,8 @@ while (ch != NULL){ if (Chunk_size (ch) > Chunk_alloc (ch)){ caml_make_free_blocks ((value *) (ch + Chunk_alloc (ch)), - Wsize_bsize (Chunk_size(ch)-Chunk_alloc(ch)), 1); + Wsize_bsize (Chunk_size(ch)-Chunk_alloc(ch)), 1, + Caml_white); } ch = Chunk_next (ch); } @@ -395,6 +394,70 @@ uintnat caml_percent_max; /* used in gc_ctrl.c and memory.c */ +void caml_compact_heap (void) +{ + uintnat target_words, target_size, live; + + do_compaction (); + /* Compaction may fail to shrink the heap to a reasonable size + because it deals in complete chunks: if a very large chunk + is at the beginning of the heap, everything gets moved to + it and it is not freed. + + In that case, we allocate a new chunk of the desired heap + size, chain it at the beginning of the heap (thus pretending + its address is smaller), and launch a second compaction. + This will move all data to this new chunk and free the + very large chunk. + + See PR#5389 + */ + /* We compute: + freewords = caml_fl_cur_size (exact) + heapwords = Wsize_bsize (caml_heap_size) (exact) + live = heapwords - freewords + wanted = caml_percent_free * (live / 100 + 1) (same as in do_compaction) + target_words = live + wanted + We add one page to make sure a small difference in counting sizes + won't make [do_compaction] keep the second block (and break all sorts + of invariants). + + We recompact if target_size < heap_size / 2 + */ + live = Wsize_bsize (caml_stat_heap_size) - caml_fl_cur_size; + target_words = live + caml_percent_free * (live / 100 + 1) + + Wsize_bsize (Page_size); + target_size = caml_round_heap_chunk_size (Bsize_wsize (target_words)); + if (target_size < caml_stat_heap_size / 2){ + char *chunk; + + caml_gc_message (0x10, "Recompacting heap (target=%luk)\n", + target_size / 1024); + + chunk = caml_alloc_for_heap (target_size); + if (chunk == NULL) return; + /* PR#5757: we need to make the new blocks blue, or they won't be + recognized as free by the recompaction. */ + caml_make_free_blocks ((value *) chunk, + Wsize_bsize (Chunk_size (chunk)), 0, Caml_blue); + if (caml_page_table_add (In_heap, chunk, chunk + Chunk_size (chunk)) != 0){ + caml_free_for_heap (chunk); + return; + } + Chunk_next (chunk) = caml_heap_start; + caml_heap_start = chunk; + ++ caml_stat_heap_chunks; + caml_stat_heap_size += Chunk_size (chunk); + if (caml_stat_heap_size > caml_stat_top_heap_size){ + caml_stat_top_heap_size = caml_stat_heap_size; + } + do_compaction (); + Assert (caml_stat_heap_chunks == 1); + Assert (Chunk_next (caml_heap_start) == NULL); + Assert (caml_stat_heap_size == Chunk_size (chunk)); + } +} + void caml_compact_heap_maybe (void) { /* Estimated free words in the heap: @@ -408,7 +471,7 @@ float fw, fp; Assert (caml_gc_phase == Phase_idle); if (caml_percent_max >= 1000000) return; - if (caml_stat_major_collections < 3 || caml_stat_heap_chunks < 3) return; + if (caml_stat_major_collections < 3) return; fw = 3.0 * caml_fl_cur_size - 2.0 * caml_fl_size_at_phase_change; if (fw < 0) fw = caml_fl_cur_size; diff -Nru ocaml-3.12.1/byterun/compact.h ocaml-4.01.0/byterun/compact.h --- ocaml-3.12.1/byterun/compact.h 2003-12-31 14:20:40.000000000 +0000 +++ ocaml-4.01.0/byterun/compact.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: compact.h 6044 2003-12-31 14:20:40Z doligez $ */ - #ifndef CAML_COMPACT_H #define CAML_COMPACT_H diff -Nru ocaml-3.12.1/byterun/compare.c ocaml-4.01.0/byterun/compare.c --- ocaml-3.12.1/byterun/compare.c 2011-05-12 14:34:05.000000000 +0000 +++ ocaml-4.01.0/byterun/compare.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: compare.c 11037 2011-05-12 14:34:05Z xleroy $ */ - #include #include #include "custom.h" @@ -106,7 +104,7 @@ /* Subtraction above cannot overflow and cannot result in UNORDERED */ if (Is_in_value_area(v2)) { switch (Tag_val(v2)) { - case Forward_tag: + case Forward_tag: v2 = Forward_val(v2); continue; case Custom_tag: { diff -Nru ocaml-3.12.1/byterun/compare.h ocaml-4.01.0/byterun/compare.h --- ocaml-3.12.1/byterun/compare.h 2003-12-31 14:20:40.000000000 +0000 +++ ocaml-4.01.0/byterun/compare.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, Projet Moscova, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: compare.h 6044 2003-12-31 14:20:40Z doligez $ */ - #ifndef CAML_COMPARE_H #define CAML_COMPARE_H diff -Nru ocaml-3.12.1/byterun/compatibility.h ocaml-4.01.0/byterun/compatibility.h --- ocaml-3.12.1/byterun/compatibility.h 2008-07-28 11:59:55.000000000 +0000 +++ ocaml-4.01.0/byterun/compatibility.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Moscova, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: compatibility.h 8953 2008-07-28 11:59:55Z doligez $ */ - /* definitions for compatibility with old identifiers */ #ifndef CAML_COMPATIBILITY_H diff -Nru ocaml-3.12.1/byterun/config.h ocaml-4.01.0/byterun/config.h --- ocaml-3.12.1/byterun/config.h 2010-11-10 15:47:34.000000000 +0000 +++ ocaml-4.01.0/byterun/config.h 2013-03-22 18:22:51.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: config.h 10787 2010-11-10 15:47:34Z doligez $ */ - #ifndef CAML_CONFIG_H #define CAML_CONFIG_H @@ -96,7 +94,8 @@ /* We use threaded code interpretation if the compiler provides labels as first-class values (GCC 2.x). */ -#if defined(__GNUC__) && __GNUC__ >= 2 && !defined(DEBUG) && !defined (SHRINKED_GNUC) && !defined(CAML_JIT) +#if defined(__GNUC__) && __GNUC__ >= 2 && !defined(DEBUG) \ + && !defined (SHRINKED_GNUC) && !defined(CAML_JIT) #define THREADED_CODE #endif diff -Nru ocaml-3.12.1/byterun/custom.c ocaml-4.01.0/byterun/custom.c --- ocaml-3.12.1/byterun/custom.c 2005-09-22 14:21:50.000000000 +0000 +++ ocaml-4.01.0/byterun/custom.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Manuel Serrano and Xavier Leroy, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: custom.c 7064 2005-09-22 14:21:50Z xleroy $ */ - #include #include "alloc.h" @@ -83,6 +81,7 @@ ops->hash = custom_hash_default; ops->serialize = custom_serialize_default; ops->deserialize = custom_deserialize_default; + ops->compare_ext = custom_compare_ext_default; l = caml_stat_alloc(sizeof(struct custom_operations_list)); l->ops = ops; l->next = custom_ops_final_table; diff -Nru ocaml-3.12.1/byterun/custom.h ocaml-4.01.0/byterun/custom.h --- ocaml-3.12.1/byterun/custom.h 2011-05-12 14:34:05.000000000 +0000 +++ ocaml-4.01.0/byterun/custom.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Manuel Serrano and Xavier Leroy, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: custom.h 11037 2011-05-12 14:34:05Z xleroy $ */ - #ifndef CAML_CUSTOM_H #define CAML_CUSTOM_H @@ -43,6 +41,11 @@ #define Custom_ops_val(v) (*((struct custom_operations **) (v))) +#ifdef __cplusplus +extern "C" { +#endif + + CAMLextern value caml_alloc_custom(struct custom_operations * ops, uintnat size, /*size in bytes*/ mlsize_t mem, /*resources consumed*/ @@ -61,4 +64,8 @@ extern void caml_init_custom_operations(void); /* */ +#ifdef __cplusplus +} +#endif + #endif /* CAML_CUSTOM_H */ diff -Nru ocaml-3.12.1/byterun/debugger.c ocaml-4.01.0/byterun/debugger.c --- ocaml-3.12.1/byterun/debugger.c 2010-04-20 15:47:15.000000000 +0000 +++ ocaml-4.01.0/byterun/debugger.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: debugger.c 10287 2010-04-20 15:47:15Z doligez $ */ - /* Interface with the byte-code debugger */ #ifdef _WIN32 @@ -21,6 +19,7 @@ #include +#include "alloc.h" #include "config.h" #include "debugger.h" #include "misc.h" @@ -28,6 +27,7 @@ int caml_debugger_in_use = 0; uintnat caml_event_count; int caml_debugger_fork_mode = 1; /* parent by default */ +value marshal_flags = Val_emptylist; #if !defined(HAS_SOCKETS) || defined(NATIVE_CODE) @@ -162,6 +162,11 @@ struct hostent * host; int n; + caml_register_global_root(&marshal_flags); + marshal_flags = caml_alloc(2, Tag_cons); + Store_field(marshal_flags, 0, Val_int(1)); /* Marshal.Closures */ + Store_field(marshal_flags, 1, Val_emptylist); + address = getenv("CAML_DEBUG_SOCKET"); if (address == NULL) return; dbg_addr = address; @@ -230,7 +235,7 @@ saved_external_raise = caml_external_raise; if (sigsetjmp(raise_buf.buf, 0) == 0) { caml_external_raise = &raise_buf; - caml_output_val(chan, val, Val_unit); + caml_output_val(chan, val, marshal_flags); } else { /* Send wrong magic number, will cause [caml_input_value] to fail */ caml_really_putblock(chan, "\000\000\000\000", 4); diff -Nru ocaml-3.12.1/byterun/debugger.h ocaml-4.01.0/byterun/debugger.h --- ocaml-3.12.1/byterun/debugger.h 2010-04-20 15:47:15.000000000 +0000 +++ ocaml-4.01.0/byterun/debugger.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: debugger.h 10287 2010-04-20 15:47:15Z doligez $ */ - /* Interface with the debugger */ #ifndef CAML_DEBUGGER_H diff -Nru ocaml-3.12.1/byterun/dynlink.c ocaml-4.01.0/byterun/dynlink.c --- ocaml-3.12.1/byterun/dynlink.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/dynlink.c 2013-03-09 22:38:52.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: dynlink.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* Dynamic loading of C primitives. */ #include @@ -165,7 +163,7 @@ for (p = req_prims; *p != 0; p += strlen(p) + 1) { c_primitive prim = lookup_primitive(p); if (prim == NULL) - caml_fatal_error_arg("Fatal error: unknown C primitive `%s'\n", p); + caml_fatal_error_arg("Fatal error: unknown C primitive `%s'\n", p); caml_ext_table_add(&caml_prim_table, (void *) prim); #ifdef DEBUG caml_ext_table_add(&caml_prim_name_table, strdup(p)); @@ -184,8 +182,16 @@ { int i; caml_ext_table_init(&caml_prim_table, 0x180); - for (i = 0; caml_builtin_cprim[i] != 0; i++) +#ifdef DEBUG + caml_ext_table_init(&caml_prim_name_table, 0x180); +#endif + for (i = 0; caml_builtin_cprim[i] != 0; i++) { caml_ext_table_add(&caml_prim_table, (void *) caml_builtin_cprim[i]); +#ifdef DEBUG + caml_ext_table_add(&caml_prim_name_table, + strdup(caml_names_of_builtin_cprim[i])); +#endif +} } #endif /* NATIVE_CODE */ diff -Nru ocaml-3.12.1/byterun/dynlink.h ocaml-4.01.0/byterun/dynlink.h --- ocaml-3.12.1/byterun/dynlink.h 2004-02-22 15:07:51.000000000 +0000 +++ ocaml-4.01.0/byterun/dynlink.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: dynlink.h 6130 2004-02-22 15:07:51Z xleroy $ */ - /* Dynamic loading of C primitives. */ #ifndef CAML_DYNLINK_H diff -Nru ocaml-3.12.1/byterun/exec.h ocaml-4.01.0/byterun/exec.h --- ocaml-3.12.1/byterun/exec.h 2004-06-01 12:36:34.000000000 +0000 +++ ocaml-4.01.0/byterun/exec.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: exec.h 6359 2004-06-01 12:36:34Z xleroy $ */ - /* exec.h : format of executable bytecode files */ #ifndef CAML_EXEC_H diff -Nru ocaml-3.12.1/byterun/extern.c ocaml-4.01.0/byterun/extern.c --- ocaml-3.12.1/byterun/extern.c 2008-08-04 11:45:58.000000000 +0000 +++ ocaml-4.01.0/byterun/extern.c 2013-07-23 14:48:47.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: extern.c 8978 2008-08-04 11:45:58Z xleroy $ */ - /* Structured output */ /* The interface of this file is "intext.h" */ @@ -24,6 +22,7 @@ #include "gc.h" #include "intext.h" #include "io.h" +#include "md5.h" #include "memory.h" #include "misc.h" #include "mlvalues.h" @@ -33,8 +32,16 @@ static uintnat size_32; /* Size in words of 32-bit block for struct. */ static uintnat size_64; /* Size in words of 64-bit block for struct. */ -static int extern_ignore_sharing; /* Flag to ignore sharing */ -static int extern_closures; /* Flag to allow externing code pointers */ +/* Flags affecting marshaling */ + +enum { + NO_SHARING = 1, /* Flag to ignore sharing */ + CLOSURES = 2, /* Flag to allow marshaling code pointers */ + COMPAT_32 = 4 /* Flag to ensure that output can safely + be read back on a 32-bit platform */ +}; + +static int extern_flags; /* logical or of some of the flags above */ /* Trail mechanism to undo forwarding pointers put inside objects */ @@ -52,10 +59,62 @@ static struct trail_block * extern_trail_block; static struct trail_entry * extern_trail_cur, * extern_trail_limit; + +/* Stack for pending values to marshal */ + +struct extern_item { value * v; mlsize_t count; }; + +#define EXTERN_STACK_INIT_SIZE 256 +#define EXTERN_STACK_MAX_SIZE (1024*1024*100) + +static struct extern_item extern_stack_init[EXTERN_STACK_INIT_SIZE]; + +static struct extern_item * extern_stack = extern_stack_init; +static struct extern_item * extern_stack_limit = extern_stack_init + + EXTERN_STACK_INIT_SIZE; + /* Forward declarations */ static void extern_out_of_memory(void); static void extern_invalid_argument(char *msg); +static void extern_failwith(char *msg); +static void extern_stack_overflow(void); +static struct code_fragment * extern_find_code(char *addr); +static void extern_replay_trail(void); +static void free_extern_output(void); + +/* Free the extern stack if needed */ +static void extern_free_stack(void) +{ + if (extern_stack != extern_stack_init) { + free(extern_stack); + /* Reinitialize the globals for next time around */ + extern_stack = extern_stack_init; + extern_stack_limit = extern_stack + EXTERN_STACK_INIT_SIZE; + } +} + +static struct extern_item * extern_resize_stack(struct extern_item * sp) +{ + asize_t newsize = 2 * (extern_stack_limit - extern_stack); + asize_t sp_offset = sp - extern_stack; + struct extern_item * newstack; + + if (newsize >= EXTERN_STACK_MAX_SIZE) extern_stack_overflow(); + if (extern_stack == extern_stack_init) { + newstack = malloc(sizeof(struct extern_item) * newsize); + if (newstack == NULL) extern_stack_overflow(); + memcpy(newstack, extern_stack_init, + sizeof(struct extern_item) * EXTERN_STACK_INIT_SIZE); + } else { + newstack = + realloc(extern_stack, sizeof(struct extern_item) * newsize); + if (newstack == NULL) extern_stack_overflow(); + } + extern_stack = newstack; + extern_stack_limit = newstack + newsize; + return newstack + sp_offset; +} /* Initialize the trail */ @@ -102,7 +161,7 @@ { header_t hdr; - if (extern_ignore_sharing) return; + if (extern_flags & NO_SHARING) return; if (extern_trail_cur == extern_trail_limit) { struct trail_block * new_block = malloc(sizeof(struct trail_block)); if (new_block == NULL) extern_out_of_memory(); @@ -161,6 +220,7 @@ free(blk); } extern_output_first = NULL; + extern_free_stack(); } static void grow_extern_output(intnat required) @@ -169,8 +229,7 @@ intnat extra; if (extern_userprovided_output != NULL) { - extern_replay_trail(); - caml_failwith("Marshal.to_buffer: buffer overflow"); + extern_failwith("Marshal.to_buffer: buffer overflow"); } extern_output_block->end = extern_ptr; if (required <= SIZE_EXTERN_OUTPUT_BLOCK / 2) @@ -216,6 +275,21 @@ caml_invalid_argument(msg); } +static void extern_failwith(char *msg) +{ + extern_replay_trail(); + free_extern_output(); + caml_failwith(msg); +} + +static void extern_stack_overflow(void) +{ + caml_gc_message (0x04, "Stack overflow in marshaling value\n", 0); + extern_replay_trail(); + free_extern_output(); + caml_raise_out_of_memory(); +} + /* Write characters, integers, and blocks in the output buffer */ #define Write(c) \ @@ -289,7 +363,11 @@ static void extern_rec(value v) { - tailcall: + struct code_fragment * cf; + struct extern_item * sp; + sp = extern_stack; + + while(1) { if (Is_long(v)) { intnat n = Long_val(v); if (n >= 0 && n < 0x40) { @@ -299,12 +377,15 @@ } else if (n >= -(1 << 15) && n < (1 << 15)) { writecode16(CODE_INT16, n); #ifdef ARCH_SIXTYFOUR - } else if (n < -((intnat)1 << 31) || n >= ((intnat)1 << 31)) { + } else if (n < -((intnat)1 << 30) || n >= ((intnat)1 << 30)) { + if (extern_flags & COMPAT_32) + extern_failwith("output_value: integer cannot be read back on " + "32-bit platform"); writecode64(CODE_INT64, n); #endif } else writecode32(CODE_INT32, n); - return; + goto next_item; } if (Is_in_value_area(v)) { header_t hd = Hd_val(v); @@ -319,7 +400,7 @@ /* Do not short-circuit the pointer. */ }else{ v = f; - goto tailcall; + continue; } } /* Atoms are treated specially for two reasons: they are not allocated @@ -330,7 +411,7 @@ } else { writecode32(CODE_BLOCK32, hd); } - return; + goto next_item; } /* Check if already seen */ if (Color_hd(hd) == Caml_blue) { @@ -342,7 +423,7 @@ } else { writecode32(CODE_SHARED32, d); } - return; + goto next_item; } /* Output the contents of the object */ @@ -354,6 +435,11 @@ } else if (len < 0x100) { writecode8(CODE_STRING8, len); } else { +#ifdef ARCH_SIXTYFOUR + if (len > 0xFFFFFB && (extern_flags & COMPAT_32)) + extern_failwith("output_value: string cannot be read back on " + "32-bit platform"); +#endif writecode32(CODE_STRING32, len); } writeblock(String_val(v), len); @@ -380,6 +466,11 @@ if (nfloats < 0x100) { writecode8(CODE_DOUBLE_ARRAY8_NATIVE, nfloats); } else { +#ifdef ARCH_SIXTYFOUR + if (nfloats > 0x1FFFFF && (extern_flags & COMPAT_32)) + extern_failwith("output_value: float array cannot be read back on " + "32-bit platform"); +#endif writecode32(CODE_DOUBLE_ARRAY32_NATIVE, nfloats); } writeblock_float8((double *) v, nfloats); @@ -393,8 +484,8 @@ break; case Infix_tag: writecode32(CODE_INFIXPOINTER, Infix_offset_hd(hd)); - extern_rec(v - Infix_offset_hd(hd)); - break; + v = v - Infix_offset_hd(hd); /* PR#5772 */ + continue; case Custom_tag: { uintnat sz_32, sz_64; char * ident = Custom_ops_val(v)->identifier; @@ -413,53 +504,66 @@ } default: { value field0; - mlsize_t i; if (tag < 16 && sz < 8) { Write(PREFIX_SMALL_BLOCK + tag + (sz << 4)); #ifdef ARCH_SIXTYFOUR } else if (hd >= ((uintnat)1 << 32)) { + /* Is this case useful? The overflow check in extern_value will fail.*/ writecode64(CODE_BLOCK64, Whitehd_hd (hd)); #endif } else { +#ifdef ARCH_SIXTYFOUR + if (sz > 0x3FFFFF && (extern_flags & COMPAT_32)) + extern_failwith("output_value: array cannot be read back on " + "32-bit platform"); +#endif writecode32(CODE_BLOCK32, Whitehd_hd (hd)); } size_32 += 1 + sz; size_64 += 1 + sz; field0 = Field(v, 0); extern_record_location(v); - if (sz == 1) { - v = field0; - } else { - extern_rec(field0); - for (i = 1; i < sz - 1; i++) extern_rec(Field(v, i)); - v = Field(v, i); + /* Remember that we still have to serialize fields 1 ... sz - 1 */ + if (sz > 1) { + sp++; + if (sp >= extern_stack_limit) sp = extern_resize_stack(sp); + sp->v = &Field(v,1); + sp->count = sz-1; } - goto tailcall; + /* Continue serialization with the first field */ + v = field0; + continue; } } } - else if ((char *) v >= caml_code_area_start && - (char *) v < caml_code_area_end) { - if (!extern_closures) + else if ((cf = extern_find_code((char *) v)) != NULL) { + if ((extern_flags & CLOSURES) == 0) extern_invalid_argument("output_value: functional value"); - writecode32(CODE_CODEPOINTER, (char *) v - caml_code_area_start); - writeblock((char *) caml_code_checksum(), 16); + writecode32(CODE_CODEPOINTER, (char *) v - cf->code_start); + writeblock((char *) cf->digest, 16); } else { extern_invalid_argument("output_value: abstract value (outside heap)"); } + next_item: + /* Pop one more item to marshal, if any */ + if (sp == extern_stack) { + /* We are done. Cleanup the stack and leave the function */ + extern_free_stack(); + return; + } + v = *((sp->v)++); + if (--(sp->count) == 0) sp--; + } + /* Never reached as function leaves with return */ } -enum { NO_SHARING = 1, CLOSURES = 2 }; -static int extern_flags[] = { NO_SHARING, CLOSURES }; +static int extern_flag_values[] = { NO_SHARING, CLOSURES, COMPAT_32 }; static intnat extern_value(value v, value flags) { intnat res_len; - int fl; /* Parse flag list */ - fl = caml_convert_flag_list(flags, extern_flags); - extern_ignore_sharing = fl & NO_SHARING; - extern_closures = fl & CLOSURES; + extern_flags = caml_convert_flag_list(flags, extern_flag_values); /* Initializations */ init_extern_trail(); obj_counter = 0; @@ -502,13 +606,12 @@ void caml_output_val(struct channel *chan, value v, value flags) { - intnat len; struct output_block * blk, * nextblk; if (! caml_channel_binary_mode(chan)) caml_failwith("output_value: not a binary channel"); init_extern_output(); - len = extern_value(v, flags); + extern_value(v, flags); /* During [caml_really_putblock], concurrent [caml_output_val] operations can take place (via signal handlers or context switching in systhreads), and [extern_output_first] may change. So, save it in a local variable. */ @@ -724,3 +827,19 @@ } #endif } + +/* Find where a code pointer comes from */ + +static struct code_fragment * extern_find_code(char *addr) +{ + int i; + for (i = caml_code_fragments_table.size - 1; i >= 0; i--) { + struct code_fragment * cf = caml_code_fragments_table.contents[i]; + if (! cf->digest_computed) { + caml_md5_block(cf->digest, cf->code_start, cf->code_end - cf->code_start); + cf->digest_computed = 1; + } + if (cf->code_start <= addr && addr < cf->code_end) return cf; + } + return NULL; +} diff -Nru ocaml-3.12.1/byterun/fail.c ocaml-4.01.0/byterun/fail.c --- ocaml-3.12.1/byterun/fail.c 2010-11-11 11:07:48.000000000 +0000 +++ ocaml-4.01.0/byterun/fail.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: fail.c 10793 2010-11-11 11:07:48Z xleroy $ */ - /* Raising exceptions from C. */ #include @@ -168,3 +166,9 @@ out_of_memory_bucket.exn = Field(caml_global_data, OUT_OF_MEMORY_EXN); caml_register_global_root(&out_of_memory_bucket.exn); } + +int caml_is_special_exception(value exn) { + return exn == Field(caml_global_data, MATCH_FAILURE_EXN) + || exn == Field(caml_global_data, ASSERT_FAILURE_EXN) + || exn == Field(caml_global_data, UNDEFINED_RECURSIVE_MODULE_EXN); +} diff -Nru ocaml-3.12.1/byterun/fail.h ocaml-4.01.0/byterun/fail.h --- ocaml-3.12.1/byterun/fail.h 2008-09-18 11:23:28.000000000 +0000 +++ ocaml-4.01.0/byterun/fail.h 2013-03-09 22:38:52.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: fail.h 9030 2008-09-18 11:23:28Z xleroy $ */ - #ifndef CAML_FAIL_H #define CAML_FAIL_H @@ -54,13 +52,19 @@ CAMLextern struct longjmp_buffer * caml_external_raise; extern value caml_exn_bucket; +int caml_is_special_exception(value exn); /* */ +#ifdef __cplusplus +extern "C" { +#endif + CAMLextern void caml_raise (value bucket) Noreturn; CAMLextern void caml_raise_constant (value tag) Noreturn; CAMLextern void caml_raise_with_arg (value tag, value arg) Noreturn; -CAMLextern void caml_raise_with_args (value tag, int nargs, value arg[]) Noreturn; +CAMLextern void caml_raise_with_args (value tag, int nargs, value arg[]) + Noreturn; CAMLextern void caml_raise_with_string (value tag, char const * msg) Noreturn; CAMLextern void caml_failwith (char const *) Noreturn; CAMLextern void caml_invalid_argument (char const *) Noreturn; @@ -74,4 +78,8 @@ CAMLextern void caml_array_bound_error (void) Noreturn; CAMLextern void caml_raise_sys_blocked_io (void) Noreturn; +#ifdef __cplusplus +} +#endif + #endif /* CAML_FAIL_H */ diff -Nru ocaml-3.12.1/byterun/finalise.c ocaml-4.01.0/byterun/finalise.c --- ocaml-3.12.1/byterun/finalise.c 2010-05-12 14:32:23.000000000 +0000 +++ ocaml-4.01.0/byterun/finalise.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Moscova, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: finalise.c 10393 2010-05-12 14:32:23Z doligez $ */ - /* Handling of finalised values. */ #include "callback.h" diff -Nru ocaml-3.12.1/byterun/finalise.h ocaml-4.01.0/byterun/finalise.h --- ocaml-3.12.1/byterun/finalise.h 2004-01-02 19:23:29.000000000 +0000 +++ ocaml-4.01.0/byterun/finalise.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Moscova, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: finalise.h 6047 2004-01-02 19:23:29Z doligez $ */ - #ifndef CAML_FINALISE_H #define CAML_FINALISE_H diff -Nru ocaml-3.12.1/byterun/fix_code.c ocaml-4.01.0/byterun/fix_code.c --- ocaml-3.12.1/byterun/fix_code.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/fix_code.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: fix_code.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* Handling of blocks of bytecode (endianness switch, threading). */ #include "config.h" @@ -24,6 +22,7 @@ #include "debugger.h" #include "fix_code.h" #include "instruct.h" +#include "intext.h" #include "md5.h" #include "memory.h" #include "misc.h" @@ -33,22 +32,31 @@ code_t caml_start_code; asize_t caml_code_size; unsigned char * caml_saved_code; -unsigned char caml_code_md5[16]; /* Read the main bytecode block from a file */ +void caml_init_code_fragments() { + struct code_fragment * cf; + /* Register the code in the table of code fragments */ + cf = caml_stat_alloc(sizeof(struct code_fragment)); + cf->code_start = (char *) caml_start_code; + cf->code_end = (char *) caml_start_code + caml_code_size; + caml_md5_block(cf->digest, caml_start_code, caml_code_size); + cf->digest_computed = 1; + caml_ext_table_init(&caml_code_fragments_table, 8); + caml_ext_table_add(&caml_code_fragments_table, cf); +} + void caml_load_code(int fd, asize_t len) { int i; - struct MD5Context ctx; caml_code_size = len; caml_start_code = (code_t) caml_stat_alloc(caml_code_size); if (read(fd, (char *) caml_start_code, caml_code_size) != caml_code_size) caml_fatal_error("Fatal error: truncated bytecode file.\n"); - caml_MD5Init(&ctx); - caml_MD5Update(&ctx, (unsigned char *) caml_start_code, caml_code_size); - caml_MD5Final(caml_code_md5, &ctx); + caml_init_code_fragments(); + /* Prepare the code for execution */ #ifdef ARCH_BIG_ENDIAN caml_fixup_endianness(caml_start_code, caml_code_size); #endif diff -Nru ocaml-3.12.1/byterun/fix_code.h ocaml-4.01.0/byterun/fix_code.h --- ocaml-3.12.1/byterun/fix_code.h 2004-01-02 19:23:29.000000000 +0000 +++ ocaml-4.01.0/byterun/fix_code.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: fix_code.h 6047 2004-01-02 19:23:29Z doligez $ */ - /* Handling of blocks of bytecode (endianness switch, threading). */ #ifndef CAML_FIX_CODE_H @@ -26,8 +24,8 @@ extern code_t caml_start_code; extern asize_t caml_code_size; extern unsigned char * caml_saved_code; -extern unsigned char caml_code_md5[16]; +void caml_init_code_fragments(); void caml_load_code (int fd, asize_t len); void caml_fixup_endianness (code_t code, asize_t len); void caml_set_instruction (code_t pos, opcode_t instr); diff -Nru ocaml-3.12.1/byterun/floats.c ocaml-4.01.0/byterun/floats.c --- ocaml-3.12.1/byterun/floats.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/floats.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: floats.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* The interface of this file is in "mlvalues.h" and "alloc.h" */ #include @@ -28,6 +26,12 @@ #include "reverse.h" #include "stacks.h" +#ifdef _MSC_VER +#include +#define isnan _isnan +#define isfinite _finite +#endif + #ifdef ARCH_ALIGN_DOUBLE CAMLexport double caml_Double_val(value val) @@ -77,7 +81,11 @@ char * p; char * dest; value res; + double d = Double_val(arg); +#ifdef HAS_BROKEN_PRINTF + if (isfinite(d)) { +#endif prec = MAX_DIGITS; for (p = String_val(fmt); *p != 0; p++) { if (*p >= '0' && *p <= '9') { @@ -98,11 +106,30 @@ } else { dest = caml_stat_alloc(prec); } - sprintf(dest, String_val(fmt), Double_val(arg)); + sprintf(dest, String_val(fmt), d); res = caml_copy_string(dest); if (dest != format_buffer) { caml_stat_free(dest); } +#ifdef HAS_BROKEN_PRINTF + } else { + if (isnan(d)) + { + res = caml_copy_string("nan"); + } + else + { + if (d > 0) + { + res = caml_copy_string("inf"); + } + else + { + res = caml_copy_string("-inf"); + } + } + } +#endif return res; } @@ -326,12 +353,32 @@ return caml_copy_double(ceil(Double_val(f))); } +CAMLexport double caml_hypot(double x, double y) +{ +#ifdef HAS_C99_FLOAT_OPS + return hypot(x, y); +#else + double tmp, ratio; + if (x != x) return x; /* NaN */ + if (y != y) return y; /* NaN */ + x = fabs(x); y = fabs(y); + if (x < y) { tmp = x; x = y; y = tmp; } + if (x == 0.0) return 0.0; + ratio = y / x; + return x * sqrt(1.0 + ratio * ratio); +#endif +} + +CAMLprim value caml_hypot_float(value f, value g) +{ + return caml_copy_double(caml_hypot(Double_val(f), Double_val(g))); +} + /* These emulations of expm1() and log1p() are due to William Kahan. See http://www.plunk.org/~hatch/rightway.php */ - CAMLexport double caml_expm1(double x) { -#ifdef HAS_EXPM1_LOG1P +#ifdef HAS_C99_FLOAT_OPS return expm1(x); #else double u = exp(x); @@ -345,7 +392,7 @@ CAMLexport double caml_log1p(double x) { -#ifdef HAS_EXPM1_LOG1P +#ifdef HAS_C99_FLOAT_OPS return log1p(x); #else double u = 1. + x; @@ -366,6 +413,34 @@ return caml_copy_double(caml_log1p(Double_val(f))); } +union double_as_two_int32 { + double d; +#if defined(ARCH_BIG_ENDIAN) || (defined(__arm__) && !defined(__ARM_EABI__)) + struct { uint32 h; uint32 l; } i; +#else + struct { uint32 l; uint32 h; } i; +#endif +}; + +CAMLexport double caml_copysign(double x, double y) +{ +#ifdef HAS_C99_FLOAT_OPS + return copysign(x, y); +#else + union double_as_two_int32 ux, uy; + ux.d = x; + uy.d = y; + ux.i.h &= 0x7FFFFFFFU; + ux.i.h |= (uy.i.h & 0x80000000U); + return ux.d; +#endif +} + +CAMLprim value caml_copysign_float(value f, value g) +{ + return caml_copy_double(caml_copysign(Double_val(f), Double_val(g))); +} + CAMLprim value caml_eq_float(value f, value g) { return Val_bool(Double_val(f) == Double_val(g)); @@ -429,14 +504,7 @@ return Val_int(FP_normal); } #else - union { - double d; -#if defined(ARCH_BIG_ENDIAN) || (defined(__arm__) && !defined(__ARM_EABI__)) - struct { uint32 h; uint32 l; } i; -#else - struct { uint32 l; uint32 h; } i; -#endif - } u; + union double_as_two_int32 u; uint32 h, l; u.d = Double_val(vd); diff -Nru ocaml-3.12.1/byterun/freelist.c ocaml-4.01.0/byterun/freelist.c --- ocaml-3.12.1/byterun/freelist.c 2008-12-03 18:09:09.000000000 +0000 +++ ocaml-4.01.0/byterun/freelist.c 2013-03-09 22:38:52.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: freelist.c 9153 2008-12-03 18:09:09Z doligez $ */ - #define FREELIST_DEBUG 0 #if FREELIST_DEBUG #include @@ -196,7 +194,8 @@ #if FREELIST_DEBUG if (i > 5) fprintf (stderr, "FLP: found at %d size=%d\n", i, wo_sz); #endif - result = allocate_block (Whsize_wosize (wo_sz), i, flp[i], Next(flp[i])); + result = allocate_block (Whsize_wosize (wo_sz), i, flp[i], + Next (flp[i])); goto update_flp; } } @@ -509,8 +508,11 @@ p: pointer to the first word of the block size: size of the block (in words) do_merge: 1 -> do merge; 0 -> do not merge + color: which color to give to the pieces; if [do_merge] is 1, this + is overridden by the merge code, but we have historically used + [Caml_white]. */ -void caml_make_free_blocks (value *p, mlsize_t size, int do_merge) +void caml_make_free_blocks (value *p, mlsize_t size, int do_merge, int color) { mlsize_t sz; @@ -520,7 +522,7 @@ }else{ sz = size; } - *(header_t *)p = Make_header (Wosize_whsize (sz), 0, Caml_white); + *(header_t *)p = Make_header (Wosize_whsize (sz), 0, color); if (do_merge) caml_fl_merge_block (Bp_hp (p)); size -= sz; p += sz; @@ -532,14 +534,14 @@ switch (p){ case Policy_next_fit: fl_prev = Fl_head; + policy = p; break; case Policy_first_fit: flp_size = 0; beyond = NULL; + policy = p; break; default: - Assert (0); break; } - policy = p; } diff -Nru ocaml-3.12.1/byterun/freelist.h ocaml-4.01.0/byterun/freelist.h --- ocaml-3.12.1/byterun/freelist.h 2008-12-03 18:09:09.000000000 +0000 +++ ocaml-4.01.0/byterun/freelist.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: freelist.h 9153 2008-12-03 18:09:09Z doligez $ */ - /* Free lists of heap blocks. */ #ifndef CAML_FREELIST_H @@ -29,7 +27,7 @@ void caml_fl_reset (void); char *caml_fl_merge_block (char *); void caml_fl_add_blocks (char *); -void caml_make_free_blocks (value *, mlsize_t, int); +void caml_make_free_blocks (value *, mlsize_t, int, int); void caml_set_allocation_policy (uintnat); diff -Nru ocaml-3.12.1/byterun/gc.h ocaml-4.01.0/byterun/gc.h --- ocaml-3.12.1/byterun/gc.h 2004-07-19 13:20:06.000000000 +0000 +++ ocaml-4.01.0/byterun/gc.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: gc.h 6557 2004-07-19 13:20:06Z xleroy $ */ - #ifndef CAML_GC_H #define CAML_GC_H diff -Nru ocaml-3.12.1/byterun/gc_ctrl.c ocaml-4.01.0/byterun/gc_ctrl.c --- ocaml-3.12.1/byterun/gc_ctrl.c 2010-11-10 15:46:16.000000000 +0000 +++ ocaml-4.01.0/byterun/gc_ctrl.c 2013-07-17 11:50:53.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: gc_ctrl.c 10786 2010-11-10 15:46:16Z doligez $ */ - #include "alloc.h" #include "compact.h" #include "custom.h" @@ -129,17 +127,22 @@ free_words = 0, free_blocks = 0, largest_free = 0, fragments = 0, heap_chunks = 0; char *chunk = caml_heap_start, *chunk_end; - char *cur_hp, *prev_hp; + char *cur_hp; +#ifdef DEBUG + char *prev_hp; +#endif header_t cur_hd; #ifdef DEBUG - caml_gc_message (-1, "### O'Caml runtime: heap check ###\n", 0); + caml_gc_message (-1, "### OCaml runtime: heap check ###\n", 0); #endif while (chunk != NULL){ ++ heap_chunks; chunk_end = chunk + Chunk_size (chunk); +#ifdef DEBUG prev_hp = NULL; +#endif cur_hp = chunk; while (cur_hp < chunk_end){ cur_hd = Hd_hp (cur_hp); @@ -194,7 +197,9 @@ */ break; } +#ifdef DEBUG prev_hp = cur_hp; +#endif cur_hp = Next (cur_hp); } Assert (cur_hp == chunk_end); chunk = Chunk_next (chunk); @@ -356,21 +361,12 @@ return s; } -static intnat norm_policy (intnat p) -{ - if (p >= 0 && p <= 1){ - return p; - }else{ - return 1; - } -} - CAMLprim value caml_gc_set(value v) { uintnat newpf, newpm; asize_t newheapincr; asize_t newminsize; - uintnat newpolicy; + uintnat oldpolicy; caml_verb_gc = Long_val (Field (v, 3)); @@ -396,15 +392,16 @@ caml_gc_message (0x20, "New heap increment size: %luk bytes\n", caml_major_heap_increment/1024); } - newpolicy = norm_policy (Long_val (Field (v, 6))); - if (newpolicy != caml_allocation_policy){ - caml_gc_message (0x20, "New allocation policy: %d\n", newpolicy); - caml_set_allocation_policy (newpolicy); + oldpolicy = caml_allocation_policy; + caml_set_allocation_policy (Long_val (Field (v, 6))); + if (oldpolicy != caml_allocation_policy){ + caml_gc_message (0x20, "New allocation policy: %d\n", + caml_allocation_policy); } /* Minor heap size comes last because it will trigger a minor collection (thus invalidating [v]) and it can raise [Out_of_memory]. */ - newminsize = norm_minsize (Bsize_wsize (Long_val (Field (v, 0)))); + newminsize = Bsize_wsize (norm_minsize (Long_val (Field (v, 0)))); if (newminsize != caml_minor_heap_size){ caml_gc_message (0x20, "New minor heap size: %luk bytes\n", newminsize/1024); diff -Nru ocaml-3.12.1/byterun/gc_ctrl.h ocaml-4.01.0/byterun/gc_ctrl.h --- ocaml-3.12.1/byterun/gc_ctrl.h 2005-09-22 14:21:50.000000000 +0000 +++ ocaml-4.01.0/byterun/gc_ctrl.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: gc_ctrl.h 7064 2005-09-22 14:21:50Z xleroy $ */ - #ifndef CAML_GC_CTRL_H #define CAML_GC_CTRL_H diff -Nru ocaml-3.12.1/byterun/globroots.c ocaml-4.01.0/byterun/globroots.c --- ocaml-3.12.1/byterun/globroots.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/globroots.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: globroots.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* Registration of global memory roots */ #include "memory.h" diff -Nru ocaml-3.12.1/byterun/globroots.h ocaml-4.01.0/byterun/globroots.h --- ocaml-3.12.1/byterun/globroots.h 2008-03-10 19:56:39.000000000 +0000 +++ ocaml-4.01.0/byterun/globroots.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: globroots.h 8828 2008-03-10 19:56:39Z xleroy $ */ - /* Registration of global memory roots */ #ifndef CAML_GLOBROOTS_H diff -Nru ocaml-3.12.1/byterun/hash.c ocaml-4.01.0/byterun/hash.c --- ocaml-3.12.1/byterun/hash.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/hash.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,15 +11,269 @@ /* */ /***********************************************************************/ -/* $Id: hash.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* The generic hashing primitive */ -/* The interface of this file is in "mlvalues.h" */ +/* The interface of this file is in "mlvalues.h" (for [caml_hash_variant]) + and in "hash.h" (for the other exported functions). */ #include "mlvalues.h" #include "custom.h" #include "memory.h" +#include "hash.h" + +#ifdef ARCH_INT64_TYPE +#include "int64_native.h" +#else +#include "int64_emul.h" +#endif + +/* The new implementation, based on MurmurHash 3, + http://code.google.com/p/smhasher/ */ + +#define ROTL32(x,n) ((x) << n | (x) >> (32-n)) + +#define MIX(h,d) \ + d *= 0xcc9e2d51; \ + d = ROTL32(d, 15); \ + d *= 0x1b873593; \ + h ^= d; \ + h = ROTL32(h, 13); \ + h = h * 5 + 0xe6546b64; + +#define FINAL_MIX(h) \ + h ^= h >> 16; \ + h *= 0x85ebca6b; \ + h ^= h >> 13; \ + h *= 0xc2b2ae35; \ + h ^= h >> 16; + +CAMLexport uint32 caml_hash_mix_uint32(uint32 h, uint32 d) +{ + MIX(h, d); + return h; +} + +/* Mix a platform-native integer. */ + +CAMLexport uint32 caml_hash_mix_intnat(uint32 h, intnat d) +{ + uint32 n; +#ifdef ARCH_SIXTYFOUR + /* Mix the low 32 bits and the high 32 bits, in a way that preserves + 32/64 compatibility: we want n = (uint32) d + if d is in the range [-2^31, 2^31-1]. */ + n = (d >> 32) ^ (d >> 63) ^ d; + /* If 0 <= d < 2^31: d >> 32 = 0 d >> 63 = 0 + If -2^31 <= d < 0: d >> 32 = -1 d >> 63 = -1 + In both cases, n = (uint32) d. */ +#else + n = d; +#endif + MIX(h, n); + return h; +} + +/* Mix a 64-bit integer. */ + +CAMLexport uint32 caml_hash_mix_int64(uint32 h, int64 d) +{ + uint32 hi, lo; + + I64_split(d, hi, lo); + MIX(h, lo); + MIX(h, hi); + return h; +} + +/* Mix a double-precision float. + Treats +0.0 and -0.0 identically. + Treats all NaNs identically. +*/ + +CAMLexport uint32 caml_hash_mix_double(uint32 hash, double d) +{ + union { + double d; +#if defined(ARCH_BIG_ENDIAN) || (defined(__arm__) && !defined(__ARM_EABI__)) + struct { uint32 h; uint32 l; } i; +#else + struct { uint32 l; uint32 h; } i; +#endif + } u; + uint32 h, l; + /* Convert to two 32-bit halves */ + u.d = d; + h = u.i.h; l = u.i.l; + /* Normalize NaNs */ + if ((h & 0x7FF00000) == 0x7FF00000 && (l | (h & 0xFFFFF)) != 0) { + h = 0x7FF00000; + l = 0x00000001; + } + /* Normalize -0 into +0 */ + else if (h == 0x80000000 && l == 0) { + h = 0; + } + MIX(hash, l); + MIX(hash, h); + return hash; +} + +/* Mix a single-precision float. + Treats +0.0 and -0.0 identically. + Treats all NaNs identically. +*/ + +CAMLexport uint32 caml_hash_mix_float(uint32 hash, float d) +{ + union { + float f; + uint32 i; + } u; + uint32 n; + /* Convert to int32 */ + u.f = d; n = u.i; + /* Normalize NaNs */ + if ((n & 0x7F800000) == 0x7F800000 && (n & 0x007FFFFF) != 0) { + n = 0x7F800001; + } + /* Normalize -0 into +0 */ + else if (n == 0x80000000) { + n = 0; + } + MIX(hash, n); + return hash; +} + +/* Mix an OCaml string */ + +CAMLexport uint32 caml_hash_mix_string(uint32 h, value s) +{ + mlsize_t len = caml_string_length(s); + mlsize_t i; + uint32 w; + + /* Mix by 32-bit blocks (little-endian) */ + for (i = 0; i + 4 <= len; i += 4) { +#ifdef ARCH_BIG_ENDIAN + w = Byte_u(s, i) + | (Byte_u(s, i+1) << 8) + | (Byte_u(s, i+2) << 16) + | (Byte_u(s, i+3) << 24); +#else + w = *((uint32 *) &Byte_u(s, i)); +#endif + MIX(h, w); + } + /* Finish with up to 3 bytes */ + w = 0; + switch (len & 3) { + case 3: w = Byte_u(s, i+2) << 16; /* fallthrough */ + case 2: w |= Byte_u(s, i+1) << 8; /* fallthrough */ + case 1: w |= Byte_u(s, i); + MIX(h, w); + default: /*skip*/; /* len & 3 == 0, no extra bytes, do nothing */ + } + /* Finally, mix in the length. Ignore the upper 32 bits, generally 0. */ + h ^= (uint32) len; + return h; +} + +/* Maximal size of the queue used for breadth-first traversal. */ +#define HASH_QUEUE_SIZE 256 + +/* The generic hash function */ + +CAMLprim value caml_hash(value count, value limit, value seed, value obj) +{ + value queue[HASH_QUEUE_SIZE]; /* Queue of values to examine */ + intnat rd; /* Position of first value in queue */ + intnat wr; /* One past position of last value in queue */ + intnat sz; /* Max number of values to put in queue */ + intnat num; /* Max number of meaningful values to see */ + uint32 h; /* Rolling hash */ + value v; + mlsize_t i, len; + + sz = Long_val(limit); + if (sz < 0 || sz > HASH_QUEUE_SIZE) sz = HASH_QUEUE_SIZE; + num = Long_val(count); + h = Int_val(seed); + queue[0] = obj; rd = 0; wr = 1; + + while (rd < wr && num > 0) { + v = queue[rd++]; + again: + if (Is_long(v)) { + h = caml_hash_mix_intnat(h, v); + num--; + } + else if (Is_in_value_area(v)) { + switch (Tag_val(v)) { + case String_tag: + h = caml_hash_mix_string(h, v); + num--; + break; + case Double_tag: + h = caml_hash_mix_double(h, Double_val(v)); + num--; + break; + case Double_array_tag: + for (i = 0, len = Wosize_val(v) / Double_wosize; i < len; i++) { + h = caml_hash_mix_double(h, Double_field(v, i)); + num--; + if (num < 0) break; + } + break; + case Abstract_tag: + /* Block contents unknown. Do nothing. */ + break; + case Infix_tag: + /* Mix in the offset to distinguish different functions from + the same mutually-recursive definition */ + h = caml_hash_mix_uint32(h, Infix_offset_val(v)); + v = v - Infix_offset_val(v); + goto again; + case Forward_tag: + v = Forward_val(v); + goto again; + case Object_tag: + h = caml_hash_mix_intnat(h, Oid_val(v)); + num--; + break; + case Custom_tag: + /* If no hashing function provided, do nothing. */ + /* Only use low 32 bits of custom hash, for 32/64 compatibility */ + if (Custom_ops_val(v)->hash != NULL) { + uint32 n = (uint32) Custom_ops_val(v)->hash(v); + h = caml_hash_mix_uint32(h, n); + num--; + } + break; + default: + /* Mix in the tag and size, but do not count this towards [num] */ + h = caml_hash_mix_uint32(h, Whitehd_hd(Hd_val(v))); + /* Copy fields into queue, not exceeding the total size [sz] */ + for (i = 0, len = Wosize_val(v); i < len; i++) { + if (wr >= sz) break; + queue[wr++] = Field(v, i); + } + break; + } + } else { + /* v is a pointer outside the heap, probably a code pointer. + Shall we count it? Let's say yes by compatibility with old code. */ + h = caml_hash_mix_intnat(h, v); + num--; + } + } + /* Final mixing of bits */ + FINAL_MIX(h); + /* Fold result to the range [0, 2^30-1] so that it is a nonnegative + OCaml integer both on 32 and 64-bit platforms. */ + return Val_int(h & 0x3FFFFFFFU); +} + +/* The old implementation */ static uintnat hash_accu; static intnat hash_univ_limit, hash_univ_count; diff -Nru ocaml-3.12.1/byterun/hash.h ocaml-4.01.0/byterun/hash.h --- ocaml-3.12.1/byterun/hash.h 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/byterun/hash.h 2012-10-15 17:50:56.000000000 +0000 @@ -0,0 +1,29 @@ +/***********************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Gallium, INRIA Rocquencourt */ +/* */ +/* Copyright 2011 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../LICENSE. */ +/* */ +/***********************************************************************/ + +/* Auxiliary functions for custom hash functions */ + +#ifndef CAML_HASH_H +#define CAML_HASH_H + +#include "mlvalues.h" + +CAMLextern uint32 caml_hash_mix_uint32(uint32 h, uint32 d); +CAMLextern uint32 caml_hash_mix_intnat(uint32 h, intnat d); +CAMLextern uint32 caml_hash_mix_int64(uint32 h, int64 d); +CAMLextern uint32 caml_hash_mix_double(uint32 h, double d); +CAMLextern uint32 caml_hash_mix_float(uint32 h, float d); +CAMLextern uint32 caml_hash_mix_string(uint32 h, value s); + + +#endif diff -Nru ocaml-3.12.1/byterun/instrtrace.c ocaml-4.01.0/byterun/instrtrace.c --- ocaml-3.12.1/byterun/instrtrace.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/instrtrace.c 2013-03-22 18:36:22.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: instrtrace.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* Trace the instructions executed */ #ifdef DEBUG @@ -184,19 +182,19 @@ if (prog && v % sizeof (int) == 0 && (code_t) v >= prog && (code_t) v < (code_t) ((char *) prog + proglen)) - fprintf (f, "=code@%d", (code_t) v - prog); + fprintf (f, "=code@%ld", (code_t) v - prog); else if (Is_long (v)) fprintf (f, "=long%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val (v)); else if ((void*)v >= (void*)caml_stack_low && (void*)v < (void*)caml_stack_high) - fprintf (f, "=stack_%d", (intnat*)caml_stack_high - (intnat*)v); + fprintf (f, "=stack_%ld", (intnat*)caml_stack_high - (intnat*)v); else if (Is_block (v)) { int s = Wosize_val (v); int tg = Tag_val (v); int l = 0; switch (tg) { case Closure_tag: - fprintf (f, "=closure[s%d,cod%d]", s, (code_t) (Code_val (v)) - prog); + fprintf (f, "=closure[s%d,cod%ld]", s, (code_t) (Code_val (v)) - prog); goto displayfields; case String_tag: l = caml_string_length (v); @@ -251,11 +249,11 @@ value *p; fprintf (f, "accu="); caml_trace_value_file (accu, prog, proglen, f); - fprintf (f, "\n sp=%#" ARCH_INTNAT_PRINTF_FORMAT "x @%d:", + fprintf (f, "\n sp=%#" ARCH_INTNAT_PRINTF_FORMAT "x @%ld:", (intnat) sp, caml_stack_high - sp); for (p = sp, i = 0; i < 12 + (1 << caml_trace_flag) && p < caml_stack_high; p++, i++) { - fprintf (f, "\n[%d] ", caml_stack_high - p); + fprintf (f, "\n[%ld] ", caml_stack_high - p); caml_trace_value_file (*p, prog, proglen, f); }; putc ('\n', f); diff -Nru ocaml-3.12.1/byterun/instrtrace.h ocaml-4.01.0/byterun/instrtrace.h --- ocaml-3.12.1/byterun/instrtrace.h 2005-09-22 14:21:50.000000000 +0000 +++ ocaml-4.01.0/byterun/instrtrace.h 2013-03-09 22:38:52.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: instrtrace.h 7064 2005-09-22 14:21:50Z xleroy $ */ - /* Trace the instructions executed */ #ifndef _instrtrace_ @@ -27,5 +25,6 @@ void caml_stop_here (void); void caml_disasm_instr (code_t pc); void caml_trace_value_file (value v, code_t prog, int proglen, FILE * f); -void caml_trace_accu_sp_file(value accu, value * sp, code_t prog, int proglen, FILE * f); +void caml_trace_accu_sp_file(value accu, value * sp, code_t prog, int proglen, + FILE * f); #endif diff -Nru ocaml-3.12.1/byterun/instruct.h ocaml-4.01.0/byterun/instruct.h --- ocaml-3.12.1/byterun/instruct.h 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/instruct.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: instruct.h 9547 2010-01-22 12:48:24Z doligez $ */ - /* The instruction set. */ #ifndef CAML_INSTRUCT_H diff -Nru ocaml-3.12.1/byterun/int64_emul.h ocaml-4.01.0/byterun/int64_emul.h --- ocaml-3.12.1/byterun/int64_emul.h 2010-03-29 11:29:24.000000000 +0000 +++ ocaml-4.01.0/byterun/int64_emul.h 2012-11-29 09:55:00.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: int64_emul.h 10217 2010-03-29 11:29:24Z xleroy $ */ - /* Software emulation of 64-bit integer arithmetic, for C compilers that do not support it. */ @@ -27,6 +25,8 @@ #define I64_literal(hi,lo) { lo, hi } #endif +#define I64_split(x,hi,lo) (hi = (x).h, lo = (x).l) + /* Unsigned comparison */ static int I64_ucompare(uint64 x, uint64 y) { @@ -270,4 +270,18 @@ return res; } +static int64 I64_bswap(int64 x) +{ + int64 res; + res.h = (((x.l & 0x000000FF) << 24) | + ((x.l & 0x0000FF00) << 8) | + ((x.l & 0x00FF0000) >> 8) | + ((x.l & 0xFF000000) >> 24)); + res.l = (((x.h & 0x000000FF) << 24) | + ((x.h & 0x0000FF00) << 8) | + ((x.h & 0x00FF0000) >> 8) | + ((x.h & 0xFF000000) >> 24)); + return res; +} + #endif /* CAML_INT64_EMUL_H */ diff -Nru ocaml-3.12.1/byterun/int64_format.h ocaml-4.01.0/byterun/int64_format.h --- ocaml-3.12.1/byterun/int64_format.h 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/int64_format.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: int64_format.h 9547 2010-01-22 12:48:24Z doligez $ */ - /* printf-like formatting of 64-bit integers, in case the C library printf() function does not support them. */ @@ -52,7 +50,7 @@ case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': width = atoi(p); - while (*p >= '0' && *p <= '9') p++; + while (p[1] >= '0' && p[1] <= '9') p++; break; case 'd': case 'i': signedconv = 1; /* fallthrough */ diff -Nru ocaml-3.12.1/byterun/int64_native.h ocaml-4.01.0/byterun/int64_native.h --- ocaml-3.12.1/byterun/int64_native.h 2009-05-20 11:52:42.000000000 +0000 +++ ocaml-4.01.0/byterun/int64_native.h 2013-04-18 13:52:32.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: int64_native.h 9270 2009-05-20 11:52:42Z doligez $ */ - /* Wrapper macros around native 64-bit integer arithmetic, so that it has the same interface as the software emulation provided in int64_emul.h */ @@ -21,6 +19,7 @@ #define CAML_INT64_NATIVE_H #define I64_literal(hi,lo) ((int64)(hi) << 32 | (lo)) +#define I64_split(x,hi,lo) (hi = (uint32)((x)>>32), lo = (uint32)(x)) #define I64_compare(x,y) (((x) > (y)) - ((x) < (y))) #define I64_ult(x,y) ((uint64)(x) < (uint64)(y)) #define I64_neg(x) (-(x)) @@ -50,4 +49,13 @@ #define I64_to_double(x) ((double)(x)) #define I64_of_double(x) ((int64)(x)) +#define I64_bswap(x) ((((x) & 0x00000000000000FFULL) << 56) | \ + (((x) & 0x000000000000FF00ULL) << 40) | \ + (((x) & 0x0000000000FF0000ULL) << 24) | \ + (((x) & 0x00000000FF000000ULL) << 8) | \ + (((x) & 0x000000FF00000000ULL) >> 8) | \ + (((x) & 0x0000FF0000000000ULL) >> 24) | \ + (((x) & 0x00FF000000000000ULL) >> 40) | \ + (((x) & 0xFF00000000000000ULL) >> 56)) + #endif /* CAML_INT64_NATIVE_H */ diff -Nru ocaml-3.12.1/byterun/intern.c ocaml-4.01.0/byterun/intern.c --- ocaml-3.12.1/byterun/intern.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/intern.c 2013-06-07 14:06:30.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,19 +11,20 @@ /* */ /***********************************************************************/ -/* $Id: intern.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* Structured input, compact format */ /* The interface of this file is "intext.h" */ #include +#include #include "alloc.h" +#include "callback.h" #include "custom.h" #include "fail.h" #include "gc.h" #include "intext.h" #include "io.h" +#include "md5.h" #include "memory.h" #include "mlvalues.h" #include "misc.h" @@ -63,6 +64,16 @@ /* Point to the heap block allocated as destination block. Meaningful only if intern_extra_block is NULL. */ +static value * camlinternaloo_last_id = NULL; +/* Pointer to a reference holding the last object id. + -1 means not available (CamlinternalOO not loaded). */ + +static char * intern_resolve_code_pointer(unsigned char digest[16], + asize_t offset); +static void intern_bad_code_pointer(unsigned char digest[16]) Noreturn; + +static void intern_free_stack(void); + #define Sign_extend_shift ((sizeof(intnat) - 1) * 8) #define Sign_extend(x) (((intnat)(x) << Sign_extend_shift) >> Sign_extend_shift) @@ -109,20 +120,200 @@ /* restore original header for heap block, otherwise GC is confused */ Hd_val(intern_block) = intern_header; } + /* free the recursion stack */ + intern_free_stack(); +} + +static void readfloat(double * dest, unsigned int code) +{ + if (sizeof(double) != 8) { + intern_cleanup(); + caml_invalid_argument("input_value: non-standard floats"); + } + readblock((char *) dest, 8); + /* Fix up endianness, if needed */ +#if ARCH_FLOAT_ENDIANNESS == 0x76543210 + /* Host is big-endian; fix up if data read is little-endian */ + if (code != CODE_DOUBLE_BIG) Reverse_64(dest, dest); +#elif ARCH_FLOAT_ENDIANNESS == 0x01234567 + /* Host is little-endian; fix up if data read is big-endian */ + if (code != CODE_DOUBLE_LITTLE) Reverse_64(dest, dest); +#else + /* Host is neither big nor little; permute as appropriate */ + if (code == CODE_DOUBLE_LITTLE) + Permute_64(dest, ARCH_FLOAT_ENDIANNESS, dest, 0x01234567) + else + Permute_64(dest, ARCH_FLOAT_ENDIANNESS, dest, 0x76543210); +#endif } +static void readfloats(double * dest, mlsize_t len, unsigned int code) +{ + mlsize_t i; + if (sizeof(double) != 8) { + intern_cleanup(); + caml_invalid_argument("input_value: non-standard floats"); + } + readblock((char *) dest, len * 8); + /* Fix up endianness, if needed */ +#if ARCH_FLOAT_ENDIANNESS == 0x76543210 + /* Host is big-endian; fix up if data read is little-endian */ + if (code != CODE_DOUBLE_ARRAY8_BIG && + code != CODE_DOUBLE_ARRAY32_BIG) { + for (i = 0; i < len; i++) Reverse_64(dest + i, dest + i); + } +#elif ARCH_FLOAT_ENDIANNESS == 0x01234567 + /* Host is little-endian; fix up if data read is big-endian */ + if (code != CODE_DOUBLE_ARRAY8_LITTLE && + code != CODE_DOUBLE_ARRAY32_LITTLE) { + for (i = 0; i < len; i++) Reverse_64(dest + i, dest + i); + } +#else + /* Host is neither big nor little; permute as appropriate */ + if (code == CODE_DOUBLE_ARRAY8_LITTLE || + code == CODE_DOUBLE_ARRAY32_LITTLE) { + for (i = 0; i < len; i++) + Permute_64(dest + i, ARCH_FLOAT_ENDIANNESS, dest + i, 0x01234567); + } else { + for (i = 0; i < len; i++) + Permute_64(dest + i, ARCH_FLOAT_ENDIANNESS, dest + i, 0x76543210); + } +#endif +} + +/* Item on the stack with defined operation */ +struct intern_item { + value * dest; + intnat arg; + enum { + OReadItems, /* read arg items and store them in dest[0], dest[1], ... */ + OFreshOID, /* generate a fresh OID and store it in *dest */ + OShift /* offset *dest by arg */ + } op; +}; + +/* FIXME: This is duplicated in two other places, with the only difference of + the type of elements stored in the stack. Possible solution in C would + be to instantiate stack these function via. C preprocessor macro. + */ + +#define INTERN_STACK_INIT_SIZE 256 +#define INTERN_STACK_MAX_SIZE (1024*1024*100) + +static struct intern_item intern_stack_init[INTERN_STACK_INIT_SIZE]; + +static struct intern_item * intern_stack = intern_stack_init; +static struct intern_item * intern_stack_limit = intern_stack_init + + INTERN_STACK_INIT_SIZE; + +/* Free the recursion stack if needed */ +static void intern_free_stack(void) +{ + if (intern_stack != intern_stack_init) { + free(intern_stack); + /* Reinitialize the globals for next time around */ + intern_stack = intern_stack_init; + intern_stack_limit = intern_stack + INTERN_STACK_INIT_SIZE; + } +} + +/* Same, then raise Out_of_memory */ +static void intern_stack_overflow(void) +{ + caml_gc_message (0x04, "Stack overflow in un-marshaling value\n", 0); + intern_free_stack(); + caml_raise_out_of_memory(); +} + +static struct intern_item * intern_resize_stack(struct intern_item * sp) +{ + asize_t newsize = 2 * (intern_stack_limit - intern_stack); + asize_t sp_offset = sp - intern_stack; + struct intern_item * newstack; + + if (newsize >= INTERN_STACK_MAX_SIZE) intern_stack_overflow(); + if (intern_stack == intern_stack_init) { + newstack = malloc(sizeof(struct intern_item) * newsize); + if (newstack == NULL) intern_stack_overflow(); + memcpy(newstack, intern_stack_init, + sizeof(struct intern_item) * INTERN_STACK_INIT_SIZE); + } else { + newstack = + realloc(intern_stack, sizeof(struct intern_item) * newsize); + if (newstack == NULL) intern_stack_overflow(); + } + intern_stack = newstack; + intern_stack_limit = newstack + newsize; + return newstack + sp_offset; +} + +/* Convenience macros for requesting operation on the stack */ +#define PushItem() \ + do { \ + sp++; \ + if (sp >= intern_stack_limit) sp = intern_resize_stack(sp); \ + } while(0) + +#define ReadItems(_dest,_n) \ + do { \ + if (_n > 0) { \ + PushItem(); \ + sp->op = OReadItems; \ + sp->dest = _dest; \ + sp->arg = _n; \ + } \ + } while(0) + static void intern_rec(value *dest) { unsigned int code; tag_t tag; mlsize_t size, len, ofs_ind; - value v, clos; + value v; asize_t ofs; header_t header; - char cksum[16]; + unsigned char digest[16]; struct custom_operations * ops; + char * codeptr; + struct intern_item * sp; + + sp = intern_stack; - tailcall: + /* Initially let's try to read the first object from the stream */ + ReadItems(dest, 1); + + /* The un-marshaler loop, the recursion is unrolled */ + while(sp != intern_stack) { + + /* Interpret next item on the stack */ + dest = sp->dest; + switch (sp->op) { + case OFreshOID: + /* Refresh the object ID */ + if (camlinternaloo_last_id == NULL) { + camlinternaloo_last_id = caml_named_value("CamlinternalOO.last_id"); + if (camlinternaloo_last_id == NULL) + camlinternaloo_last_id = (value*) (-1); + } + if (camlinternaloo_last_id != (value*) (-1)) { + value id = Field(*camlinternaloo_last_id,0); + Field(dest, 0) = id; + Field(*camlinternaloo_last_id,0) = id + 2; + } + /* Pop item and iterate */ + sp--; + break; + case OShift: + /* Shift value by an offset */ + *dest += sp->arg; + /* Pop item and iterate */ + sp--; + break; + case OReadItems: + /* Pop item */ + sp->dest++; + if (--(sp->arg) == 0) sp--; + /* Read a value and set v to this value */ code = read8u(); if (code >= PREFIX_SMALL_INT) { if (code >= PREFIX_SMALL_BLOCK) { @@ -134,14 +325,24 @@ v = Atom(tag); } else { v = Val_hp(intern_dest); - *dest = v; if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v; - dest = (value *) (intern_dest + 1); *intern_dest = Make_header(size, tag, intern_color); intern_dest += 1 + size; - for(/*nothing*/; size > 1; size--, dest++) - intern_rec(dest); - goto tailcall; + /* For objects, we need to freshen the oid */ + if (tag == Object_tag) { + Assert(size >= 2); + /* Request to read rest of the elements of the block */ + ReadItems(&Field(v, 2), size - 2); + /* Request freshing OID */ + PushItem(); + sp->op = OFreshOID; + sp->dest = &Field(v, 1); + sp->arg = 1; + /* Finally read first two block elements: method table and old OID */ + ReadItems(&Field(v, 0), 2); + } else + /* If it's not an object then read the contents of the block */ + ReadItems(&Field(v, 0), size); } } else { /* Small integer */ @@ -219,68 +420,22 @@ goto read_string; case CODE_DOUBLE_LITTLE: case CODE_DOUBLE_BIG: - if (sizeof(double) != 8) { - intern_cleanup(); - caml_invalid_argument("input_value: non-standard floats"); - } v = Val_hp(intern_dest); if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v; *intern_dest = Make_header(Double_wosize, Double_tag, intern_color); intern_dest += 1 + Double_wosize; - readblock((char *) v, 8); -#if ARCH_FLOAT_ENDIANNESS == 0x76543210 - if (code != CODE_DOUBLE_BIG) Reverse_64(v, v); -#elif ARCH_FLOAT_ENDIANNESS == 0x01234567 - if (code != CODE_DOUBLE_LITTLE) Reverse_64(v, v); -#else - if (code == CODE_DOUBLE_LITTLE) - Permute_64(v, ARCH_FLOAT_ENDIANNESS, v, 0x01234567) - else - Permute_64(v, ARCH_FLOAT_ENDIANNESS, v, 0x76543210); -#endif + readfloat((double *) v, code); break; case CODE_DOUBLE_ARRAY8_LITTLE: case CODE_DOUBLE_ARRAY8_BIG: len = read8u(); read_double_array: - if (sizeof(double) != 8) { - intern_cleanup(); - caml_invalid_argument("input_value: non-standard floats"); - } size = len * Double_wosize; v = Val_hp(intern_dest); if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v; *intern_dest = Make_header(size, Double_array_tag, intern_color); intern_dest += 1 + size; - readblock((char *) v, len * 8); -#if ARCH_FLOAT_ENDIANNESS == 0x76543210 - if (code != CODE_DOUBLE_ARRAY8_BIG && - code != CODE_DOUBLE_ARRAY32_BIG) { - mlsize_t i; - for (i = 0; i < len; i++) Reverse_64((value)((double *)v + i), - (value)((double *)v + i)); - } -#elif ARCH_FLOAT_ENDIANNESS == 0x01234567 - if (code != CODE_DOUBLE_ARRAY8_LITTLE && - code != CODE_DOUBLE_ARRAY32_LITTLE) { - mlsize_t i; - for (i = 0; i < len; i++) Reverse_64((value)((double *)v + i), - (value)((double *)v + i)); - } -#else - if (code == CODE_DOUBLE_ARRAY8_LITTLE || - code == CODE_DOUBLE_ARRAY32_LITTLE) { - mlsize_t i; - for (i = 0; i < len; i++) - Permute_64((value)((double *)v + i), ARCH_FLOAT_ENDIANNESS, - (value)((double *)v + i), 0x01234567); - } else { - mlsize_t i; - for (i = 0; i < len; i++) - Permute_64((value)((double *)v + i), ARCH_FLOAT_ENDIANNESS, - (value)((double *)v + i), 0x76543210); - } -#endif + readfloats((double *) v, len, code); break; case CODE_DOUBLE_ARRAY32_LITTLE: case CODE_DOUBLE_ARRAY32_BIG: @@ -288,18 +443,30 @@ goto read_double_array; case CODE_CODEPOINTER: ofs = read32u(); - readblock(cksum, 16); - if (memcmp(cksum, caml_code_checksum(), 16) != 0) { - intern_cleanup(); - caml_failwith("input_value: code mismatch"); + readblock(digest, 16); + codeptr = intern_resolve_code_pointer(digest, ofs); + if (codeptr != NULL) { + v = (value) codeptr; + } else { + value * function_placeholder = + caml_named_value ("Debugger.function_placeholder"); + if (function_placeholder != NULL) { + v = *function_placeholder; + } else { + intern_cleanup(); + intern_bad_code_pointer(digest); + } } - v = (value) (caml_code_area_start + ofs); break; case CODE_INFIXPOINTER: ofs = read32u(); - intern_rec(&clos); - v = clos + ofs; - break; + /* Read a value to *dest, then offset *dest by ofs */ + PushItem(); + sp->dest = dest; + sp->op = OShift; + sp->arg = ofs; + ReadItems(dest, 1); + continue; /* with next iteration of main loop, skipping *dest = v */ case CODE_CUSTOM: ops = caml_find_custom_operations((char *) intern_src); if (ops == NULL) { @@ -321,13 +488,23 @@ } } } + /* end of case OReadItems */ *dest = v; + break; + default: + Assert(0); + } + } + /* We are done. Cleanup the stack and leave the function */ + intern_free_stack(); } static void intern_alloc(mlsize_t whsize, mlsize_t num_objects) { mlsize_t wosize; + if (camlinternaloo_last_id == (value*)-1) + camlinternaloo_last_id = NULL; /* Reset ignore flag */ if (whsize == 0) { intern_obj_table = NULL; intern_extra_block = NULL; @@ -379,7 +556,7 @@ Assert(intern_dest <= end_extra_block); if (intern_dest < end_extra_block){ caml_make_free_blocks ((value *) intern_dest, - end_extra_block - intern_dest, 0); + end_extra_block - intern_dest, 0, Caml_white); } caml_allocated_words += Wsize_bsize ((char *) intern_dest - intern_extra_block); @@ -390,7 +567,7 @@ value caml_input_val(struct channel *chan) { uint32 magic; - mlsize_t block_len, num_objects, size_32, size_64, whsize; + mlsize_t block_len, num_objects, whsize; char * block; value res; @@ -400,8 +577,13 @@ if (magic != Intext_magic_number) caml_failwith("input_value: bad object"); block_len = caml_getword(chan); num_objects = caml_getword(chan); - size_32 = caml_getword(chan); - size_64 = caml_getword(chan); +#ifdef ARCH_SIXTYFOUR + caml_getword(chan); /* skip size_32 */ + whsize = caml_getword(chan); +#else + whsize = caml_getword(chan); + caml_getword(chan); /* skip size_64 */ +#endif /* Read block from channel */ block = caml_stat_alloc(block_len); /* During [caml_really_getblock], concurrent [caml_input_val] operations @@ -415,12 +597,6 @@ intern_input = (unsigned char *) block; intern_input_malloced = 1; intern_src = intern_input; - /* Allocate result */ -#ifdef ARCH_SIXTYFOUR - whsize = size_64; -#else - whsize = size_32; -#endif intern_alloc(whsize, num_objects); /* Fill it in */ intern_rec(&res); @@ -428,7 +604,7 @@ /* Free everything */ caml_stat_free(intern_input); if (intern_obj_table != NULL) caml_stat_free(intern_obj_table); - return res; + return caml_check_urgent_gc(res); } CAMLprim value caml_input_value(value vchan) @@ -446,20 +622,20 @@ CAMLexport value caml_input_val_from_string(value str, intnat ofs) { CAMLparam1 (str); - mlsize_t num_objects, size_32, size_64, whsize; + mlsize_t num_objects, whsize; CAMLlocal1 (obj); intern_src = &Byte_u(str, ofs + 2*4); intern_input_malloced = 0; num_objects = read32u(); - size_32 = read32u(); - size_64 = read32u(); - /* Allocate result */ #ifdef ARCH_SIXTYFOUR - whsize = size_64; + intern_src += 4; /* skip size_32 */ + whsize = read32u(); #else - whsize = size_32; + whsize = read32u(); + intern_src += 4; /* skip size_64 */ #endif + /* Allocate result */ intern_alloc(whsize, num_objects); intern_src = &Byte_u(str, ofs + 5*4); /* If a GC occurred */ /* Fill it in */ @@ -467,7 +643,7 @@ intern_add_to_heap(whsize); /* Free everything */ if (intern_obj_table != NULL) caml_stat_free(intern_obj_table); - CAMLreturn (obj); + CAMLreturn (caml_check_urgent_gc(obj)); } CAMLprim value caml_input_value_from_string(value str, value ofs) @@ -477,31 +653,30 @@ static value input_val_from_block(void) { - mlsize_t num_objects, size_32, size_64, whsize; + mlsize_t num_objects, whsize; value obj; num_objects = read32u(); - size_32 = read32u(); - size_64 = read32u(); - /* Allocate result */ #ifdef ARCH_SIXTYFOUR - whsize = size_64; + intern_src += 4; /* skip size_32 */ + whsize = read32u(); #else - whsize = size_32; + whsize = read32u(); + intern_src += 4; /* skip size_64 */ #endif + /* Allocate result */ intern_alloc(whsize, num_objects); /* Fill it in */ intern_rec(&obj); intern_add_to_heap(whsize); /* Free internal data structures */ if (intern_obj_table != NULL) caml_stat_free(intern_obj_table); - return obj; + return caml_check_urgent_gc(obj); } CAMLexport value caml_input_value_from_malloc(char * data, intnat ofs) { uint32 magic; - mlsize_t block_len; value obj; intern_input = (unsigned char *) data; @@ -510,7 +685,7 @@ magic = read32u(); if (magic != Intext_magic_number) caml_failwith("input_value_from_malloc: bad object"); - block_len = read32u(); + intern_src += 4; /* Skip block_len */ obj = input_val_from_block(); /* Free the input */ caml_stat_free(intern_input); @@ -551,40 +726,41 @@ return Val_long(block_len); } -/* Return an MD5 checksum of the code area */ - -#ifdef NATIVE_CODE - -#include "md5.h" +/* Resolution of code pointers */ -unsigned char * caml_code_checksum(void) +static char * intern_resolve_code_pointer(unsigned char digest[16], + asize_t offset) { - static unsigned char checksum[16]; - static int checksum_computed = 0; - - if (! checksum_computed) { - struct MD5Context ctx; - caml_MD5Init(&ctx); - caml_MD5Update(&ctx, - (unsigned char *) caml_code_area_start, - caml_code_area_end - caml_code_area_start); - caml_MD5Final(checksum, &ctx); - checksum_computed = 1; + int i; + for (i = caml_code_fragments_table.size - 1; i >= 0; i--) { + struct code_fragment * cf = caml_code_fragments_table.contents[i]; + if (! cf->digest_computed) { + caml_md5_block(cf->digest, cf->code_start, cf->code_end - cf->code_start); + cf->digest_computed = 1; + } + if (memcmp(digest, cf->digest, 16) == 0) { + if (cf->code_start + offset < cf->code_end) + return cf->code_start + offset; + else + return NULL; + } } - return checksum; + return NULL; } -#else - -#include "fix_code.h" - -unsigned char * caml_code_checksum(void) +static void intern_bad_code_pointer(unsigned char digest[16]) { - return caml_code_md5; + char msg[256]; + sprintf(msg, "input_value: unknown code module " + "%02X%02X%02X%02X%02X%02X%02X%02X" + "%02X%02X%02X%02X%02X%02X%02X%02X", + digest[0], digest[1], digest[2], digest[3], + digest[4], digest[5], digest[6], digest[7], + digest[8], digest[9], digest[10], digest[11], + digest[12], digest[13], digest[14], digest[15]); + caml_failwith(msg); } -#endif - /* Functions for writing user-defined marshallers */ CAMLexport int caml_deserialize_uint_1(void) diff -Nru ocaml-3.12.1/byterun/interp.c ocaml-4.01.0/byterun/interp.c --- ocaml-3.12.1/byterun/interp.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/interp.c 2013-06-01 07:43:45.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: interp.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* The bytecode interpreter */ #include #include "alloc.h" @@ -113,7 +111,8 @@ For GCC, I have hand-assigned hardware registers for several architectures. */ -#if defined(__GNUC__) && !defined(DEBUG) && !defined(__INTEL_COMPILER) && !defined(__llvm__) +#if defined(__GNUC__) && !defined(DEBUG) && !defined(__INTEL_COMPILER) \ + && !defined(__llvm__) #ifdef __mips__ #define PC_REG asm("$16") #define SP_REG asm("$17") @@ -217,7 +216,6 @@ struct caml__roots_block * volatile initial_local_roots; volatile code_t saved_pc = NULL; struct longjmp_buffer raise_buf; - value * modify_dest, modify_newval; #ifndef THREADED_CODE opcode_t curr_instr; #endif @@ -707,29 +705,26 @@ } Instruct(SETFIELD0): - modify_dest = &Field(accu, 0); - modify_newval = *sp++; - modify: - Modify(modify_dest, modify_newval); + caml_modify(&Field(accu, 0), *sp++); accu = Val_unit; Next; Instruct(SETFIELD1): - modify_dest = &Field(accu, 1); - modify_newval = *sp++; - goto modify; + caml_modify(&Field(accu, 1), *sp++); + accu = Val_unit; + Next; Instruct(SETFIELD2): - modify_dest = &Field(accu, 2); - modify_newval = *sp++; - goto modify; + caml_modify(&Field(accu, 2), *sp++); + accu = Val_unit; + Next; Instruct(SETFIELD3): - modify_dest = &Field(accu, 3); - modify_newval = *sp++; - goto modify; + caml_modify(&Field(accu, 3), *sp++); + accu = Val_unit; + Next; Instruct(SETFIELD): - modify_dest = &Field(accu, *pc); + caml_modify(&Field(accu, *pc), *sp++); + accu = Val_unit; pc++; - modify_newval = *sp++; - goto modify; + Next; Instruct(SETFLOATFIELD): Store_double_field(accu, *pc, Double_val(*sp)); accu = Val_unit; @@ -750,10 +745,10 @@ sp += 1; Next; Instruct(SETVECTITEM): - modify_dest = &Field(accu, Long_val(sp[0])); - modify_newval = sp[1]; + caml_modify(&Field(accu, Long_val(sp[0])), sp[1]); + accu = Val_unit; sp += 2; - goto modify; + Next; /* String operations */ @@ -1123,7 +1118,7 @@ #else caml_fatal_error_arg("Fatal error: bad opcode (%" ARCH_INTNAT_PRINTF_FORMAT "x)\n", - (char *)(*(pc-1))); + (char *) (intnat) *(pc-1)); #endif } } diff -Nru ocaml-3.12.1/byterun/interp.h ocaml-4.01.0/byterun/interp.h --- ocaml-3.12.1/byterun/interp.h 2004-04-26 14:08:22.000000000 +0000 +++ ocaml-4.01.0/byterun/interp.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: interp.h 6257 2004-04-26 14:08:22Z basile $ */ - /* The bytecode interpreter */ #ifndef CAML_INTERP_H diff -Nru ocaml-3.12.1/byterun/intext.h ocaml-4.01.0/byterun/intext.h --- ocaml-3.12.1/byterun/intext.h 2005-09-22 14:21:50.000000000 +0000 +++ ocaml-4.01.0/byterun/intext.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: intext.h 7064 2005-09-22 14:21:50Z xleroy $ */ - /* Structured input/output */ #ifndef CAML_INTEXT_H @@ -81,6 +79,10 @@ /* */ +#ifdef __cplusplus +extern "C" { +#endif + CAMLextern void caml_output_value_to_malloc(value v, value flags, /*out*/ char ** buf, /*out*/ intnat * len); @@ -100,7 +102,7 @@ /* */ CAMLextern value caml_input_val_from_string (value str, intnat ofs); - /* Read a structured value from the Caml string [str], starting + /* Read a structured value from the OCaml string [str], starting at offset [ofs]. */ CAMLextern value caml_input_value_from_malloc(char * data, intnat ofs); /* Read a structured value from a malloced buffer. [data] points @@ -147,16 +149,20 @@ /* */ /* Auxiliary stuff for sending code pointers */ -unsigned char * caml_code_checksum (void); -#ifndef NATIVE_CODE -#include "fix_code.h" -#define caml_code_area_start ((char *) caml_start_code) -#define caml_code_area_end ((char *) caml_start_code + caml_code_size) -#else -extern char * caml_code_area_start, * caml_code_area_end; -#endif +struct code_fragment { + char * code_start; + char * code_end; + unsigned char digest[16]; + char digest_computed; +}; + +struct ext_table caml_code_fragments_table; /* */ +#ifdef __cplusplus +} +#endif + #endif /* CAML_INTEXT_H */ diff -Nru ocaml-3.12.1/byterun/ints.c ocaml-4.01.0/byterun/ints.c --- ocaml-3.12.1/byterun/ints.c 2011-05-12 14:34:05.000000000 +0000 +++ ocaml-4.01.0/byterun/ints.c 2013-04-18 13:59:50.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: ints.c 11037 2011-05-12 14:34:05Z xleroy $ */ - #include #include #include "alloc.h" @@ -116,6 +114,19 @@ } #endif +value caml_bswap16_direct(value x) +{ + return ((((x & 0x00FF) << 8) | + ((x & 0xFF00) >> 8))); +} + +CAMLprim value caml_bswap16(value v) +{ + intnat x = Int_val(v); + return (Val_int ((((x & 0x00FF) << 8) | + ((x & 0xFF00) >> 8)))); +} + /* Tagged integers */ CAMLprim value caml_int_compare(value v1, value v2) @@ -142,7 +153,7 @@ char lastletter; mlsize_t len, len_suffix; - /* Copy Caml format fmt to format_string, + /* Copy OCaml format fmt to format_string, adding the suffix before the last letter of the format */ len = caml_string_length(fmt); len_suffix = strlen(suffix); @@ -227,7 +238,8 @@ int32_cmp, int32_hash, int32_serialize, - int32_deserialize + int32_deserialize, + custom_compare_ext_default }; CAMLexport value caml_copy_int32(int32 i) @@ -297,6 +309,20 @@ CAMLprim value caml_int32_shift_right_unsigned(value v1, value v2) { return caml_copy_int32((uint32)Int32_val(v1) >> Int_val(v2)); } +static int32 caml_swap32(int32 x) +{ + return (((x & 0x000000FF) << 24) | + ((x & 0x0000FF00) << 8) | + ((x & 0x00FF0000) >> 8) | + ((x & 0xFF000000) >> 24)); +} + +value caml_int32_direct_bswap(value v) +{ return caml_swap32(v); } + +CAMLprim value caml_int32_bswap(value v) +{ return caml_copy_int32(caml_swap32(Int32_val(v))); } + CAMLprim value caml_int32_of_int(value v) { return caml_copy_int32(Long_val(v)); } @@ -381,7 +407,11 @@ static intnat int64_hash(value v) { - return I64_to_intnat(Int64_val(v)); + int64 x = Int64_val(v); + uint32 lo, hi; + + I64_split(x, hi, lo); + return hi ^ lo; } static void int64_serialize(value v, uintnat * wsize_32, @@ -410,7 +440,8 @@ int64_cmp, int64_hash, int64_serialize, - int64_deserialize + int64_deserialize, + custom_compare_ext_default }; CAMLexport value caml_copy_int64(int64 i) @@ -482,6 +513,26 @@ CAMLprim value caml_int64_shift_right_unsigned(value v1, value v2) { return caml_copy_int64(I64_lsr(Int64_val(v1), Int_val(v2))); } +#ifdef ARCH_SIXTYFOUR +static value caml_swap64(value x) +{ + return (((((x) & 0x00000000000000FF) << 56) | + (((x) & 0x000000000000FF00) << 40) | + (((x) & 0x0000000000FF0000) << 24) | + (((x) & 0x00000000FF000000) << 8) | + (((x) & 0x000000FF00000000) >> 8) | + (((x) & 0x0000FF0000000000) >> 24) | + (((x) & 0x00FF000000000000) >> 40) | + (((x) & 0xFF00000000000000) >> 56))); +} + +value caml_int64_direct_bswap(value v) +{ return caml_swap64(v); } +#endif + +CAMLprim value caml_int64_bswap(value v) +{ return caml_copy_int64(I64_bswap(Int64_val(v))); } + CAMLprim value caml_int64_of_int(value v) { return caml_copy_int64(I64_of_intnat(Long_val(v))); } @@ -606,7 +657,14 @@ static intnat nativeint_hash(value v) { - return Nativeint_val(v); + intnat n = Nativeint_val(v); +#ifdef ARCH_SIXTYFOUR + /* 32/64 bits compatibility trick. See explanations in file "hash.c", + function caml_hash_mix_intnat. */ + return (n >> 32) ^ (n >> 63) ^ n; +#else + return n; +#endif } static void nativeint_serialize(value v, uintnat * wsize_32, @@ -654,7 +712,8 @@ nativeint_cmp, nativeint_hash, nativeint_serialize, - nativeint_deserialize + nativeint_deserialize, + custom_compare_ext_default }; CAMLexport value caml_copy_nativeint(intnat i) @@ -700,7 +759,9 @@ if (divisor == 0) caml_raise_zero_divide(); /* PR#4740: on some processors, modulus crashes if division overflows. Implement the same behavior as for type "int". */ - if (dividend == Nativeint_min_int && divisor == -1) return caml_copy_nativeint(0); + if (dividend == Nativeint_min_int && divisor == -1){ + return caml_copy_nativeint(0); + } #ifdef NONSTANDARD_DIV_MOD return caml_copy_nativeint(caml_safe_mod(dividend, divisor)); #else @@ -726,6 +787,24 @@ CAMLprim value caml_nativeint_shift_right_unsigned(value v1, value v2) { return caml_copy_nativeint((uintnat)Nativeint_val(v1) >> Int_val(v2)); } +value caml_nativeint_direct_bswap(value v) +{ +#ifdef ARCH_SIXTYFOUR + return caml_swap64(v); +#else + return caml_swap32(v); +#endif +} + +CAMLprim value caml_nativeint_bswap(value v) +{ +#ifdef ARCH_SIXTYFOUR + return caml_copy_nativeint(caml_swap64(Nativeint_val(v))); +#else + return caml_copy_nativeint(caml_swap32(Nativeint_val(v))); +#endif +} + CAMLprim value caml_nativeint_of_int(value v) { return caml_copy_nativeint(Long_val(v)); } diff -Nru ocaml-3.12.1/byterun/io.c ocaml-4.01.0/byterun/io.c --- ocaml-3.12.1/byterun/io.c 2010-04-23 07:58:59.000000000 +0000 +++ ocaml-4.01.0/byterun/io.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: io.c 10300 2010-04-23 07:58:59Z shinwell $ */ - /* Buffered input/output. */ #include @@ -117,7 +115,7 @@ file_offset end; int fd; - /* We extract data from [channel] before dropping the Caml lock, in case + /* We extract data from [channel] before dropping the OCaml lock, in case someone else touches the block. */ fd = channel->fd; offset = channel->offset; @@ -279,6 +277,11 @@ do { caml_enter_blocking_section(); retcode = read(fd, p, n); +#if defined(_WIN32) + if (retcode == -1 && errno == ENOMEM && n > 16384){ + retcode = read(fd, p, 16384); + } +#endif caml_leave_blocking_section(); } while (retcode == -1 && errno == EINTR); if (retcode == -1) caml_sys_io_error(NO_ARG); @@ -411,7 +414,7 @@ return (p - channel->curr); } -/* Caml entry points for the I/O functions. Wrap struct channel * +/* OCaml entry points for the I/O functions. Wrap struct channel * objects into a heap-allocated object. Perform locking and unlocking around the I/O operations. */ /* FIXME CAMLexport, but not in io.h exported for Cash ? */ @@ -431,13 +434,19 @@ return (chan1 == chan2) ? 0 : (chan1 < chan2) ? -1 : 1; } +static intnat hash_channel(value vchan) +{ + return (intnat) (Channel(vchan)); +} + static struct custom_operations channel_operations = { "_chan", caml_finalize_channel, compare_channel, - custom_hash_default, + hash_channel, custom_serialize_default, - custom_deserialize_default + custom_deserialize_default, + custom_compare_ext_default }; CAMLexport value caml_alloc_channel(struct channel *chan) diff -Nru ocaml-3.12.1/byterun/io.h ocaml-4.01.0/byterun/io.h --- ocaml-3.12.1/byterun/io.h 2008-09-27 21:16:29.000000000 +0000 +++ ocaml-4.01.0/byterun/io.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: io.h 9041 2008-09-27 21:16:29Z weis $ */ - /* Buffered input/output */ #ifndef CAML_IO_H @@ -22,7 +20,7 @@ #include "mlvalues.h" #ifndef IO_BUFFER_SIZE -#define IO_BUFFER_SIZE 4096 +#define IO_BUFFER_SIZE 65536 #endif #if defined(_WIN32) diff -Nru ocaml-3.12.1/byterun/lexing.c ocaml-4.01.0/byterun/lexing.c --- ocaml-3.12.1/byterun/lexing.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/lexing.c 2013-03-09 22:38:52.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: lexing.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* The table-driven automaton for lexers generated by camllex. */ #include "fail.h" @@ -220,7 +218,8 @@ else pc_off = Short(tbl->lex_default_code, pstate) ; if (pc_off > 0) - run_mem(Bp_val(tbl->lex_code) + pc_off, lexbuf->lex_mem, lexbuf->lex_curr_pos) ; + run_mem(Bp_val(tbl->lex_code) + pc_off, lexbuf->lex_mem, + lexbuf->lex_curr_pos) ; /* Erase the EOF condition only if the EOF pseudo-character was consumed by the automaton (i.e. there was no backtrack above) */ diff -Nru ocaml-3.12.1/byterun/main.c ocaml-4.01.0/byterun/main.c --- ocaml-3.12.1/byterun/main.c 2008-02-29 12:56:15.000000000 +0000 +++ ocaml-4.01.0/byterun/main.c 2013-02-26 12:47:13.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: main.c 8822 2008-02-29 12:56:15Z doligez $ */ - /* Main entry point (can be overridden by a user-provided main() function that calls caml_main() later). */ @@ -29,13 +27,13 @@ int main(int argc, char **argv) { #ifdef DEBUG + caml_gc_message (-1, "### OCaml runtime: debug mode ###\n", 0); +#if 0 { + int i; char *ocp; char *cp; - int i; - caml_gc_message (-1, "### OCaml runtime: debug mode ###\n", 0); -#if 0 caml_gc_message (-1, "### command line:", 0); for (i = 0; i < argc; i++){ caml_gc_message (-1, " %s", argv[i]); @@ -46,9 +44,9 @@ cp = getenv ("CAMLRUNPARAM"); caml_gc_message (-1, "### CAMLRUNPARAM=%s\n", cp == NULL ? "" : cp); caml_gc_message (-1, "### working dir: %s\n", getcwd (NULL, 0)); -#endif } #endif +#endif #ifdef _WIN32 /* Expand wildcards and diversions in command line */ caml_expand_command_line(&argc, &argv); diff -Nru ocaml-3.12.1/byterun/major_gc.c ocaml-4.01.0/byterun/major_gc.c --- ocaml-3.12.1/byterun/major_gc.c 2009-11-04 12:25:47.000000000 +0000 +++ ocaml-4.01.0/byterun/major_gc.c 2013-03-09 22:38:52.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: major_gc.c 9410 2009-11-04 12:25:47Z doligez $ */ - #include #include "compact.h" @@ -233,7 +231,11 @@ weak_prev = &Field (cur, 0); work -= Whsize_hd (hd); }else{ - /* Subphase_weak1 is done. Start removing dead weak arrays. */ + /* Subphase_weak1 is done. + Handle finalised values and start removing dead weak arrays. */ + gray_vals_cur = gray_vals_ptr; + caml_final_update (); + gray_vals_ptr = gray_vals_cur; caml_gc_subphase = Subphase_weak2; weak_prev = &caml_weak_list_head; } @@ -254,10 +256,7 @@ } work -= 1; }else{ - /* Subphase_weak2 is done. Handle finalised values. */ - gray_vals_cur = gray_vals_ptr; - caml_final_update (); - gray_vals_ptr = gray_vals_cur; + /* Subphase_weak2 is done. Go to Subphase_final. */ caml_gc_subphase = Subphase_final; } } @@ -490,12 +489,13 @@ if (caml_page_table_add(In_heap, caml_heap_start, caml_heap_start + caml_stat_heap_size) != 0) { - caml_fatal_error ("Fatal error: not enough memory for the initial page table.\n"); + caml_fatal_error ("Fatal error: not enough memory " + "for the initial page table.\n"); } caml_fl_init_merge (); caml_make_free_blocks ((value *) caml_heap_start, - Wsize_bsize (caml_stat_heap_size), 1); + Wsize_bsize (caml_stat_heap_size), 1, Caml_white); caml_gc_phase = Phase_idle; gray_vals_size = 2048; gray_vals = (value *) malloc (gray_vals_size * sizeof (value)); diff -Nru ocaml-3.12.1/byterun/major_gc.h ocaml-4.01.0/byterun/major_gc.h --- ocaml-3.12.1/byterun/major_gc.h 2010-11-22 15:32:07.000000000 +0000 +++ ocaml-4.01.0/byterun/major_gc.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: major_gc.h 10843 2010-11-22 15:32:07Z doligez $ */ - #ifndef CAML_MAJOR_GC_H #define CAML_MAJOR_GC_H diff -Nru ocaml-3.12.1/byterun/md5.c ocaml-4.01.0/byterun/md5.c --- ocaml-3.12.1/byterun/md5.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/md5.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: md5.c 9547 2010-01-22 12:48:24Z doligez $ */ - #include #include "alloc.h" #include "fail.h" @@ -68,6 +66,15 @@ CAMLreturn (res); } +CAMLexport void caml_md5_block(unsigned char digest[16], + void * data, uintnat len) +{ + struct MD5Context ctx; + caml_MD5Init(&ctx); + caml_MD5Update(&ctx, data, len); + caml_MD5Final(digest, &ctx); +} + /* * This code implements the MD5 message-digest algorithm. * The algorithm is due to Ron Rivest. This code was @@ -206,7 +213,7 @@ caml_MD5Transform(ctx->buf, (uint32 *) ctx->in); byteReverse((unsigned char *) ctx->buf, 4); memcpy(digest, ctx->buf, 16); - memset(ctx, 0, sizeof(ctx)); /* In case it's sensitive */ + memset(ctx, 0, sizeof(*ctx)); /* In case it's sensitive */ } /* The four core functions - F1 is optimized somewhat */ diff -Nru ocaml-3.12.1/byterun/md5.h ocaml-4.01.0/byterun/md5.h --- ocaml-3.12.1/byterun/md5.h 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/md5.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: md5.h 9547 2010-01-22 12:48:24Z doligez $ */ - /* MD5 message digest */ #ifndef CAML_MD5_H @@ -24,6 +22,8 @@ CAMLextern value caml_md5_string (value str, value ofs, value len); CAMLextern value caml_md5_chan (value vchan, value len); +CAMLextern void caml_md5_block(unsigned char digest[16], + void * data, uintnat len); struct MD5Context { uint32 buf[4]; diff -Nru ocaml-3.12.1/byterun/memory.c ocaml-4.01.0/byterun/memory.c --- ocaml-3.12.1/byterun/memory.c 2008-12-03 18:09:09.000000000 +0000 +++ ocaml-4.01.0/byterun/memory.c 2013-08-01 08:12:41.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: memory.c 9153 2008-12-03 18:09:09Z doligez $ */ - #include #include #include "fail.h" @@ -255,6 +253,8 @@ caller. All other blocks must have the color [caml_allocation_color(m)]. The caller must update [caml_allocated_words] if applicable. Return value: 0 if no error; -1 in case of error. + + See also: caml_compact_heap, which duplicates most of this function. */ int caml_add_to_heap (char *m) { @@ -316,7 +316,7 @@ } remain = malloc_request; prev = hp = mem; - /* XXX find a way to do this with a call to caml_make_free_blocks */ + /* FIXME find a way to do this with a call to caml_make_free_blocks */ while (Wosize_bhsize (remain) > Max_wosize){ Hd_hp (hp) = Make_header (Max_wosize, 0, Caml_blue); #ifdef DEBUG @@ -353,7 +353,7 @@ { char **cp; - /* Never deallocate the first block, because caml_heap_start is both the + /* Never deallocate the first chunk, because caml_heap_start is both the first block and the base address for page numbers, and we don't want to shift the page table, it's too messy (see above). It will never happen anyway, because of the way compaction works. @@ -500,12 +500,14 @@ A block value [v] is a shared block if and only if [Is_in_heap (v)] is true. */ -/* [caml_initialize] never calls the GC, so you may call it while an block is +/* [caml_initialize] never calls the GC, so you may call it while a block is unfinished (i.e. just after a call to [caml_alloc_shr].) */ -void caml_initialize (value *fp, value val) +/* PR#6084 workaround: define it as a weak symbol */ +CAMLexport CAMLweakdef void caml_initialize (value *fp, value val) { + CAMLassert(Is_in_heap(fp)); *fp = val; - if (Is_block (val) && Is_young (val) && Is_in_heap (fp)){ + if (Is_block (val) && Is_young (val)) { if (caml_ref_table.ptr >= caml_ref_table.limit){ caml_realloc_ref_table (&caml_ref_table); } @@ -517,9 +519,54 @@ unless you are sure the value being overwritten is not a shared block and the value being written is not a young block. */ /* [caml_modify] never calls the GC. */ -void caml_modify (value *fp, value val) -{ - Modify (fp, val); +/* [caml_modify] can also be used to do assignment on data structures that are + in the minor heap instead of in the major heap. In this case, it + is a bit slower than simple assignment. + In particular, you can use [caml_modify] when you don't know whether the + block being changed is in the minor heap or the major heap. */ +/* PR#6084 workaround: define it as a weak symbol */ + +CAMLexport CAMLweakdef void caml_modify (value *fp, value val) +{ + /* The write barrier implemented by [caml_modify] checks for the + following two conditions and takes appropriate action: + 1- a pointer from the major heap to the minor heap is created + --> add [fp] to the remembered set + 2- a pointer from the major heap to the major heap is overwritten, + while the GC is in the marking phase + --> call [caml_darken] on the overwritten pointer so that the + major GC treats it as an additional root. + */ + value old; + + if (Is_young((value)fp)) { + /* The modified object resides in the minor heap. + Conditions 1 and 2 cannot occur. */ + *fp = val; + } else { + /* The modified object resides in the major heap. */ + CAMLassert(Is_in_heap(fp)); + old = *fp; + *fp = val; + if (Is_block(old)) { + /* If [old] is a pointer within the minor heap, we already + have a major->minor pointer and [fp] is already in the + remembered set. Conditions 1 and 2 cannot occur. */ + if (Is_young(old)) return; + /* Here, [old] can be a pointer within the major heap. + Check for condition 2. */ + if (caml_gc_phase == Phase_mark) caml_darken(old, NULL); + } + /* Check for condition 1. */ + if (Is_block(val) && Is_young(val)) { + /* Add [fp] to remembered set */ + if (caml_ref_table.ptr >= caml_ref_table.limit){ + CAMLassert (caml_ref_table.ptr == caml_ref_table.limit); + caml_realloc_ref_table (&caml_ref_table); + } + *caml_ref_table.ptr++ = fp; + } + } } CAMLexport void * caml_stat_alloc (asize_t sz) diff -Nru ocaml-3.12.1/byterun/memory.h ocaml-4.01.0/byterun/memory.h --- ocaml-3.12.1/byterun/memory.h 2008-12-03 18:09:09.000000000 +0000 +++ ocaml-4.01.0/byterun/memory.h 2013-06-01 07:43:45.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: memory.h 9153 2008-12-03 18:09:09Z doligez $ */ - /* Allocation macros and functions */ #ifndef CAML_MEMORY_H @@ -30,6 +28,11 @@ #include "misc.h" #include "mlvalues.h" +#ifdef __cplusplus +extern "C" { +#endif + + CAMLextern value caml_alloc_shr (mlsize_t, tag_t); CAMLextern void caml_adjust_gc_speed (mlsize_t, mlsize_t); CAMLextern void caml_alloc_dependent_memory (mlsize_t); @@ -102,7 +105,7 @@ CAMLassert ((tag_t) (tag) < 256); \ CAMLassert ((wosize) <= Max_young_wosize); \ caml_young_ptr -= Bhsize_wosize (wosize); \ - if (caml_young_ptr < caml_young_limit){ \ + if (caml_young_ptr < caml_young_start){ \ caml_young_ptr += Bhsize_wosize (wosize); \ Setup_for_gc; \ caml_minor_collection (); \ @@ -114,32 +117,9 @@ DEBUG_clear ((result), (wosize)); \ }while(0) -/* You must use [Modify] to change a field of an existing shared block, - unless you are sure the value being overwritten is not a shared block and - the value being written is not a young block. */ -/* [Modify] never calls the GC. */ -/* [Modify] can also be used to do assignment on data structures that are - not in the (major) heap. In this case, it is a bit slower than - simple assignment. - In particular, you can use [Modify] when you don't know whether the - block being changed is in the minor heap or the major heap. -*/ +/* Deprecated alias for [caml_modify] */ -#define Modify(fp, val) do{ \ - value _old_ = *(fp); \ - *(fp) = (val); \ - if (Is_in_heap (fp)){ \ - if (caml_gc_phase == Phase_mark) caml_darken (_old_, NULL); \ - if (Is_block (val) && Is_young (val) \ - && ! (Is_block (_old_) && Is_young (_old_))){ \ - if (caml_ref_table.ptr >= caml_ref_table.limit){ \ - CAMLassert (caml_ref_table.ptr == caml_ref_table.limit); \ - caml_realloc_ref_table (&caml_ref_table); \ - } \ - *caml_ref_table.ptr++ = (fp); \ - } \ - } \ -}while(0) +#define Modify(fp,val) caml_modify((fp), (val)) /* */ @@ -168,15 +148,15 @@ If you need local variables of type [value], declare them with one or more calls to the [CAMLlocal] macros at the beginning of the - function. Use [CAMLlocalN] (at the beginning of the function) to - declare an array of [value]s. + function, after the call to CAMLparam. Use [CAMLlocalN] (at the + beginning of the function) to declare an array of [value]s. Your function may raise an exception or return a [value] with the [CAMLreturn] macro. Its argument is simply the [value] returned by your function. Do NOT directly return a [value] with the [return] keyword. If your function returns void, use [CAMLreturn0]. - All the identifiers beginning with "caml__" are reserved by Caml. + All the identifiers beginning with "caml__" are reserved by OCaml. Do not use them for anything (local or global variables, struct or union tags, macros, etc.) */ @@ -209,7 +189,7 @@ CAMLxparamN (x, (size)) -#if defined (__GNUC__) && (__GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ > 7)) +#if defined(__GNUC__) && (__GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ > 7)) #define CAMLunused __attribute__ ((unused)) #else #define CAMLunused @@ -341,7 +321,7 @@ It must contain all values in C local variables and function parameters at the time the minor GC is called. Usage: - After initialising your local variables to legal Caml values, but before + After initialising your local variables to legal OCaml values, but before calling allocation functions, insert [Begin_roots_n(v1, ... vn)], where v1 ... vn are your variables of type [value] that you want to be updated across allocations. @@ -435,7 +415,7 @@ the value of this variable, it must do so by calling [caml_modify_generational_global_root]. The [value *] pointer passed to [caml_register_generational_global_root] must contain - a valid Caml value before the call. + a valid OCaml value before the call. In return for these constraints, scanning of memory roots during minor collection is made more efficient. */ @@ -456,4 +436,8 @@ CAMLextern void caml_modify_generational_global_root(value *r, value newval); +#ifdef __cplusplus +} +#endif + #endif /* CAML_MEMORY_H */ diff -Nru ocaml-3.12.1/byterun/meta.c ocaml-4.01.0/byterun/meta.c --- ocaml-3.12.1/byterun/meta.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/meta.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,10 +11,9 @@ /* */ /***********************************************************************/ -/* $Id: meta.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* Primitives for the toplevel */ +#include #include "alloc.h" #include "config.h" #include "fail.h" @@ -61,6 +60,17 @@ return clos; } +CAMLprim value caml_register_code_fragment(value prog, value len, value digest) +{ + struct code_fragment * cf = caml_stat_alloc(sizeof(struct code_fragment)); + cf->code_start = (char *) prog; + cf->code_end = (char *) prog + Long_val(len); + memcpy(cf->digest, String_val(digest), 16); + cf->digest_computed = 1; + caml_ext_table_add(&caml_code_fragments_table, cf); + return Val_unit; +} + CAMLprim value caml_realloc_global(value size) { mlsize_t requested_size, actual_size, i; diff -Nru ocaml-3.12.1/byterun/minor_gc.c ocaml-4.01.0/byterun/minor_gc.c --- ocaml-3.12.1/byterun/minor_gc.c 2008-07-28 12:03:55.000000000 +0000 +++ ocaml-4.01.0/byterun/minor_gc.c 2013-07-17 11:50:53.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: minor_gc.c 8954 2008-07-28 12:03:55Z doligez $ */ - #include #include "config.h" #include "fail.h" @@ -73,13 +71,14 @@ tbl->limit = tbl->threshold; } +/* size in bytes */ void caml_set_minor_heap_size (asize_t size) { char *new_heap; void *new_heap_base; - Assert (size >= Minor_heap_min); - Assert (size <= Minor_heap_max); + Assert (size >= Bsize_wsize(Minor_heap_min)); + Assert (size <= Bsize_wsize(Minor_heap_max)); Assert (size % sizeof (value) == 0); if (caml_young_ptr != caml_young_end) caml_minor_collection (); Assert (caml_young_ptr == caml_young_end); @@ -160,9 +159,14 @@ Assert (tag == Forward_tag); if (Is_block (f)){ - vv = Is_in_value_area(f); - if (vv) { + if (Is_young (f)){ + vv = 1; ft = Tag_val (Hd_val (f) == 0 ? Field (f, 0) : f); + }else{ + vv = Is_in_value_area(f); + if (vv){ + ft = Tag_val (f); + } } } if (!vv || ft == Forward_tag || ft == Lazy_tag || ft == Double_tag){ diff -Nru ocaml-3.12.1/byterun/minor_gc.h ocaml-4.01.0/byterun/minor_gc.h --- ocaml-3.12.1/byterun/minor_gc.h 2007-05-04 14:05:13.000000000 +0000 +++ ocaml-4.01.0/byterun/minor_gc.h 2013-07-17 11:50:53.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: minor_gc.h 8211 2007-05-04 14:05:13Z doligez $ */ - #ifndef CAML_MINOR_GC_H #define CAML_MINOR_GC_H @@ -39,7 +37,7 @@ (Assert (Is_block (val)), \ (addr)(val) < (addr)caml_young_end && (addr)(val) > (addr)caml_young_start) -extern void caml_set_minor_heap_size (asize_t); +extern void caml_set_minor_heap_size (asize_t); /* size in bytes */ extern void caml_empty_minor_heap (void); CAMLextern void caml_minor_collection (void); CAMLextern void garbage_collection (void); /* def in asmrun/signals.c */ diff -Nru ocaml-3.12.1/byterun/misc.c ocaml-4.01.0/byterun/misc.c --- ocaml-3.12.1/byterun/misc.c 2008-02-29 12:56:15.000000000 +0000 +++ ocaml-4.01.0/byterun/misc.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: misc.c 8822 2008-02-29 12:56:15Z doligez $ */ - #include #include "config.h" #include "misc.h" diff -Nru ocaml-3.12.1/byterun/misc.h ocaml-4.01.0/byterun/misc.h --- ocaml-3.12.1/byterun/misc.h 2008-02-29 12:56:15.000000000 +0000 +++ ocaml-4.01.0/byterun/misc.h 2013-08-01 08:12:41.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: misc.h 8822 2008-02-29 12:56:15Z doligez $ */ - /* Miscellaneous macros and variables. */ #ifndef CAML_MISC_H @@ -53,12 +51,21 @@ #define CAMLprim #define CAMLextern extern +/* Weak function definitions that can be overriden by external libs */ +/* Conservatively restricted to ELF and MacOSX platforms */ +#if defined(__GNUC__) && (defined (__ELF__) || defined(__APPLE__)) +#define CAMLweakdef __attribute__((weak)) +#else +#define CAMLweakdef +#endif + /* Assertions */ /* */ #ifdef DEBUG -#define CAMLassert(x) ((x) ? 0 : caml_failed_assert ( #x , __FILE__, __LINE__)) +#define CAMLassert(x) \ + ((x) ? (void) 0 : caml_failed_assert ( #x , __FILE__, __LINE__)) CAMLextern int caml_failed_assert (char *, char *, int); #else #define CAMLassert(x) ((void) 0) diff -Nru ocaml-3.12.1/byterun/mlvalues.h ocaml-4.01.0/byterun/mlvalues.h --- ocaml-3.12.1/byterun/mlvalues.h 2008-08-01 14:10:36.000000000 +0000 +++ ocaml-4.01.0/byterun/mlvalues.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: mlvalues.h 8970 2008-08-01 14:10:36Z xleroy $ */ - #ifndef CAML_MLVALUES_H #define CAML_MLVALUES_H @@ -22,6 +20,10 @@ #include "config.h" #include "misc.h" +#ifdef __cplusplus +extern "C" { +#endif + /* Definitions word: Four bytes on 32 and 16 bit architectures, @@ -245,6 +247,9 @@ double caml__temp_d = (d); \ Store_double_val((value)((double *) (v) + caml__temp_i), caml__temp_d); \ }while(0) +CAMLextern mlsize_t caml_array_length (value); /* size in items */ +CAMLextern int caml_is_double_array (value); /* 0 is false, 1 is true */ + /* Custom blocks. They contain a pointer to a "method suite" of functions (for finalization, comparison, hashing, etc) @@ -291,5 +296,9 @@ extern value caml_global_data; +#ifdef __cplusplus +} +#endif + #endif /* CAML_MLVALUES_H */ diff -Nru ocaml-3.12.1/byterun/obj.c ocaml-4.01.0/byterun/obj.c --- ocaml-3.12.1/byterun/obj.c 2010-01-25 11:55:30.000000000 +0000 +++ ocaml-4.01.0/byterun/obj.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: obj.c 9561 2010-01-25 11:55:30Z doligez $ */ - /* Operations on objects */ #include @@ -171,7 +169,7 @@ } /* The following functions are used in stdlib/lazy.ml. - They are not written in O'Caml because they must be atomic with respect + They are not written in OCaml because they must be atomic with respect to the GC. */ @@ -191,7 +189,7 @@ CAMLlocal1 (res); res = caml_alloc_small (1, Forward_tag); - Modify (&Field (res, 0), v); + Field (res, 0) = v; CAMLreturn (res); } diff -Nru ocaml-3.12.1/byterun/osdeps.h ocaml-4.01.0/byterun/osdeps.h --- ocaml-3.12.1/byterun/osdeps.h 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/osdeps.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: osdeps.h 9547 2010-01-22 12:48:24Z doligez $ */ - /* Operating system - specific stuff */ #ifndef CAML_OSDEPS_H diff -Nru ocaml-3.12.1/byterun/parsing.c ocaml-4.01.0/byterun/parsing.c --- ocaml-3.12.1/byterun/parsing.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/parsing.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: parsing.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* The PDA automaton for parsers generated by camlyacc */ #include @@ -125,7 +123,7 @@ state, token_name(tables->names_block, Tag_val(tok))); v = Field(tok, 0); if (Is_long(v)) - fprintf(stderr, "%ld", Long_val(v)); + fprintf(stderr, "%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val(v)); else if (Tag_val(v) == String_tag) fprintf(stderr, "%s", String_val(v)); else if (Tag_val(v) == Double_tag) diff -Nru ocaml-3.12.1/byterun/prims.h ocaml-4.01.0/byterun/prims.h --- ocaml-3.12.1/byterun/prims.h 2004-02-22 15:07:51.000000000 +0000 +++ ocaml-4.01.0/byterun/prims.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: prims.h 6130 2004-02-22 15:07:51Z xleroy $ */ - /* Interface with C primitives. */ #ifndef CAML_PRIMS_H diff -Nru ocaml-3.12.1/byterun/printexc.c ocaml-4.01.0/byterun/printexc.c --- ocaml-3.12.1/byterun/printexc.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/printexc.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: printexc.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* Print an uncaught exception and abort */ #include @@ -60,7 +58,8 @@ /* Check for exceptions in the style of Match_failure and Assert_failure */ if (Wosize_val(exn) == 2 && Is_block(Field(exn, 1)) && - Tag_val(Field(exn, 1)) == 0) { + Tag_val(Field(exn, 1)) == 0 && + caml_is_special_exception(Field(exn, 0))) { bucket = Field(exn, 1); start = 0; } else { @@ -72,7 +71,7 @@ if (i > start) add_string(&buf, ", "); v = Field(bucket, i); if (Is_long(v)) { - sprintf(intbuf, "%ld", Long_val(v)); + sprintf(intbuf, "%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val(v)); add_string(&buf, intbuf); } else if (Tag_val(v) == String_tag) { add_char(&buf, '"'); diff -Nru ocaml-3.12.1/byterun/printexc.h ocaml-4.01.0/byterun/printexc.h --- ocaml-3.12.1/byterun/printexc.h 2004-01-01 16:42:43.000000000 +0000 +++ ocaml-4.01.0/byterun/printexc.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: printexc.h 6045 2004-01-01 16:42:43Z doligez $ */ - #ifndef CAML_PRINTEXC_H #define CAML_PRINTEXC_H @@ -20,8 +18,16 @@ #include "misc.h" #include "mlvalues.h" +#ifdef __cplusplus +extern "C" { +#endif + + CAMLextern char * caml_format_exception (value); void caml_fatal_uncaught_exception (value) Noreturn; +#ifdef __cplusplus +} +#endif #endif /* CAML_PRINTEXC_H */ diff -Nru ocaml-3.12.1/byterun/reverse.h ocaml-4.01.0/byterun/reverse.h --- ocaml-3.12.1/byterun/reverse.h 2003-12-15 18:10:51.000000000 +0000 +++ ocaml-4.01.0/byterun/reverse.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: reverse.h 6021 2003-12-15 18:10:51Z doligez $ */ - /* Swap byte-order in 16, 32, and 64-bit integers or floats */ #ifndef CAML_REVERSE_H diff -Nru ocaml-3.12.1/byterun/roots.c ocaml-4.01.0/byterun/roots.c --- ocaml-3.12.1/byterun/roots.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/roots.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: roots.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* To walk the memory roots for garbage collection */ #include "finalise.h" diff -Nru ocaml-3.12.1/byterun/roots.h ocaml-4.01.0/byterun/roots.h --- ocaml-3.12.1/byterun/roots.h 2005-09-22 14:21:50.000000000 +0000 +++ ocaml-4.01.0/byterun/roots.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: roots.h 7064 2005-09-22 14:21:50Z xleroy $ */ - #ifndef CAML_ROOTS_H #define CAML_ROOTS_H diff -Nru ocaml-3.12.1/byterun/signals.c ocaml-4.01.0/byterun/signals.c --- ocaml-3.12.1/byterun/signals.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/signals.c 2013-05-14 15:48:50.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ /* */ @@ -11,11 +11,10 @@ /* */ /***********************************************************************/ -/* $Id: signals.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* Signal handling, code common to the bytecode and native systems */ #include +#include #include "alloc.h" #include "callback.h" #include "config.h" @@ -117,8 +116,12 @@ CAMLexport void caml_leave_blocking_section(void) { + int saved_errno; + /* Save the value of errno (PR#5982). */ + saved_errno = errno; caml_leave_blocking_section_hook (); caml_process_pending_signals(); + errno = saved_errno; } /* Execute a signal handler immediately */ diff -Nru ocaml-3.12.1/byterun/signals.h ocaml-4.01.0/byterun/signals.h --- ocaml-3.12.1/byterun/signals.h 2007-02-23 09:29:45.000000000 +0000 +++ ocaml-4.01.0/byterun/signals.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: signals.h 7904 2007-02-23 09:29:45Z xleroy $ */ - #ifndef CAML_SIGNALS_H #define CAML_SIGNALS_H @@ -22,6 +20,10 @@ #include "misc.h" #include "mlvalues.h" +#ifdef __cplusplus +extern "C" { +#endif + /* */ CAMLextern intnat volatile caml_signals_are_pending; CAMLextern intnat volatile caml_pending_signals[]; @@ -48,4 +50,8 @@ CAMLextern void (* volatile caml_async_action_hook)(void); /* */ +#ifdef __cplusplus +} +#endif + #endif /* CAML_SIGNALS_H */ diff -Nru ocaml-3.12.1/byterun/signals_byt.c ocaml-4.01.0/byterun/signals_byt.c --- ocaml-3.12.1/byterun/signals_byt.c 2007-02-23 09:29:45.000000000 +0000 +++ ocaml-4.01.0/byterun/signals_byt.c 2013-05-14 15:37:48.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ /* */ @@ -11,11 +11,10 @@ /* */ /***********************************************************************/ -/* $Id: signals_byt.c 7904 2007-02-23 09:29:45Z xleroy $ */ - /* Signal handling, code specific to the bytecode interpreter */ #include +#include #include "config.h" #include "memory.h" #include "osdeps.h" @@ -51,6 +50,9 @@ static void handle_signal(int signal_number) { + int saved_errno; + /* Save the value of errno (PR#5982). */ + saved_errno = errno; #if !defined(POSIX_SIGNALS) && !defined(BSD_SIGNALS) signal(signal_number, handle_signal); #endif @@ -60,7 +62,8 @@ caml_enter_blocking_section_hook(); }else{ caml_record_signal(signal_number); - } + } + errno = saved_errno; } int caml_set_signal_action(int signo, int action) diff -Nru ocaml-3.12.1/byterun/signals_machdep.h ocaml-4.01.0/byterun/signals_machdep.h --- ocaml-3.12.1/byterun/signals_machdep.h 2007-02-23 09:43:14.000000000 +0000 +++ ocaml-4.01.0/byterun/signals_machdep.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: signals_machdep.h 7905 2007-02-23 09:43:14Z xleroy $ */ - /* Processor-specific operation: atomic "read and clear" */ #ifndef CAML_SIGNALS_MACHDEP_H diff -Nru ocaml-3.12.1/byterun/stacks.c ocaml-4.01.0/byterun/stacks.c --- ocaml-3.12.1/byterun/stacks.c 2010-11-11 11:07:48.000000000 +0000 +++ ocaml-4.01.0/byterun/stacks.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: stacks.c 10793 2010-11-11 11:07:48Z xleroy $ */ - /* To initialize and resize the stacks */ #include diff -Nru ocaml-3.12.1/byterun/stacks.h ocaml-4.01.0/byterun/stacks.h --- ocaml-3.12.1/byterun/stacks.h 2010-04-27 07:55:08.000000000 +0000 +++ ocaml-4.01.0/byterun/stacks.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: stacks.h 10315 2010-04-27 07:55:08Z xleroy $ */ - /* structure of the stacks */ #ifndef CAML_STACKS_H diff -Nru ocaml-3.12.1/byterun/startup.c ocaml-4.01.0/byterun/startup.c --- ocaml-3.12.1/byterun/startup.c 2010-09-03 16:31:32.000000000 +0000 +++ ocaml-4.01.0/byterun/startup.c 2013-08-01 09:18:15.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: startup.c 10668 2010-09-03 16:31:32Z doligez $ */ - /* Start-up code */ #include @@ -75,7 +73,7 @@ for(i = 0; i < 256; i++) caml_atom_table[i] = Make_header(0, i, Caml_white); if (caml_page_table_add(In_static_data, caml_atom_table, caml_atom_table + 256) != 0) { - caml_fatal_error("Fatal error: not enough memory for the initial page table"); + caml_fatal_error("Fatal error: not enough memory for initial page table"); } } @@ -90,7 +88,8 @@ static int read_trailer(int fd, struct exec_trailer *trail) { - lseek(fd, (long) -TRAILER_SIZE, SEEK_END); + if (lseek(fd, (long) -TRAILER_SIZE, SEEK_END) == -1) + return BAD_BYTECODE; if (read(fd, (char *) trail, TRAILER_SIZE) < TRAILER_SIZE) return BAD_BYTECODE; fixup_endianness_trailer(&trail->num_sections); @@ -216,7 +215,7 @@ Algorithm: 1- If argument 0 is a valid byte-code file that does not start with #!, then we are in case 3 and we pass the same command line to the - Objective Caml program. + OCaml program. 2- In all other cases, we parse the command line as: (whatever) [options] bytecode args... and we strip "(whatever) [options]" from the command line. @@ -247,7 +246,7 @@ #endif case 'v': if (!strcmp (argv[i], "-version")){ - printf ("The Objective Caml runtime, version " OCAML_VERSION "\n"); + printf ("The OCaml runtime, version " OCAML_VERSION "\n"); exit (0); }else if (!strcmp (argv[i], "-vnum")){ printf (OCAML_VERSION "\n"); @@ -309,16 +308,20 @@ if (opt != NULL){ while (*opt != '\0'){ switch (*opt++){ - case 's': scanmult (opt, &minor_heap_init); break; - case 'i': scanmult (opt, &heap_chunk_init); break; + case 'a': scanmult (opt, &p); caml_set_allocation_policy (p); break; + case 'b': caml_record_backtrace(Val_true); break; case 'h': scanmult (opt, &heap_size_init); break; + case 'i': scanmult (opt, &heap_chunk_init); break; case 'l': scanmult (opt, &max_stack_init); break; case 'o': scanmult (opt, &percent_free_init); break; case 'O': scanmult (opt, &max_percent_free_init); break; - case 'v': scanmult (opt, &caml_verb_gc); break; - case 'b': caml_record_backtrace(Val_true); break; case 'p': caml_parser_trace = 1; break; - case 'a': scanmult (opt, &p); caml_set_allocation_policy (p); break; + /* case 'R': see stdlib/hashtbl.mli */ + case 's': scanmult (opt, &minor_heap_init); break; +#ifdef DEBUG + case 't': caml_trace_flag = 1; break; +#endif + case 'v': scanmult (opt, &caml_verb_gc); break; } } } @@ -330,6 +333,13 @@ extern void caml_signal_thread(void * lpParam); #endif +#ifdef _MSC_VER + +/* PR 4887: avoid crash box of windows runtime on some system calls */ +extern void caml_install_invalid_parameter_handler(); + +#endif + /* Main entry point when loading code from a file */ CAMLexport void caml_main(char **argv) @@ -347,6 +357,9 @@ /* Machine-dependent initialization of the floating-point hardware so that it behaves as much as possible as specified in IEEE */ caml_init_ieee_floats(); +#ifdef _MSC_VER + caml_install_invalid_parameter_handler(); +#endif caml_init_custom_operations(); caml_ext_table_init(&caml_shared_libs_path, 8); caml_external_raise = NULL; @@ -370,12 +383,12 @@ fd = caml_attempt_open(&exe_name, &trail, 1); switch(fd) { case FILE_NOT_FOUND: - caml_fatal_error_arg("Fatal error: cannot find file %s\n", argv[pos]); + caml_fatal_error_arg("Fatal error: cannot find file '%s'\n", argv[pos]); break; case BAD_BYTECODE: caml_fatal_error_arg( - "Fatal error: the file %s is not a bytecode executable file\n", - argv[pos]); + "Fatal error: the file '%s' is not a bytecode executable file\n", + exe_name); break; } } @@ -443,8 +456,15 @@ { value res; char* cds_file; + char * exe_name; +#ifdef __linux__ + static char proc_self_exe[256]; +#endif caml_init_ieee_floats(); +#ifdef _MSC_VER + caml_install_invalid_parameter_handler(); +#endif caml_init_custom_operations(); #ifdef DEBUG caml_verb_gc = 63; @@ -455,6 +475,11 @@ strcpy(caml_cds_file, cds_file); } parse_camlrunparam(); + exe_name = argv[0]; +#ifdef __linux__ + if (caml_executable_name(proc_self_exe, sizeof(proc_self_exe)) == 0) + exe_name = proc_self_exe; +#endif caml_external_raise = NULL; /* Initialize the abstract machine */ caml_init_gc (minor_heap_init, heap_size_init, heap_chunk_init, @@ -468,6 +493,7 @@ /* Load the code */ caml_start_code = code; caml_code_size = code_size; + caml_init_code_fragments(); if (caml_debugger_in_use) { int len, i; len = code_size / sizeof(opcode_t); @@ -489,7 +515,7 @@ caml_section_table_size = section_table_size; /* Initialize system libraries */ caml_init_exceptions(); - caml_sys_init("", argv); + caml_sys_init(exe_name, argv); /* Execute the program */ caml_debugger(PROGRAM_START); res = caml_interprete(caml_start_code, caml_code_size); diff -Nru ocaml-3.12.1/byterun/startup.h ocaml-4.01.0/byterun/startup.h --- ocaml-3.12.1/byterun/startup.h 2004-02-22 15:07:51.000000000 +0000 +++ ocaml-4.01.0/byterun/startup.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: startup.h 6130 2004-02-22 15:07:51Z xleroy $ */ - #ifndef CAML_STARTUP_H #define CAML_STARTUP_H diff -Nru ocaml-3.12.1/byterun/str.c ocaml-4.01.0/byterun/str.c --- ocaml-3.12.1/byterun/str.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/str.c 2012-12-19 16:22:30.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: str.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* Operations on strings */ #include @@ -65,6 +63,154 @@ return Val_unit; } +CAMLprim value caml_string_get16(value str, value index) +{ + intnat res; + unsigned char b1, b2; + intnat idx = Long_val(index); + if (idx < 0 || idx >= caml_string_length(str) - 1) caml_array_bound_error(); + b1 = Byte_u(str, idx); + b2 = Byte_u(str, idx + 1); +#ifdef ARCH_BIG_ENDIAN + res = b1 << 8 | b2; +#else + res = b2 << 8 | b1; +#endif + return Val_int(res); +} + +CAMLprim value caml_string_get32(value str, value index) +{ + intnat res; + unsigned char b1, b2, b3, b4; + intnat idx = Long_val(index); + if (idx < 0 || idx >= caml_string_length(str) - 3) caml_array_bound_error(); + b1 = Byte_u(str, idx); + b2 = Byte_u(str, idx + 1); + b3 = Byte_u(str, idx + 2); + b4 = Byte_u(str, idx + 3); +#ifdef ARCH_BIG_ENDIAN + res = b1 << 24 | b2 << 16 | b3 << 8 | b4; +#else + res = b4 << 24 | b3 << 16 | b2 << 8 | b1; +#endif + return caml_copy_int32(res); +} + +#ifdef ARCH_INT64_TYPE +#include "int64_native.h" +#else +#include "int64_emul.h" +#endif + +CAMLprim value caml_string_get64(value str, value index) +{ + uint32 reshi; + uint32 reslo; + unsigned char b1, b2, b3, b4, b5, b6, b7, b8; + intnat idx = Long_val(index); + if (idx < 0 || idx >= caml_string_length(str) - 7) caml_array_bound_error(); + b1 = Byte_u(str, idx); + b2 = Byte_u(str, idx + 1); + b3 = Byte_u(str, idx + 2); + b4 = Byte_u(str, idx + 3); + b5 = Byte_u(str, idx + 4); + b6 = Byte_u(str, idx + 5); + b7 = Byte_u(str, idx + 6); + b8 = Byte_u(str, idx + 7); +#ifdef ARCH_BIG_ENDIAN + reshi = b1 << 24 | b2 << 16 | b3 << 8 | b4; + reslo = b5 << 24 | b6 << 16 | b7 << 8 | b8; +#else + reshi = b8 << 24 | b7 << 16 | b6 << 8 | b5; + reslo = b4 << 24 | b3 << 16 | b2 << 8 | b1; +#endif + return caml_copy_int64(I64_literal(reshi,reslo)); +} + +CAMLprim value caml_string_set16(value str, value index, value newval) +{ + unsigned char b1, b2; + intnat val; + intnat idx = Long_val(index); + if (idx < 0 || idx >= caml_string_length(str) - 1) caml_array_bound_error(); + val = Long_val(newval); +#ifdef ARCH_BIG_ENDIAN + b1 = 0xFF & val >> 8; + b2 = 0xFF & val; +#else + b2 = 0xFF & val >> 8; + b1 = 0xFF & val; +#endif + Byte_u(str, idx) = b1; + Byte_u(str, idx + 1) = b2; + return Val_unit; +} + +CAMLprim value caml_string_set32(value str, value index, value newval) +{ + unsigned char b1, b2, b3, b4; + intnat val; + intnat idx = Long_val(index); + if (idx < 0 || idx >= caml_string_length(str) - 3) caml_array_bound_error(); + val = Int32_val(newval); +#ifdef ARCH_BIG_ENDIAN + b1 = 0xFF & val >> 24; + b2 = 0xFF & val >> 16; + b3 = 0xFF & val >> 8; + b4 = 0xFF & val; +#else + b4 = 0xFF & val >> 24; + b3 = 0xFF & val >> 16; + b2 = 0xFF & val >> 8; + b1 = 0xFF & val; +#endif + Byte_u(str, idx) = b1; + Byte_u(str, idx + 1) = b2; + Byte_u(str, idx + 2) = b3; + Byte_u(str, idx + 3) = b4; + return Val_unit; +} + +CAMLprim value caml_string_set64(value str, value index, value newval) +{ + unsigned char b1, b2, b3, b4, b5, b6, b7, b8; + uint32 lo,hi; + int64 val; + intnat idx = Long_val(index); + if (idx < 0 || idx >= caml_string_length(str) - 7) caml_array_bound_error(); + val = Int64_val(newval); + I64_split(val,hi,lo); +#ifdef ARCH_BIG_ENDIAN + b1 = 0xFF & hi >> 24; + b2 = 0xFF & hi >> 16; + b3 = 0xFF & hi >> 8; + b4 = 0xFF & hi; + b5 = 0xFF & lo >> 24; + b6 = 0xFF & lo >> 16; + b7 = 0xFF & lo >> 8; + b8 = 0xFF & lo; +#else + b8 = 0xFF & hi >> 24; + b7 = 0xFF & hi >> 16; + b6 = 0xFF & hi >> 8; + b5 = 0xFF & hi; + b4 = 0xFF & lo >> 24; + b3 = 0xFF & lo >> 16; + b2 = 0xFF & lo >> 8; + b1 = 0xFF & lo; +#endif + Byte_u(str, idx) = b1; + Byte_u(str, idx + 1) = b2; + Byte_u(str, idx + 2) = b3; + Byte_u(str, idx + 3) = b4; + Byte_u(str, idx + 4) = b5; + Byte_u(str, idx + 5) = b6; + Byte_u(str, idx + 6) = b7; + Byte_u(str, idx + 7) = b8; + return Val_unit; +} + CAMLprim value caml_string_equal(value s1, value s2) { mlsize_t sz1, sz2; diff -Nru ocaml-3.12.1/byterun/sys.c ocaml-4.01.0/byterun/sys.c --- ocaml-3.12.1/byterun/sys.c 2011-05-12 15:12:14.000000000 +0000 +++ ocaml-4.01.0/byterun/sys.c 2012-11-29 09:55:00.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: sys.c 11038 2011-05-12 15:12:14Z xleroy $ */ - /* Basic system calls */ #include @@ -51,10 +49,6 @@ #include "stacks.h" #include "sys.h" -#ifndef _WIN32 -extern int errno; -#endif - static char * error_message(void) { return strerror(errno); @@ -295,38 +289,94 @@ } #ifdef _WIN32 -extern intnat caml_win32_random_seed (void); +extern int caml_win32_random_seed (intnat data[16]); #endif CAMLprim value caml_sys_random_seed (value unit) { + intnat data[16]; + int n, i; + value res; #ifdef _WIN32 - return Val_long(caml_win32_random_seed()); + n = caml_win32_random_seed(data); #else - intnat seed; + int fd; + n = 0; + /* Try /dev/urandom first */ + fd = open("/dev/urandom", O_RDONLY, 0); + if (fd != -1) { + unsigned char buffer[12]; + int nread = read(fd, buffer, 12); + close(fd); + while (nread > 0) data[n++] = buffer[--nread]; + } + /* If the read from /dev/urandom fully succeeded, we now have 96 bits + of good random data and can stop here. Otherwise, complement + whatever we got (probably nothing) with some not-very-random data. */ + if (n < 12) { #ifdef HAS_GETTIMEOFDAY - struct timeval tv; - gettimeofday(&tv, NULL); - seed = tv.tv_sec ^ tv.tv_usec; + struct timeval tv; + gettimeofday(&tv, NULL); + data[n++] = tv.tv_usec; + data[n++] = tv.tv_sec; #else - seed = time (NULL); + data[n++] = time(NULL); #endif #ifdef HAS_UNISTD - seed ^= (getppid() << 16) ^ getpid(); + data[n++] = getpid(); + data[n++] = getppid(); +#endif + } #endif - return Val_long(seed); + /* Convert to an OCaml array of ints */ + res = caml_alloc_small(n, 0); + for (i = 0; i < n; i++) Field(res, i) = Val_long(data[i]); + return res; +} + +CAMLprim value caml_sys_const_big_endian(value unit) +{ +#ifdef ARCH_BIG_ENDIAN + return Val_true; +#else + return Val_false; #endif } +CAMLprim value caml_sys_const_word_size(value unit) +{ + return Val_long(8 * sizeof(value)); +} + +CAMLprim value caml_sys_const_ostype_unix(value unit) +{ + return Val_long(0 == strcmp(OCAML_OS_TYPE,"Unix")); +} + +CAMLprim value caml_sys_const_ostype_win32(value unit) +{ + return Val_long(0 == strcmp(OCAML_OS_TYPE,"Win32")); +} + +CAMLprim value caml_sys_const_ostype_cygwin(value unit) +{ + return Val_long(0 == strcmp(OCAML_OS_TYPE,"Cygwin")); +} + CAMLprim value caml_sys_get_config(value unit) { CAMLparam0 (); /* unit is unused */ CAMLlocal2 (result, ostype); ostype = caml_copy_string(OCAML_OS_TYPE); - result = caml_alloc_small (2, 0); + result = caml_alloc_small (3, 0); Field(result, 0) = ostype; Field(result, 1) = Val_long (8 * sizeof(value)); +#ifdef ARCH_BIG_ENDIAN + Field(result, 2) = Val_true; +#else + Field(result, 2) = Val_false; +#endif CAMLreturn (result); } diff -Nru ocaml-3.12.1/byterun/sys.h ocaml-4.01.0/byterun/sys.h --- ocaml-3.12.1/byterun/sys.h 2007-02-25 12:38:36.000000000 +0000 +++ ocaml-4.01.0/byterun/sys.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: sys.h 7919 2007-02-25 12:38:36Z xleroy $ */ - #ifndef CAML_SYS_H #define CAML_SYS_H diff -Nru ocaml-3.12.1/byterun/terminfo.c ocaml-4.01.0/byterun/terminfo.c --- ocaml-3.12.1/byterun/terminfo.c 2004-01-01 16:42:43.000000000 +0000 +++ ocaml-4.01.0/byterun/terminfo.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: terminfo.c 6045 2004-01-01 16:42:43Z doligez $ */ - /* Read and output terminal commands */ #include "config.h" diff -Nru ocaml-3.12.1/byterun/ui.h ocaml-4.01.0/byterun/ui.h --- ocaml-3.12.1/byterun/ui.h 2003-12-15 18:10:51.000000000 +0000 +++ ocaml-4.01.0/byterun/ui.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: ui.h 6021 2003-12-15 18:10:51Z doligez $ */ - /* Function declarations for non-Unix user interfaces */ #ifndef CAML_UI_H diff -Nru ocaml-3.12.1/byterun/unix.c ocaml-4.01.0/byterun/unix.c --- ocaml-3.12.1/byterun/unix.c 2010-07-02 08:44:04.000000000 +0000 +++ ocaml-4.01.0/byterun/unix.c 2013-03-09 22:38:52.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: unix.c 10613 2010-07-02 08:44:04Z frisch $ */ - /* Unix-specific stuff */ #define _GNU_SOURCE @@ -213,7 +211,8 @@ void * caml_dlopen(char * libname, int for_execution, int global) { - return dlopen(libname, RTLD_NOW | (global ? RTLD_GLOBAL : RTLD_LOCAL) | RTLD_NODELETE); + return dlopen(libname, RTLD_NOW | (global ? RTLD_GLOBAL : RTLD_LOCAL) + | RTLD_NODELETE); /* Could use RTLD_LAZY if for_execution == 0, but needs testing */ } diff -Nru ocaml-3.12.1/byterun/weak.c ocaml-4.01.0/byterun/weak.c --- ocaml-3.12.1/byterun/weak.c 2008-09-17 14:55:30.000000000 +0000 +++ ocaml-4.01.0/byterun/weak.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: weak.c 9028 2008-09-17 14:55:30Z doligez $ */ - /* Operations on weak arrays */ #include diff -Nru ocaml-3.12.1/byterun/weak.h ocaml-4.01.0/byterun/weak.h --- ocaml-3.12.1/byterun/weak.h 2004-01-01 16:42:43.000000000 +0000 +++ ocaml-4.01.0/byterun/weak.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: weak.h 6045 2004-01-01 16:42:43Z doligez $ */ - /* Operations on weak arrays */ #ifndef CAML_WEAK_H diff -Nru ocaml-3.12.1/byterun/win32.c ocaml-4.01.0/byterun/win32.c --- ocaml-3.12.1/byterun/win32.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/byterun/win32.c 2013-06-06 11:39:51.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: win32.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* Win32-specific stuff */ #include @@ -33,7 +31,7 @@ #include "signals.h" #include "sys.h" -#include "flexdll.h" +#include #ifndef S_ISREG #define S_ISREG(mode) (((mode) & S_IFMT) == S_IFREG) @@ -93,7 +91,7 @@ pathlen = strlen(name) + 1; if (pathlen < 256) pathlen = 256; while (1) { - fullname = stat_alloc(pathlen); + fullname = caml_stat_alloc(pathlen); retcode = SearchPath(NULL, /* use system search path */ name, ".exe", /* add .exe extension if needed */ @@ -107,7 +105,7 @@ break; } if (retcode < pathlen) break; - stat_free(fullname); + caml_stat_free(fullname); pathlen = retcode + 1; } return fullname; @@ -205,7 +203,6 @@ static void store_argument(char * arg); static void expand_argument(char * arg); static void expand_pattern(char * arg); -static void expand_diversion(char * filename); static void out_of_memory(void) { @@ -227,10 +224,6 @@ { char * p; - if (arg[0] == '@') { - expand_diversion(arg + 1); - return; - } for (p = arg; *p != 0; p++) { if (*p == '*' || *p == '?') { expand_pattern(arg); @@ -265,62 +258,6 @@ _findclose(handle); } -static void expand_diversion(char * filename) -{ - struct _stat stat; - int fd; - char * buf, * endbuf, * p, * q, * s; - int inquote; - - if (_stat(filename, &stat) == -1 || - (fd = _open(filename, O_RDONLY | O_BINARY, 0)) == -1) { - fprintf(stderr, "Cannot open file %s\n", filename); - exit(2); - } - buf = (char *) malloc(stat.st_size + 1); - if (buf == NULL) out_of_memory(); - _read(fd, buf, stat.st_size); - endbuf = buf + stat.st_size; - _close(fd); - for (p = buf; p < endbuf; /*nothing*/) { - /* Skip leading blanks */ - while (p < endbuf && isspace(*p)) p++; - if (p >= endbuf) break; - s = p; - /* Skip to end of argument, taking quotes into account */ - q = s; - inquote = 0; - while (p < endbuf) { - if (! inquote) { - if (isspace(*p)) break; - if (*p == '"') { inquote = 1; p++; continue; } - *q++ = *p++; - } else { - switch (*p) { - case '"': - inquote = 0; p++; continue; - case '\\': - if (p + 4 <= endbuf && strncmp(p, "\\\\\\\"", 4) == 0) { - p += 4; *q++ = '\\'; *q++ = '"'; continue; - } - if (p + 3 <= endbuf && strncmp(p, "\\\\\"", 3) == 0) { - p += 3; *q++ = '\\'; inquote = 0; continue; - } - if (p + 2 <= endbuf && p[1] == '"') { - p += 2; *q++ = '"'; continue; - } - /* fallthrough */ - default: - *q++ = *p++; - } - } - } - /* Delimit argument and expand it */ - *q++ = 0; - expand_argument(s); - p++; - } -} CAMLexport void caml_expand_command_line(int * argcp, char *** argvp) { @@ -528,18 +465,40 @@ /* Seeding of pseudo-random number generators */ -intnat caml_win32_random_seed (void) +int caml_win32_random_seed (intnat data[16]) +{ + /* For better randomness, consider: + http://msdn.microsoft.com/library/en-us/seccrypto/security/rtlgenrandom.asp + http://blogs.msdn.com/b/michael_howard/archive/2005/01/14/353379.aspx + */ + FILETIME t; + LARGE_INTEGER pc; + GetSystemTimeAsFileTime(&t); + QueryPerformanceCounter(&pc); /* PR#6032 */ + data[0] = t.dwLowDateTime; + data[1] = t.dwHighDateTime; + data[2] = GetCurrentProcessId(); + data[3] = pc.LowPart; + data[4] = pc.HighPart; + return 5; +} + + +#ifdef _MSC_VER + +static void invalid_parameter_handler(const wchar_t* expression, + const wchar_t* function, + const wchar_t* file, + unsigned int line, + uintptr_t pReserved) { - intnat seed; - SYSTEMTIME t; + /* no crash box */ +} - GetLocalTime(&t); - seed = t.wMonth; - seed = (seed << 5) ^ t.wDay; - seed = (seed << 4) ^ t.wHour; - seed = (seed << 5) ^ t.wMinute; - seed = (seed << 5) ^ t.wSecond; - seed = (seed << 9) ^ t.wMilliseconds; - seed ^= GetCurrentProcessId(); - return seed; + +void caml_install_invalid_parameter_handler() +{ + _set_invalid_parameter_handler(invalid_parameter_handler); } + +#endif diff -Nru ocaml-3.12.1/camlp4/.cvsignore ocaml-4.01.0/camlp4/.cvsignore --- ocaml-3.12.1/camlp4/.cvsignore 2007-02-07 11:41:36.000000000 +0000 +++ ocaml-4.01.0/camlp4/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -*.cm* -.cache-status -*.tmp.ml diff -Nru ocaml-3.12.1/camlp4/.ignore ocaml-4.01.0/camlp4/.ignore --- ocaml-3.12.1/camlp4/.ignore 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/camlp4/.ignore 2012-07-17 15:31:12.000000000 +0000 @@ -0,0 +1,2 @@ +.cache-status +*.tmp.ml diff -Nru ocaml-3.12.1/camlp4/CHANGES ocaml-4.01.0/camlp4/CHANGES --- ocaml-3.12.1/camlp4/CHANGES 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/camlp4/CHANGES 2012-08-02 08:17:59.000000000 +0000 @@ -497,7 +497,7 @@ - [Apr 17, 00] Added support for labels and variants. - [Mar 28, 00] Improved the grammars: now the rules starting with n terminals are locally LL(n), i.e. if any of the terminal fails, it is - not Error but just Failure. Allows to write the Ocaml syntax case: + not Error but just Failure. Allows to write the OCaml syntax case: ( operator ) ( expr ) with the problem of "( - )" as: @@ -518,7 +518,7 @@ - [Nov 23, 99] Changed the module name Config into Oconfig, because of conflict problem when applications want to link with the module Config of - Ocaml. + OCaml. Camlp4 Version 2.03: -------------------- @@ -534,9 +534,9 @@ - [Mar 9, 99] Added missing case in pr_depend.ml. * Other: - - [Sep 10, 99] Updated from current Ocaml new interfaces. + - [Sep 10, 99] Updated from current OCaml new interfaces. - [Jul 9, 99] Added stream type constraint in pa_oop.ml to reflect the same - change in Ocaml. + change in OCaml. - [Jun 24, 99] Added missing "constraint" construction in types - [Jun 15, 99] Added option -I for command "mkcamlp4". - [May 14, 99] Added man pages (links) for camlp4o, camlp4r, mkcamlp4, ocpp @@ -555,11 +555,11 @@ -------------------- * Parsing: - - [Feb 27, 99] Fixed 2 bugs, resulting of incorrect Ocaml parsing of the + - [Feb 27, 99] Fixed 2 bugs, resulting of incorrect OCaml parsing of the program example: "type t = F(B).t" - [Jan 30, 99] Fixed bug "pa_op.ml", could not parse "parser | [<>] -> ()". - [Jan 16, 99] Added "define" and "undef" in "pa_ifdef.cmo". - - [Dec 22, 98] Fixed precedence of "!=" in Ocaml syntax + - [Dec 22, 98] Fixed precedence of "!=" in OCaml syntax * Printing: - [Mar 4, 99] Added pr_depend.cmo for printing file dependencies. @@ -603,7 +603,7 @@ Missing features added * Added "lazy" statement (pa_r.cmo, pa_o.cmo, pr_r.cmo, pr_o.cmo) * Added print "assert" statement (pr_o.cmo, pr_r.cmo) -* Added parsing of infix operators like in Ocaml (e.g. |||) in pa_o.cmo +* Added parsing of infix operators like in OCaml (e.g. |||) in pa_o.cmo Compilation * Added "make scratch" @@ -636,20 +636,20 @@ -------------------- * Designation "righteous" has been renamed "revised". -* Added class and objects in Ocaml printing (pr_o.cmo), revised parsing +* Added class and objects in OCaml printing (pr_o.cmo), revised parsing (pa_r.cmo) and printing (pr_r.cmo). -* Fixed bug in Ocaml syntax: let _, x = 1, 2;; was refused. +* Fixed bug in OCaml syntax: let _, x = 1, 2;; was refused. Camlp4 Version 2.00--1: ----------------------- -* Added classes and objects in Ocaml syntax (pa_o.cmo) +* Added classes and objects in OCaml syntax (pa_o.cmo) * Fixed pr_r.cmo et pr_r.cmo which wrote on stdout, even when option -o Camlp4 Version 2.00--: ---------------------- -* Adapted for Ocaml 2.00. +* Adapted for OCaml 2.00. * No objects and classes in this version. * Added "let module" parsing and printing. @@ -672,7 +672,7 @@ * Added missing statement "include" in signature item in normal and righteous syntaxes * Changed precedence of ":=" and "<-" in normal syntax (pa_o et pr_o): - now before "or", like in Ocaml compiler. + now before "or", like in OCaml compiler. * Same change in righteous syntax, by symmetry. Camlp4 Version 1.07.2: @@ -684,8 +684,8 @@ * Added missing syntax (normal): type foo = bar = {......} * Added missing syntax (normal): did not accept separators before ending constructions (many of them). -* Fixed bug: "assert false" is now of type 'a, like in Ocaml. -* Fixed to match Ocaml feature: "\^" is "\^" in Ocaml, but just "^" in Camlp4. +* Fixed bug: "assert false" is now of type 'a, like in OCaml. +* Fixed to match OCaml feature: "\^" is "\^" in OCaml, but just "^" in Camlp4. * Fixed bug in Windows NT/95: problem in backslash before newlines in strings Grammars, EXTEND, DELETE_RULE @@ -736,7 +736,7 @@ * Environment variable CAMLP4LIB to change camlp4 library directory * Grammar: empty rules have a correct location instead of (-1, -1) * Compilation possible in Windows NT/95 -* String constants no more shared while parsing Ocaml +* String constants no more shared while parsing OCaml * Fixed bug in antiquotations in q_MLast.cmo (bad errors locations) * Fixed bug in antiquotations in q_MLast.cmo (EOI not checked) * Fixed bug in Plexer: could not create keywords with iso 8859 characters @@ -748,17 +748,17 @@ * Added iso 8859 uppercase characters for uidents in plexer.ml * Fixed bug factorization IDENT in grammars * Fixed bug pr_o.cmo was printing "declare" -* Fixed bug constructor arity in Ocaml syntax (pa_o.cmo). +* Fixed bug constructor arity in OCaml syntax (pa_o.cmo). * Changed "lazy" into "slazy". * Completed pa_ifdef.cmo. Camlp4 Version 1.06: -------------------- -* Adapted to Ocaml 1.06. -* Changed version number to match Ocaml's => 1.06 too. -* Deleted module Gstream, using Ocaml's Stream. -* Generate different AST for C(x,y) and C x y (change done in Ocaml's compiler) +* Adapted to OCaml 1.06. +* Changed version number to match OCaml's => 1.06 too. +* Deleted module Gstream, using OCaml's Stream. +* Generate different AST for C(x,y) and C x y (change done in OCaml's compiler) * No more message "Interrupted" in toplevel in case of syntax error. * Added flag to suppress warnings while extending grammars. * Completed some missing statements and declarations (objects) @@ -832,7 +832,7 @@ when the quotation is in a context of a pattern. These expanders, returning strings which are parsed afterwards, may work for some language syntax and/or language extensions used (e.g. may work for - Righteous syntax and not for Ocaml syntax). + Righteous syntax and not for OCaml syntax). - A new type of expander returning directly syntax trees. A pair of functions, for expressions and for patterns must be provided. These expanders are independant from the language syntax and/or @@ -842,12 +842,12 @@ been deleted; one can use "ctyp", "patt", and "expr" in position of pattern or expression. ---- Ocaml and Righteous syntaxes +--- OCaml and Righteous syntaxes * Fixed bug: "open Foo.Bar" was converted (pr_dump.cmo) into "open Bar.Foo" -* Corrected behavior different from Ocaml's: "^" and "@" were at the same - level than "=": now, like Ocaml, they have a separated right associative +* Corrected behavior different from OCaml's: "^" and "@" were at the same + level than "=": now, like OCaml, they have a separated right associative level. --- Grammars behavior @@ -881,7 +881,7 @@ * Possible creation of native code library (make opt) -* Ocaml and Righteous Syntax more complete +* OCaml and Righteous Syntax more complete * Added pa_ru.cmo for compiling sequences of type unit (Righteous) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Camlp4Ast.partial.ml ocaml-4.01.0/camlp4/Camlp4/Camlp4Ast.partial.ml --- ocaml-3.12.1/camlp4/Camlp4/Camlp4Ast.partial.ml 2011-02-02 14:25:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Camlp4Ast.partial.ml 2013-08-30 11:39:33.000000000 +0000 @@ -1,3 +1,20 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + +(* Note: when you modify these types you must increment + ast magic numbers defined in Camlp4_config.ml. *) + type loc = Loc.t and meta_bool = [ BTrue @@ -61,9 +78,12 @@ | TyObj of loc and ctyp and row_var_flag | TyOlb of loc and string and ctyp (* ?s:t *) | TyPol of loc and ctyp and ctyp (* ! t . t *) (* ! 'a . list 'a -> 'a *) + | TyTypePol of loc and ctyp and ctyp (* type t . t *) (* type a . list a -> a *) | TyQuo of loc and string (* 's *) | TyQuP of loc and string (* +'s *) | TyQuM of loc and string (* -'s *) + | TyAnP of loc (* +_ *) + | TyAnM of loc (* -_ *) | TyVrn of loc and string (* `s *) | TyRec of loc and ctyp (* { t } *) (* { foo : int ; bar : mutable string } *) | TyCol of loc and ctyp and ctyp (* t : t *) @@ -116,7 +136,8 @@ | PaTyc of loc and patt and ctyp (* (p : t) *) | PaTyp of loc and ident (* #i *) | PaVrn of loc and string (* `s *) - | PaLaz of loc and patt (* lazy p *) ] + | PaLaz of loc and patt (* lazy p *) + | PaMod of loc and string (* (module M) *) ] and expr = [ ExNil of loc | ExId of loc and ident (* i *) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Debug.ml ocaml-4.01.0/camlp4/Camlp4/Debug.ml --- ocaml-3.12.1/camlp4/Camlp4/Debug.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Debug.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -50,24 +50,15 @@ value formatter = let header = "camlp4-debug: " in - let normal s = - let rec self from accu = - try - let i = String.index_from s from '\n' - in self (i + 1) [String.sub s from (i - from + 1) :: accu] - with - [ Not_found -> [ String.sub s from (String.length s - from) :: accu ] ] - in String.concat header (List.rev (self 0 [])) in - let after_new_line str = header ^ normal str in - let f = ref after_new_line in - let output str chr = do { - output_string out_channel (f.val str); - output_char out_channel chr; - f.val := if chr = '\n' then after_new_line else normal; - } in + let at_bol = ref True in (make_formatter (fun buf pos len -> - let p = pred len in output (String.sub buf pos p) buf.[pos + p]) + for i = pos to pos + len - 1 do + if at_bol.val then output_string out_channel header else (); + let ch = buf.[i]; + output_char out_channel ch; + at_bol.val := ch = '\n'; + done) (fun () -> flush out_channel)); value printf section fmt = fprintf formatter ("%s: " ^^ fmt) section; diff -Nru ocaml-3.12.1/camlp4/Camlp4/Debug.mli ocaml-4.01.0/camlp4/Camlp4/Debug.mli --- ocaml-3.12.1/camlp4/Camlp4/Debug.mli 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Debug.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/ErrorHandler.ml ocaml-4.01.0/camlp4/Camlp4/ErrorHandler.ml --- ocaml-3.12.1/camlp4/Camlp4/ErrorHandler.ml 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/ErrorHandler.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -92,7 +92,7 @@ | x when x = Obj.string_tag -> "\"" ^ String.escaped (Obj.magic r : string) ^ "\"" | x when x = Obj.double_tag -> - string_of_float (Obj.magic r : float) + Camlp4_import.Oprint.float_repres (Obj.magic r : float) | x when x = Obj.abstract_tag -> opaque "abstract" | x when x = Obj.custom_tag -> diff -Nru ocaml-3.12.1/camlp4/Camlp4/ErrorHandler.mli ocaml-4.01.0/camlp4/Camlp4/ErrorHandler.mli --- ocaml-3.12.1/camlp4/Camlp4/ErrorHandler.mli 2007-02-07 10:09:29.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/ErrorHandler.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/OCamlInitSyntax.ml ocaml-4.01.0/camlp4/Camlp4/OCamlInitSyntax.ml --- ocaml-3.12.1/camlp4/Camlp4/OCamlInitSyntax.ml 2010-06-10 07:02:56.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/OCamlInitSyntax.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Options.ml ocaml-4.01.0/camlp4/Camlp4/Options.ml --- ocaml-3.12.1/camlp4/Camlp4/Options.ml 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Options.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Options.mli ocaml-4.01.0/camlp4/Camlp4/Options.mli --- ocaml-3.12.1/camlp4/Camlp4/Options.mli 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Options.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/PreCast.ml ocaml-4.01.0/camlp4/Camlp4/PreCast.ml --- ocaml-3.12.1/camlp4/Camlp4/PreCast.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/PreCast.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/PreCast.mli ocaml-4.01.0/camlp4/Camlp4/PreCast.mli --- ocaml-3.12.1/camlp4/Camlp4/PreCast.mli 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/PreCast.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Printers/DumpCamlp4Ast.ml ocaml-4.01.0/camlp4/Camlp4/Printers/DumpCamlp4Ast.ml --- ocaml-3.12.1/camlp4/Camlp4/Printers/DumpCamlp4Ast.ml 2008-10-27 14:03:57.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Printers/DumpCamlp4Ast.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Printers/DumpCamlp4Ast.mli ocaml-4.01.0/camlp4/Camlp4/Printers/DumpCamlp4Ast.mli --- ocaml-3.12.1/camlp4/Camlp4/Printers/DumpCamlp4Ast.mli 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Printers/DumpCamlp4Ast.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Printers/DumpOCamlAst.ml ocaml-4.01.0/camlp4/Camlp4/Printers/DumpOCamlAst.ml --- ocaml-3.12.1/camlp4/Camlp4/Printers/DumpOCamlAst.ml 2008-10-27 14:03:57.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Printers/DumpOCamlAst.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Printers/DumpOCamlAst.mli ocaml-4.01.0/camlp4/Camlp4/Printers/DumpOCamlAst.mli --- ocaml-3.12.1/camlp4/Camlp4/Printers/DumpOCamlAst.mli 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Printers/DumpOCamlAst.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Printers/Null.ml ocaml-4.01.0/camlp4/Camlp4/Printers/Null.ml --- ocaml-3.12.1/camlp4/Camlp4/Printers/Null.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Printers/Null.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Printers/Null.mli ocaml-4.01.0/camlp4/Camlp4/Printers/Null.mli --- ocaml-3.12.1/camlp4/Camlp4/Printers/Null.mli 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Printers/Null.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Printers/OCaml.ml ocaml-4.01.0/camlp4/Camlp4/Printers/OCaml.ml --- ocaml-3.12.1/camlp4/Camlp4/Printers/OCaml.ml 2011-02-03 13:08:28.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Printers/OCaml.ml 2013-08-30 11:39:33.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -106,10 +106,8 @@ "Cannot print %S this identifier does not respect OCaml lexing rules (%s)" str (Lexer.Error.to_string exn)) ]; - value ocaml_char = - fun - [ "'" -> "\\'" - | c -> c ]; + (* This is to be sure character literals are always escaped. *) + value ocaml_char x = Char.escaped (Struct.Token.Eval.char x); value rec get_expr_args a al = match a with @@ -303,16 +301,19 @@ | <:binding< $b1$ and $b2$ >> -> do { o#binding f b1; pp f o#andsep; o#binding f b2 } | <:binding< $p$ = $e$ >> -> - let (pl, e) = + let (pl, e') = match p with [ <:patt< ($_$ : $_$) >> -> ([], e) | _ -> expr_fun_args e ] in - match (p, e) with - [ (<:patt< $lid:_$ >>, <:expr< ($e$ : $t$) >>) -> + match (p, e') with + [ (<:patt< $lid:_$ >>, <:expr< ($e'$ : $t$) >>) -> pp f "%a :@ %a =@ %a" - (list o#fun_binding "@ ") [`patt p::pl] o#ctyp t o#expr e - | _ -> pp f "%a @[<0>%a=@]@ %a" o#simple_patt - p (list' o#fun_binding "" "@ ") pl o#expr e ] + (list o#fun_binding "@ ") [`patt p::pl] o#ctyp t o#expr e' + | (<:patt< $lid:_$ >>, _) -> + pp f "%a @[<0>%a=@]@ %a" o#simple_patt + p (list' o#fun_binding "" "@ ") pl o#expr e' + | _ -> + pp f "%a =@ %a" o#simple_patt p o#expr e ] | <:binding< $anti:s$ >> -> o#anti f s ]; method record_binding f bi = @@ -371,7 +372,12 @@ match Ast.list_of_ctyp t [] with [ [] -> () | ts -> - pp f "@[| %a@]" (list o#ctyp "@ | ") ts ]; + pp f "@[| %a@]" (list o#constructor_declaration "@ | ") ts ]; + + method private constructor_declaration f t = + match t with + [ <:ctyp< $t1$ : $t2$ -> $t3$ >> -> pp f "@[<2>%a :@ @[<2>%a@ ->@ %a@]@]" o#ctyp t1 o#constructor_type t2 o#ctyp t3 + | t -> o#ctyp f t ]; method string f = pp f "%s"; method quoted_string f = pp f "%S"; @@ -654,6 +660,7 @@ | <:patt< $id:i$ >> -> o#var_ident f i | <:patt< $anti:s$ >> -> o#anti f s | <:patt< _ >> -> pp f "_" + | <:patt< ( module $m$ ) >> -> pp f "(module %s)" m | <:patt< ( $tup:p$ ) >> -> pp f "@[<1>(%a)@]" o#patt3 p | <:patt< { $p$ } >> -> pp f "@[{@ %a@]@ }" o#patt p | <:patt< $str:s$ >> -> pp f "\"%s\"" s @@ -695,6 +702,8 @@ [ <:ctyp< $id:i$ >> -> o#ident f i | <:ctyp< $anti:s$ >> -> o#anti f s | <:ctyp< _ >> -> pp f "_" + | Ast.TyAnP _ -> pp f "+_" + | Ast.TyAnM _ -> pp f "-_" | <:ctyp< ~ $s$ : $t$ >> -> pp f "@[<2>%s:@ %a@]" s o#simple_ctyp t | <:ctyp< ? $s$ : $t$ >> -> pp f "@[<2>?%s:@ %a@]" s o#simple_ctyp t | <:ctyp< < > >> -> pp f "< >" @@ -758,6 +767,9 @@ | <:ctyp< ! $t1$ . $t2$ >> -> let (a, al) = get_ctyp_args t1 [] in pp f "@[<2>%a.@ %a@]" (list o#ctyp "@ ") [a::al] o#ctyp t2 + | Ast.TyTypePol (_,t1,t2) -> + let (a, al) = get_ctyp_args t1 [] in + pp f "@[<2>type %a.@ %a@]" (list o#ctyp "@ ") [a::al] o#ctyp t2 | <:ctyp< private $t$ >> -> pp f "@[private@ %a@]" o#simple_ctyp t | t -> o#simple_ctyp f t ]; @@ -878,7 +890,8 @@ let () = o#node f mt Ast.loc_of_module_type in match mt with [ <:module_type<>> -> assert False - | <:module_type< module type of $me$ >> -> pp f "@[<2>module type of@ %a@]" o#module_expr me + | <:module_type< module type of $me$ >> -> + pp f "@[<2>module type of@ %a@]" o#module_expr me | <:module_type< $id:i$ >> -> o#ident f i | <:module_type< $anti:s$ >> -> o#anti f s | <:module_type< functor ( $s$ : $mt1$ ) -> $mt2$ >> -> @@ -939,7 +952,7 @@ let () = o#node f ce Ast.loc_of_class_expr in match ce with [ <:class_expr< $ce$ $e$ >> -> - pp f "@[<2>%a@ %a@]" o#class_expr ce o#expr e + pp f "@[<2>%a@ %a@]" o#class_expr ce o#apply_expr e | <:class_expr< $id:i$ >> -> pp f "@[<2>%a@]" o#ident i | <:class_expr< $id:i$ [ $t$ ] >> -> diff -Nru ocaml-3.12.1/camlp4/Camlp4/Printers/OCaml.mli ocaml-4.01.0/camlp4/Camlp4/Printers/OCaml.mli --- ocaml-3.12.1/camlp4/Camlp4/Printers/OCaml.mli 2011-02-03 13:08:28.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Printers/OCaml.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Printers/OCamlr.ml ocaml-4.01.0/camlp4/Camlp4/Printers/OCamlr.ml --- ocaml-3.12.1/camlp4/Camlp4/Printers/OCamlr.ml 2011-02-07 16:07:54.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Printers/OCamlr.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -190,6 +190,8 @@ } | <:ctyp< $t1$ : mutable $t2$ >> -> pp f "@[%a :@ mutable %a@]" o#ctyp t1 o#ctyp t2 + | <:ctyp< $t1$ == $t2$ >> -> + pp f "@[<2>%a ==@ %a@]" o#simple_ctyp t1 o#ctyp t2 | t -> super#ctyp f t ]; method simple_ctyp f t = diff -Nru ocaml-3.12.1/camlp4/Camlp4/Printers/OCamlr.mli ocaml-4.01.0/camlp4/Camlp4/Printers/OCamlr.mli --- ocaml-3.12.1/camlp4/Camlp4/Printers/OCamlr.mli 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Printers/OCamlr.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Register.ml ocaml-4.01.0/camlp4/Camlp4/Register.ml --- ocaml-3.12.1/camlp4/Camlp4/Register.ml 2011-02-10 15:32:56.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Register.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Register.mli ocaml-4.01.0/camlp4/Camlp4/Register.mli --- ocaml-3.12.1/camlp4/Camlp4/Register.mli 2011-02-10 15:32:56.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Register.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Sig.ml ocaml-4.01.0/camlp4/Camlp4/Sig.ml --- ocaml-3.12.1/camlp4/Camlp4/Sig.ml 2010-06-16 07:13:59.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Sig.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -64,6 +64,16 @@ (** A signature for locations. *) module type Loc = sig + (** The type of locations. Note that, as for OCaml locations, + character numbers in locations refer to character numbers in the + parsed character stream, while line numbers refer to line + numbers in the source file. The source file and the parsed + character stream differ, for instance, when the parsed character + stream contains a line number directive. The line number + directive will only update the file-name field and the + line-number field of the position. It makes therefore no sense + to use character numbers with the source file if the sources + contain line number directives. *) type t; (** Return a start location for the given file name. @@ -96,7 +106,8 @@ stop_line, stop_bol, stop_off, ghost)]. *) value to_tuple : t -> (string * int * int * int * int * int * int * bool); - (** [merge loc1 loc2] Return a location that starts at [loc1] and end at [loc2]. *) + (** [merge loc1 loc2] Return a location that starts at [loc1] and end at + [loc2]. *) value merge : t -> t -> t; (** The stop pos becomes equal to the start pos. *) @@ -128,19 +139,19 @@ (** Return the line number of the ending of this location. *) value stop_line : t -> int; - (** Returns the number of characters from the begining of the file + (** Returns the number of characters from the begining of the stream to the begining of the line of location's begining. *) value start_bol : t -> int; - (** Returns the number of characters from the begining of the file + (** Returns the number of characters from the begining of the stream to the begining of the line of location's ending. *) value stop_bol : t -> int; - (** Returns the number of characters from the begining of the file + (** Returns the number of characters from the begining of the stream of the begining of this location. *) value start_off : t -> int; - (** Return the number of characters from the begining of the file + (** Return the number of characters from the begining of the stream of the ending of this location. *) value stop_off : t -> int; @@ -843,7 +854,7 @@ module Error : Error; end; -(** This signature describes tokens for the Objective Caml and the Revised +(** This signature describes tokens for the OCaml and the Revised syntax lexing rules. For some tokens the data constructor holds two representations with the evaluated one and the source one. For example the INT data constructor holds an integer and a string, this string can diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/.cvsignore ocaml-4.01.0/camlp4/Camlp4/Struct/.cvsignore --- ocaml-3.12.1/camlp4/Camlp4/Struct/.cvsignore 2007-02-07 11:41:36.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -Lexer.ml -Camlp4Ast.tmp.ml diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/.ignore ocaml-4.01.0/camlp4/Camlp4/Struct/.ignore --- ocaml-3.12.1/camlp4/Camlp4/Struct/.ignore 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/.ignore 2012-07-17 15:31:12.000000000 +0000 @@ -0,0 +1,2 @@ +Lexer.ml +Camlp4Ast.tmp.ml diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/AstFilters.ml ocaml-4.01.0/camlp4/Camlp4/Struct/AstFilters.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/AstFilters.ml 2008-10-27 13:45:09.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/AstFilters.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Camlp4Ast.mlast ocaml-4.01.0/camlp4/Camlp4/Struct/Camlp4Ast.mlast --- ocaml-3.12.1/camlp4/Camlp4/Struct/Camlp4Ast.mlast 2008-07-21 14:05:59.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Camlp4Ast.mlast 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -123,6 +123,7 @@ | <:patt< ~ $_$ : $p$ >> -> is_irrefut_patt p | <:patt< lazy $p$ >> -> is_irrefut_patt p | <:patt< $id:_$ >> -> False (* here one need to know the arity of constructors *) + | <:patt< (module $_$) >> -> True | <:patt< `$_$ >> | <:patt< $str:_$ >> | <:patt< $_$ .. $_$ >> | <:patt< $flo:_$ >> | <:patt< $nativeint:_$ >> | <:patt< $int64:_$ >> | <:patt< $int32:_$ >> | <:patt< $int:_$ >> | <:patt< $chr:_$ >> | diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml ocaml-4.01.0/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml 2011-02-02 14:25:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml 2013-08-30 11:39:33.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -57,6 +57,8 @@ value mkloc = Loc.to_ocaml_location; value mkghloc loc = Loc.to_ocaml_location (Loc.ghostify loc); + value with_loc txt loc = Camlp4_import.Location.mkloc txt (mkloc loc); + value mktyp loc d = {ptyp_desc = d; ptyp_loc = mkloc loc}; value mkpat loc d = {ppat_desc = d; ppat_loc = mkloc loc}; value mkghpat loc d = {ppat_desc = d; ppat_loc = mkghloc loc}; @@ -67,7 +69,10 @@ value mkstr loc d = {pstr_desc = d; pstr_loc = mkloc loc}; value mkfield loc d = {pfield_desc = d; pfield_loc = mkloc loc}; value mkcty loc d = {pcty_desc = d; pcty_loc = mkloc loc}; - value mkpcl loc d = {pcl_desc = d; pcl_loc = mkloc loc}; + value mkcl loc d = {pcl_desc = d; pcl_loc = mkloc loc}; + value mkcf loc d = { pcf_desc = d; pcf_loc = mkloc loc; }; + value mkctf loc d = { pctf_desc = d; pctf_loc = mkloc loc; }; + value mkpolytype t = match t.ptyp_desc with [ Ptyp_poly _ _ -> t @@ -85,6 +90,9 @@ | _ -> assert False ]; value lident s = Lident s; + value lident_with_loc s loc = with_loc (Lident s) loc; + + value ldot l s = Ldot l s; value lapply l s = Lapply l s; @@ -106,17 +114,17 @@ } ; - value array_function str name = + value array_function_no_loc str name = ldot (lident str) (if Camlp4_config.unsafe.val then "unsafe_" ^ name else name) ; - + value array_function loc str name = with_loc (array_function_no_loc str name) loc; value mkrf = fun [ <:rec_flag< rec >> -> Recursive | <:rec_flag<>> -> Nonrecursive | _ -> assert False ]; - value mkli s = loop lident + value mkli sloc s list = with_loc (loop lident list) sloc where rec loop f = fun [ [i :: il] -> loop (ldot (f i)) il @@ -133,7 +141,9 @@ let rec self i acc = match i with - [ <:ident< $i1$.$i2$ >> -> + [ <:ident< $lid:"*predef*"$.$lid:"option"$ >> -> + (ldot (lident "*predef*") "option", `lident) + | <:ident< $i1$.$i2$ >> -> self i2 (Some (self i1 acc)) | <:ident< $i1$ $i2$ >> -> let i' = Lapply (fst (self i1 None)) (fst (self i2 None)) in @@ -159,18 +169,20 @@ | _ -> error (loc_of_ident i) "invalid long identifier" ] in self i None; - value ident ?conv_lid i = fst (ident_tag ?conv_lid i); - - value long_lident msg i = - match ident_tag i with - [ (i, `lident) -> i - | _ -> error (loc_of_ident i) msg ] + value ident_noloc ?conv_lid i = fst (ident_tag ?conv_lid i); + value ident ?conv_lid i = + with_loc (ident_noloc ?conv_lid i) (loc_of_ident i); + + value long_lident msg id = + match ident_tag id with + [ (i, `lident) -> with_loc i (loc_of_ident id) + | _ -> error (loc_of_ident id) msg ] ; value long_type_ident = long_lident "invalid long identifier type"; value long_class_ident = long_lident "invalid class name"; - value long_uident ?(conv_con = fun x -> x) i = + value long_uident_noloc ?(conv_con = fun x -> x) i = match ident_tag i with [ (Ldot i s, `uident) -> ldot i (conv_con s) | (Lident s, `uident) -> lident (conv_con s) @@ -178,9 +190,12 @@ | _ -> error (loc_of_ident i) "uppercase identifier expected" ] ; + value long_uident ?conv_con i = + with_loc (long_uident_noloc ?conv_con i) (loc_of_ident i); + value rec ctyp_long_id_prefix t = match t with - [ <:ctyp< $id:i$ >> -> ident i + [ <:ctyp< $id:i$ >> -> ident_noloc i | <:ctyp< $m1$ $m2$ >> -> let li1 = ctyp_long_id_prefix m1 in let li2 = ctyp_long_id_prefix m2 in @@ -204,6 +219,9 @@ | <:ctyp< '$s$ >> -> [s] | _ -> assert False ]; + value predef_option loc = + TyId (loc, IdAcc (loc, IdLid (loc, "*predef*"), IdLid (loc, "option"))); + value rec ctyp = fun [ TyId loc i -> @@ -226,7 +244,7 @@ | TyArr loc (TyLab _ lab t1) t2 -> mktyp loc (Ptyp_arrow lab (ctyp t1) (ctyp t2)) | TyArr loc (TyOlb loc1 lab t1) t2 -> - let t1 = TyApp loc1 <:ctyp@loc1< option >> t1 in + let t1 = TyApp loc1 (predef_option loc1) t1 in mktyp loc (Ptyp_arrow ("?" ^ lab) (ctyp t1) (ctyp t2)) | TyArr loc t1 t2 -> mktyp loc (Ptyp_arrow "" (ctyp t1) (ctyp t2)) | <:ctyp@loc< < $fl$ > >> -> mktyp loc (Ptyp_object (meth_list fl [])) @@ -261,6 +279,7 @@ | TyAnt loc _ -> error loc "antiquotation not allowed here" | TyOfAmp _ _ _ |TyAmp _ _ _ |TySta _ _ _ | TyCom _ _ _ |TyVrn _ _ |TyQuM _ _ |TyQuP _ _ |TyDcl _ _ _ _ _ | + TyAnP _ | TyAnM _ | TyTypePol _ _ _ | TyObj _ _ (RvAnt _) | TyNil _ | TyTup _ _ -> assert False ] and row_field = fun @@ -285,8 +304,8 @@ and package_type_constraints wc acc = match wc with [ <:with_constr<>> -> acc - | <:with_constr< type $lid:id$ = $ct$ >> -> - [(id, ctyp ct) :: acc] + | <:with_constr< type $id:id$ = $ct$ >> -> + [(ident id, ctyp ct) :: acc] | <:with_constr< $wc1$ and $wc2$ >> -> package_type_constraints wc1 (package_type_constraints wc2 acc) | _ -> error (loc_of_with_constr wc) "unexpected `with constraint' for a package type" ] @@ -312,23 +331,32 @@ | _ -> assert False ]; value mktrecord = fun - [ <:ctyp@loc< $lid:s$ : mutable $t$ >> -> - (s, Mutable, mkpolytype (ctyp t), mkloc loc) - | <:ctyp@loc< $lid:s$ : $t$ >> -> - (s, Immutable, mkpolytype (ctyp t), mkloc loc) + [ <:ctyp@loc< $id:(<:ident@sloc< $lid:s$ >>)$ : mutable $t$ >> -> + (with_loc s sloc, Mutable, mkpolytype (ctyp t), mkloc loc) + | <:ctyp@loc< $id:(<:ident@sloc< $lid:s$ >>)$ : $t$ >> -> + (with_loc s sloc, Immutable, mkpolytype (ctyp t), mkloc loc) | _ -> assert False (*FIXME*) ]; value mkvariant = fun - [ <:ctyp@loc< $uid:s$ >> -> (conv_con s, [], mkloc loc) - | <:ctyp@loc< $uid:s$ of $t$ >> -> - (conv_con s, List.map ctyp (list_of_ctyp t []), mkloc loc) + [ <:ctyp@loc< $id:(<:ident@sloc< $uid:s$ >>)$ >> -> + (with_loc (conv_con s) sloc, [], None, mkloc loc) + | <:ctyp@loc< $id:(<:ident@sloc< $uid:s$ >>)$ of $t$ >> -> + (with_loc (conv_con s) sloc, List.map ctyp (list_of_ctyp t []), None, mkloc loc) + | <:ctyp@loc< $id:(<:ident@sloc< $uid:s$ >>)$ : ($t$ -> $u$) >> -> + (with_loc (conv_con s) sloc, List.map ctyp (list_of_ctyp t []), Some (ctyp u), mkloc loc) + | <:ctyp@loc< $id:(<:ident@sloc< $uid:s$ >>)$ : $t$ >> -> + (with_loc (conv_con s) sloc, [], Some (ctyp t), mkloc loc) + | _ -> assert False (*FIXME*) ]; value rec type_decl tl cl loc m pflag = fun [ <:ctyp< $t1$ == $t2$ >> -> type_decl tl cl loc (Some (ctyp t1)) pflag t2 - | <:ctyp< private $t$ >> -> - type_decl tl cl loc m True t + | <:ctyp@_loc< private $t$ >> -> + if pflag then + error _loc "multiple private keyword used, use only one instead" + else + type_decl tl cl loc m True t | <:ctyp< { $t$ } >> -> mktype loc tl cl (Ptype_record (List.map mktrecord (list_of_ctyp t []))) (mkprivate' pflag) m @@ -346,9 +374,9 @@ mktype loc tl cl Ptype_abstract (mkprivate' pflag) m ] ; - value type_decl tl cl t = type_decl tl cl (loc_of_ctyp t) None False t; + value type_decl tl cl t loc = type_decl tl cl loc None False t; - value mkvalue_desc t p = {pval_type = ctyp t; pval_prim = p}; + value mkvalue_desc loc t p = {pval_type = ctyp t; pval_prim = p; pval_loc = mkloc loc}; value rec list_of_meta_list = fun @@ -381,19 +409,30 @@ | <:ctyp< '$s$ >> -> [(s, (False, False)) :: acc] | _ -> assert False ]; + value rec optional_type_parameters t acc = + match t with + [ <:ctyp< $t1$ $t2$ >> -> optional_type_parameters t1 (optional_type_parameters t2 acc) + | <:ctyp@loc< +'$s$ >> -> [(Some (with_loc s loc), (True, False)) :: acc] + | Ast.TyAnP _loc -> [(None, (True, False)) :: acc] + | <:ctyp@loc< -'$s$ >> -> [(Some (with_loc s loc), (False, True)) :: acc] + | Ast.TyAnM _loc -> [(None, (False, True)) :: acc] + | <:ctyp@loc< '$s$ >> -> [(Some (with_loc s loc), (False, False)) :: acc] + | Ast.TyAny _loc -> [(None, (False, False)) :: acc] + | _ -> assert False ]; + value rec class_parameters t acc = match t with [ <:ctyp< $t1$, $t2$ >> -> class_parameters t1 (class_parameters t2 acc) - | <:ctyp< +'$s$ >> -> [(s, (True, False)) :: acc] - | <:ctyp< -'$s$ >> -> [(s, (False, True)) :: acc] - | <:ctyp< '$s$ >> -> [(s, (False, False)) :: acc] + | <:ctyp@loc< +'$s$ >> -> [(with_loc s loc, (True, False)) :: acc] + | <:ctyp@loc< -'$s$ >> -> [(with_loc s loc, (False, True)) :: acc] + | <:ctyp@loc< '$s$ >> -> [(with_loc s loc, (False, False)) :: acc] | _ -> assert False ]; value rec type_parameters_and_type_name t acc = match t with [ <:ctyp< $t1$ $t2$ >> -> type_parameters_and_type_name t1 - (type_parameters t2 acc) + (optional_type_parameters t2 acc) | <:ctyp< $id:i$ >> -> (ident i, acc) | _ -> assert False ]; @@ -448,7 +487,8 @@ value rec patt = fun - [ <:patt@loc< $lid:s$ >> -> mkpat loc (Ppat_var s) + [ <:patt@loc< $id:(<:ident@sloc< $lid:s$ >>)$ >> -> + mkpat loc (Ppat_var (with_loc s sloc)) | <:patt@loc< $id:i$ >> -> let p = Ppat_construct (long_uident ~conv_con i) None (constructors_arity ()) @@ -456,15 +496,15 @@ | PaAli loc p1 p2 -> let (p, i) = match (p1, p2) with - [ (p, <:patt< $lid:s$ >>) -> (p, s) - | (<:patt< $lid:s$ >>, p) -> (p, s) + [ (p, <:patt< $id:(<:ident@sloc< $lid:s$ >>)$ >>) -> (p, with_loc s sloc) + | (<:patt< $id:(<:ident@sloc< $lid:s$ >>)$ >>, p) -> (p, with_loc s sloc) | _ -> error loc "invalid alias pattern" ] in mkpat loc (Ppat_alias (patt p) i) | PaAnt loc _ -> error loc "antiquotation not allowed here" | PaAny loc -> mkpat loc Ppat_any - | <:patt@loc< $uid:s$ ($tup:<:patt@loc_any< _ >>$) >> -> - mkpat loc (Ppat_construct (lident (conv_con s)) + | <:patt@loc< $id:(<:ident@sloc< $uid:s$ >>)$ ($tup:<:patt@loc_any< _ >>$) >> -> + mkpat loc (Ppat_construct (lident_with_loc (conv_con s) sloc) (Some (mkpat loc_any Ppat_any)) False) | PaApp loc _ _ as f -> let (f, al) = patt_fa [] f in @@ -536,8 +576,9 @@ | <:patt@loc< ($tup:_$) >> -> error loc "singleton tuple pattern" | PaTyc loc p t -> mkpat loc (Ppat_constraint (patt p) (ctyp t)) | PaTyp loc i -> mkpat loc (Ppat_type (long_type_ident i)) - | PaVrn loc s -> mkpat loc (Ppat_variant s None) + | PaVrn loc s -> mkpat loc (Ppat_variant (conv_con s) None) | PaLaz loc p -> mkpat loc (Ppat_lazy (patt p)) + | PaMod loc m -> mkpat loc (Ppat_unpack (with_loc m loc)) | PaEq _ _ _ | PaSem _ _ _ | PaCom _ _ _ | PaNil _ as p -> error (loc_of_patt p) "invalid pattern" ] and mklabpat = @@ -589,19 +630,68 @@ [ <:ctyp<>> -> acc | t -> list_of_ctyp t acc ]; +value varify_constructors var_names = + let rec loop t = + let desc = + match t.ptyp_desc with + [ + Ptyp_any -> Ptyp_any + | Ptyp_var x -> Ptyp_var x + | Ptyp_arrow label core_type core_type' -> + Ptyp_arrow label (loop core_type) (loop core_type') + | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) + | Ptyp_constr ({ txt = Lident s }) [] when List.mem s var_names -> + Ptyp_var ("&" ^ s) + | Ptyp_constr longident lst -> + Ptyp_constr longident (List.map loop lst) + | Ptyp_object lst -> + Ptyp_object (List.map loop_core_field lst) + | Ptyp_class longident lst lbl_list -> + Ptyp_class (longident, List.map loop lst, lbl_list) + | Ptyp_alias core_type string -> + Ptyp_alias(loop core_type, string) + | Ptyp_variant row_field_list flag lbl_lst_option -> + Ptyp_variant(List.map loop_row_field row_field_list, flag, lbl_lst_option) + | Ptyp_poly string_lst core_type -> + Ptyp_poly(string_lst, loop core_type) + | Ptyp_package longident lst -> + Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst) +] + in + {(t) with ptyp_desc = desc} + and loop_core_field t = + let desc = + match t.pfield_desc with + [ Pfield(n,typ) -> + Pfield(n,loop typ) + | Pfield_var -> + Pfield_var] + in + { (t) with pfield_desc=desc} + and loop_row_field x = + match x with + [ Rtag(label,flag,lst) -> + Rtag(label,flag,List.map loop lst) + | Rinherit t -> + Rinherit (loop t) ] + in + loop; + + + value rec expr = fun [ <:expr@loc< $x$.val >> -> mkexp loc - (Pexp_apply (mkexp loc (Pexp_ident (Lident "!"))) [("", expr x)]) + (Pexp_apply (mkexp loc (Pexp_ident (lident_with_loc "!" loc))) [("", expr x)]) | ExAcc loc _ _ | <:expr@loc< $id:<:ident< $_$ . $_$ >>$ >> as e -> let (e, l) = match sep_expr_acc [] e with - [ [(loc, ml, <:expr< $uid:s$ >>) :: l] -> + [ [(loc, ml, <:expr@sloc< $uid:s$ >>) :: l] -> let ca = constructors_arity () in - (mkexp loc (Pexp_construct (mkli (conv_con s) ml) None ca), l) - | [(loc, ml, <:expr< $lid:s$ >>) :: l] -> - (mkexp loc (Pexp_ident (mkli s ml)), l) + (mkexp loc (Pexp_construct (mkli sloc (conv_con s) ml) None ca), l) + | [(loc, ml, <:expr@sloc< $lid:s$ >>) :: l] -> + (mkexp loc (Pexp_ident (mkli sloc s ml)), l) | [(_, [], e) :: l] -> (expr e, l) | _ -> error loc "bad ast in expression" ] in @@ -609,9 +699,9 @@ List.fold_left (fun (loc_bp, e1) (loc_ep, ml, e2) -> match e2 with - [ <:expr< $lid:s$ >> -> + [ <:expr@sloc< $lid:s$ >> -> let loc = Loc.merge loc_bp loc_ep - in (loc, mkexp loc (Pexp_field e1 (mkli (conv_lab s) ml))) + in (loc, mkexp loc (Pexp_field e1 (mkli sloc (conv_lab s) ml))) | _ -> error (loc_of_expr e2) "lowercase identifier expected" ]) (loc, e) l in @@ -645,7 +735,7 @@ | _ -> mkexp loc (Pexp_apply (expr f) al) ] | ExAre loc e1 e2 -> mkexp loc - (Pexp_apply (mkexp loc (Pexp_ident (array_function "Array" "get"))) + (Pexp_apply (mkexp loc (Pexp_ident (array_function loc "Array" "get"))) [("", expr e1); ("", expr e2)]) | ExArr loc e -> mkexp loc (Pexp_array (List.map expr (list_of_expr e []))) | ExAsf loc -> mkexp loc Pexp_assertfalse @@ -653,19 +743,19 @@ let e = match e with [ <:expr@loc< $x$.val >> -> - Pexp_apply (mkexp loc (Pexp_ident (Lident ":="))) + Pexp_apply (mkexp loc (Pexp_ident (lident_with_loc ":=" loc))) [("", expr x); ("", expr v)] | ExAcc loc _ _ -> match (expr e).pexp_desc with [ Pexp_field e lab -> Pexp_setfield e lab (expr v) | _ -> error loc "bad record access" ] - | ExAre _ e1 e2 -> - Pexp_apply (mkexp loc (Pexp_ident (array_function "Array" "set"))) + | ExAre loc e1 e2 -> + Pexp_apply (mkexp loc (Pexp_ident (array_function loc "Array" "set"))) [("", expr e1); ("", expr e2); ("", expr v)] - | <:expr< $lid:lab$ >> -> Pexp_setinstvar lab (expr v) - | ExSte _ e1 e2 -> + | <:expr< $id:(<:ident@lloc< $lid:lab$ >>)$ >> -> Pexp_setinstvar (with_loc lab lloc) (expr v) + | ExSte loc e1 e2 -> Pexp_apply - (mkexp loc (Pexp_ident (array_function "String" "set"))) + (mkexp loc (Pexp_ident (array_function loc "String" "set"))) [("", expr e1); ("", expr e2); ("", expr v)] | _ -> error loc "bad left part of assignment" ] in @@ -682,7 +772,7 @@ | ExFlo loc s -> mkexp loc (Pexp_constant (Const_float (remove_underscores s))) | ExFor loc i e1 e2 df el -> let e3 = ExSeq loc el in - mkexp loc (Pexp_for i (expr e1) (expr e2) (mkdirection df) (expr e3)) + mkexp loc (Pexp_for (with_loc i loc) (expr e1) (expr e2) (mkdirection df) (expr e3)) | <:expr@loc< fun [ $PaLab _ lab po$ when $w$ -> $e$ ] >> -> mkexp loc (Pexp_function lab None @@ -718,7 +808,7 @@ | ExLaz loc e -> mkexp loc (Pexp_lazy (expr e)) | ExLet loc rf bi e -> mkexp loc (Pexp_let (mkrf rf) (binding bi []) (expr e)) - | ExLmd loc i me e -> mkexp loc (Pexp_letmodule i (module_expr me) (expr e)) + | ExLmd loc i me e -> mkexp loc (Pexp_letmodule (with_loc i loc) (module_expr me) (expr e)) | ExMat loc e a -> mkexp loc (Pexp_match (expr e) (match_case a [])) | ExNew loc id -> mkexp loc (Pexp_new (long_type_ident id)) | ExObj loc po cfl -> @@ -728,7 +818,7 @@ | p -> p ] in let cil = class_str_item cfl [] in - mkexp loc (Pexp_object (patt p, cil)) + mkexp loc (Pexp_object { pcstr_pat = patt p; pcstr_fields = cil }) | ExOlb loc _ _ -> error loc "labeled expression not allowed here" | ExOvr loc iel -> mkexp loc (Pexp_override (mkideexp iel [])) | ExRec loc lel eo -> @@ -753,7 +843,7 @@ | ExSnd loc e s -> mkexp loc (Pexp_send (expr e) s) | ExSte loc e1 e2 -> mkexp loc - (Pexp_apply (mkexp loc (Pexp_ident (array_function "String" "get"))) + (Pexp_apply (mkexp loc (Pexp_ident (array_function loc "String" "get"))) [("", expr e1); ("", expr e2)]) | ExStr loc s -> mkexp loc (Pexp_constant (Const_string (string_of_string_token loc s))) @@ -763,22 +853,23 @@ | <:expr@loc< ($tup:_$) >> -> error loc "singleton tuple" | ExTyc loc e t -> mkexp loc (Pexp_constraint (expr e) (Some (ctyp t)) None) | <:expr@loc< () >> -> - mkexp loc (Pexp_construct (lident "()") None True) + mkexp loc (Pexp_construct (lident_with_loc "()" loc) None True) | <:expr@loc< $lid:s$ >> -> - mkexp loc (Pexp_ident (lident s)) + mkexp loc (Pexp_ident (lident_with_loc s loc)) | <:expr@loc< $uid:s$ >> -> (* let ca = constructors_arity () in *) - mkexp loc (Pexp_construct (lident (conv_con s)) None True) - | ExVrn loc s -> mkexp loc (Pexp_variant s None) + mkexp loc (Pexp_construct (lident_with_loc (conv_con s) loc) None True) + | ExVrn loc s -> mkexp loc (Pexp_variant (conv_con s) None) | ExWhi loc e1 el -> let e2 = ExSeq loc el in mkexp loc (Pexp_while (expr e1) (expr e2)) | <:expr@loc< let open $i$ in $e$ >> -> - mkexp loc (Pexp_open (long_uident i) (expr e)) + mkexp loc (Pexp_open Fresh (long_uident i) (expr e)) | <:expr@loc< (module $me$ : $pt$) >> -> - mkexp loc (Pexp_pack (module_expr me) (package_type pt)) - | <:expr@loc< (module $_$) >> -> - error loc "(module_expr : package_type) expected here" + mkexp loc (Pexp_constraint (mkexp loc (Pexp_pack (module_expr me)), + Some (mktyp loc (Ptyp_package (package_type pt))), None)) + | <:expr@loc< (module $me$) >> -> + mkexp loc (Pexp_pack (module_expr me)) | ExFUN loc i e -> mkexp loc (Pexp_newtype i (expr e)) | <:expr@loc< $_$,$_$ >> -> error loc "expr, expr: not allowed here" @@ -802,6 +893,33 @@ match x with [ <:binding< $x$ and $y$ >> -> binding x (binding y acc) + | <:binding@_loc< $pat:( <:patt@sloc< $lid:bind_name$ >> )$ = ($e$ : $TyTypePol _ vs ty$) >> -> + (* this code is not pretty because it is temporary *) + let rec id_to_string x = + match x with + [ <:ctyp< $lid:x$ >> -> [x] + | <:ctyp< $x$ $y$ >> -> (id_to_string x) @ (id_to_string y) + | _ -> assert False] + in + let vars = id_to_string vs in + let ampersand_vars = List.map (fun x -> "&" ^ x) vars in + let ty' = varify_constructors vars (ctyp ty) in + let mkexp = mkexp _loc in + let mkpat = mkpat _loc in + let e = mkexp (Pexp_constraint (expr e) (Some (ctyp ty)) None) in + let rec mk_newtypes x = + match x with + [ [newtype :: []] -> mkexp (Pexp_newtype(newtype, e)) + | [newtype :: newtypes] -> + mkexp(Pexp_newtype (newtype,mk_newtypes newtypes)) + | [] -> assert False] + in + let pat = + mkpat (Ppat_constraint (mkpat (Ppat_var (with_loc bind_name sloc)), + mktyp _loc (Ptyp_poly ampersand_vars ty'))) + in + let e = mk_newtypes vars in + [( pat, e) :: acc] | <:binding@_loc< $p$ = ($e$ : ! $vs$ . $ty$) >> -> [(patt <:patt< ($p$ : ! $vs$ . $ty$ ) >>, expr e) :: acc] | <:binding< $p$ = $e$ >> -> [(patt p, expr e) :: acc] @@ -829,13 +947,13 @@ [ <:rec_binding<>> -> acc | <:rec_binding< $x$; $y$ >> -> mkideexp x (mkideexp y acc) - | <:rec_binding< $lid:s$ = $e$ >> -> [(s, expr e) :: acc] + | <:rec_binding< $id:( <:ident@sloc< $lid:s$ >>)$ = $e$ >> -> [(with_loc s sloc, expr e) :: acc] | _ -> assert False ] and mktype_decl x acc = match x with [ <:ctyp< $x$ and $y$ >> -> mktype_decl x (mktype_decl y acc) - | Ast.TyDcl _ c tl td cl -> + | Ast.TyDcl cloc c tl td cl -> let cl = List.map (fun (t1, t2) -> @@ -843,14 +961,15 @@ (ctyp t1, ctyp t2, mkloc loc)) cl in - [(c, type_decl (List.fold_right type_parameters tl []) cl td) :: acc] + [(with_loc c cloc, + type_decl (List.fold_right optional_type_parameters tl []) cl td cloc) :: acc] | _ -> assert False ] and module_type = fun [ <:module_type@loc<>> -> error loc "abstract/nil module type not allowed here" | <:module_type@loc< $id:i$ >> -> mkmty loc (Pmty_ident (long_uident i)) | <:module_type@loc< functor ($n$ : $nt$) -> $mt$ >> -> - mkmty loc (Pmty_functor n (module_type nt) (module_type mt)) + mkmty loc (Pmty_functor (with_loc n loc) (module_type nt) (module_type mt)) | <:module_type@loc< '$_$ >> -> error loc "module type variable not allowed here" | <:module_type@loc< sig $sl$ end >> -> mkmty loc (Pmty_signature (sig_item sl [])) @@ -871,14 +990,14 @@ | <:sig_item< $sg1$; $sg2$ >> -> sig_item sg1 (sig_item sg2 l) | SgDir _ _ _ -> l | <:sig_item@loc< exception $uid:s$ >> -> - [mksig loc (Psig_exception (conv_con s) []) :: l] + [mksig loc (Psig_exception (with_loc (conv_con s) loc) []) :: l] | <:sig_item@loc< exception $uid:s$ of $t$ >> -> - [mksig loc (Psig_exception (conv_con s) + [mksig loc (Psig_exception (with_loc (conv_con s) loc) (List.map ctyp (list_of_ctyp t []))) :: l] | SgExc _ _ -> assert False (*FIXME*) - | SgExt loc n t sl -> [mksig loc (Psig_value n (mkvalue_desc t (list_of_meta_list sl))) :: l] + | SgExt loc n t sl -> [mksig loc (Psig_value (with_loc n loc) (mkvalue_desc loc t (list_of_meta_list sl))) :: l] | SgInc loc mt -> [mksig loc (Psig_include (module_type mt)) :: l] - | SgMod loc n mt -> [mksig loc (Psig_module n (module_type mt)) :: l] + | SgMod loc n mt -> [mksig loc (Psig_module (with_loc n loc) (module_type mt)) :: l] | SgRecMod loc mb -> [mksig loc (Psig_recmodule (module_sig_binding mb [])) :: l] | SgMty loc n mt -> @@ -887,25 +1006,25 @@ [ MtQuo _ _ -> Pmodtype_abstract | _ -> Pmodtype_manifest (module_type mt) ] in - [mksig loc (Psig_modtype n si) :: l] + [mksig loc (Psig_modtype (with_loc n loc) si) :: l] | SgOpn loc id -> - [mksig loc (Psig_open (long_uident id)) :: l] + [mksig loc (Psig_open Fresh (long_uident id)) :: l] | SgTyp loc tdl -> [mksig loc (Psig_type (mktype_decl tdl [])) :: l] - | SgVal loc n t -> [mksig loc (Psig_value n (mkvalue_desc t [])) :: l] + | SgVal loc n t -> [mksig loc (Psig_value (with_loc n loc) (mkvalue_desc loc t [])) :: l] | <:sig_item@loc< $anti:_$ >> -> error loc "antiquotation in sig_item" ] and module_sig_binding x acc = match x with [ <:module_binding< $x$ and $y$ >> -> module_sig_binding x (module_sig_binding y acc) - | <:module_binding< $s$ : $mt$ >> -> - [(s, module_type mt) :: acc] + | <:module_binding@loc< $s$ : $mt$ >> -> + [(with_loc s loc, module_type mt) :: acc] | _ -> assert False ] and module_str_binding x acc = match x with [ <:module_binding< $x$ and $y$ >> -> module_str_binding x (module_str_binding y acc) - | <:module_binding< $s$ : $mt$ = $me$ >> -> - [(s, module_type mt, module_expr me) :: acc] + | <:module_binding@loc< $s$ : $mt$ = $me$ >> -> + [(with_loc s loc, module_type mt, module_expr me) :: acc] | _ -> assert False ] and module_expr = fun @@ -914,15 +1033,18 @@ | <:module_expr@loc< $me1$ $me2$ >> -> mkmod loc (Pmod_apply (module_expr me1) (module_expr me2)) | <:module_expr@loc< functor ($n$ : $mt$) -> $me$ >> -> - mkmod loc (Pmod_functor n (module_type mt) (module_expr me)) + mkmod loc (Pmod_functor (with_loc n loc) (module_type mt) (module_expr me)) | <:module_expr@loc< struct $sl$ end >> -> mkmod loc (Pmod_structure (str_item sl [])) | <:module_expr@loc< ($me$ : $mt$) >> -> mkmod loc (Pmod_constraint (module_expr me) (module_type mt)) | <:module_expr@loc< (value $e$ : $pt$) >> -> - mkmod loc (Pmod_unpack (expr e) (package_type pt)) - | <:module_expr@loc< (value $_$) >> -> - error loc "(value expr) not supported yet" + mkmod loc (Pmod_unpack ( + mkexp loc (Pexp_constraint (expr e, + Some (mktyp loc (Ptyp_package (package_type pt))), + None)))) + | <:module_expr@loc< (value $e$) >> -> + mkmod loc (Pmod_unpack (expr e)) | <:module_expr@loc< $anti:_$ >> -> error loc "antiquotation in module_expr" ] and str_item s l = match s with @@ -936,22 +1058,24 @@ | <:str_item< $st1$; $st2$ >> -> str_item st1 (str_item st2 l) | StDir _ _ _ -> l | <:str_item@loc< exception $uid:s$ >> -> - [mkstr loc (Pstr_exception (conv_con s) []) :: l ] + [mkstr loc (Pstr_exception (with_loc (conv_con s) loc) []) :: l ] | <:str_item@loc< exception $uid:s$ of $t$ >> -> - [mkstr loc (Pstr_exception (conv_con s) + [mkstr loc (Pstr_exception (with_loc (conv_con s) loc) (List.map ctyp (list_of_ctyp t []))) :: l ] | <:str_item@loc< exception $uid:s$ = $i$ >> -> - [mkstr loc (Pstr_exn_rebind (conv_con s) (ident i)) :: l ] + [mkstr loc (Pstr_exn_rebind (with_loc (conv_con s) loc) (long_uident ~conv_con i)) :: l ] + | <:str_item@loc< exception $uid:_$ of $_$ = $_$ >> -> + error loc "type in exception alias" | StExc _ _ _ -> assert False (*FIXME*) | StExp loc e -> [mkstr loc (Pstr_eval (expr e)) :: l] - | StExt loc n t sl -> [mkstr loc (Pstr_primitive n (mkvalue_desc t (list_of_meta_list sl))) :: l] + | StExt loc n t sl -> [mkstr loc (Pstr_primitive (with_loc n loc) (mkvalue_desc loc t (list_of_meta_list sl))) :: l] | StInc loc me -> [mkstr loc (Pstr_include (module_expr me)) :: l] - | StMod loc n me -> [mkstr loc (Pstr_module n (module_expr me)) :: l] + | StMod loc n me -> [mkstr loc (Pstr_module (with_loc n loc) (module_expr me)) :: l] | StRecMod loc mb -> [mkstr loc (Pstr_recmodule (module_str_binding mb [])) :: l] - | StMty loc n mt -> [mkstr loc (Pstr_modtype n (module_type mt)) :: l] + | StMty loc n mt -> [mkstr loc (Pstr_modtype (with_loc n loc) (module_type mt)) :: l] | StOpn loc id -> - [mkstr loc (Pstr_open (long_uident id)) :: l] + [mkstr loc (Pstr_open Fresh (long_uident id)) :: l] | StTyp loc tdl -> [mkstr loc (Pstr_type (mktype_decl tdl [])) :: l] | StVal loc rf bi -> [mkstr loc (Pstr_value (mkrf rf) (binding bi [])) :: l] @@ -964,7 +1088,7 @@ | CtFun loc (TyLab _ lab t) ct -> mkcty loc (Pcty_fun lab (ctyp t) (class_type ct)) | CtFun loc (TyOlb loc1 lab t) ct -> - let t = TyApp loc1 <:ctyp@loc1< option >> t in + let t = TyApp loc1 (predef_option loc1) t in mkcty loc (Pcty_fun ("?" ^ lab) (ctyp t) (class_type ct)) | CtFun loc t ct -> mkcty loc (Pcty_fun "" (ctyp t) (class_type ct)) | CtSig loc t_o ctfl -> @@ -974,7 +1098,11 @@ | t -> t ] in let cil = class_sig_item ctfl [] in - mkcty loc (Pcty_signature (ctyp t, cil)) + mkcty loc (Pcty_signature { + pcsig_self = ctyp t; + pcsig_fields = cil; + pcsig_loc = mkloc loc; + }) | CtCon loc _ _ _ -> error loc "invalid virtual class inside a class type" | CtAnt _ _ | CtEq _ _ _ | CtCol _ _ _ | CtAnd _ _ _ | CtNil _ -> @@ -982,7 +1110,7 @@ and class_info_class_expr ci = match ci with - [ CeEq _ (CeCon loc vir (IdLid _ name) params) ce -> + [ CeEq _ (CeCon loc vir (IdLid nloc name) params) ce -> let (loc_params, (params, variance)) = match params with [ <:ctyp<>> -> (loc, ([], [])) @@ -990,15 +1118,15 @@ in {pci_virt = mkvirtual vir; pci_params = (params, mkloc loc_params); - pci_name = name; + pci_name = with_loc name nloc; pci_expr = class_expr ce; pci_loc = mkloc loc; pci_variance = variance} | ce -> error (loc_of_class_expr ce) "bad class definition" ] and class_info_class_type ci = match ci with - [ CtEq _ (CtCon loc vir (IdLid _ name) params) ct | - CtCol _ (CtCon loc vir (IdLid _ name) params) ct -> + [ CtEq _ (CtCon loc vir (IdLid nloc name) params) ct | + CtCol _ (CtCon loc vir (IdLid nloc name) params) ct -> let (loc_params, (params, variance)) = match params with [ <:ctyp<>> -> (loc, ([], [])) @@ -1006,7 +1134,7 @@ in {pci_virt = mkvirtual vir; pci_params = (params, mkloc loc_params); - pci_name = name; + pci_name = with_loc name nloc; pci_expr = class_type ct; pci_loc = mkloc loc; pci_variance = variance} @@ -1015,39 +1143,39 @@ and class_sig_item c l = match c with [ <:class_sig_item<>> -> l - | CgCtr loc t1 t2 -> [Pctf_cstr (ctyp t1, ctyp t2, mkloc loc) :: l] + | CgCtr loc t1 t2 -> [mkctf loc (Pctf_cstr (ctyp t1, ctyp t2)) :: l] | <:class_sig_item< $csg1$; $csg2$ >> -> class_sig_item csg1 (class_sig_item csg2 l) - | CgInh _ ct -> [Pctf_inher (class_type ct) :: l] + | CgInh loc ct -> [mkctf loc (Pctf_inher (class_type ct)) :: l] | CgMth loc s pf t -> - [Pctf_meth (s, mkprivate pf, mkpolytype (ctyp t), mkloc loc) :: l] + [mkctf loc (Pctf_meth (s, mkprivate pf, mkpolytype (ctyp t))) :: l] | CgVal loc s b v t -> - [Pctf_val (s, mkmutable b, mkvirtual v, ctyp t, mkloc loc) :: l] + [mkctf loc (Pctf_val (s, mkmutable b, mkvirtual v, ctyp t)) :: l] | CgVir loc s b t -> - [Pctf_virt (s, mkprivate b, mkpolytype (ctyp t), mkloc loc) :: l] + [mkctf loc (Pctf_virt (s, mkprivate b, mkpolytype (ctyp t))) :: l] | CgAnt _ _ -> assert False ] and class_expr = fun [ CeApp loc _ _ as c -> let (ce, el) = class_expr_fa [] c in let el = List.map label_expr el in - mkpcl loc (Pcl_apply (class_expr ce) el) + mkcl loc (Pcl_apply (class_expr ce) el) | CeCon loc ViNil id tl -> - mkpcl loc + mkcl loc (Pcl_constr (long_class_ident id) (List.map ctyp (list_of_opt_ctyp tl []))) | CeFun loc (PaLab _ lab po) ce -> - mkpcl loc + mkcl loc (Pcl_fun lab None (patt_of_lab loc lab po) (class_expr ce)) | CeFun loc (PaOlbi _ lab p e) ce -> let lab = paolab lab p in - mkpcl loc (Pcl_fun ("?" ^ lab) (Some (expr e)) (patt p) (class_expr ce)) + mkcl loc (Pcl_fun ("?" ^ lab) (Some (expr e)) (patt p) (class_expr ce)) | CeFun loc (PaOlb _ lab p) ce -> let lab = paolab lab p in - mkpcl loc + mkcl loc (Pcl_fun ("?" ^ lab) None (patt_of_lab loc lab p) (class_expr ce)) - | CeFun loc p ce -> mkpcl loc (Pcl_fun "" None (patt p) (class_expr ce)) + | CeFun loc p ce -> mkcl loc (Pcl_fun "" None (patt p) (class_expr ce)) | CeLet loc rf bi ce -> - mkpcl loc (Pcl_let (mkrf rf) (binding bi []) (class_expr ce)) + mkcl loc (Pcl_let (mkrf rf) (binding bi []) (class_expr ce)) | CeStr loc po cfl -> let p = match po with @@ -1055,35 +1183,38 @@ | p -> p ] in let cil = class_str_item cfl [] in - mkpcl loc (Pcl_structure (patt p, cil)) + mkcl loc (Pcl_structure { + pcstr_pat = patt p; + pcstr_fields = cil; + }) | CeTyc loc ce ct -> - mkpcl loc (Pcl_constraint (class_expr ce) (class_type ct)) + mkcl loc (Pcl_constraint (class_expr ce) (class_type ct)) | CeCon loc _ _ _ -> error loc "invalid virtual class inside a class expression" | CeAnt _ _ | CeEq _ _ _ | CeAnd _ _ _ | CeNil _ -> assert False ] and class_str_item c l = match c with [ CrNil _ -> l - | CrCtr loc t1 t2 -> [Pcf_cstr (ctyp t1, ctyp t2, mkloc loc) :: l] + | CrCtr loc t1 t2 -> [mkcf loc (Pcf_constr (ctyp t1, ctyp t2)) :: l] | <:class_str_item< $cst1$; $cst2$ >> -> class_str_item cst1 (class_str_item cst2 l) | CrInh loc ov ce pb -> let opb = if pb = "" then None else Some pb in - [Pcf_inher (override_flag loc ov) (class_expr ce) opb :: l] - | CrIni _ e -> [Pcf_init (expr e) :: l] + [mkcf loc (Pcf_inher (override_flag loc ov) (class_expr ce) opb) :: l] + | CrIni loc e -> [mkcf loc (Pcf_init (expr e)) :: l] | CrMth loc s ov pf e t -> let t = match t with [ <:ctyp<>> -> None | t -> Some (mkpolytype (ctyp t)) ] in let e = mkexp loc (Pexp_poly (expr e) t) in - [Pcf_meth (s, mkprivate pf, override_flag loc ov, e, mkloc loc) :: l] + [mkcf loc (Pcf_meth (with_loc s loc, mkprivate pf, override_flag loc ov, e)) :: l] | CrVal loc s ov mf e -> - [Pcf_val (s, mkmutable mf, override_flag loc ov, expr e, mkloc loc) :: l] + [mkcf loc (Pcf_val (with_loc s loc, mkmutable mf, override_flag loc ov, expr e)) :: l] | CrVir loc s pf t -> - [Pcf_virt (s, mkprivate pf, mkpolytype (ctyp t), mkloc loc) :: l] + [mkcf loc (Pcf_virt (with_loc s loc, mkprivate pf, mkpolytype (ctyp t))) :: l] | CrVvr loc s mf t -> - [Pcf_valvirt (s, mkmutable mf, ctyp t, mkloc loc) :: l] + [mkcf loc (Pcf_valvirt (with_loc s loc, mkmutable mf, ctyp t)) :: l] | CrAnt _ _ -> assert False ]; value sig_item ast = sig_item ast []; @@ -1096,7 +1227,7 @@ | ExInt _ i -> Pdir_int (int_of_string i) | <:expr< True >> -> Pdir_bool True | <:expr< False >> -> Pdir_bool False - | e -> Pdir_ident (ident (ident_of_expr e)) ] + | e -> Pdir_ident (ident_noloc (ident_of_expr e)) ] ; value phrase = diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.mli ocaml-4.01.0/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.mli --- ocaml-3.12.1/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.mli 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/CleanAst.ml ocaml-4.01.0/camlp4/Camlp4/Struct/CleanAst.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/CleanAst.ml 2007-11-21 18:15:48.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/CleanAst.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/CommentFilter.ml ocaml-4.01.0/camlp4/Camlp4/Struct/CommentFilter.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/CommentFilter.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/CommentFilter.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/CommentFilter.mli ocaml-4.01.0/camlp4/Camlp4/Struct/CommentFilter.mli --- ocaml-3.12.1/camlp4/Camlp4/Struct/CommentFilter.mli 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/CommentFilter.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/DynAst.ml ocaml-4.01.0/camlp4/Camlp4/Struct/DynAst.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/DynAst.ml 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/DynAst.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2007 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/DynLoader.ml ocaml-4.01.0/camlp4/Camlp4/Struct/DynLoader.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/DynLoader.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/DynLoader.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r pa_macro.cmo *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2001-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/DynLoader.mli ocaml-4.01.0/camlp4/Camlp4/Struct/DynLoader.mli --- ocaml-3.12.1/camlp4/Camlp4/Struct/DynLoader.mli 2007-02-07 10:09:29.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/DynLoader.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/EmptyError.ml ocaml-4.01.0/camlp4/Camlp4/Struct/EmptyError.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/EmptyError.ml 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/EmptyError.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -19,4 +19,4 @@ type t = unit; exception E of t; value print _ = assert False; -value to_string _ = assert False; \ No newline at end of file +value to_string _ = assert False; diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/EmptyError.mli ocaml-4.01.0/camlp4/Camlp4/Struct/EmptyError.mli --- ocaml-3.12.1/camlp4/Camlp4/Struct/EmptyError.mli 2007-02-07 10:09:29.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/EmptyError.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -16,4 +16,4 @@ * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) -include Sig.Error; \ No newline at end of file +include Sig.Error; diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/EmptyPrinter.ml ocaml-4.01.0/camlp4/Camlp4/Struct/EmptyPrinter.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/EmptyPrinter.ml 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/EmptyPrinter.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/EmptyPrinter.mli ocaml-4.01.0/camlp4/Camlp4/Struct/EmptyPrinter.mli --- ocaml-3.12.1/camlp4/Camlp4/Struct/EmptyPrinter.mli 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/EmptyPrinter.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/FreeVars.ml ocaml-4.01.0/camlp4/Camlp4/Struct/FreeVars.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/FreeVars.ml 2010-06-09 14:21:26.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/FreeVars.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/FreeVars.mli ocaml-4.01.0/camlp4/Camlp4/Struct/FreeVars.mli --- ocaml-3.12.1/camlp4/Camlp4/Struct/FreeVars.mli 2007-02-07 10:09:29.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/FreeVars.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Delete.ml ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Delete.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Delete.ml 2010-06-16 07:13:59.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Delete.ml 2012-10-25 12:28:15.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -17,11 +17,37 @@ * - Nicolas Pouillard: refactoring *) +exception Rule_not_found of (string * string); + +let () = + Printexc.register_printer + (fun + [ Rule_not_found (symbols, entry) -> + let msg = Printf.sprintf "rule %S cannot be found in entry\n%s" symbols entry in + Some msg + | _ -> None ]) in () +; + module Make (Structure : Structure.S) = struct module Tools = Tools.Make Structure; module Parser = Parser.Make Structure; + module Print = Print.Make Structure; open Structure; +value raise_rule_not_found entry symbols = + let to_string f x = + let buff = Buffer.create 128 in + let ppf = Format.formatter_of_buffer buff in + do { + f ppf x; + Format.pp_print_flush ppf (); + Buffer.contents buff + } in + let entry = to_string Print.entry entry in + let symbols = to_string Print.print_rule symbols in + raise (Rule_not_found (symbols, entry)) +; + (* Deleting a rule *) (* [delete_rule_in_tree] returns @@ -104,7 +130,7 @@ | None -> let levs = delete_rule_in_suffix entry symbols levs in [lev :: levs] ] - | [] -> raise Not_found ] + | [] -> raise_rule_not_found entry symbols ] ; value rec delete_rule_in_prefix entry symbols = @@ -128,7 +154,7 @@ | None -> let levs = delete_rule_in_prefix entry symbols levs in [lev :: levs] ] - | [] -> raise Not_found ] + | [] -> raise_rule_not_found entry symbols ] ; value rec delete_rule_in_level_list entry symbols levs = diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Dynamic.ml ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Dynamic.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Dynamic.ml 2011-04-29 09:29:17.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Dynamic.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Entry.ml ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Entry.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Entry.ml 2010-06-16 07:13:40.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Entry.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Failed.ml ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Failed.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Failed.ml 2010-06-16 07:13:59.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Failed.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Find.ml ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Find.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Find.ml 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Find.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Fold.ml ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Fold.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Fold.ml 2010-06-12 07:48:23.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Fold.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Fold.mli ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Fold.mli --- ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Fold.mli 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Fold.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Insert.ml ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Insert.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Insert.ml 2010-06-16 07:13:59.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Insert.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ (* -*- camlp4r -*- *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -256,10 +256,6 @@ Some t | None -> None ] | LocAct _ _ | DeadEnd -> None ] - and insert_new = - fun - [ [s :: sl] -> Node {node = s; son = insert_new sl; brother = DeadEnd} - | [] -> LocAct action [] ] in insert gsymbols tree ; diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Parser.ml ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Parser.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Parser.ml 2010-06-16 07:13:59.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Parser.ml 2012-07-20 09:26:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -36,7 +36,13 @@ value add_loc bp parse_fun strm = let x = parse_fun strm in let ep = loc_ep strm in - let loc = Loc.merge bp ep in + let loc = + if Loc.start_off bp > Loc.stop_off ep then + (* If nothing has been consumed, create a 0-length location. *) + Loc.join bp + else + Loc.merge bp ep + in (x, loc); value stream_peek_nth strm n = diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Parser.mli ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Parser.mli --- ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Parser.mli 2010-06-16 07:13:40.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Parser.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2007 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Print.ml ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Print.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Print.ml 2010-06-16 07:13:59.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Print.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Print.mli ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Print.mli --- ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Print.mli 2006-06-29 11:29:27.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Print.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Search.ml ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Search.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Search.ml 2010-06-16 07:13:59.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Search.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Static.ml ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Static.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Static.ml 2011-04-29 09:29:17.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Static.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Structure.ml ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Structure.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Structure.ml 2011-04-29 09:29:17.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Structure.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Tools.ml ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Tools.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/Grammar/Tools.ml 2011-04-29 09:29:17.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Grammar/Tools.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Lexer.mll ocaml-4.01.0/camlp4/Camlp4/Struct/Lexer.mll --- ocaml-3.12.1/camlp4/Camlp4/Struct/Lexer.mll 2011-04-07 08:19:49.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Lexer.mll 2013-08-30 11:39:33.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -180,9 +180,9 @@ pos_lnum = if absolute then line else pos.pos_lnum + line; pos_bol = pos.pos_cnum - chars; } - + (* To convert integer literals, copied from "../parsing/lexer.mll" *) - + let cvt_int_literal s = - int_of_string ("-" ^ s) let cvt_int32_literal s = diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Loc.ml ocaml-4.01.0/camlp4/Camlp4/Struct/Loc.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/Loc.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Loc.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Loc.mli ocaml-4.01.0/camlp4/Camlp4/Struct/Loc.mli --- ocaml-3.12.1/camlp4/Camlp4/Struct/Loc.mli 2007-02-07 10:09:29.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Loc.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Quotation.ml ocaml-4.01.0/camlp4/Camlp4/Struct/Quotation.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/Quotation.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Quotation.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Token.ml ocaml-4.01.0/camlp4/Camlp4/Struct/Token.ml --- ocaml-3.12.1/camlp4/Camlp4/Struct/Token.ml 2007-12-18 08:51:25.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Token.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -211,7 +211,7 @@ | [: `'b' :] -> '\b' | [: `'\\' :] -> '\\' | [: `'"' :] -> '"' - | [: `''' :] -> ''' + | [: `'\'' :] -> '\'' | [: `' ' :] -> ' ' | [: `('0'..'9' as c1); `('0'..'9' as c2); `('0'..'9' as c3) :] -> chr (100 * (valch c1) + 10 * (valch c2) + (valch c3)) diff -Nru ocaml-3.12.1/camlp4/Camlp4/Struct/Token.mli ocaml-4.01.0/camlp4/Camlp4/Struct/Token.mli --- ocaml-3.12.1/camlp4/Camlp4/Struct/Token.mli 2007-02-07 10:09:29.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4/Struct/Token.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Bin.ml ocaml-4.01.0/camlp4/Camlp4Bin.ml --- ocaml-3.12.1/camlp4/Camlp4Bin.ml 2011-02-15 14:12:48.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Bin.ml 2013-08-30 11:39:33.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Filters/Camlp4AstLifter.ml ocaml-4.01.0/camlp4/Camlp4Filters/Camlp4AstLifter.ml --- ocaml-3.12.1/camlp4/Camlp4Filters/Camlp4AstLifter.ml 2008-10-27 14:03:57.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Filters/Camlp4AstLifter.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Filters/Camlp4ExceptionTracer.ml ocaml-4.01.0/camlp4/Camlp4Filters/Camlp4ExceptionTracer.ml --- ocaml-3.12.1/camlp4/Camlp4Filters/Camlp4ExceptionTracer.ml 2008-10-27 14:03:57.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Filters/Camlp4ExceptionTracer.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Filters/Camlp4FoldGenerator.ml ocaml-4.01.0/camlp4/Camlp4Filters/Camlp4FoldGenerator.ml --- ocaml-3.12.1/camlp4/Camlp4Filters/Camlp4FoldGenerator.ml 2010-06-10 09:53:51.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Filters/Camlp4FoldGenerator.ml 2013-08-30 11:39:33.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) -(* Copyright 2006,2007 Institut National de Recherche en Informatique et *) +(* Copyright 2006-2007 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Filters/Camlp4LocationStripper.ml ocaml-4.01.0/camlp4/Camlp4Filters/Camlp4LocationStripper.ml --- ocaml-3.12.1/camlp4/Camlp4Filters/Camlp4LocationStripper.ml 2008-10-27 14:03:57.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Filters/Camlp4LocationStripper.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Filters/Camlp4MapGenerator.ml ocaml-4.01.0/camlp4/Camlp4Filters/Camlp4MapGenerator.ml --- ocaml-3.12.1/camlp4/Camlp4Filters/Camlp4MapGenerator.ml 2008-10-27 14:03:57.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Filters/Camlp4MapGenerator.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + (* This module is useless now. Camlp4FoldGenerator handles map too. *) module Id = struct value name = "Camlp4MapGenerator"; diff -Nru ocaml-3.12.1/camlp4/Camlp4Filters/Camlp4MetaGenerator.ml ocaml-4.01.0/camlp4/Camlp4Filters/Camlp4MetaGenerator.ml --- ocaml-3.12.1/camlp4/Camlp4Filters/Camlp4MetaGenerator.ml 2010-06-10 09:52:14.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Filters/Camlp4MetaGenerator.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + open Camlp4; open PreCast; module MapTy = Map.Make String; @@ -147,10 +161,10 @@ let bi = mk_meta m in <:module_expr< struct - value meta_string _loc s = $m.str$ _loc s; + value meta_string _loc s = $m.str$ _loc (safe_string_escaped s); value meta_int _loc s = $m.int$ _loc s; value meta_float _loc s = $m.flo$ _loc s; - value meta_char _loc s = $m.chr$ _loc s; + value meta_char _loc s = $m.chr$ _loc (String.escaped s); value meta_bool _loc = fun [ False -> $m_uid m "False"$ diff -Nru ocaml-3.12.1/camlp4/Camlp4Filters/Camlp4Profiler.ml ocaml-4.01.0/camlp4/Camlp4Filters/Camlp4Profiler.ml --- ocaml-3.12.1/camlp4/Camlp4Filters/Camlp4Profiler.ml 2008-10-27 14:03:57.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Filters/Camlp4Profiler.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Filters/Camlp4TrashRemover.ml ocaml-4.01.0/camlp4/Camlp4Filters/Camlp4TrashRemover.ml --- ocaml-3.12.1/camlp4/Camlp4Filters/Camlp4TrashRemover.ml 2008-10-27 14:03:57.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Filters/Camlp4TrashRemover.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4AstLoader.ml ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4AstLoader.ml --- ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4AstLoader.ml 2008-10-27 14:03:57.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4AstLoader.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4DebugParser.ml ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4DebugParser.ml --- ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4DebugParser.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4DebugParser.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ open Camlp4; (* -*- camlp4r -*- *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4GrammarParser.ml ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4GrammarParser.ml --- ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4GrammarParser.ml 2010-06-16 07:13:59.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4GrammarParser.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ open Camlp4; (* -*- camlp4r -*- *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4ListComprehension.ml ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4ListComprehension.ml --- ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4ListComprehension.ml 2011-02-02 15:27:16.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4ListComprehension.ml 2012-10-25 12:28:15.000000000 +0000 @@ -1,15 +1,15 @@ open Camlp4; (* -*- camlp4r -*- *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2007 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -102,7 +102,7 @@ try do { DELETE_RULE Gram expr: "["; sem_expr_for_list; "::"; expr; "]" END; True - } with [ Not_found -> False ]; + } with [ Struct.Grammar.Delete.Rule_not_found _ -> False ]; value comprehension_or_sem_expr_for_list = Gram.Entry.mk "comprehension_or_sem_expr_for_list"; diff -Nru ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4MacroParser.ml ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4MacroParser.ml --- ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4MacroParser.ml 2011-06-06 07:04:42.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4MacroParser.ml 2013-08-30 11:39:33.000000000 +0000 @@ -1,15 +1,15 @@ open Camlp4; (* -*- camlp4r -*- *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -52,6 +52,7 @@ DEFINE = IN __FILE__ __LOCATION__ + LOCATION_OF In patterns: @@ -84,6 +85,10 @@ The expression __FILE__ returns the current compiled file name. The expression __LOCATION__ returns the current location of itself. + If used inside a macro, it returns the location where the macro is + called. + The expression (LOCATION_OF parameter) returns the location of the given + macro parameter. It cannot be used outside a macro definition. *) @@ -151,6 +156,15 @@ [ <:expr< $lid:x$ >> | <:expr< $uid:x$ >> as e -> try List.assoc x env with [ Not_found -> super#expr e ] + | <:expr@_loc< LOCATION_OF $lid:x$ >> | <:expr@_loc< LOCATION_OF $uid:x$ >> as e -> + try + let loc = Ast.loc_of_expr (List.assoc x env) in + let (a, b, c, d, e, f, g, h) = Loc.to_tuple loc in + <:expr< Loc.of_tuple + ($`str:a$, $`int:b$, $`int:c$, $`int:d$, + $`int:e$, $`int:f$, $`int:g$, + $if h then <:expr< True >> else <:expr< False >> $) >> + with [ Not_found -> super#expr e ] | e -> super#expr e ]; method patt = @@ -387,15 +401,6 @@ | "DEFINE"; i = LIDENT; "="; def = expr; "IN"; body = expr -> (new subst _loc [(i, def)])#expr body ] ] ; - expr: LEVEL "simple" - [ [ LIDENT "__FILE__" -> <:expr< $`str:Loc.file_name _loc$ >> - | LIDENT "__LOCATION__" -> - let (a, b, c, d, e, f, g, h) = Loc.to_tuple _loc in - <:expr< Loc.of_tuple - ($`str:a$, $`int:b$, $`int:c$, $`int:d$, - $`int:e$, $`int:f$, $`int:g$, - $if h then <:expr< True >> else <:expr< False >> $) >> ] ] - ; patt: [ [ "IFDEF"; i = uident; "THEN"; p1 = patt; "ELSE"; p2 = patt; endif -> if is_defined i then p1 else p2 @@ -434,12 +439,20 @@ open AstFilters; open Ast; - value remove_nothings = + (* Remove NOTHING and expanse __FILE__ and __LOCATION__ *) + value map_expr = fun [ <:expr< $e$ NOTHING >> | <:expr< fun $ <:patt< NOTHING >> $ -> $e$ >> -> e + | <:expr@_loc< $lid:"__FILE__"$ >> -> <:expr< $`str:Loc.file_name _loc$ >> + | <:expr@_loc< $lid:"__LOCATION__"$ >> -> + let (a, b, c, d, e, f, g, h) = Loc.to_tuple _loc in + <:expr< Loc.of_tuple + ($`str:a$, $`int:b$, $`int:c$, $`int:d$, + $`int:e$, $`int:f$, $`int:g$, + $if h then <:expr< True >> else <:expr< False >> $) >> | e -> e]; - register_str_item_filter (Ast.map_expr remove_nothings)#str_item; + register_str_item_filter (Ast.map_expr map_expr)#str_item; end; diff -Nru ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4OCamlOriginalQuotationExpander.ml ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4OCamlOriginalQuotationExpander.ml --- ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4OCamlOriginalQuotationExpander.ml 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4OCamlOriginalQuotationExpander.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ open Camlp4; (* -*- camlp4r -*- *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml --- ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml 2011-06-07 22:22:12.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml 2013-08-30 11:39:33.000000000 +0000 @@ -1,15 +1,15 @@ open Camlp4; (* -*- camlp4r -*- *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -107,13 +107,13 @@ | _ -> 1 ]) ; - value lident_colon = - Gram.Entry.of_parser "lident_colon" - (fun strm -> - match Stream.npeek 2 strm with - [ [(LIDENT i, _); (KEYWORD ":", _)] -> - do { Stream.junk strm; Stream.junk strm; i } - | _ -> raise Stream.Failure ]) + value lident_colon = + Gram.Entry.of_parser "lident_colon" + (fun strm -> + match Stream.npeek 2 strm with + [ [(LIDENT i, _); (KEYWORD ":", _)] -> + do { Stream.junk strm; Stream.junk strm; i } + | _ -> raise Stream.Failure ]) ; value rec is_ident_constr_call = @@ -158,6 +158,7 @@ DELETE_RULE Gram expr: SELF; ":="; SELF; dummy END; DELETE_RULE Gram expr: "~"; a_LIDENT; ":"; SELF END; DELETE_RULE Gram expr: "?"; a_LIDENT; ":"; SELF END; + DELETE_RULE Gram constructor_declarations: a_UIDENT; ":"; ctyp END; (* Some other DELETE_RULE are after the grammar *) value clear = Gram.Entry.clear; @@ -189,7 +190,7 @@ clear package_type; clear top_phrase; - EXTEND Gram + let apply () = EXTEND Gram GLOBAL: a_CHAR a_FLOAT a_INT a_INT32 a_INT64 a_LABEL a_LIDENT a_NATIVEINT a_OPTLABEL a_STRING a_UIDENT a_ident @@ -384,6 +385,9 @@ | "[|"; pl = sem_patt; "|]" -> <:patt< [| $pl$ |] >> | "{"; pl = label_patt_list; "}" -> <:patt< { $pl$ } >> | "("; ")" -> <:patt< () >> + | "("; "module"; m = a_UIDENT; ")" -> <:patt< (module $m$) >> + | "("; "module"; m = a_UIDENT; ":"; pt = package_type; ")" -> + <:patt< ((module $m$) : (module $pt$)) >> | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> | "("; p = patt; ")" -> <:patt< $p$ >> | "_" -> <:patt< _ >> @@ -427,8 +431,8 @@ ] ] ; package_type_cstr: - [ [ "type"; i = a_LIDENT; "="; ty = ctyp -> - <:with_constr< type $lid:i$ = $ty$ >> + [ [ "type"; i = ident; "="; ty = ctyp -> + <:with_constr< type $id:i$ = $ty$ >> ] ] ; package_type_cstrs: @@ -538,6 +542,15 @@ | t = ctyp LEVEL "ctyp1" -> t ] ] ; + constructor_declarations: + [ [ s = a_UIDENT; ":"; t = constructor_arg_list ; "->" ; ret = ctyp -> + <:ctyp< $uid:s$ : ($t$ -> $ret$) >> + | s = a_UIDENT; ":"; ret = constructor_arg_list -> + match Ast.list_of_ctyp ret [] with + [ [c] -> <:ctyp< $uid:s$ : $c$ >> + | _ -> raise (Stream.Error "invalid generalized constructor type") ] + ] ] + ; semi: [ [ ";;" -> () | -> () ] ] ; @@ -559,17 +572,35 @@ | t = type_parameter -> fun acc -> <:ctyp< $acc$ $t$ >> ] ] ; + + optional_type_parameter: + [ [ `ANTIQUOT (""|"typ"|"anti" as n) s -> <:ctyp< $anti:mk_anti n s$ >> + | `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.ctyp_tag + | "+"; "_" -> Ast.TyAnP _loc + | "+"; "'"; i = a_ident -> <:ctyp< +'$lid:i$ >> + | "-"; "_" -> Ast.TyAnM _loc + | "-"; "'"; i = a_ident -> <:ctyp< -'$lid:i$ >> + | "_" -> Ast.TyAny _loc + | "'"; i = a_ident -> <:ctyp< '$lid:i$ >> + + ] ] + ; + type_ident_and_parameters: - [ [ "("; tpl = LIST1 type_parameter SEP ","; ")"; i = a_LIDENT -> (i, tpl) - | t = type_parameter; i = a_LIDENT -> (i, [t]) + [ [ "("; tpl = LIST1 optional_type_parameter SEP ","; ")"; i = a_LIDENT -> (i, tpl) + | t = optional_type_parameter; i = a_LIDENT -> (i, [t]) | i = a_LIDENT -> (i, []) ] ] ; type_kind: [ [ "private"; tk = type_kind -> <:ctyp< private $tk$ >> - | t = TRY [OPT "|"; t = constructor_declarations; - test_not_dot_nor_lparen -> t] -> - <:ctyp< [ $t$ ] >> + | (x, t) = TRY [x = OPT "|"; t = constructor_declarations; + test_not_dot_nor_lparen -> (x, t)] -> + (* If there is no "|" and [t] is an antiquotation, + then it is not a sum type. *) + match (x, t) with + [ (None, Ast.TyAnt _) -> t + | _ -> <:ctyp< [ $t$ ] >> ] | t = TRY ctyp -> <:ctyp< $t$ >> | t = TRY ctyp; "="; "private"; tk = type_kind -> <:ctyp< $t$ == private $tk$ >> @@ -675,7 +706,7 @@ | `EOI -> None ] ] ; - END; + END in apply (); (* Some other DELETE_RULE are before the grammar *) DELETE_RULE Gram module_longident_with_app: "("; SELF; ")" END; diff -Nru ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4OCamlParserParser.ml ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4OCamlParserParser.ml --- ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4OCamlParserParser.ml 2008-10-27 14:03:57.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4OCamlParserParser.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 1998-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4OCamlReloadedParser.ml ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4OCamlReloadedParser.ml --- ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4OCamlReloadedParser.ml 2008-10-27 14:03:57.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4OCamlReloadedParser.ml 2012-10-25 12:28:15.000000000 +0000 @@ -1,15 +1,15 @@ open Camlp4; (* -*- camlp4r -*- *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2007 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -40,7 +40,7 @@ value revised = try (DELETE_RULE Gram expr: "if"; SELF; "then"; SELF; "else"; SELF END; True) - with [ Not_found -> begin + with [ Struct.Grammar.Delete.Rule_not_found _ -> begin DELETE_RULE Gram expr: "if"; SELF; "then"; expr LEVEL "top"; "else"; expr LEVEL "top" END; DELETE_RULE Gram expr: "if"; SELF; "then"; expr LEVEL "top" END; False end ]; diff -Nru ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml --- ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml 2011-05-12 08:14:30.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml 2013-08-30 11:39:33.000000000 +0000 @@ -1,15 +1,15 @@ open Camlp4; (* -*- camlp4r -*- *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -303,6 +303,15 @@ value stopped_at _loc = Some (Loc.move_line 1 _loc) (* FIXME be more precise *); + value rec generalized_type_of_type = + fun + [ <:ctyp< $t1$ -> $t2$ >> -> + let (tl, rt) = generalized_type_of_type t2 in + ([t1 :: tl], rt) + | t -> + ([], t) ] + ; + value symbolchar = let list = ['$'; '!'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; @@ -361,7 +370,7 @@ parser [ [: `((KEYWORD "(", _) as tok); xs :] -> match xs with parser - [ [: `(KEYWORD ("mod"|"land"|"lor"|"lxor"|"lsl"|"lsr"|"asr" as i), _loc); + [ [: `(KEYWORD ("or"|"mod"|"land"|"lor"|"lxor"|"lsl"|"lsr"|"asr" as i), _loc); `(KEYWORD ")", _); xs :] -> [: `(LIDENT i, _loc); infix_kwds_filter xs :] | [: xs :] -> @@ -391,7 +400,7 @@ parser [: a = symb; s :] -> kont a s end; - EXTEND Gram + let apply () = EXTEND Gram GLOBAL: a_CHAR a_FLOAT a_INT a_INT32 a_INT64 a_LABEL a_LIDENT rec_binding_quot a_NATIVEINT a_OPTLABEL a_STRING a_UIDENT a_ident @@ -521,7 +530,8 @@ | i = module_longident_with_app -> <:module_type< $id:i$ >> | "'"; i = a_ident -> <:module_type< ' $i$ >> | "("; mt = SELF; ")" -> <:module_type< $mt$ >> - | "module"; "type"; "of"; me = module_expr -> <:module_type< module type of $me$ >> ] ] + | "module"; "type"; "of"; me = module_expr -> + <:module_type< module type of $me$ >> ] ] ; sig_item: [ "top" @@ -891,6 +901,9 @@ | "[|"; pl = sem_patt; "|]" -> <:patt< [| $pl$ |] >> | "{"; pl = label_patt_list; "}" -> <:patt< { $pl$ } >> | "("; ")" -> <:patt< () >> + | "("; "module"; m = a_UIDENT; ")" -> <:patt< (module $m$) >> + | "("; "module"; m = a_UIDENT; ":"; pt = package_type; ")" -> + <:patt< ((module $m$) : (module $pt$)) >> | "("; p = SELF; ")" -> p | "("; p = SELF; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> | "("; p = SELF; "as"; p2 = SELF; ")" -> <:patt< ($p$ as $p2$) >> @@ -959,6 +972,9 @@ <:patt< ($tup:<:patt< $anti:mk_anti ~c:"patt" n s$ >>$) >> | `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.patt_tag | "("; ")" -> <:patt< () >> + | "("; "module"; m = a_UIDENT; ")" -> <:patt< (module $m$) >> + | "("; "module"; m = a_UIDENT; ":"; pt = package_type; ")" -> + <:patt< ((module $m$) : (module $pt$)) >> | "("; p = SELF; ")" -> p | "("; p = SELF; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> | "("; p = SELF; "as"; p2 = SELF; ")" -> <:patt< ($p$ as $p2$) >> @@ -977,6 +993,8 @@ ; label_ipatt_list: [ [ p1 = label_ipatt; ";"; p2 = SELF -> <:patt< $p1$ ; $p2$ >> + | p1 = label_ipatt; ";"; "_" -> <:patt< $p1$ ; _ >> + | p1 = label_ipatt; ";"; "_"; ";" -> <:patt< $p1$ ; _ >> | p1 = label_ipatt; ";" -> p1 | p1 = label_ipatt -> p1 ] ]; @@ -1010,7 +1028,7 @@ [ [ t = ctyp -> t ] ] ; type_ident_and_parameters: - [ [ i = a_LIDENT; tpl = LIST0 type_parameter -> (i, tpl) ] ] + [ [ i = a_LIDENT; tpl = LIST0 optional_type_parameter -> (i, tpl) ] ] ; type_longident_and_parameters: [ [ i = type_longident; tpl = type_parameters -> tpl <:ctyp< $id:i$ >> @@ -1023,6 +1041,7 @@ | -> fun t -> t ] ] ; + type_parameter: [ [ `ANTIQUOT (""|"typ"|"anti" as n) s -> <:ctyp< $anti:mk_anti n s$ >> | `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.ctyp_tag @@ -1030,6 +1049,20 @@ | "+"; "'"; i = a_ident -> <:ctyp< +'$lid:i$ >> | "-"; "'"; i = a_ident -> <:ctyp< -'$lid:i$ >> ] ] ; + optional_type_parameter: + [ [ `ANTIQUOT (""|"typ"|"anti" as n) s -> <:ctyp< $anti:mk_anti n s$ >> + | `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.ctyp_tag + | "'"; i = a_ident -> <:ctyp< '$lid:i$ >> + | "+"; "'"; i = a_ident -> <:ctyp< +'$lid:i$ >> + | "-"; "'"; i = a_ident -> <:ctyp< -'$lid:i$ >> + | "+"; "_" -> Ast.TyAnP _loc + | "-"; "_" -> Ast.TyAnM _loc + | "_" -> Ast.TyAny _loc + + ] ] + ; + + ctyp: [ "==" LEFTA [ t1 = SELF; "=="; t2 = SELF -> <:ctyp< $t1$ == $t2$ >> ] @@ -1111,8 +1144,11 @@ <:ctyp< $t1$ | $t2$ >> | s = a_UIDENT; "of"; t = constructor_arg_list -> <:ctyp< $uid:s$ of $t$ >> + | s = a_UIDENT; ":"; t = ctyp -> + let (tl, rt) = generalized_type_of_type t in + <:ctyp< $uid:s$ : ($Ast.tyAnd_of_list tl$ -> $rt$) >> | s = a_UIDENT -> - <:ctyp< $uid:s$ >> + <:ctyp< $uid:s$ >> ] ] ; constructor_declaration: @@ -1364,6 +1400,9 @@ ; cvalue_binding: [ [ "="; e = expr -> e + | ":"; "type"; t1 = unquoted_typevars; "." ; t2 = ctyp ; "="; e = expr -> + let u = Ast.TyTypePol _loc t1 t2 in + <:expr< ($e$ : $u$) >> | ":"; t = poly_type; "="; e = expr -> <:expr< ($e$ : $t$) >> | ":"; t = poly_type; ":>"; t2 = ctyp; "="; e = expr -> match t with @@ -1484,6 +1523,16 @@ | "'"; i = a_ident -> <:ctyp< '$lid:i$ >> ] ] ; + unquoted_typevars: + [ LEFTA + [ t1 = SELF; t2 = SELF -> <:ctyp< $t1$ $t2$ >> + | `ANTIQUOT (""|"typ" as n) s -> + <:ctyp< $anti:mk_anti ~c:"ctyp" n s$ >> + | `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.ctyp_tag + | i = a_ident -> <:ctyp< $lid:i$ >> + ] ] + ; + row_field: [ [ `ANTIQUOT (""|"typ" as n) s -> <:ctyp< $anti:mk_anti ~c:"ctyp" n s$ >> @@ -1741,13 +1790,19 @@ ; str_item_quot: [ [ "#"; n = a_LIDENT; dp = opt_expr -> <:str_item< # $n$ $dp$ >> - | st1 = str_item; semi; st2 = SELF -> <:str_item< $st1$; $st2$ >> + | st1 = str_item; semi; st2 = SELF -> + match st2 with + [ <:str_item<>> -> st1 + | _ -> <:str_item< $st1$; $st2$ >> ] | st = str_item -> st | -> <:str_item<>> ] ] ; sig_item_quot: [ [ "#"; n = a_LIDENT; dp = opt_expr -> <:sig_item< # $n$ $dp$ >> - | sg1 = sig_item; semi; sg2 = SELF -> <:sig_item< $sg1$; $sg2$ >> + | sg1 = sig_item; semi; sg2 = SELF -> + match sg2 with + [ <:sig_item<>> -> sg1 + | _ -> <:sig_item< $sg1$; $sg2$ >> ] | sg = sig_item -> sg | -> <:sig_item<>> ] ] ; @@ -1832,12 +1887,17 @@ ; class_str_item_quot: [ [ x1 = class_str_item; semi; x2 = SELF -> - <:class_str_item< $x1$; $x2$ >> + match x2 with + [ <:class_str_item<>> -> x1 + | _ -> <:class_str_item< $x1$; $x2$ >> ] | x = class_str_item -> x | -> <:class_str_item<>> ] ] ; class_sig_item_quot: - [ [ x1 = class_sig_item; semi; x2 = SELF -> <:class_sig_item< $x1$; $x2$ >> + [ [ x1 = class_sig_item; semi; x2 = SELF -> + match x2 with + [ <:class_sig_item<>> -> x1 + | _ -> <:class_sig_item< $x1$; $x2$ >> ] | x = class_sig_item -> x | -> <:class_sig_item<>> ] ] ; @@ -1858,7 +1918,7 @@ expr_eoi: [ [ x = expr; `EOI -> x ] ] ; - END; + END in apply (); end; diff -Nru ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParserParser.ml ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParserParser.ml --- ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParserParser.ml 2010-06-12 07:48:23.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParserParser.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ open Camlp4; (* -*- camlp4r -*- *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 1998-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4OCamlRevisedQuotationExpander.ml ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4OCamlRevisedQuotationExpander.ml --- ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4OCamlRevisedQuotationExpander.ml 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4OCamlRevisedQuotationExpander.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ open Camlp4; (* -*- camlp4r -*- *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4QuotationCommon.ml ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4QuotationCommon.ml --- ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4QuotationCommon.ml 2011-02-08 14:07:47.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4QuotationCommon.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ open Camlp4; (* -*- camlp4r -*- *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4QuotationExpander.ml ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4QuotationExpander.ml --- ocaml-3.12.1/camlp4/Camlp4Parsers/Camlp4QuotationExpander.ml 2008-10-27 14:03:57.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Parsers/Camlp4QuotationExpander.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ open Camlp4; (* -*- camlp4r -*- *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Printers/Camlp4AstDumper.ml ocaml-4.01.0/camlp4/Camlp4Printers/Camlp4AstDumper.ml --- ocaml-3.12.1/camlp4/Camlp4Printers/Camlp4AstDumper.ml 2007-02-07 10:09:29.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Printers/Camlp4AstDumper.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Printers/Camlp4AutoPrinter.ml ocaml-4.01.0/camlp4/Camlp4Printers/Camlp4AutoPrinter.ml --- ocaml-3.12.1/camlp4/Camlp4Printers/Camlp4AutoPrinter.ml 2007-02-07 10:09:29.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Printers/Camlp4AutoPrinter.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Printers/Camlp4NullDumper.ml ocaml-4.01.0/camlp4/Camlp4Printers/Camlp4NullDumper.ml --- ocaml-3.12.1/camlp4/Camlp4Printers/Camlp4NullDumper.ml 2007-02-07 10:09:29.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Printers/Camlp4NullDumper.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Printers/Camlp4OCamlAstDumper.ml ocaml-4.01.0/camlp4/Camlp4Printers/Camlp4OCamlAstDumper.ml --- ocaml-3.12.1/camlp4/Camlp4Printers/Camlp4OCamlAstDumper.ml 2007-02-07 10:09:29.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Printers/Camlp4OCamlAstDumper.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Printers/Camlp4OCamlPrinter.ml ocaml-4.01.0/camlp4/Camlp4Printers/Camlp4OCamlPrinter.ml --- ocaml-3.12.1/camlp4/Camlp4Printers/Camlp4OCamlPrinter.ml 2007-02-07 10:09:29.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Printers/Camlp4OCamlPrinter.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Printers/Camlp4OCamlRevisedPrinter.ml ocaml-4.01.0/camlp4/Camlp4Printers/Camlp4OCamlRevisedPrinter.ml --- ocaml-3.12.1/camlp4/Camlp4Printers/Camlp4OCamlRevisedPrinter.ml 2007-02-07 10:09:29.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Printers/Camlp4OCamlRevisedPrinter.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/Camlp4Top/Rprint.ml ocaml-4.01.0/camlp4/Camlp4Top/Rprint.ml --- ocaml-3.12.1/camlp4/Camlp4Top/Rprint.ml 2011-05-10 11:19:59.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Top/Rprint.ml 2012-07-30 18:04:46.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -246,10 +246,14 @@ fprintf ppf "@[<1>(%a)@]" print_out_type ty ] in print_tkind ppf -and print_out_constr ppf (name, tyl) = - match tyl with - [ [] -> fprintf ppf "%s" name - | _ -> +and print_out_constr ppf (name, tyl, ret) = + match (tyl,ret) with + [ ([], None) -> fprintf ppf "%s" name + | ([], Some r) -> fprintf ppf "@[<2>%s:@ %a@]" name print_out_type r + | (_,Some r) -> + fprintf ppf "@[<2>%s:@ %a -> %a@]" name + (print_typlist print_out_type " and") tyl print_out_type r + | (_,None) -> fprintf ppf "@[<2>%s of@ %a@]" name (print_typlist print_out_type " and") tyl ] and print_out_label ppf (name, mut, arg) = @@ -297,7 +301,9 @@ ; value type_parameter ppf (ty, (co, cn)) = - fprintf ppf "%s'%s" (if not cn then "+" else if not co then "-" else "") + fprintf ppf "%s%s%s" + (if not cn then "+" else if not co then "-" else "") + (if ty = "_" then "" else "'") ty ; @@ -392,7 +398,7 @@ (if vir_flag then " virtual" else "") print_out_class_params params name Toploop.print_out_class_type.val clt | Osig_exception id tyl -> - fprintf ppf "@[<2>exception %a@]" print_out_constr (id, tyl) + fprintf ppf "@[<2>exception %a@]" print_out_constr (id, tyl,None) | Osig_modtype name Omty_abstract -> fprintf ppf "@[<2>module type %s@]" name | Osig_modtype name mty -> @@ -447,8 +453,13 @@ print_kind ty2 | ty -> print_kind ppf ty ] in - fprintf ppf "@[<2>@[@[%s %t@] =%a@]%a@]" kwd type_defined - print_types ty print_constraints constraints + match ty with + [ Otyp_abstract -> + fprintf ppf "@[<2>@[@[%s %t@]@]%a@]" kwd type_defined + print_constraints constraints + | _ -> + fprintf ppf "@[<2>@[@[%s %t@] =%a@]%a@]" kwd type_defined + print_types ty print_constraints constraints ] ; (* Phrases *) diff -Nru ocaml-3.12.1/camlp4/Camlp4Top/Top.ml ocaml-4.01.0/camlp4/Camlp4Top/Top.ml --- ocaml-3.12.1/camlp4/Camlp4Top/Top.ml 2010-08-16 14:14:10.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4Top/Top.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,15 +1,15 @@ (* camlp4r q_MLast.cmo *) (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -60,45 +60,31 @@ else () end; -value lookup x xs = try Some (List.assq x xs) with [ Not_found -> None ]; - -value wrap parse_fun = - let token_streams = ref [] in - let cleanup lb = - try token_streams.val := List.remove_assq lb token_streams.val - with [ Not_found -> () ] - in - fun lb -> - let () = Lazy.force initialization in - let () = Register.iter_and_take_callbacks (fun (_, f) -> f ()) in - let token_stream = - match lookup lb token_streams.val with - [ None -> - let not_filtered_token_stream = Lexer.from_lexbuf lb in - let token_stream = Gram.filter (not_filtered not_filtered_token_stream) in - do { token_streams.val := [ (lb,token_stream) :: token_streams.val ]; token_stream } - | Some token_stream -> token_stream ] - in try - match token_stream with parser - [ [: `(EOI, _) :] -> raise End_of_file - | [: :] -> parse_fun token_stream ] - with - [ End_of_file | Sys.Break | (Loc.Exc_located _ (End_of_file | Sys.Break)) - as x -> (cleanup lb; raise x) - | x -> - let x = - match x with - [ Loc.Exc_located loc x -> do { +value wrap parse_fun lb = + let () = Lazy.force initialization in + let () = Register.iter_and_take_callbacks (fun (_, f) -> f ()) in + let not_filtered_token_stream = Lexer.from_lexbuf lb in + let token_stream = Gram.filter (not_filtered not_filtered_token_stream) in + try + match token_stream with parser + [ [: `(EOI, _) :] -> raise End_of_file + | [: :] -> parse_fun token_stream ] + with + [ End_of_file | Sys.Break | (Loc.Exc_located _ (End_of_file | Sys.Break)) + as x -> raise x + | x -> + let x = + match x with + [ Loc.Exc_located loc x -> do { Toploop.print_location Format.err_formatter (Loc.to_ocaml_location loc); x } - | x -> x ] - in - do { - cleanup lb; - Format.eprintf "@[<0>%a@]@." Camlp4.ErrorHandler.print x; - raise Exit - } ]; + | x -> x ] + in + do { + Format.eprintf "@[<0>%a@]@." Camlp4.ErrorHandler.print x; + raise Exit + } ]; value toplevel_phrase token_stream = match Gram.parse_tokens_after_filter Syntax.top_phrase token_stream with diff -Nru ocaml-3.12.1/camlp4/Camlp4_config.ml ocaml-4.01.0/camlp4/Camlp4_config.ml --- ocaml-3.12.1/camlp4/Camlp4_config.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4_config.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) @@ -32,8 +32,8 @@ let antiquotations = ref false;; let quotations = ref true;; let inter_phrases = ref None;; -let camlp4_ast_impl_magic_number = "Camlp42006M001";; -let camlp4_ast_intf_magic_number = "Camlp42006N001";; +let camlp4_ast_impl_magic_number = "Camlp42006M002";; +let camlp4_ast_intf_magic_number = "Camlp42006N002";; let ocaml_ast_intf_magic_number = Camlp4_import.Config.ast_intf_magic_number;; let ocaml_ast_impl_magic_number = Camlp4_import.Config.ast_impl_magic_number;; let current_input_file = ref "";; diff -Nru ocaml-3.12.1/camlp4/Camlp4_config.mli ocaml-4.01.0/camlp4/Camlp4_config.mli --- ocaml-3.12.1/camlp4/Camlp4_config.mli 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/Camlp4_config.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/boot/.cvsignore ocaml-4.01.0/camlp4/boot/.cvsignore --- ocaml-3.12.1/camlp4/boot/.cvsignore 2007-02-07 10:09:29.000000000 +0000 +++ ocaml-4.01.0/camlp4/boot/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,5 +0,0 @@ -*.cm[oia] -camlp4 -camlp4o -camlp4r -SAVED diff -Nru ocaml-3.12.1/camlp4/boot/.ignore ocaml-4.01.0/camlp4/boot/.ignore --- ocaml-3.12.1/camlp4/boot/.ignore 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/camlp4/boot/.ignore 2012-07-26 19:21:54.000000000 +0000 @@ -0,0 +1,5 @@ +camlp4 +camlp4o +camlp4r +SAVED +*.old diff -Nru ocaml-3.12.1/camlp4/boot/Camlp4.ml ocaml-4.01.0/camlp4/boot/Camlp4.ml --- ocaml-3.12.1/camlp4/boot/Camlp4.ml 2011-05-18 15:01:07.000000000 +0000 +++ ocaml-4.01.0/camlp4/boot/Camlp4.ml 2013-08-30 11:39:33.000000000 +0000 @@ -2,15 +2,15 @@ sig (****************************************************************************) (* *) - (* Objective Caml *) + (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) - (* exception on linking described in LICENSE at the top of the Objective *) - (* Caml source tree. *) + (* exception on linking described in LICENSE at the top of the OCaml *) + (* source tree. *) (* *) (****************************************************************************) (* Authors: @@ -28,15 +28,15 @@ struct (****************************************************************************) (* *) - (* Objective Caml *) + (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) - (* exception on linking described in LICENSE at the top of the Objective *) - (* Caml source tree. *) + (* exception on linking described in LICENSE at the top of the OCaml *) + (* source tree. *) (* *) (****************************************************************************) (* Authors: @@ -81,25 +81,15 @@ let formatter = let header = "camlp4-debug: " in - let normal s = - let rec self from accu = - try - let i = String.index_from s from '\n' - in self (i + 1) ((String.sub s from ((i - from) + 1)) :: accu) - with - | Not_found -> - (String.sub s from ((String.length s) - from)) :: accu - in String.concat header (List.rev (self 0 [])) in - let after_new_line str = header ^ (normal str) in - let f = ref after_new_line in - let output str chr = - (output_string out_channel (!f str); - output_char out_channel chr; - f := if chr = '\n' then after_new_line else normal) + let at_bol = ref true in make_formatter (fun buf pos len -> - let p = pred len in output (String.sub buf pos p) buf.[pos + p]) + for i = pos to (pos + len) - 1 do + if !at_bol then output_string out_channel header else (); + let ch = buf.[i] + in (output_char out_channel ch; at_bol := ch = '\n') + done) (fun () -> flush out_channel) let printf section fmt = fprintf formatter ("%s: " ^^ fmt) section @@ -110,15 +100,15 @@ sig (****************************************************************************) (* *) - (* Objective Caml *) + (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) - (* exception on linking described in LICENSE at the top of the Objective *) - (* Caml source tree. *) + (* exception on linking described in LICENSE at the top of the OCaml *) + (* source tree. *) (* *) (****************************************************************************) (* Authors: @@ -142,15 +132,15 @@ struct (****************************************************************************) (* *) - (* Objective Caml *) + (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) - (* exception on linking described in LICENSE at the top of the Objective *) - (* Caml source tree. *) + (* exception on linking described in LICENSE at the top of the OCaml *) + (* source tree. *) (* *) (****************************************************************************) (* Authors: @@ -357,15 +347,15 @@ (* camlp4r *) (****************************************************************************) (* *) - (* Objective Caml *) + (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) - (* exception on linking described in LICENSE at the top of the Objective *) - (* Caml source tree. *) + (* exception on linking described in LICENSE at the top of the OCaml *) + (* source tree. *) (* *) (****************************************************************************) (* Authors: @@ -424,6 +414,16 @@ (** A signature for locations. *) module type Loc = sig + (** The type of locations. Note that, as for OCaml locations, + character numbers in locations refer to character numbers in the + parsed character stream, while line numbers refer to line + numbers in the source file. The source file and the parsed + character stream differ, for instance, when the parsed character + stream contains a line number directive. The line number + directive will only update the file-name field and the + line-number field of the position. It makes therefore no sense + to use character numbers with the source file if the sources + contain line number directives. *) type t (** Return a start location for the given file name. @@ -457,7 +457,8 @@ val to_tuple : t -> (string * int * int * int * int * int * int * bool) - (** [merge loc1 loc2] Return a location that starts at [loc1] and end at [loc2]. *) + (** [merge loc1 loc2] Return a location that starts at [loc1] and end at + [loc2]. *) val merge : t -> t -> t (** The stop pos becomes equal to the start pos. *) @@ -488,19 +489,19 @@ (** Return the line number of the ending of this location. *) val stop_line : t -> int - (** Returns the number of characters from the begining of the file + (** Returns the number of characters from the begining of the stream to the begining of the line of location's begining. *) val start_bol : t -> int - (** Returns the number of characters from the begining of the file + (** Returns the number of characters from the begining of the stream to the begining of the line of location's ending. *) val stop_bol : t -> int - (** Returns the number of characters from the begining of the file + (** Returns the number of characters from the begining of the stream of the begining of this location. *) val start_off : t -> int - (** Return the number of characters from the begining of the file + (** Return the number of characters from the begining of the stream of the ending of this location. *) val stop_off : t -> int @@ -671,145 +672,83 @@ class map : object ('self_type) method string : string -> string - method list : 'a 'b. ('self_type -> 'a -> 'b) -> 'a list -> 'b list - method meta_bool : meta_bool -> meta_bool - method meta_option : 'a 'b. ('self_type -> 'a -> 'b) -> 'a meta_option -> 'b meta_option - method meta_list : 'a 'b. ('self_type -> 'a -> 'b) -> 'a meta_list -> 'b meta_list - method loc : loc -> loc - method expr : expr -> expr - method patt : patt -> patt - method ctyp : ctyp -> ctyp - method str_item : str_item -> str_item - method sig_item : sig_item -> sig_item - method module_expr : module_expr -> module_expr - method module_type : module_type -> module_type - method class_expr : class_expr -> class_expr - method class_type : class_type -> class_type - method class_sig_item : class_sig_item -> class_sig_item - method class_str_item : class_str_item -> class_str_item - method with_constr : with_constr -> with_constr - method binding : binding -> binding - method rec_binding : rec_binding -> rec_binding - method module_binding : module_binding -> module_binding - method match_case : match_case -> match_case - method ident : ident -> ident - method override_flag : override_flag -> override_flag - method mutable_flag : mutable_flag -> mutable_flag - method private_flag : private_flag -> private_flag - method virtual_flag : virtual_flag -> virtual_flag - method direction_flag : direction_flag -> direction_flag - method rec_flag : rec_flag -> rec_flag - method row_var_flag : row_var_flag -> row_var_flag - method unknown : 'a. 'a -> 'a - end (** Fold style traversal *) class fold : object ('self_type) method string : string -> 'self_type - method list : 'a. ('self_type -> 'a -> 'self_type) -> 'a list -> 'self_type - method meta_bool : meta_bool -> 'self_type - method meta_option : 'a. ('self_type -> 'a -> 'self_type) -> 'a meta_option -> 'self_type - method meta_list : 'a. ('self_type -> 'a -> 'self_type) -> 'a meta_list -> 'self_type - method loc : loc -> 'self_type - method expr : expr -> 'self_type - method patt : patt -> 'self_type - method ctyp : ctyp -> 'self_type - method str_item : str_item -> 'self_type - method sig_item : sig_item -> 'self_type - method module_expr : module_expr -> 'self_type - method module_type : module_type -> 'self_type - method class_expr : class_expr -> 'self_type - method class_type : class_type -> 'self_type - method class_sig_item : class_sig_item -> 'self_type - method class_str_item : class_str_item -> 'self_type - method with_constr : with_constr -> 'self_type - method binding : binding -> 'self_type - method rec_binding : rec_binding -> 'self_type - method module_binding : module_binding -> 'self_type - method match_case : match_case -> 'self_type - method ident : ident -> 'self_type - method rec_flag : rec_flag -> 'self_type - method direction_flag : direction_flag -> 'self_type - method mutable_flag : mutable_flag -> 'self_type - method private_flag : private_flag -> 'self_type - method virtual_flag : virtual_flag -> 'self_type - method row_var_flag : row_var_flag -> 'self_type - method override_flag : override_flag -> 'self_type - method unknown : 'a. 'a -> 'self_type - end end @@ -850,6 +789,21 @@ (** The inner module for locations *) module Loc : Loc + (****************************************************************************) + (* *) + (* OCaml *) + (* *) + (* INRIA Rocquencourt *) + (* *) + (* Copyright 2007 Institut National de Recherche en Informatique et *) + (* en Automatique. All rights reserved. This file is distributed under *) + (* the terms of the GNU Library General Public License, with the special *) + (* exception on linking described in LICENSE at the top of the OCaml *) + (* source tree. *) + (* *) + (****************************************************************************) + (* Note: when you modify these types you must increment + ast magic numbers defined in Camlp4_config.ml. *) type loc = Loc. t @@ -918,12 +872,19 @@ TyPol of loc * ctyp * ctyp | (* ! t . t *) (* ! 'a . list 'a -> 'a *) + TyTypePol of loc * ctyp * ctyp + | (* type t . t *) + (* type a . list a -> a *) TyQuo of loc * string | (* 's *) TyQuP of loc * string | (* +'s *) TyQuM of loc * string | (* -'s *) + TyAnP of loc + | (* +_ *) + TyAnM of loc + | (* -_ *) TyVrn of loc * string | (* `s *) TyRec of loc * ctyp @@ -1023,7 +984,9 @@ PaVrn of loc * string | (* `s *) PaLaz of loc * patt - and (* lazy p *) + | (* lazy p *) + PaMod of loc * string + and (* (module M) *) expr = | ExNil of loc | ExId of loc * ident @@ -1537,144 +1500,82 @@ class map : object ('self_type) method string : string -> string - method list : 'a 'b. ('self_type -> 'a -> 'b) -> 'a list -> 'b list - method meta_bool : meta_bool -> meta_bool - method meta_option : 'a 'b. ('self_type -> 'a -> 'b) -> 'a meta_option -> 'b meta_option - method meta_list : 'a 'b. ('self_type -> 'a -> 'b) -> 'a meta_list -> 'b meta_list - method loc : loc -> loc - method expr : expr -> expr - method patt : patt -> patt - method ctyp : ctyp -> ctyp - method str_item : str_item -> str_item - method sig_item : sig_item -> sig_item - method module_expr : module_expr -> module_expr - method module_type : module_type -> module_type - method class_expr : class_expr -> class_expr - method class_type : class_type -> class_type - method class_sig_item : class_sig_item -> class_sig_item - method class_str_item : class_str_item -> class_str_item - method with_constr : with_constr -> with_constr - method binding : binding -> binding - method rec_binding : rec_binding -> rec_binding - method module_binding : module_binding -> module_binding - method match_case : match_case -> match_case - method ident : ident -> ident - method mutable_flag : mutable_flag -> mutable_flag - method private_flag : private_flag -> private_flag - method virtual_flag : virtual_flag -> virtual_flag - method direction_flag : direction_flag -> direction_flag - method rec_flag : rec_flag -> rec_flag - method row_var_flag : row_var_flag -> row_var_flag - method override_flag : override_flag -> override_flag - method unknown : 'a. 'a -> 'a - end class fold : object ('self_type) method string : string -> 'self_type - method list : 'a. ('self_type -> 'a -> 'self_type) -> 'a list -> 'self_type - method meta_bool : meta_bool -> 'self_type - method meta_option : 'a. ('self_type -> 'a -> 'self_type) -> 'a meta_option -> 'self_type - method meta_list : 'a. ('self_type -> 'a -> 'self_type) -> 'a meta_list -> 'self_type - method loc : loc -> 'self_type - method expr : expr -> 'self_type - method patt : patt -> 'self_type - method ctyp : ctyp -> 'self_type - method str_item : str_item -> 'self_type - method sig_item : sig_item -> 'self_type - method module_expr : module_expr -> 'self_type - method module_type : module_type -> 'self_type - method class_expr : class_expr -> 'self_type - method class_type : class_type -> 'self_type - method class_sig_item : class_sig_item -> 'self_type - method class_str_item : class_str_item -> 'self_type - method with_constr : with_constr -> 'self_type - method binding : binding -> 'self_type - method rec_binding : rec_binding -> 'self_type - method module_binding : module_binding -> 'self_type - method match_case : match_case -> 'self_type - method ident : ident -> 'self_type - method rec_flag : rec_flag -> 'self_type - method direction_flag : direction_flag -> 'self_type - method mutable_flag : mutable_flag -> 'self_type - method private_flag : private_flag -> 'self_type - method virtual_flag : virtual_flag -> 'self_type - method row_var_flag : row_var_flag -> 'self_type - method override_flag : override_flag -> 'self_type - method unknown : 'a. 'a -> 'self_type - end val map_expr : (expr -> expr) -> map @@ -1878,9 +1779,12 @@ | TyObj of loc * ctyp * row_var_flag | TyOlb of loc * string * ctyp | TyPol of loc * ctyp * ctyp + | TyTypePol of loc * ctyp * ctyp | TyQuo of loc * string | TyQuP of loc * string | TyQuM of loc * string + | TyAnP of loc + | TyAnM of loc | TyVrn of loc * string | TyRec of loc * ctyp | TyCol of loc * ctyp * ctyp @@ -1931,6 +1835,7 @@ | PaTyp of loc * ident | PaVrn of loc * string | PaLaz of loc * patt + | PaMod of loc * string and expr = | ExNil of loc | ExId of loc * ident @@ -3626,7 +3531,7 @@ let skip_opt_linefeed (__strm : _ Stream.t) = match Stream.peek __strm with - | Some '\010' -> (Stream.junk __strm; ()) + | Some '\n' -> (Stream.junk __strm; ()) | _ -> () let chr c = @@ -3636,8 +3541,8 @@ let rec backslash (__strm : _ Stream.t) = match Stream.peek __strm with - | Some '\010' -> (Stream.junk __strm; '\010') - | Some '\013' -> (Stream.junk __strm; '\013') + | Some '\n' -> (Stream.junk __strm; '\n') + | Some '\r' -> (Stream.junk __strm; '\r') | Some 'n' -> (Stream.junk __strm; '\n') | Some 'r' -> (Stream.junk __strm; '\r') | Some 't' -> (Stream.junk __strm; '\t') @@ -3676,8 +3581,8 @@ let rec backslash_in_string strict store (__strm : _ Stream.t) = match Stream.peek __strm with - | Some '\010' -> (Stream.junk __strm; skip_indent __strm) - | Some '\013' -> + | Some '\n' -> (Stream.junk __strm; skip_indent __strm) + | Some '\r' -> (Stream.junk __strm; let s = __strm in (skip_opt_linefeed s; skip_indent s)) | _ -> @@ -3880,6 +3785,15 @@ pos_bol = pos.pos_cnum - chars; } + let cvt_int_literal s = - (int_of_string ("-" ^ s)) + + let cvt_int32_literal s = Int32.neg (Int32.of_string ("-" ^ s)) + + let cvt_int64_literal s = Int64.neg (Int64.of_string ("-" ^ s)) + + let cvt_nativeint_literal s = + Nativeint.neg (Nativeint.of_string ("-" ^ s)) + let err error loc = raise (Loc.Exc_located (loc, (Error.E error))) @@ -6473,7 +6387,7 @@ Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos lexbuf.Lexing.lex_curr_pos in - (try INT ((int_of_string i), i) + (try INT ((cvt_int_literal i), i) with | Failure _ -> err (Literal_overflow "int") (Loc.of_lexbuf lexbuf)) @@ -6492,7 +6406,7 @@ Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos (lexbuf.Lexing.lex_curr_pos + (-1)) in - (try INT32 ((Int32.of_string i), i) + (try INT32 ((cvt_int32_literal i), i) with | Failure _ -> err (Literal_overflow "int32") @@ -6502,7 +6416,7 @@ Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos (lexbuf.Lexing.lex_curr_pos + (-1)) in - (try INT64 ((Int64.of_string i), i) + (try INT64 ((cvt_int64_literal i), i) with | Failure _ -> err (Literal_overflow "int64") @@ -6512,7 +6426,7 @@ Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos (lexbuf.Lexing.lex_curr_pos + (-1)) in - (try NATIVEINT ((Nativeint.of_string i), i) + (try NATIVEINT ((cvt_nativeint_literal i), i) with | Failure _ -> err (Literal_overflow "nativeint") @@ -7030,6 +6944,7 @@ | Ast.PaLab (_, _, p) -> is_irrefut_patt p | Ast.PaLaz (_, p) -> is_irrefut_patt p | Ast.PaId (_, _) -> false + | Ast.PaMod (_, _) -> true | Ast.PaVrn (_, _) | Ast.PaStr (_, _) | Ast.PaRng (_, _, _) | Ast.PaFlo (_, _) | Ast.PaNativeInt (_, _) | Ast.PaInt64 (_, _) | Ast.PaInt32 (_, _) | Ast.PaInt (_, _) @@ -7503,13 +7418,15 @@ module Expr = struct - let meta_string _loc s = Ast.ExStr (_loc, s) + let meta_string _loc s = + Ast.ExStr (_loc, (safe_string_escaped s)) let meta_int _loc s = Ast.ExInt (_loc, s) let meta_float _loc s = Ast.ExFlo (_loc, s) - let meta_char _loc s = Ast.ExChr (_loc, s) + let meta_char _loc s = + Ast.ExChr (_loc, (String.escaped s)) let meta_bool _loc = function @@ -8138,6 +8055,20 @@ (Ast.IdUid (_loc, "TyVrn")))))), (meta_loc _loc x0))), (meta_string _loc x1)) + | Ast.TyAnM x0 -> + Ast.ExApp (_loc, + (Ast.ExId (_loc, + (Ast.IdAcc (_loc, + (Ast.IdUid (_loc, "Ast")), + (Ast.IdUid (_loc, "TyAnM")))))), + (meta_loc _loc x0)) + | Ast.TyAnP x0 -> + Ast.ExApp (_loc, + (Ast.ExId (_loc, + (Ast.IdAcc (_loc, + (Ast.IdUid (_loc, "Ast")), + (Ast.IdUid (_loc, "TyAnP")))))), + (meta_loc _loc x0)) | Ast.TyQuM (x0, x1) -> Ast.ExApp (_loc, (Ast.ExApp (_loc, @@ -8165,6 +8096,17 @@ (Ast.IdUid (_loc, "TyQuo")))))), (meta_loc _loc x0))), (meta_string _loc x1)) + | Ast.TyTypePol (x0, x1, x2) -> + Ast.ExApp (_loc, + (Ast.ExApp (_loc, + (Ast.ExApp (_loc, + (Ast.ExId (_loc, + (Ast.IdAcc (_loc, + (Ast.IdUid (_loc, "Ast")), + (Ast.IdUid (_loc, "TyTypePol")))))), + (meta_loc _loc x0))), + (meta_ctyp _loc x1))), + (meta_ctyp _loc x2)) | Ast.TyPol (x0, x1, x2) -> Ast.ExApp (_loc, (Ast.ExApp (_loc, @@ -9093,6 +9035,15 @@ (Ast.IdUid (_loc, "OvOverride"))))) and meta_patt _loc = function + | Ast.PaMod (x0, x1) -> + Ast.ExApp (_loc, + (Ast.ExApp (_loc, + (Ast.ExId (_loc, + (Ast.IdAcc (_loc, + (Ast.IdUid (_loc, "Ast")), + (Ast.IdUid (_loc, "PaMod")))))), + (meta_loc _loc x0))), + (meta_string _loc x1)) | Ast.PaLaz (x0, x1) -> Ast.ExApp (_loc, (Ast.ExApp (_loc, @@ -9798,13 +9749,15 @@ module Patt = struct - let meta_string _loc s = Ast.PaStr (_loc, s) + let meta_string _loc s = + Ast.PaStr (_loc, (safe_string_escaped s)) let meta_int _loc s = Ast.PaInt (_loc, s) let meta_float _loc s = Ast.PaFlo (_loc, s) - let meta_char _loc s = Ast.PaChr (_loc, s) + let meta_char _loc s = + Ast.PaChr (_loc, (String.escaped s)) let meta_bool _loc = function @@ -10433,6 +10386,20 @@ (Ast.IdUid (_loc, "TyVrn")))))), (meta_loc _loc x0))), (meta_string _loc x1)) + | Ast.TyAnM x0 -> + Ast.PaApp (_loc, + (Ast.PaId (_loc, + (Ast.IdAcc (_loc, + (Ast.IdUid (_loc, "Ast")), + (Ast.IdUid (_loc, "TyAnM")))))), + (meta_loc _loc x0)) + | Ast.TyAnP x0 -> + Ast.PaApp (_loc, + (Ast.PaId (_loc, + (Ast.IdAcc (_loc, + (Ast.IdUid (_loc, "Ast")), + (Ast.IdUid (_loc, "TyAnP")))))), + (meta_loc _loc x0)) | Ast.TyQuM (x0, x1) -> Ast.PaApp (_loc, (Ast.PaApp (_loc, @@ -10460,6 +10427,17 @@ (Ast.IdUid (_loc, "TyQuo")))))), (meta_loc _loc x0))), (meta_string _loc x1)) + | Ast.TyTypePol (x0, x1, x2) -> + Ast.PaApp (_loc, + (Ast.PaApp (_loc, + (Ast.PaApp (_loc, + (Ast.PaId (_loc, + (Ast.IdAcc (_loc, + (Ast.IdUid (_loc, "Ast")), + (Ast.IdUid (_loc, "TyTypePol")))))), + (meta_loc _loc x0))), + (meta_ctyp _loc x1))), + (meta_ctyp _loc x2)) | Ast.TyPol (x0, x1, x2) -> Ast.PaApp (_loc, (Ast.PaApp (_loc, @@ -11388,6 +11366,15 @@ (Ast.IdUid (_loc, "OvOverride"))))) and meta_patt _loc = function + | Ast.PaMod (x0, x1) -> + Ast.PaApp (_loc, + (Ast.PaApp (_loc, + (Ast.PaId (_loc, + (Ast.IdAcc (_loc, + (Ast.IdUid (_loc, "Ast")), + (Ast.IdUid (_loc, "PaMod")))))), + (meta_loc _loc x0))), + (meta_string _loc x1)) | Ast.PaLaz (x0, x1) -> Ast.PaApp (_loc, (Ast.PaApp (_loc, @@ -12096,7 +12083,6 @@ class map = object ((o : 'self_type)) method string : string -> string = o#unknown - method list : 'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a list -> 'a_out list = @@ -12106,7 +12092,6 @@ | _x :: _x_i1 -> let _x = _f_a o _x in let _x_i1 = o#list _f_a _x_i1 in _x :: _x_i1 - method with_constr : with_constr -> with_constr = function | WcNil _x -> let _x = o#loc _x in WcNil _x @@ -12134,13 +12119,11 @@ | WcAnt (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in WcAnt (_x, _x_i1) - method virtual_flag : virtual_flag -> virtual_flag = function | ViVirtual -> ViVirtual | ViNil -> ViNil | ViAnt _x -> let _x = o#string _x in ViAnt _x - method str_item : str_item -> str_item = function | StNil _x -> let _x = o#loc _x in StNil _x @@ -12203,7 +12186,6 @@ | StAnt (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in StAnt (_x, _x_i1) - method sig_item : sig_item -> sig_item = function | SgNil _x -> let _x = o#loc _x in SgNil _x @@ -12261,19 +12243,16 @@ | SgAnt (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in SgAnt (_x, _x_i1) - method row_var_flag : row_var_flag -> row_var_flag = function | RvRowVar -> RvRowVar | RvNil -> RvNil | RvAnt _x -> let _x = o#string _x in RvAnt _x - method rec_flag : rec_flag -> rec_flag = function | ReRecursive -> ReRecursive | ReNil -> ReNil | ReAnt _x -> let _x = o#string _x in ReAnt _x - method rec_binding : rec_binding -> rec_binding = function | RbNil _x -> let _x = o#loc _x in RbNil _x @@ -12289,13 +12268,11 @@ | RbAnt (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in RbAnt (_x, _x_i1) - method private_flag : private_flag -> private_flag = function | PrPrivate -> PrPrivate | PrNil -> PrNil | PrAnt _x -> let _x = o#string _x in PrAnt _x - method patt : patt -> patt = function | PaNil _x -> let _x = o#loc _x in PaNil _x @@ -12391,19 +12368,19 @@ | PaLaz (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#patt _x_i1 in PaLaz (_x, _x_i1) - + | PaMod (_x, _x_i1) -> + let _x = o#loc _x in + let _x_i1 = o#string _x_i1 in PaMod (_x, _x_i1) method override_flag : override_flag -> override_flag = function | OvOverride -> OvOverride | OvNil -> OvNil | OvAnt _x -> let _x = o#string _x in OvAnt _x - method mutable_flag : mutable_flag -> mutable_flag = function | MuMutable -> MuMutable | MuNil -> MuNil | MuAnt _x -> let _x = o#string _x in MuAnt _x - method module_type : module_type -> module_type = function | MtNil _x -> let _x = o#loc _x in MtNil _x @@ -12433,7 +12410,6 @@ | MtAnt (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in MtAnt (_x, _x_i1) - method module_expr : module_expr -> module_expr = function | MeNil _x -> let _x = o#loc _x in MeNil _x @@ -12465,7 +12441,6 @@ | MeAnt (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in MeAnt (_x, _x_i1) - method module_binding : module_binding -> module_binding = function | MbNil _x -> let _x = o#loc _x in MbNil _x @@ -12488,7 +12463,6 @@ | MbAnt (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in MbAnt (_x, _x_i1) - method meta_option : 'a 'a_out. ('self_type -> 'a -> 'a_out) -> @@ -12498,7 +12472,6 @@ | ONone -> ONone | OSome _x -> let _x = _f_a o _x in OSome _x | OAnt _x -> let _x = o#string _x in OAnt _x - method meta_list : 'a 'a_out. ('self_type -> 'a -> 'a_out) -> @@ -12511,13 +12484,11 @@ let _x_i1 = o#meta_list _f_a _x_i1 in LCons (_x, _x_i1) | LAnt _x -> let _x = o#string _x in LAnt _x - method meta_bool : meta_bool -> meta_bool = function | BTrue -> BTrue | BFalse -> BFalse | BAnt _x -> let _x = o#string _x in BAnt _x - method match_case : match_case -> match_case = function | McNil _x -> let _x = o#loc _x in McNil _x @@ -12535,9 +12506,7 @@ | McAnt (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in McAnt (_x, _x_i1) - method loc : loc -> loc = o#unknown - method ident : ident -> ident = function | IdAcc (_x, _x_i1, _x_i2) -> @@ -12557,7 +12526,6 @@ | IdAnt (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in IdAnt (_x, _x_i1) - method expr : expr -> expr = function | ExNil _x -> let _x = o#loc _x in ExNil _x @@ -12726,13 +12694,11 @@ | ExPkg (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#module_expr _x_i1 in ExPkg (_x, _x_i1) - method direction_flag : direction_flag -> direction_flag = function | DiTo -> DiTo | DiDownto -> DiDownto | DiAnt _x -> let _x = o#string _x in DiAnt _x - method ctyp : ctyp -> ctyp = function | TyNil _x -> let _x = o#loc _x in TyNil _x @@ -12788,6 +12754,11 @@ let _x = o#loc _x in let _x_i1 = o#ctyp _x_i1 in let _x_i2 = o#ctyp _x_i2 in TyPol (_x, _x_i1, _x_i2) + | TyTypePol (_x, _x_i1, _x_i2) -> + let _x = o#loc _x in + let _x_i1 = o#ctyp _x_i1 in + let _x_i2 = o#ctyp _x_i2 + in TyTypePol (_x, _x_i1, _x_i2) | TyQuo (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in TyQuo (_x, _x_i1) @@ -12797,6 +12768,8 @@ | TyQuM (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in TyQuM (_x, _x_i1) + | TyAnP _x -> let _x = o#loc _x in TyAnP _x + | TyAnM _x -> let _x = o#loc _x in TyAnM _x | TyVrn (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in TyVrn (_x, _x_i1) @@ -12871,7 +12844,6 @@ | TyAnt (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in TyAnt (_x, _x_i1) - method class_type : class_type -> class_type = function | CtNil _x -> let _x = o#loc _x in CtNil _x @@ -12909,7 +12881,6 @@ | CtAnt (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in CtAnt (_x, _x_i1) - method class_str_item : class_str_item -> class_str_item = function | CrNil _x -> let _x = o#loc _x in CrNil _x @@ -12961,7 +12932,6 @@ | CrAnt (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in CrAnt (_x, _x_i1) - method class_sig_item : class_sig_item -> class_sig_item = function | CgNil _x -> let _x = o#loc _x in CgNil _x @@ -12999,7 +12969,6 @@ | CgAnt (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in CgAnt (_x, _x_i1) - method class_expr : class_expr -> class_expr = function | CeNil _x -> let _x = o#loc _x in CeNil _x @@ -13047,7 +13016,6 @@ | CeAnt (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in CeAnt (_x, _x_i1) - method binding : binding -> binding = function | BiNil _x -> let _x = o#loc _x in BiNil _x @@ -13062,15 +13030,12 @@ | BiAnt (_x, _x_i1) -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in BiAnt (_x, _x_i1) - method unknown : 'a. 'a -> 'a = fun x -> x - end class fold = object ((o : 'self_type)) method string : string -> 'self_type = o#unknown - method list : 'a. ('self_type -> 'a -> 'self_type) -> 'a list -> 'self_type = @@ -13079,7 +13044,6 @@ | [] -> o | _x :: _x_i1 -> let o = _f_a o _x in let o = o#list _f_a _x_i1 in o - method with_constr : with_constr -> 'self_type = function | WcNil _x -> let o = o#loc _x in o @@ -13101,13 +13065,11 @@ let o = o#with_constr _x_i2 in o | WcAnt (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o - method virtual_flag : virtual_flag -> 'self_type = function | ViVirtual -> o | ViNil -> o | ViAnt _x -> let o = o#string _x in o - method str_item : str_item -> 'self_type = function | StNil _x -> let o = o#loc _x in o @@ -13155,7 +13117,6 @@ let o = o#binding _x_i2 in o | StAnt (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o - method sig_item : sig_item -> 'self_type = function | SgNil _x -> let o = o#loc _x in o @@ -13198,19 +13159,16 @@ let o = o#string _x_i1 in let o = o#ctyp _x_i2 in o | SgAnt (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o - method row_var_flag : row_var_flag -> 'self_type = function | RvRowVar -> o | RvNil -> o | RvAnt _x -> let o = o#string _x in o - method rec_flag : rec_flag -> 'self_type = function | ReRecursive -> o | ReNil -> o | ReAnt _x -> let o = o#string _x in o - method rec_binding : rec_binding -> 'self_type = function | RbNil _x -> let o = o#loc _x in o @@ -13223,13 +13181,11 @@ let o = o#ident _x_i1 in let o = o#expr _x_i2 in o | RbAnt (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o - method private_flag : private_flag -> 'self_type = function | PrPrivate -> o | PrNil -> o | PrAnt _x -> let o = o#string _x in o - method patt : patt -> 'self_type = function | PaNil _x -> let o = o#loc _x in o @@ -13298,19 +13254,18 @@ let o = o#loc _x in let o = o#string _x_i1 in o | PaLaz (_x, _x_i1) -> let o = o#loc _x in let o = o#patt _x_i1 in o - + | PaMod (_x, _x_i1) -> + let o = o#loc _x in let o = o#string _x_i1 in o method override_flag : override_flag -> 'self_type = function | OvOverride -> o | OvNil -> o | OvAnt _x -> let o = o#string _x in o - method mutable_flag : mutable_flag -> 'self_type = function | MuMutable -> o | MuNil -> o | MuAnt _x -> let o = o#string _x in o - method module_type : module_type -> 'self_type = function | MtNil _x -> let o = o#loc _x in o @@ -13333,7 +13288,6 @@ let o = o#loc _x in let o = o#module_expr _x_i1 in o | MtAnt (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o - method module_expr : module_expr -> 'self_type = function | MeNil _x -> let o = o#loc _x in o @@ -13358,7 +13312,6 @@ let o = o#loc _x in let o = o#expr _x_i1 in o | MeAnt (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o - method module_binding : module_binding -> 'self_type = function | MbNil _x -> let o = o#loc _x in o @@ -13377,7 +13330,6 @@ let o = o#module_type _x_i2 in o | MbAnt (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o - method meta_option : 'a. ('self_type -> 'a -> 'self_type) -> @@ -13387,7 +13339,6 @@ | ONone -> o | OSome _x -> let o = _f_a o _x in o | OAnt _x -> let o = o#string _x in o - method meta_list : 'a. ('self_type -> 'a -> 'self_type) -> @@ -13399,13 +13350,11 @@ let o = _f_a o _x in let o = o#meta_list _f_a _x_i1 in o | LAnt _x -> let o = o#string _x in o - method meta_bool : meta_bool -> 'self_type = function | BTrue -> o | BFalse -> o | BAnt _x -> let o = o#string _x in o - method match_case : match_case -> 'self_type = function | McNil _x -> let o = o#loc _x in o @@ -13419,9 +13368,7 @@ let o = o#expr _x_i2 in let o = o#expr _x_i3 in o | McAnt (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o - method loc : loc -> 'self_type = o#unknown - method ident : ident -> 'self_type = function | IdAcc (_x, _x_i1, _x_i2) -> @@ -13436,7 +13383,6 @@ let o = o#loc _x in let o = o#string _x_i1 in o | IdAnt (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o - method expr : expr -> 'self_type = function | ExNil _x -> let o = o#loc _x in o @@ -13559,13 +13505,11 @@ let o = o#string _x_i1 in let o = o#expr _x_i2 in o | ExPkg (_x, _x_i1) -> let o = o#loc _x in let o = o#module_expr _x_i1 in o - method direction_flag : direction_flag -> 'self_type = function | DiTo -> o | DiDownto -> o | DiAnt _x -> let o = o#string _x in o - method ctyp : ctyp -> 'self_type = function | TyNil _x -> let o = o#loc _x in o @@ -13610,12 +13554,17 @@ | TyPol (_x, _x_i1, _x_i2) -> let o = o#loc _x in let o = o#ctyp _x_i1 in let o = o#ctyp _x_i2 in o + | TyTypePol (_x, _x_i1, _x_i2) -> + let o = o#loc _x in + let o = o#ctyp _x_i1 in let o = o#ctyp _x_i2 in o | TyQuo (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o | TyQuP (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o | TyQuM (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o + | TyAnP _x -> let o = o#loc _x in o + | TyAnM _x -> let o = o#loc _x in o | TyVrn (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o | TyRec (_x, _x_i1) -> @@ -13668,7 +13617,6 @@ let o = o#loc _x in let o = o#module_type _x_i1 in o | TyAnt (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o - method class_type : class_type -> 'self_type = function | CtNil _x -> let o = o#loc _x in o @@ -13697,7 +13645,6 @@ let o = o#class_type _x_i2 in o | CtAnt (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o - method class_str_item : class_str_item -> 'self_type = function | CrNil _x -> let o = o#loc _x in o @@ -13739,7 +13686,6 @@ let o = o#ctyp _x_i3 in o | CrAnt (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o - method class_sig_item : class_sig_item -> 'self_type = function | CgNil _x -> let o = o#loc _x in o @@ -13770,7 +13716,6 @@ let o = o#ctyp _x_i3 in o | CgAnt (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o - method class_expr : class_expr -> 'self_type = function | CeNil _x -> let o = o#loc _x in o @@ -13807,7 +13752,6 @@ let o = o#class_expr _x_i2 in o | CeAnt (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o - method binding : binding -> 'self_type = function | BiNil _x -> let o = o#loc _x in o @@ -13819,57 +13763,43 @@ let o = o#patt _x_i1 in let o = o#expr _x_i2 in o | BiAnt (_x, _x_i1) -> let o = o#loc _x in let o = o#string _x_i1 in o - method unknown : 'a. 'a -> 'self_type = fun _ -> o - end let map_expr f = object inherit map as super - method expr = fun x -> f (super#expr x) - end let map_patt f = object inherit map as super - method patt = fun x -> f (super#patt x) - end let map_ctyp f = object inherit map as super - method ctyp = fun x -> f (super#ctyp x) - end let map_str_item f = object inherit map as super - method str_item = fun x -> f (super#str_item x) - end let map_sig_item f = object inherit map as super - method sig_item = fun x -> f (super#sig_item x) - end let map_loc f = object inherit map as super - method loc = fun x -> f (super#loc x) - end end @@ -14236,6 +14166,9 @@ let mkghloc loc = Loc.to_ocaml_location (Loc.ghostify loc) + let with_loc txt loc = + Camlp4_import.Location.mkloc txt (mkloc loc) + let mktyp loc d = { ptyp_desc = d; ptyp_loc = mkloc loc; } let mkpat loc d = { ppat_desc = d; ppat_loc = mkloc loc; } @@ -14256,7 +14189,11 @@ let mkcty loc d = { pcty_desc = d; pcty_loc = mkloc loc; } - let mkpcl loc d = { pcl_desc = d; pcl_loc = mkloc loc; } + let mkcl loc d = { pcl_desc = d; pcl_loc = mkloc loc; } + + let mkcf loc d = { pcf_desc = d; pcf_loc = mkloc loc; } + + let mkctf loc d = { pctf_desc = d; pctf_loc = mkloc loc; } let mkpolytype t = match t.ptyp_desc with @@ -14277,6 +14214,8 @@ let lident s = Lident s + let lident_with_loc s loc = with_loc (Lident s) loc + let ldot l s = Ldot (l, s) let lapply l s = Lapply (l, s) @@ -14296,20 +14235,23 @@ [ ("val", "contents") ]; fun s -> try Hashtbl.find t s with | Not_found -> s) - let array_function str name = + let array_function_no_loc str name = ldot (lident str) (if !Camlp4_config.unsafe then "unsafe_" ^ name else name) + let array_function loc str name = + with_loc (array_function_no_loc str name) loc + let mkrf = function | Ast.ReRecursive -> Recursive | Ast.ReNil -> Nonrecursive | _ -> assert false - let mkli s = + let mkli sloc s list = let rec loop f = function | i :: il -> loop (ldot (f i)) il | [] -> f s - in loop lident + in with_loc (loop lident list) sloc let rec ctyp_fa al = function @@ -14319,6 +14261,9 @@ let ident_tag ?(conv_lid = fun x -> x) i = let rec self i acc = match i with + | Ast.IdAcc (_, (Ast.IdLid (_, "*predef*")), + (Ast.IdLid (_, "option"))) -> + ((ldot (lident "*predef*") "option"), `lident) | Ast.IdAcc (_, i1, i2) -> self i2 (Some (self i1 acc)) | Ast.IdApp (_, i1, i2) -> let i' = @@ -14349,27 +14294,33 @@ | _ -> error (loc_of_ident i) "invalid long identifier" in self i None - let ident ?conv_lid i = fst (ident_tag ?conv_lid i) + let ident_noloc ?conv_lid i = fst (ident_tag ?conv_lid i) - let long_lident msg i = - match ident_tag i with - | (i, `lident) -> i - | _ -> error (loc_of_ident i) msg + let ident ?conv_lid i = + with_loc (ident_noloc ?conv_lid i) (loc_of_ident i) + + let long_lident msg id = + match ident_tag id with + | (i, `lident) -> with_loc i (loc_of_ident id) + | _ -> error (loc_of_ident id) msg let long_type_ident = long_lident "invalid long identifier type" let long_class_ident = long_lident "invalid class name" - let long_uident ?(conv_con = fun x -> x) i = + let long_uident_noloc ?(conv_con = fun x -> x) i = match ident_tag i with | (Ldot (i, s), `uident) -> ldot i (conv_con s) | (Lident s, `uident) -> lident (conv_con s) | (i, `app) -> i | _ -> error (loc_of_ident i) "uppercase identifier expected" + let long_uident ?conv_con i = + with_loc (long_uident_noloc ?conv_con i) (loc_of_ident i) + let rec ctyp_long_id_prefix t = match t with - | Ast.TyId (_, i) -> ident i + | Ast.TyId (_, i) -> ident_noloc i | Ast.TyApp (_, m1, m2) -> let li1 = ctyp_long_id_prefix m1 in let li2 = ctyp_long_id_prefix m2 in Lapply (li1, li2) @@ -14389,6 +14340,13 @@ | Ast.TyQuo (_, s) -> [ s ] | _ -> assert false + let predef_option loc = + TyId + ((loc, + (IdAcc + ((loc, (IdLid ((loc, "*predef*"))), + (IdLid ((loc, "option")))))))) + let rec ctyp = function | TyId (loc, i) -> @@ -14412,9 +14370,7 @@ | TyArr (loc, (TyLab (_, lab, t1)), t2) -> mktyp loc (Ptyp_arrow (lab, (ctyp t1), (ctyp t2))) | TyArr (loc, (TyOlb (loc1, lab, t1)), t2) -> - let t1 = - TyApp (loc1, - (Ast.TyId (loc1, (Ast.IdLid (loc1, "option")))), t1) + let t1 = TyApp (loc1, (predef_option loc1), t1) in mktyp loc (Ptyp_arrow (("?" ^ lab), (ctyp t1), (ctyp t2))) @@ -14470,9 +14426,9 @@ | TyAnt (loc, _) -> error loc "antiquotation not allowed here" | TyOfAmp (_, _, _) | TyAmp (_, _, _) | TySta (_, _, _) | TyCom (_, _, _) | TyVrn (_, _) | TyQuM (_, _) | - TyQuP (_, _) | TyDcl (_, _, _, _, _) | - TyObj (_, _, (RvAnt _)) | TyNil _ | TyTup (_, _) -> - assert false + TyQuP (_, _) | TyDcl (_, _, _, _, _) | TyAnP _ | TyAnM _ | + TyTypePol (_, _, _) | TyObj (_, _, (RvAnt _)) | TyNil _ | + TyTup (_, _) -> assert false and row_field = function | Ast.TyNil _ -> [] @@ -14498,8 +14454,8 @@ and package_type_constraints wc acc = match wc with | Ast.WcNil _ -> acc - | Ast.WcTyp (_, (Ast.TyId (_, (Ast.IdLid (_, id)))), ct) -> - (id, (ctyp ct)) :: acc + | Ast.WcTyp (_, (Ast.TyId (_, id)), ct) -> + ((ident id), (ctyp ct)) :: acc | Ast.WcAnd (_, wc1, wc2) -> package_type_constraints wc1 (package_type_constraints wc2 acc) @@ -14536,19 +14492,29 @@ let mktrecord = function - | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdLid (_, s)))), + | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdLid (sloc, s)))), (Ast.TyMut (_, t))) -> - (s, Mutable, (mkpolytype (ctyp t)), (mkloc loc)) - | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdLid (_, s)))), t) -> - (s, Immutable, (mkpolytype (ctyp t)), (mkloc loc)) + ((with_loc s sloc), Mutable, (mkpolytype (ctyp t)), + (mkloc loc)) + | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdLid (sloc, s)))), t) -> + ((with_loc s sloc), Immutable, (mkpolytype (ctyp t)), + (mkloc loc)) | _ -> assert false let mkvariant = function - | Ast.TyId (loc, (Ast.IdUid (_, s))) -> - ((conv_con s), [], (mkloc loc)) - | Ast.TyOf (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))), t) -> - ((conv_con s), (List.map ctyp (list_of_ctyp t [])), + | Ast.TyId (loc, (Ast.IdUid (sloc, s))) -> + ((with_loc (conv_con s) sloc), [], None, (mkloc loc)) + | Ast.TyOf (loc, (Ast.TyId (_, (Ast.IdUid (sloc, s)))), t) -> + ((with_loc (conv_con s) sloc), + (List.map ctyp (list_of_ctyp t [])), None, (mkloc loc)) + | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdUid (sloc, s)))), + (Ast.TyArr (_, t, u))) -> + ((with_loc (conv_con s) sloc), + (List.map ctyp (list_of_ctyp t [])), (Some (ctyp u)), + (mkloc loc)) + | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdUid (sloc, s)))), t) -> + ((with_loc (conv_con s) sloc), [], (Some (ctyp t)), (mkloc loc)) | _ -> assert false @@ -14556,7 +14522,12 @@ function | Ast.TyMan (_, t1, t2) -> type_decl tl cl loc (Some (ctyp t1)) pflag t2 - | Ast.TyPrv (_, t) -> type_decl tl cl loc m true t + | Ast.TyPrv (_loc, t) -> + if pflag + then + error _loc + "multiple private keyword used, use only one instead" + else type_decl tl cl loc m true t | Ast.TyRec (_, t) -> mktype loc tl cl (Ptype_record (List.map mktrecord (list_of_ctyp t []))) @@ -14576,10 +14547,10 @@ | _ -> Some (ctyp t) in mktype loc tl cl Ptype_abstract (mkprivate' pflag) m) - let type_decl tl cl t = - type_decl tl cl (loc_of_ctyp t) None false t + let type_decl tl cl t loc = type_decl tl cl loc None false t - let mkvalue_desc t p = { pval_type = ctyp t; pval_prim = p; } + let mkvalue_desc loc t p = + { pval_type = ctyp t; pval_prim = p; pval_loc = mkloc loc; } let rec list_of_meta_list = function @@ -14616,19 +14587,39 @@ | Ast.TyQuo (_, s) -> (s, (false, false)) :: acc | _ -> assert false + let rec optional_type_parameters t acc = + match t with + | Ast.TyApp (_, t1, t2) -> + optional_type_parameters t1 + (optional_type_parameters t2 acc) + | Ast.TyQuP (loc, s) -> + ((Some (with_loc s loc)), (true, false)) :: acc + | Ast.TyAnP _loc -> (None, (true, false)) :: acc + | Ast.TyQuM (loc, s) -> + ((Some (with_loc s loc)), (false, true)) :: acc + | Ast.TyAnM _loc -> (None, (false, true)) :: acc + | Ast.TyQuo (loc, s) -> + ((Some (with_loc s loc)), (false, false)) :: acc + | Ast.TyAny _loc -> (None, (false, false)) :: acc + | _ -> assert false + let rec class_parameters t acc = match t with | Ast.TyCom (_, t1, t2) -> class_parameters t1 (class_parameters t2 acc) - | Ast.TyQuP (_, s) -> (s, (true, false)) :: acc - | Ast.TyQuM (_, s) -> (s, (false, true)) :: acc - | Ast.TyQuo (_, s) -> (s, (false, false)) :: acc + | Ast.TyQuP (loc, s) -> + ((with_loc s loc), (true, false)) :: acc + | Ast.TyQuM (loc, s) -> + ((with_loc s loc), (false, true)) :: acc + | Ast.TyQuo (loc, s) -> + ((with_loc s loc), (false, false)) :: acc | _ -> assert false let rec type_parameters_and_type_name t acc = match t with | Ast.TyApp (_, t1, t2) -> - type_parameters_and_type_name t1 (type_parameters t2 acc) + type_parameters_and_type_name t1 + (optional_type_parameters t2 acc) | Ast.TyId (_, i) -> ((ident i), acc) | _ -> assert false @@ -14693,7 +14684,8 @@ let rec patt = function - | Ast.PaId (loc, (Ast.IdLid (_, s))) -> mkpat loc (Ppat_var s) + | Ast.PaId (loc, (Ast.IdLid (sloc, s))) -> + mkpat loc (Ppat_var (with_loc s sloc)) | Ast.PaId (loc, i) -> let p = Ppat_construct ((long_uident ~conv_con i), None, @@ -14702,16 +14694,18 @@ | PaAli (loc, p1, p2) -> let (p, i) = (match (p1, p2) with - | (p, Ast.PaId (_, (Ast.IdLid (_, s)))) -> (p, s) - | (Ast.PaId (_, (Ast.IdLid (_, s))), p) -> (p, s) + | (p, Ast.PaId (_, (Ast.IdLid (sloc, s)))) -> + (p, (with_loc s sloc)) + | (Ast.PaId (_, (Ast.IdLid (sloc, s))), p) -> + (p, (with_loc s sloc)) | _ -> error loc "invalid alias pattern") in mkpat loc (Ppat_alias ((patt p), i)) | PaAnt (loc, _) -> error loc "antiquotation not allowed here" | PaAny loc -> mkpat loc Ppat_any - | Ast.PaApp (loc, (Ast.PaId (_, (Ast.IdUid (_, s)))), + | Ast.PaApp (loc, (Ast.PaId (_, (Ast.IdUid (sloc, s)))), (Ast.PaTup (_, (Ast.PaAny loc_any)))) -> mkpat loc - (Ppat_construct ((lident (conv_con s)), + (Ppat_construct ((lident_with_loc (conv_con s) sloc), (Some (mkpat loc_any Ppat_any)), false)) | (PaApp (loc, _, _) as f) -> let (f, al) = patt_fa [] f in @@ -14819,8 +14813,10 @@ | PaTyc (loc, p, t) -> mkpat loc (Ppat_constraint ((patt p), (ctyp t))) | PaTyp (loc, i) -> mkpat loc (Ppat_type (long_type_ident i)) - | PaVrn (loc, s) -> mkpat loc (Ppat_variant (s, None)) + | PaVrn (loc, s) -> + mkpat loc (Ppat_variant ((conv_con s), None)) | PaLaz (loc, p) -> mkpat loc (Ppat_lazy (patt p)) + | PaMod (loc, m) -> mkpat loc (Ppat_unpack (with_loc m loc)) | (PaEq (_, _, _) | PaSem (_, _, _) | PaCom (_, _, _) | PaNil _ as p) -> error (loc_of_patt p) "invalid pattern" and mklabpat = @@ -14871,37 +14867,82 @@ let list_of_opt_ctyp ot acc = match ot with | Ast.TyNil _ -> acc | t -> list_of_ctyp t acc + let varify_constructors var_names = + let rec loop t = + let desc = + match t.ptyp_desc with + | Ptyp_any -> Ptyp_any + | Ptyp_var x -> Ptyp_var x + | Ptyp_arrow (label, core_type, core_type') -> + Ptyp_arrow (label, (loop core_type), (loop core_type')) + | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) + | Ptyp_constr ({ txt = Lident s }, []) when + List.mem s var_names -> Ptyp_var ("&" ^ s) + | Ptyp_constr (longident, lst) -> + Ptyp_constr (longident, (List.map loop lst)) + | Ptyp_object lst -> + Ptyp_object (List.map loop_core_field lst) + | Ptyp_class (longident, lst, lbl_list) -> + Ptyp_class ((longident, (List.map loop lst), lbl_list)) + | Ptyp_alias (core_type, string) -> + Ptyp_alias (((loop core_type), string)) + | Ptyp_variant (row_field_list, flag, lbl_lst_option) -> + Ptyp_variant + (((List.map loop_row_field row_field_list), flag, + lbl_lst_option)) + | Ptyp_poly (string_lst, core_type) -> + Ptyp_poly ((string_lst, (loop core_type))) + | Ptyp_package (longident, lst) -> + Ptyp_package + ((longident, + (List.map (fun (n, typ) -> (n, (loop typ))) lst))) + in { (t) with ptyp_desc = desc; } + and loop_core_field t = + let desc = + match t.pfield_desc with + | Pfield ((n, typ)) -> Pfield ((n, (loop typ))) + | Pfield_var -> Pfield_var + in { (t) with pfield_desc = desc; } + and loop_row_field x = + match x with + | Rtag ((label, flag, lst)) -> + Rtag ((label, flag, (List.map loop lst))) + | Rinherit t -> Rinherit (loop t) + in loop + let rec expr = function | Ast.ExAcc (loc, x, (Ast.ExId (_, (Ast.IdLid (_, "val"))))) -> mkexp loc - (Pexp_apply ((mkexp loc (Pexp_ident (Lident "!"))), + (Pexp_apply + ((mkexp loc (Pexp_ident (lident_with_loc "!" loc))), [ ("", (expr x)) ])) | (ExAcc (loc, _, _) | Ast.ExId (loc, (Ast.IdAcc (_, _, _))) as e) -> let (e, l) = (match sep_expr_acc [] e with - | (loc, ml, Ast.ExId (_, (Ast.IdUid (_, s)))) :: l -> + | (loc, ml, Ast.ExId (sloc, (Ast.IdUid (_, s)))) :: l -> let ca = constructors_arity () in ((mkexp loc - (Pexp_construct ((mkli (conv_con s) ml), None, - ca))), + (Pexp_construct ((mkli sloc (conv_con s) ml), + None, ca))), l) - | (loc, ml, Ast.ExId (_, (Ast.IdLid (_, s)))) :: l -> - ((mkexp loc (Pexp_ident (mkli s ml))), l) + | (loc, ml, Ast.ExId (sloc, (Ast.IdLid (_, s)))) :: l -> + ((mkexp loc (Pexp_ident (mkli sloc s ml))), l) | (_, [], e) :: l -> ((expr e), l) | _ -> error loc "bad ast in expression") in let (_, e) = List.fold_left (fun (loc_bp, e1) (loc_ep, ml, e2) -> match e2 with - | Ast.ExId (_, (Ast.IdLid (_, s))) -> + | Ast.ExId (sloc, (Ast.IdLid (_, s))) -> let loc = Loc.merge loc_bp loc_ep in (loc, (mkexp loc - (Pexp_field (e1, (mkli (conv_lab s) ml))))) + (Pexp_field (e1, + (mkli sloc (conv_lab s) ml))))) | _ -> error (loc_of_expr e2) "lowercase identifier expected") @@ -14944,7 +14985,7 @@ mkexp loc (Pexp_apply ((mkexp loc - (Pexp_ident (array_function "Array" "get"))), + (Pexp_ident (array_function loc "Array" "get"))), [ ("", (expr e1)); ("", (expr e2)) ])) | ExArr (loc, e) -> mkexp loc (Pexp_array (List.map expr (list_of_expr e []))) @@ -14954,24 +14995,27 @@ (match e with | Ast.ExAcc (loc, x, (Ast.ExId (_, (Ast.IdLid (_, "val"))))) -> - Pexp_apply ((mkexp loc (Pexp_ident (Lident ":="))), + Pexp_apply + ((mkexp loc + (Pexp_ident (lident_with_loc ":=" loc))), [ ("", (expr x)); ("", (expr v)) ]) | ExAcc (loc, _, _) -> (match (expr e).pexp_desc with | Pexp_field (e, lab) -> Pexp_setfield (e, lab, (expr v)) | _ -> error loc "bad record access") - | ExAre (_, e1, e2) -> + | ExAre (loc, e1, e2) -> Pexp_apply ((mkexp loc - (Pexp_ident (array_function "Array" "set"))), + (Pexp_ident (array_function loc "Array" "set"))), [ ("", (expr e1)); ("", (expr e2)); ("", (expr v)) ]) - | Ast.ExId (_, (Ast.IdLid (_, lab))) -> - Pexp_setinstvar (lab, (expr v)) - | ExSte (_, e1, e2) -> + | Ast.ExId (_, (Ast.IdLid (lloc, lab))) -> + Pexp_setinstvar ((with_loc lab lloc), (expr v)) + | ExSte (loc, e1, e2) -> Pexp_apply ((mkexp loc - (Pexp_ident (array_function "String" "set"))), + (Pexp_ident + (array_function loc "String" "set"))), [ ("", (expr e1)); ("", (expr e2)); ("", (expr v)) ]) | _ -> error loc "bad left part of assignment") in mkexp loc e @@ -14992,8 +15036,8 @@ let e3 = ExSeq (loc, el) in mkexp loc - (Pexp_for (i, (expr e1), (expr e2), (mkdirection df), - (expr e3))) + (Pexp_for ((with_loc i loc), (expr e1), (expr e2), + (mkdirection df), (expr e3))) | Ast.ExFun (loc, (Ast.McArr (_, (PaLab (_, lab, po)), w, e))) -> mkexp loc @@ -15040,7 +15084,7 @@ with | Failure _ -> error loc - "Integer literal exceeds the range of representable integers of type int64.1") + "Integer literal exceeds the range of representable integers of type int64") in mkexp loc (Pexp_constant (Const_int64 i64)) | ExNativeInt (loc, s) -> let nati = @@ -15056,7 +15100,9 @@ | ExLet (loc, rf, bi, e) -> mkexp loc (Pexp_let ((mkrf rf), (binding bi []), (expr e))) | ExLmd (loc, i, me, e) -> - mkexp loc (Pexp_letmodule (i, (module_expr me), (expr e))) + mkexp loc + (Pexp_letmodule ((with_loc i loc), (module_expr me), + (expr e))) | ExMat (loc, e, a) -> mkexp loc (Pexp_match ((expr e), (match_case a []))) | ExNew (loc, id) -> mkexp loc (Pexp_new (long_type_ident id)) @@ -15064,7 +15110,10 @@ let p = (match po with | Ast.PaNil _ -> Ast.PaAny loc | p -> p) in let cil = class_str_item cfl [] - in mkexp loc (Pexp_object (((patt p), cil))) + in + mkexp loc + (Pexp_object + { pcstr_pat = patt p; pcstr_fields = cil; }) | ExOlb (loc, _, _) -> error loc "labeled expression not allowed here" | ExOvr (loc, iel) -> @@ -15092,7 +15141,7 @@ mkexp loc (Pexp_apply ((mkexp loc - (Pexp_ident (array_function "String" "get"))), + (Pexp_ident (array_function loc "String" "get"))), [ ("", (expr e1)); ("", (expr e2)) ])) | ExStr (loc, s) -> mkexp loc @@ -15109,22 +15158,28 @@ mkexp loc (Pexp_constraint ((expr e), (Some (ctyp t)), None)) | Ast.ExId (loc, (Ast.IdUid (_, "()"))) -> - mkexp loc (Pexp_construct ((lident "()"), None, true)) + mkexp loc + (Pexp_construct ((lident_with_loc "()" loc), None, true)) | Ast.ExId (loc, (Ast.IdLid (_, s))) -> - mkexp loc (Pexp_ident (lident s)) + mkexp loc (Pexp_ident (lident_with_loc s loc)) | Ast.ExId (loc, (Ast.IdUid (_, s))) -> mkexp loc - (Pexp_construct ((lident (conv_con s)), None, true)) - | ExVrn (loc, s) -> mkexp loc (Pexp_variant (s, None)) + (Pexp_construct ((lident_with_loc (conv_con s) loc), + None, true)) + | ExVrn (loc, s) -> + mkexp loc (Pexp_variant ((conv_con s), None)) | ExWhi (loc, e1, el) -> let e2 = ExSeq (loc, el) in mkexp loc (Pexp_while ((expr e1), (expr e2))) | Ast.ExOpI (loc, i, e) -> - mkexp loc (Pexp_open ((long_uident i), (expr e))) + mkexp loc (Pexp_open (Fresh, (long_uident i), (expr e))) | Ast.ExPkg (loc, (Ast.MeTyc (_, me, pt))) -> - mkexp loc (Pexp_pack ((module_expr me), (package_type pt))) - | Ast.ExPkg (loc, _) -> - error loc "(module_expr : package_type) expected here" + mkexp loc + (Pexp_constraint + (((mkexp loc (Pexp_pack (module_expr me))), + (Some (mktyp loc (Ptyp_package (package_type pt)))), + None))) + | Ast.ExPkg (loc, me) -> mkexp loc (Pexp_pack (module_expr me)) | ExFUN (loc, i, e) -> mkexp loc (Pexp_newtype (i, (expr e))) | Ast.ExCom (loc, _, _) -> error loc "expr, expr: not allowed here" @@ -15152,6 +15207,36 @@ and binding x acc = match x with | Ast.BiAnd (_, x, y) -> binding x (binding y acc) + | Ast.BiEq (_loc, + (Ast.PaId (sloc, (Ast.IdLid (_, bind_name)))), + (Ast.ExTyc (_, e, (TyTypePol (_, vs, ty))))) -> + let rec id_to_string x = + (match x with + | Ast.TyId (_, (Ast.IdLid (_, x))) -> [ x ] + | Ast.TyApp (_, x, y) -> + (id_to_string x) @ (id_to_string y) + | _ -> assert false) in + let vars = id_to_string vs in + let ampersand_vars = List.map (fun x -> "&" ^ x) vars in + let ty' = varify_constructors vars (ctyp ty) in + let mkexp = mkexp _loc in + let mkpat = mkpat _loc in + let e = + mkexp + (Pexp_constraint ((expr e), (Some (ctyp ty)), None)) in + let rec mk_newtypes x = + (match x with + | [ newtype ] -> mkexp (Pexp_newtype ((newtype, e))) + | newtype :: newtypes -> + mkexp + (Pexp_newtype ((newtype, (mk_newtypes newtypes)))) + | [] -> assert false) in + let pat = + mkpat + (Ppat_constraint + (((mkpat (Ppat_var (with_loc bind_name sloc))), + (mktyp _loc (Ptyp_poly (ampersand_vars, ty')))))) in + let e = mk_newtypes vars in (pat, e) :: acc | Ast.BiEq (_loc, p, (Ast.ExTyc (_, e, (Ast.TyPol (_, vs, ty))))) -> ((patt (Ast.PaTyc (_loc, p, (Ast.TyPol (_loc, vs, ty))))), @@ -15179,12 +15264,13 @@ match x with | Ast.RbNil _ -> acc | Ast.RbSem (_, x, y) -> mkideexp x (mkideexp y acc) - | Ast.RbEq (_, (Ast.IdLid (_, s)), e) -> (s, (expr e)) :: acc + | Ast.RbEq (_, (Ast.IdLid (sloc, s)), e) -> + ((with_loc s sloc), (expr e)) :: acc | _ -> assert false and mktype_decl x acc = match x with | Ast.TyAnd (_, x, y) -> mktype_decl x (mktype_decl y acc) - | Ast.TyDcl (_, c, tl, td, cl) -> + | Ast.TyDcl (cloc, c, tl, td, cl) -> let cl = List.map (fun (t1, t2) -> @@ -15193,8 +15279,10 @@ in ((ctyp t1), (ctyp t2), (mkloc loc))) cl in - (c, - (type_decl (List.fold_right type_parameters tl []) cl td)) :: + ((with_loc c cloc), + (type_decl + (List.fold_right optional_type_parameters tl []) cl + td cloc)) :: acc | _ -> assert false and module_type = @@ -15204,13 +15292,16 @@ | Ast.MtId (loc, i) -> mkmty loc (Pmty_ident (long_uident i)) | Ast.MtFun (loc, n, nt, mt) -> mkmty loc - (Pmty_functor (n, (module_type nt), (module_type mt))) + (Pmty_functor ((with_loc n loc), (module_type nt), + (module_type mt))) | Ast.MtQuo (loc, _) -> error loc "module type variable not allowed here" | Ast.MtSig (loc, sl) -> mkmty loc (Pmty_signature (sig_item sl [])) | Ast.MtWit (loc, mt, wc) -> mkmty loc (Pmty_with ((module_type mt), (mkwithc wc []))) + | Ast.MtOf (loc, me) -> + mkmty loc (Pmty_typeof (module_expr me)) | Ast.MtAnt (_, _) -> assert false and sig_item s l = match s with @@ -15230,22 +15321,27 @@ | Ast.SgSem (_, sg1, sg2) -> sig_item sg1 (sig_item sg2 l) | SgDir (_, _, _) -> l | Ast.SgExc (loc, (Ast.TyId (_, (Ast.IdUid (_, s))))) -> - (mksig loc (Psig_exception ((conv_con s), []))) :: l + (mksig loc + (Psig_exception ((with_loc (conv_con s) loc), []))) :: + l | Ast.SgExc (loc, (Ast.TyOf (_, (Ast.TyId (_, (Ast.IdUid (_, s)))), t))) -> (mksig loc - (Psig_exception ((conv_con s), + (Psig_exception ((with_loc (conv_con s) loc), (List.map ctyp (list_of_ctyp t []))))) :: l | SgExc (_, _) -> assert false | SgExt (loc, n, t, sl) -> (mksig loc - (Psig_value (n, (mkvalue_desc t (list_of_meta_list sl))))) :: + (Psig_value ((with_loc n loc), + (mkvalue_desc loc t (list_of_meta_list sl))))) :: l | SgInc (loc, mt) -> (mksig loc (Psig_include (module_type mt))) :: l | SgMod (loc, n, mt) -> - (mksig loc (Psig_module (n, (module_type mt)))) :: l + (mksig loc + (Psig_module ((with_loc n loc), (module_type mt)))) :: + l | SgRecMod (loc, mb) -> (mksig loc (Psig_recmodule (module_sig_binding mb []))) :: l @@ -15254,26 +15350,30 @@ (match mt with | MtQuo (_, _) -> Pmodtype_abstract | _ -> Pmodtype_manifest (module_type mt)) - in (mksig loc (Psig_modtype (n, si))) :: l + in (mksig loc (Psig_modtype ((with_loc n loc), si))) :: l | SgOpn (loc, id) -> - (mksig loc (Psig_open (long_uident id))) :: l + (mksig loc (Psig_open (Fresh, (long_uident id)))) :: l | SgTyp (loc, tdl) -> (mksig loc (Psig_type (mktype_decl tdl []))) :: l | SgVal (loc, n, t) -> - (mksig loc (Psig_value (n, (mkvalue_desc t [])))) :: l + (mksig loc + (Psig_value ((with_loc n loc), (mkvalue_desc loc t [])))) :: + l | Ast.SgAnt (loc, _) -> error loc "antiquotation in sig_item" and module_sig_binding x acc = match x with | Ast.MbAnd (_, x, y) -> module_sig_binding x (module_sig_binding y acc) - | Ast.MbCol (_, s, mt) -> (s, (module_type mt)) :: acc + | Ast.MbCol (loc, s, mt) -> + ((with_loc s loc), (module_type mt)) :: acc | _ -> assert false and module_str_binding x acc = match x with | Ast.MbAnd (_, x, y) -> module_str_binding x (module_str_binding y acc) - | Ast.MbColEq (_, s, mt, me) -> - (s, (module_type mt), (module_expr me)) :: acc + | Ast.MbColEq (loc, s, mt, me) -> + ((with_loc s loc), (module_type mt), (module_expr me)) :: + acc | _ -> assert false and module_expr = function @@ -15284,16 +15384,23 @@ (Pmod_apply ((module_expr me1), (module_expr me2))) | Ast.MeFun (loc, n, mt, me) -> mkmod loc - (Pmod_functor (n, (module_type mt), (module_expr me))) + (Pmod_functor ((with_loc n loc), (module_type mt), + (module_expr me))) | Ast.MeStr (loc, sl) -> mkmod loc (Pmod_structure (str_item sl [])) | Ast.MeTyc (loc, me, mt) -> mkmod loc (Pmod_constraint ((module_expr me), (module_type mt))) | Ast.MePkg (loc, (Ast.ExTyc (_, e, (Ast.TyPkg (_, pt))))) -> - mkmod loc (Pmod_unpack ((expr e), (package_type pt))) - | Ast.MePkg (loc, _) -> - error loc "(value expr) not supported yet" + mkmod loc + (Pmod_unpack + (mkexp loc + (Pexp_constraint + (((expr e), + (Some + (mktyp loc (Ptyp_package (package_type pt)))), + None))))) + | Ast.MePkg (loc, e) -> mkmod loc (Pmod_unpack (expr e)) | Ast.MeAnt (loc, _) -> error loc "antiquotation in module_expr" and str_item s l = @@ -15315,36 +15422,47 @@ | StDir (_, _, _) -> l | Ast.StExc (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))), Ast. ONone) -> - (mkstr loc (Pstr_exception ((conv_con s), []))) :: l + (mkstr loc + (Pstr_exception ((with_loc (conv_con s) loc), []))) :: + l | Ast.StExc (loc, (Ast.TyOf (_, (Ast.TyId (_, (Ast.IdUid (_, s)))), t)), Ast. ONone) -> (mkstr loc - (Pstr_exception ((conv_con s), + (Pstr_exception ((with_loc (conv_con s) loc), (List.map ctyp (list_of_ctyp t []))))) :: l | Ast.StExc (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))), (Ast.OSome i)) -> - (mkstr loc (Pstr_exn_rebind ((conv_con s), (ident i)))) :: + (mkstr loc + (Pstr_exn_rebind ((with_loc (conv_con s) loc), + (long_uident ~conv_con i)))) :: l + | Ast.StExc (loc, + (Ast.TyOf (_, (Ast.TyId (_, (Ast.IdUid (_, _)))), _)), + (Ast.OSome _)) -> error loc "type in exception alias" | StExc (_, _, _) -> assert false | StExp (loc, e) -> (mkstr loc (Pstr_eval (expr e))) :: l | StExt (loc, n, t, sl) -> (mkstr loc - (Pstr_primitive (n, - (mkvalue_desc t (list_of_meta_list sl))))) :: + (Pstr_primitive ((with_loc n loc), + (mkvalue_desc loc t (list_of_meta_list sl))))) :: l | StInc (loc, me) -> (mkstr loc (Pstr_include (module_expr me))) :: l | StMod (loc, n, me) -> - (mkstr loc (Pstr_module (n, (module_expr me)))) :: l + (mkstr loc + (Pstr_module ((with_loc n loc), (module_expr me)))) :: + l | StRecMod (loc, mb) -> (mkstr loc (Pstr_recmodule (module_str_binding mb []))) :: l | StMty (loc, n, mt) -> - (mkstr loc (Pstr_modtype (n, (module_type mt)))) :: l + (mkstr loc + (Pstr_modtype ((with_loc n loc), (module_type mt)))) :: + l | StOpn (loc, id) -> - (mkstr loc (Pstr_open (long_uident id))) :: l + (mkstr loc (Pstr_open (Fresh, (long_uident id)))) :: l | StTyp (loc, tdl) -> (mkstr loc (Pstr_type (mktype_decl tdl []))) :: l | StVal (loc, rf, bi) -> @@ -15359,9 +15477,7 @@ | CtFun (loc, (TyLab (_, lab, t)), ct) -> mkcty loc (Pcty_fun (lab, (ctyp t), (class_type ct))) | CtFun (loc, (TyOlb (loc1, lab, t)), ct) -> - let t = - TyApp (loc1, - (Ast.TyId (loc1, (Ast.IdLid (loc1, "option")))), t) + let t = TyApp (loc1, (predef_option loc1), t) in mkcty loc (Pcty_fun (("?" ^ lab), (ctyp t), (class_type ct))) @@ -15371,15 +15487,22 @@ let t = (match t_o with | Ast.TyNil _ -> Ast.TyAny loc | t -> t) in let cil = class_sig_item ctfl [] - in mkcty loc (Pcty_signature (((ctyp t), cil))) + in + mkcty loc + (Pcty_signature + { + pcsig_self = ctyp t; + pcsig_fields = cil; + pcsig_loc = mkloc loc; + }) | CtCon (loc, _, _, _) -> error loc "invalid virtual class inside a class type" | CtAnt (_, _) | CtEq (_, _, _) | CtCol (_, _, _) | CtAnd (_, _, _) | CtNil _ -> assert false and class_info_class_expr ci = match ci with - | CeEq (_, (CeCon (loc, vir, (IdLid (_, name)), params)), ce) - -> + | CeEq (_, (CeCon (loc, vir, (IdLid (nloc, name)), params)), + ce) -> let (loc_params, (params, variance)) = (match params with | Ast.TyNil _ -> (loc, ([], [])) @@ -15390,7 +15513,7 @@ { pci_virt = mkvirtual vir; pci_params = (params, (mkloc loc_params)); - pci_name = name; + pci_name = with_loc name nloc; pci_expr = class_expr ce; pci_loc = mkloc loc; pci_variance = variance; @@ -15398,8 +15521,9 @@ | ce -> error (loc_of_class_expr ce) "bad class definition" and class_info_class_type ci = match ci with - | CtEq (_, (CtCon (loc, vir, (IdLid (_, name)), params)), ct) | - CtCol (_, (CtCon (loc, vir, (IdLid (_, name)), params)), + | CtEq (_, (CtCon (loc, vir, (IdLid (nloc, name)), params)), + ct) | + CtCol (_, (CtCon (loc, vir, (IdLid (nloc, name)), params)), ct) -> let (loc_params, (params, variance)) = @@ -15412,7 +15536,7 @@ { pci_virt = mkvirtual vir; pci_params = (params, (mkloc loc_params)); - pci_name = name; + pci_name = with_loc name nloc; pci_expr = class_type ct; pci_loc = mkloc loc; pci_variance = variance; @@ -15424,22 +15548,22 @@ match c with | Ast.CgNil _ -> l | CgCtr (loc, t1, t2) -> - (Pctf_cstr (((ctyp t1), (ctyp t2), (mkloc loc)))) :: l + (mkctf loc (Pctf_cstr (((ctyp t1), (ctyp t2))))) :: l | Ast.CgSem (_, csg1, csg2) -> class_sig_item csg1 (class_sig_item csg2 l) - | CgInh (_, ct) -> (Pctf_inher (class_type ct)) :: l + | CgInh (loc, ct) -> + (mkctf loc (Pctf_inher (class_type ct))) :: l | CgMth (loc, s, pf, t) -> - (Pctf_meth - ((s, (mkprivate pf), (mkpolytype (ctyp t)), (mkloc loc)))) :: + (mkctf loc + (Pctf_meth ((s, (mkprivate pf), (mkpolytype (ctyp t)))))) :: l | CgVal (loc, s, b, v, t) -> - (Pctf_val - ((s, (mkmutable b), (mkvirtual v), (ctyp t), - (mkloc loc)))) :: + (mkctf loc + (Pctf_val ((s, (mkmutable b), (mkvirtual v), (ctyp t))))) :: l | CgVir (loc, s, b, t) -> - (Pctf_virt - ((s, (mkprivate b), (mkpolytype (ctyp t)), (mkloc loc)))) :: + (mkctf loc + (Pctf_virt ((s, (mkprivate b), (mkpolytype (ctyp t)))))) :: l | CgAnt (_, _) -> assert false and class_expr = @@ -15447,39 +15571,42 @@ | (CeApp (loc, _, _) as c) -> let (ce, el) = class_expr_fa [] c in let el = List.map label_expr el - in mkpcl loc (Pcl_apply ((class_expr ce), el)) + in mkcl loc (Pcl_apply ((class_expr ce), el)) | CeCon (loc, ViNil, id, tl) -> - mkpcl loc + mkcl loc (Pcl_constr ((long_class_ident id), (List.map ctyp (list_of_opt_ctyp tl [])))) | CeFun (loc, (PaLab (_, lab, po)), ce) -> - mkpcl loc + mkcl loc (Pcl_fun (lab, None, (patt_of_lab loc lab po), (class_expr ce))) | CeFun (loc, (PaOlbi (_, lab, p, e)), ce) -> let lab = paolab lab p in - mkpcl loc + mkcl loc (Pcl_fun (("?" ^ lab), (Some (expr e)), (patt p), (class_expr ce))) | CeFun (loc, (PaOlb (_, lab, p)), ce) -> let lab = paolab lab p in - mkpcl loc + mkcl loc (Pcl_fun (("?" ^ lab), None, (patt_of_lab loc lab p), (class_expr ce))) | CeFun (loc, p, ce) -> - mkpcl loc (Pcl_fun ("", None, (patt p), (class_expr ce))) + mkcl loc (Pcl_fun ("", None, (patt p), (class_expr ce))) | CeLet (loc, rf, bi, ce) -> - mkpcl loc + mkcl loc (Pcl_let ((mkrf rf), (binding bi []), (class_expr ce))) | CeStr (loc, po, cfl) -> let p = (match po with | Ast.PaNil _ -> Ast.PaAny loc | p -> p) in let cil = class_str_item cfl [] - in mkpcl loc (Pcl_structure (((patt p), cil))) + in + mkcl loc + (Pcl_structure + { pcstr_pat = patt p; pcstr_fields = cil; }) | CeTyc (loc, ce, ct) -> - mkpcl loc + mkcl loc (Pcl_constraint ((class_expr ce), (class_type ct))) | CeCon (loc, _, _, _) -> error loc "invalid virtual class inside a class expression" @@ -15489,15 +15616,17 @@ match c with | CrNil _ -> l | CrCtr (loc, t1, t2) -> - (Pcf_cstr (((ctyp t1), (ctyp t2), (mkloc loc)))) :: l + (mkcf loc (Pcf_constr (((ctyp t1), (ctyp t2))))) :: l | Ast.CrSem (_, cst1, cst2) -> class_str_item cst1 (class_str_item cst2 l) | CrInh (loc, ov, ce, pb) -> let opb = if pb = "" then None else Some pb in - (Pcf_inher ((override_flag loc ov), (class_expr ce), opb)) :: + (mkcf loc + (Pcf_inher ((override_flag loc ov), (class_expr ce), + opb))) :: l - | CrIni (_, e) -> (Pcf_init (expr e)) :: l + | CrIni (loc, e) -> (mkcf loc (Pcf_init (expr e))) :: l | CrMth (loc, s, ov, pf, e, t) -> let t = (match t with @@ -15505,21 +15634,27 @@ | t -> Some (mkpolytype (ctyp t))) in let e = mkexp loc (Pexp_poly ((expr e), t)) in - (Pcf_meth - ((s, (mkprivate pf), (override_flag loc ov), e, - (mkloc loc)))) :: + (mkcf loc + (Pcf_meth + (((with_loc s loc), (mkprivate pf), + (override_flag loc ov), e)))) :: l | CrVal (loc, s, ov, mf, e) -> - (Pcf_val - ((s, (mkmutable mf), (override_flag loc ov), (expr e), - (mkloc loc)))) :: + (mkcf loc + (Pcf_val + (((with_loc s loc), (mkmutable mf), + (override_flag loc ov), (expr e))))) :: l | CrVir (loc, s, pf, t) -> - (Pcf_virt - ((s, (mkprivate pf), (mkpolytype (ctyp t)), (mkloc loc)))) :: + (mkcf loc + (Pcf_virt + (((with_loc s loc), (mkprivate pf), + (mkpolytype (ctyp t)))))) :: l | CrVvr (loc, s, mf, t) -> - (Pcf_valvirt ((s, (mkmutable mf), (ctyp t), (mkloc loc)))) :: + (mkcf loc + (Pcf_valvirt + (((with_loc s loc), (mkmutable mf), (ctyp t))))) :: l | CrAnt (_, _) -> assert false @@ -15534,7 +15669,7 @@ | ExInt (_, i) -> Pdir_int (int_of_string i) | Ast.ExId (_, (Ast.IdUid (_, "True"))) -> Pdir_bool true | Ast.ExId (_, (Ast.IdUid (_, "False"))) -> Pdir_bool false - | e -> Pdir_ident (ident (ident_of_expr e)) + | e -> Pdir_ident (ident_noloc (ident_of_expr e)) let phrase = function @@ -15551,14 +15686,12 @@ struct class clean_ast = object inherit Ast.map as super - method with_constr = fun wc -> match super#with_constr wc with | Ast.WcAnd (_, (Ast.WcNil _), wc) | Ast.WcAnd (_, wc, (Ast.WcNil _)) -> wc | wc -> wc - method expr = fun e -> match super#expr e with @@ -15569,7 +15702,6 @@ Ast.ExSem (_, (Ast.ExNil _), e) | Ast.ExSem (_, e, (Ast.ExNil _)) -> e | e -> e - method patt = fun p -> match super#patt p with @@ -15581,35 +15713,30 @@ Ast.PaSem (_, (Ast.PaNil _), p) | Ast.PaSem (_, p, (Ast.PaNil _)) -> p | p -> p - method match_case = fun mc -> match super#match_case mc with | Ast.McOr (_, (Ast.McNil _), mc) | Ast.McOr (_, mc, (Ast.McNil _)) -> mc | mc -> mc - method binding = fun bi -> match super#binding bi with | Ast.BiAnd (_, (Ast.BiNil _), bi) | Ast.BiAnd (_, bi, (Ast.BiNil _)) -> bi | bi -> bi - method rec_binding = fun rb -> match super#rec_binding rb with | Ast.RbSem (_, (Ast.RbNil _), bi) | Ast.RbSem (_, bi, (Ast.RbNil _)) -> bi | bi -> bi - method module_binding = fun mb -> match super#module_binding mb with | Ast.MbAnd (_, (Ast.MbNil _), mb) | Ast.MbAnd (_, mb, (Ast.MbNil _)) -> mb | mb -> mb - method ctyp = fun t -> match super#ctyp t with @@ -15632,7 +15759,6 @@ Ast.TySta (_, (Ast.TyNil _), t) | Ast.TySta (_, t, (Ast.TyNil _)) -> t | t -> t - method sig_item = fun sg -> match super#sig_item sg with @@ -15640,7 +15766,6 @@ Ast.SgSem (_, sg, (Ast.SgNil _)) -> sg | Ast.SgTyp (loc, (Ast.TyNil _)) -> Ast.SgNil loc | sg -> sg - method str_item = fun st -> match super#str_item st with @@ -15649,41 +15774,35 @@ | Ast.StTyp (loc, (Ast.TyNil _)) -> Ast.StNil loc | Ast.StVal (loc, _, (Ast.BiNil _)) -> Ast.StNil loc | st -> st - method module_type = fun mt -> match super#module_type mt with | Ast.MtWit (_, mt, (Ast.WcNil _)) -> mt | mt -> mt - method class_expr = fun ce -> match super#class_expr ce with | Ast.CeAnd (_, (Ast.CeNil _), ce) | Ast.CeAnd (_, ce, (Ast.CeNil _)) -> ce | ce -> ce - method class_type = fun ct -> match super#class_type ct with | Ast.CtAnd (_, (Ast.CtNil _), ct) | Ast.CtAnd (_, ct, (Ast.CtNil _)) -> ct | ct -> ct - method class_sig_item = fun csg -> match super#class_sig_item csg with | Ast.CgSem (_, (Ast.CgNil _), csg) | Ast.CgSem (_, csg, (Ast.CgNil _)) -> csg | csg -> csg - method class_str_item = fun cst -> match super#class_str_item cst with | Ast.CrSem (_, (Ast.CrNil _), cst) | Ast.CrSem (_, cst, (Ast.CrNil _)) -> cst | cst -> cst - end end @@ -15878,10 +15997,7 @@ class ['accu] c_fold_pattern_vars : (string -> 'accu -> 'accu) -> 'accu -> - object inherit Ast.fold - val acc : 'accu - method acc : 'accu - + object inherit Ast.fold val acc : 'accu method acc : 'accu end val fold_pattern_vars : @@ -15893,21 +16009,13 @@ 'accu -> object ('self_type) inherit Ast.fold - val free : 'accu - val env : S.t - method free : 'accu - method set_env : S.t -> 'self_type - method add_atom : string -> 'self_type - method add_patt : Ast.patt -> 'self_type - method add_binding : Ast.binding -> 'self_type - end val free_vars : S.t -> Ast.expr -> S.t @@ -15922,18 +16030,14 @@ class ['accu] c_fold_pattern_vars f init = object inherit Ast.fold as super - val acc = init - method acc : 'accu = acc - method patt = function | Ast.PaId (_, (Ast.IdLid (_, s))) | Ast.PaLab (_, s, (Ast.PaNil _)) | Ast.PaOlb (_, s, (Ast.PaNil _)) -> {< acc = f s acc; >} | p -> super#patt p - end let fold_pattern_vars f p init = @@ -15951,23 +16055,15 @@ ?(env_init = S.empty) free_init = object (o) inherit Ast.fold as super - val free = (free_init : 'accu) - val env = (env_init : S.t) - method free = free - method set_env = fun env -> {< env = env; >} - method add_atom = fun s -> {< env = S.add s env; >} - method add_patt = fun p -> {< env = fold_pattern_vars S.add p env; >} - method add_binding = fun bi -> {< env = fold_binding_vars S.add bi env; >} - method expr = function | Ast.ExId (_, (Ast.IdLid (_, s))) | @@ -15985,13 +16081,11 @@ | Ast.ExObj (_, p, cst) -> ((o#add_patt p)#class_str_item cst)#set_env env | e -> super#expr e - method match_case = function | Ast.McArr (_, p, e1, e2) -> (((o#add_patt p)#expr e1)#expr e2)#set_env env | m -> super#match_case m - method str_item = function | Ast.StExt (_, s, t, _) -> (o#ctyp t)#add_atom s @@ -16000,7 +16094,6 @@ | Ast.StVal (_, Ast.ReRecursive, bi) -> (o#add_binding bi)#binding bi | st -> super#str_item st - method class_expr = function | Ast.CeFun (_, p, ce) -> @@ -16014,7 +16107,6 @@ | Ast.CeStr (_, p, cst) -> ((o#add_patt p)#class_str_item cst)#set_env env | ce -> super#class_expr ce - method class_str_item = function | (Ast.CrInh (_, _, _, "") as cst) -> @@ -16023,12 +16115,10 @@ | Ast.CrVal (_, s, _, _, e) -> (o#expr e)#add_atom s | Ast.CrVvr (_, s, _, t) -> (o#ctyp t)#add_atom s | cst -> super#class_str_item cst - method module_expr = function | Ast.MeStr (_, st) -> (o#str_item st)#set_env env | me -> super#module_expr me - end let free_vars env_init e = @@ -16996,7 +17086,11 @@ let add_loc bp parse_fun strm = let x = parse_fun strm in let ep = loc_ep strm in - let loc = Loc.merge bp ep in (x, loc) + let loc = + if (Loc.start_off bp) > (Loc.stop_off ep) + then Loc.join bp + else Loc.merge bp ep + in (x, loc) let stream_peek_nth strm n = let rec loop i = @@ -17807,13 +17901,6 @@ in Some t | None -> None) | LocAct (_, _) | DeadEnd -> None - and insert_new = - function - | s :: sl -> - Node - { node = s; son = insert_new sl; brother = DeadEnd; - } - | [] -> LocAct (action, []) in insert gsymbols tree let insert_level entry e1 symbols action slev = @@ -17892,14 +17979,43 @@ module Delete = struct + exception Rule_not_found of (string * string) + + let _ = + let () = + Printexc.register_printer + (function + | Rule_not_found ((symbols, entry)) -> + let msg = + Printf.sprintf + "rule %S cannot be found in entry\n%s" symbols + entry + in Some msg + | _ -> None) + in () + module Make (Structure : Structure.S) = struct module Tools = Tools.Make(Structure) module Parser = Parser.Make(Structure) + module Print = Print.Make(Structure) + open Structure + let raise_rule_not_found entry symbols = + let to_string f x = + let buff = Buffer.create 128 in + let ppf = Format.formatter_of_buffer buff + in + (f ppf x; + Format.pp_print_flush ppf (); + Buffer.contents buff) in + let entry = to_string Print.entry entry in + let symbols = to_string Print.print_rule symbols + in raise (Rule_not_found ((symbols, entry))) + let delete_rule_in_tree entry = let rec delete_in_tree symbols tree = match (symbols, tree) with @@ -17998,7 +18114,7 @@ let levs = delete_rule_in_suffix entry symbols levs in lev :: levs) - | [] -> raise Not_found + | [] -> raise_rule_not_found entry symbols let rec delete_rule_in_prefix entry symbols = function @@ -18025,7 +18141,7 @@ let levs = delete_rule_in_prefix entry symbols levs in lev :: levs) - | [] -> raise Not_found + | [] -> raise_rule_not_found entry symbols let rec delete_rule_in_level_list entry symbols levs = match symbols with @@ -18633,191 +18749,113 @@ unit -> object ('a) method interf : formatter -> Ast.sig_item -> unit - method implem : formatter -> Ast.str_item -> unit - method sig_item : formatter -> Ast.sig_item -> unit - method str_item : formatter -> Ast.str_item -> unit - val pipe : bool - val semi : bool - val semisep : sep - + val no_semisep : sep method value_val : string - method value_let : string - method andsep : sep - method anti : formatter -> string -> unit - method class_declaration : formatter -> Ast.class_expr -> unit - method class_expr : formatter -> Ast.class_expr -> unit - method class_sig_item : formatter -> Ast.class_sig_item -> unit - method class_str_item : formatter -> Ast.class_str_item -> unit - method class_type : formatter -> Ast.class_type -> unit - method constrain : formatter -> (Ast.ctyp * Ast.ctyp) -> unit - method ctyp : formatter -> Ast.ctyp -> unit - method ctyp1 : formatter -> Ast.ctyp -> unit - method constructor_type : formatter -> Ast.ctyp -> unit - method dot_expr : formatter -> Ast.expr -> unit - method apply_expr : formatter -> Ast.expr -> unit - method expr : formatter -> Ast.expr -> unit - method expr_list : formatter -> Ast.expr list -> unit - method expr_list_cons : bool -> formatter -> Ast.expr -> unit - method fun_binding : formatter -> fun_binding -> unit - method functor_arg : formatter -> (string * Ast.module_type) -> unit - method functor_args : formatter -> (string * Ast.module_type) list -> unit - method ident : formatter -> Ast.ident -> unit - method numeric : formatter -> string -> string -> unit - method binding : formatter -> Ast.binding -> unit - method record_binding : formatter -> Ast.rec_binding -> unit - method match_case : formatter -> Ast.match_case -> unit - method match_case_aux : formatter -> Ast.match_case -> unit - method mk_expr_list : Ast.expr -> ((Ast.expr list) * (Ast.expr option)) - method mk_patt_list : Ast.patt -> ((Ast.patt list) * (Ast.patt option)) - method simple_module_expr : formatter -> Ast.module_expr -> unit - method module_expr : formatter -> Ast.module_expr -> unit - method module_expr_get_functor_args : (string * Ast.module_type) list -> Ast.module_expr -> (((string * Ast.module_type) list) * Ast. module_expr * (Ast.module_type option)) - method module_rec_binding : formatter -> Ast.module_binding -> unit - method module_type : formatter -> Ast.module_type -> unit - method override_flag : formatter -> Ast.override_flag -> unit - method mutable_flag : formatter -> Ast.mutable_flag -> unit - method direction_flag : formatter -> Ast.direction_flag -> unit - method rec_flag : formatter -> Ast.rec_flag -> unit - method node : formatter -> 'b -> ('b -> Loc.t) -> unit - method patt : formatter -> Ast.patt -> unit - method patt1 : formatter -> Ast.patt -> unit - method patt2 : formatter -> Ast.patt -> unit - method patt3 : formatter -> Ast.patt -> unit - method patt4 : formatter -> Ast.patt -> unit - method patt5 : formatter -> Ast.patt -> unit - method patt_tycon : formatter -> Ast.patt -> unit - method patt_expr_fun_args : formatter -> (fun_binding * Ast.expr) -> unit - method patt_class_expr_fun_args : formatter -> (Ast.patt * Ast.class_expr) -> unit - method print_comments_before : Loc.t -> formatter -> unit - method private_flag : formatter -> Ast.private_flag -> unit - method virtual_flag : formatter -> Ast.virtual_flag -> unit - method quoted_string : formatter -> string -> unit - method raise_match_failure : formatter -> Loc.t -> unit - method reset : 'a - method reset_semi : 'a - method semisep : sep - method set_comments : bool -> 'a - method set_curry_constr : bool -> 'a - method set_loc_and_comments : 'a - method set_semisep : sep -> 'a - method simple_ctyp : formatter -> Ast.ctyp -> unit - method simple_expr : formatter -> Ast.expr -> unit - method simple_patt : formatter -> Ast.patt -> unit - method seq : formatter -> Ast.expr -> unit - method string : formatter -> string -> unit - method sum_type : formatter -> Ast.ctyp -> unit - method type_params : formatter -> Ast.ctyp list -> unit - method class_params : formatter -> Ast.ctyp -> unit - method under_pipe : 'a - method under_semi : 'a - method var : formatter -> string -> unit - method with_constraint : formatter -> Ast.with_constr -> unit - end val with_outfile : @@ -18954,7 +18992,7 @@ "Cannot print %S this identifier does not respect OCaml lexing rules (%s)" str (Lexer.Error.to_string exn)) - let ocaml_char = function | "'" -> "\\'" | c -> c + let ocaml_char x = Char.escaped (Struct.Token.Eval.char x) let rec get_expr_args a al = match a with @@ -19008,43 +19046,26 @@ ?(comments = true) () = object (o) val pipe = false - val semi = false - method under_pipe = {< pipe = true; >} - method under_semi = {< semi = true; >} - method reset_semi = {< semi = false; >} - method reset = {< pipe = false; semi = false; >} - val semisep = (";;" : sep) - + val no_semisep = ("" : sep) val mode = if comments then `comments else `no_comments - val curry_constr = init_curry_constr - val var_conversion = false - method andsep : sep = "@]@ @[<2>and@ " - method value_val = "val" - method value_let = "let" - method semisep = semisep - method set_semisep = fun s -> {< semisep = s; >} - method set_comments = fun b -> {< mode = if b then `comments else `no_comments; >} - method set_loc_and_comments = {< mode = `loc_and_comments; >} - method set_curry_constr = fun b -> {< curry_constr = b; >} - method print_comments_before = fun loc f -> match mode with @@ -19059,7 +19080,6 @@ (fun s -> pp f "%s(*comm_loc: %a*)@ " s Loc.dump) (CommentFilter.take_stream comment_filter) | _ -> () - method var = fun f -> function @@ -19087,14 +19107,12 @@ (sprintf "Bad token used as an identifier: %s" (Token.to_string tok)))) - method type_params = fun f -> function | [] -> () | [ x ] -> pp f "%a@ " o#ctyp x | l -> pp f "@[<1>(%a)@]@ " (list o#ctyp ",@ ") l - method class_params = fun f -> function @@ -19102,44 +19120,37 @@ pp f "@[<1>%a,@ %a@]" o#class_params t1 o#class_params t2 | x -> o#ctyp f x - method override_flag = fun f -> function | Ast.OvOverride -> pp f "!" | Ast.OvNil -> () | Ast.OvAnt s -> o#anti f s - method mutable_flag = fun f -> function | Ast.MuMutable -> pp f "mutable@ " | Ast.MuNil -> () | Ast.MuAnt s -> o#anti f s - method rec_flag = fun f -> function | Ast.ReRecursive -> pp f "rec@ " | Ast.ReNil -> () | Ast.ReAnt s -> o#anti f s - method virtual_flag = fun f -> function | Ast.ViVirtual -> pp f "virtual@ " | Ast.ViNil -> () | Ast.ViAnt s -> o#anti f s - method private_flag = fun f -> function | Ast.PrPrivate -> pp f "private@ " | Ast.PrNil -> () | Ast.PrAnt s -> o#anti f s - method anti = fun f s -> pp f "$%s$" s - method seq = fun f -> function @@ -19147,14 +19158,12 @@ pp f "%a;@ %a" o#under_semi#seq e1 o#seq e2 | Ast.ExSeq (_, e) -> o#seq f e | e -> o#expr f e - method match_case = fun f -> function | Ast.McNil _loc -> pp f "@[<2>@ _ ->@ %a@]" o#raise_match_failure _loc | a -> o#match_case_aux f a - method match_case_aux = fun f -> function @@ -19168,13 +19177,11 @@ | Ast.McArr (_, p, w, e) -> pp f "@ | @[<2>%a@ when@ %a@ ->@ %a@]" o#patt p o#under_pipe#expr w o#under_pipe#expr e - method fun_binding = fun f -> function | `patt p -> o#simple_patt f p | `newtype i -> pp f "(type %s)" i - method binding = fun f bi -> let () = o#node f bi Ast.loc_of_binding @@ -19184,22 +19191,22 @@ | Ast.BiAnd (_, b1, b2) -> (o#binding f b1; pp f o#andsep; o#binding f b2) | Ast.BiEq (_, p, e) -> - let (pl, e) = + let (pl, e') = (match p with | Ast.PaTyc (_, _, _) -> ([], e) | _ -> expr_fun_args e) in - (match (p, e) with + (match (p, e') with | (Ast.PaId (_, (Ast.IdLid (_, _))), - Ast.ExTyc (_, e, t)) -> + Ast.ExTyc (_, e', t)) -> pp f "%a :@ %a =@ %a" (list o#fun_binding "@ ") - ((`patt p) :: pl) o#ctyp t o#expr e - | _ -> + ((`patt p) :: pl) o#ctyp t o#expr e' + | (Ast.PaId (_, (Ast.IdLid (_, _))), _) -> pp f "%a @[<0>%a=@]@ %a" o#simple_patt p - (list' o#fun_binding "" "@ ") pl o#expr e) + (list' o#fun_binding "" "@ ") pl o#expr e' + | _ -> pp f "%a =@ %a" o#simple_patt p o#expr e) | Ast.BiAnt (_, s) -> o#anti f s - method record_binding = fun f bi -> let () = o#node f bi Ast.loc_of_rec_binding @@ -19212,7 +19219,6 @@ (o#under_semi#record_binding f b1; o#under_semi#record_binding f b2) | Ast.RbAnt (_, s) -> o#anti f s - method mk_patt_list = function | Ast.PaApp (_, @@ -19222,7 +19228,6 @@ let (pl, c) = o#mk_patt_list p2 in ((p1 :: pl), c) | Ast.PaId (_, (Ast.IdUid (_, "[]"))) -> ([], None) | p -> ([], (Some p)) - method mk_expr_list = function | Ast.ExApp (_, @@ -19232,7 +19237,6 @@ let (el, c) = o#mk_expr_list e2 in ((e1 :: el), c) | Ast.ExId (_, (Ast.IdUid (_, "[]"))) -> ([], None) | e -> ([], (Some e)) - method expr_list = fun f -> function @@ -19241,7 +19245,6 @@ | el -> pp f "@[<2>[ %a@] ]" (list o#under_semi#expr ";@ ") el - method expr_list_cons = fun simple f e -> let (el, c) = o#mk_expr_list e @@ -19253,41 +19256,42 @@ then pp f "@[<2>(%a)@]" else pp f "@[<2>%a@]") (list o#under_semi#dot_expr " ::@ ") (el @ [ x ]) - method patt_expr_fun_args = fun f (p, e) -> let (pl, e) = expr_fun_args e in pp f "%a@ ->@ %a" (list o#fun_binding "@ ") (p :: pl) o#expr e - method patt_class_expr_fun_args = fun f (p, ce) -> let (pl, ce) = class_expr_fun_args ce in pp f "%a =@]@ %a" (list o#simple_patt "@ ") (p :: pl) o#class_expr ce - method constrain = fun f (t1, t2) -> pp f "@[<2>constraint@ %a =@ %a@]" o#ctyp t1 o#ctyp t2 - method sum_type = fun f t -> match Ast.list_of_ctyp t [] with | [] -> () - | ts -> pp f "@[| %a@]" (list o#ctyp "@ | ") ts - + | ts -> + pp f "@[| %a@]" + (list o#constructor_declaration "@ | ") ts + method private constructor_declaration = + fun f t -> + match t with + | Ast.TyCol (_, t1, (Ast.TyArr (_, t2, t3))) -> + pp f "@[<2>%a :@ @[<2>%a@ ->@ %a@]@]" o#ctyp t1 + o#constructor_type t2 o#ctyp t3 + | t -> o#ctyp f t method string = fun f -> pp f "%s" - method quoted_string = fun f -> pp f "%S" - method numeric = fun f num suff -> if num.[0] = '-' then pp f "(%s%s)" num suff else pp f "%s%s" num suff - method module_expr_get_functor_args = fun accu -> function @@ -19296,13 +19300,10 @@ | Ast.MeTyc (_, me, mt) -> ((List.rev accu), me, (Some mt)) | me -> ((List.rev accu), me, None) - method functor_args = fun f -> list o#functor_arg "@ " f - method functor_arg = fun f (s, mt) -> pp f "@[<2>(%a :@ %a)@]" o#var s o#module_type mt - method module_rec_binding = fun f -> function @@ -19317,14 +19318,12 @@ pp f o#andsep; o#module_rec_binding f mb2) | Ast.MbAnt (_, s) -> o#anti f s - method class_declaration = fun f -> function | Ast.CeTyc (_, ce, ct) -> pp f "%a :@ %a" o#class_expr ce o#class_type ct | ce -> o#class_expr f ce - method raise_match_failure = fun f _loc -> let n = Loc.file_name _loc in @@ -19343,11 +19342,9 @@ (Ast.safe_string_escaped n))))), (Ast.ExInt (_loc, (string_of_int l))))), (Ast.ExInt (_loc, (string_of_int c))))))) - method node : 'a. formatter -> 'a -> ('a -> Loc.t) -> unit = fun f node loc_of_node -> o#print_comments_before (loc_of_node node) f - method ident = fun f i -> let () = o#node f i Ast.loc_of_ident @@ -19359,9 +19356,7 @@ pp f "%a@,(%a)" o#ident i1 o#ident i2 | Ast.IdAnt (_, s) -> o#anti f s | Ast.IdLid (_, s) | Ast.IdUid (_, s) -> o#var f s - method private var_ident = {< var_conversion = true; >}#ident - method expr = fun f e -> let () = o#node f e Ast.loc_of_expr @@ -19471,7 +19466,6 @@ "@[@[object @[<2>(%a)@]@ %a@]@ end@]" o#patt p o#class_str_item cst | e -> o#apply_expr f e - method apply_expr = fun f e -> let () = o#node f e Ast.loc_of_expr @@ -19479,7 +19473,6 @@ match e with | Ast.ExNew (_, i) -> pp f "@[<2>new@ %a@]" o#ident i | e -> o#dot_expr f e - method dot_expr = fun f e -> let () = o#node f e Ast.loc_of_expr @@ -19497,7 +19490,6 @@ | Ast.ExSnd (_, e, s) -> pp f "@[<2>%a#@,%s@]" o#dot_expr e s | e -> o#simple_expr f e - method simple_expr = fun f e -> let () = o#node f e Ast.loc_of_expr @@ -19571,14 +19563,12 @@ Ast.ExAsr (_, _) | Ast.ExAsf _ | Ast.ExLaz (_, _) | Ast.ExNew (_, _) | Ast.ExObj (_, _, _) -> pp f "(%a)" o#reset#expr e - method direction_flag = fun f b -> match b with | Ast.DiTo -> pp_print_string f "to" | Ast.DiDownto -> pp_print_string f "downto" | Ast.DiAnt s -> o#anti f s - method patt = fun f p -> let () = o#node f p Ast.loc_of_patt @@ -19591,16 +19581,13 @@ | Ast.PaSem (_, p1, p2) -> pp f "%a;@ %a" o#patt p1 o#patt p2 | p -> o#patt1 f p - method patt1 = fun f -> function | Ast.PaOrp (_, p1, p2) -> pp f "@[<2>%a@ |@ %a@]" o#patt1 p1 o#patt2 p2 | p -> o#patt2 f p - method patt2 = fun f p -> o#patt3 f p - method patt3 = fun f -> function @@ -19609,7 +19596,6 @@ | Ast.PaCom (_, p1, p2) -> pp f "%a,@ %a" o#patt3 p1 o#patt3 p2 | p -> o#patt4 f p - method patt4 = fun f -> function @@ -19627,7 +19613,6 @@ pp f "@[<2>%a@]" (list o#patt5 " ::@ ") (pl @ [ x ])) | p -> o#patt5 f p - method patt5 = fun f -> function @@ -19662,7 +19647,6 @@ pp f "@[<2>%a@ (%a)@]" o#patt5 a (list o#simple_patt ",@ ") al) | p -> o#simple_patt f p - method simple_patt = fun f p -> let () = o#node f p Ast.loc_of_patt @@ -19672,6 +19656,7 @@ | Ast.PaId (_, i) -> o#var_ident f i | Ast.PaAnt (_, s) -> o#anti f s | Ast.PaAny _ -> pp f "_" + | Ast.PaMod (_, m) -> pp f "(module %s)" m | Ast.PaTup (_, p) -> pp f "@[<1>(%a)@]" o#patt3 p | Ast.PaRec (_, p) -> pp f "@[{@ %a@]@ }" o#patt p | Ast.PaStr (_, s) -> pp f "\"%s\"" s @@ -19704,14 +19689,12 @@ Ast.PaCom (_, _, _) | Ast.PaSem (_, _, _) | Ast.PaEq (_, _, _) | Ast.PaLaz (_, _) as p) -> pp f "@[<1>(%a)@]" o#patt p - method patt_tycon = fun f -> function | Ast.PaTyc (_, p, t) -> pp f "%a :@ %a" o#patt p o#ctyp t | p -> o#patt f p - method simple_ctyp = fun f t -> let () = o#node f t Ast.loc_of_ctyp @@ -19720,6 +19703,8 @@ | Ast.TyId (_, i) -> o#ident f i | Ast.TyAnt (_, s) -> o#anti f s | Ast.TyAny _ -> pp f "_" + | Ast.TyAnP _ -> pp f "+_" + | Ast.TyAnM _ -> pp f "-_" | Ast.TyLab (_, s, t) -> pp f "@[<2>%s:@ %a@]" s o#simple_ctyp t | Ast.TyOlb (_, s, t) -> @@ -19754,7 +19739,6 @@ pp f "%a *@ %a" o#simple_ctyp t1 o#simple_ctyp t2 | Ast.TyNil _ -> assert false | t -> pp f "@[<1>(%a)@]" o#ctyp t - method ctyp = fun f t -> let () = o#node f t Ast.loc_of_ctyp @@ -19799,7 +19783,6 @@ then pp f "@ %a" (list o#constrain "@ ") cl else ()) | t -> o#ctyp1 f t - method ctyp1 = fun f -> function @@ -19816,10 +19799,14 @@ in pp f "@[<2>%a.@ %a@]" (list o#ctyp "@ ") (a :: al) o#ctyp t2 + | Ast.TyTypePol ((_, t1, t2)) -> + let (a, al) = get_ctyp_args t1 [] + in + pp f "@[<2>type %a.@ %a@]" (list o#ctyp "@ ") + (a :: al) o#ctyp t2 | Ast.TyPrv (_, t) -> pp f "@[private@ %a@]" o#simple_ctyp t | t -> o#simple_ctyp f t - method constructor_type = fun f t -> match t with @@ -19830,7 +19817,6 @@ o#constructor_type t2 | Ast.TyArr (_, _, _) -> pp f "(%a)" o#ctyp t | t -> o#ctyp f t - method sig_item = fun f sg -> let () = o#node f sg Ast.loc_of_sig_item @@ -19887,7 +19873,6 @@ o#module_rec_binding mb semisep | Ast.SgDir (_, _, _) -> () | Ast.SgAnt (_, s) -> pp f "%a%(%)" o#anti s semisep - method str_item = fun f st -> let () = o#node f st Ast.loc_of_str_item @@ -19954,13 +19939,14 @@ | Ast.StDir (_, _, _) -> () | Ast.StAnt (_, s) -> pp f "%a%(%)" o#anti s semisep | Ast.StExc (_, _, (Ast.OAnt _)) -> assert false - method module_type = fun f mt -> let () = o#node f mt Ast.loc_of_module_type in match mt with | Ast.MtNil _ -> assert false + | Ast.MtOf (_, me) -> + pp f "@[<2>module type of@ %a@]" o#module_expr me | Ast.MtId (_, i) -> o#ident f i | Ast.MtAnt (_, s) -> o#anti f s | Ast.MtFun (_, s, mt1, mt2) -> @@ -19972,7 +19958,6 @@ | Ast.MtWit (_, mt, wc) -> pp f "@[<2>%a@ with@ %a@]" o#module_type mt o#with_constraint wc - method with_constraint = fun f wc -> let () = o#node f wc Ast.loc_of_with_constr @@ -19994,7 +19979,6 @@ pp f o#andsep; o#with_constraint f wc2) | Ast.WcAnt (_, s) -> o#anti f s - method module_expr = fun f me -> let () = o#node f me Ast.loc_of_module_expr @@ -20007,7 +19991,6 @@ "@[<2>@[struct@ %a@]@ end :@ @[sig@ %a@]@ end@]" o#str_item st o#sig_item sg | _ -> o#simple_module_expr f me - method simple_module_expr = fun f me -> let () = o#node f me Ast.loc_of_module_expr @@ -20034,14 +20017,13 @@ o#module_type mt | Ast.MePkg (_, e) -> pp f "@[<1>(%s %a)@]" o#value_val o#expr e - method class_expr = fun f ce -> let () = o#node f ce Ast.loc_of_class_expr in match ce with | Ast.CeApp (_, ce, e) -> - pp f "@[<2>%a@ %a@]" o#class_expr ce o#expr e + pp f "@[<2>%a@ %a@]" o#class_expr ce o#apply_expr e | Ast.CeCon (_, Ast.ViNil, i, (Ast.TyNil _)) -> pp f "@[<2>%a@]" o#ident i | Ast.CeCon (_, Ast.ViNil, i, t) -> @@ -20082,7 +20064,6 @@ pp f "@[<2>%a =@]@ %a" o#class_expr ce1 o#class_expr ce2 | _ -> assert false - method class_type = fun f ct -> let () = o#node f ct Ast.loc_of_class_type @@ -20119,7 +20100,6 @@ | Ast.CtEq (_, ct1, ct2) -> pp f "%a =@ %a" o#class_type ct1 o#class_type ct2 | _ -> assert false - method class_sig_item = fun f csg -> let () = o#node f csg Ast.loc_of_class_sig_item @@ -20135,22 +20115,21 @@ o#class_sig_item f csg2) | Ast.CgCtr (_, t1, t2) -> pp f "@[<2>constraint@ %a =@ %a%(%)@]" o#ctyp t1 - o#ctyp t2 semisep + o#ctyp t2 no_semisep | Ast.CgInh (_, ct) -> pp f "@[<2>inherit@ %a%(%)@]" o#class_type ct - semisep + no_semisep | Ast.CgMth (_, s, pr, t) -> pp f "@[<2>method %a%a :@ %a%(%)@]" o#private_flag - pr o#var s o#ctyp t semisep + pr o#var s o#ctyp t no_semisep | Ast.CgVir (_, s, pr, t) -> pp f "@[<2>method virtual %a%a :@ %a%(%)@]" - o#private_flag pr o#var s o#ctyp t semisep + o#private_flag pr o#var s o#ctyp t no_semisep | Ast.CgVal (_, s, mu, vi, t) -> pp f "@[<2>%s %a%a%a :@ %a%(%)@]" o#value_val o#mutable_flag mu o#virtual_flag vi o#var s - o#ctyp t semisep - | Ast.CgAnt (_, s) -> pp f "%a%(%)" o#anti s semisep - + o#ctyp t no_semisep + | Ast.CgAnt (_, s) -> pp f "%a%(%)" o#anti s no_semisep method class_str_item = fun f cst -> let () = o#node f cst Ast.loc_of_class_str_item @@ -20166,45 +20145,43 @@ o#class_str_item f cst2) | Ast.CrCtr (_, t1, t2) -> pp f "@[<2>constraint %a =@ %a%(%)@]" o#ctyp t1 - o#ctyp t2 semisep + o#ctyp t2 no_semisep | Ast.CrInh (_, ov, ce, "") -> pp f "@[<2>inherit%a@ %a%(%)@]" o#override_flag ov - o#class_expr ce semisep + o#class_expr ce no_semisep | Ast.CrInh (_, ov, ce, s) -> pp f "@[<2>inherit%a@ %a as@ %a%(%)@]" o#override_flag ov o#class_expr ce o#var s - semisep + no_semisep | Ast.CrIni (_, e) -> - pp f "@[<2>initializer@ %a%(%)@]" o#expr e semisep + pp f "@[<2>initializer@ %a%(%)@]" o#expr e + no_semisep | Ast.CrMth (_, s, ov, pr, e, (Ast.TyNil _)) -> pp f "@[<2>method%a %a%a =@ %a%(%)@]" o#override_flag ov o#private_flag pr o#var s - o#expr e semisep + o#expr e no_semisep | Ast.CrMth (_, s, ov, pr, e, t) -> pp f "@[<2>method%a %a%a :@ %a =@ %a%(%)@]" o#override_flag ov o#private_flag pr o#var s - o#ctyp t o#expr e semisep + o#ctyp t o#expr e no_semisep | Ast.CrVir (_, s, pr, t) -> pp f "@[<2>method virtual@ %a%a :@ %a%(%)@]" - o#private_flag pr o#var s o#ctyp t semisep + o#private_flag pr o#var s o#ctyp t no_semisep | Ast.CrVvr (_, s, mu, t) -> pp f "@[<2>%s virtual %a%a :@ %a%(%)@]" o#value_val - o#mutable_flag mu o#var s o#ctyp t semisep + o#mutable_flag mu o#var s o#ctyp t no_semisep | Ast.CrVal (_, s, ov, mu, e) -> pp f "@[<2>%s%a %a%a =@ %a%(%)@]" o#value_val o#override_flag ov o#mutable_flag mu o#var s - o#expr e semisep - | Ast.CrAnt (_, s) -> pp f "%a%(%)" o#anti s semisep - + o#expr e no_semisep + | Ast.CrAnt (_, s) -> pp f "%a%(%)" o#anti s no_semisep method implem = fun f st -> match st with | Ast.StExp (_, e) -> pp f "@[<0>%a%(%)@]@." o#expr e semisep | st -> pp f "@[%a@]@." o#str_item st - method interf = fun f sg -> pp f "@[%a@]@." o#sig_item sg - end let with_outfile output_file fct arg = @@ -20316,8 +20293,7 @@ class printer : ?curry_constr: bool -> ?comments: bool -> - unit -> object ('a) inherit OCaml.Make(Syntax).printer - end + unit -> object ('a) inherit OCaml.Make(Syntax).printer end val with_outfile : string option -> (formatter -> 'a -> unit) -> 'a -> unit @@ -20369,35 +20345,22 @@ inherit PP_o.printer ~curry_constr: init_curry_constr ~comments () as super - val! semisep = (";" : sep) - + val! no_semisep = (";" : sep) val mode = if comments then `comments else `no_comments - val curry_constr = init_curry_constr - val first_match_case = true - method andsep : sep = "@]@ @[<2>and@ " - method value_val = "value" - method value_let = "value" - method under_pipe = o - method under_semi = o - method reset_semi = o - method reset = o - method private unset_first_match_case = {< first_match_case = false; >} - method private set_first_match_case = {< first_match_case = true; >} - method seq = fun f e -> let rec self right f e = @@ -20421,7 +20384,6 @@ | _ -> go_right f e2)) | e -> o#expr f e in self true f e - method var = fun f -> function @@ -20441,14 +20403,12 @@ failwith (sprintf "Bad token used as an identifier: %s" (Token.to_string tok))) - method type_params = fun f -> function | [] -> () | [ x ] -> pp f "@ %a" o#ctyp x | l -> pp f "@ @[<1>%a@]" (list o#ctyp "@ ") l - method match_case = fun f -> function @@ -20456,7 +20416,6 @@ | m -> pp f "@ [ %a ]" o#set_first_match_case#match_case_aux m - method match_case_aux = fun f -> function @@ -20475,13 +20434,11 @@ in pp f "@[<2>%a@ when@ %a@ ->@ %a@]" o#patt p o#under_pipe#expr w o#under_pipe#expr e - method sum_type = fun f -> function | Ast.TyNil _ -> pp f "[]" | t -> pp f "@[[ %a ]@]" o#ctyp t - method ident = fun f i -> let () = o#node f i Ast.loc_of_ident @@ -20490,7 +20447,6 @@ | Ast.IdApp (_, i1, i2) -> pp f "%a@ %a" o#dot_ident i1 o#dot_ident i2 | i -> o#dot_ident f i - method private dot_ident = fun f i -> let () = o#node f i Ast.loc_of_ident @@ -20501,7 +20457,6 @@ | Ast.IdAnt (_, s) -> o#anti f s | Ast.IdLid (_, s) | Ast.IdUid (_, s) -> o#var f s | i -> pp f "(%a)" o#ident i - method patt4 = fun f -> function @@ -20519,7 +20474,6 @@ pp f "@[<2>[ %a ::@ %a ]@]" (list o#patt ";@ ") pl o#patt x) | p -> super#patt4 f p - method expr_list_cons = fun _ f e -> let (el, c) = o#mk_expr_list e @@ -20529,7 +20483,6 @@ | Some x -> pp f "@[<2>[ %a ::@ %a ]@]" (list o#expr ";@ ") el o#expr x - method expr = fun f e -> let () = o#node f e Ast.loc_of_expr @@ -20548,7 +20501,6 @@ pp f "@[fun%a@]" o#match_case a | Ast.ExAsf _ -> pp f "@[<2>assert@ False@]" | e -> super#expr f e - method dot_expr = fun f e -> let () = o#node f e Ast.loc_of_expr @@ -20558,7 +20510,6 @@ (Ast.ExId (_, (Ast.IdLid (_, "val"))))) -> pp f "@[<2>%a.@,val@]" o#simple_expr e | e -> super#dot_expr f e - method ctyp = fun f t -> let () = o#node f t Ast.loc_of_ctyp @@ -20574,8 +20525,9 @@ else ()) | Ast.TyCol (_, t1, (Ast.TyMut (_, t2))) -> pp f "@[%a :@ mutable %a@]" o#ctyp t1 o#ctyp t2 + | Ast.TyMan (_, t1, t2) -> + pp f "@[<2>%a ==@ %a@]" o#simple_ctyp t1 o#ctyp t2 | t -> super#ctyp f t - method simple_ctyp = fun f t -> let () = o#node f t Ast.loc_of_ctyp @@ -20595,7 +20547,6 @@ | Ast.TyLab (_, s, t) -> pp f "@[<2>~%s:@ %a@]" s o#simple_ctyp t | t -> super#simple_ctyp f t - method ctyp1 = fun f -> function @@ -20613,7 +20564,6 @@ pp f "@[<2>! %a.@ %a@]" (list o#ctyp "@ ") (a :: al) o#ctyp t2 | t -> super#ctyp1 f t - method constructor_type = fun f t -> match t with @@ -20623,14 +20573,12 @@ pp f "%a@ and %a" o#constructor_type t1 o#constructor_type t2 | t -> o#ctyp f t - method str_item = fun f st -> match st with | Ast.StExp (_, e) -> pp f "@[<2>%a%(%)@]" o#expr e semisep | st -> super#str_item f st - method module_expr = fun f me -> let () = o#node f me Ast.loc_of_module_expr @@ -20640,7 +20588,6 @@ pp f "@[<2>%a@ %a@]" o#module_expr me1 o#simple_module_expr me2 | me -> super#module_expr f me - method simple_module_expr = fun f me -> let () = o#node f me Ast.loc_of_module_expr @@ -20648,9 +20595,7 @@ match me with | Ast.MeApp (_, _, _) -> pp f "(%a)" o#module_expr me | _ -> super#simple_module_expr f me - method implem = fun f st -> pp f "@[%a@]@." o#str_item st - method class_type = fun f ct -> let () = o#node f ct Ast.loc_of_class_type @@ -20671,7 +20616,6 @@ pp f "@[<2>virtual@ %a@ [@,%a@]@,]" o#var i o#class_params t | ct -> super#class_type f ct - method class_expr = fun f ce -> let () = o#node f ce Ast.loc_of_class_expr @@ -20687,9 +20631,8 @@ | Ast.CeCon (_, Ast.ViVirtual, (Ast.IdLid (_, i)), t) -> pp f "@[<2>virtual@ %a@ @[<1>[%a]@]@]" o#var i - o#ctyp t + o#class_params t | ce -> super#class_expr f ce - end let with_outfile = with_outfile @@ -21418,6 +21361,11 @@ PreCast.Ast.str_item parser_fun -> PreCast.Ast.sig_item parser_fun -> unit + val current_parser : + unit -> + ((PreCast.Ast.str_item parser_fun) * + (PreCast.Ast.sig_item parser_fun)) + module Parser (Id : Sig.Id) (Maker : functor (Ast : Sig.Ast) -> Sig.Parser(Ast).S) : sig end @@ -21441,6 +21389,11 @@ PreCast.Ast.str_item printer_fun -> PreCast.Ast.sig_item printer_fun -> unit + val current_printer : + unit -> + ((PreCast.Ast.str_item printer_fun) * + (PreCast.Ast.sig_item printer_fun)) + module Printer (Id : Sig.Id) (Maker : functor (Syn : Sig.Syntax) -> Sig.Printer(Syn.Ast).S) : @@ -21526,12 +21479,16 @@ let register_parser f g = (str_item_parser := f; sig_item_parser := g) + let current_parser () = ((!str_item_parser), (!sig_item_parser)) + let register_str_item_printer f = str_item_printer := f let register_sig_item_printer f = sig_item_printer := f let register_printer f g = (str_item_printer := f; sig_item_printer := g) + let current_printer () = ((!str_item_printer), (!sig_item_printer)) + module Plugin (Id : Sig.Id) (Maker : functor (Unit : sig end) -> sig end) = struct diff -Nru ocaml-3.12.1/camlp4/boot/Camlp4Ast.ml ocaml-4.01.0/camlp4/boot/Camlp4Ast.ml --- ocaml-3.12.1/camlp4/boot/Camlp4Ast.ml 2011-02-02 14:25:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/boot/Camlp4Ast.ml 2013-08-30 11:39:33.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) (* Authors: @@ -108,12 +108,12 @@ | Ast.PaLab _ _ p -> is_irrefut_patt p | Ast.PaLaz _ p -> is_irrefut_patt p | Ast.PaId _ _ -> False - | (* here one need to know the arity of constructors *) - Ast.PaVrn _ _ | Ast.PaStr _ _ | Ast.PaRng _ _ _ | Ast.PaFlo _ _ | - Ast.PaNativeInt _ _ | Ast.PaInt64 _ _ | Ast.PaInt32 _ _ | - Ast.PaInt _ _ | Ast.PaChr _ _ | Ast.PaTyp _ _ | Ast.PaArr _ _ | - Ast.PaAnt _ _ - -> False ]; + | (* here one need to know the arity of constructors *) Ast.PaMod _ _ + -> True + | Ast.PaVrn _ _ | Ast.PaStr _ _ | Ast.PaRng _ _ _ | Ast.PaFlo _ _ | + Ast.PaNativeInt _ _ | Ast.PaInt64 _ _ | Ast.PaInt32 _ _ | + Ast.PaInt _ _ | Ast.PaChr _ _ | Ast.PaTyp _ _ | Ast.PaArr _ _ | + Ast.PaAnt _ _ -> False ]; value rec is_constructor = fun [ Ast.IdAcc _ _ i -> is_constructor i @@ -471,10 +471,11 @@ value meta_loc = meta_loc_expr; module Expr = struct - value meta_string _loc s = Ast.ExStr _loc s; + value meta_string _loc s = + Ast.ExStr _loc (safe_string_escaped s); value meta_int _loc s = Ast.ExInt _loc s; value meta_float _loc s = Ast.ExFlo _loc s; - value meta_char _loc s = Ast.ExChr _loc s; + value meta_char _loc s = Ast.ExChr _loc (String.escaped s); value meta_bool _loc = fun [ False -> Ast.ExId _loc (Ast.IdUid _loc "False") @@ -1042,6 +1043,18 @@ (Ast.IdUid _loc "TyVrn"))) (meta_loc _loc x0)) (meta_string _loc x1) + | Ast.TyAnM x0 -> + Ast.ExApp _loc + (Ast.ExId _loc + (Ast.IdAcc _loc (Ast.IdUid _loc "Ast") + (Ast.IdUid _loc "TyAnM"))) + (meta_loc _loc x0) + | Ast.TyAnP x0 -> + Ast.ExApp _loc + (Ast.ExId _loc + (Ast.IdAcc _loc (Ast.IdUid _loc "Ast") + (Ast.IdUid _loc "TyAnP"))) + (meta_loc _loc x0) | Ast.TyQuM x0 x1 -> Ast.ExApp _loc (Ast.ExApp _loc @@ -1066,6 +1079,16 @@ (Ast.IdUid _loc "TyQuo"))) (meta_loc _loc x0)) (meta_string _loc x1) + | Ast.TyTypePol x0 x1 x2 -> + Ast.ExApp _loc + (Ast.ExApp _loc + (Ast.ExApp _loc + (Ast.ExId _loc + (Ast.IdAcc _loc (Ast.IdUid _loc "Ast") + (Ast.IdUid _loc "TyTypePol"))) + (meta_loc _loc x0)) + (meta_ctyp _loc x1)) + (meta_ctyp _loc x2) | Ast.TyPol x0 x1 x2 -> Ast.ExApp _loc (Ast.ExApp _loc @@ -1910,7 +1933,15 @@ (Ast.IdUid _loc "OvOverride")) ] and meta_patt _loc = fun - [ Ast.PaLaz x0 x1 -> + [ Ast.PaMod x0 x1 -> + Ast.ExApp _loc + (Ast.ExApp _loc + (Ast.ExId _loc + (Ast.IdAcc _loc (Ast.IdUid _loc "Ast") + (Ast.IdUid _loc "PaMod"))) + (meta_loc _loc x0)) + (meta_string _loc x1) + | Ast.PaLaz x0 x1 -> Ast.ExApp _loc (Ast.ExApp _loc (Ast.ExId _loc @@ -2547,10 +2578,11 @@ value meta_loc = meta_loc_patt; module Patt = struct - value meta_string _loc s = Ast.PaStr _loc s; + value meta_string _loc s = + Ast.PaStr _loc (safe_string_escaped s); value meta_int _loc s = Ast.PaInt _loc s; value meta_float _loc s = Ast.PaFlo _loc s; - value meta_char _loc s = Ast.PaChr _loc s; + value meta_char _loc s = Ast.PaChr _loc (String.escaped s); value meta_bool _loc = fun [ False -> Ast.PaId _loc (Ast.IdUid _loc "False") @@ -3118,6 +3150,18 @@ (Ast.IdUid _loc "TyVrn"))) (meta_loc _loc x0)) (meta_string _loc x1) + | Ast.TyAnM x0 -> + Ast.PaApp _loc + (Ast.PaId _loc + (Ast.IdAcc _loc (Ast.IdUid _loc "Ast") + (Ast.IdUid _loc "TyAnM"))) + (meta_loc _loc x0) + | Ast.TyAnP x0 -> + Ast.PaApp _loc + (Ast.PaId _loc + (Ast.IdAcc _loc (Ast.IdUid _loc "Ast") + (Ast.IdUid _loc "TyAnP"))) + (meta_loc _loc x0) | Ast.TyQuM x0 x1 -> Ast.PaApp _loc (Ast.PaApp _loc @@ -3142,6 +3186,16 @@ (Ast.IdUid _loc "TyQuo"))) (meta_loc _loc x0)) (meta_string _loc x1) + | Ast.TyTypePol x0 x1 x2 -> + Ast.PaApp _loc + (Ast.PaApp _loc + (Ast.PaApp _loc + (Ast.PaId _loc + (Ast.IdAcc _loc (Ast.IdUid _loc "Ast") + (Ast.IdUid _loc "TyTypePol"))) + (meta_loc _loc x0)) + (meta_ctyp _loc x1)) + (meta_ctyp _loc x2) | Ast.TyPol x0 x1 x2 -> Ast.PaApp _loc (Ast.PaApp _loc @@ -3986,7 +4040,15 @@ (Ast.IdUid _loc "OvOverride")) ] and meta_patt _loc = fun - [ Ast.PaLaz x0 x1 -> + [ Ast.PaMod x0 x1 -> + Ast.PaApp _loc + (Ast.PaApp _loc + (Ast.PaId _loc + (Ast.IdAcc _loc (Ast.IdUid _loc "Ast") + (Ast.IdUid _loc "PaMod"))) + (meta_loc _loc x0)) + (meta_string _loc x1) + | Ast.PaLaz x0 x1 -> Ast.PaApp _loc (Ast.PaApp _loc (Ast.PaId _loc @@ -4888,7 +4950,10 @@ let _x = o#loc _x in let _x_i1 = o#string _x_i1 in PaVrn _x _x_i1 | PaLaz _x _x_i1 -> - let _x = o#loc _x in let _x_i1 = o#patt _x_i1 in PaLaz _x _x_i1 ]; + let _x = o#loc _x in let _x_i1 = o#patt _x_i1 in PaLaz _x _x_i1 + | PaMod _x _x_i1 -> + let _x = o#loc _x in + let _x_i1 = o#string _x_i1 in PaMod _x _x_i1 ]; method override_flag : override_flag -> override_flag = fun [ OvOverride -> OvOverride @@ -4971,7 +5036,22 @@ let _x = o#loc _x in let _x_i1 = o#string _x_i1 in MbAnt _x _x_i1 ]; method meta_option : - ! 'a 'a_out. + ! (****************************************************************************) + (* *) + (* OCaml *) + (* *) + (* INRIA Rocquencourt *) + (* *) + (* Copyright 2007 Institut National de Recherche en Informatique et *) + (* en Automatique. All rights reserved. This file is distributed under *) + (* the terms of the GNU Library General Public License, with the special *) + (* exception on linking described in LICENSE at the top of the OCaml *) + (* source tree. *) + (* *) + (****************************************************************************) + (* Note: when you modify these types you must increment + ast magic numbers defined in Camlp4_config.ml. *) + 'a 'a_out. ('self_type -> 'a -> 'a_out) -> meta_option 'a -> meta_option 'a_out = fun _f_a -> @@ -5242,6 +5322,10 @@ let _x = o#loc _x in let _x_i1 = o#ctyp _x_i1 in let _x_i2 = o#ctyp _x_i2 in TyPol _x _x_i1 _x_i2 + | TyTypePol _x _x_i1 _x_i2 -> + let _x = o#loc _x in + let _x_i1 = o#ctyp _x_i1 in + let _x_i2 = o#ctyp _x_i2 in TyTypePol _x _x_i1 _x_i2 | TyQuo _x _x_i1 -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in TyQuo _x _x_i1 @@ -5251,6 +5335,8 @@ | TyQuM _x _x_i1 -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in TyQuM _x _x_i1 + | TyAnP _x -> let _x = o#loc _x in TyAnP _x + | TyAnM _x -> let _x = o#loc _x in TyAnM _x | TyVrn _x _x_i1 -> let _x = o#loc _x in let _x_i1 = o#string _x_i1 in TyVrn _x _x_i1 @@ -5672,7 +5758,8 @@ let o = o#patt _x_i1 in let o = o#ctyp _x_i2 in o | PaTyp _x _x_i1 -> let o = o#loc _x in let o = o#ident _x_i1 in o | PaVrn _x _x_i1 -> let o = o#loc _x in let o = o#string _x_i1 in o - | PaLaz _x _x_i1 -> let o = o#loc _x in let o = o#patt _x_i1 in o ]; + | PaLaz _x _x_i1 -> let o = o#loc _x in let o = o#patt _x_i1 in o + | PaMod _x _x_i1 -> let o = o#loc _x in let o = o#string _x_i1 in o ]; method override_flag : override_flag -> 'self_type = fun [ OvOverride -> o @@ -5929,9 +6016,14 @@ | TyPol _x _x_i1 _x_i2 -> let o = o#loc _x in let o = o#ctyp _x_i1 in let o = o#ctyp _x_i2 in o + | TyTypePol _x _x_i1 _x_i2 -> + let o = o#loc _x in + let o = o#ctyp _x_i1 in let o = o#ctyp _x_i2 in o | TyQuo _x _x_i1 -> let o = o#loc _x in let o = o#string _x_i1 in o | TyQuP _x _x_i1 -> let o = o#loc _x in let o = o#string _x_i1 in o | TyQuM _x _x_i1 -> let o = o#loc _x in let o = o#string _x_i1 in o + | TyAnP _x -> let o = o#loc _x in o + | TyAnM _x -> let o = o#loc _x in o | TyVrn _x _x_i1 -> let o = o#loc _x in let o = o#string _x_i1 in o | TyRec _x _x_i1 -> let o = o#loc _x in let o = o#ctyp _x_i1 in o | TyCol _x _x_i1 _x_i2 -> diff -Nru ocaml-3.12.1/camlp4/boot/camlp4boot.ml ocaml-4.01.0/camlp4/boot/camlp4boot.ml --- ocaml-3.12.1/camlp4/boot/camlp4boot.ml 2011-02-08 14:07:47.000000000 +0000 +++ ocaml-4.01.0/camlp4/boot/camlp4boot.ml 2013-08-30 11:39:33.000000000 +0000 @@ -5,15 +5,15 @@ (* -*- camlp4r -*- *) (****************************************************************************) (* *) - (* Objective Caml *) + (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) - (* exception on linking described in LICENSE at the top of the Objective *) - (* Caml source tree. *) + (* exception on linking described in LICENSE at the top of the OCaml *) + (* source tree. *) (* *) (****************************************************************************) (* Authors: @@ -588,6 +588,12 @@ let stopped_at _loc = Some (Loc.move_line 1 _loc) (* FIXME be more precise *) + let rec generalized_type_of_type = + function + | Ast.TyArr (_, t1, t2) -> + let (tl, rt) = generalized_type_of_type t2 in ((t1 :: tl), rt) + | t -> ([], t) + let symbolchar = let list = [ '$'; '!'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; @@ -676,8 +682,8 @@ (match Stream.peek __strm with | Some ((KEYWORD - (("mod" | "land" | "lor" | "lxor" | "lsl" | "lsr" | - "asr" + (("or" | "mod" | "land" | "lor" | "lxor" | "lsl" | + "lsr" | "asr" as i)), _loc)) -> @@ -735,8440 +741,8918 @@ let a = symb __strm in kont a __strm) let _ = - let _ = (a_CHAR : 'a_CHAR Gram.Entry.t) - and _ = (override_flag_quot : 'override_flag_quot Gram.Entry.t) - and _ = (row_var_flag_quot : 'row_var_flag_quot Gram.Entry.t) - and _ = (virtual_flag_quot : 'virtual_flag_quot Gram.Entry.t) - and _ = (private_flag_quot : 'private_flag_quot Gram.Entry.t) - and _ = (mutable_flag_quot : 'mutable_flag_quot Gram.Entry.t) - and _ = (direction_flag_quot : 'direction_flag_quot Gram.Entry.t) - and _ = (rec_flag_quot : 'rec_flag_quot Gram.Entry.t) - and _ = (package_type : 'package_type Gram.Entry.t) - and _ = (do_sequence : 'do_sequence Gram.Entry.t) - and _ = (infixop4 : 'infixop4 Gram.Entry.t) - and _ = (infixop3 : 'infixop3 Gram.Entry.t) - and _ = (infixop2 : 'infixop2 Gram.Entry.t) - and _ = (infixop1 : 'infixop1 Gram.Entry.t) - and _ = (infixop0 : 'infixop0 Gram.Entry.t) - and _ = (with_constr_quot : 'with_constr_quot Gram.Entry.t) - and _ = (with_constr : 'with_constr Gram.Entry.t) - and _ = (value_val : 'value_val Gram.Entry.t) - and _ = (value_let : 'value_let Gram.Entry.t) - and _ = (val_longident : 'val_longident Gram.Entry.t) - and _ = (use_file : 'use_file Gram.Entry.t) - and _ = (typevars : 'typevars Gram.Entry.t) - and _ = (type_parameters : 'type_parameters Gram.Entry.t) - and _ = (type_parameter : 'type_parameter Gram.Entry.t) - and _ = - (type_longident_and_parameters : - 'type_longident_and_parameters Gram.Entry.t) - and _ = (type_longident : 'type_longident Gram.Entry.t) - and _ = (type_kind : 'type_kind Gram.Entry.t) - and _ = - (type_ident_and_parameters : - 'type_ident_and_parameters Gram.Entry.t) - and _ = (type_declaration : 'type_declaration Gram.Entry.t) - and _ = (type_constraint : 'type_constraint Gram.Entry.t) - and _ = (top_phrase : 'top_phrase Gram.Entry.t) - and _ = (str_items : 'str_items Gram.Entry.t) - and _ = (str_item_quot : 'str_item_quot Gram.Entry.t) - and _ = (str_item : 'str_item Gram.Entry.t) - and _ = (star_ctyp : 'star_ctyp Gram.Entry.t) - and _ = (sig_items : 'sig_items Gram.Entry.t) - and _ = (sig_item_quot : 'sig_item_quot Gram.Entry.t) - and _ = (sig_item : 'sig_item Gram.Entry.t) - and _ = (sequence : 'sequence Gram.Entry.t) - and _ = (semi : 'semi Gram.Entry.t) - and _ = (sem_patt_for_list : 'sem_patt_for_list Gram.Entry.t) - and _ = (sem_patt : 'sem_patt Gram.Entry.t) - and _ = (sem_expr_for_list : 'sem_expr_for_list Gram.Entry.t) - and _ = (sem_expr : 'sem_expr Gram.Entry.t) - and _ = (row_field : 'row_field Gram.Entry.t) - and _ = (poly_type : 'poly_type Gram.Entry.t) - and _ = (phrase : 'phrase Gram.Entry.t) - and _ = (patt_tcon : 'patt_tcon Gram.Entry.t) - and _ = (patt_quot : 'patt_quot Gram.Entry.t) - and _ = (patt_eoi : 'patt_eoi Gram.Entry.t) - and _ = (patt_as_patt_opt : 'patt_as_patt_opt Gram.Entry.t) - and _ = (patt : 'patt Gram.Entry.t) - and _ = (opt_when_expr : 'opt_when_expr Gram.Entry.t) - and _ = (opt_virtual : 'opt_virtual Gram.Entry.t) - and _ = (opt_rec : 'opt_rec Gram.Entry.t) - and _ = (opt_private : 'opt_private Gram.Entry.t) - and _ = (opt_polyt : 'opt_polyt Gram.Entry.t) - and _ = (opt_mutable : 'opt_mutable Gram.Entry.t) - and _ = (opt_meth_list : 'opt_meth_list Gram.Entry.t) - and _ = (opt_expr : 'opt_expr Gram.Entry.t) - and _ = (opt_eq_ctyp : 'opt_eq_ctyp Gram.Entry.t) - and _ = (opt_dot_dot : 'opt_dot_dot Gram.Entry.t) - and _ = (opt_comma_ctyp : 'opt_comma_ctyp Gram.Entry.t) - and _ = (opt_class_self_type : 'opt_class_self_type Gram.Entry.t) - and _ = (opt_class_self_patt : 'opt_class_self_patt Gram.Entry.t) - and _ = (opt_as_lident : 'opt_as_lident Gram.Entry.t) - and _ = (name_tags : 'name_tags Gram.Entry.t) - and _ = (more_ctyp : 'more_ctyp Gram.Entry.t) - and _ = (module_type_quot : 'module_type_quot Gram.Entry.t) - and _ = (module_type : 'module_type Gram.Entry.t) - and _ = - (module_rec_declaration : 'module_rec_declaration Gram.Entry.t) - and _ = - (module_longident_with_app : - 'module_longident_with_app Gram.Entry.t) - and _ = (module_longident : 'module_longident Gram.Entry.t) - and _ = (module_expr_quot : 'module_expr_quot Gram.Entry.t) - and _ = (module_expr : 'module_expr Gram.Entry.t) - and _ = (module_declaration : 'module_declaration Gram.Entry.t) - and _ = (module_binding_quot : 'module_binding_quot Gram.Entry.t) - and _ = (module_binding0 : 'module_binding0 Gram.Entry.t) - and _ = (module_binding : 'module_binding Gram.Entry.t) - and _ = (meth_decl : 'meth_decl Gram.Entry.t) - and _ = (meth_list : 'meth_list Gram.Entry.t) - and _ = (let_binding : 'let_binding Gram.Entry.t) - and _ = (labeled_ipatt : 'labeled_ipatt Gram.Entry.t) - and _ = (label_patt_list : 'label_patt_list Gram.Entry.t) - and _ = (label_patt : 'label_patt Gram.Entry.t) - and _ = (label_longident : 'label_longident Gram.Entry.t) - and _ = (label_ipatt_list : 'label_ipatt_list Gram.Entry.t) - and _ = (label_ipatt : 'label_ipatt Gram.Entry.t) - and _ = (label_expr_list : 'label_expr_list Gram.Entry.t) - and _ = (label_expr : 'label_expr Gram.Entry.t) - and _ = - (label_declaration_list : 'label_declaration_list Gram.Entry.t) - and _ = (label_declaration : 'label_declaration Gram.Entry.t) - and _ = (label : 'label Gram.Entry.t) - and _ = (ipatt_tcon : 'ipatt_tcon Gram.Entry.t) - and _ = (ipatt : 'ipatt Gram.Entry.t) - and _ = (interf : 'interf Gram.Entry.t) - and _ = (implem : 'implem Gram.Entry.t) - and _ = (ident_quot : 'ident_quot Gram.Entry.t) - and _ = (ident : 'ident Gram.Entry.t) - and _ = (fun_def : 'fun_def Gram.Entry.t) - and _ = (fun_binding : 'fun_binding Gram.Entry.t) - and _ = (field_expr_list : 'field_expr_list Gram.Entry.t) - and _ = (field_expr : 'field_expr Gram.Entry.t) - and _ = (expr_quot : 'expr_quot Gram.Entry.t) - and _ = (expr_eoi : 'expr_eoi Gram.Entry.t) - and _ = (expr : 'expr Gram.Entry.t) - and _ = (eq_expr : 'eq_expr Gram.Entry.t) - and _ = (dummy : 'dummy Gram.Entry.t) - and _ = (direction_flag : 'direction_flag Gram.Entry.t) - and _ = (cvalue_binding : 'cvalue_binding Gram.Entry.t) - and _ = (ctyp_quot : 'ctyp_quot Gram.Entry.t) - and _ = (ctyp : 'ctyp Gram.Entry.t) - and _ = - (constructor_declarations : - 'constructor_declarations Gram.Entry.t) - and _ = - (constructor_declaration : 'constructor_declaration Gram.Entry.t) - and _ = (constructor_arg_list : 'constructor_arg_list Gram.Entry.t) - and _ = (constrain : 'constrain Gram.Entry.t) - and _ = (comma_type_parameter : 'comma_type_parameter Gram.Entry.t) - and _ = (comma_patt : 'comma_patt Gram.Entry.t) - and _ = (comma_ipatt : 'comma_ipatt Gram.Entry.t) - and _ = (comma_expr : 'comma_expr Gram.Entry.t) - and _ = (comma_ctyp : 'comma_ctyp Gram.Entry.t) - and _ = (class_type_quot : 'class_type_quot Gram.Entry.t) - and _ = (class_type_plus : 'class_type_plus Gram.Entry.t) - and _ = - (class_type_longident_and_param : - 'class_type_longident_and_param Gram.Entry.t) - and _ = (class_type_longident : 'class_type_longident Gram.Entry.t) - and _ = - (class_type_declaration : 'class_type_declaration Gram.Entry.t) - and _ = (class_type : 'class_type Gram.Entry.t) - and _ = (class_structure : 'class_structure Gram.Entry.t) - and _ = (class_str_item_quot : 'class_str_item_quot Gram.Entry.t) - and _ = (class_str_item : 'class_str_item Gram.Entry.t) - and _ = (class_signature : 'class_signature Gram.Entry.t) - and _ = (class_sig_item_quot : 'class_sig_item_quot Gram.Entry.t) - and _ = (class_sig_item : 'class_sig_item Gram.Entry.t) - and _ = (class_name_and_param : 'class_name_and_param Gram.Entry.t) - and _ = - (class_longident_and_param : - 'class_longident_and_param Gram.Entry.t) - and _ = (class_longident : 'class_longident Gram.Entry.t) - and _ = - (class_info_for_class_type : - 'class_info_for_class_type Gram.Entry.t) - and _ = - (class_info_for_class_expr : - 'class_info_for_class_expr Gram.Entry.t) - and _ = (class_fun_def : 'class_fun_def Gram.Entry.t) - and _ = (class_fun_binding : 'class_fun_binding Gram.Entry.t) - and _ = (class_expr_quot : 'class_expr_quot Gram.Entry.t) - and _ = (class_expr : 'class_expr Gram.Entry.t) - and _ = (class_description : 'class_description Gram.Entry.t) - and _ = (class_declaration : 'class_declaration Gram.Entry.t) - and _ = (binding_quot : 'binding_quot Gram.Entry.t) - and _ = (binding : 'binding Gram.Entry.t) - and _ = (match_case_quot : 'match_case_quot Gram.Entry.t) - and _ = (match_case0 : 'match_case0 Gram.Entry.t) - and _ = (match_case : 'match_case Gram.Entry.t) - and _ = (and_ctyp : 'and_ctyp Gram.Entry.t) - and _ = (amp_ctyp : 'amp_ctyp Gram.Entry.t) - and _ = (a_ident : 'a_ident Gram.Entry.t) - and _ = (a_UIDENT : 'a_UIDENT Gram.Entry.t) - and _ = (a_STRING : 'a_STRING Gram.Entry.t) - and _ = (a_OPTLABEL : 'a_OPTLABEL Gram.Entry.t) - and _ = (a_NATIVEINT : 'a_NATIVEINT Gram.Entry.t) - and _ = (rec_binding_quot : 'rec_binding_quot Gram.Entry.t) - and _ = (a_LIDENT : 'a_LIDENT Gram.Entry.t) - and _ = (a_LABEL : 'a_LABEL Gram.Entry.t) - and _ = (a_INT64 : 'a_INT64 Gram.Entry.t) - and _ = (a_INT32 : 'a_INT32 Gram.Entry.t) - and _ = (a_INT : 'a_INT Gram.Entry.t) - and _ = (a_FLOAT : 'a_FLOAT Gram.Entry.t) in - let grammar_entry_create = Gram.Entry.mk in - let (* Here it's LABEL and not tilde_label since ~a:b is different than ~a : b *) - (* Same remark for ?a:b *) infixop5 : 'infixop5 Gram.Entry.t = - grammar_entry_create "infixop5" - and (* | i = opt_label; "("; p = patt_tcon; ")" -> *) - (* <:patt< ? $i$ : ($p$) >> *) - (* | i = opt_label; "("; p = ipatt_tcon; ")" -> + let apply () = + let _ = (a_CHAR : 'a_CHAR Gram.Entry.t) + and _ = (override_flag_quot : 'override_flag_quot Gram.Entry.t) + and _ = (row_var_flag_quot : 'row_var_flag_quot Gram.Entry.t) + and _ = (virtual_flag_quot : 'virtual_flag_quot Gram.Entry.t) + and _ = (private_flag_quot : 'private_flag_quot Gram.Entry.t) + and _ = (mutable_flag_quot : 'mutable_flag_quot Gram.Entry.t) + and _ = (direction_flag_quot : 'direction_flag_quot Gram.Entry.t) + and _ = (rec_flag_quot : 'rec_flag_quot Gram.Entry.t) + and _ = (package_type : 'package_type Gram.Entry.t) + and _ = (do_sequence : 'do_sequence Gram.Entry.t) + and _ = (infixop4 : 'infixop4 Gram.Entry.t) + and _ = (infixop3 : 'infixop3 Gram.Entry.t) + and _ = (infixop2 : 'infixop2 Gram.Entry.t) + and _ = (infixop1 : 'infixop1 Gram.Entry.t) + and _ = (infixop0 : 'infixop0 Gram.Entry.t) + and _ = (with_constr_quot : 'with_constr_quot Gram.Entry.t) + and _ = (with_constr : 'with_constr Gram.Entry.t) + and _ = (value_val : 'value_val Gram.Entry.t) + and _ = (value_let : 'value_let Gram.Entry.t) + and _ = (val_longident : 'val_longident Gram.Entry.t) + and _ = (use_file : 'use_file Gram.Entry.t) + and _ = (typevars : 'typevars Gram.Entry.t) + and _ = (type_parameters : 'type_parameters Gram.Entry.t) + and _ = (type_parameter : 'type_parameter Gram.Entry.t) + and _ = + (type_longident_and_parameters : + 'type_longident_and_parameters Gram.Entry.t) + and _ = (type_longident : 'type_longident Gram.Entry.t) + and _ = (type_kind : 'type_kind Gram.Entry.t) + and _ = + (type_ident_and_parameters : + 'type_ident_and_parameters Gram.Entry.t) + and _ = (type_declaration : 'type_declaration Gram.Entry.t) + and _ = (type_constraint : 'type_constraint Gram.Entry.t) + and _ = (top_phrase : 'top_phrase Gram.Entry.t) + and _ = (str_items : 'str_items Gram.Entry.t) + and _ = (str_item_quot : 'str_item_quot Gram.Entry.t) + and _ = (str_item : 'str_item Gram.Entry.t) + and _ = (star_ctyp : 'star_ctyp Gram.Entry.t) + and _ = (sig_items : 'sig_items Gram.Entry.t) + and _ = (sig_item_quot : 'sig_item_quot Gram.Entry.t) + and _ = (sig_item : 'sig_item Gram.Entry.t) + and _ = (sequence : 'sequence Gram.Entry.t) + and _ = (semi : 'semi Gram.Entry.t) + and _ = (sem_patt_for_list : 'sem_patt_for_list Gram.Entry.t) + and _ = (sem_patt : 'sem_patt Gram.Entry.t) + and _ = (sem_expr_for_list : 'sem_expr_for_list Gram.Entry.t) + and _ = (sem_expr : 'sem_expr Gram.Entry.t) + and _ = (row_field : 'row_field Gram.Entry.t) + and _ = (poly_type : 'poly_type Gram.Entry.t) + and _ = (phrase : 'phrase Gram.Entry.t) + and _ = (patt_tcon : 'patt_tcon Gram.Entry.t) + and _ = (patt_quot : 'patt_quot Gram.Entry.t) + and _ = (patt_eoi : 'patt_eoi Gram.Entry.t) + and _ = (patt_as_patt_opt : 'patt_as_patt_opt Gram.Entry.t) + and _ = (patt : 'patt Gram.Entry.t) + and _ = (opt_when_expr : 'opt_when_expr Gram.Entry.t) + and _ = (opt_virtual : 'opt_virtual Gram.Entry.t) + and _ = (opt_rec : 'opt_rec Gram.Entry.t) + and _ = (opt_private : 'opt_private Gram.Entry.t) + and _ = (opt_polyt : 'opt_polyt Gram.Entry.t) + and _ = (opt_mutable : 'opt_mutable Gram.Entry.t) + and _ = (opt_meth_list : 'opt_meth_list Gram.Entry.t) + and _ = (opt_expr : 'opt_expr Gram.Entry.t) + and _ = (opt_eq_ctyp : 'opt_eq_ctyp Gram.Entry.t) + and _ = (opt_dot_dot : 'opt_dot_dot Gram.Entry.t) + and _ = (opt_comma_ctyp : 'opt_comma_ctyp Gram.Entry.t) + and _ = (opt_class_self_type : 'opt_class_self_type Gram.Entry.t) + and _ = (opt_class_self_patt : 'opt_class_self_patt Gram.Entry.t) + and _ = (opt_as_lident : 'opt_as_lident Gram.Entry.t) + and _ = (name_tags : 'name_tags Gram.Entry.t) + and _ = (more_ctyp : 'more_ctyp Gram.Entry.t) + and _ = (module_type_quot : 'module_type_quot Gram.Entry.t) + and _ = (module_type : 'module_type Gram.Entry.t) + and _ = + (module_rec_declaration : 'module_rec_declaration Gram.Entry.t) + and _ = + (module_longident_with_app : + 'module_longident_with_app Gram.Entry.t) + and _ = (module_longident : 'module_longident Gram.Entry.t) + and _ = (module_expr_quot : 'module_expr_quot Gram.Entry.t) + and _ = (module_expr : 'module_expr Gram.Entry.t) + and _ = (module_declaration : 'module_declaration Gram.Entry.t) + and _ = (module_binding_quot : 'module_binding_quot Gram.Entry.t) + and _ = (module_binding0 : 'module_binding0 Gram.Entry.t) + and _ = (module_binding : 'module_binding Gram.Entry.t) + and _ = (meth_decl : 'meth_decl Gram.Entry.t) + and _ = (meth_list : 'meth_list Gram.Entry.t) + and _ = (let_binding : 'let_binding Gram.Entry.t) + and _ = (labeled_ipatt : 'labeled_ipatt Gram.Entry.t) + and _ = (label_patt_list : 'label_patt_list Gram.Entry.t) + and _ = (label_patt : 'label_patt Gram.Entry.t) + and _ = (label_longident : 'label_longident Gram.Entry.t) + and _ = (label_ipatt_list : 'label_ipatt_list Gram.Entry.t) + and _ = (label_ipatt : 'label_ipatt Gram.Entry.t) + and _ = (label_expr_list : 'label_expr_list Gram.Entry.t) + and _ = (label_expr : 'label_expr Gram.Entry.t) + and _ = + (label_declaration_list : 'label_declaration_list Gram.Entry.t) + and _ = (label_declaration : 'label_declaration Gram.Entry.t) + and _ = (label : 'label Gram.Entry.t) + and _ = (ipatt_tcon : 'ipatt_tcon Gram.Entry.t) + and _ = (ipatt : 'ipatt Gram.Entry.t) + and _ = (interf : 'interf Gram.Entry.t) + and _ = (implem : 'implem Gram.Entry.t) + and _ = (ident_quot : 'ident_quot Gram.Entry.t) + and _ = (ident : 'ident Gram.Entry.t) + and _ = (fun_def : 'fun_def Gram.Entry.t) + and _ = (fun_binding : 'fun_binding Gram.Entry.t) + and _ = (field_expr_list : 'field_expr_list Gram.Entry.t) + and _ = (field_expr : 'field_expr Gram.Entry.t) + and _ = (expr_quot : 'expr_quot Gram.Entry.t) + and _ = (expr_eoi : 'expr_eoi Gram.Entry.t) + and _ = (expr : 'expr Gram.Entry.t) + and _ = (eq_expr : 'eq_expr Gram.Entry.t) + and _ = (dummy : 'dummy Gram.Entry.t) + and _ = (direction_flag : 'direction_flag Gram.Entry.t) + and _ = (cvalue_binding : 'cvalue_binding Gram.Entry.t) + and _ = (ctyp_quot : 'ctyp_quot Gram.Entry.t) + and _ = (ctyp : 'ctyp Gram.Entry.t) + and _ = + (constructor_declarations : + 'constructor_declarations Gram.Entry.t) + and _ = + (constructor_declaration : + 'constructor_declaration Gram.Entry.t) + and _ = + (constructor_arg_list : 'constructor_arg_list Gram.Entry.t) + and _ = (constrain : 'constrain Gram.Entry.t) + and _ = + (comma_type_parameter : 'comma_type_parameter Gram.Entry.t) + and _ = (comma_patt : 'comma_patt Gram.Entry.t) + and _ = (comma_ipatt : 'comma_ipatt Gram.Entry.t) + and _ = (comma_expr : 'comma_expr Gram.Entry.t) + and _ = (comma_ctyp : 'comma_ctyp Gram.Entry.t) + and _ = (class_type_quot : 'class_type_quot Gram.Entry.t) + and _ = (class_type_plus : 'class_type_plus Gram.Entry.t) + and _ = + (class_type_longident_and_param : + 'class_type_longident_and_param Gram.Entry.t) + and _ = + (class_type_longident : 'class_type_longident Gram.Entry.t) + and _ = + (class_type_declaration : 'class_type_declaration Gram.Entry.t) + and _ = (class_type : 'class_type Gram.Entry.t) + and _ = (class_structure : 'class_structure Gram.Entry.t) + and _ = (class_str_item_quot : 'class_str_item_quot Gram.Entry.t) + and _ = (class_str_item : 'class_str_item Gram.Entry.t) + and _ = (class_signature : 'class_signature Gram.Entry.t) + and _ = (class_sig_item_quot : 'class_sig_item_quot Gram.Entry.t) + and _ = (class_sig_item : 'class_sig_item Gram.Entry.t) + and _ = + (class_name_and_param : 'class_name_and_param Gram.Entry.t) + and _ = + (class_longident_and_param : + 'class_longident_and_param Gram.Entry.t) + and _ = (class_longident : 'class_longident Gram.Entry.t) + and _ = + (class_info_for_class_type : + 'class_info_for_class_type Gram.Entry.t) + and _ = + (class_info_for_class_expr : + 'class_info_for_class_expr Gram.Entry.t) + and _ = (class_fun_def : 'class_fun_def Gram.Entry.t) + and _ = (class_fun_binding : 'class_fun_binding Gram.Entry.t) + and _ = (class_expr_quot : 'class_expr_quot Gram.Entry.t) + and _ = (class_expr : 'class_expr Gram.Entry.t) + and _ = (class_description : 'class_description Gram.Entry.t) + and _ = (class_declaration : 'class_declaration Gram.Entry.t) + and _ = (binding_quot : 'binding_quot Gram.Entry.t) + and _ = (binding : 'binding Gram.Entry.t) + and _ = (match_case_quot : 'match_case_quot Gram.Entry.t) + and _ = (match_case0 : 'match_case0 Gram.Entry.t) + and _ = (match_case : 'match_case Gram.Entry.t) + and _ = (and_ctyp : 'and_ctyp Gram.Entry.t) + and _ = (amp_ctyp : 'amp_ctyp Gram.Entry.t) + and _ = (a_ident : 'a_ident Gram.Entry.t) + and _ = (a_UIDENT : 'a_UIDENT Gram.Entry.t) + and _ = (a_STRING : 'a_STRING Gram.Entry.t) + and _ = (a_OPTLABEL : 'a_OPTLABEL Gram.Entry.t) + and _ = (a_NATIVEINT : 'a_NATIVEINT Gram.Entry.t) + and _ = (rec_binding_quot : 'rec_binding_quot Gram.Entry.t) + and _ = (a_LIDENT : 'a_LIDENT Gram.Entry.t) + and _ = (a_LABEL : 'a_LABEL Gram.Entry.t) + and _ = (a_INT64 : 'a_INT64 Gram.Entry.t) + and _ = (a_INT32 : 'a_INT32 Gram.Entry.t) + and _ = (a_INT : 'a_INT Gram.Entry.t) + and _ = (a_FLOAT : 'a_FLOAT Gram.Entry.t) in + let grammar_entry_create = Gram.Entry.mk in + let (* Here it's LABEL and not tilde_label since ~a:b is different than ~a : b *) + (* Same remark for ?a:b *) infixop5 : 'infixop5 Gram.Entry.t = + grammar_entry_create "infixop5" + and (* | i = opt_label; "("; p = patt_tcon; ")" -> *) + (* <:patt< ? $i$ : ($p$) >> *) + (* | i = opt_label; "("; p = ipatt_tcon; ")" -> <:patt< ? $i$ : ($p$) >> | i = opt_label; "("; p = ipatt_tcon; "="; e = expr; ")" -> <:patt< ? $i$ : ($p$ = $e$) >> *) - string_list : 'string_list Gram.Entry.t = - grammar_entry_create "string_list" - and opt_override : 'opt_override Gram.Entry.t = - grammar_entry_create "opt_override" - and value_val_opt_override : 'value_val_opt_override Gram.Entry.t = - grammar_entry_create "value_val_opt_override" - and method_opt_override : 'method_opt_override Gram.Entry.t = - grammar_entry_create "method_opt_override" - and module_longident_dot_lparen : - 'module_longident_dot_lparen Gram.Entry.t = - grammar_entry_create "module_longident_dot_lparen" - and fun_def_cont_no_when : 'fun_def_cont_no_when Gram.Entry.t = - grammar_entry_create "fun_def_cont_no_when" - and fun_def_cont : 'fun_def_cont Gram.Entry.t = - grammar_entry_create "fun_def_cont" - and sequence' : 'sequence' Gram.Entry.t = - grammar_entry_create "sequence'" - and infixop6 : 'infixop6 Gram.Entry.t = - grammar_entry_create "infixop6" - in - (Gram.extend (module_expr : 'module_expr Gram.Entry.t) - ((fun () -> - (None, - [ ((Some "top"), None, - [ ([ Gram.Skeyword "struct"; - Gram.Snterm - (Gram.Entry.obj - (str_items : 'str_items Gram.Entry.t)); - Gram.Skeyword "end" ], - (Gram.Action.mk - (fun _ (st : 'str_items) _ (_loc : Gram.Loc.t) - -> (Ast.MeStr (_loc, st) : 'module_expr)))); - ([ Gram.Skeyword "functor"; Gram.Skeyword "("; - Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (module_type : 'module_type Gram.Entry.t)); - Gram.Skeyword ")"; Gram.Skeyword "->"; Gram.Sself ], - (Gram.Action.mk - (fun (me : 'module_expr) _ _ (t : 'module_type) - _ (i : 'a_UIDENT) _ _ (_loc : Gram.Loc.t) -> - (Ast.MeFun (_loc, i, t, me) : 'module_expr)))) ]); - ((Some "apply"), None, - [ ([ Gram.Sself; Gram.Sself ], - (Gram.Action.mk - (fun (me2 : 'module_expr) (me1 : 'module_expr) - (_loc : Gram.Loc.t) -> - (Ast.MeApp (_loc, me1, me2) : 'module_expr)))) ]); - ((Some "simple"), None, - [ ([ Gram.Skeyword "("; - Gram.Snterm - (Gram.Entry.obj - (value_val : 'value_val Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (package_type : 'package_type Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (p : 'package_type) _ (e : 'expr) _ _ - (_loc : Gram.Loc.t) -> - (Ast.MePkg (_loc, - (Ast.ExTyc (_loc, e, - (Ast.TyPkg (_loc, p))))) : - 'module_expr)))); - ([ Gram.Skeyword "("; - Gram.Snterm - (Gram.Entry.obj - (value_val : 'value_val Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (e : 'expr) _ _ (_loc : Gram.Loc.t) -> - (Ast.MePkg (_loc, e) : 'module_expr)))); - ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (me : 'module_expr) _ (_loc : Gram.Loc.t) - -> (me : 'module_expr)))); - ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (module_type : 'module_type Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (mt : 'module_type) _ (me : 'module_expr) - _ (_loc : Gram.Loc.t) -> - (Ast.MeTyc (_loc, me, mt) : 'module_expr)))); - ([ Gram.Snterm - (Gram.Entry.obj - (module_longident : - 'module_longident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'module_longident) (_loc : Gram.Loc.t) - -> (Ast.MeId (_loc, i) : 'module_expr)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.module_expr_tag : - 'module_expr) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "mexp" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"mexp\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "mexp" | "anti" | "list" as n)), - s) -> - (Ast.MeAnt (_loc, - (mk_anti ~c: "module_expr" n s)) : - 'module_expr) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (str_item : 'str_item Gram.Entry.t) - ((fun () -> - (None, - [ ((Some "top"), None, - [ ([ Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) (_loc : Gram.Loc.t) -> - (Ast.StExp (_loc, e) : 'str_item)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.str_item_tag : - 'str_item) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "stri" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"stri\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "stri" | "anti" | "list" as n)), - s) -> - (Ast.StAnt (_loc, - (mk_anti ~c: "str_item" n s)) : - 'str_item) - | _ -> assert false))); - ([ Gram.Skeyword "class"; Gram.Skeyword "type"; - Gram.Snterm - (Gram.Entry.obj - (class_type_declaration : - 'class_type_declaration Gram.Entry.t)) ], - (Gram.Action.mk - (fun (ctd : 'class_type_declaration) _ _ - (_loc : Gram.Loc.t) -> - (Ast.StClt (_loc, ctd) : 'str_item)))); - ([ Gram.Skeyword "class"; - Gram.Snterm - (Gram.Entry.obj - (class_declaration : - 'class_declaration Gram.Entry.t)) ], - (Gram.Action.mk - (fun (cd : 'class_declaration) _ - (_loc : Gram.Loc.t) -> - (Ast.StCls (_loc, cd) : 'str_item)))); - ([ Gram.Snterm - (Gram.Entry.obj - (value_let : 'value_let Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_rec : 'opt_rec Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (binding : 'binding Gram.Entry.t)) ], - (Gram.Action.mk - (fun (bi : 'binding) (r : 'opt_rec) _ - (_loc : Gram.Loc.t) -> - (Ast.StVal (_loc, r, bi) : 'str_item)))); - ([ Gram.Skeyword "type"; - Gram.Snterm - (Gram.Entry.obj - (type_declaration : - 'type_declaration Gram.Entry.t)) ], - (Gram.Action.mk - (fun (td : 'type_declaration) _ - (_loc : Gram.Loc.t) -> - (Ast.StTyp (_loc, td) : 'str_item)))); - ([ Gram.Skeyword "open"; - Gram.Snterm - (Gram.Entry.obj - (module_longident : - 'module_longident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'module_longident) _ - (_loc : Gram.Loc.t) -> - (Ast.StOpn (_loc, i) : 'str_item)))); - ([ Gram.Skeyword "module"; Gram.Skeyword "type"; - Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj - (module_type : 'module_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (mt : 'module_type) _ (i : 'a_UIDENT) _ _ - (_loc : Gram.Loc.t) -> - (Ast.StMty (_loc, i, mt) : 'str_item)))); - ([ Gram.Skeyword "module"; Gram.Skeyword "rec"; - Gram.Snterm - (Gram.Entry.obj - (module_binding : - 'module_binding Gram.Entry.t)) ], - (Gram.Action.mk - (fun (mb : 'module_binding) _ _ - (_loc : Gram.Loc.t) -> - (Ast.StRecMod (_loc, mb) : 'str_item)))); - ([ Gram.Skeyword "module"; - Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (module_binding0 : - 'module_binding0 Gram.Entry.t)) ], - (Gram.Action.mk - (fun (mb : 'module_binding0) (i : 'a_UIDENT) _ - (_loc : Gram.Loc.t) -> - (Ast.StMod (_loc, i, mb) : 'str_item)))); - ([ Gram.Skeyword "include"; - Gram.Snterm - (Gram.Entry.obj - (module_expr : 'module_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (me : 'module_expr) _ (_loc : Gram.Loc.t) - -> (Ast.StInc (_loc, me) : 'str_item)))); - ([ Gram.Skeyword "external"; - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj - (string_list : 'string_list Gram.Entry.t)) ], - (Gram.Action.mk - (fun (sl : 'string_list) _ (t : 'ctyp) _ - (i : 'a_LIDENT) _ (_loc : Gram.Loc.t) -> - (Ast.StExt (_loc, i, t, sl) : 'str_item)))); - ([ Gram.Skeyword "exception"; - Gram.Snterm - (Gram.Entry.obj - (constructor_declaration : - 'constructor_declaration Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj - (type_longident : - 'type_longident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'type_longident) _ - (t : 'constructor_declaration) _ - (_loc : Gram.Loc.t) -> - (Ast.StExc (_loc, t, (Ast.OSome i)) : - 'str_item)))); - ([ Gram.Skeyword "exception"; - Gram.Snterm - (Gram.Entry.obj - (constructor_declaration : - 'constructor_declaration Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'constructor_declaration) _ - (_loc : Gram.Loc.t) -> - (Ast.StExc (_loc, t, Ast.ONone) : 'str_item)))) ]) ])) - ()); - Gram.extend (module_binding0 : 'module_binding0 Gram.Entry.t) - ((fun () -> - (None, - [ (None, (Some Camlp4.Sig.Grammar.RightA), - [ ([ Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj - (module_expr : 'module_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (me : 'module_expr) _ (_loc : Gram.Loc.t) - -> (me : 'module_binding0)))); - ([ Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (module_type : 'module_type Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj - (module_expr : 'module_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (me : 'module_expr) _ (mt : 'module_type) _ - (_loc : Gram.Loc.t) -> - (Ast.MeTyc (_loc, me, mt) : 'module_binding0)))); - ([ Gram.Skeyword "("; - Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (module_type : 'module_type Gram.Entry.t)); - Gram.Skeyword ")"; Gram.Sself ], - (Gram.Action.mk - (fun (mb : 'module_binding0) _ - (mt : 'module_type) _ (m : 'a_UIDENT) _ - (_loc : Gram.Loc.t) -> - (Ast.MeFun (_loc, m, mt, mb) : - 'module_binding0)))) ]) ])) - ()); - Gram.extend (module_binding : 'module_binding Gram.Entry.t) - ((fun () -> - (None, - [ (None, (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (module_type : 'module_type Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj - (module_expr : 'module_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (me : 'module_expr) _ (mt : 'module_type) _ - (m : 'a_UIDENT) (_loc : Gram.Loc.t) -> - (Ast.MbColEq (_loc, m, mt, me) : - 'module_binding)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.module_binding_tag : - 'module_binding) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("", _) -> true - | _ -> false), - "ANTIQUOT (\"\", _)")); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (module_type : 'module_type Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj - (module_expr : 'module_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (me : 'module_expr) _ (mt : 'module_type) _ - (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" as n)), m) -> - (Ast.MbColEq (_loc, (mk_anti n m), mt, - me) : - 'module_binding) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("", _) -> true - | _ -> false), - "ANTIQUOT (\"\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" as n)), s) -> - (Ast.MbAnt (_loc, - (mk_anti ~c: "module_binding" n s)) : - 'module_binding) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT - (("module_binding" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"module_binding\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("module_binding" | "anti" | "list" as - n)), - s) -> - (Ast.MbAnt (_loc, - (mk_anti ~c: "module_binding" n s)) : - 'module_binding) - | _ -> assert false))); - ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], - (Gram.Action.mk - (fun (b2 : 'module_binding) _ - (b1 : 'module_binding) (_loc : Gram.Loc.t) -> - (Ast.MbAnd (_loc, b1, b2) : 'module_binding)))) ]) ])) - ()); - Gram.extend (module_type : 'module_type Gram.Entry.t) - ((fun () -> - (None, - [ ((Some "top"), None, - [ ([ Gram.Skeyword "functor"; Gram.Skeyword "("; - Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Skeyword ":"; Gram.Sself; Gram.Skeyword ")"; - Gram.Skeyword "->"; Gram.Sself ], - (Gram.Action.mk - (fun (mt : 'module_type) _ _ (t : 'module_type) - _ (i : 'a_UIDENT) _ _ (_loc : Gram.Loc.t) -> - (Ast.MtFun (_loc, i, t, mt) : 'module_type)))) ]); - ((Some "with"), None, - [ ([ Gram.Sself; Gram.Skeyword "with"; - Gram.Snterm - (Gram.Entry.obj - (with_constr : 'with_constr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (wc : 'with_constr) _ (mt : 'module_type) - (_loc : Gram.Loc.t) -> - (Ast.MtWit (_loc, mt, wc) : 'module_type)))) ]); - ((Some "apply"), None, - [ ([ Gram.Sself; Gram.Sself; - Gram.Snterm - (Gram.Entry.obj (dummy : 'dummy Gram.Entry.t)) ], - (Gram.Action.mk - (fun _ (mt2 : 'module_type) (mt1 : 'module_type) - (_loc : Gram.Loc.t) -> - (module_type_app mt1 mt2 : 'module_type)))) ]); - ((Some "."), None, - [ ([ Gram.Sself; Gram.Skeyword "."; Gram.Sself ], - (Gram.Action.mk - (fun (mt2 : 'module_type) _ (mt1 : 'module_type) - (_loc : Gram.Loc.t) -> - (module_type_acc mt1 mt2 : 'module_type)))) ]); - ((Some "sig"), None, - [ ([ Gram.Skeyword "sig"; - Gram.Snterm - (Gram.Entry.obj - (sig_items : 'sig_items Gram.Entry.t)); - Gram.Skeyword "end" ], - (Gram.Action.mk - (fun _ (sg : 'sig_items) _ (_loc : Gram.Loc.t) - -> (Ast.MtSig (_loc, sg) : 'module_type)))) ]); - ((Some "simple"), None, - [ ([ Gram.Skeyword "module"; Gram.Skeyword "type"; - Gram.Skeyword "of"; - Gram.Snterm - (Gram.Entry.obj - (module_expr : 'module_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (me : 'module_expr) _ _ _ - (_loc : Gram.Loc.t) -> - (Ast.MtOf (_loc, me) : 'module_type)))); - ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (mt : 'module_type) _ (_loc : Gram.Loc.t) - -> (mt : 'module_type)))); - ([ Gram.Skeyword "'"; - Gram.Snterm - (Gram.Entry.obj - (a_ident : 'a_ident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_ident) _ (_loc : Gram.Loc.t) -> - (Ast.MtQuo (_loc, i) : 'module_type)))); - ([ Gram.Snterm - (Gram.Entry.obj - (module_longident_with_app : - 'module_longident_with_app Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'module_longident_with_app) - (_loc : Gram.Loc.t) -> - (Ast.MtId (_loc, i) : 'module_type)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.module_type_tag : - 'module_type) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "mtyp" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"mtyp\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "mtyp" | "anti" | "list" as n)), - s) -> - (Ast.MtAnt (_loc, - (mk_anti ~c: "module_type" n s)) : - 'module_type) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (sig_item : 'sig_item Gram.Entry.t) - ((fun () -> - (None, - [ ((Some "top"), None, - [ ([ Gram.Skeyword "class"; Gram.Skeyword "type"; - Gram.Snterm - (Gram.Entry.obj - (class_type_declaration : - 'class_type_declaration Gram.Entry.t)) ], - (Gram.Action.mk - (fun (ctd : 'class_type_declaration) _ _ - (_loc : Gram.Loc.t) -> - (Ast.SgClt (_loc, ctd) : 'sig_item)))); - ([ Gram.Skeyword "class"; - Gram.Snterm - (Gram.Entry.obj - (class_description : - 'class_description Gram.Entry.t)) ], - (Gram.Action.mk - (fun (cd : 'class_description) _ - (_loc : Gram.Loc.t) -> - (Ast.SgCls (_loc, cd) : 'sig_item)))); - ([ Gram.Snterm - (Gram.Entry.obj - (value_val : 'value_val Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'ctyp) _ (i : 'a_LIDENT) _ - (_loc : Gram.Loc.t) -> - (Ast.SgVal (_loc, i, t) : 'sig_item)))); - ([ Gram.Skeyword "type"; - Gram.Snterm - (Gram.Entry.obj - (type_declaration : - 'type_declaration Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'type_declaration) _ - (_loc : Gram.Loc.t) -> - (Ast.SgTyp (_loc, t) : 'sig_item)))); - ([ Gram.Skeyword "open"; - Gram.Snterm - (Gram.Entry.obj - (module_longident : - 'module_longident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'module_longident) _ - (_loc : Gram.Loc.t) -> - (Ast.SgOpn (_loc, i) : 'sig_item)))); - ([ Gram.Skeyword "module"; Gram.Skeyword "type"; - Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_UIDENT) _ _ (_loc : Gram.Loc.t) -> - (Ast.SgMty (_loc, i, (Ast.MtNil _loc)) : - 'sig_item)))); - ([ Gram.Skeyword "module"; Gram.Skeyword "type"; - Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj - (module_type : 'module_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (mt : 'module_type) _ (i : 'a_UIDENT) _ _ - (_loc : Gram.Loc.t) -> - (Ast.SgMty (_loc, i, mt) : 'sig_item)))); - ([ Gram.Skeyword "module"; Gram.Skeyword "rec"; - Gram.Snterm - (Gram.Entry.obj - (module_rec_declaration : - 'module_rec_declaration Gram.Entry.t)) ], - (Gram.Action.mk - (fun (mb : 'module_rec_declaration) _ _ - (_loc : Gram.Loc.t) -> - (Ast.SgRecMod (_loc, mb) : 'sig_item)))); - ([ Gram.Skeyword "module"; - Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (module_declaration : - 'module_declaration Gram.Entry.t)) ], - (Gram.Action.mk - (fun (mt : 'module_declaration) (i : 'a_UIDENT) - _ (_loc : Gram.Loc.t) -> - (Ast.SgMod (_loc, i, mt) : 'sig_item)))); - ([ Gram.Skeyword "include"; - Gram.Snterm - (Gram.Entry.obj - (module_type : 'module_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (mt : 'module_type) _ (_loc : Gram.Loc.t) - -> (Ast.SgInc (_loc, mt) : 'sig_item)))); - ([ Gram.Skeyword "external"; - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj - (string_list : 'string_list Gram.Entry.t)) ], - (Gram.Action.mk - (fun (sl : 'string_list) _ (t : 'ctyp) _ - (i : 'a_LIDENT) _ (_loc : Gram.Loc.t) -> - (Ast.SgExt (_loc, i, t, sl) : 'sig_item)))); - ([ Gram.Skeyword "exception"; - Gram.Snterm - (Gram.Entry.obj - (constructor_declaration : - 'constructor_declaration Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'constructor_declaration) _ - (_loc : Gram.Loc.t) -> - (Ast.SgExc (_loc, t) : 'sig_item)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.sig_item_tag : - 'sig_item) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "sigi" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"sigi\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "sigi" | "anti" | "list" as n)), - s) -> - (Ast.SgAnt (_loc, - (mk_anti ~c: "sig_item" n s)) : - 'sig_item) - | _ -> assert false))) ]) ])) - ()); - Gram.extend - (module_declaration : 'module_declaration Gram.Entry.t) - ((fun () -> - (None, - [ (None, (Some Camlp4.Sig.Grammar.RightA), - [ ([ Gram.Skeyword "("; - Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (module_type : 'module_type Gram.Entry.t)); - Gram.Skeyword ")"; Gram.Sself ], - (Gram.Action.mk - (fun (mt : 'module_declaration) _ - (t : 'module_type) _ (i : 'a_UIDENT) _ - (_loc : Gram.Loc.t) -> - (Ast.MtFun (_loc, i, t, mt) : - 'module_declaration)))); - ([ Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (module_type : 'module_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (mt : 'module_type) _ (_loc : Gram.Loc.t) - -> (mt : 'module_declaration)))) ]) ])) - ()); - Gram.extend - (module_rec_declaration : - 'module_rec_declaration Gram.Entry.t) - ((fun () -> - (None, - [ (None, (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (module_type : 'module_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (mt : 'module_type) _ (m : 'a_UIDENT) - (_loc : Gram.Loc.t) -> - (Ast.MbCol (_loc, m, mt) : - 'module_rec_declaration)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.module_binding_tag : - 'module_rec_declaration) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT - (("" | "module_binding" | "anti" | - "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"module_binding\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "module_binding" | "anti" | - "list" - as n)), - s) -> - (Ast.MbAnt (_loc, - (mk_anti ~c: "module_binding" n s)) : - 'module_rec_declaration) - | _ -> assert false))); - ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], - (Gram.Action.mk - (fun (m2 : 'module_rec_declaration) _ - (m1 : 'module_rec_declaration) - (_loc : Gram.Loc.t) -> - (Ast.MbAnd (_loc, m1, m2) : - 'module_rec_declaration)))) ]) ])) - ()); - Gram.extend (with_constr : 'with_constr Gram.Entry.t) - ((fun () -> - (None, - [ (None, (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Skeyword "module"; - Gram.Snterm - (Gram.Entry.obj - (module_longident : - 'module_longident Gram.Entry.t)); - Gram.Skeyword ":="; - Gram.Snterm - (Gram.Entry.obj - (module_longident_with_app : - 'module_longident_with_app Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i2 : 'module_longident_with_app) _ - (i1 : 'module_longident) _ - (_loc : Gram.Loc.t) -> - (Ast.WcMoS (_loc, i1, i2) : 'with_constr)))); - ([ Gram.Skeyword "type"; - Gram.Snterm - (Gram.Entry.obj - (type_longident_and_parameters : - 'type_longident_and_parameters Gram.Entry. - t)); - Gram.Skeyword ":="; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t2 : 'ctyp) _ - (t1 : 'type_longident_and_parameters) _ - (_loc : Gram.Loc.t) -> - (Ast.WcTyS (_loc, t1, t2) : 'with_constr)))); - ([ Gram.Skeyword "type"; - Gram.Stoken - (((function - | ANTIQUOT (("" | "typ" | "anti"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"\" | \"typ\" | \"anti\"), _)")); - Gram.Skeyword ":="; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'ctyp) _ (__camlp4_0 : Gram.Token.t) _ - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "typ" | "anti" as n)), s) - -> - (Ast.WcTyS (_loc, - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp" n s))), - t) : - 'with_constr) - | _ -> assert false))); - ([ Gram.Skeyword "module"; - Gram.Snterm - (Gram.Entry.obj - (module_longident : - 'module_longident Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj - (module_longident_with_app : - 'module_longident_with_app Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i2 : 'module_longident_with_app) _ - (i1 : 'module_longident) _ - (_loc : Gram.Loc.t) -> - (Ast.WcMod (_loc, i1, i2) : 'with_constr)))); - ([ Gram.Skeyword "type"; - Gram.Snterm - (Gram.Entry.obj - (type_longident_and_parameters : - 'type_longident_and_parameters Gram.Entry. - t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t2 : 'ctyp) _ - (t1 : 'type_longident_and_parameters) _ - (_loc : Gram.Loc.t) -> - (Ast.WcTyp (_loc, t1, t2) : 'with_constr)))); - ([ Gram.Skeyword "type"; - Gram.Stoken - (((function - | ANTIQUOT (("" | "typ" | "anti"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"\" | \"typ\" | \"anti\"), _)")); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'ctyp) _ (__camlp4_0 : Gram.Token.t) _ - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "typ" | "anti" as n)), s) - -> - (Ast.WcTyp (_loc, - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp" n s))), - t) : - 'with_constr) - | _ -> assert false))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.with_constr_tag : - 'with_constr) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT - (("" | "with_constr" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"with_constr\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "with_constr" | "anti" | "list" - as n)), - s) -> - (Ast.WcAnt (_loc, - (mk_anti ~c: "with_constr" n s)) : - 'with_constr) - | _ -> assert false))); - ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], - (Gram.Action.mk - (fun (wc2 : 'with_constr) _ (wc1 : 'with_constr) - (_loc : Gram.Loc.t) -> - (Ast.WcAnd (_loc, wc1, wc2) : 'with_constr)))) ]) ])) - ()); - Gram.extend (expr : 'expr Gram.Entry.t) - ((fun () -> - (None, - [ ((Some "top"), (Some Camlp4.Sig.Grammar.RightA), - [ ([ Gram.Skeyword "object"; - Gram.Snterm - (Gram.Entry.obj - (opt_class_self_patt : - 'opt_class_self_patt Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (class_structure : - 'class_structure Gram.Entry.t)); - Gram.Skeyword "end" ], - (Gram.Action.mk - (fun _ (cst : 'class_structure) - (csp : 'opt_class_self_patt) _ - (_loc : Gram.Loc.t) -> - (Ast.ExObj (_loc, csp, cst) : 'expr)))); - ([ Gram.Skeyword "while"; - Gram.Snterm - (Gram.Entry.obj - (sequence : 'sequence Gram.Entry.t)); - Gram.Skeyword "do"; - Gram.Snterm - (Gram.Entry.obj - (do_sequence : 'do_sequence Gram.Entry.t)) ], - (Gram.Action.mk - (fun (seq : 'do_sequence) _ (e : 'sequence) _ - (_loc : Gram.Loc.t) -> - (Ast.ExWhi (_loc, (mksequence' _loc e), seq) : - 'expr)))); - ([ Gram.Skeyword "for"; - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj - (sequence : 'sequence Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (direction_flag : - 'direction_flag Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (sequence : 'sequence Gram.Entry.t)); - Gram.Skeyword "do"; - Gram.Snterm - (Gram.Entry.obj - (do_sequence : 'do_sequence Gram.Entry.t)) ], - (Gram.Action.mk - (fun (seq : 'do_sequence) _ (e2 : 'sequence) - (df : 'direction_flag) (e1 : 'sequence) _ - (i : 'a_LIDENT) _ (_loc : Gram.Loc.t) -> - (Ast.ExFor (_loc, i, (mksequence' _loc e1), - (mksequence' _loc e2), df, seq) : - 'expr)))); - ([ Gram.Skeyword "do"; - Gram.Snterm - (Gram.Entry.obj - (do_sequence : 'do_sequence Gram.Entry.t)) ], - (Gram.Action.mk - (fun (seq : 'do_sequence) _ (_loc : Gram.Loc.t) - -> (mksequence _loc seq : 'expr)))); - ([ Gram.Skeyword "if"; Gram.Sself; - Gram.Skeyword "then"; Gram.Sself; - Gram.Skeyword "else"; Gram.Sself ], - (Gram.Action.mk - (fun (e3 : 'expr) _ (e2 : 'expr) _ (e1 : 'expr) - _ (_loc : Gram.Loc.t) -> - (Ast.ExIfe (_loc, e1, e2, e3) : 'expr)))); - ([ Gram.Skeyword "try"; - Gram.Snterm - (Gram.Entry.obj - (sequence : 'sequence Gram.Entry.t)); - Gram.Skeyword "with"; - Gram.Snterm - (Gram.Entry.obj - (match_case : 'match_case Gram.Entry.t)) ], - (Gram.Action.mk - (fun (a : 'match_case) _ (e : 'sequence) _ - (_loc : Gram.Loc.t) -> - (Ast.ExTry (_loc, (mksequence' _loc e), a) : - 'expr)))); - ([ Gram.Skeyword "match"; - Gram.Snterm - (Gram.Entry.obj - (sequence : 'sequence Gram.Entry.t)); - Gram.Skeyword "with"; - Gram.Snterm - (Gram.Entry.obj - (match_case : 'match_case Gram.Entry.t)) ], - (Gram.Action.mk - (fun (a : 'match_case) _ (e : 'sequence) _ - (_loc : Gram.Loc.t) -> - (Ast.ExMat (_loc, (mksequence' _loc e), a) : - 'expr)))); - ([ Gram.Skeyword "fun"; - Gram.Snterm - (Gram.Entry.obj - (fun_def : 'fun_def Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'fun_def) _ (_loc : Gram.Loc.t) -> - (e : 'expr)))); - ([ Gram.Skeyword "fun"; Gram.Skeyword "["; - Gram.Slist0sep - ((Gram.Snterm - (Gram.Entry.obj - (match_case0 : - 'match_case0 Gram.Entry.t))), - (Gram.Skeyword "|")); - Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ (a : 'match_case0 list) _ _ - (_loc : Gram.Loc.t) -> - (Ast.ExFun (_loc, (Ast.mcOr_of_list a)) : - 'expr)))); - ([ Gram.Skeyword "let"; Gram.Skeyword "open"; - Gram.Snterm - (Gram.Entry.obj - (module_longident : - 'module_longident Gram.Entry.t)); - Gram.Skeyword "in"; Gram.Sself ], - (Gram.Action.mk - (fun (e : 'expr) _ (i : 'module_longident) _ _ - (_loc : Gram.Loc.t) -> - (Ast.ExOpI (_loc, i, e) : 'expr)))); - ([ Gram.Skeyword "let"; Gram.Skeyword "module"; - Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (module_binding0 : - 'module_binding0 Gram.Entry.t)); - Gram.Skeyword "in"; Gram.Sself ], - (Gram.Action.mk - (fun (e : 'expr) _ (mb : 'module_binding0) - (m : 'a_UIDENT) _ _ (_loc : Gram.Loc.t) -> - (Ast.ExLmd (_loc, m, mb, e) : 'expr)))); - ([ Gram.Skeyword "let"; - Gram.Snterm - (Gram.Entry.obj - (opt_rec : 'opt_rec Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (binding : 'binding Gram.Entry.t)); - Gram.Skeyword "in"; Gram.Sself ], - (Gram.Action.mk - (fun (x : 'expr) _ (bi : 'binding) - (r : 'opt_rec) _ (_loc : Gram.Loc.t) -> - (Ast.ExLet (_loc, r, bi, x) : 'expr)))) ]); - ((Some "where"), None, - [ ([ Gram.Sself; Gram.Skeyword "where"; - Gram.Snterm - (Gram.Entry.obj - (opt_rec : 'opt_rec Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (let_binding : 'let_binding Gram.Entry.t)) ], - (Gram.Action.mk - (fun (lb : 'let_binding) (rf : 'opt_rec) _ - (e : 'expr) (_loc : Gram.Loc.t) -> - (Ast.ExLet (_loc, rf, lb, e) : 'expr)))) ]); - ((Some ":="), (Some Camlp4.Sig.Grammar.NonA), - [ ([ Gram.Sself; Gram.Skeyword ":="; Gram.Sself; - Gram.Snterm - (Gram.Entry.obj (dummy : 'dummy Gram.Entry.t)) ], - (Gram.Action.mk - (fun _ (e2 : 'expr) _ (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (match bigarray_set _loc e1 e2 with - | Some e -> e - | None -> Ast.ExAss (_loc, e1, e2) : 'expr)))) ]); - ((Some "||"), (Some Camlp4.Sig.Grammar.RightA), - [ ([ Gram.Sself; - Gram.Snterm - (Gram.Entry.obj - (infixop6 : 'infixop6 Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (e2 : 'expr) (op : 'infixop6) (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExApp (_loc, (Ast.ExApp (_loc, op, e1)), - e2) : - 'expr)))) ]); - ((Some "&&"), (Some Camlp4.Sig.Grammar.RightA), - [ ([ Gram.Sself; - Gram.Snterm - (Gram.Entry.obj - (infixop5 : 'infixop5 Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (e2 : 'expr) (op : 'infixop5) (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExApp (_loc, (Ast.ExApp (_loc, op, e1)), - e2) : - 'expr)))) ]); - ((Some "<"), (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Sself; - Gram.Snterm - (Gram.Entry.obj - (infixop0 : 'infixop0 Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (e2 : 'expr) (op : 'infixop0) (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExApp (_loc, (Ast.ExApp (_loc, op, e1)), - e2) : - 'expr)))) ]); - ((Some "^"), (Some Camlp4.Sig.Grammar.RightA), - [ ([ Gram.Sself; - Gram.Snterm - (Gram.Entry.obj - (infixop1 : 'infixop1 Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (e2 : 'expr) (op : 'infixop1) (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExApp (_loc, (Ast.ExApp (_loc, op, e1)), - e2) : - 'expr)))) ]); - ((Some "+"), (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Sself; - Gram.Snterm - (Gram.Entry.obj - (infixop2 : 'infixop2 Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (e2 : 'expr) (op : 'infixop2) (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExApp (_loc, (Ast.ExApp (_loc, op, e1)), - e2) : - 'expr)))) ]); - ((Some "*"), (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Sself; - Gram.Snterm - (Gram.Entry.obj - (infixop3 : 'infixop3 Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (e2 : 'expr) (op : 'infixop3) (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExApp (_loc, (Ast.ExApp (_loc, op, e1)), - e2) : - 'expr)))); - ([ Gram.Sself; Gram.Skeyword "mod"; Gram.Sself ], - (Gram.Action.mk - (fun (e2 : 'expr) _ (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExApp (_loc, - (Ast.ExApp (_loc, - (Ast.ExId (_loc, - (Ast.IdLid (_loc, "mod")))), - e1)), - e2) : - 'expr)))); - ([ Gram.Sself; Gram.Skeyword "lxor"; Gram.Sself ], - (Gram.Action.mk - (fun (e2 : 'expr) _ (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExApp (_loc, - (Ast.ExApp (_loc, - (Ast.ExId (_loc, - (Ast.IdLid (_loc, "lxor")))), - e1)), - e2) : - 'expr)))); - ([ Gram.Sself; Gram.Skeyword "lor"; Gram.Sself ], - (Gram.Action.mk - (fun (e2 : 'expr) _ (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExApp (_loc, - (Ast.ExApp (_loc, - (Ast.ExId (_loc, - (Ast.IdLid (_loc, "lor")))), - e1)), - e2) : - 'expr)))); - ([ Gram.Sself; Gram.Skeyword "land"; Gram.Sself ], - (Gram.Action.mk - (fun (e2 : 'expr) _ (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExApp (_loc, - (Ast.ExApp (_loc, - (Ast.ExId (_loc, - (Ast.IdLid (_loc, "land")))), - e1)), - e2) : - 'expr)))) ]); - ((Some "**"), (Some Camlp4.Sig.Grammar.RightA), - [ ([ Gram.Sself; - Gram.Snterm - (Gram.Entry.obj - (infixop4 : 'infixop4 Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (e2 : 'expr) (op : 'infixop4) (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExApp (_loc, (Ast.ExApp (_loc, op, e1)), - e2) : - 'expr)))); - ([ Gram.Sself; Gram.Skeyword "lsr"; Gram.Sself ], - (Gram.Action.mk - (fun (e2 : 'expr) _ (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExApp (_loc, - (Ast.ExApp (_loc, - (Ast.ExId (_loc, - (Ast.IdLid (_loc, "lsr")))), - e1)), - e2) : - 'expr)))); - ([ Gram.Sself; Gram.Skeyword "lsl"; Gram.Sself ], - (Gram.Action.mk - (fun (e2 : 'expr) _ (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExApp (_loc, - (Ast.ExApp (_loc, - (Ast.ExId (_loc, - (Ast.IdLid (_loc, "lsl")))), - e1)), - e2) : - 'expr)))); - ([ Gram.Sself; Gram.Skeyword "asr"; Gram.Sself ], - (Gram.Action.mk - (fun (e2 : 'expr) _ (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExApp (_loc, - (Ast.ExApp (_loc, - (Ast.ExId (_loc, - (Ast.IdLid (_loc, "asr")))), - e1)), - e2) : - 'expr)))) ]); - ((Some "unary minus"), (Some Camlp4.Sig.Grammar.NonA), - [ ([ Gram.Skeyword "-."; Gram.Sself ], - (Gram.Action.mk - (fun (e : 'expr) _ (_loc : Gram.Loc.t) -> - (mkumin _loc "-." e : 'expr)))); - ([ Gram.Skeyword "-"; Gram.Sself ], - (Gram.Action.mk - (fun (e : 'expr) _ (_loc : Gram.Loc.t) -> - (mkumin _loc "-" e : 'expr)))) ]); - ((Some "apply"), (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Skeyword "lazy"; Gram.Sself ], - (Gram.Action.mk - (fun (e : 'expr) _ (_loc : Gram.Loc.t) -> - (Ast.ExLaz (_loc, e) : 'expr)))); - ([ Gram.Skeyword "new"; - Gram.Snterm - (Gram.Entry.obj - (class_longident : - 'class_longident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'class_longident) _ - (_loc : Gram.Loc.t) -> - (Ast.ExNew (_loc, i) : 'expr)))); - ([ Gram.Skeyword "assert"; Gram.Sself ], - (Gram.Action.mk - (fun (e : 'expr) _ (_loc : Gram.Loc.t) -> - (mkassert _loc e : 'expr)))); - ([ Gram.Sself; Gram.Sself ], - (Gram.Action.mk - (fun (e2 : 'expr) (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExApp (_loc, e1, e2) : 'expr)))) ]); - ((Some "label"), (Some Camlp4.Sig.Grammar.NonA), - [ ([ Gram.Skeyword "?"; - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_LIDENT) _ (_loc : Gram.Loc.t) -> - (Ast.ExOlb (_loc, i, (Ast.ExNil _loc)) : - 'expr)))); - ([ Gram.Skeyword "?"; - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Skeyword ":"; Gram.Sself ], - (Gram.Action.mk - (fun (e : 'expr) _ (i : 'a_LIDENT) _ - (_loc : Gram.Loc.t) -> - (Ast.ExOlb (_loc, i, e) : 'expr)))); - ([ Gram.Stoken - (((function | OPTLABEL _ -> true | _ -> false), - "OPTLABEL _")); - Gram.Sself ], - (Gram.Action.mk - (fun (e : 'expr) (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | OPTLABEL i -> - (Ast.ExOlb (_loc, i, e) : 'expr) - | _ -> assert false))); - ([ Gram.Stoken - (((function | LABEL _ -> true | _ -> false), - "LABEL _")); - Gram.Sself ], - (Gram.Action.mk - (fun (e : 'expr) (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | LABEL i -> (Ast.ExLab (_loc, i, e) : 'expr) - | _ -> assert false))); - ([ Gram.Skeyword "~"; - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_LIDENT) _ (_loc : Gram.Loc.t) -> - (Ast.ExLab (_loc, i, (Ast.ExNil _loc)) : - 'expr)))); - ([ Gram.Skeyword "~"; - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Skeyword ":"; Gram.Sself ], - (Gram.Action.mk - (fun (e : 'expr) _ (i : 'a_LIDENT) _ - (_loc : Gram.Loc.t) -> - (Ast.ExLab (_loc, i, e) : 'expr)))) ]); - ((Some "."), (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Sself; Gram.Skeyword "#"; - Gram.Snterm - (Gram.Entry.obj (label : 'label Gram.Entry.t)) ], - (Gram.Action.mk - (fun (lab : 'label) _ (e : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExSnd (_loc, e, lab) : 'expr)))); - ([ Gram.Sself; Gram.Skeyword "."; Gram.Sself ], - (Gram.Action.mk - (fun (e2 : 'expr) _ (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExAcc (_loc, e1, e2) : 'expr)))); - ([ Gram.Sself; Gram.Skeyword "."; Gram.Skeyword "{"; - Gram.Snterm - (Gram.Entry.obj - (comma_expr : 'comma_expr Gram.Entry.t)); - Gram.Skeyword "}" ], - (Gram.Action.mk - (fun _ (e2 : 'comma_expr) _ _ (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (bigarray_get _loc e1 e2 : 'expr)))); - ([ Gram.Sself; Gram.Skeyword "."; Gram.Skeyword "["; - Gram.Sself; Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ (e2 : 'expr) _ _ (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExSte (_loc, e1, e2) : 'expr)))); - ([ Gram.Sself; Gram.Skeyword "."; Gram.Skeyword "("; - Gram.Sself; Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (e2 : 'expr) _ _ (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExAre (_loc, e1, e2) : 'expr)))) ]); - ((Some "~-"), (Some Camlp4.Sig.Grammar.NonA), - [ ([ Gram.Snterm - (Gram.Entry.obj - (prefixop : 'prefixop Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (e : 'expr) (f : 'prefixop) - (_loc : Gram.Loc.t) -> - (Ast.ExApp (_loc, f, e) : 'expr)))); - ([ Gram.Skeyword "!"; Gram.Sself ], - (Gram.Action.mk - (fun (e : 'expr) _ (_loc : Gram.Loc.t) -> - (Ast.ExAcc (_loc, e, - (Ast.ExId (_loc, - (Ast.IdLid (_loc, "val"))))) : - 'expr)))) ]); - ((Some "simple"), None, - [ ([ Gram.Skeyword "("; Gram.Skeyword "module"; - Gram.Snterm - (Gram.Entry.obj - (module_expr : 'module_expr Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (package_type : 'package_type Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (pt : 'package_type) _ - (me : 'module_expr) _ _ (_loc : Gram.Loc.t) - -> - (Ast.ExPkg (_loc, (Ast.MeTyc (_loc, me, pt))) : - 'expr)))); - ([ Gram.Skeyword "("; Gram.Skeyword "module"; - Gram.Snterm - (Gram.Entry.obj - (module_expr : 'module_expr Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (me : 'module_expr) _ _ - (_loc : Gram.Loc.t) -> - (Ast.ExPkg (_loc, me) : 'expr)))); - ([ Gram.Skeyword "begin"; Gram.Skeyword "end" ], - (Gram.Action.mk - (fun _ _ (_loc : Gram.Loc.t) -> - (Ast.ExId (_loc, (Ast.IdUid (_loc, "()"))) : - 'expr)))); - ([ Gram.Skeyword "begin"; - Gram.Snterm - (Gram.Entry.obj - (sequence : 'sequence Gram.Entry.t)); - Gram.Skeyword "end" ], - (Gram.Action.mk - (fun _ (seq : 'sequence) _ (_loc : Gram.Loc.t) - -> (mksequence _loc seq : 'expr)))); - ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (e : 'expr) _ (_loc : Gram.Loc.t) -> - (e : 'expr)))); - ([ Gram.Skeyword "("; Gram.Sself; - Gram.Skeyword ":>"; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (t : 'ctyp) _ (e : 'expr) _ - (_loc : Gram.Loc.t) -> - (Ast.ExCoe (_loc, e, (Ast.TyNil _loc), t) : - 'expr)))); - ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); - Gram.Skeyword ":>"; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (t2 : 'ctyp) _ (t : 'ctyp) _ (e : 'expr) - _ (_loc : Gram.Loc.t) -> - (Ast.ExCoe (_loc, e, t, t2) : 'expr)))); - ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ";"; - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ _ (e : 'expr) _ (_loc : Gram.Loc.t) -> - (mksequence _loc e : 'expr)))); - ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ";"; - Gram.Snterm - (Gram.Entry.obj - (sequence : 'sequence Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (seq : 'sequence) _ (e : 'expr) _ - (_loc : Gram.Loc.t) -> - (mksequence _loc (Ast.ExSem (_loc, e, seq)) : - 'expr)))); - ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ","; - Gram.Snterm - (Gram.Entry.obj - (comma_expr : 'comma_expr Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (el : 'comma_expr) _ (e : 'expr) _ - (_loc : Gram.Loc.t) -> - (Ast.ExTup (_loc, (Ast.ExCom (_loc, e, el))) : - 'expr)))); - ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (t : 'ctyp) _ (e : 'expr) _ - (_loc : Gram.Loc.t) -> - (Ast.ExTyc (_loc, e, t) : 'expr)))); - ([ Gram.Skeyword "("; Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ _ (_loc : Gram.Loc.t) -> - (Ast.ExId (_loc, (Ast.IdUid (_loc, "()"))) : - 'expr)))); - ([ Gram.Skeyword "{<"; - Gram.Snterm - (Gram.Entry.obj - (field_expr_list : - 'field_expr_list Gram.Entry.t)); - Gram.Skeyword ">}" ], - (Gram.Action.mk - (fun _ (fel : 'field_expr_list) _ - (_loc : Gram.Loc.t) -> - (Ast.ExOvr (_loc, fel) : 'expr)))); - ([ Gram.Skeyword "{<"; Gram.Skeyword ">}" ], - (Gram.Action.mk - (fun _ _ (_loc : Gram.Loc.t) -> - (Ast.ExOvr (_loc, (Ast.RbNil _loc)) : 'expr)))); - ([ Gram.Skeyword "{"; Gram.Skeyword "("; Gram.Sself; - Gram.Skeyword ")"; Gram.Skeyword "with"; - Gram.Snterm - (Gram.Entry.obj - (label_expr_list : - 'label_expr_list Gram.Entry.t)); - Gram.Skeyword "}" ], - (Gram.Action.mk - (fun _ (el : 'label_expr_list) _ _ (e : 'expr) _ - _ (_loc : Gram.Loc.t) -> - (Ast.ExRec (_loc, el, e) : 'expr)))); - ([ Gram.Skeyword "{"; - Gram.Snterm - (Gram.Entry.obj - (label_expr_list : - 'label_expr_list Gram.Entry.t)); - Gram.Skeyword "}" ], - (Gram.Action.mk - (fun _ (el : 'label_expr_list) _ - (_loc : Gram.Loc.t) -> - (Ast.ExRec (_loc, el, (Ast.ExNil _loc)) : - 'expr)))); - ([ Gram.Skeyword "[|"; - Gram.Snterm - (Gram.Entry.obj - (sem_expr : 'sem_expr Gram.Entry.t)); - Gram.Skeyword "|]" ], - (Gram.Action.mk - (fun _ (el : 'sem_expr) _ (_loc : Gram.Loc.t) -> - (Ast.ExArr (_loc, el) : 'expr)))); - ([ Gram.Skeyword "[|"; Gram.Skeyword "|]" ], - (Gram.Action.mk - (fun _ _ (_loc : Gram.Loc.t) -> - (Ast.ExArr (_loc, (Ast.ExNil _loc)) : 'expr)))); - ([ Gram.Skeyword "["; - Gram.Snterm - (Gram.Entry.obj - (sem_expr_for_list : - 'sem_expr_for_list Gram.Entry.t)); - Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ (mk_list : 'sem_expr_for_list) _ - (_loc : Gram.Loc.t) -> - (mk_list - (Ast.ExId (_loc, (Ast.IdUid (_loc, "[]")))) : - 'expr)))); - ([ Gram.Skeyword "["; - Gram.Snterm - (Gram.Entry.obj - (sem_expr_for_list : - 'sem_expr_for_list Gram.Entry.t)); - Gram.Skeyword "::"; Gram.Sself; Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ (last : 'expr) _ - (mk_list : 'sem_expr_for_list) _ - (_loc : Gram.Loc.t) -> (mk_list last : 'expr)))); - ([ Gram.Skeyword "["; Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ _ (_loc : Gram.Loc.t) -> - (Ast.ExId (_loc, (Ast.IdUid (_loc, "[]"))) : - 'expr)))); - ([ Gram.Skeyword "`"; - Gram.Snterm - (Gram.Entry.obj - (a_ident : 'a_ident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_ident) _ (_loc : Gram.Loc.t) -> - (Ast.ExVrn (_loc, s) : 'expr)))); - ([ Gram.Stry - (Gram.Snterm - (Gram.Entry.obj - (val_longident : - 'val_longident Gram.Entry.t))) ], - (Gram.Action.mk - (fun (i : 'val_longident) (_loc : Gram.Loc.t) -> - (Ast.ExId (_loc, i) : 'expr)))); - ([ Gram.Stry - (Gram.Snterm - (Gram.Entry.obj - (module_longident_dot_lparen : - 'module_longident_dot_lparen Gram. - Entry.t))); - Gram.Snterm - (Gram.Entry.obj - (sequence : 'sequence Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (e : 'sequence) - (i : 'module_longident_dot_lparen) - (_loc : Gram.Loc.t) -> - (Ast.ExOpI (_loc, i, e) : 'expr)))); - ([ Gram.Snterm - (Gram.Entry.obj (a_CHAR : 'a_CHAR Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_CHAR) (_loc : Gram.Loc.t) -> - (Ast.ExChr (_loc, s) : 'expr)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_STRING : 'a_STRING Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_STRING) (_loc : Gram.Loc.t) -> - (Ast.ExStr (_loc, s) : 'expr)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_FLOAT : 'a_FLOAT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_FLOAT) (_loc : Gram.Loc.t) -> - (Ast.ExFlo (_loc, s) : 'expr)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_NATIVEINT : 'a_NATIVEINT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_NATIVEINT) (_loc : Gram.Loc.t) -> - (Ast.ExNativeInt (_loc, s) : 'expr)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_INT64 : 'a_INT64 Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_INT64) (_loc : Gram.Loc.t) -> - (Ast.ExInt64 (_loc, s) : 'expr)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_INT32 : 'a_INT32 Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_INT32) (_loc : Gram.Loc.t) -> - (Ast.ExInt32 (_loc, s) : 'expr)))); - ([ Gram.Snterm - (Gram.Entry.obj (a_INT : 'a_INT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_INT) (_loc : Gram.Loc.t) -> - (Ast.ExInt (_loc, s) : 'expr)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("seq", _) -> true - | _ -> false), - "ANTIQUOT (\"seq\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("seq" as n)), s) -> - (Ast.ExSeq (_loc, - (Ast.ExAnt (_loc, - (mk_anti ~c: "expr" n s)))) : - 'expr) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("tup", _) -> true - | _ -> false), - "ANTIQUOT (\"tup\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("tup" as n)), s) -> - (Ast.ExTup (_loc, - (Ast.ExAnt (_loc, - (mk_anti ~c: "expr" n s)))) : - 'expr) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("`bool", _) -> true - | _ -> false), - "ANTIQUOT (\"`bool\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("`bool" as n)), s) -> - (Ast.ExId (_loc, - (Ast.IdAnt (_loc, (mk_anti n s)))) : - 'expr) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("exp" | "" | "anti"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"exp\" | \"\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("exp" | "" | "anti" as n)), s) - -> - (Ast.ExAnt (_loc, - (mk_anti ~c: "expr" n s)) : - 'expr) - | _ -> assert false))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.expr_tag : - 'expr) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (do_sequence : 'do_sequence Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Skeyword "done" ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> - (Ast.ExId (_loc, (Ast.IdUid (_loc, "()"))) : - 'do_sequence)))); - ([ Gram.Stry - (Gram.srules do_sequence - [ ([ Gram.Snterm - (Gram.Entry.obj - (sequence : - 'sequence Gram.Entry.t)); - Gram.Skeyword "done" ], - (Gram.Action.mk - (fun _ (seq : 'sequence) - (_loc : Gram.Loc.t) -> - (seq : 'e__3)))) ]) ], - (Gram.Action.mk - (fun (seq : 'e__3) (_loc : Gram.Loc.t) -> - (seq : 'do_sequence)))); - ([ Gram.Stry - (Gram.srules do_sequence - [ ([ Gram.Skeyword "{"; Gram.Skeyword "}" ], - (Gram.Action.mk - (fun _ _ (_loc : Gram.Loc.t) -> - (() : 'e__2)))) ]) ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> - (Ast.ExId (_loc, (Ast.IdUid (_loc, "()"))) : - 'do_sequence)))); - ([ Gram.Stry - (Gram.srules do_sequence - [ ([ Gram.Skeyword "{"; - Gram.Snterm - (Gram.Entry.obj - (sequence : - 'sequence Gram.Entry.t)); - Gram.Skeyword "}" ], - (Gram.Action.mk - (fun _ (seq : 'sequence) _ - (_loc : Gram.Loc.t) -> - (seq : 'e__1)))) ]) ], - (Gram.Action.mk - (fun (seq : 'e__1) (_loc : Gram.Loc.t) -> - (seq : 'do_sequence)))) ]) ])) - ()); - Gram.extend (infixop5 : 'infixop5 Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.srules infixop5 - [ ([ Gram.Skeyword "&&" ], - (Gram.Action.mk - (fun (x : Gram.Token.t) - (_loc : Gram.Loc.t) -> - (Gram.Token.extract_string x : 'e__4)))); - ([ Gram.Skeyword "&" ], - (Gram.Action.mk - (fun (x : Gram.Token.t) - (_loc : Gram.Loc.t) -> - (Gram.Token.extract_string x : 'e__4)))) ] ], - (Gram.Action.mk - (fun (x : 'e__4) (_loc : Gram.Loc.t) -> - (Ast.ExId (_loc, (Ast.IdLid (_loc, x))) : - 'infixop5)))) ]) ])) - ()); - Gram.extend (infixop6 : 'infixop6 Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.srules infixop6 - [ ([ Gram.Skeyword "||" ], - (Gram.Action.mk - (fun (x : Gram.Token.t) - (_loc : Gram.Loc.t) -> - (Gram.Token.extract_string x : 'e__5)))); - ([ Gram.Skeyword "or" ], - (Gram.Action.mk - (fun (x : Gram.Token.t) - (_loc : Gram.Loc.t) -> - (Gram.Token.extract_string x : 'e__5)))) ] ], - (Gram.Action.mk - (fun (x : 'e__5) (_loc : Gram.Loc.t) -> - (Ast.ExId (_loc, (Ast.IdLid (_loc, x))) : - 'infixop6)))) ]) ])) - ()); - Gram.extend - (sem_expr_for_list : 'sem_expr_for_list Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) (_loc : Gram.Loc.t) -> - (fun acc -> - Ast.ExApp (_loc, - (Ast.ExApp (_loc, - (Ast.ExId (_loc, - (Ast.IdUid (_loc, "::")))), - e)), - acc) : - 'sem_expr_for_list)))); - ([ Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); - Gram.Skeyword ";" ], - (Gram.Action.mk - (fun _ (e : 'expr) (_loc : Gram.Loc.t) -> - (fun acc -> - Ast.ExApp (_loc, - (Ast.ExApp (_loc, - (Ast.ExId (_loc, - (Ast.IdUid (_loc, "::")))), - e)), - acc) : - 'sem_expr_for_list)))); - ([ Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); - Gram.Skeyword ";"; Gram.Sself ], - (Gram.Action.mk - (fun (el : 'sem_expr_for_list) _ (e : 'expr) - (_loc : Gram.Loc.t) -> - (fun acc -> - Ast.ExApp (_loc, - (Ast.ExApp (_loc, - (Ast.ExId (_loc, - (Ast.IdUid (_loc, "::")))), - e)), - (el acc)) : - 'sem_expr_for_list)))) ]) ])) - ()); - Gram.extend (comma_expr : 'comma_expr Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterml - ((Gram.Entry.obj (expr : 'expr Gram.Entry.t)), - "top") ], - (Gram.Action.mk - (fun (e : 'expr) (_loc : Gram.Loc.t) -> - (e : 'comma_expr)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.ExAnt (_loc, - (mk_anti ~c: "expr," n s)) : - 'comma_expr) - | _ -> assert false))); - ([ Gram.Sself; Gram.Skeyword ","; Gram.Sself ], - (Gram.Action.mk - (fun (e2 : 'comma_expr) _ (e1 : 'comma_expr) - (_loc : Gram.Loc.t) -> - (Ast.ExCom (_loc, e1, e2) : 'comma_expr)))) ]) ])) - ()); - Gram.extend (dummy : 'dummy Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> (() : 'dummy)))) ]) ])) - ()); - Gram.extend (sequence' : 'sequence' Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Skeyword ";"; - Gram.Snterm - (Gram.Entry.obj - (sequence : 'sequence Gram.Entry.t)) ], - (Gram.Action.mk - (fun (el : 'sequence) _ (_loc : Gram.Loc.t) -> - (fun e -> Ast.ExSem (_loc, e, el) : - 'sequence')))); - ([ Gram.Skeyword ";" ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> - (fun e -> e : 'sequence')))); - ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (fun e -> e : 'sequence')))) ]) ])) - ()); - Gram.extend (sequence : 'sequence Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (sequence' : 'sequence' Gram.Entry.t)) ], - (Gram.Action.mk - (fun (k : 'sequence') (e : 'expr) - (_loc : Gram.Loc.t) -> (k e : 'sequence)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.ExAnt (_loc, - (mk_anti ~c: "expr;" n s)) : - 'sequence) - | _ -> assert false))); - ([ Gram.Skeyword "let"; Gram.Skeyword "open"; - Gram.Snterm - (Gram.Entry.obj - (module_longident : - 'module_longident Gram.Entry.t)); - Gram.Skeyword "in"; Gram.Sself ], - (Gram.Action.mk - (fun (e : 'sequence) _ (i : 'module_longident) _ - _ (_loc : Gram.Loc.t) -> - (Ast.ExOpI (_loc, i, e) : 'sequence)))); - ([ Gram.Skeyword "let"; Gram.Skeyword "module"; - Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (module_binding0 : - 'module_binding0 Gram.Entry.t)); - Gram.Skeyword ";"; Gram.Sself ], - (Gram.Action.mk - (fun (el : 'sequence) _ (mb : 'module_binding0) - (m : 'a_UIDENT) _ _ (_loc : Gram.Loc.t) -> - (Ast.ExLmd (_loc, m, mb, - (mksequence _loc el)) : - 'sequence)))); - ([ Gram.Skeyword "let"; Gram.Skeyword "module"; - Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (module_binding0 : - 'module_binding0 Gram.Entry.t)); - Gram.Skeyword "in"; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (sequence' : 'sequence' Gram.Entry.t)) ], - (Gram.Action.mk - (fun (k : 'sequence') (e : 'expr) _ - (mb : 'module_binding0) (m : 'a_UIDENT) _ _ - (_loc : Gram.Loc.t) -> - (k (Ast.ExLmd (_loc, m, mb, e)) : 'sequence)))); - ([ Gram.Skeyword "let"; - Gram.Snterm - (Gram.Entry.obj - (opt_rec : 'opt_rec Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (binding : 'binding Gram.Entry.t)); - Gram.Skeyword ";"; Gram.Sself ], - (Gram.Action.mk - (fun (el : 'sequence) _ (bi : 'binding) - (rf : 'opt_rec) _ (_loc : Gram.Loc.t) -> - (Ast.ExLet (_loc, rf, bi, - (mksequence _loc el)) : - 'sequence)))); - ([ Gram.Skeyword "let"; - Gram.Snterm - (Gram.Entry.obj - (opt_rec : 'opt_rec Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (binding : 'binding Gram.Entry.t)); - Gram.Skeyword "in"; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (sequence' : 'sequence' Gram.Entry.t)) ], - (Gram.Action.mk - (fun (k : 'sequence') (e : 'expr) _ - (bi : 'binding) (rf : 'opt_rec) _ - (_loc : Gram.Loc.t) -> - (k (Ast.ExLet (_loc, rf, bi, e)) : 'sequence)))) ]) ])) - ()); - Gram.extend (binding : 'binding Gram.Entry.t) - ((fun () -> - (None, - [ (None, (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Snterm - (Gram.Entry.obj - (let_binding : 'let_binding Gram.Entry.t)) ], - (Gram.Action.mk - (fun (b : 'let_binding) (_loc : Gram.Loc.t) -> - (b : 'binding)))); - ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], - (Gram.Action.mk - (fun (b2 : 'binding) _ (b1 : 'binding) - (_loc : Gram.Loc.t) -> - (Ast.BiAnd (_loc, b1, b2) : 'binding)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "anti"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "anti" as n)), s) -> - (Ast.BiAnt (_loc, - (mk_anti ~c: "binding" n s)) : - 'binding) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "anti"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"anti\"), _)")); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) _ (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "anti" as n)), s) -> - (Ast.BiEq (_loc, - (Ast.PaAnt (_loc, - (mk_anti ~c: "patt" n s))), - e) : - 'binding) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("binding" | "list"), _) -> true - | _ -> false), - "ANTIQUOT ((\"binding\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("binding" | "list" as n)), s) - -> - (Ast.BiAnt (_loc, - (mk_anti ~c: "binding" n s)) : - 'binding) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (let_binding : 'let_binding Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (fun_binding : 'fun_binding Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'fun_binding) (p : 'ipatt) - (_loc : Gram.Loc.t) -> - (Ast.BiEq (_loc, p, e) : 'let_binding)))) ]) ])) - ()); - Gram.extend (fun_binding : 'fun_binding Gram.Entry.t) - ((fun () -> - (None, - [ (None, (Some Camlp4.Sig.Grammar.RightA), - [ ([ Gram.Snterm - (Gram.Entry.obj - (cvalue_binding : - 'cvalue_binding Gram.Entry.t)) ], - (Gram.Action.mk - (fun (bi : 'cvalue_binding) (_loc : Gram.Loc.t) - -> (bi : 'fun_binding)))); - ([ Gram.Stry - (Gram.Snterm - (Gram.Entry.obj - (labeled_ipatt : - 'labeled_ipatt Gram.Entry.t))); - Gram.Sself ], - (Gram.Action.mk - (fun (e : 'fun_binding) (p : 'labeled_ipatt) - (_loc : Gram.Loc.t) -> - (Ast.ExFun (_loc, - (Ast.McArr (_loc, p, (Ast.ExNil _loc), e))) : - 'fun_binding)))); - ([ Gram.Stry - (Gram.srules fun_binding - [ ([ Gram.Skeyword "("; Gram.Skeyword "type" ], - (Gram.Action.mk - (fun _ _ (_loc : Gram.Loc.t) -> - (() : 'e__6)))) ]); - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Skeyword ")"; Gram.Sself ], - (Gram.Action.mk - (fun (e : 'fun_binding) _ (i : 'a_LIDENT) _ - (_loc : Gram.Loc.t) -> - (Ast.ExFUN (_loc, i, e) : 'fun_binding)))) ]) ])) - ()); - Gram.extend (match_case : 'match_case Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)); - Gram.Skeyword "->"; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) _ (p : 'ipatt) - (_loc : Gram.Loc.t) -> - (Ast.McArr (_loc, p, (Ast.ExNil _loc), e) : - 'match_case)))); - ([ Gram.Skeyword "["; - Gram.Slist0sep - ((Gram.Snterm - (Gram.Entry.obj - (match_case0 : - 'match_case0 Gram.Entry.t))), - (Gram.Skeyword "|")); - Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ (l : 'match_case0 list) _ - (_loc : Gram.Loc.t) -> - (Ast.mcOr_of_list l : 'match_case)))) ]) ])) - ()); - Gram.extend (match_case0 : 'match_case0 Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (patt_as_patt_opt : - 'patt_as_patt_opt Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_when_expr : - 'opt_when_expr Gram.Entry.t)); - Gram.Skeyword "->"; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) _ (w : 'opt_when_expr) - (p : 'patt_as_patt_opt) (_loc : Gram.Loc.t) - -> (Ast.McArr (_loc, p, w, e) : 'match_case0)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "anti"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"anti\"), _)")); - Gram.Skeyword "when"; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); - Gram.Skeyword "->"; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) _ (w : 'expr) _ - (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "anti" as n)), s) -> - (Ast.McArr (_loc, - (Ast.PaAnt (_loc, - (mk_anti ~c: "patt" n s))), - w, e) : - 'match_case0) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "anti"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"anti\"), _)")); - Gram.Skeyword "->"; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) _ (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "anti" as n)), s) -> - (Ast.McArr (_loc, - (Ast.PaAnt (_loc, - (mk_anti ~c: "patt" n s))), - (Ast.ExNil _loc), e) : - 'match_case0) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "anti"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "anti" as n)), s) -> - (Ast.McAnt (_loc, - (mk_anti ~c: "match_case" n s)) : - 'match_case0) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("match_case" | "list"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"match_case\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("match_case" | "list" as n)), - s) -> - (Ast.McAnt (_loc, - (mk_anti ~c: "match_case" n s)) : - 'match_case0) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (opt_when_expr : 'opt_when_expr Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.ExNil _loc : 'opt_when_expr)))); - ([ Gram.Skeyword "when"; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (w : 'expr) _ (_loc : Gram.Loc.t) -> - (w : 'opt_when_expr)))) ]) ])) - ()); - Gram.extend (patt_as_patt_opt : 'patt_as_patt_opt Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], - (Gram.Action.mk - (fun (p : 'patt) (_loc : Gram.Loc.t) -> - (p : 'patt_as_patt_opt)))); - ([ Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); - Gram.Skeyword "as"; - Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], - (Gram.Action.mk - (fun (p2 : 'patt) _ (p1 : 'patt) - (_loc : Gram.Loc.t) -> - (Ast.PaAli (_loc, p1, p2) : - 'patt_as_patt_opt)))) ]) ])) - ()); - Gram.extend (label_expr_list : 'label_expr_list Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (label_expr : 'label_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (b1 : 'label_expr) (_loc : Gram.Loc.t) -> - (b1 : 'label_expr_list)))); - ([ Gram.Snterm - (Gram.Entry.obj - (label_expr : 'label_expr Gram.Entry.t)); - Gram.Skeyword ";" ], - (Gram.Action.mk - (fun _ (b1 : 'label_expr) (_loc : Gram.Loc.t) -> - (b1 : 'label_expr_list)))); - ([ Gram.Snterm - (Gram.Entry.obj - (label_expr : 'label_expr Gram.Entry.t)); - Gram.Skeyword ";"; Gram.Sself ], - (Gram.Action.mk - (fun (b2 : 'label_expr_list) _ - (b1 : 'label_expr) (_loc : Gram.Loc.t) -> - (Ast.RbSem (_loc, b1, b2) : 'label_expr_list)))) ]) ])) - ()); - Gram.extend (label_expr : 'label_expr Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (label_longident : - 'label_longident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'label_longident) (_loc : Gram.Loc.t) - -> - (Ast.RbEq (_loc, i, - (Ast.ExId (_loc, - (Ast.IdLid (_loc, (lid_of_ident i)))))) : - 'label_expr)))); - ([ Gram.Snterm - (Gram.Entry.obj - (label_longident : - 'label_longident Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (fun_binding : 'fun_binding Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'fun_binding) (i : 'label_longident) - (_loc : Gram.Loc.t) -> - (Ast.RbEq (_loc, i, e) : 'label_expr)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.RbAnt (_loc, - (mk_anti ~c: "rec_binding" n s)) : - 'label_expr) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "anti"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"anti\"), _)")); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) _ (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "anti" as n)), s) -> - (Ast.RbEq (_loc, - (Ast.IdAnt (_loc, - (mk_anti ~c: "ident" n s))), - e) : - 'label_expr) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "anti"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "anti" as n)), s) -> - (Ast.RbAnt (_loc, - (mk_anti ~c: "rec_binding" n s)) : - 'label_expr) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("rec_binding", _) -> true - | _ -> false), - "ANTIQUOT (\"rec_binding\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("rec_binding" as n)), s) -> - (Ast.RbAnt (_loc, - (mk_anti ~c: "rec_binding" n s)) : - 'label_expr) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (fun_def : 'fun_def Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Stry - (Gram.Snterm - (Gram.Entry.obj - (labeled_ipatt : - 'labeled_ipatt Gram.Entry.t))); - Gram.Snterm - (Gram.Entry.obj - (fun_def_cont : 'fun_def_cont Gram.Entry.t)) ], - (Gram.Action.mk - (fun ((w, e) : 'fun_def_cont) - (p : 'labeled_ipatt) (_loc : Gram.Loc.t) -> - (Ast.ExFun (_loc, - (Ast.McArr (_loc, p, w, e))) : - 'fun_def)))); - ([ Gram.Stry - (Gram.srules fun_def - [ ([ Gram.Skeyword "("; Gram.Skeyword "type" ], - (Gram.Action.mk - (fun _ _ (_loc : Gram.Loc.t) -> - (() : 'e__7)))) ]); - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Skeyword ")"; - Gram.Snterm - (Gram.Entry.obj - (fun_def_cont_no_when : - 'fun_def_cont_no_when Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'fun_def_cont_no_when) _ - (i : 'a_LIDENT) _ (_loc : Gram.Loc.t) -> - (Ast.ExFUN (_loc, i, e) : 'fun_def)))) ]) ])) - ()); - Gram.extend (fun_def_cont : 'fun_def_cont Gram.Entry.t) - ((fun () -> - (None, - [ (None, (Some Camlp4.Sig.Grammar.RightA), - [ ([ Gram.Skeyword "->"; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) _ (_loc : Gram.Loc.t) -> - (((Ast.ExNil _loc), e) : 'fun_def_cont)))); - ([ Gram.Skeyword "when"; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); - Gram.Skeyword "->"; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) _ (w : 'expr) _ - (_loc : Gram.Loc.t) -> - ((w, e) : 'fun_def_cont)))); - ([ Gram.Stry - (Gram.Snterm - (Gram.Entry.obj - (labeled_ipatt : - 'labeled_ipatt Gram.Entry.t))); - Gram.Sself ], - (Gram.Action.mk - (fun ((w, e) : 'fun_def_cont) - (p : 'labeled_ipatt) (_loc : Gram.Loc.t) -> - (((Ast.ExNil _loc), - (Ast.ExFun (_loc, - (Ast.McArr (_loc, p, w, e))))) : - 'fun_def_cont)))); - ([ Gram.Stry - (Gram.srules fun_def_cont - [ ([ Gram.Skeyword "("; Gram.Skeyword "type" ], - (Gram.Action.mk - (fun _ _ (_loc : Gram.Loc.t) -> - (() : 'e__8)))) ]); - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Skeyword ")"; - Gram.Snterm - (Gram.Entry.obj - (fun_def_cont_no_when : - 'fun_def_cont_no_when Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'fun_def_cont_no_when) _ - (i : 'a_LIDENT) _ (_loc : Gram.Loc.t) -> - (((Ast.ExNil _loc), (Ast.ExFUN (_loc, i, e))) : - 'fun_def_cont)))) ]) ])) - ()); - Gram.extend - (fun_def_cont_no_when : 'fun_def_cont_no_when Gram.Entry.t) - ((fun () -> - (None, - [ (None, (Some Camlp4.Sig.Grammar.RightA), - [ ([ Gram.Skeyword "->"; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) _ (_loc : Gram.Loc.t) -> - (e : 'fun_def_cont_no_when)))); - ([ Gram.Stry - (Gram.Snterm - (Gram.Entry.obj - (labeled_ipatt : - 'labeled_ipatt Gram.Entry.t))); - Gram.Snterm - (Gram.Entry.obj - (fun_def_cont : 'fun_def_cont Gram.Entry.t)) ], - (Gram.Action.mk - (fun ((w, e) : 'fun_def_cont) - (p : 'labeled_ipatt) (_loc : Gram.Loc.t) -> - (Ast.ExFun (_loc, - (Ast.McArr (_loc, p, w, e))) : - 'fun_def_cont_no_when)))); - ([ Gram.Stry - (Gram.srules fun_def_cont_no_when - [ ([ Gram.Skeyword "("; Gram.Skeyword "type" ], - (Gram.Action.mk - (fun _ _ (_loc : Gram.Loc.t) -> - (() : 'e__9)))) ]); - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Skeyword ")"; Gram.Sself ], - (Gram.Action.mk - (fun (e : 'fun_def_cont_no_when) _ - (i : 'a_LIDENT) _ (_loc : Gram.Loc.t) -> - (Ast.ExFUN (_loc, i, e) : - 'fun_def_cont_no_when)))) ]) ])) - ()); - Gram.extend (patt : 'patt Gram.Entry.t) - ((fun () -> - (None, - [ ((Some "|"), (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Sself; Gram.Skeyword "|"; Gram.Sself ], - (Gram.Action.mk - (fun (p2 : 'patt) _ (p1 : 'patt) - (_loc : Gram.Loc.t) -> - (Ast.PaOrp (_loc, p1, p2) : 'patt)))) ]); - ((Some ".."), (Some Camlp4.Sig.Grammar.NonA), - [ ([ Gram.Sself; Gram.Skeyword ".."; Gram.Sself ], - (Gram.Action.mk - (fun (p2 : 'patt) _ (p1 : 'patt) - (_loc : Gram.Loc.t) -> - (Ast.PaRng (_loc, p1, p2) : 'patt)))) ]); - ((Some "apply"), (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Skeyword "lazy"; Gram.Sself ], - (Gram.Action.mk - (fun (p : 'patt) _ (_loc : Gram.Loc.t) -> - (Ast.PaLaz (_loc, p) : 'patt)))); - ([ Gram.Sself; Gram.Sself ], - (Gram.Action.mk - (fun (p2 : 'patt) (p1 : 'patt) - (_loc : Gram.Loc.t) -> - (Ast.PaApp (_loc, p1, p2) : 'patt)))) ]); - ((Some "simple"), None, - [ ([ Gram.Skeyword "?"; Gram.Skeyword "("; - Gram.Snterm - (Gram.Entry.obj - (patt_tcon : 'patt_tcon Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (e : 'expr) _ (p : 'patt_tcon) _ _ - (_loc : Gram.Loc.t) -> - (Ast.PaOlbi (_loc, "", p, e) : 'patt)))); - ([ Gram.Skeyword "?"; Gram.Skeyword "("; - Gram.Snterm - (Gram.Entry.obj - (patt_tcon : 'patt_tcon Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (p : 'patt_tcon) _ _ (_loc : Gram.Loc.t) - -> (Ast.PaOlb (_loc, "", p) : 'patt)))); - ([ Gram.Skeyword "?"; - Gram.Stoken - (((function - | ANTIQUOT (("" | "lid"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"lid\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) _ - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "lid" as n)), i) -> - (Ast.PaOlb (_loc, (mk_anti n i), - (Ast.PaNil _loc)) : - 'patt) - | _ -> assert false))); - ([ Gram.Skeyword "?"; - Gram.Stoken - (((function | LIDENT _ -> true | _ -> false), - "LIDENT _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) _ - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | LIDENT i -> - (Ast.PaOlb (_loc, i, (Ast.PaNil _loc)) : - 'patt) - | _ -> assert false))); - ([ Gram.Skeyword "?"; - Gram.Stoken - (((function - | ANTIQUOT (("" | "lid"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"lid\"), _)")); - Gram.Skeyword ":"; Gram.Skeyword "("; - Gram.Snterm - (Gram.Entry.obj - (patt_tcon : 'patt_tcon Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (eq_expr : 'eq_expr Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (f : 'eq_expr) (p : 'patt_tcon) _ _ - (__camlp4_0 : Gram.Token.t) _ - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "lid" as n)), i) -> - (f (mk_anti n i) p : 'patt) - | _ -> assert false))); - ([ Gram.Stoken - (((function | OPTLABEL _ -> true | _ -> false), - "OPTLABEL _")); - Gram.Skeyword "("; - Gram.Snterm - (Gram.Entry.obj - (patt_tcon : 'patt_tcon Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (eq_expr : 'eq_expr Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (f : 'eq_expr) (p : 'patt_tcon) _ - (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | OPTLABEL i -> (f i p : 'patt) - | _ -> assert false))); - ([ Gram.Skeyword "~"; - Gram.Stoken - (((function | LIDENT _ -> true | _ -> false), - "LIDENT _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) _ - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | LIDENT i -> - (Ast.PaLab (_loc, i, (Ast.PaNil _loc)) : - 'patt) - | _ -> assert false))); - ([ Gram.Skeyword "~"; - Gram.Stoken - (((function - | ANTIQUOT (("" | "lid"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"lid\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) _ - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "lid" as n)), i) -> - (Ast.PaLab (_loc, (mk_anti n i), - (Ast.PaNil _loc)) : - 'patt) - | _ -> assert false))); - ([ Gram.Skeyword "~"; - Gram.Stoken - (((function - | ANTIQUOT (("" | "lid"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"lid\"), _)")); - Gram.Skeyword ":"; Gram.Sself ], - (Gram.Action.mk - (fun (p : 'patt) _ (__camlp4_0 : Gram.Token.t) _ - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "lid" as n)), i) -> - (Ast.PaLab (_loc, (mk_anti n i), p) : - 'patt) - | _ -> assert false))); - ([ Gram.Stoken - (((function | LABEL _ -> true | _ -> false), - "LABEL _")); - Gram.Sself ], - (Gram.Action.mk - (fun (p : 'patt) (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | LABEL i -> (Ast.PaLab (_loc, i, p) : 'patt) - | _ -> assert false))); - ([ Gram.Skeyword "#"; - Gram.Snterm - (Gram.Entry.obj - (type_longident : - 'type_longident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'type_longident) _ (_loc : Gram.Loc.t) - -> (Ast.PaTyp (_loc, i) : 'patt)))); - ([ Gram.Skeyword "`"; - Gram.Snterm - (Gram.Entry.obj - (a_ident : 'a_ident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_ident) _ (_loc : Gram.Loc.t) -> - (Ast.PaVrn (_loc, s) : 'patt)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.patt_tag : - 'patt) - | _ -> assert false))); - ([ Gram.Skeyword "_" ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> - (Ast.PaAny _loc : 'patt)))); - ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ","; - Gram.Snterm - (Gram.Entry.obj - (comma_patt : 'comma_patt Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (pl : 'comma_patt) _ (p : 'patt) _ - (_loc : Gram.Loc.t) -> - (Ast.PaTup (_loc, (Ast.PaCom (_loc, p, pl))) : - 'patt)))); - ([ Gram.Skeyword "("; Gram.Sself; - Gram.Skeyword "as"; Gram.Sself; Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (p2 : 'patt) _ (p : 'patt) _ - (_loc : Gram.Loc.t) -> - (Ast.PaAli (_loc, p, p2) : 'patt)))); - ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (t : 'ctyp) _ (p : 'patt) _ - (_loc : Gram.Loc.t) -> - (Ast.PaTyc (_loc, p, t) : 'patt)))); - ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (p : 'patt) _ (_loc : Gram.Loc.t) -> - (p : 'patt)))); - ([ Gram.Skeyword "("; Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ _ (_loc : Gram.Loc.t) -> - (Ast.PaId (_loc, (Ast.IdUid (_loc, "()"))) : - 'patt)))); - ([ Gram.Skeyword "{"; - Gram.Snterm - (Gram.Entry.obj - (label_patt_list : - 'label_patt_list Gram.Entry.t)); - Gram.Skeyword "}" ], - (Gram.Action.mk - (fun _ (pl : 'label_patt_list) _ - (_loc : Gram.Loc.t) -> - (Ast.PaRec (_loc, pl) : 'patt)))); - ([ Gram.Skeyword "[|"; - Gram.Snterm - (Gram.Entry.obj - (sem_patt : 'sem_patt Gram.Entry.t)); - Gram.Skeyword "|]" ], - (Gram.Action.mk - (fun _ (pl : 'sem_patt) _ (_loc : Gram.Loc.t) -> - (Ast.PaArr (_loc, pl) : 'patt)))); - ([ Gram.Skeyword "[|"; Gram.Skeyword "|]" ], - (Gram.Action.mk - (fun _ _ (_loc : Gram.Loc.t) -> - (Ast.PaArr (_loc, (Ast.PaNil _loc)) : 'patt)))); - ([ Gram.Skeyword "["; - Gram.Snterm - (Gram.Entry.obj - (sem_patt_for_list : - 'sem_patt_for_list Gram.Entry.t)); - Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ (mk_list : 'sem_patt_for_list) _ - (_loc : Gram.Loc.t) -> - (mk_list - (Ast.PaId (_loc, (Ast.IdUid (_loc, "[]")))) : - 'patt)))); - ([ Gram.Skeyword "["; - Gram.Snterm - (Gram.Entry.obj - (sem_patt_for_list : - 'sem_patt_for_list Gram.Entry.t)); - Gram.Skeyword "::"; Gram.Sself; Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ (last : 'patt) _ - (mk_list : 'sem_patt_for_list) _ - (_loc : Gram.Loc.t) -> (mk_list last : 'patt)))); - ([ Gram.Skeyword "["; Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ _ (_loc : Gram.Loc.t) -> - (Ast.PaId (_loc, (Ast.IdUid (_loc, "[]"))) : - 'patt)))); - ([ Gram.Skeyword "-"; - Gram.Snterm - (Gram.Entry.obj - (a_FLOAT : 'a_FLOAT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_FLOAT) _ (_loc : Gram.Loc.t) -> - (Ast.PaFlo (_loc, (neg_string s)) : 'patt)))); - ([ Gram.Skeyword "-"; - Gram.Snterm - (Gram.Entry.obj - (a_NATIVEINT : 'a_NATIVEINT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_NATIVEINT) _ (_loc : Gram.Loc.t) -> - (Ast.PaNativeInt (_loc, (neg_string s)) : - 'patt)))); - ([ Gram.Skeyword "-"; - Gram.Snterm - (Gram.Entry.obj - (a_INT64 : 'a_INT64 Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_INT64) _ (_loc : Gram.Loc.t) -> - (Ast.PaInt64 (_loc, (neg_string s)) : 'patt)))); - ([ Gram.Skeyword "-"; - Gram.Snterm - (Gram.Entry.obj - (a_INT32 : 'a_INT32 Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_INT32) _ (_loc : Gram.Loc.t) -> - (Ast.PaInt32 (_loc, (neg_string s)) : 'patt)))); - ([ Gram.Skeyword "-"; - Gram.Snterm - (Gram.Entry.obj (a_INT : 'a_INT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_INT) _ (_loc : Gram.Loc.t) -> - (Ast.PaInt (_loc, (neg_string s)) : 'patt)))); - ([ Gram.Snterm - (Gram.Entry.obj (a_CHAR : 'a_CHAR Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_CHAR) (_loc : Gram.Loc.t) -> - (Ast.PaChr (_loc, s) : 'patt)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_STRING : 'a_STRING Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_STRING) (_loc : Gram.Loc.t) -> - (Ast.PaStr (_loc, s) : 'patt)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_FLOAT : 'a_FLOAT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_FLOAT) (_loc : Gram.Loc.t) -> - (Ast.PaFlo (_loc, s) : 'patt)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_NATIVEINT : 'a_NATIVEINT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_NATIVEINT) (_loc : Gram.Loc.t) -> - (Ast.PaNativeInt (_loc, s) : 'patt)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_INT64 : 'a_INT64 Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_INT64) (_loc : Gram.Loc.t) -> - (Ast.PaInt64 (_loc, s) : 'patt)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_INT32 : 'a_INT32 Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_INT32) (_loc : Gram.Loc.t) -> - (Ast.PaInt32 (_loc, s) : 'patt)))); - ([ Gram.Snterm - (Gram.Entry.obj (a_INT : 'a_INT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_INT) (_loc : Gram.Loc.t) -> - (Ast.PaInt (_loc, s) : 'patt)))); - ([ Gram.Snterm - (Gram.Entry.obj (ident : 'ident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'ident) (_loc : Gram.Loc.t) -> - (Ast.PaId (_loc, i) : 'patt)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("`bool", _) -> true - | _ -> false), - "ANTIQUOT (\"`bool\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("`bool" as n)), s) -> - (Ast.PaId (_loc, - (Ast.IdAnt (_loc, (mk_anti n s)))) : - 'patt) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("tup", _) -> true - | _ -> false), - "ANTIQUOT (\"tup\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("tup" as n)), s) -> - (Ast.PaTup (_loc, - (Ast.PaAnt (_loc, - (mk_anti ~c: "patt" n s)))) : - 'patt) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "pat" | "anti"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"\" | \"pat\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "pat" | "anti" as n)), s) - -> - (Ast.PaAnt (_loc, - (mk_anti ~c: "patt" n s)) : - 'patt) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (comma_patt : 'comma_patt Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], - (Gram.Action.mk - (fun (p : 'patt) (_loc : Gram.Loc.t) -> - (p : 'comma_patt)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.PaAnt (_loc, - (mk_anti ~c: "patt," n s)) : - 'comma_patt) - | _ -> assert false))); - ([ Gram.Sself; Gram.Skeyword ","; Gram.Sself ], - (Gram.Action.mk - (fun (p2 : 'comma_patt) _ (p1 : 'comma_patt) - (_loc : Gram.Loc.t) -> - (Ast.PaCom (_loc, p1, p2) : 'comma_patt)))) ]) ])) - ()); - Gram.extend (sem_patt : 'sem_patt Gram.Entry.t) - ((fun () -> - (None, - [ (None, (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], - (Gram.Action.mk - (fun (p : 'patt) (_loc : Gram.Loc.t) -> - (p : 'sem_patt)))); - ([ Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); - Gram.Skeyword ";" ], - (Gram.Action.mk - (fun _ (p : 'patt) (_loc : Gram.Loc.t) -> - (p : 'sem_patt)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.PaAnt (_loc, - (mk_anti ~c: "patt;" n s)) : - 'sem_patt) - | _ -> assert false))); - ([ Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); - Gram.Skeyword ";"; Gram.Sself ], - (Gram.Action.mk - (fun (p2 : 'sem_patt) _ (p1 : 'patt) - (_loc : Gram.Loc.t) -> - (Ast.PaSem (_loc, p1, p2) : 'sem_patt)))) ]) ])) - ()); - Gram.extend - (sem_patt_for_list : 'sem_patt_for_list Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], - (Gram.Action.mk - (fun (p : 'patt) (_loc : Gram.Loc.t) -> - (fun acc -> - Ast.PaApp (_loc, - (Ast.PaApp (_loc, - (Ast.PaId (_loc, - (Ast.IdUid (_loc, "::")))), - p)), - acc) : - 'sem_patt_for_list)))); - ([ Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); - Gram.Skeyword ";" ], - (Gram.Action.mk - (fun _ (p : 'patt) (_loc : Gram.Loc.t) -> - (fun acc -> - Ast.PaApp (_loc, - (Ast.PaApp (_loc, - (Ast.PaId (_loc, - (Ast.IdUid (_loc, "::")))), - p)), - acc) : - 'sem_patt_for_list)))); - ([ Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); - Gram.Skeyword ";"; Gram.Sself ], - (Gram.Action.mk - (fun (pl : 'sem_patt_for_list) _ (p : 'patt) - (_loc : Gram.Loc.t) -> - (fun acc -> - Ast.PaApp (_loc, - (Ast.PaApp (_loc, - (Ast.PaId (_loc, - (Ast.IdUid (_loc, "::")))), - p)), - (pl acc)) : - 'sem_patt_for_list)))) ]) ])) - ()); - Gram.extend (label_patt_list : 'label_patt_list Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (label_patt : 'label_patt Gram.Entry.t)) ], - (Gram.Action.mk - (fun (p1 : 'label_patt) (_loc : Gram.Loc.t) -> - (p1 : 'label_patt_list)))); - ([ Gram.Snterm - (Gram.Entry.obj - (label_patt : 'label_patt Gram.Entry.t)); - Gram.Skeyword ";" ], - (Gram.Action.mk - (fun _ (p1 : 'label_patt) (_loc : Gram.Loc.t) -> - (p1 : 'label_patt_list)))); - ([ Gram.Snterm - (Gram.Entry.obj - (label_patt : 'label_patt Gram.Entry.t)); - Gram.Skeyword ";"; Gram.Skeyword "_"; - Gram.Skeyword ";" ], - (Gram.Action.mk - (fun _ _ _ (p1 : 'label_patt) - (_loc : Gram.Loc.t) -> - (Ast.PaSem (_loc, p1, (Ast.PaAny _loc)) : - 'label_patt_list)))); - ([ Gram.Snterm - (Gram.Entry.obj - (label_patt : 'label_patt Gram.Entry.t)); - Gram.Skeyword ";"; Gram.Skeyword "_" ], - (Gram.Action.mk - (fun _ _ (p1 : 'label_patt) (_loc : Gram.Loc.t) - -> - (Ast.PaSem (_loc, p1, (Ast.PaAny _loc)) : - 'label_patt_list)))); - ([ Gram.Snterm - (Gram.Entry.obj - (label_patt : 'label_patt Gram.Entry.t)); - Gram.Skeyword ";"; Gram.Sself ], - (Gram.Action.mk - (fun (p2 : 'label_patt_list) _ - (p1 : 'label_patt) (_loc : Gram.Loc.t) -> - (Ast.PaSem (_loc, p1, p2) : 'label_patt_list)))) ]) ])) - ()); - Gram.extend (label_patt : 'label_patt Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (label_longident : - 'label_longident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'label_longident) (_loc : Gram.Loc.t) - -> - (Ast.PaEq (_loc, i, - (Ast.PaId (_loc, - (Ast.IdLid (_loc, (lid_of_ident i)))))) : - 'label_patt)))); - ([ Gram.Snterm - (Gram.Entry.obj - (label_longident : - 'label_longident Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], - (Gram.Action.mk - (fun (p : 'patt) _ (i : 'label_longident) - (_loc : Gram.Loc.t) -> - (Ast.PaEq (_loc, i, p) : 'label_patt)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.PaAnt (_loc, - (mk_anti ~c: "patt;" n s)) : - 'label_patt) - | _ -> assert false))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.patt_tag : - 'label_patt) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "pat" | "anti"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"\" | \"pat\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "pat" | "anti" as n)), s) - -> - (Ast.PaAnt (_loc, - (mk_anti ~c: "patt" n s)) : - 'label_patt) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (ipatt : 'ipatt Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Skeyword "_" ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> - (Ast.PaAny _loc : 'ipatt)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_LIDENT) (_loc : Gram.Loc.t) -> - (Ast.PaId (_loc, (Ast.IdLid (_loc, s))) : - 'ipatt)))); - ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ","; - Gram.Snterm - (Gram.Entry.obj - (comma_ipatt : 'comma_ipatt Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (pl : 'comma_ipatt) _ (p : 'ipatt) _ - (_loc : Gram.Loc.t) -> - (Ast.PaTup (_loc, (Ast.PaCom (_loc, p, pl))) : - 'ipatt)))); - ([ Gram.Skeyword "("; Gram.Sself; - Gram.Skeyword "as"; Gram.Sself; Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (p2 : 'ipatt) _ (p : 'ipatt) _ - (_loc : Gram.Loc.t) -> - (Ast.PaAli (_loc, p, p2) : 'ipatt)))); - ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (t : 'ctyp) _ (p : 'ipatt) _ - (_loc : Gram.Loc.t) -> - (Ast.PaTyc (_loc, p, t) : 'ipatt)))); - ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (p : 'ipatt) _ (_loc : Gram.Loc.t) -> - (p : 'ipatt)))); - ([ Gram.Skeyword "("; Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ _ (_loc : Gram.Loc.t) -> - (Ast.PaId (_loc, (Ast.IdUid (_loc, "()"))) : - 'ipatt)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.patt_tag : - 'ipatt) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("tup", _) -> true - | _ -> false), - "ANTIQUOT (\"tup\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("tup" as n)), s) -> - (Ast.PaTup (_loc, - (Ast.PaAnt (_loc, - (mk_anti ~c: "patt" n s)))) : - 'ipatt) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "pat" | "anti"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"\" | \"pat\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "pat" | "anti" as n)), s) - -> - (Ast.PaAnt (_loc, - (mk_anti ~c: "patt" n s)) : - 'ipatt) - | _ -> assert false))); - ([ Gram.Skeyword "{"; - Gram.Snterm - (Gram.Entry.obj - (label_ipatt_list : - 'label_ipatt_list Gram.Entry.t)); - Gram.Skeyword "}" ], - (Gram.Action.mk - (fun _ (pl : 'label_ipatt_list) _ - (_loc : Gram.Loc.t) -> - (Ast.PaRec (_loc, pl) : 'ipatt)))) ]) ])) - ()); - Gram.extend (labeled_ipatt : 'labeled_ipatt Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)) ], - (Gram.Action.mk - (fun (p : 'ipatt) (_loc : Gram.Loc.t) -> - (p : 'labeled_ipatt)))) ]) ])) - ()); - Gram.extend (comma_ipatt : 'comma_ipatt Gram.Entry.t) - ((fun () -> - (None, - [ (None, (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Snterm - (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)) ], - (Gram.Action.mk - (fun (p : 'ipatt) (_loc : Gram.Loc.t) -> - (p : 'comma_ipatt)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.PaAnt (_loc, - (mk_anti ~c: "patt," n s)) : - 'comma_ipatt) - | _ -> assert false))); - ([ Gram.Sself; Gram.Skeyword ","; Gram.Sself ], - (Gram.Action.mk - (fun (p2 : 'comma_ipatt) _ (p1 : 'comma_ipatt) - (_loc : Gram.Loc.t) -> - (Ast.PaCom (_loc, p1, p2) : 'comma_ipatt)))) ]) ])) - ()); - Gram.extend (label_ipatt_list : 'label_ipatt_list Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (label_ipatt : 'label_ipatt Gram.Entry.t)) ], - (Gram.Action.mk - (fun (p1 : 'label_ipatt) (_loc : Gram.Loc.t) -> - (p1 : 'label_ipatt_list)))); - ([ Gram.Snterm - (Gram.Entry.obj - (label_ipatt : 'label_ipatt Gram.Entry.t)); - Gram.Skeyword ";" ], - (Gram.Action.mk - (fun _ (p1 : 'label_ipatt) (_loc : Gram.Loc.t) - -> (p1 : 'label_ipatt_list)))); - ([ Gram.Snterm - (Gram.Entry.obj - (label_ipatt : 'label_ipatt Gram.Entry.t)); - Gram.Skeyword ";"; Gram.Sself ], - (Gram.Action.mk - (fun (p2 : 'label_ipatt_list) _ - (p1 : 'label_ipatt) (_loc : Gram.Loc.t) -> - (Ast.PaSem (_loc, p1, p2) : - 'label_ipatt_list)))) ]) ])) - ()); - Gram.extend (label_ipatt : 'label_ipatt Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (label_longident : - 'label_longident Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)) ], - (Gram.Action.mk - (fun (p : 'ipatt) _ (i : 'label_longident) - (_loc : Gram.Loc.t) -> - (Ast.PaEq (_loc, i, p) : 'label_ipatt)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.patt_tag : - 'label_ipatt) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.PaAnt (_loc, - (mk_anti ~c: "patt;" n s)) : - 'label_ipatt) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "pat" | "anti"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"\" | \"pat\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "pat" | "anti" as n)), s) - -> - (Ast.PaAnt (_loc, - (mk_anti ~c: "patt" n s)) : - 'label_ipatt) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (type_declaration : 'type_declaration Gram.Entry.t) - ((fun () -> - (None, - [ (None, (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Snterm - (Gram.Entry.obj - (type_ident_and_parameters : - 'type_ident_and_parameters Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_eq_ctyp : 'opt_eq_ctyp Gram.Entry.t)); - Gram.Slist0 - (Gram.Snterm - (Gram.Entry.obj - (constrain : 'constrain Gram.Entry.t))) ], - (Gram.Action.mk - (fun (cl : 'constrain list) (tk : 'opt_eq_ctyp) - ((n, tpl) : 'type_ident_and_parameters) - (_loc : Gram.Loc.t) -> - (Ast.TyDcl (_loc, n, tpl, tk, cl) : - 'type_declaration)))); - ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], - (Gram.Action.mk - (fun (t2 : 'type_declaration) _ - (t1 : 'type_declaration) (_loc : Gram.Loc.t) - -> - (Ast.TyAnd (_loc, t1, t2) : - 'type_declaration)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.ctyp_tag : - 'type_declaration) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctypand" n s)) : - 'type_declaration) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "typ" | "anti"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"\" | \"typ\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "typ" | "anti" as n)), s) - -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp" n s)) : - 'type_declaration) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (constrain : 'constrain Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Skeyword "constraint"; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ - (_loc : Gram.Loc.t) -> - ((t1, t2) : 'constrain)))) ]) ])) - ()); - Gram.extend (opt_eq_ctyp : 'opt_eq_ctyp Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.TyNil _loc : 'opt_eq_ctyp)))); - ([ Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj - (type_kind : 'type_kind Gram.Entry.t)) ], - (Gram.Action.mk - (fun (tk : 'type_kind) _ (_loc : Gram.Loc.t) -> - (tk : 'opt_eq_ctyp)))) ]) ])) - ()); - Gram.extend (type_kind : 'type_kind Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'ctyp) (_loc : Gram.Loc.t) -> - (t : 'type_kind)))) ]) ])) - ()); - Gram.extend - (type_ident_and_parameters : - 'type_ident_and_parameters Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Slist0 - (Gram.Snterm - (Gram.Entry.obj - (type_parameter : - 'type_parameter Gram.Entry.t))) ], - (Gram.Action.mk - (fun (tpl : 'type_parameter list) - (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> - ((i, tpl) : 'type_ident_and_parameters)))) ]) ])) - ()); - Gram.extend - (type_longident_and_parameters : - 'type_longident_and_parameters Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (type_longident : - 'type_longident Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (type_parameters : - 'type_parameters Gram.Entry.t)) ], - (Gram.Action.mk - (fun (tpl : 'type_parameters) - (i : 'type_longident) (_loc : Gram.Loc.t) -> - (tpl (Ast.TyId (_loc, i)) : - 'type_longident_and_parameters)))) ]) ])) - ()); - Gram.extend (type_parameters : 'type_parameters Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (fun t -> t : 'type_parameters)))); - ([ Gram.Snterm - (Gram.Entry.obj - (type_parameter : - 'type_parameter Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'type_parameter) (_loc : Gram.Loc.t) - -> - (fun acc -> Ast.TyApp (_loc, acc, t) : - 'type_parameters)))); - ([ Gram.Snterm - (Gram.Entry.obj - (type_parameter : - 'type_parameter Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (t2 : 'type_parameters) - (t1 : 'type_parameter) (_loc : Gram.Loc.t) -> - (fun acc -> t2 (Ast.TyApp (_loc, acc, t1)) : - 'type_parameters)))) ]) ])) - ()); - Gram.extend (type_parameter : 'type_parameter Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Skeyword "-"; Gram.Skeyword "'"; - Gram.Snterm - (Gram.Entry.obj - (a_ident : 'a_ident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_ident) _ _ (_loc : Gram.Loc.t) -> - (Ast.TyQuM (_loc, i) : 'type_parameter)))); - ([ Gram.Skeyword "+"; Gram.Skeyword "'"; - Gram.Snterm - (Gram.Entry.obj - (a_ident : 'a_ident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_ident) _ _ (_loc : Gram.Loc.t) -> - (Ast.TyQuP (_loc, i) : 'type_parameter)))); - ([ Gram.Skeyword "'"; - Gram.Snterm - (Gram.Entry.obj - (a_ident : 'a_ident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_ident) _ (_loc : Gram.Loc.t) -> - (Ast.TyQuo (_loc, i) : 'type_parameter)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.ctyp_tag : - 'type_parameter) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "typ" | "anti"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"\" | \"typ\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "typ" | "anti" as n)), s) - -> - (Ast.TyAnt (_loc, (mk_anti n s)) : - 'type_parameter) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (ctyp : 'ctyp Gram.Entry.t) - ((fun () -> - (None, - [ ((Some "=="), (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Sself; Gram.Skeyword "=="; Gram.Sself ], - (Gram.Action.mk - (fun (t2 : 'ctyp) _ (t1 : 'ctyp) - (_loc : Gram.Loc.t) -> - (Ast.TyMan (_loc, t1, t2) : 'ctyp)))) ]); - ((Some "private"), (Some Camlp4.Sig.Grammar.NonA), - [ ([ Gram.Skeyword "private"; - Gram.Snterml - ((Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)), - "alias") ], - (Gram.Action.mk - (fun (t : 'ctyp) _ (_loc : Gram.Loc.t) -> - (Ast.TyPrv (_loc, t) : 'ctyp)))) ]); - ((Some "alias"), (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Sself; Gram.Skeyword "as"; Gram.Sself ], - (Gram.Action.mk - (fun (t2 : 'ctyp) _ (t1 : 'ctyp) - (_loc : Gram.Loc.t) -> - (Ast.TyAli (_loc, t1, t2) : 'ctyp)))) ]); - ((Some "forall"), (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Skeyword "!"; - Gram.Snterm - (Gram.Entry.obj - (typevars : 'typevars Gram.Entry.t)); - Gram.Skeyword "."; Gram.Sself ], - (Gram.Action.mk - (fun (t2 : 'ctyp) _ (t1 : 'typevars) _ - (_loc : Gram.Loc.t) -> - (Ast.TyPol (_loc, t1, t2) : 'ctyp)))) ]); - ((Some "arrow"), (Some Camlp4.Sig.Grammar.RightA), - [ ([ Gram.Sself; Gram.Skeyword "->"; Gram.Sself ], - (Gram.Action.mk - (fun (t2 : 'ctyp) _ (t1 : 'ctyp) - (_loc : Gram.Loc.t) -> - (Ast.TyArr (_loc, t1, t2) : 'ctyp)))) ]); - ((Some "label"), (Some Camlp4.Sig.Grammar.NonA), - [ ([ Gram.Snterm - (Gram.Entry.obj - (a_OPTLABEL : 'a_OPTLABEL Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (t : 'ctyp) (i : 'a_OPTLABEL) - (_loc : Gram.Loc.t) -> - (Ast.TyOlb (_loc, i, t) : 'ctyp)))); - ([ Gram.Skeyword "?"; - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Skeyword ":"; Gram.Sself ], - (Gram.Action.mk - (fun (t : 'ctyp) _ (i : 'a_LIDENT) _ - (_loc : Gram.Loc.t) -> - (Ast.TyOlb (_loc, i, t) : 'ctyp)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_LABEL : 'a_LABEL Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (t : 'ctyp) (i : 'a_LABEL) - (_loc : Gram.Loc.t) -> - (Ast.TyLab (_loc, i, t) : 'ctyp)))); - ([ Gram.Skeyword "~"; - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Skeyword ":"; Gram.Sself ], - (Gram.Action.mk - (fun (t : 'ctyp) _ (i : 'a_LIDENT) _ - (_loc : Gram.Loc.t) -> - (Ast.TyLab (_loc, i, t) : 'ctyp)))) ]); - ((Some "apply"), (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Sself; Gram.Sself ], - (Gram.Action.mk - (fun (t2 : 'ctyp) (t1 : 'ctyp) - (_loc : Gram.Loc.t) -> - (let t = Ast.TyApp (_loc, t1, t2) - in - try Ast.TyId (_loc, (Ast.ident_of_ctyp t)) - with | Invalid_argument _ -> t : - 'ctyp)))) ]); - ((Some "."), (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Sself; Gram.Skeyword "."; Gram.Sself ], - (Gram.Action.mk - (fun (t2 : 'ctyp) _ (t1 : 'ctyp) - (_loc : Gram.Loc.t) -> - (try - Ast.TyId (_loc, - (Ast.IdAcc (_loc, - (Ast.ident_of_ctyp t1), - (Ast.ident_of_ctyp t2)))) - with - | Invalid_argument s -> - raise (Stream.Error s) : - 'ctyp)))) ]); - ((Some "simple"), None, - [ ([ Gram.Skeyword "("; Gram.Skeyword "module"; - Gram.Snterm - (Gram.Entry.obj - (package_type : 'package_type Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (p : 'package_type) _ _ - (_loc : Gram.Loc.t) -> - (Ast.TyPkg (_loc, p) : 'ctyp)))); - ([ Gram.Skeyword "<"; - Gram.Snterm - (Gram.Entry.obj - (opt_meth_list : - 'opt_meth_list Gram.Entry.t)); - Gram.Skeyword ">" ], - (Gram.Action.mk - (fun _ (t : 'opt_meth_list) _ - (_loc : Gram.Loc.t) -> (t : 'ctyp)))); - ([ Gram.Skeyword "#"; - Gram.Snterm - (Gram.Entry.obj - (class_longident : - 'class_longident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'class_longident) _ - (_loc : Gram.Loc.t) -> - (Ast.TyCls (_loc, i) : 'ctyp)))); - ([ Gram.Skeyword "{"; - Gram.Snterm - (Gram.Entry.obj - (label_declaration_list : - 'label_declaration_list Gram.Entry.t)); - Gram.Skeyword "}" ], - (Gram.Action.mk - (fun _ (t : 'label_declaration_list) _ - (_loc : Gram.Loc.t) -> - (Ast.TyRec (_loc, t) : 'ctyp)))); - ([ Gram.Skeyword "[<"; - Gram.Snterm - (Gram.Entry.obj - (row_field : 'row_field Gram.Entry.t)); - Gram.Skeyword ">"; - Gram.Snterm - (Gram.Entry.obj - (name_tags : 'name_tags Gram.Entry.t)); - Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ (ntl : 'name_tags) _ (rfl : 'row_field) _ - (_loc : Gram.Loc.t) -> - (Ast.TyVrnInfSup (_loc, rfl, ntl) : 'ctyp)))); - ([ Gram.Skeyword "[<"; - Gram.Snterm - (Gram.Entry.obj - (row_field : 'row_field Gram.Entry.t)); - Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ (rfl : 'row_field) _ (_loc : Gram.Loc.t) - -> (Ast.TyVrnInf (_loc, rfl) : 'ctyp)))); - ([ Gram.Skeyword "["; Gram.Skeyword "<"; - Gram.Snterm - (Gram.Entry.obj - (row_field : 'row_field Gram.Entry.t)); - Gram.Skeyword ">"; - Gram.Snterm - (Gram.Entry.obj - (name_tags : 'name_tags Gram.Entry.t)); - Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ (ntl : 'name_tags) _ (rfl : 'row_field) _ - _ (_loc : Gram.Loc.t) -> - (Ast.TyVrnInfSup (_loc, rfl, ntl) : 'ctyp)))); - ([ Gram.Skeyword "["; Gram.Skeyword "<"; - Gram.Snterm - (Gram.Entry.obj - (row_field : 'row_field Gram.Entry.t)); - Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ (rfl : 'row_field) _ _ - (_loc : Gram.Loc.t) -> - (Ast.TyVrnInf (_loc, rfl) : 'ctyp)))); - ([ Gram.Skeyword "["; Gram.Skeyword ">"; - Gram.Snterm - (Gram.Entry.obj - (row_field : 'row_field Gram.Entry.t)); - Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ (rfl : 'row_field) _ _ - (_loc : Gram.Loc.t) -> - (Ast.TyVrnSup (_loc, rfl) : 'ctyp)))); - ([ Gram.Skeyword "["; Gram.Skeyword ">"; - Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ _ _ (_loc : Gram.Loc.t) -> - (Ast.TyVrnSup (_loc, (Ast.TyNil _loc)) : - 'ctyp)))); - ([ Gram.Skeyword "["; Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj - (row_field : 'row_field Gram.Entry.t)); - Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ (rfl : 'row_field) _ _ - (_loc : Gram.Loc.t) -> - (Ast.TyVrnEq (_loc, rfl) : 'ctyp)))); - ([ Gram.Skeyword "["; - Gram.Snterm - (Gram.Entry.obj - (constructor_declarations : - 'constructor_declarations Gram.Entry.t)); - Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ (t : 'constructor_declarations) _ - (_loc : Gram.Loc.t) -> - (Ast.TySum (_loc, t) : 'ctyp)))); - ([ Gram.Skeyword "["; Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ _ (_loc : Gram.Loc.t) -> - (Ast.TySum (_loc, (Ast.TyNil _loc)) : 'ctyp)))); - ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (t : 'ctyp) _ (_loc : Gram.Loc.t) -> - (t : 'ctyp)))); - ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword "*"; - Gram.Snterm - (Gram.Entry.obj - (star_ctyp : 'star_ctyp Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (tl : 'star_ctyp) _ (t : 'ctyp) _ - (_loc : Gram.Loc.t) -> - (Ast.TyTup (_loc, (Ast.TySta (_loc, t, tl))) : - 'ctyp)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_UIDENT) (_loc : Gram.Loc.t) -> - (Ast.TyId (_loc, (Ast.IdUid (_loc, i))) : - 'ctyp)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> - (Ast.TyId (_loc, (Ast.IdLid (_loc, i))) : - 'ctyp)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.ctyp_tag : - 'ctyp) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("id", _) -> true - | _ -> false), - "ANTIQUOT (\"id\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("id" as n)), s) -> - (Ast.TyId (_loc, - (Ast.IdAnt (_loc, - (mk_anti ~c: "ident" n s)))) : - 'ctyp) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("tup", _) -> true - | _ -> false), - "ANTIQUOT (\"tup\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("tup" as n)), s) -> - (Ast.TyTup (_loc, - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp" n s)))) : - 'ctyp) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "typ" | "anti"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"\" | \"typ\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "typ" | "anti" as n)), s) - -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp" n s)) : - 'ctyp) - | _ -> assert false))); - ([ Gram.Skeyword "_" ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> - (Ast.TyAny _loc : 'ctyp)))); - ([ Gram.Skeyword "'"; - Gram.Snterm - (Gram.Entry.obj - (a_ident : 'a_ident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_ident) _ (_loc : Gram.Loc.t) -> - (Ast.TyQuo (_loc, i) : 'ctyp)))) ]) ])) - ()); - Gram.extend (star_ctyp : 'star_ctyp Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'ctyp) (_loc : Gram.Loc.t) -> - (t : 'star_ctyp)))); - ([ Gram.Sself; Gram.Skeyword "*"; Gram.Sself ], - (Gram.Action.mk - (fun (t2 : 'star_ctyp) _ (t1 : 'star_ctyp) - (_loc : Gram.Loc.t) -> - (Ast.TySta (_loc, t1, t2) : 'star_ctyp)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp*" n s)) : - 'star_ctyp) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "typ"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"typ\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "typ" as n)), s) -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp" n s)) : - 'star_ctyp) - | _ -> assert false))) ]) ])) - ()); - Gram.extend - (constructor_declarations : - 'constructor_declarations Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_UIDENT) (_loc : Gram.Loc.t) -> - (Ast.TyId (_loc, (Ast.IdUid (_loc, s))) : - 'constructor_declarations)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Skeyword "of"; - Gram.Snterm - (Gram.Entry.obj - (constructor_arg_list : - 'constructor_arg_list Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'constructor_arg_list) _ - (s : 'a_UIDENT) (_loc : Gram.Loc.t) -> - (Ast.TyOf (_loc, - (Ast.TyId (_loc, (Ast.IdUid (_loc, s)))), - t) : - 'constructor_declarations)))); - ([ Gram.Sself; Gram.Skeyword "|"; Gram.Sself ], - (Gram.Action.mk - (fun (t2 : 'constructor_declarations) _ - (t1 : 'constructor_declarations) - (_loc : Gram.Loc.t) -> - (Ast.TyOr (_loc, t1, t2) : - 'constructor_declarations)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.ctyp_tag : - 'constructor_declarations) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp|" n s)) : - 'constructor_declarations) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "typ"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"typ\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "typ" as n)), s) -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp" n s)) : - 'constructor_declarations) - | _ -> assert false))) ]) ])) - ()); - Gram.extend - (constructor_declaration : - 'constructor_declaration Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (s : 'a_UIDENT) (_loc : Gram.Loc.t) -> - (Ast.TyId (_loc, (Ast.IdUid (_loc, s))) : - 'constructor_declaration)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Skeyword "of"; - Gram.Snterm - (Gram.Entry.obj - (constructor_arg_list : - 'constructor_arg_list Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'constructor_arg_list) _ - (s : 'a_UIDENT) (_loc : Gram.Loc.t) -> - (Ast.TyOf (_loc, - (Ast.TyId (_loc, (Ast.IdUid (_loc, s)))), - t) : - 'constructor_declaration)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.ctyp_tag : - 'constructor_declaration) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "typ"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"typ\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "typ" as n)), s) -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp" n s)) : - 'constructor_declaration) - | _ -> assert false))) ]) ])) - ()); - Gram.extend - (constructor_arg_list : 'constructor_arg_list Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'ctyp) (_loc : Gram.Loc.t) -> - (t : 'constructor_arg_list)))); - ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], - (Gram.Action.mk - (fun (t2 : 'constructor_arg_list) _ - (t1 : 'constructor_arg_list) - (_loc : Gram.Loc.t) -> - (Ast.TyAnd (_loc, t1, t2) : - 'constructor_arg_list)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctypand" n s)) : - 'constructor_arg_list) - | _ -> assert false))) ]) ])) - ()); - Gram.extend - (label_declaration_list : - 'label_declaration_list Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (label_declaration : - 'label_declaration Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t1 : 'label_declaration) - (_loc : Gram.Loc.t) -> - (t1 : 'label_declaration_list)))); - ([ Gram.Snterm - (Gram.Entry.obj - (label_declaration : - 'label_declaration Gram.Entry.t)); - Gram.Skeyword ";" ], - (Gram.Action.mk - (fun _ (t1 : 'label_declaration) - (_loc : Gram.Loc.t) -> - (t1 : 'label_declaration_list)))); - ([ Gram.Snterm - (Gram.Entry.obj - (label_declaration : - 'label_declaration Gram.Entry.t)); - Gram.Skeyword ";"; Gram.Sself ], - (Gram.Action.mk - (fun (t2 : 'label_declaration_list) _ - (t1 : 'label_declaration) (_loc : Gram.Loc.t) - -> - (Ast.TySem (_loc, t1, t2) : - 'label_declaration_list)))) ]) ])) - ()); - Gram.extend - (label_declaration : 'label_declaration Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Skeyword ":"; Gram.Skeyword "mutable"; - Gram.Snterm - (Gram.Entry.obj - (poly_type : 'poly_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'poly_type) _ _ (s : 'a_LIDENT) - (_loc : Gram.Loc.t) -> - (Ast.TyCol (_loc, - (Ast.TyId (_loc, (Ast.IdLid (_loc, s)))), - (Ast.TyMut (_loc, t))) : - 'label_declaration)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (poly_type : 'poly_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'poly_type) _ (s : 'a_LIDENT) - (_loc : Gram.Loc.t) -> - (Ast.TyCol (_loc, - (Ast.TyId (_loc, (Ast.IdLid (_loc, s)))), - t) : - 'label_declaration)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.ctyp_tag : - 'label_declaration) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp;" n s)) : - 'label_declaration) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "typ"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"typ\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "typ" as n)), s) -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp" n s)) : - 'label_declaration) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (a_ident : 'a_ident Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_UIDENT) (_loc : Gram.Loc.t) -> - (i : 'a_ident)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> - (i : 'a_ident)))) ]) ])) - ()); - Gram.extend (ident : 'ident Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Skeyword "."; Gram.Sself ], - (Gram.Action.mk - (fun (j : 'ident) _ (i : 'a_UIDENT) - (_loc : Gram.Loc.t) -> - (Ast.IdAcc (_loc, (Ast.IdUid (_loc, i)), j) : - 'ident)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "id" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")); - Gram.Skeyword "."; Gram.Sself ], - (Gram.Action.mk - (fun (i : 'ident) _ (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "id" | "anti" | "list" as n)), s) - -> - (Ast.IdAcc (_loc, - (Ast.IdAnt (_loc, - (mk_anti ~c: "ident" n s))), - i) : - 'ident) - | _ -> assert false))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> - (Ast.IdLid (_loc, i) : 'ident)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_UIDENT) (_loc : Gram.Loc.t) -> - (Ast.IdUid (_loc, i) : 'ident)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "id" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "id" | "anti" | "list" as n)), s) - -> - (Ast.IdAnt (_loc, - (mk_anti ~c: "ident" n s)) : - 'ident) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (module_longident : 'module_longident Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_UIDENT) (_loc : Gram.Loc.t) -> - (Ast.IdUid (_loc, i) : 'module_longident)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Skeyword "."; Gram.Sself ], - (Gram.Action.mk - (fun (l : 'module_longident) _ (m : 'a_UIDENT) - (_loc : Gram.Loc.t) -> - (Ast.IdAcc (_loc, (Ast.IdUid (_loc, m)), l) : - 'module_longident)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "id" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "id" | "anti" | "list" as n)), s) - -> - (Ast.IdAnt (_loc, - (mk_anti ~c: "ident" n s)) : - 'module_longident) - | _ -> assert false))) ]) ])) - ()); - Gram.extend - (module_longident_with_app : - 'module_longident_with_app Gram.Entry.t) - ((fun () -> - (None, - [ ((Some "apply"), None, - [ ([ Gram.Sself; Gram.Sself ], - (Gram.Action.mk - (fun (j : 'module_longident_with_app) - (i : 'module_longident_with_app) - (_loc : Gram.Loc.t) -> - (Ast.IdApp (_loc, i, j) : - 'module_longident_with_app)))) ]); - ((Some "."), None, - [ ([ Gram.Sself; Gram.Skeyword "."; Gram.Sself ], - (Gram.Action.mk - (fun (j : 'module_longident_with_app) _ - (i : 'module_longident_with_app) - (_loc : Gram.Loc.t) -> - (Ast.IdAcc (_loc, i, j) : - 'module_longident_with_app)))) ]); - ((Some "simple"), None, - [ ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (i : 'module_longident_with_app) _ - (_loc : Gram.Loc.t) -> - (i : 'module_longident_with_app)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_UIDENT) (_loc : Gram.Loc.t) -> - (Ast.IdUid (_loc, i) : - 'module_longident_with_app)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "id" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "id" | "anti" | "list" as n)), s) - -> - (Ast.IdAnt (_loc, - (mk_anti ~c: "ident" n s)) : - 'module_longident_with_app) - | _ -> assert false))) ]) ])) - ()); - Gram.extend - (module_longident_dot_lparen : - 'module_longident_dot_lparen Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Skeyword "."; Gram.Skeyword "(" ], - (Gram.Action.mk - (fun _ _ (i : 'a_UIDENT) (_loc : Gram.Loc.t) -> - (Ast.IdUid (_loc, i) : - 'module_longident_dot_lparen)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Skeyword "."; Gram.Sself ], - (Gram.Action.mk - (fun (l : 'module_longident_dot_lparen) _ - (m : 'a_UIDENT) (_loc : Gram.Loc.t) -> - (Ast.IdAcc (_loc, (Ast.IdUid (_loc, m)), l) : - 'module_longident_dot_lparen)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "id" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")); - Gram.Skeyword "."; Gram.Skeyword "(" ], - (Gram.Action.mk - (fun _ _ (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "id" | "anti" | "list" as n)), s) - -> - (Ast.IdAnt (_loc, - (mk_anti ~c: "ident" n s)) : - 'module_longident_dot_lparen) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (type_longident : 'type_longident Gram.Entry.t) - ((fun () -> - (None, - [ ((Some "apply"), None, - [ ([ Gram.Sself; Gram.Sself ], - (Gram.Action.mk - (fun (j : 'type_longident) (i : 'type_longident) - (_loc : Gram.Loc.t) -> - (Ast.IdApp (_loc, i, j) : 'type_longident)))) ]); - ((Some "."), None, - [ ([ Gram.Sself; Gram.Skeyword "."; Gram.Sself ], - (Gram.Action.mk - (fun (j : 'type_longident) _ - (i : 'type_longident) (_loc : Gram.Loc.t) -> - (Ast.IdAcc (_loc, i, j) : 'type_longident)))) ]); - ((Some "simple"), None, - [ ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (i : 'type_longident) _ - (_loc : Gram.Loc.t) -> (i : 'type_longident)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_UIDENT) (_loc : Gram.Loc.t) -> - (Ast.IdUid (_loc, i) : 'type_longident)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> - (Ast.IdLid (_loc, i) : 'type_longident)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "id" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "id" | "anti" | "list" as n)), s) - -> - (Ast.IdAnt (_loc, - (mk_anti ~c: "ident" n s)) : - 'type_longident) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (label_longident : 'label_longident Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> - (Ast.IdLid (_loc, i) : 'label_longident)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Skeyword "."; Gram.Sself ], - (Gram.Action.mk - (fun (l : 'label_longident) _ (m : 'a_UIDENT) - (_loc : Gram.Loc.t) -> - (Ast.IdAcc (_loc, (Ast.IdUid (_loc, m)), l) : - 'label_longident)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "id" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "id" | "anti" | "list" as n)), s) - -> - (Ast.IdAnt (_loc, - (mk_anti ~c: "ident" n s)) : - 'label_longident) - | _ -> assert false))) ]) ])) - ()); - Gram.extend - (class_type_longident : 'class_type_longident Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (type_longident : - 'type_longident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'type_longident) (_loc : Gram.Loc.t) - -> (x : 'class_type_longident)))) ]) ])) - ()); - Gram.extend (val_longident : 'val_longident Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (ident : 'ident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'ident) (_loc : Gram.Loc.t) -> - (x : 'val_longident)))) ]) ])) - ()); - Gram.extend (class_longident : 'class_longident Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (label_longident : - 'label_longident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'label_longident) (_loc : Gram.Loc.t) - -> (x : 'class_longident)))) ]) ])) - ()); - Gram.extend - (class_declaration : 'class_declaration Gram.Entry.t) - ((fun () -> - (None, - [ (None, (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Snterm - (Gram.Entry.obj - (class_info_for_class_expr : - 'class_info_for_class_expr Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (class_fun_binding : - 'class_fun_binding Gram.Entry.t)) ], - (Gram.Action.mk - (fun (ce : 'class_fun_binding) - (ci : 'class_info_for_class_expr) - (_loc : Gram.Loc.t) -> - (Ast.CeEq (_loc, ci, ce) : - 'class_declaration)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.class_expr_tag : - 'class_declaration) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "cdcl" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"cdcl\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "cdcl" | "anti" | "list" as n)), - s) -> - (Ast.CeAnt (_loc, - (mk_anti ~c: "class_expr" n s)) : - 'class_declaration) - | _ -> assert false))); - ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], - (Gram.Action.mk - (fun (c2 : 'class_declaration) _ - (c1 : 'class_declaration) (_loc : Gram.Loc.t) - -> - (Ast.CeAnd (_loc, c1, c2) : - 'class_declaration)))) ]) ])) - ()); - Gram.extend - (class_fun_binding : 'class_fun_binding Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (labeled_ipatt : - 'labeled_ipatt Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (cfb : 'class_fun_binding) - (p : 'labeled_ipatt) (_loc : Gram.Loc.t) -> - (Ast.CeFun (_loc, p, cfb) : - 'class_fun_binding)))); - ([ Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (class_type_plus : - 'class_type_plus Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj - (class_expr : 'class_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (ce : 'class_expr) _ - (ct : 'class_type_plus) _ (_loc : Gram.Loc.t) - -> - (Ast.CeTyc (_loc, ce, ct) : - 'class_fun_binding)))); - ([ Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj - (class_expr : 'class_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (ce : 'class_expr) _ (_loc : Gram.Loc.t) -> - (ce : 'class_fun_binding)))) ]) ])) - ()); - Gram.extend - (class_info_for_class_type : - 'class_info_for_class_type Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (opt_virtual : 'opt_virtual Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (class_name_and_param : - 'class_name_and_param Gram.Entry.t)) ], - (Gram.Action.mk - (fun ((i, ot) : 'class_name_and_param) - (mv : 'opt_virtual) (_loc : Gram.Loc.t) -> - (Ast.CtCon (_loc, mv, (Ast.IdLid (_loc, i)), - ot) : - 'class_info_for_class_type)))) ]) ])) - ()); - Gram.extend - (class_info_for_class_expr : - 'class_info_for_class_expr Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (opt_virtual : 'opt_virtual Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (class_name_and_param : - 'class_name_and_param Gram.Entry.t)) ], - (Gram.Action.mk - (fun ((i, ot) : 'class_name_and_param) - (mv : 'opt_virtual) (_loc : Gram.Loc.t) -> - (Ast.CeCon (_loc, mv, (Ast.IdLid (_loc, i)), - ot) : - 'class_info_for_class_expr)))) ]) ])) - ()); - Gram.extend - (class_name_and_param : 'class_name_and_param Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> - ((i, (Ast.TyNil _loc)) : - 'class_name_and_param)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Skeyword "["; - Gram.Snterm - (Gram.Entry.obj - (comma_type_parameter : - 'comma_type_parameter Gram.Entry.t)); - Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ (x : 'comma_type_parameter) _ - (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> - ((i, x) : 'class_name_and_param)))) ]) ])) - ()); - Gram.extend - (comma_type_parameter : 'comma_type_parameter Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (type_parameter : - 'type_parameter Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'type_parameter) (_loc : Gram.Loc.t) - -> (t : 'comma_type_parameter)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp," n s)) : - 'comma_type_parameter) - | _ -> assert false))); - ([ Gram.Sself; Gram.Skeyword ","; Gram.Sself ], - (Gram.Action.mk - (fun (t2 : 'comma_type_parameter) _ - (t1 : 'comma_type_parameter) - (_loc : Gram.Loc.t) -> - (Ast.TyCom (_loc, t1, t2) : - 'comma_type_parameter)))) ]) ])) - ()); - Gram.extend (opt_comma_ctyp : 'opt_comma_ctyp Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.TyNil _loc : 'opt_comma_ctyp)))); - ([ Gram.Skeyword "["; - Gram.Snterm - (Gram.Entry.obj - (comma_ctyp : 'comma_ctyp Gram.Entry.t)); - Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ (x : 'comma_ctyp) _ (_loc : Gram.Loc.t) - -> (x : 'opt_comma_ctyp)))) ]) ])) - ()); - Gram.extend (comma_ctyp : 'comma_ctyp Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'ctyp) (_loc : Gram.Loc.t) -> - (t : 'comma_ctyp)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp," n s)) : - 'comma_ctyp) - | _ -> assert false))); - ([ Gram.Sself; Gram.Skeyword ","; Gram.Sself ], - (Gram.Action.mk - (fun (t2 : 'comma_ctyp) _ (t1 : 'comma_ctyp) - (_loc : Gram.Loc.t) -> - (Ast.TyCom (_loc, t1, t2) : 'comma_ctyp)))) ]) ])) - ()); - Gram.extend (class_fun_def : 'class_fun_def Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Skeyword "->"; - Gram.Snterm - (Gram.Entry.obj - (class_expr : 'class_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (ce : 'class_expr) _ (_loc : Gram.Loc.t) -> - (ce : 'class_fun_def)))); - ([ Gram.Snterm - (Gram.Entry.obj - (labeled_ipatt : - 'labeled_ipatt Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (ce : 'class_fun_def) (p : 'labeled_ipatt) - (_loc : Gram.Loc.t) -> - (Ast.CeFun (_loc, p, ce) : 'class_fun_def)))) ]) ])) - ()); - Gram.extend (class_expr : 'class_expr Gram.Entry.t) - ((fun () -> - (None, - [ ((Some "top"), None, - [ ([ Gram.Skeyword "let"; - Gram.Snterm - (Gram.Entry.obj - (opt_rec : 'opt_rec Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (binding : 'binding Gram.Entry.t)); - Gram.Skeyword "in"; Gram.Sself ], - (Gram.Action.mk - (fun (ce : 'class_expr) _ (bi : 'binding) - (rf : 'opt_rec) _ (_loc : Gram.Loc.t) -> - (Ast.CeLet (_loc, rf, bi, ce) : 'class_expr)))); - ([ Gram.Skeyword "fun"; - Gram.Snterm - (Gram.Entry.obj - (labeled_ipatt : - 'labeled_ipatt Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (class_fun_def : - 'class_fun_def Gram.Entry.t)) ], - (Gram.Action.mk - (fun (ce : 'class_fun_def) (p : 'labeled_ipatt) - _ (_loc : Gram.Loc.t) -> - (Ast.CeFun (_loc, p, ce) : 'class_expr)))) ]); - ((Some "apply"), (Some Camlp4.Sig.Grammar.NonA), - [ ([ Gram.Sself; - Gram.Snterml - ((Gram.Entry.obj (expr : 'expr Gram.Entry.t)), - "label") ], - (Gram.Action.mk - (fun (e : 'expr) (ce : 'class_expr) - (_loc : Gram.Loc.t) -> - (Ast.CeApp (_loc, ce, e) : 'class_expr)))) ]); - ((Some "simple"), None, - [ ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (ce : 'class_expr) _ (_loc : Gram.Loc.t) - -> (ce : 'class_expr)))); - ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (class_type : 'class_type Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (ct : 'class_type) _ (ce : 'class_expr) _ - (_loc : Gram.Loc.t) -> - (Ast.CeTyc (_loc, ce, ct) : 'class_expr)))); - ([ Gram.Skeyword "object"; - Gram.Snterm - (Gram.Entry.obj - (opt_class_self_patt : - 'opt_class_self_patt Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (class_structure : - 'class_structure Gram.Entry.t)); - Gram.Skeyword "end" ], - (Gram.Action.mk - (fun _ (cst : 'class_structure) - (csp : 'opt_class_self_patt) _ - (_loc : Gram.Loc.t) -> - (Ast.CeStr (_loc, csp, cst) : 'class_expr)))); - ([ Gram.Snterm - (Gram.Entry.obj - (class_longident_and_param : - 'class_longident_and_param Gram.Entry.t)) ], - (Gram.Action.mk - (fun (ce : 'class_longident_and_param) - (_loc : Gram.Loc.t) -> (ce : 'class_expr)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.class_expr_tag : - 'class_expr) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "cexp" | "anti"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"\" | \"cexp\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "cexp" | "anti" as n)), s) - -> - (Ast.CeAnt (_loc, - (mk_anti ~c: "class_expr" n s)) : - 'class_expr) - | _ -> assert false))) ]) ])) - ()); - Gram.extend - (class_longident_and_param : - 'class_longident_and_param Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (class_longident : - 'class_longident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (ci : 'class_longident) (_loc : Gram.Loc.t) - -> - (Ast.CeCon (_loc, Ast.ViNil, ci, - (Ast.TyNil _loc)) : - 'class_longident_and_param)))); - ([ Gram.Snterm - (Gram.Entry.obj - (class_longident : - 'class_longident Gram.Entry.t)); - Gram.Skeyword "["; - Gram.Snterm - (Gram.Entry.obj - (comma_ctyp : 'comma_ctyp Gram.Entry.t)); - Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ (t : 'comma_ctyp) _ - (ci : 'class_longident) (_loc : Gram.Loc.t) - -> - (Ast.CeCon (_loc, Ast.ViNil, ci, t) : - 'class_longident_and_param)))) ]) ])) - ()); - Gram.extend (class_structure : 'class_structure Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Slist0 - (Gram.srules class_structure - [ ([ Gram.Snterm - (Gram.Entry.obj - (class_str_item : - 'class_str_item Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (semi : 'semi Gram.Entry.t)) ], - (Gram.Action.mk - (fun _ (cst : 'class_str_item) - (_loc : Gram.Loc.t) -> - (cst : 'e__10)))) ]) ], - (Gram.Action.mk - (fun (l : 'e__10 list) (_loc : Gram.Loc.t) -> - (Ast.crSem_of_list l : 'class_structure)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "cst" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"cst\" | \"anti\" | \"list\"), _)")); - Gram.Snterm - (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (cst : 'class_structure) _ - (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "cst" | "anti" | "list" as n)), - s) -> - (Ast.CrSem (_loc, - (Ast.CrAnt (_loc, - (mk_anti ~c: "class_str_item" n s))), - cst) : - 'class_structure) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "cst" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"cst\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "cst" | "anti" | "list" as n)), - s) -> - (Ast.CrAnt (_loc, - (mk_anti ~c: "class_str_item" n s)) : - 'class_structure) - | _ -> assert false))) ]) ])) - ()); - Gram.extend - (opt_class_self_patt : 'opt_class_self_patt Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.PaNil _loc : 'opt_class_self_patt)))); - ([ Gram.Skeyword "("; - Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (t : 'ctyp) _ (p : 'patt) _ - (_loc : Gram.Loc.t) -> - (Ast.PaTyc (_loc, p, t) : - 'opt_class_self_patt)))); - ([ Gram.Skeyword "("; - Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (p : 'patt) _ (_loc : Gram.Loc.t) -> - (p : 'opt_class_self_patt)))) ]) ])) - ()); - Gram.extend (class_str_item : 'class_str_item Gram.Entry.t) - ((fun () -> - (None, - [ (None, (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Skeyword "initializer"; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (se : 'expr) _ (_loc : Gram.Loc.t) -> - (Ast.CrIni (_loc, se) : 'class_str_item)))); - ([ Gram.Snterm - (Gram.Entry.obj - (type_constraint : - 'type_constraint Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ - (_loc : Gram.Loc.t) -> - (Ast.CrCtr (_loc, t1, t2) : 'class_str_item)))); - ([ Gram.Snterm - (Gram.Entry.obj - (method_opt_override : - 'method_opt_override Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_private : 'opt_private Gram.Entry.t)); - Gram.Skeyword "virtual"; - Gram.Snterm - (Gram.Entry.obj (label : 'label Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (poly_type : 'poly_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'poly_type) _ (l : 'label) _ - (pf : 'opt_private) - (o : 'method_opt_override) - (_loc : Gram.Loc.t) -> - (if o <> Ast.OvNil - then - raise - (Stream.Error - "override (!) is incompatible with virtual") - else Ast.CrVir (_loc, l, pf, t) : - 'class_str_item)))); - ([ Gram.Snterm - (Gram.Entry.obj - (method_opt_override : - 'method_opt_override Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_private : 'opt_private Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (label : 'label Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_polyt : 'opt_polyt Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (fun_binding : 'fun_binding Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'fun_binding) (topt : 'opt_polyt) - (l : 'label) (pf : 'opt_private) - (o : 'method_opt_override) - (_loc : Gram.Loc.t) -> - (Ast.CrMth (_loc, l, o, pf, e, topt) : - 'class_str_item)))); - ([ Gram.Snterm - (Gram.Entry.obj - (method_opt_override : - 'method_opt_override Gram.Entry.t)); - Gram.Skeyword "virtual"; - Gram.Snterm - (Gram.Entry.obj - (opt_private : 'opt_private Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (label : 'label Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (poly_type : 'poly_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'poly_type) _ (l : 'label) - (pf : 'opt_private) _ - (o : 'method_opt_override) - (_loc : Gram.Loc.t) -> - (if o <> Ast.OvNil - then - raise - (Stream.Error - "override (!) is incompatible with virtual") - else Ast.CrVir (_loc, l, pf, t) : - 'class_str_item)))); - ([ Gram.Snterm - (Gram.Entry.obj - (value_val_opt_override : - 'value_val_opt_override Gram.Entry.t)); - Gram.Skeyword "virtual"; - Gram.Snterm - (Gram.Entry.obj - (opt_mutable : 'opt_mutable Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (label : 'label Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (poly_type : 'poly_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'poly_type) _ (l : 'label) - (mf : 'opt_mutable) _ - (o : 'value_val_opt_override) - (_loc : Gram.Loc.t) -> - (if o <> Ast.OvNil - then - raise - (Stream.Error - "override (!) is incompatible with virtual") - else Ast.CrVvr (_loc, l, mf, t) : - 'class_str_item)))); - ([ Gram.Snterm - (Gram.Entry.obj - (value_val_opt_override : - 'value_val_opt_override Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_mutable : 'opt_mutable Gram.Entry.t)); - Gram.Skeyword "virtual"; - Gram.Snterm - (Gram.Entry.obj (label : 'label Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (poly_type : 'poly_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'poly_type) _ (l : 'label) _ - (mf : 'opt_mutable) - (o : 'value_val_opt_override) - (_loc : Gram.Loc.t) -> - (if o <> Ast.OvNil - then - raise - (Stream.Error - "override (!) is incompatible with virtual") - else Ast.CrVvr (_loc, l, mf, t) : - 'class_str_item)))); - ([ Gram.Snterm - (Gram.Entry.obj - (value_val_opt_override : - 'value_val_opt_override Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_mutable : 'opt_mutable Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (label : 'label Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (cvalue_binding : - 'cvalue_binding Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'cvalue_binding) (lab : 'label) - (mf : 'opt_mutable) - (o : 'value_val_opt_override) - (_loc : Gram.Loc.t) -> - (Ast.CrVal (_loc, lab, o, mf, e) : - 'class_str_item)))); - ([ Gram.Skeyword "inherit"; - Gram.Snterm - (Gram.Entry.obj - (opt_override : 'opt_override Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (class_expr : 'class_expr Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_as_lident : - 'opt_as_lident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (pb : 'opt_as_lident) (ce : 'class_expr) - (o : 'opt_override) _ (_loc : Gram.Loc.t) -> - (Ast.CrInh (_loc, o, ce, pb) : - 'class_str_item)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.class_str_item_tag : - 'class_str_item) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "cst" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"cst\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "cst" | "anti" | "list" as n)), - s) -> - (Ast.CrAnt (_loc, - (mk_anti ~c: "class_str_item" n s)) : - 'class_str_item) - | _ -> assert false))) ]) ])) - ()); - Gram.extend - (method_opt_override : 'method_opt_override Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Skeyword "method" ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> - (Ast.OvNil : 'method_opt_override)))); - ([ Gram.Skeyword "method"; - Gram.Stoken - (((function - | ANTIQUOT (("!" | "override" | "anti"), _) - -> true - | _ -> false), - "ANTIQUOT ((\"!\" | \"override\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) _ - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("!" | "override" | "anti" as n)), s) - -> - (Ast.OvAnt (mk_anti n s) : - 'method_opt_override) - | _ -> assert false))); - ([ Gram.Skeyword "method"; Gram.Skeyword "!" ], - (Gram.Action.mk - (fun _ _ (_loc : Gram.Loc.t) -> - (Ast.OvOverride : 'method_opt_override)))) ]) ])) - ()); - Gram.extend - (value_val_opt_override : - 'value_val_opt_override Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (value_val : 'value_val Gram.Entry.t)) ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> - (Ast.OvNil : 'value_val_opt_override)))); - ([ Gram.Snterm - (Gram.Entry.obj - (value_val : 'value_val Gram.Entry.t)); - Gram.Stoken - (((function - | ANTIQUOT (("!" | "override" | "anti"), _) - -> true - | _ -> false), - "ANTIQUOT ((\"!\" | \"override\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) _ - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("!" | "override" | "anti" as n)), s) - -> - (Ast.OvAnt (mk_anti n s) : - 'value_val_opt_override) - | _ -> assert false))); - ([ Gram.Snterm - (Gram.Entry.obj - (value_val : 'value_val Gram.Entry.t)); - Gram.Skeyword "!" ], - (Gram.Action.mk - (fun _ _ (_loc : Gram.Loc.t) -> - (Ast.OvOverride : 'value_val_opt_override)))) ]) ])) - ()); - Gram.extend (opt_as_lident : 'opt_as_lident Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - ("" : 'opt_as_lident)))); - ([ Gram.Skeyword "as"; - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_LIDENT) _ (_loc : Gram.Loc.t) -> - (i : 'opt_as_lident)))) ]) ])) - ()); - Gram.extend (opt_polyt : 'opt_polyt Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.TyNil _loc : 'opt_polyt)))); - ([ Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (poly_type : 'poly_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'poly_type) _ (_loc : Gram.Loc.t) -> - (t : 'opt_polyt)))) ]) ])) - ()); - Gram.extend (cvalue_binding : 'cvalue_binding Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Skeyword ":>"; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) _ (t : 'ctyp) _ - (_loc : Gram.Loc.t) -> - (Ast.ExCoe (_loc, e, (Ast.TyNil _loc), t) : - 'cvalue_binding)))); - ([ Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (poly_type : 'poly_type Gram.Entry.t)); - Gram.Skeyword ":>"; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) _ (t2 : 'ctyp) _ - (t : 'poly_type) _ (_loc : Gram.Loc.t) -> - (match t with - | Ast.TyPol (_, _, _) -> - raise - (Stream.Error - "unexpected polytype here") - | _ -> Ast.ExCoe (_loc, e, t, t2) : - 'cvalue_binding)))); - ([ Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (poly_type : 'poly_type Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) _ (t : 'poly_type) _ - (_loc : Gram.Loc.t) -> - (Ast.ExTyc (_loc, e, t) : 'cvalue_binding)))); - ([ Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) _ (_loc : Gram.Loc.t) -> - (e : 'cvalue_binding)))) ]) ])) - ()); - Gram.extend (label : 'label Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> - (i : 'label)))) ]) ])) - ()); - Gram.extend (class_type : 'class_type Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Skeyword "object"; - Gram.Snterm - (Gram.Entry.obj - (opt_class_self_type : - 'opt_class_self_type Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (class_signature : - 'class_signature Gram.Entry.t)); - Gram.Skeyword "end" ], - (Gram.Action.mk - (fun _ (csg : 'class_signature) - (cst : 'opt_class_self_type) _ - (_loc : Gram.Loc.t) -> - (Ast.CtSig (_loc, cst, csg) : 'class_type)))); - ([ Gram.Snterm - (Gram.Entry.obj - (class_type_longident_and_param : - 'class_type_longident_and_param Gram. - Entry.t)) ], - (Gram.Action.mk - (fun (ct : 'class_type_longident_and_param) - (_loc : Gram.Loc.t) -> (ct : 'class_type)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.class_type_tag : - 'class_type) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "ctyp" | "anti"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"\" | \"ctyp\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "ctyp" | "anti" as n)), s) - -> - (Ast.CtAnt (_loc, - (mk_anti ~c: "class_type" n s)) : - 'class_type) - | _ -> assert false))) ]) ])) - ()); - Gram.extend - (class_type_longident_and_param : - 'class_type_longident_and_param Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (class_type_longident : - 'class_type_longident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'class_type_longident) - (_loc : Gram.Loc.t) -> - (Ast.CtCon (_loc, Ast.ViNil, i, - (Ast.TyNil _loc)) : - 'class_type_longident_and_param)))); - ([ Gram.Snterm - (Gram.Entry.obj - (class_type_longident : - 'class_type_longident Gram.Entry.t)); - Gram.Skeyword "["; - Gram.Snterm - (Gram.Entry.obj - (comma_ctyp : 'comma_ctyp Gram.Entry.t)); - Gram.Skeyword "]" ], - (Gram.Action.mk - (fun _ (t : 'comma_ctyp) _ - (i : 'class_type_longident) - (_loc : Gram.Loc.t) -> - (Ast.CtCon (_loc, Ast.ViNil, i, t) : - 'class_type_longident_and_param)))) ]) ])) - ()); - Gram.extend (class_type_plus : 'class_type_plus Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (class_type : 'class_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (ct : 'class_type) (_loc : Gram.Loc.t) -> - (ct : 'class_type_plus)))); - ([ Gram.Skeyword "["; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); - Gram.Skeyword "]"; Gram.Skeyword "->"; Gram.Sself ], - (Gram.Action.mk - (fun (ct : 'class_type_plus) _ _ (t : 'ctyp) _ - (_loc : Gram.Loc.t) -> - (Ast.CtFun (_loc, t, ct) : 'class_type_plus)))) ]) ])) - ()); - Gram.extend - (opt_class_self_type : 'opt_class_self_type Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.TyNil _loc : 'opt_class_self_type)))); - ([ Gram.Skeyword "("; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (t : 'ctyp) _ (_loc : Gram.Loc.t) -> - (t : 'opt_class_self_type)))) ]) ])) - ()); - Gram.extend (class_signature : 'class_signature Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Slist0 - (Gram.srules class_signature - [ ([ Gram.Snterm - (Gram.Entry.obj - (class_sig_item : - 'class_sig_item Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (semi : 'semi Gram.Entry.t)) ], - (Gram.Action.mk - (fun _ (csg : 'class_sig_item) - (_loc : Gram.Loc.t) -> - (csg : 'e__11)))) ]) ], - (Gram.Action.mk - (fun (l : 'e__11 list) (_loc : Gram.Loc.t) -> - (Ast.cgSem_of_list l : 'class_signature)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "csg" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"csg\" | \"anti\" | \"list\"), _)")); - Gram.Snterm - (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (csg : 'class_signature) _ - (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "csg" | "anti" | "list" as n)), - s) -> - (Ast.CgSem (_loc, - (Ast.CgAnt (_loc, - (mk_anti ~c: "class_sig_item" n s))), - csg) : - 'class_signature) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "csg" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"csg\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "csg" | "anti" | "list" as n)), - s) -> - (Ast.CgAnt (_loc, - (mk_anti ~c: "class_sig_item" n s)) : - 'class_signature) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (class_sig_item : 'class_sig_item Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (type_constraint : - 'type_constraint Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ - (_loc : Gram.Loc.t) -> - (Ast.CgCtr (_loc, t1, t2) : 'class_sig_item)))); - ([ Gram.Skeyword "method"; - Gram.Snterm - (Gram.Entry.obj - (opt_private : 'opt_private Gram.Entry.t)); - Gram.Skeyword "virtual"; - Gram.Snterm - (Gram.Entry.obj (label : 'label Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (poly_type : 'poly_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'poly_type) _ (l : 'label) _ - (pf : 'opt_private) _ (_loc : Gram.Loc.t) -> - (Ast.CgVir (_loc, l, pf, t) : - 'class_sig_item)))); - ([ Gram.Skeyword "method"; - Gram.Snterm - (Gram.Entry.obj - (opt_private : 'opt_private Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (label : 'label Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (poly_type : 'poly_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'poly_type) _ (l : 'label) - (pf : 'opt_private) _ (_loc : Gram.Loc.t) -> - (Ast.CgMth (_loc, l, pf, t) : - 'class_sig_item)))); - ([ Gram.Skeyword "method"; Gram.Skeyword "virtual"; - Gram.Snterm - (Gram.Entry.obj - (opt_private : 'opt_private Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (label : 'label Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (poly_type : 'poly_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'poly_type) _ (l : 'label) - (pf : 'opt_private) _ _ (_loc : Gram.Loc.t) - -> - (Ast.CgVir (_loc, l, pf, t) : - 'class_sig_item)))); - ([ Gram.Snterm - (Gram.Entry.obj - (value_val : 'value_val Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_mutable : 'opt_mutable Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_virtual : 'opt_virtual Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (label : 'label Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'ctyp) _ (l : 'label) - (mv : 'opt_virtual) (mf : 'opt_mutable) _ - (_loc : Gram.Loc.t) -> - (Ast.CgVal (_loc, l, mf, mv, t) : - 'class_sig_item)))); - ([ Gram.Skeyword "inherit"; - Gram.Snterm - (Gram.Entry.obj - (class_type : 'class_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (cs : 'class_type) _ (_loc : Gram.Loc.t) -> - (Ast.CgInh (_loc, cs) : 'class_sig_item)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.class_sig_item_tag : - 'class_sig_item) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "csg" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"csg\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "csg" | "anti" | "list" as n)), - s) -> - (Ast.CgAnt (_loc, - (mk_anti ~c: "class_sig_item" n s)) : - 'class_sig_item) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (type_constraint : 'type_constraint Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Skeyword "constraint" ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> - (() : 'type_constraint)))); - ([ Gram.Skeyword "type" ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> - (() : 'type_constraint)))) ]) ])) - ()); - Gram.extend - (class_description : 'class_description Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (class_info_for_class_type : - 'class_info_for_class_type Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (class_type_plus : - 'class_type_plus Gram.Entry.t)) ], - (Gram.Action.mk - (fun (ct : 'class_type_plus) _ - (ci : 'class_info_for_class_type) - (_loc : Gram.Loc.t) -> - (Ast.CtCol (_loc, ci, ct) : - 'class_description)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.class_type_tag : - 'class_description) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "typ" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"typ\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "typ" | "anti" | "list" as n)), - s) -> - (Ast.CtAnt (_loc, - (mk_anti ~c: "class_type" n s)) : - 'class_description) - | _ -> assert false))); - ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], - (Gram.Action.mk - (fun (cd2 : 'class_description) _ - (cd1 : 'class_description) - (_loc : Gram.Loc.t) -> - (Ast.CtAnd (_loc, cd1, cd2) : - 'class_description)))) ]) ])) - ()); - Gram.extend - (class_type_declaration : - 'class_type_declaration Gram.Entry.t) - ((fun () -> - (None, - [ (None, (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Snterm - (Gram.Entry.obj - (class_info_for_class_type : - 'class_info_for_class_type Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj - (class_type : 'class_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (ct : 'class_type) _ - (ci : 'class_info_for_class_type) - (_loc : Gram.Loc.t) -> - (Ast.CtEq (_loc, ci, ct) : - 'class_type_declaration)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.class_type_tag : - 'class_type_declaration) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "typ" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"typ\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "typ" | "anti" | "list" as n)), - s) -> - (Ast.CtAnt (_loc, - (mk_anti ~c: "class_type" n s)) : - 'class_type_declaration) - | _ -> assert false))); - ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], - (Gram.Action.mk - (fun (cd2 : 'class_type_declaration) _ - (cd1 : 'class_type_declaration) - (_loc : Gram.Loc.t) -> - (Ast.CtAnd (_loc, cd1, cd2) : - 'class_type_declaration)))) ]) ])) - ()); - Gram.extend (field_expr_list : 'field_expr_list Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (field_expr : 'field_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (b1 : 'field_expr) (_loc : Gram.Loc.t) -> - (b1 : 'field_expr_list)))); - ([ Gram.Snterm - (Gram.Entry.obj - (field_expr : 'field_expr Gram.Entry.t)); - Gram.Skeyword ";" ], - (Gram.Action.mk - (fun _ (b1 : 'field_expr) (_loc : Gram.Loc.t) -> - (b1 : 'field_expr_list)))); - ([ Gram.Snterm - (Gram.Entry.obj - (field_expr : 'field_expr Gram.Entry.t)); - Gram.Skeyword ";"; Gram.Sself ], - (Gram.Action.mk - (fun (b2 : 'field_expr_list) _ - (b1 : 'field_expr) (_loc : Gram.Loc.t) -> - (Ast.RbSem (_loc, b1, b2) : 'field_expr_list)))) ]) ])) - ()); - Gram.extend (field_expr : 'field_expr Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (label : 'label Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) _ (l : 'label) - (_loc : Gram.Loc.t) -> - (Ast.RbEq (_loc, (Ast.IdLid (_loc, l)), e) : - 'field_expr)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.RbAnt (_loc, - (mk_anti ~c: "rec_binding" n s)) : - 'field_expr) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "bi" | "anti"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"bi\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "bi" | "anti" as n)), s) - -> - (Ast.RbAnt (_loc, - (mk_anti ~c: "rec_binding" n s)) : - 'field_expr) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (meth_list : 'meth_list Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (meth_decl : 'meth_decl Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_dot_dot : 'opt_dot_dot Gram.Entry.t)) ], - (Gram.Action.mk - (fun (v : 'opt_dot_dot) (m : 'meth_decl) - (_loc : Gram.Loc.t) -> ((m, v) : 'meth_list)))); - ([ Gram.Snterm - (Gram.Entry.obj - (meth_decl : 'meth_decl Gram.Entry.t)); - Gram.Skeyword ";"; - Gram.Snterm - (Gram.Entry.obj - (opt_dot_dot : 'opt_dot_dot Gram.Entry.t)) ], - (Gram.Action.mk - (fun (v : 'opt_dot_dot) _ (m : 'meth_decl) - (_loc : Gram.Loc.t) -> ((m, v) : 'meth_list)))); - ([ Gram.Snterm - (Gram.Entry.obj - (meth_decl : 'meth_decl Gram.Entry.t)); - Gram.Skeyword ";"; Gram.Sself ], - (Gram.Action.mk - (fun ((ml, v) : 'meth_list) _ (m : 'meth_decl) - (_loc : Gram.Loc.t) -> - (((Ast.TySem (_loc, m, ml)), v) : 'meth_list)))) ]) ])) - ()); - Gram.extend (meth_decl : 'meth_decl Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (poly_type : 'poly_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'poly_type) _ (lab : 'a_LIDENT) - (_loc : Gram.Loc.t) -> - (Ast.TyCol (_loc, - (Ast.TyId (_loc, (Ast.IdLid (_loc, lab)))), - t) : - 'meth_decl)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.ctyp_tag : - 'meth_decl) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp;" n s)) : - 'meth_decl) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "typ"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"typ\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "typ" as n)), s) -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp" n s)) : - 'meth_decl) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (opt_meth_list : 'opt_meth_list Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (opt_dot_dot : 'opt_dot_dot Gram.Entry.t)) ], - (Gram.Action.mk - (fun (v : 'opt_dot_dot) (_loc : Gram.Loc.t) -> - (Ast.TyObj (_loc, (Ast.TyNil _loc), v) : - 'opt_meth_list)))); - ([ Gram.Snterm - (Gram.Entry.obj - (meth_list : 'meth_list Gram.Entry.t)) ], - (Gram.Action.mk - (fun ((ml, v) : 'meth_list) (_loc : Gram.Loc.t) - -> (Ast.TyObj (_loc, ml, v) : 'opt_meth_list)))) ]) ])) - ()); - Gram.extend (poly_type : 'poly_type Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'ctyp) (_loc : Gram.Loc.t) -> - (t : 'poly_type)))) ]) ])) - ()); - Gram.extend (package_type : 'package_type Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (module_type : 'module_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (p : 'module_type) (_loc : Gram.Loc.t) -> - (p : 'package_type)))) ]) ])) - ()); - Gram.extend (typevars : 'typevars Gram.Entry.t) - ((fun () -> - (None, - [ (None, (Some Camlp4.Sig.Grammar.LeftA), - [ ([ Gram.Skeyword "'"; - Gram.Snterm - (Gram.Entry.obj - (a_ident : 'a_ident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_ident) _ (_loc : Gram.Loc.t) -> - (Ast.TyQuo (_loc, i) : 'typevars)))); - ([ Gram.Stoken - (((function | QUOTATION _ -> true | _ -> false), - "QUOTATION _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | QUOTATION x -> - (Quotation.expand _loc x Quotation. - DynAst.ctyp_tag : - 'typevars) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "typ"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"typ\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "typ" as n)), s) -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp" n s)) : - 'typevars) - | _ -> assert false))); - ([ Gram.Sself; Gram.Sself ], - (Gram.Action.mk - (fun (t2 : 'typevars) (t1 : 'typevars) - (_loc : Gram.Loc.t) -> - (Ast.TyApp (_loc, t1, t2) : 'typevars)))) ]) ])) - ()); - Gram.extend (row_field : 'row_field Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'ctyp) (_loc : Gram.Loc.t) -> - (t : 'row_field)))); - ([ Gram.Skeyword "`"; - Gram.Snterm - (Gram.Entry.obj - (a_ident : 'a_ident Gram.Entry.t)); - Gram.Skeyword "of"; - Gram.Snterm - (Gram.Entry.obj - (amp_ctyp : 'amp_ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'amp_ctyp) _ (i : 'a_ident) _ - (_loc : Gram.Loc.t) -> - (Ast.TyOf (_loc, (Ast.TyVrn (_loc, i)), t) : - 'row_field)))); - ([ Gram.Skeyword "`"; - Gram.Snterm - (Gram.Entry.obj - (a_ident : 'a_ident Gram.Entry.t)); - Gram.Skeyword "of"; Gram.Skeyword "&"; - Gram.Snterm - (Gram.Entry.obj - (amp_ctyp : 'amp_ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'amp_ctyp) _ _ (i : 'a_ident) _ - (_loc : Gram.Loc.t) -> - (Ast.TyOfAmp (_loc, (Ast.TyVrn (_loc, i)), t) : - 'row_field)))); - ([ Gram.Skeyword "`"; - Gram.Snterm - (Gram.Entry.obj - (a_ident : 'a_ident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_ident) _ (_loc : Gram.Loc.t) -> - (Ast.TyVrn (_loc, i) : 'row_field)))); - ([ Gram.Sself; Gram.Skeyword "|"; Gram.Sself ], - (Gram.Action.mk - (fun (t2 : 'row_field) _ (t1 : 'row_field) - (_loc : Gram.Loc.t) -> - (Ast.TyOr (_loc, t1, t2) : 'row_field)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp|" n s)) : - 'row_field) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "typ"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"typ\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "typ" as n)), s) -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp" n s)) : - 'row_field) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (amp_ctyp : 'amp_ctyp Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'ctyp) (_loc : Gram.Loc.t) -> - (t : 'amp_ctyp)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("list", _) -> true - | _ -> false), - "ANTIQUOT (\"list\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("list" as n)), s) -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp&" n s)) : - 'amp_ctyp) - | _ -> assert false))); - ([ Gram.Sself; Gram.Skeyword "&"; Gram.Sself ], - (Gram.Action.mk - (fun (t2 : 'amp_ctyp) _ (t1 : 'amp_ctyp) - (_loc : Gram.Loc.t) -> - (Ast.TyAmp (_loc, t1, t2) : 'amp_ctyp)))) ]) ])) - ()); - Gram.extend (name_tags : 'name_tags Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Skeyword "`"; - Gram.Snterm - (Gram.Entry.obj - (a_ident : 'a_ident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_ident) _ (_loc : Gram.Loc.t) -> - (Ast.TyVrn (_loc, i) : 'name_tags)))); - ([ Gram.Sself; Gram.Sself ], - (Gram.Action.mk - (fun (t2 : 'name_tags) (t1 : 'name_tags) - (_loc : Gram.Loc.t) -> - (Ast.TyApp (_loc, t1, t2) : 'name_tags)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "typ"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"typ\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "typ" as n)), s) -> - (Ast.TyAnt (_loc, - (mk_anti ~c: "ctyp" n s)) : - 'name_tags) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (eq_expr : 'eq_expr Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (fun i p -> Ast.PaOlb (_loc, i, p) : - 'eq_expr)))); - ([ Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) _ (_loc : Gram.Loc.t) -> - (fun i p -> Ast.PaOlbi (_loc, i, p, e) : - 'eq_expr)))) ]) ])) - ()); - Gram.extend (patt_tcon : 'patt_tcon Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], - (Gram.Action.mk - (fun (p : 'patt) (_loc : Gram.Loc.t) -> - (p : 'patt_tcon)))); - ([ Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'ctyp) _ (p : 'patt) - (_loc : Gram.Loc.t) -> - (Ast.PaTyc (_loc, p, t) : 'patt_tcon)))) ]) ])) - ()); - Gram.extend (ipatt : 'ipatt Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Skeyword "?"; Gram.Skeyword "("; - Gram.Snterm - (Gram.Entry.obj - (ipatt_tcon : 'ipatt_tcon Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (e : 'expr) _ (p : 'ipatt_tcon) _ _ - (_loc : Gram.Loc.t) -> - (Ast.PaOlbi (_loc, "", p, e) : 'ipatt)))); - ([ Gram.Skeyword "?"; Gram.Skeyword "("; - Gram.Snterm - (Gram.Entry.obj - (ipatt_tcon : 'ipatt_tcon Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (p : 'ipatt_tcon) _ _ (_loc : Gram.Loc.t) - -> (Ast.PaOlb (_loc, "", p) : 'ipatt)))); - ([ Gram.Skeyword "?"; - Gram.Stoken - (((function - | ANTIQUOT (("" | "lid"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"lid\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) _ - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "lid" as n)), i) -> - (Ast.PaOlb (_loc, (mk_anti n i), - (Ast.PaNil _loc)) : - 'ipatt) - | _ -> assert false))); - ([ Gram.Skeyword "?"; - Gram.Stoken - (((function | LIDENT _ -> true | _ -> false), - "LIDENT _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) _ - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | LIDENT i -> - (Ast.PaOlb (_loc, i, (Ast.PaNil _loc)) : - 'ipatt) - | _ -> assert false))); - ([ Gram.Skeyword "?"; - Gram.Stoken - (((function - | ANTIQUOT (("" | "lid"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"lid\"), _)")); - Gram.Skeyword ":"; Gram.Skeyword "("; - Gram.Snterm - (Gram.Entry.obj - (ipatt_tcon : 'ipatt_tcon Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (eq_expr : 'eq_expr Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (f : 'eq_expr) (p : 'ipatt_tcon) _ _ - (__camlp4_0 : Gram.Token.t) _ - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "lid" as n)), i) -> - (f (mk_anti n i) p : 'ipatt) - | _ -> assert false))); - ([ Gram.Stoken - (((function | OPTLABEL _ -> true | _ -> false), - "OPTLABEL _")); - Gram.Skeyword "("; - Gram.Snterm - (Gram.Entry.obj - (ipatt_tcon : 'ipatt_tcon Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (eq_expr : 'eq_expr Gram.Entry.t)); - Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (f : 'eq_expr) (p : 'ipatt_tcon) _ - (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | OPTLABEL i -> (f i p : 'ipatt) - | _ -> assert false))); - ([ Gram.Skeyword "~"; - Gram.Stoken - (((function | LIDENT _ -> true | _ -> false), - "LIDENT _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) _ - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | LIDENT i -> - (Ast.PaLab (_loc, i, (Ast.PaNil _loc)) : - 'ipatt) - | _ -> assert false))); - ([ Gram.Skeyword "~"; - Gram.Stoken - (((function - | ANTIQUOT (("" | "lid"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"lid\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) _ - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "lid" as n)), i) -> - (Ast.PaLab (_loc, (mk_anti n i), - (Ast.PaNil _loc)) : - 'ipatt) - | _ -> assert false))); - ([ Gram.Skeyword "~"; - Gram.Stoken - (((function - | ANTIQUOT (("" | "lid"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"lid\"), _)")); - Gram.Skeyword ":"; Gram.Sself ], - (Gram.Action.mk - (fun (p : 'ipatt) _ (__camlp4_0 : Gram.Token.t) - _ (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "lid" as n)), i) -> - (Ast.PaLab (_loc, (mk_anti n i), p) : - 'ipatt) - | _ -> assert false))); - ([ Gram.Stoken - (((function | LABEL _ -> true | _ -> false), - "LABEL _")); - Gram.Sself ], - (Gram.Action.mk - (fun (p : 'ipatt) (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | LABEL i -> - (Ast.PaLab (_loc, i, p) : 'ipatt) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (ipatt_tcon : 'ipatt_tcon Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)) ], - (Gram.Action.mk - (fun (p : 'ipatt) (_loc : Gram.Loc.t) -> - (p : 'ipatt_tcon)))); - ([ Gram.Snterm - (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (t : 'ctyp) _ (p : 'ipatt) - (_loc : Gram.Loc.t) -> - (Ast.PaTyc (_loc, p, t) : 'ipatt_tcon)))) ]) ])) - ()); - Gram.extend (direction_flag : 'direction_flag Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Stoken - (((function - | ANTIQUOT (("to" | "anti"), _) -> true - | _ -> false), - "ANTIQUOT ((\"to\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("to" | "anti" as n)), s) -> - (Ast.DiAnt (mk_anti n s) : - 'direction_flag) - | _ -> assert false))); - ([ Gram.Skeyword "downto" ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> - (Ast.DiDownto : 'direction_flag)))); - ([ Gram.Skeyword "to" ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> - (Ast.DiTo : 'direction_flag)))) ]) ])) - ()); - Gram.extend (opt_private : 'opt_private Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.PrNil : 'opt_private)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("private" | "anti"), _) -> true - | _ -> false), - "ANTIQUOT ((\"private\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("private" | "anti" as n)), s) - -> - (Ast.PrAnt (mk_anti n s) : 'opt_private) - | _ -> assert false))); - ([ Gram.Skeyword "private" ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> - (Ast.PrPrivate : 'opt_private)))) ]) ])) - ()); - Gram.extend (opt_mutable : 'opt_mutable Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.MuNil : 'opt_mutable)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("mutable" | "anti"), _) -> true - | _ -> false), - "ANTIQUOT ((\"mutable\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("mutable" | "anti" as n)), s) - -> - (Ast.MuAnt (mk_anti n s) : 'opt_mutable) - | _ -> assert false))); - ([ Gram.Skeyword "mutable" ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> - (Ast.MuMutable : 'opt_mutable)))) ]) ])) - ()); - Gram.extend (opt_virtual : 'opt_virtual Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.ViNil : 'opt_virtual)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("virtual" | "anti"), _) -> true - | _ -> false), - "ANTIQUOT ((\"virtual\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("virtual" | "anti" as n)), s) - -> - (Ast.ViAnt (mk_anti n s) : 'opt_virtual) - | _ -> assert false))); - ([ Gram.Skeyword "virtual" ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> - (Ast.ViVirtual : 'opt_virtual)))) ]) ])) - ()); - Gram.extend (opt_dot_dot : 'opt_dot_dot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.RvNil : 'opt_dot_dot)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ((".." | "anti"), _) -> true - | _ -> false), - "ANTIQUOT ((\"..\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT (((".." | "anti" as n)), s) -> - (Ast.RvAnt (mk_anti n s) : 'opt_dot_dot) - | _ -> assert false))); - ([ Gram.Skeyword ".." ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> - (Ast.RvRowVar : 'opt_dot_dot)))) ]) ])) - ()); - Gram.extend (opt_rec : 'opt_rec Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.ReNil : 'opt_rec)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("rec" | "anti"), _) -> true - | _ -> false), - "ANTIQUOT ((\"rec\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("rec" | "anti" as n)), s) -> - (Ast.ReAnt (mk_anti n s) : 'opt_rec) - | _ -> assert false))); - ([ Gram.Skeyword "rec" ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> - (Ast.ReRecursive : 'opt_rec)))) ]) ])) - ()); - Gram.extend (opt_override : 'opt_override Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.OvNil : 'opt_override)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("!" | "override" | "anti"), _) - -> true - | _ -> false), - "ANTIQUOT ((\"!\" | \"override\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("!" | "override" | "anti" as n)), s) - -> - (Ast.OvAnt (mk_anti n s) : 'opt_override) - | _ -> assert false))); - ([ Gram.Skeyword "!" ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> - (Ast.OvOverride : 'opt_override)))) ]) ])) - ()); - Gram.extend (opt_expr : 'opt_expr Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.ExNil _loc : 'opt_expr)))); - ([ Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) (_loc : Gram.Loc.t) -> - (e : 'opt_expr)))) ]) ])) - ()); - Gram.extend (interf : 'interf Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Stoken - (((function | EOI -> true | _ -> false), "EOI")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | EOI -> (([], None) : 'interf) - | _ -> assert false))); - ([ Gram.Snterm - (Gram.Entry.obj - (sig_item : 'sig_item Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun ((sil, stopped) : 'interf) _ - (si : 'sig_item) (_loc : Gram.Loc.t) -> - (((si :: sil), stopped) : 'interf)))); - ([ Gram.Skeyword "#"; - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_expr : 'opt_expr Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (semi : 'semi Gram.Entry.t)) ], - (Gram.Action.mk - (fun _ (dp : 'opt_expr) (n : 'a_LIDENT) _ - (_loc : Gram.Loc.t) -> - (([ Ast.SgDir (_loc, n, dp) ], - (stopped_at _loc)) : 'interf)))) ]) ])) - ()); - Gram.extend (sig_items : 'sig_items Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Slist0 - (Gram.srules sig_items - [ ([ Gram.Snterm - (Gram.Entry.obj - (sig_item : - 'sig_item Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (semi : 'semi Gram.Entry.t)) ], - (Gram.Action.mk - (fun _ (sg : 'sig_item) - (_loc : Gram.Loc.t) -> - (sg : 'e__12)))) ]) ], - (Gram.Action.mk - (fun (l : 'e__12 list) (_loc : Gram.Loc.t) -> - (Ast.sgSem_of_list l : 'sig_items)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "sigi" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"sigi\" | \"anti\" | \"list\"), _)")); - Gram.Snterm - (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (sg : 'sig_items) _ - (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "sigi" | "anti" | "list" as n)), - s) -> - (Ast.SgSem (_loc, - (Ast.SgAnt (_loc, - (mk_anti n ~c: "sig_item" s))), - sg) : - 'sig_items) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "sigi" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"sigi\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "sigi" | "anti" | "list" as n)), - s) -> - (Ast.SgAnt (_loc, - (mk_anti n ~c: "sig_item" s)) : - 'sig_items) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (implem : 'implem Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Stoken - (((function | EOI -> true | _ -> false), "EOI")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | EOI -> (([], None) : 'implem) - | _ -> assert false))); - ([ Gram.Snterm - (Gram.Entry.obj - (str_item : 'str_item Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun ((sil, stopped) : 'implem) _ - (si : 'str_item) (_loc : Gram.Loc.t) -> - (((si :: sil), stopped) : 'implem)))); - ([ Gram.Skeyword "#"; - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_expr : 'opt_expr Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (semi : 'semi Gram.Entry.t)) ], - (Gram.Action.mk - (fun _ (dp : 'opt_expr) (n : 'a_LIDENT) _ - (_loc : Gram.Loc.t) -> - (([ Ast.StDir (_loc, n, dp) ], - (stopped_at _loc)) : 'implem)))) ]) ])) - ()); - Gram.extend (str_items : 'str_items Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Slist0 - (Gram.srules str_items - [ ([ Gram.Snterm - (Gram.Entry.obj - (str_item : - 'str_item Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (semi : 'semi Gram.Entry.t)) ], - (Gram.Action.mk - (fun _ (st : 'str_item) - (_loc : Gram.Loc.t) -> - (st : 'e__13)))) ]) ], - (Gram.Action.mk - (fun (l : 'e__13 list) (_loc : Gram.Loc.t) -> - (Ast.stSem_of_list l : 'str_items)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "stri" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"stri\" | \"anti\" | \"list\"), _)")); - Gram.Snterm - (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (st : 'str_items) _ - (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "stri" | "anti" | "list" as n)), - s) -> - (Ast.StSem (_loc, - (Ast.StAnt (_loc, - (mk_anti n ~c: "str_item" s))), - st) : - 'str_items) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "stri" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"stri\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "stri" | "anti" | "list" as n)), - s) -> - (Ast.StAnt (_loc, - (mk_anti n ~c: "str_item" s)) : - 'str_items) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (top_phrase : 'top_phrase Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Stoken - (((function | EOI -> true | _ -> false), "EOI")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | EOI -> (None : 'top_phrase) - | _ -> assert false))); - ([ Gram.Snterm - (Gram.Entry.obj (phrase : 'phrase Gram.Entry.t)) ], - (Gram.Action.mk - (fun (ph : 'phrase) (_loc : Gram.Loc.t) -> - (Some ph : 'top_phrase)))) ]) ])) - ()); - Gram.extend (use_file : 'use_file Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Stoken - (((function | EOI -> true | _ -> false), "EOI")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | EOI -> (([], None) : 'use_file) - | _ -> assert false))); - ([ Gram.Snterm - (Gram.Entry.obj - (str_item : 'str_item Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun ((sil, stopped) : 'use_file) _ - (si : 'str_item) (_loc : Gram.Loc.t) -> - (((si :: sil), stopped) : 'use_file)))); - ([ Gram.Skeyword "#"; - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_expr : 'opt_expr Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (semi : 'semi Gram.Entry.t)) ], - (Gram.Action.mk - (fun _ (dp : 'opt_expr) (n : 'a_LIDENT) _ - (_loc : Gram.Loc.t) -> - (([ Ast.StDir (_loc, n, dp) ], - (stopped_at _loc)) : 'use_file)))) ]) ])) - ()); - Gram.extend (phrase : 'phrase Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (str_item : 'str_item Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (semi : 'semi Gram.Entry.t)) ], - (Gram.Action.mk - (fun _ (st : 'str_item) (_loc : Gram.Loc.t) -> - (st : 'phrase)))); - ([ Gram.Skeyword "#"; - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_expr : 'opt_expr Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (semi : 'semi Gram.Entry.t)) ], - (Gram.Action.mk - (fun _ (dp : 'opt_expr) (n : 'a_LIDENT) _ - (_loc : Gram.Loc.t) -> - (Ast.StDir (_loc, n, dp) : 'phrase)))) ]) ])) - ()); - Gram.extend (a_INT : 'a_INT Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Stoken - (((function | INT (_, _) -> true | _ -> false), - "INT (_, _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | INT (_, s) -> (s : 'a_INT) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "int" | "`int"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"\" | \"int\" | \"`int\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "int" | "`int" as n)), s) - -> (mk_anti n s : 'a_INT) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (a_INT32 : 'a_INT32 Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Stoken - (((function | INT32 (_, _) -> true | _ -> false), - "INT32 (_, _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | INT32 (_, s) -> (s : 'a_INT32) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "int32" | "`int32"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"\" | \"int32\" | \"`int32\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "int32" | "`int32" as n)), - s) -> (mk_anti n s : 'a_INT32) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (a_INT64 : 'a_INT64 Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Stoken - (((function | INT64 (_, _) -> true | _ -> false), - "INT64 (_, _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | INT64 (_, s) -> (s : 'a_INT64) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "int64" | "`int64"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"\" | \"int64\" | \"`int64\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "int64" | "`int64" as n)), - s) -> (mk_anti n s : 'a_INT64) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (a_NATIVEINT : 'a_NATIVEINT Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Stoken - (((function - | NATIVEINT (_, _) -> true - | _ -> false), - "NATIVEINT (_, _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | NATIVEINT (_, s) -> (s : 'a_NATIVEINT) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT - (("" | "nativeint" | "`nativeint"), _) - -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"nativeint\" | \"`nativeint\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "nativeint" | "`nativeint" as n)), - s) -> (mk_anti n s : 'a_NATIVEINT) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (a_FLOAT : 'a_FLOAT Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Stoken - (((function | FLOAT (_, _) -> true | _ -> false), - "FLOAT (_, _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | FLOAT (_, s) -> (s : 'a_FLOAT) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "flo" | "`flo"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"\" | \"flo\" | \"`flo\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "flo" | "`flo" as n)), s) - -> (mk_anti n s : 'a_FLOAT) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (a_CHAR : 'a_CHAR Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Stoken - (((function | CHAR (_, _) -> true | _ -> false), - "CHAR (_, _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | CHAR (_, s) -> (s : 'a_CHAR) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "chr" | "`chr"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"\" | \"chr\" | \"`chr\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "chr" | "`chr" as n)), s) - -> (mk_anti n s : 'a_CHAR) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (a_UIDENT : 'a_UIDENT Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Stoken - (((function | UIDENT _ -> true | _ -> false), - "UIDENT _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | UIDENT s -> (s : 'a_UIDENT) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "uid"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"uid\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "uid" as n)), s) -> - (mk_anti n s : 'a_UIDENT) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (a_LIDENT : 'a_LIDENT Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Stoken - (((function | LIDENT _ -> true | _ -> false), - "LIDENT _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | LIDENT s -> (s : 'a_LIDENT) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "lid"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"lid\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "lid" as n)), s) -> - (mk_anti n s : 'a_LIDENT) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (a_LABEL : 'a_LABEL Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Stoken - (((function | LABEL _ -> true | _ -> false), - "LABEL _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | LABEL s -> (s : 'a_LABEL) - | _ -> assert false))); - ([ Gram.Skeyword "~"; - Gram.Stoken - (((function - | ANTIQUOT ("", _) -> true - | _ -> false), - "ANTIQUOT (\"\", _)")); - Gram.Skeyword ":" ], - (Gram.Action.mk - (fun _ (__camlp4_0 : Gram.Token.t) _ - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" as n)), s) -> - (mk_anti n s : 'a_LABEL) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (a_OPTLABEL : 'a_OPTLABEL Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Stoken - (((function | OPTLABEL _ -> true | _ -> false), - "OPTLABEL _")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | OPTLABEL s -> (s : 'a_OPTLABEL) - | _ -> assert false))); - ([ Gram.Skeyword "?"; - Gram.Stoken - (((function - | ANTIQUOT ("", _) -> true - | _ -> false), - "ANTIQUOT (\"\", _)")); - Gram.Skeyword ":" ], - (Gram.Action.mk - (fun _ (__camlp4_0 : Gram.Token.t) _ - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" as n)), s) -> - (mk_anti n s : 'a_OPTLABEL) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (a_STRING : 'a_STRING Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Stoken - (((function - | STRING (_, _) -> true - | _ -> false), - "STRING (_, _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | STRING (_, s) -> (s : 'a_STRING) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "str" | "`str"), _) -> - true - | _ -> false), - "ANTIQUOT ((\"\" | \"str\" | \"`str\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" | "str" | "`str" as n)), s) - -> (mk_anti n s : 'a_STRING) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (string_list : 'string_list Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Stoken - (((function - | STRING (_, _) -> true - | _ -> false), - "STRING (_, _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | STRING (_, x) -> - (Ast.LCons (x, Ast.LNil) : 'string_list) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | STRING (_, _) -> true - | _ -> false), - "STRING (_, _)")); - Gram.Sself ], - (Gram.Action.mk - (fun (xs : 'string_list) - (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | STRING (_, x) -> - (Ast.LCons (x, xs) : 'string_list) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "str_list"), _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"str_list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT (("" | "str_list"), s) -> - (Ast.LAnt (mk_anti "str_list" s) : - 'string_list) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (value_let : 'value_let Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Skeyword "value" ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> (() : 'value_let)))) ]) ])) - ()); - Gram.extend (value_val : 'value_val Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Skeyword "value" ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> (() : 'value_val)))) ]) ])) - ()); - Gram.extend (semi : 'semi Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Skeyword ";" ], - (Gram.Action.mk - (fun _ (_loc : Gram.Loc.t) -> (() : 'semi)))) ]) ])) - ()); - Gram.extend (expr_quot : 'expr_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.ExNil _loc : 'expr_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e : 'expr) (_loc : Gram.Loc.t) -> - (e : 'expr_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); - Gram.Skeyword ";"; - Gram.Snterm - (Gram.Entry.obj - (sem_expr : 'sem_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e2 : 'sem_expr) _ (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExSem (_loc, e1, e2) : 'expr_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); - Gram.Skeyword ","; - Gram.Snterm - (Gram.Entry.obj - (comma_expr : 'comma_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (e2 : 'comma_expr) _ (e1 : 'expr) - (_loc : Gram.Loc.t) -> - (Ast.ExCom (_loc, e1, e2) : 'expr_quot)))) ]) ])) - ()); - Gram.extend (patt_quot : 'patt_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.PaNil _loc : 'patt_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'patt) (_loc : Gram.Loc.t) -> - (x : 'patt_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], - (Gram.Action.mk - (fun (y : 'patt) _ (x : 'patt) - (_loc : Gram.Loc.t) -> - (let i = - match x with - | Ast.PaAnt (loc, s) -> Ast.IdAnt (loc, s) - | p -> Ast.ident_of_patt p - in Ast.PaEq (_loc, i, y) : 'patt_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); - Gram.Skeyword ";"; - Gram.Snterm - (Gram.Entry.obj - (sem_patt : 'sem_patt Gram.Entry.t)) ], - (Gram.Action.mk - (fun (y : 'sem_patt) _ (x : 'patt) - (_loc : Gram.Loc.t) -> - (Ast.PaSem (_loc, x, y) : 'patt_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); - Gram.Skeyword ","; - Gram.Snterm - (Gram.Entry.obj - (comma_patt : 'comma_patt Gram.Entry.t)) ], - (Gram.Action.mk - (fun (y : 'comma_patt) _ (x : 'patt) - (_loc : Gram.Loc.t) -> - (Ast.PaCom (_loc, x, y) : 'patt_quot)))) ]) ])) - ()); - Gram.extend (ctyp_quot : 'ctyp_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.TyNil _loc : 'ctyp_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (more_ctyp : 'more_ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'more_ctyp) (_loc : Gram.Loc.t) -> - (x : 'ctyp_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (more_ctyp : 'more_ctyp Gram.Entry.t)); - Gram.Skeyword "and"; - Gram.Snterm - (Gram.Entry.obj - (constructor_arg_list : - 'constructor_arg_list Gram.Entry.t)) ], - (Gram.Action.mk - (fun (y : 'constructor_arg_list) _ - (x : 'more_ctyp) (_loc : Gram.Loc.t) -> - (Ast.TyAnd (_loc, x, y) : 'ctyp_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (more_ctyp : 'more_ctyp Gram.Entry.t)); - Gram.Skeyword "&"; - Gram.Snterm - (Gram.Entry.obj - (amp_ctyp : 'amp_ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (y : 'amp_ctyp) _ (x : 'more_ctyp) - (_loc : Gram.Loc.t) -> - (Ast.TyAmp (_loc, x, y) : 'ctyp_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (more_ctyp : 'more_ctyp Gram.Entry.t)); - Gram.Skeyword "*"; - Gram.Snterm - (Gram.Entry.obj - (star_ctyp : 'star_ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (y : 'star_ctyp) _ (x : 'more_ctyp) - (_loc : Gram.Loc.t) -> - (Ast.TySta (_loc, x, y) : 'ctyp_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (more_ctyp : 'more_ctyp Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (more_ctyp : 'more_ctyp Gram.Entry.t)); - Gram.Skeyword ";"; - Gram.Snterm - (Gram.Entry.obj - (label_declaration_list : - 'label_declaration_list Gram.Entry.t)) ], - (Gram.Action.mk - (fun (z : 'label_declaration_list) _ - (y : 'more_ctyp) _ (x : 'more_ctyp) - (_loc : Gram.Loc.t) -> - (Ast.TySem (_loc, (Ast.TyCol (_loc, x, y)), - z) : - 'ctyp_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (more_ctyp : 'more_ctyp Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (more_ctyp : 'more_ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (y : 'more_ctyp) _ (x : 'more_ctyp) - (_loc : Gram.Loc.t) -> - (Ast.TyCol (_loc, x, y) : 'ctyp_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (more_ctyp : 'more_ctyp Gram.Entry.t)); - Gram.Skeyword "of"; Gram.Skeyword "&"; - Gram.Snterm - (Gram.Entry.obj - (amp_ctyp : 'amp_ctyp Gram.Entry.t)); - Gram.Skeyword "|"; - Gram.Snterm - (Gram.Entry.obj - (row_field : 'row_field Gram.Entry.t)) ], - (Gram.Action.mk - (fun (z : 'row_field) _ (y : 'amp_ctyp) _ _ - (x : 'more_ctyp) (_loc : Gram.Loc.t) -> - (Ast.TyOr (_loc, (Ast.TyOfAmp (_loc, x, y)), - z) : - 'ctyp_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (more_ctyp : 'more_ctyp Gram.Entry.t)); - Gram.Skeyword "of"; Gram.Skeyword "&"; - Gram.Snterm - (Gram.Entry.obj - (amp_ctyp : 'amp_ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (y : 'amp_ctyp) _ _ (x : 'more_ctyp) - (_loc : Gram.Loc.t) -> - (Ast.TyOfAmp (_loc, x, y) : 'ctyp_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (more_ctyp : 'more_ctyp Gram.Entry.t)); - Gram.Skeyword "of"; - Gram.Snterm - (Gram.Entry.obj - (constructor_arg_list : - 'constructor_arg_list Gram.Entry.t)); - Gram.Skeyword "|"; - Gram.Snterm - (Gram.Entry.obj - (constructor_declarations : - 'constructor_declarations Gram.Entry.t)) ], - (Gram.Action.mk - (fun (z : 'constructor_declarations) _ - (y : 'constructor_arg_list) _ - (x : 'more_ctyp) (_loc : Gram.Loc.t) -> - (Ast.TyOr (_loc, (Ast.TyOf (_loc, x, y)), z) : - 'ctyp_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (more_ctyp : 'more_ctyp Gram.Entry.t)); - Gram.Skeyword "of"; - Gram.Snterm - (Gram.Entry.obj - (constructor_arg_list : - 'constructor_arg_list Gram.Entry.t)) ], - (Gram.Action.mk - (fun (y : 'constructor_arg_list) _ - (x : 'more_ctyp) (_loc : Gram.Loc.t) -> - (Ast.TyOf (_loc, x, y) : 'ctyp_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (more_ctyp : 'more_ctyp Gram.Entry.t)); - Gram.Skeyword "|"; - Gram.Snterm - (Gram.Entry.obj - (constructor_declarations : - 'constructor_declarations Gram.Entry.t)) ], - (Gram.Action.mk - (fun (y : 'constructor_declarations) _ - (x : 'more_ctyp) (_loc : Gram.Loc.t) -> - (Ast.TyOr (_loc, x, y) : 'ctyp_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (more_ctyp : 'more_ctyp Gram.Entry.t)); - Gram.Skeyword ";"; - Gram.Snterm - (Gram.Entry.obj - (label_declaration_list : - 'label_declaration_list Gram.Entry.t)) ], - (Gram.Action.mk - (fun (y : 'label_declaration_list) _ - (x : 'more_ctyp) (_loc : Gram.Loc.t) -> - (Ast.TySem (_loc, x, y) : 'ctyp_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (more_ctyp : 'more_ctyp Gram.Entry.t)); - Gram.Skeyword ","; - Gram.Snterm - (Gram.Entry.obj - (comma_ctyp : 'comma_ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (y : 'comma_ctyp) _ (x : 'more_ctyp) - (_loc : Gram.Loc.t) -> - (Ast.TyCom (_loc, x, y) : 'ctyp_quot)))) ]) ])) - ()); - Gram.extend (more_ctyp : 'more_ctyp Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (type_parameter : - 'type_parameter Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'type_parameter) (_loc : Gram.Loc.t) - -> (x : 'more_ctyp)))); - ([ Gram.Snterm - (Gram.Entry.obj - (type_kind : 'type_kind Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'type_kind) (_loc : Gram.Loc.t) -> - (x : 'more_ctyp)))); - ([ Gram.Skeyword "`"; - Gram.Snterm - (Gram.Entry.obj - (a_ident : 'a_ident Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'a_ident) _ (_loc : Gram.Loc.t) -> - (Ast.TyVrn (_loc, x) : 'more_ctyp)))); - ([ Gram.Skeyword "mutable"; Gram.Sself ], - (Gram.Action.mk - (fun (x : 'more_ctyp) _ (_loc : Gram.Loc.t) -> - (Ast.TyMut (_loc, x) : 'more_ctyp)))) ]) ])) - ()); - Gram.extend (str_item_quot : 'str_item_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.StNil _loc : 'str_item_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (str_item : 'str_item Gram.Entry.t)) ], - (Gram.Action.mk - (fun (st : 'str_item) (_loc : Gram.Loc.t) -> - (st : 'str_item_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (str_item : 'str_item Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (st2 : 'str_item_quot) _ (st1 : 'str_item) - (_loc : Gram.Loc.t) -> - (Ast.StSem (_loc, st1, st2) : 'str_item_quot)))); - ([ Gram.Skeyword "#"; - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_expr : 'opt_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (dp : 'opt_expr) (n : 'a_LIDENT) _ - (_loc : Gram.Loc.t) -> - (Ast.StDir (_loc, n, dp) : 'str_item_quot)))) ]) ])) - ()); - Gram.extend (sig_item_quot : 'sig_item_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.SgNil _loc : 'sig_item_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (sig_item : 'sig_item Gram.Entry.t)) ], - (Gram.Action.mk - (fun (sg : 'sig_item) (_loc : Gram.Loc.t) -> - (sg : 'sig_item_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (sig_item : 'sig_item Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (sg2 : 'sig_item_quot) _ (sg1 : 'sig_item) - (_loc : Gram.Loc.t) -> - (Ast.SgSem (_loc, sg1, sg2) : 'sig_item_quot)))); - ([ Gram.Skeyword "#"; - Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_expr : 'opt_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (dp : 'opt_expr) (n : 'a_LIDENT) _ - (_loc : Gram.Loc.t) -> - (Ast.SgDir (_loc, n, dp) : 'sig_item_quot)))) ]) ])) - ()); - Gram.extend (module_type_quot : 'module_type_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.MtNil _loc : 'module_type_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (module_type : 'module_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'module_type) (_loc : Gram.Loc.t) -> - (x : 'module_type_quot)))) ]) ])) - ()); - Gram.extend (module_expr_quot : 'module_expr_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.MeNil _loc : 'module_expr_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (module_expr : 'module_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'module_expr) (_loc : Gram.Loc.t) -> - (x : 'module_expr_quot)))) ]) ])) - ()); - Gram.extend (match_case_quot : 'match_case_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.McNil _loc : 'match_case_quot)))); - ([ Gram.Slist0sep - ((Gram.Snterm - (Gram.Entry.obj - (match_case0 : - 'match_case0 Gram.Entry.t))), - (Gram.Skeyword "|")) ], - (Gram.Action.mk - (fun (x : 'match_case0 list) (_loc : Gram.Loc.t) - -> (Ast.mcOr_of_list x : 'match_case_quot)))) ]) ])) - ()); - Gram.extend (binding_quot : 'binding_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.BiNil _loc : 'binding_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (binding : 'binding Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'binding) (_loc : Gram.Loc.t) -> - (x : 'binding_quot)))) ]) ])) - ()); - Gram.extend (rec_binding_quot : 'rec_binding_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.RbNil _loc : 'rec_binding_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (label_expr_list : - 'label_expr_list Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'label_expr_list) (_loc : Gram.Loc.t) - -> (x : 'rec_binding_quot)))) ]) ])) - ()); - Gram.extend - (module_binding_quot : 'module_binding_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.MbNil _loc : 'module_binding_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (module_type : 'module_type Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj - (module_expr : 'module_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (me : 'module_expr) _ (mt : 'module_type) _ - (m : 'a_UIDENT) (_loc : Gram.Loc.t) -> - (Ast.MbColEq (_loc, m, mt, me) : - 'module_binding_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (module_type : 'module_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (mt : 'module_type) _ (m : 'a_UIDENT) - (_loc : Gram.Loc.t) -> - (Ast.MbCol (_loc, m, mt) : - 'module_binding_quot)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("", _) -> true - | _ -> false), - "ANTIQUOT (\"\", _)")); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (module_type : 'module_type Gram.Entry.t)); - Gram.Skeyword "="; - Gram.Snterm - (Gram.Entry.obj - (module_expr : 'module_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (me : 'module_expr) _ (mt : 'module_type) _ - (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" as n)), m) -> - (Ast.MbColEq (_loc, (mk_anti n m), mt, - me) : - 'module_binding_quot) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("", _) -> true - | _ -> false), - "ANTIQUOT (\"\", _)")); - Gram.Skeyword ":"; - Gram.Snterm - (Gram.Entry.obj - (module_type : 'module_type Gram.Entry.t)) ], - (Gram.Action.mk - (fun (mt : 'module_type) _ - (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" as n)), m) -> - (Ast.MbCol (_loc, (mk_anti n m), mt) : - 'module_binding_quot) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("", _) -> true - | _ -> false), - "ANTIQUOT (\"\", _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("" as n)), s) -> - (Ast.MbAnt (_loc, - (mk_anti ~c: "module_binding" n s)) : - 'module_binding_quot) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("module_binding" | "anti"), _) - -> true - | _ -> false), - "ANTIQUOT ((\"module_binding\" | \"anti\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("module_binding" | "anti" as n)), s) - -> - (Ast.MbAnt (_loc, - (mk_anti ~c: "module_binding" n s)) : - 'module_binding_quot) - | _ -> assert false))); - ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], - (Gram.Action.mk - (fun (b2 : 'module_binding_quot) _ - (b1 : 'module_binding_quot) - (_loc : Gram.Loc.t) -> - (Ast.MbAnd (_loc, b1, b2) : - 'module_binding_quot)))) ]) ])) - ()); - Gram.extend (ident_quot : 'ident_quot Gram.Entry.t) - ((fun () -> - (None, - [ ((Some "apply"), None, - [ ([ Gram.Sself; Gram.Sself ], - (Gram.Action.mk - (fun (j : 'ident_quot) (i : 'ident_quot) - (_loc : Gram.Loc.t) -> - (Ast.IdApp (_loc, i, j) : 'ident_quot)))) ]); - ((Some "."), None, - [ ([ Gram.Sself; Gram.Skeyword "."; Gram.Sself ], - (Gram.Action.mk - (fun (j : 'ident_quot) _ (i : 'ident_quot) - (_loc : Gram.Loc.t) -> - (Ast.IdAcc (_loc, i, j) : 'ident_quot)))) ]); - ((Some "simple"), None, - [ ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], - (Gram.Action.mk - (fun _ (i : 'ident_quot) _ (_loc : Gram.Loc.t) - -> (i : 'ident_quot)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "id" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")); - Gram.Skeyword "."; Gram.Sself ], - (Gram.Action.mk - (fun (i : 'ident_quot) _ - (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "id" | "anti" | "list" as n)), s) - -> - (Ast.IdAcc (_loc, - (Ast.IdAnt (_loc, - (mk_anti ~c: "ident" n s))), - i) : - 'ident_quot) - | _ -> assert false))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> - (Ast.IdLid (_loc, i) : 'ident_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], - (Gram.Action.mk - (fun (i : 'a_UIDENT) (_loc : Gram.Loc.t) -> - (Ast.IdUid (_loc, i) : 'ident_quot)))); - ([ Gram.Stoken - (((function - | ANTIQUOT (("" | "id" | "anti" | "list"), - _) -> true - | _ -> false), - "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT - ((("" | "id" | "anti" | "list" as n)), s) - -> - (Ast.IdAnt (_loc, - (mk_anti ~c: "ident" n s)) : - 'ident_quot) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (class_expr_quot : 'class_expr_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.CeNil _loc : 'class_expr_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (class_expr : 'class_expr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'class_expr) (_loc : Gram.Loc.t) -> - (x : 'class_expr_quot)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("virtual", _) -> true - | _ -> false), - "ANTIQUOT (\"virtual\", _)")); - Gram.Snterm - (Gram.Entry.obj (ident : 'ident Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_comma_ctyp : - 'opt_comma_ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (ot : 'opt_comma_ctyp) (i : 'ident) - (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("virtual" as n)), s) -> - (let anti = - Ast.ViAnt - (mk_anti ~c: "class_expr" n s) - in Ast.CeCon (_loc, anti, i, ot) : - 'class_expr_quot) - | _ -> assert false))); - ([ Gram.Skeyword "virtual"; - Gram.Snterm - (Gram.Entry.obj - (class_name_and_param : - 'class_name_and_param Gram.Entry.t)) ], - (Gram.Action.mk - (fun ((i, ot) : 'class_name_and_param) _ - (_loc : Gram.Loc.t) -> - (Ast.CeCon (_loc, Ast.ViVirtual, - (Ast.IdLid (_loc, i)), ot) : - 'class_expr_quot)))); - ([ Gram.Sself; Gram.Skeyword "="; Gram.Sself ], - (Gram.Action.mk - (fun (ce2 : 'class_expr_quot) _ - (ce1 : 'class_expr_quot) (_loc : Gram.Loc.t) - -> - (Ast.CeEq (_loc, ce1, ce2) : - 'class_expr_quot)))); - ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], - (Gram.Action.mk - (fun (ce2 : 'class_expr_quot) _ - (ce1 : 'class_expr_quot) (_loc : Gram.Loc.t) - -> - (Ast.CeAnd (_loc, ce1, ce2) : - 'class_expr_quot)))) ]) ])) - ()); - Gram.extend (class_type_quot : 'class_type_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.CtNil _loc : 'class_type_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (class_type_plus : - 'class_type_plus Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'class_type_plus) (_loc : Gram.Loc.t) - -> (x : 'class_type_quot)))); - ([ Gram.Stoken - (((function - | ANTIQUOT ("virtual", _) -> true - | _ -> false), - "ANTIQUOT (\"virtual\", _)")); - Gram.Snterm - (Gram.Entry.obj (ident : 'ident Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj - (opt_comma_ctyp : - 'opt_comma_ctyp Gram.Entry.t)) ], - (Gram.Action.mk - (fun (ot : 'opt_comma_ctyp) (i : 'ident) - (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | ANTIQUOT ((("virtual" as n)), s) -> - (let anti = - Ast.ViAnt - (mk_anti ~c: "class_type" n s) - in Ast.CtCon (_loc, anti, i, ot) : - 'class_type_quot) - | _ -> assert false))); - ([ Gram.Skeyword "virtual"; - Gram.Snterm - (Gram.Entry.obj - (class_name_and_param : - 'class_name_and_param Gram.Entry.t)) ], - (Gram.Action.mk - (fun ((i, ot) : 'class_name_and_param) _ - (_loc : Gram.Loc.t) -> - (Ast.CtCon (_loc, Ast.ViVirtual, - (Ast.IdLid (_loc, i)), ot) : - 'class_type_quot)))); - ([ Gram.Sself; Gram.Skeyword ":"; Gram.Sself ], - (Gram.Action.mk - (fun (ct2 : 'class_type_quot) _ - (ct1 : 'class_type_quot) (_loc : Gram.Loc.t) - -> - (Ast.CtCol (_loc, ct1, ct2) : - 'class_type_quot)))); - ([ Gram.Sself; Gram.Skeyword "="; Gram.Sself ], - (Gram.Action.mk - (fun (ct2 : 'class_type_quot) _ - (ct1 : 'class_type_quot) (_loc : Gram.Loc.t) - -> - (Ast.CtEq (_loc, ct1, ct2) : - 'class_type_quot)))); - ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], - (Gram.Action.mk - (fun (ct2 : 'class_type_quot) _ - (ct1 : 'class_type_quot) (_loc : Gram.Loc.t) - -> - (Ast.CtAnd (_loc, ct1, ct2) : - 'class_type_quot)))) ]) ])) - ()); - Gram.extend - (class_str_item_quot : 'class_str_item_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.CrNil _loc : 'class_str_item_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (class_str_item : - 'class_str_item Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'class_str_item) (_loc : Gram.Loc.t) - -> (x : 'class_str_item_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (class_str_item : - 'class_str_item Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (x2 : 'class_str_item_quot) _ - (x1 : 'class_str_item) (_loc : Gram.Loc.t) -> - (Ast.CrSem (_loc, x1, x2) : - 'class_str_item_quot)))) ]) ])) - ()); - Gram.extend - (class_sig_item_quot : 'class_sig_item_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.CgNil _loc : 'class_sig_item_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (class_sig_item : - 'class_sig_item Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'class_sig_item) (_loc : Gram.Loc.t) - -> (x : 'class_sig_item_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (class_sig_item : - 'class_sig_item Gram.Entry.t)); - Gram.Snterm - (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); - Gram.Sself ], - (Gram.Action.mk - (fun (x2 : 'class_sig_item_quot) _ - (x1 : 'class_sig_item) (_loc : Gram.Loc.t) -> - (Ast.CgSem (_loc, x1, x2) : - 'class_sig_item_quot)))) ]) ])) - ()); - Gram.extend (with_constr_quot : 'with_constr_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([], - (Gram.Action.mk - (fun (_loc : Gram.Loc.t) -> - (Ast.WcNil _loc : 'with_constr_quot)))); - ([ Gram.Snterm - (Gram.Entry.obj - (with_constr : 'with_constr Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'with_constr) (_loc : Gram.Loc.t) -> - (x : 'with_constr_quot)))) ]) ])) - ()); - Gram.extend (rec_flag_quot : 'rec_flag_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (opt_rec : 'opt_rec Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'opt_rec) (_loc : Gram.Loc.t) -> - (x : 'rec_flag_quot)))) ]) ])) - ()); - Gram.extend - (direction_flag_quot : 'direction_flag_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (direction_flag : - 'direction_flag Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'direction_flag) (_loc : Gram.Loc.t) - -> (x : 'direction_flag_quot)))) ]) ])) - ()); - Gram.extend - (mutable_flag_quot : 'mutable_flag_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (opt_mutable : 'opt_mutable Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'opt_mutable) (_loc : Gram.Loc.t) -> - (x : 'mutable_flag_quot)))) ]) ])) - ()); - Gram.extend - (private_flag_quot : 'private_flag_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (opt_private : 'opt_private Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'opt_private) (_loc : Gram.Loc.t) -> - (x : 'private_flag_quot)))) ]) ])) - ()); - Gram.extend - (virtual_flag_quot : 'virtual_flag_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (opt_virtual : 'opt_virtual Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'opt_virtual) (_loc : Gram.Loc.t) -> - (x : 'virtual_flag_quot)))) ]) ])) - ()); - Gram.extend - (row_var_flag_quot : 'row_var_flag_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (opt_dot_dot : 'opt_dot_dot Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'opt_dot_dot) (_loc : Gram.Loc.t) -> - (x : 'row_var_flag_quot)))) ]) ])) - ()); - Gram.extend - (override_flag_quot : 'override_flag_quot Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj - (opt_override : 'opt_override Gram.Entry.t)) ], - (Gram.Action.mk - (fun (x : 'opt_override) (_loc : Gram.Loc.t) -> - (x : 'override_flag_quot)))) ]) ])) - ()); - Gram.extend (patt_eoi : 'patt_eoi Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); - Gram.Stoken - (((function | EOI -> true | _ -> false), "EOI")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) (x : 'patt) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | EOI -> (x : 'patt_eoi) - | _ -> assert false))) ]) ])) - ()); - Gram.extend (expr_eoi : 'expr_eoi Gram.Entry.t) - ((fun () -> - (None, - [ (None, None, - [ ([ Gram.Snterm - (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); - Gram.Stoken - (((function | EOI -> true | _ -> false), "EOI")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) (x : 'expr) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | EOI -> (x : 'expr_eoi) - | _ -> assert false))) ]) ])) - ())) + string_list : 'string_list Gram.Entry.t = + grammar_entry_create "string_list" + and opt_override : 'opt_override Gram.Entry.t = + grammar_entry_create "opt_override" + and unquoted_typevars : 'unquoted_typevars Gram.Entry.t = + grammar_entry_create "unquoted_typevars" + and value_val_opt_override : + 'value_val_opt_override Gram.Entry.t = + grammar_entry_create "value_val_opt_override" + and method_opt_override : 'method_opt_override Gram.Entry.t = + grammar_entry_create "method_opt_override" + and module_longident_dot_lparen : + 'module_longident_dot_lparen Gram.Entry.t = + grammar_entry_create "module_longident_dot_lparen" + and optional_type_parameter : + 'optional_type_parameter Gram.Entry.t = + grammar_entry_create "optional_type_parameter" + and fun_def_cont_no_when : 'fun_def_cont_no_when Gram.Entry.t = + grammar_entry_create "fun_def_cont_no_when" + and fun_def_cont : 'fun_def_cont Gram.Entry.t = + grammar_entry_create "fun_def_cont" + and sequence' : 'sequence' Gram.Entry.t = + grammar_entry_create "sequence'" + and infixop6 : 'infixop6 Gram.Entry.t = + grammar_entry_create "infixop6" + in + (Gram.extend (module_expr : 'module_expr Gram.Entry.t) + ((fun () -> + (None, + [ ((Some "top"), None, + [ ([ Gram.Skeyword "struct"; + Gram.Snterm + (Gram.Entry.obj + (str_items : 'str_items Gram.Entry.t)); + Gram.Skeyword "end" ], + (Gram.Action.mk + (fun _ (st : 'str_items) _ (_loc : Gram.Loc.t) + -> (Ast.MeStr (_loc, st) : 'module_expr)))); + ([ Gram.Skeyword "functor"; Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)); + Gram.Skeyword ")"; Gram.Skeyword "->"; Gram. + Sself ], + (Gram.Action.mk + (fun (me : 'module_expr) _ _ + (t : 'module_type) _ (i : 'a_UIDENT) _ _ + (_loc : Gram.Loc.t) -> + (Ast.MeFun (_loc, i, t, me) : 'module_expr)))) ]); + ((Some "apply"), None, + [ ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (me2 : 'module_expr) (me1 : 'module_expr) + (_loc : Gram.Loc.t) -> + (Ast.MeApp (_loc, me1, me2) : 'module_expr)))) ]); + ((Some "simple"), None, + [ ([ Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (value_val : 'value_val Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (package_type : + 'package_type Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (p : 'package_type) _ (e : 'expr) _ _ + (_loc : Gram.Loc.t) -> + (Ast.MePkg (_loc, + (Ast.ExTyc (_loc, e, + (Ast.TyPkg (_loc, p))))) : + 'module_expr)))); + ([ Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (value_val : 'value_val Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (e : 'expr) _ _ (_loc : Gram.Loc.t) -> + (Ast.MePkg (_loc, e) : 'module_expr)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (me : 'module_expr) _ + (_loc : Gram.Loc.t) -> (me : 'module_expr)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (mt : 'module_type) _ + (me : 'module_expr) _ (_loc : Gram.Loc.t) + -> + (Ast.MeTyc (_loc, me, mt) : 'module_expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (module_longident : + 'module_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'module_longident) + (_loc : Gram.Loc.t) -> + (Ast.MeId (_loc, i) : 'module_expr)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.module_expr_tag : + 'module_expr) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "mexp" | "anti" | "list"), _) + -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"mexp\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "mexp" | "anti" | "list" as n)), + s) -> + (Ast.MeAnt (_loc, + (mk_anti ~c: "module_expr" n s)) : + 'module_expr) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (str_item : 'str_item Gram.Entry.t) + ((fun () -> + (None, + [ ((Some "top"), None, + [ ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) (_loc : Gram.Loc.t) -> + (Ast.StExp (_loc, e) : 'str_item)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.str_item_tag : + 'str_item) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "stri" | "anti" | "list"), _) + -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"stri\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "stri" | "anti" | "list" as n)), + s) -> + (Ast.StAnt (_loc, + (mk_anti ~c: "str_item" n s)) : + 'str_item) + | _ -> assert false))); + ([ Gram.Skeyword "class"; Gram.Skeyword "type"; + Gram.Snterm + (Gram.Entry.obj + (class_type_declaration : + 'class_type_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ctd : 'class_type_declaration) _ _ + (_loc : Gram.Loc.t) -> + (Ast.StClt (_loc, ctd) : 'str_item)))); + ([ Gram.Skeyword "class"; + Gram.Snterm + (Gram.Entry.obj + (class_declaration : + 'class_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (cd : 'class_declaration) _ + (_loc : Gram.Loc.t) -> + (Ast.StCls (_loc, cd) : 'str_item)))); + ([ Gram.Snterm + (Gram.Entry.obj + (value_let : 'value_let Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_rec : 'opt_rec Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (binding : 'binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (bi : 'binding) (r : 'opt_rec) _ + (_loc : Gram.Loc.t) -> + (Ast.StVal (_loc, r, bi) : 'str_item)))); + ([ Gram.Skeyword "type"; + Gram.Snterm + (Gram.Entry.obj + (type_declaration : + 'type_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (td : 'type_declaration) _ + (_loc : Gram.Loc.t) -> + (Ast.StTyp (_loc, td) : 'str_item)))); + ([ Gram.Skeyword "open"; + Gram.Snterm + (Gram.Entry.obj + (module_longident : + 'module_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'module_longident) _ + (_loc : Gram.Loc.t) -> + (Ast.StOpn (_loc, i) : 'str_item)))); + ([ Gram.Skeyword "module"; Gram.Skeyword "type"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mt : 'module_type) _ (i : 'a_ident) _ _ + (_loc : Gram.Loc.t) -> + (Ast.StMty (_loc, i, mt) : 'str_item)))); + ([ Gram.Skeyword "module"; Gram.Skeyword "rec"; + Gram.Snterm + (Gram.Entry.obj + (module_binding : + 'module_binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mb : 'module_binding) _ _ + (_loc : Gram.Loc.t) -> + (Ast.StRecMod (_loc, mb) : 'str_item)))); + ([ Gram.Skeyword "module"; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (module_binding0 : + 'module_binding0 Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mb : 'module_binding0) (i : 'a_UIDENT) _ + (_loc : Gram.Loc.t) -> + (Ast.StMod (_loc, i, mb) : 'str_item)))); + ([ Gram.Skeyword "include"; + Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (me : 'module_expr) _ (_loc : Gram.Loc.t) + -> (Ast.StInc (_loc, me) : 'str_item)))); + ([ Gram.Skeyword "external"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (string_list : 'string_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (sl : 'string_list) _ (t : 'ctyp) _ + (i : 'a_LIDENT) _ (_loc : Gram.Loc.t) -> + (Ast.StExt (_loc, i, t, sl) : 'str_item)))); + ([ Gram.Skeyword "exception"; + Gram.Snterm + (Gram.Entry.obj + (constructor_declaration : + 'constructor_declaration Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (type_longident : + 'type_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'type_longident) _ + (t : 'constructor_declaration) _ + (_loc : Gram.Loc.t) -> + (Ast.StExc (_loc, t, (Ast.OSome i)) : + 'str_item)))); + ([ Gram.Skeyword "exception"; + Gram.Snterm + (Gram.Entry.obj + (constructor_declaration : + 'constructor_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'constructor_declaration) _ + (_loc : Gram.Loc.t) -> + (Ast.StExc (_loc, t, Ast.ONone) : + 'str_item)))) ]) ])) + ()); + Gram.extend (module_binding0 : 'module_binding0 Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (me : 'module_expr) _ (_loc : Gram.Loc.t) + -> (me : 'module_binding0)))); + ([ Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (me : 'module_expr) _ (mt : 'module_type) + _ (_loc : Gram.Loc.t) -> + (Ast.MeTyc (_loc, me, mt) : + 'module_binding0)))); + ([ Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)); + Gram.Skeyword ")"; Gram.Sself ], + (Gram.Action.mk + (fun (mb : 'module_binding0) _ + (mt : 'module_type) _ (m : 'a_UIDENT) _ + (_loc : Gram.Loc.t) -> + (Ast.MeFun (_loc, m, mt, mb) : + 'module_binding0)))) ]) ])) + ()); + Gram.extend (module_binding : 'module_binding Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (me : 'module_expr) _ (mt : 'module_type) + _ (m : 'a_UIDENT) (_loc : Gram.Loc.t) -> + (Ast.MbColEq (_loc, m, mt, me) : + 'module_binding)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.module_binding_tag : + 'module_binding) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("", _) -> true + | _ -> false), + "ANTIQUOT (\"\", _)")); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (me : 'module_expr) _ (mt : 'module_type) + _ (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" as n)), m) -> + (Ast.MbColEq (_loc, (mk_anti n m), mt, + me) : + 'module_binding) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("", _) -> true + | _ -> false), + "ANTIQUOT (\"\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" as n)), s) -> + (Ast.MbAnt (_loc, + (mk_anti ~c: "module_binding" n s)) : + 'module_binding) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("module_binding" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"module_binding\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("module_binding" | "anti" | "list" + as n)), + s) -> + (Ast.MbAnt (_loc, + (mk_anti ~c: "module_binding" n s)) : + 'module_binding) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (b2 : 'module_binding) _ + (b1 : 'module_binding) (_loc : Gram.Loc.t) + -> + (Ast.MbAnd (_loc, b1, b2) : + 'module_binding)))) ]) ])) + ()); + Gram.extend (module_type : 'module_type Gram.Entry.t) + ((fun () -> + (None, + [ ((Some "top"), None, + [ ([ Gram.Skeyword "functor"; Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; Gram.Sself; + Gram.Skeyword ")"; Gram.Skeyword "->"; Gram. + Sself ], + (Gram.Action.mk + (fun (mt : 'module_type) _ _ + (t : 'module_type) _ (i : 'a_UIDENT) _ _ + (_loc : Gram.Loc.t) -> + (Ast.MtFun (_loc, i, t, mt) : 'module_type)))) ]); + ((Some "with"), None, + [ ([ Gram.Sself; Gram.Skeyword "with"; + Gram.Snterm + (Gram.Entry.obj + (with_constr : 'with_constr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (wc : 'with_constr) _ (mt : 'module_type) + (_loc : Gram.Loc.t) -> + (Ast.MtWit (_loc, mt, wc) : 'module_type)))) ]); + ((Some "apply"), None, + [ ([ Gram.Sself; Gram.Sself; + Gram.Snterm + (Gram.Entry.obj (dummy : 'dummy Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (mt2 : 'module_type) + (mt1 : 'module_type) (_loc : Gram.Loc.t) -> + (module_type_app mt1 mt2 : 'module_type)))) ]); + ((Some "."), None, + [ ([ Gram.Sself; Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (mt2 : 'module_type) _ + (mt1 : 'module_type) (_loc : Gram.Loc.t) -> + (module_type_acc mt1 mt2 : 'module_type)))) ]); + ((Some "sig"), None, + [ ([ Gram.Skeyword "sig"; + Gram.Snterm + (Gram.Entry.obj + (sig_items : 'sig_items Gram.Entry.t)); + Gram.Skeyword "end" ], + (Gram.Action.mk + (fun _ (sg : 'sig_items) _ (_loc : Gram.Loc.t) + -> (Ast.MtSig (_loc, sg) : 'module_type)))) ]); + ((Some "simple"), None, + [ ([ Gram.Skeyword "module"; Gram.Skeyword "type"; + Gram.Skeyword "of"; + Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (me : 'module_expr) _ _ _ + (_loc : Gram.Loc.t) -> + (Ast.MtOf (_loc, me) : 'module_type)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (mt : 'module_type) _ + (_loc : Gram.Loc.t) -> (mt : 'module_type)))); + ([ Gram.Skeyword "'"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ (_loc : Gram.Loc.t) -> + (Ast.MtQuo (_loc, i) : 'module_type)))); + ([ Gram.Snterm + (Gram.Entry.obj + (module_longident_with_app : + 'module_longident_with_app Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'module_longident_with_app) + (_loc : Gram.Loc.t) -> + (Ast.MtId (_loc, i) : 'module_type)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.module_type_tag : + 'module_type) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "mtyp" | "anti" | "list"), _) + -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"mtyp\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "mtyp" | "anti" | "list" as n)), + s) -> + (Ast.MtAnt (_loc, + (mk_anti ~c: "module_type" n s)) : + 'module_type) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (sig_item : 'sig_item Gram.Entry.t) + ((fun () -> + (None, + [ ((Some "top"), None, + [ ([ Gram.Skeyword "class"; Gram.Skeyword "type"; + Gram.Snterm + (Gram.Entry.obj + (class_type_declaration : + 'class_type_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ctd : 'class_type_declaration) _ _ + (_loc : Gram.Loc.t) -> + (Ast.SgClt (_loc, ctd) : 'sig_item)))); + ([ Gram.Skeyword "class"; + Gram.Snterm + (Gram.Entry.obj + (class_description : + 'class_description Gram.Entry.t)) ], + (Gram.Action.mk + (fun (cd : 'class_description) _ + (_loc : Gram.Loc.t) -> + (Ast.SgCls (_loc, cd) : 'sig_item)))); + ([ Gram.Snterm + (Gram.Entry.obj + (value_val : 'value_val Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) _ (i : 'a_LIDENT) _ + (_loc : Gram.Loc.t) -> + (Ast.SgVal (_loc, i, t) : 'sig_item)))); + ([ Gram.Skeyword "type"; + Gram.Snterm + (Gram.Entry.obj + (type_declaration : + 'type_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'type_declaration) _ + (_loc : Gram.Loc.t) -> + (Ast.SgTyp (_loc, t) : 'sig_item)))); + ([ Gram.Skeyword "open"; + Gram.Snterm + (Gram.Entry.obj + (module_longident : + 'module_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'module_longident) _ + (_loc : Gram.Loc.t) -> + (Ast.SgOpn (_loc, i) : 'sig_item)))); + ([ Gram.Skeyword "module"; Gram.Skeyword "type"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ _ (_loc : Gram.Loc.t) -> + (Ast.SgMty (_loc, i, (Ast.MtNil _loc)) : + 'sig_item)))); + ([ Gram.Skeyword "module"; Gram.Skeyword "type"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mt : 'module_type) _ (i : 'a_ident) _ _ + (_loc : Gram.Loc.t) -> + (Ast.SgMty (_loc, i, mt) : 'sig_item)))); + ([ Gram.Skeyword "module"; Gram.Skeyword "rec"; + Gram.Snterm + (Gram.Entry.obj + (module_rec_declaration : + 'module_rec_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mb : 'module_rec_declaration) _ _ + (_loc : Gram.Loc.t) -> + (Ast.SgRecMod (_loc, mb) : 'sig_item)))); + ([ Gram.Skeyword "module"; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (module_declaration : + 'module_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mt : 'module_declaration) + (i : 'a_UIDENT) _ (_loc : Gram.Loc.t) -> + (Ast.SgMod (_loc, i, mt) : 'sig_item)))); + ([ Gram.Skeyword "include"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mt : 'module_type) _ (_loc : Gram.Loc.t) + -> (Ast.SgInc (_loc, mt) : 'sig_item)))); + ([ Gram.Skeyword "external"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (string_list : 'string_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (sl : 'string_list) _ (t : 'ctyp) _ + (i : 'a_LIDENT) _ (_loc : Gram.Loc.t) -> + (Ast.SgExt (_loc, i, t, sl) : 'sig_item)))); + ([ Gram.Skeyword "exception"; + Gram.Snterm + (Gram.Entry.obj + (constructor_declaration : + 'constructor_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'constructor_declaration) _ + (_loc : Gram.Loc.t) -> + (Ast.SgExc (_loc, t) : 'sig_item)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.sig_item_tag : + 'sig_item) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "sigi" | "anti" | "list"), _) + -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"sigi\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "sigi" | "anti" | "list" as n)), + s) -> + (Ast.SgAnt (_loc, + (mk_anti ~c: "sig_item" n s)) : + 'sig_item) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (module_declaration : 'module_declaration Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)); + Gram.Skeyword ")"; Gram.Sself ], + (Gram.Action.mk + (fun (mt : 'module_declaration) _ + (t : 'module_type) _ (i : 'a_UIDENT) _ + (_loc : Gram.Loc.t) -> + (Ast.MtFun (_loc, i, t, mt) : + 'module_declaration)))); + ([ Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mt : 'module_type) _ (_loc : Gram.Loc.t) + -> (mt : 'module_declaration)))) ]) ])) + ()); + Gram.extend + (module_rec_declaration : + 'module_rec_declaration Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mt : 'module_type) _ (m : 'a_UIDENT) + (_loc : Gram.Loc.t) -> + (Ast.MbCol (_loc, m, mt) : + 'module_rec_declaration)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.module_binding_tag : + 'module_rec_declaration) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "module_binding" | "anti" | + "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"module_binding\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "module_binding" | "anti" | + "list" + as n)), + s) -> + (Ast.MbAnt (_loc, + (mk_anti ~c: "module_binding" n s)) : + 'module_rec_declaration) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (m2 : 'module_rec_declaration) _ + (m1 : 'module_rec_declaration) + (_loc : Gram.Loc.t) -> + (Ast.MbAnd (_loc, m1, m2) : + 'module_rec_declaration)))) ]) ])) + ()); + Gram.extend (with_constr : 'with_constr Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Skeyword "module"; + Gram.Snterm + (Gram.Entry.obj + (module_longident : + 'module_longident Gram.Entry.t)); + Gram.Skeyword ":="; + Gram.Snterm + (Gram.Entry.obj + (module_longident_with_app : + 'module_longident_with_app Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i2 : 'module_longident_with_app) _ + (i1 : 'module_longident) _ + (_loc : Gram.Loc.t) -> + (Ast.WcMoS (_loc, i1, i2) : 'with_constr)))); + ([ Gram.Skeyword "type"; + Gram.Snterm + (Gram.Entry.obj + (type_longident_and_parameters : + 'type_longident_and_parameters Gram. + Entry.t)); + Gram.Skeyword ":="; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ + (t1 : 'type_longident_and_parameters) _ + (_loc : Gram.Loc.t) -> + (Ast.WcTyS (_loc, t1, t2) : 'with_constr)))); + ([ Gram.Skeyword "type"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "typ" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\" | \"anti\"), _)")); + Gram.Skeyword ":="; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) _ (__camlp4_0 : Gram.Token.t) + _ (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" | "anti" as n)), + s) -> + (Ast.WcTyS (_loc, + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp" n s))), + t) : + 'with_constr) + | _ -> assert false))); + ([ Gram.Skeyword "module"; + Gram.Snterm + (Gram.Entry.obj + (module_longident : + 'module_longident Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (module_longident_with_app : + 'module_longident_with_app Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i2 : 'module_longident_with_app) _ + (i1 : 'module_longident) _ + (_loc : Gram.Loc.t) -> + (Ast.WcMod (_loc, i1, i2) : 'with_constr)))); + ([ Gram.Skeyword "type"; + Gram.Snterm + (Gram.Entry.obj + (type_longident_and_parameters : + 'type_longident_and_parameters Gram. + Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ + (t1 : 'type_longident_and_parameters) _ + (_loc : Gram.Loc.t) -> + (Ast.WcTyp (_loc, t1, t2) : 'with_constr)))); + ([ Gram.Skeyword "type"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "typ" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\" | \"anti\"), _)")); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) _ (__camlp4_0 : Gram.Token.t) + _ (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" | "anti" as n)), + s) -> + (Ast.WcTyp (_loc, + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp" n s))), + t) : + 'with_constr) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.with_constr_tag : + 'with_constr) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "with_constr" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"with_constr\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "with_constr" | "anti" | "list" + as n)), + s) -> + (Ast.WcAnt (_loc, + (mk_anti ~c: "with_constr" n s)) : + 'with_constr) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (wc2 : 'with_constr) _ + (wc1 : 'with_constr) (_loc : Gram.Loc.t) -> + (Ast.WcAnd (_loc, wc1, wc2) : 'with_constr)))) ]) ])) + ()); + Gram.extend (expr : 'expr Gram.Entry.t) + ((fun () -> + (None, + [ ((Some "top"), (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Skeyword "object"; + Gram.Snterm + (Gram.Entry.obj + (opt_class_self_patt : + 'opt_class_self_patt Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (class_structure : + 'class_structure Gram.Entry.t)); + Gram.Skeyword "end" ], + (Gram.Action.mk + (fun _ (cst : 'class_structure) + (csp : 'opt_class_self_patt) _ + (_loc : Gram.Loc.t) -> + (Ast.ExObj (_loc, csp, cst) : 'expr)))); + ([ Gram.Skeyword "while"; + Gram.Snterm + (Gram.Entry.obj + (sequence : 'sequence Gram.Entry.t)); + Gram.Skeyword "do"; + Gram.Snterm + (Gram.Entry.obj + (do_sequence : 'do_sequence Gram.Entry.t)) ], + (Gram.Action.mk + (fun (seq : 'do_sequence) _ (e : 'sequence) _ + (_loc : Gram.Loc.t) -> + (Ast.ExWhi (_loc, (mksequence' _loc e), + seq) : + 'expr)))); + ([ Gram.Skeyword "for"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (sequence : 'sequence Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (direction_flag : + 'direction_flag Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (sequence : 'sequence Gram.Entry.t)); + Gram.Skeyword "do"; + Gram.Snterm + (Gram.Entry.obj + (do_sequence : 'do_sequence Gram.Entry.t)) ], + (Gram.Action.mk + (fun (seq : 'do_sequence) _ (e2 : 'sequence) + (df : 'direction_flag) (e1 : 'sequence) _ + (i : 'a_LIDENT) _ (_loc : Gram.Loc.t) -> + (Ast.ExFor (_loc, i, (mksequence' _loc e1), + (mksequence' _loc e2), df, seq) : + 'expr)))); + ([ Gram.Skeyword "do"; + Gram.Snterm + (Gram.Entry.obj + (do_sequence : 'do_sequence Gram.Entry.t)) ], + (Gram.Action.mk + (fun (seq : 'do_sequence) _ + (_loc : Gram.Loc.t) -> + (mksequence _loc seq : 'expr)))); + ([ Gram.Skeyword "if"; Gram.Sself; + Gram.Skeyword "then"; Gram.Sself; + Gram.Skeyword "else"; Gram.Sself ], + (Gram.Action.mk + (fun (e3 : 'expr) _ (e2 : 'expr) _ + (e1 : 'expr) _ (_loc : Gram.Loc.t) -> + (Ast.ExIfe (_loc, e1, e2, e3) : 'expr)))); + ([ Gram.Skeyword "try"; + Gram.Snterm + (Gram.Entry.obj + (sequence : 'sequence Gram.Entry.t)); + Gram.Skeyword "with"; + Gram.Snterm + (Gram.Entry.obj + (match_case : 'match_case Gram.Entry.t)) ], + (Gram.Action.mk + (fun (a : 'match_case) _ (e : 'sequence) _ + (_loc : Gram.Loc.t) -> + (Ast.ExTry (_loc, (mksequence' _loc e), a) : + 'expr)))); + ([ Gram.Skeyword "match"; + Gram.Snterm + (Gram.Entry.obj + (sequence : 'sequence Gram.Entry.t)); + Gram.Skeyword "with"; + Gram.Snterm + (Gram.Entry.obj + (match_case : 'match_case Gram.Entry.t)) ], + (Gram.Action.mk + (fun (a : 'match_case) _ (e : 'sequence) _ + (_loc : Gram.Loc.t) -> + (Ast.ExMat (_loc, (mksequence' _loc e), a) : + 'expr)))); + ([ Gram.Skeyword "fun"; + Gram.Snterm + (Gram.Entry.obj + (fun_def : 'fun_def Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'fun_def) _ (_loc : Gram.Loc.t) -> + (e : 'expr)))); + ([ Gram.Skeyword "fun"; Gram.Skeyword "["; + Gram.Slist0sep + ((Gram.Snterm + (Gram.Entry.obj + (match_case0 : + 'match_case0 Gram.Entry.t))), + (Gram.Skeyword "|")); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (a : 'match_case0 list) _ _ + (_loc : Gram.Loc.t) -> + (Ast.ExFun (_loc, (Ast.mcOr_of_list a)) : + 'expr)))); + ([ Gram.Skeyword "let"; Gram.Skeyword "open"; + Gram.Snterm + (Gram.Entry.obj + (module_longident : + 'module_longident Gram.Entry.t)); + Gram.Skeyword "in"; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) _ (i : 'module_longident) _ _ + (_loc : Gram.Loc.t) -> + (Ast.ExOpI (_loc, i, e) : 'expr)))); + ([ Gram.Skeyword "let"; Gram.Skeyword "module"; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (module_binding0 : + 'module_binding0 Gram.Entry.t)); + Gram.Skeyword "in"; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) _ (mb : 'module_binding0) + (m : 'a_UIDENT) _ _ (_loc : Gram.Loc.t) -> + (Ast.ExLmd (_loc, m, mb, e) : 'expr)))); + ([ Gram.Skeyword "let"; + Gram.Snterm + (Gram.Entry.obj + (opt_rec : 'opt_rec Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (binding : 'binding Gram.Entry.t)); + Gram.Skeyword "in"; Gram.Sself ], + (Gram.Action.mk + (fun (x : 'expr) _ (bi : 'binding) + (r : 'opt_rec) _ (_loc : Gram.Loc.t) -> + (Ast.ExLet (_loc, r, bi, x) : 'expr)))) ]); + ((Some "where"), None, + [ ([ Gram.Sself; Gram.Skeyword "where"; + Gram.Snterm + (Gram.Entry.obj + (opt_rec : 'opt_rec Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (let_binding : 'let_binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (lb : 'let_binding) (rf : 'opt_rec) _ + (e : 'expr) (_loc : Gram.Loc.t) -> + (Ast.ExLet (_loc, rf, lb, e) : 'expr)))) ]); + ((Some ":="), (Some Camlp4.Sig.Grammar.NonA), + [ ([ Gram.Sself; Gram.Skeyword ":="; Gram.Sself; + Gram.Snterm + (Gram.Entry.obj (dummy : 'dummy Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (e2 : 'expr) _ (e1 : 'expr) + (_loc : Gram.Loc.t) -> + (match bigarray_set _loc e1 e2 with + | Some e -> e + | None -> Ast.ExAss (_loc, e1, e2) : + 'expr)))) ]); + ((Some "||"), (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Sself; + Gram.Snterm + (Gram.Entry.obj + (infixop6 : 'infixop6 Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) (op : 'infixop6) + (e1 : 'expr) (_loc : Gram.Loc.t) -> + (Ast.ExApp (_loc, + (Ast.ExApp (_loc, op, e1)), e2) : + 'expr)))) ]); + ((Some "&&"), (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Sself; + Gram.Snterm + (Gram.Entry.obj + (infixop5 : 'infixop5 Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) (op : 'infixop5) + (e1 : 'expr) (_loc : Gram.Loc.t) -> + (Ast.ExApp (_loc, + (Ast.ExApp (_loc, op, e1)), e2) : + 'expr)))) ]); + ((Some "<"), (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; + Gram.Snterm + (Gram.Entry.obj + (infixop0 : 'infixop0 Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) (op : 'infixop0) + (e1 : 'expr) (_loc : Gram.Loc.t) -> + (Ast.ExApp (_loc, + (Ast.ExApp (_loc, op, e1)), e2) : + 'expr)))) ]); + ((Some "^"), (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Sself; + Gram.Snterm + (Gram.Entry.obj + (infixop1 : 'infixop1 Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) (op : 'infixop1) + (e1 : 'expr) (_loc : Gram.Loc.t) -> + (Ast.ExApp (_loc, + (Ast.ExApp (_loc, op, e1)), e2) : + 'expr)))) ]); + ((Some "+"), (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; + Gram.Snterm + (Gram.Entry.obj + (infixop2 : 'infixop2 Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) (op : 'infixop2) + (e1 : 'expr) (_loc : Gram.Loc.t) -> + (Ast.ExApp (_loc, + (Ast.ExApp (_loc, op, e1)), e2) : + 'expr)))) ]); + ((Some "*"), (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; + Gram.Snterm + (Gram.Entry.obj + (infixop3 : 'infixop3 Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) (op : 'infixop3) + (e1 : 'expr) (_loc : Gram.Loc.t) -> + (Ast.ExApp (_loc, + (Ast.ExApp (_loc, op, e1)), e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "mod"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) + (_loc : Gram.Loc.t) -> + (Ast.ExApp (_loc, + (Ast.ExApp (_loc, + (Ast.ExId (_loc, + (Ast.IdLid (_loc, "mod")))), + e1)), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "lxor"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) + (_loc : Gram.Loc.t) -> + (Ast.ExApp (_loc, + (Ast.ExApp (_loc, + (Ast.ExId (_loc, + (Ast.IdLid (_loc, "lxor")))), + e1)), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "lor"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) + (_loc : Gram.Loc.t) -> + (Ast.ExApp (_loc, + (Ast.ExApp (_loc, + (Ast.ExId (_loc, + (Ast.IdLid (_loc, "lor")))), + e1)), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "land"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) + (_loc : Gram.Loc.t) -> + (Ast.ExApp (_loc, + (Ast.ExApp (_loc, + (Ast.ExId (_loc, + (Ast.IdLid (_loc, "land")))), + e1)), + e2) : + 'expr)))) ]); + ((Some "**"), (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Sself; + Gram.Snterm + (Gram.Entry.obj + (infixop4 : 'infixop4 Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) (op : 'infixop4) + (e1 : 'expr) (_loc : Gram.Loc.t) -> + (Ast.ExApp (_loc, + (Ast.ExApp (_loc, op, e1)), e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "lsr"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) + (_loc : Gram.Loc.t) -> + (Ast.ExApp (_loc, + (Ast.ExApp (_loc, + (Ast.ExId (_loc, + (Ast.IdLid (_loc, "lsr")))), + e1)), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "lsl"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) + (_loc : Gram.Loc.t) -> + (Ast.ExApp (_loc, + (Ast.ExApp (_loc, + (Ast.ExId (_loc, + (Ast.IdLid (_loc, "lsl")))), + e1)), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "asr"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) + (_loc : Gram.Loc.t) -> + (Ast.ExApp (_loc, + (Ast.ExApp (_loc, + (Ast.ExId (_loc, + (Ast.IdLid (_loc, "asr")))), + e1)), + e2) : + 'expr)))) ]); + ((Some "unary minus"), + (Some Camlp4.Sig.Grammar.NonA), + [ ([ Gram.Skeyword "-."; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Gram.Loc.t) -> + (mkumin _loc "-." e : 'expr)))); + ([ Gram.Skeyword "-"; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Gram.Loc.t) -> + (mkumin _loc "-" e : 'expr)))) ]); + ((Some "apply"), (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Skeyword "lazy"; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Gram.Loc.t) -> + (Ast.ExLaz (_loc, e) : 'expr)))); + ([ Gram.Skeyword "new"; + Gram.Snterm + (Gram.Entry.obj + (class_longident : + 'class_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'class_longident) _ + (_loc : Gram.Loc.t) -> + (Ast.ExNew (_loc, i) : 'expr)))); + ([ Gram.Skeyword "assert"; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Gram.Loc.t) -> + (mkassert _loc e : 'expr)))); + ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) (e1 : 'expr) + (_loc : Gram.Loc.t) -> + (Ast.ExApp (_loc, e1, e2) : 'expr)))) ]); + ((Some "label"), (Some Camlp4.Sig.Grammar.NonA), + [ ([ Gram.Skeyword "?"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) _ (_loc : Gram.Loc.t) -> + (Ast.ExOlb (_loc, i, (Ast.ExNil _loc)) : + 'expr)))); + ([ Gram.Skeyword "?"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) _ (i : 'a_LIDENT) _ + (_loc : Gram.Loc.t) -> + (Ast.ExOlb (_loc, i, e) : 'expr)))); + ([ Gram.Stoken + (((function | OPTLABEL _ -> true | _ -> false), + "OPTLABEL _")); + Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | OPTLABEL i -> + (Ast.ExOlb (_loc, i, e) : 'expr) + | _ -> assert false))); + ([ Gram.Stoken + (((function | LABEL _ -> true | _ -> false), + "LABEL _")); + Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | LABEL i -> + (Ast.ExLab (_loc, i, e) : 'expr) + | _ -> assert false))); + ([ Gram.Skeyword "~"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) _ (_loc : Gram.Loc.t) -> + (Ast.ExLab (_loc, i, (Ast.ExNil _loc)) : + 'expr)))); + ([ Gram.Skeyword "~"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) _ (i : 'a_LIDENT) _ + (_loc : Gram.Loc.t) -> + (Ast.ExLab (_loc, i, e) : 'expr)))) ]); + ((Some "."), (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; Gram.Skeyword "#"; + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)) ], + (Gram.Action.mk + (fun (lab : 'label) _ (e : 'expr) + (_loc : Gram.Loc.t) -> + (Ast.ExSnd (_loc, e, lab) : 'expr)))); + ([ Gram.Sself; Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) + (_loc : Gram.Loc.t) -> + (Ast.ExAcc (_loc, e1, e2) : 'expr)))); + ([ Gram.Sself; Gram.Skeyword "."; + Gram.Skeyword "{"; + Gram.Snterm + (Gram.Entry.obj + (comma_expr : 'comma_expr Gram.Entry.t)); + Gram.Skeyword "}" ], + (Gram.Action.mk + (fun _ (e2 : 'comma_expr) _ _ (e1 : 'expr) + (_loc : Gram.Loc.t) -> + (bigarray_get _loc e1 e2 : 'expr)))); + ([ Gram.Sself; Gram.Skeyword "."; + Gram.Skeyword "["; Gram.Sself; + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (e2 : 'expr) _ _ (e1 : 'expr) + (_loc : Gram.Loc.t) -> + (Ast.ExSte (_loc, e1, e2) : 'expr)))); + ([ Gram.Sself; Gram.Skeyword "."; + Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (e2 : 'expr) _ _ (e1 : 'expr) + (_loc : Gram.Loc.t) -> + (Ast.ExAre (_loc, e1, e2) : 'expr)))) ]); + ((Some "~-"), (Some Camlp4.Sig.Grammar.NonA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (prefixop : 'prefixop Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) (f : 'prefixop) + (_loc : Gram.Loc.t) -> + (Ast.ExApp (_loc, f, e) : 'expr)))); + ([ Gram.Skeyword "!"; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Gram.Loc.t) -> + (Ast.ExAcc (_loc, e, + (Ast.ExId (_loc, + (Ast.IdLid (_loc, "val"))))) : + 'expr)))) ]); + ((Some "simple"), None, + [ ([ Gram.Skeyword "("; Gram.Skeyword "module"; + Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (package_type : + 'package_type Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (pt : 'package_type) _ + (me : 'module_expr) _ _ (_loc : Gram.Loc.t) + -> + (Ast.ExPkg (_loc, + (Ast.MeTyc (_loc, me, pt))) : + 'expr)))); + ([ Gram.Skeyword "("; Gram.Skeyword "module"; + Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (me : 'module_expr) _ _ + (_loc : Gram.Loc.t) -> + (Ast.ExPkg (_loc, me) : 'expr)))); + ([ Gram.Skeyword "begin"; Gram.Skeyword "end" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (Ast.ExId (_loc, (Ast.IdUid (_loc, "()"))) : + 'expr)))); + ([ Gram.Skeyword "begin"; + Gram.Snterm + (Gram.Entry.obj + (sequence : 'sequence Gram.Entry.t)); + Gram.Skeyword "end" ], + (Gram.Action.mk + (fun _ (seq : 'sequence) _ (_loc : Gram.Loc.t) + -> (mksequence _loc seq : 'expr)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (e : 'expr) _ (_loc : Gram.Loc.t) -> + (e : 'expr)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ":>"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (t : 'ctyp) _ (e : 'expr) _ + (_loc : Gram.Loc.t) -> + (Ast.ExCoe (_loc, e, (Ast.TyNil _loc), t) : + 'expr)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword ":>"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (t2 : 'ctyp) _ (t : 'ctyp) _ + (e : 'expr) _ (_loc : Gram.Loc.t) -> + (Ast.ExCoe (_loc, e, t, t2) : 'expr)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ";"; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ _ (e : 'expr) _ (_loc : Gram.Loc.t) -> + (mksequence _loc e : 'expr)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ";"; + Gram.Snterm + (Gram.Entry.obj + (sequence : 'sequence Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (seq : 'sequence) _ (e : 'expr) _ + (_loc : Gram.Loc.t) -> + (mksequence _loc (Ast.ExSem (_loc, e, seq)) : + 'expr)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ","; + Gram.Snterm + (Gram.Entry.obj + (comma_expr : 'comma_expr Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (el : 'comma_expr) _ (e : 'expr) _ + (_loc : Gram.Loc.t) -> + (Ast.ExTup (_loc, + (Ast.ExCom (_loc, e, el))) : + 'expr)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (t : 'ctyp) _ (e : 'expr) _ + (_loc : Gram.Loc.t) -> + (Ast.ExTyc (_loc, e, t) : 'expr)))); + ([ Gram.Skeyword "("; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (Ast.ExId (_loc, (Ast.IdUid (_loc, "()"))) : + 'expr)))); + ([ Gram.Skeyword "{<"; + Gram.Snterm + (Gram.Entry.obj + (field_expr_list : + 'field_expr_list Gram.Entry.t)); + Gram.Skeyword ">}" ], + (Gram.Action.mk + (fun _ (fel : 'field_expr_list) _ + (_loc : Gram.Loc.t) -> + (Ast.ExOvr (_loc, fel) : 'expr)))); + ([ Gram.Skeyword "{<"; Gram.Skeyword ">}" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (Ast.ExOvr (_loc, (Ast.RbNil _loc)) : + 'expr)))); + ([ Gram.Skeyword "{"; Gram.Skeyword "("; Gram. + Sself; Gram.Skeyword ")"; Gram.Skeyword "with"; + Gram.Snterm + (Gram.Entry.obj + (label_expr_list : + 'label_expr_list Gram.Entry.t)); + Gram.Skeyword "}" ], + (Gram.Action.mk + (fun _ (el : 'label_expr_list) _ _ (e : 'expr) + _ _ (_loc : Gram.Loc.t) -> + (Ast.ExRec (_loc, el, e) : 'expr)))); + ([ Gram.Skeyword "{"; + Gram.Snterm + (Gram.Entry.obj + (label_expr_list : + 'label_expr_list Gram.Entry.t)); + Gram.Skeyword "}" ], + (Gram.Action.mk + (fun _ (el : 'label_expr_list) _ + (_loc : Gram.Loc.t) -> + (Ast.ExRec (_loc, el, (Ast.ExNil _loc)) : + 'expr)))); + ([ Gram.Skeyword "[|"; + Gram.Snterm + (Gram.Entry.obj + (sem_expr : 'sem_expr Gram.Entry.t)); + Gram.Skeyword "|]" ], + (Gram.Action.mk + (fun _ (el : 'sem_expr) _ (_loc : Gram.Loc.t) + -> (Ast.ExArr (_loc, el) : 'expr)))); + ([ Gram.Skeyword "[|"; Gram.Skeyword "|]" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (Ast.ExArr (_loc, (Ast.ExNil _loc)) : + 'expr)))); + ([ Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (sem_expr_for_list : + 'sem_expr_for_list Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (mk_list : 'sem_expr_for_list) _ + (_loc : Gram.Loc.t) -> + (mk_list + (Ast.ExId (_loc, + (Ast.IdUid (_loc, "[]")))) : + 'expr)))); + ([ Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (sem_expr_for_list : + 'sem_expr_for_list Gram.Entry.t)); + Gram.Skeyword "::"; Gram.Sself; + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (last : 'expr) _ + (mk_list : 'sem_expr_for_list) _ + (_loc : Gram.Loc.t) -> + (mk_list last : 'expr)))); + ([ Gram.Skeyword "["; Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (Ast.ExId (_loc, (Ast.IdUid (_loc, "[]"))) : + 'expr)))); + ([ Gram.Skeyword "`"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_ident) _ (_loc : Gram.Loc.t) -> + (Ast.ExVrn (_loc, s) : 'expr)))); + ([ Gram.Stry + (Gram.Snterm + (Gram.Entry.obj + (val_longident : + 'val_longident Gram.Entry.t))) ], + (Gram.Action.mk + (fun (i : 'val_longident) (_loc : Gram.Loc.t) + -> (Ast.ExId (_loc, i) : 'expr)))); + ([ Gram.Stry + (Gram.Snterm + (Gram.Entry.obj + (module_longident_dot_lparen : + 'module_longident_dot_lparen Gram. + Entry.t))); + Gram.Snterm + (Gram.Entry.obj + (sequence : 'sequence Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (e : 'sequence) + (i : 'module_longident_dot_lparen) + (_loc : Gram.Loc.t) -> + (Ast.ExOpI (_loc, i, e) : 'expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_CHAR : 'a_CHAR Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_CHAR) (_loc : Gram.Loc.t) -> + (Ast.ExChr (_loc, s) : 'expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_STRING : 'a_STRING Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_STRING) (_loc : Gram.Loc.t) -> + (Ast.ExStr (_loc, s) : 'expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_FLOAT : 'a_FLOAT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_FLOAT) (_loc : Gram.Loc.t) -> + (Ast.ExFlo (_loc, s) : 'expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_NATIVEINT : 'a_NATIVEINT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_NATIVEINT) (_loc : Gram.Loc.t) -> + (Ast.ExNativeInt (_loc, s) : 'expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_INT64 : 'a_INT64 Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_INT64) (_loc : Gram.Loc.t) -> + (Ast.ExInt64 (_loc, s) : 'expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_INT32 : 'a_INT32 Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_INT32) (_loc : Gram.Loc.t) -> + (Ast.ExInt32 (_loc, s) : 'expr)))); + ([ Gram.Snterm + (Gram.Entry.obj (a_INT : 'a_INT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_INT) (_loc : Gram.Loc.t) -> + (Ast.ExInt (_loc, s) : 'expr)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("seq", _) -> true + | _ -> false), + "ANTIQUOT (\"seq\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("seq" as n)), s) -> + (Ast.ExSeq (_loc, + (Ast.ExAnt (_loc, + (mk_anti ~c: "expr" n s)))) : + 'expr) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("tup", _) -> true + | _ -> false), + "ANTIQUOT (\"tup\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("tup" as n)), s) -> + (Ast.ExTup (_loc, + (Ast.ExAnt (_loc, + (mk_anti ~c: "expr" n s)))) : + 'expr) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("`bool", _) -> true + | _ -> false), + "ANTIQUOT (\"`bool\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("`bool" as n)), s) -> + (Ast.ExId (_loc, + (Ast.IdAnt (_loc, (mk_anti n s)))) : + 'expr) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("exp" | "" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"exp\" | \"\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("exp" | "" | "anti" as n)), + s) -> + (Ast.ExAnt (_loc, + (mk_anti ~c: "expr" n s)) : + 'expr) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.expr_tag : + 'expr) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (do_sequence : 'do_sequence Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "done" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (Ast.ExId (_loc, (Ast.IdUid (_loc, "()"))) : + 'do_sequence)))); + ([ Gram.Stry + (Gram.srules do_sequence + [ ([ Gram.Snterm + (Gram.Entry.obj + (sequence : + 'sequence Gram.Entry.t)); + Gram.Skeyword "done" ], + (Gram.Action.mk + (fun _ (seq : 'sequence) + (_loc : Gram.Loc.t) -> + (seq : 'e__3)))) ]) ], + (Gram.Action.mk + (fun (seq : 'e__3) (_loc : Gram.Loc.t) -> + (seq : 'do_sequence)))); + ([ Gram.Stry + (Gram.srules do_sequence + [ ([ Gram.Skeyword "{"; Gram.Skeyword "}" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (() : 'e__2)))) ]) ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (Ast.ExId (_loc, (Ast.IdUid (_loc, "()"))) : + 'do_sequence)))); + ([ Gram.Stry + (Gram.srules do_sequence + [ ([ Gram.Skeyword "{"; + Gram.Snterm + (Gram.Entry.obj + (sequence : + 'sequence Gram.Entry.t)); + Gram.Skeyword "}" ], + (Gram.Action.mk + (fun _ (seq : 'sequence) _ + (_loc : Gram.Loc.t) -> + (seq : 'e__1)))) ]) ], + (Gram.Action.mk + (fun (seq : 'e__1) (_loc : Gram.Loc.t) -> + (seq : 'do_sequence)))) ]) ])) + ()); + Gram.extend (infixop5 : 'infixop5 Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.srules infixop5 + [ ([ Gram.Skeyword "&&" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) + (_loc : Gram.Loc.t) -> + (Gram.Token.extract_string x : + 'e__4)))); + ([ Gram.Skeyword "&" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) + (_loc : Gram.Loc.t) -> + (Gram.Token.extract_string x : + 'e__4)))) ] ], + (Gram.Action.mk + (fun (x : 'e__4) (_loc : Gram.Loc.t) -> + (Ast.ExId (_loc, (Ast.IdLid (_loc, x))) : + 'infixop5)))) ]) ])) + ()); + Gram.extend (infixop6 : 'infixop6 Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.srules infixop6 + [ ([ Gram.Skeyword "||" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) + (_loc : Gram.Loc.t) -> + (Gram.Token.extract_string x : + 'e__5)))); + ([ Gram.Skeyword "or" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) + (_loc : Gram.Loc.t) -> + (Gram.Token.extract_string x : + 'e__5)))) ] ], + (Gram.Action.mk + (fun (x : 'e__5) (_loc : Gram.Loc.t) -> + (Ast.ExId (_loc, (Ast.IdLid (_loc, x))) : + 'infixop6)))) ]) ])) + ()); + Gram.extend + (sem_expr_for_list : 'sem_expr_for_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) (_loc : Gram.Loc.t) -> + (fun acc -> + Ast.ExApp (_loc, + (Ast.ExApp (_loc, + (Ast.ExId (_loc, + (Ast.IdUid (_loc, "::")))), + e)), + acc) : + 'sem_expr_for_list)))); + ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword ";" ], + (Gram.Action.mk + (fun _ (e : 'expr) (_loc : Gram.Loc.t) -> + (fun acc -> + Ast.ExApp (_loc, + (Ast.ExApp (_loc, + (Ast.ExId (_loc, + (Ast.IdUid (_loc, "::")))), + e)), + acc) : + 'sem_expr_for_list)))); + ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (el : 'sem_expr_for_list) _ (e : 'expr) + (_loc : Gram.Loc.t) -> + (fun acc -> + Ast.ExApp (_loc, + (Ast.ExApp (_loc, + (Ast.ExId (_loc, + (Ast.IdUid (_loc, "::")))), + e)), + (el acc)) : + 'sem_expr_for_list)))) ]) ])) + ()); + Gram.extend (comma_expr : 'comma_expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterml + ((Gram.Entry.obj (expr : 'expr Gram.Entry.t)), + "top") ], + (Gram.Action.mk + (fun (e : 'expr) (_loc : Gram.Loc.t) -> + (e : 'comma_expr)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.ExAnt (_loc, + (mk_anti ~c: "expr," n s)) : + 'comma_expr) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword ","; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'comma_expr) _ (e1 : 'comma_expr) + (_loc : Gram.Loc.t) -> + (Ast.ExCom (_loc, e1, e2) : 'comma_expr)))) ]) ])) + ()); + Gram.extend (dummy : 'dummy Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> (() : 'dummy)))) ]) ])) + ()); + Gram.extend (sequence' : 'sequence' Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword ";"; + Gram.Snterm + (Gram.Entry.obj + (sequence : 'sequence Gram.Entry.t)) ], + (Gram.Action.mk + (fun (el : 'sequence) _ (_loc : Gram.Loc.t) -> + (fun e -> Ast.ExSem (_loc, e, el) : + 'sequence')))); + ([ Gram.Skeyword ";" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (fun e -> e : 'sequence')))); + ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (fun e -> e : 'sequence')))) ]) ])) + ()); + Gram.extend (sequence : 'sequence Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (sequence' : 'sequence' Gram.Entry.t)) ], + (Gram.Action.mk + (fun (k : 'sequence') (e : 'expr) + (_loc : Gram.Loc.t) -> (k e : 'sequence)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.ExAnt (_loc, + (mk_anti ~c: "expr;" n s)) : + 'sequence) + | _ -> assert false))); + ([ Gram.Skeyword "let"; Gram.Skeyword "open"; + Gram.Snterm + (Gram.Entry.obj + (module_longident : + 'module_longident Gram.Entry.t)); + Gram.Skeyword "in"; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'sequence) _ (i : 'module_longident) + _ _ (_loc : Gram.Loc.t) -> + (Ast.ExOpI (_loc, i, e) : 'sequence)))); + ([ Gram.Skeyword "let"; Gram.Skeyword "module"; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (module_binding0 : + 'module_binding0 Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (el : 'sequence) _ + (mb : 'module_binding0) (m : 'a_UIDENT) _ _ + (_loc : Gram.Loc.t) -> + (Ast.ExLmd (_loc, m, mb, + (mksequence _loc el)) : + 'sequence)))); + ([ Gram.Skeyword "let"; Gram.Skeyword "module"; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (module_binding0 : + 'module_binding0 Gram.Entry.t)); + Gram.Skeyword "in"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (sequence' : 'sequence' Gram.Entry.t)) ], + (Gram.Action.mk + (fun (k : 'sequence') (e : 'expr) _ + (mb : 'module_binding0) (m : 'a_UIDENT) _ _ + (_loc : Gram.Loc.t) -> + (k (Ast.ExLmd (_loc, m, mb, e)) : + 'sequence)))); + ([ Gram.Skeyword "let"; + Gram.Snterm + (Gram.Entry.obj + (opt_rec : 'opt_rec Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (binding : 'binding Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (el : 'sequence) _ (bi : 'binding) + (rf : 'opt_rec) _ (_loc : Gram.Loc.t) -> + (Ast.ExLet (_loc, rf, bi, + (mksequence _loc el)) : + 'sequence)))); + ([ Gram.Skeyword "let"; + Gram.Snterm + (Gram.Entry.obj + (opt_rec : 'opt_rec Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (binding : 'binding Gram.Entry.t)); + Gram.Skeyword "in"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (sequence' : 'sequence' Gram.Entry.t)) ], + (Gram.Action.mk + (fun (k : 'sequence') (e : 'expr) _ + (bi : 'binding) (rf : 'opt_rec) _ + (_loc : Gram.Loc.t) -> + (k (Ast.ExLet (_loc, rf, bi, e)) : + 'sequence)))) ]) ])) + ()); + Gram.extend (binding : 'binding Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (let_binding : 'let_binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (b : 'let_binding) (_loc : Gram.Loc.t) -> + (b : 'binding)))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (b2 : 'binding) _ (b1 : 'binding) + (_loc : Gram.Loc.t) -> + (Ast.BiAnd (_loc, b1, b2) : 'binding)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "anti"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "anti" as n)), s) -> + (Ast.BiAnt (_loc, + (mk_anti ~c: "binding" n s)) : + 'binding) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "anti"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"anti\"), _)")); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "anti" as n)), s) -> + (Ast.BiEq (_loc, + (Ast.PaAnt (_loc, + (mk_anti ~c: "patt" n s))), + e) : + 'binding) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("binding" | "list"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"binding\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("binding" | "list" as n)), s) + -> + (Ast.BiAnt (_loc, + (mk_anti ~c: "binding" n s)) : + 'binding) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (let_binding : 'let_binding Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (fun_binding : 'fun_binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'fun_binding) (p : 'ipatt) + (_loc : Gram.Loc.t) -> + (Ast.BiEq (_loc, p, e) : 'let_binding)))) ]) ])) + ()); + Gram.extend (fun_binding : 'fun_binding Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (cvalue_binding : + 'cvalue_binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (bi : 'cvalue_binding) + (_loc : Gram.Loc.t) -> (bi : 'fun_binding)))); + ([ Gram.Stry + (Gram.Snterm + (Gram.Entry.obj + (labeled_ipatt : + 'labeled_ipatt Gram.Entry.t))); + Gram.Sself ], + (Gram.Action.mk + (fun (e : 'fun_binding) (p : 'labeled_ipatt) + (_loc : Gram.Loc.t) -> + (Ast.ExFun (_loc, + (Ast.McArr (_loc, p, (Ast.ExNil _loc), + e))) : + 'fun_binding)))); + ([ Gram.Stry + (Gram.srules fun_binding + [ ([ Gram.Skeyword "("; + Gram.Skeyword "type" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (() : 'e__6)))) ]); + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ")"; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'fun_binding) _ (i : 'a_LIDENT) _ + (_loc : Gram.Loc.t) -> + (Ast.ExFUN (_loc, i, e) : 'fun_binding)))) ]) ])) + ()); + Gram.extend (match_case : 'match_case Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)); + Gram.Skeyword "->"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (p : 'ipatt) + (_loc : Gram.Loc.t) -> + (Ast.McArr (_loc, p, (Ast.ExNil _loc), e) : + 'match_case)))); + ([ Gram.Skeyword "["; + Gram.Slist0sep + ((Gram.Snterm + (Gram.Entry.obj + (match_case0 : + 'match_case0 Gram.Entry.t))), + (Gram.Skeyword "|")); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (l : 'match_case0 list) _ + (_loc : Gram.Loc.t) -> + (Ast.mcOr_of_list l : 'match_case)))) ]) ])) + ()); + Gram.extend (match_case0 : 'match_case0 Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (patt_as_patt_opt : + 'patt_as_patt_opt Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_when_expr : + 'opt_when_expr Gram.Entry.t)); + Gram.Skeyword "->"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (w : 'opt_when_expr) + (p : 'patt_as_patt_opt) (_loc : Gram.Loc.t) + -> + (Ast.McArr (_loc, p, w, e) : 'match_case0)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "anti"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"anti\"), _)")); + Gram.Skeyword "when"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword "->"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (w : 'expr) _ + (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "anti" as n)), s) -> + (Ast.McArr (_loc, + (Ast.PaAnt (_loc, + (mk_anti ~c: "patt" n s))), + w, e) : + 'match_case0) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "anti"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"anti\"), _)")); + Gram.Skeyword "->"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "anti" as n)), s) -> + (Ast.McArr (_loc, + (Ast.PaAnt (_loc, + (mk_anti ~c: "patt" n s))), + (Ast.ExNil _loc), e) : + 'match_case0) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "anti"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "anti" as n)), s) -> + (Ast.McAnt (_loc, + (mk_anti ~c: "match_case" n s)) : + 'match_case0) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("match_case" | "list"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"match_case\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("match_case" | "list" as n)), + s) -> + (Ast.McAnt (_loc, + (mk_anti ~c: "match_case" n s)) : + 'match_case0) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (opt_when_expr : 'opt_when_expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.ExNil _loc : 'opt_when_expr)))); + ([ Gram.Skeyword "when"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (w : 'expr) _ (_loc : Gram.Loc.t) -> + (w : 'opt_when_expr)))) ]) ])) + ()); + Gram.extend + (patt_as_patt_opt : 'patt_as_patt_opt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'patt) (_loc : Gram.Loc.t) -> + (p : 'patt_as_patt_opt)))); + ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword "as"; + Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p2 : 'patt) _ (p1 : 'patt) + (_loc : Gram.Loc.t) -> + (Ast.PaAli (_loc, p1, p2) : + 'patt_as_patt_opt)))) ]) ])) + ()); + Gram.extend (label_expr_list : 'label_expr_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (label_expr : 'label_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (b1 : 'label_expr) (_loc : Gram.Loc.t) -> + (b1 : 'label_expr_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (label_expr : 'label_expr Gram.Entry.t)); + Gram.Skeyword ";" ], + (Gram.Action.mk + (fun _ (b1 : 'label_expr) (_loc : Gram.Loc.t) + -> (b1 : 'label_expr_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (label_expr : 'label_expr Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (b2 : 'label_expr_list) _ + (b1 : 'label_expr) (_loc : Gram.Loc.t) -> + (Ast.RbSem (_loc, b1, b2) : + 'label_expr_list)))) ]) ])) + ()); + Gram.extend (label_expr : 'label_expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (label_longident : + 'label_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'label_longident) + (_loc : Gram.Loc.t) -> + (Ast.RbEq (_loc, i, + (Ast.ExId (_loc, + (Ast.IdLid (_loc, (lid_of_ident i)))))) : + 'label_expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (label_longident : + 'label_longident Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (fun_binding : 'fun_binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'fun_binding) (i : 'label_longident) + (_loc : Gram.Loc.t) -> + (Ast.RbEq (_loc, i, e) : 'label_expr)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.RbAnt (_loc, + (mk_anti ~c: "rec_binding" n s)) : + 'label_expr) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "anti"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"anti\"), _)")); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "anti" as n)), s) -> + (Ast.RbEq (_loc, + (Ast.IdAnt (_loc, + (mk_anti ~c: "ident" n s))), + e) : + 'label_expr) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "anti"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "anti" as n)), s) -> + (Ast.RbAnt (_loc, + (mk_anti ~c: "rec_binding" n s)) : + 'label_expr) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("rec_binding", _) -> true + | _ -> false), + "ANTIQUOT (\"rec_binding\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("rec_binding" as n)), s) -> + (Ast.RbAnt (_loc, + (mk_anti ~c: "rec_binding" n s)) : + 'label_expr) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (fun_def : 'fun_def Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stry + (Gram.Snterm + (Gram.Entry.obj + (labeled_ipatt : + 'labeled_ipatt Gram.Entry.t))); + Gram.Snterm + (Gram.Entry.obj + (fun_def_cont : + 'fun_def_cont Gram.Entry.t)) ], + (Gram.Action.mk + (fun ((w, e) : 'fun_def_cont) + (p : 'labeled_ipatt) (_loc : Gram.Loc.t) -> + (Ast.ExFun (_loc, + (Ast.McArr (_loc, p, w, e))) : + 'fun_def)))); + ([ Gram.Stry + (Gram.srules fun_def + [ ([ Gram.Skeyword "("; + Gram.Skeyword "type" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (() : 'e__7)))) ]); + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ")"; + Gram.Snterm + (Gram.Entry.obj + (fun_def_cont_no_when : + 'fun_def_cont_no_when Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'fun_def_cont_no_when) _ + (i : 'a_LIDENT) _ (_loc : Gram.Loc.t) -> + (Ast.ExFUN (_loc, i, e) : 'fun_def)))) ]) ])) + ()); + Gram.extend (fun_def_cont : 'fun_def_cont Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Skeyword "->"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Gram.Loc.t) -> + (((Ast.ExNil _loc), e) : 'fun_def_cont)))); + ([ Gram.Skeyword "when"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword "->"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (w : 'expr) _ + (_loc : Gram.Loc.t) -> + ((w, e) : 'fun_def_cont)))); + ([ Gram.Stry + (Gram.Snterm + (Gram.Entry.obj + (labeled_ipatt : + 'labeled_ipatt Gram.Entry.t))); + Gram.Sself ], + (Gram.Action.mk + (fun ((w, e) : 'fun_def_cont) + (p : 'labeled_ipatt) (_loc : Gram.Loc.t) -> + (((Ast.ExNil _loc), + (Ast.ExFun (_loc, + (Ast.McArr (_loc, p, w, e))))) : + 'fun_def_cont)))); + ([ Gram.Stry + (Gram.srules fun_def_cont + [ ([ Gram.Skeyword "("; + Gram.Skeyword "type" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (() : 'e__8)))) ]); + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ")"; + Gram.Snterm + (Gram.Entry.obj + (fun_def_cont_no_when : + 'fun_def_cont_no_when Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'fun_def_cont_no_when) _ + (i : 'a_LIDENT) _ (_loc : Gram.Loc.t) -> + (((Ast.ExNil _loc), + (Ast.ExFUN (_loc, i, e))) : + 'fun_def_cont)))) ]) ])) + ()); + Gram.extend + (fun_def_cont_no_when : 'fun_def_cont_no_when Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Skeyword "->"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Gram.Loc.t) -> + (e : 'fun_def_cont_no_when)))); + ([ Gram.Stry + (Gram.Snterm + (Gram.Entry.obj + (labeled_ipatt : + 'labeled_ipatt Gram.Entry.t))); + Gram.Snterm + (Gram.Entry.obj + (fun_def_cont : + 'fun_def_cont Gram.Entry.t)) ], + (Gram.Action.mk + (fun ((w, e) : 'fun_def_cont) + (p : 'labeled_ipatt) (_loc : Gram.Loc.t) -> + (Ast.ExFun (_loc, + (Ast.McArr (_loc, p, w, e))) : + 'fun_def_cont_no_when)))); + ([ Gram.Stry + (Gram.srules fun_def_cont_no_when + [ ([ Gram.Skeyword "("; + Gram.Skeyword "type" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (() : 'e__9)))) ]); + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ")"; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'fun_def_cont_no_when) _ + (i : 'a_LIDENT) _ (_loc : Gram.Loc.t) -> + (Ast.ExFUN (_loc, i, e) : + 'fun_def_cont_no_when)))) ]) ])) + ()); + Gram.extend (patt : 'patt Gram.Entry.t) + ((fun () -> + (None, + [ ((Some "|"), (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; Gram.Skeyword "|"; Gram.Sself ], + (Gram.Action.mk + (fun (p2 : 'patt) _ (p1 : 'patt) + (_loc : Gram.Loc.t) -> + (Ast.PaOrp (_loc, p1, p2) : 'patt)))) ]); + ((Some ".."), (Some Camlp4.Sig.Grammar.NonA), + [ ([ Gram.Sself; Gram.Skeyword ".."; Gram.Sself ], + (Gram.Action.mk + (fun (p2 : 'patt) _ (p1 : 'patt) + (_loc : Gram.Loc.t) -> + (Ast.PaRng (_loc, p1, p2) : 'patt)))) ]); + ((Some "apply"), (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Skeyword "lazy"; Gram.Sself ], + (Gram.Action.mk + (fun (p : 'patt) _ (_loc : Gram.Loc.t) -> + (Ast.PaLaz (_loc, p) : 'patt)))); + ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (p2 : 'patt) (p1 : 'patt) + (_loc : Gram.Loc.t) -> + (Ast.PaApp (_loc, p1, p2) : 'patt)))) ]); + ((Some "simple"), None, + [ ([ Gram.Skeyword "?"; Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (patt_tcon : 'patt_tcon Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (e : 'expr) _ (p : 'patt_tcon) _ _ + (_loc : Gram.Loc.t) -> + (Ast.PaOlbi (_loc, "", p, e) : 'patt)))); + ([ Gram.Skeyword "?"; Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (patt_tcon : 'patt_tcon Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (p : 'patt_tcon) _ _ + (_loc : Gram.Loc.t) -> + (Ast.PaOlb (_loc, "", p) : 'patt)))); + ([ Gram.Skeyword "?"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "lid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"lid\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "lid" as n)), i) -> + (Ast.PaOlb (_loc, (mk_anti n i), + (Ast.PaNil _loc)) : + 'patt) + | _ -> assert false))); + ([ Gram.Skeyword "?"; + Gram.Stoken + (((function | LIDENT _ -> true | _ -> false), + "LIDENT _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | LIDENT i -> + (Ast.PaOlb (_loc, i, (Ast.PaNil _loc)) : + 'patt) + | _ -> assert false))); + ([ Gram.Skeyword "?"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "lid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"lid\"), _)")); + Gram.Skeyword ":"; Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (patt_tcon : 'patt_tcon Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (eq_expr : 'eq_expr Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (f : 'eq_expr) (p : 'patt_tcon) _ _ + (__camlp4_0 : Gram.Token.t) _ + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "lid" as n)), i) -> + (f (mk_anti n i) p : 'patt) + | _ -> assert false))); + ([ Gram.Stoken + (((function | OPTLABEL _ -> true | _ -> false), + "OPTLABEL _")); + Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (patt_tcon : 'patt_tcon Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (eq_expr : 'eq_expr Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (f : 'eq_expr) (p : 'patt_tcon) _ + (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | OPTLABEL i -> (f i p : 'patt) + | _ -> assert false))); + ([ Gram.Skeyword "~"; + Gram.Stoken + (((function | LIDENT _ -> true | _ -> false), + "LIDENT _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | LIDENT i -> + (Ast.PaLab (_loc, i, (Ast.PaNil _loc)) : + 'patt) + | _ -> assert false))); + ([ Gram.Skeyword "~"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "lid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"lid\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "lid" as n)), i) -> + (Ast.PaLab (_loc, (mk_anti n i), + (Ast.PaNil _loc)) : + 'patt) + | _ -> assert false))); + ([ Gram.Skeyword "~"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "lid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"lid\"), _)")); + Gram.Skeyword ":"; Gram.Sself ], + (Gram.Action.mk + (fun (p : 'patt) _ (__camlp4_0 : Gram.Token.t) + _ (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "lid" as n)), i) -> + (Ast.PaLab (_loc, (mk_anti n i), p) : + 'patt) + | _ -> assert false))); + ([ Gram.Stoken + (((function | LABEL _ -> true | _ -> false), + "LABEL _")); + Gram.Sself ], + (Gram.Action.mk + (fun (p : 'patt) (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | LABEL i -> + (Ast.PaLab (_loc, i, p) : 'patt) + | _ -> assert false))); + ([ Gram.Skeyword "#"; + Gram.Snterm + (Gram.Entry.obj + (type_longident : + 'type_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'type_longident) _ + (_loc : Gram.Loc.t) -> + (Ast.PaTyp (_loc, i) : 'patt)))); + ([ Gram.Skeyword "`"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_ident) _ (_loc : Gram.Loc.t) -> + (Ast.PaVrn (_loc, s) : 'patt)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.patt_tag : + 'patt) + | _ -> assert false))); + ([ Gram.Skeyword "_" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (Ast.PaAny _loc : 'patt)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ","; + Gram.Snterm + (Gram.Entry.obj + (comma_patt : 'comma_patt Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (pl : 'comma_patt) _ (p : 'patt) _ + (_loc : Gram.Loc.t) -> + (Ast.PaTup (_loc, + (Ast.PaCom (_loc, p, pl))) : + 'patt)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword "as"; Gram.Sself; + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (p2 : 'patt) _ (p : 'patt) _ + (_loc : Gram.Loc.t) -> + (Ast.PaAli (_loc, p, p2) : 'patt)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (t : 'ctyp) _ (p : 'patt) _ + (_loc : Gram.Loc.t) -> + (Ast.PaTyc (_loc, p, t) : 'patt)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (p : 'patt) _ (_loc : Gram.Loc.t) -> + (p : 'patt)))); + ([ Gram.Skeyword "("; Gram.Skeyword "module"; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (package_type : + 'package_type Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (pt : 'package_type) _ (m : 'a_UIDENT) + _ _ (_loc : Gram.Loc.t) -> + (Ast.PaTyc (_loc, (Ast.PaMod (_loc, m)), + (Ast.TyPkg (_loc, pt))) : + 'patt)))); + ([ Gram.Skeyword "("; Gram.Skeyword "module"; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (m : 'a_UIDENT) _ _ (_loc : Gram.Loc.t) + -> (Ast.PaMod (_loc, m) : 'patt)))); + ([ Gram.Skeyword "("; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (Ast.PaId (_loc, (Ast.IdUid (_loc, "()"))) : + 'patt)))); + ([ Gram.Skeyword "{"; + Gram.Snterm + (Gram.Entry.obj + (label_patt_list : + 'label_patt_list Gram.Entry.t)); + Gram.Skeyword "}" ], + (Gram.Action.mk + (fun _ (pl : 'label_patt_list) _ + (_loc : Gram.Loc.t) -> + (Ast.PaRec (_loc, pl) : 'patt)))); + ([ Gram.Skeyword "[|"; + Gram.Snterm + (Gram.Entry.obj + (sem_patt : 'sem_patt Gram.Entry.t)); + Gram.Skeyword "|]" ], + (Gram.Action.mk + (fun _ (pl : 'sem_patt) _ (_loc : Gram.Loc.t) + -> (Ast.PaArr (_loc, pl) : 'patt)))); + ([ Gram.Skeyword "[|"; Gram.Skeyword "|]" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (Ast.PaArr (_loc, (Ast.PaNil _loc)) : + 'patt)))); + ([ Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (sem_patt_for_list : + 'sem_patt_for_list Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (mk_list : 'sem_patt_for_list) _ + (_loc : Gram.Loc.t) -> + (mk_list + (Ast.PaId (_loc, + (Ast.IdUid (_loc, "[]")))) : + 'patt)))); + ([ Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (sem_patt_for_list : + 'sem_patt_for_list Gram.Entry.t)); + Gram.Skeyword "::"; Gram.Sself; + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (last : 'patt) _ + (mk_list : 'sem_patt_for_list) _ + (_loc : Gram.Loc.t) -> + (mk_list last : 'patt)))); + ([ Gram.Skeyword "["; Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (Ast.PaId (_loc, (Ast.IdUid (_loc, "[]"))) : + 'patt)))); + ([ Gram.Skeyword "-"; + Gram.Snterm + (Gram.Entry.obj + (a_FLOAT : 'a_FLOAT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_FLOAT) _ (_loc : Gram.Loc.t) -> + (Ast.PaFlo (_loc, (neg_string s)) : 'patt)))); + ([ Gram.Skeyword "-"; + Gram.Snterm + (Gram.Entry.obj + (a_NATIVEINT : 'a_NATIVEINT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_NATIVEINT) _ (_loc : Gram.Loc.t) + -> + (Ast.PaNativeInt (_loc, (neg_string s)) : + 'patt)))); + ([ Gram.Skeyword "-"; + Gram.Snterm + (Gram.Entry.obj + (a_INT64 : 'a_INT64 Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_INT64) _ (_loc : Gram.Loc.t) -> + (Ast.PaInt64 (_loc, (neg_string s)) : + 'patt)))); + ([ Gram.Skeyword "-"; + Gram.Snterm + (Gram.Entry.obj + (a_INT32 : 'a_INT32 Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_INT32) _ (_loc : Gram.Loc.t) -> + (Ast.PaInt32 (_loc, (neg_string s)) : + 'patt)))); + ([ Gram.Skeyword "-"; + Gram.Snterm + (Gram.Entry.obj (a_INT : 'a_INT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_INT) _ (_loc : Gram.Loc.t) -> + (Ast.PaInt (_loc, (neg_string s)) : 'patt)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_CHAR : 'a_CHAR Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_CHAR) (_loc : Gram.Loc.t) -> + (Ast.PaChr (_loc, s) : 'patt)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_STRING : 'a_STRING Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_STRING) (_loc : Gram.Loc.t) -> + (Ast.PaStr (_loc, s) : 'patt)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_FLOAT : 'a_FLOAT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_FLOAT) (_loc : Gram.Loc.t) -> + (Ast.PaFlo (_loc, s) : 'patt)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_NATIVEINT : 'a_NATIVEINT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_NATIVEINT) (_loc : Gram.Loc.t) -> + (Ast.PaNativeInt (_loc, s) : 'patt)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_INT64 : 'a_INT64 Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_INT64) (_loc : Gram.Loc.t) -> + (Ast.PaInt64 (_loc, s) : 'patt)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_INT32 : 'a_INT32 Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_INT32) (_loc : Gram.Loc.t) -> + (Ast.PaInt32 (_loc, s) : 'patt)))); + ([ Gram.Snterm + (Gram.Entry.obj (a_INT : 'a_INT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_INT) (_loc : Gram.Loc.t) -> + (Ast.PaInt (_loc, s) : 'patt)))); + ([ Gram.Snterm + (Gram.Entry.obj (ident : 'ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'ident) (_loc : Gram.Loc.t) -> + (Ast.PaId (_loc, i) : 'patt)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("`bool", _) -> true + | _ -> false), + "ANTIQUOT (\"`bool\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("`bool" as n)), s) -> + (Ast.PaId (_loc, + (Ast.IdAnt (_loc, (mk_anti n s)))) : + 'patt) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("tup", _) -> true + | _ -> false), + "ANTIQUOT (\"tup\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("tup" as n)), s) -> + (Ast.PaTup (_loc, + (Ast.PaAnt (_loc, + (mk_anti ~c: "patt" n s)))) : + 'patt) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "pat" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"pat\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "pat" | "anti" as n)), + s) -> + (Ast.PaAnt (_loc, + (mk_anti ~c: "patt" n s)) : + 'patt) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (comma_patt : 'comma_patt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'patt) (_loc : Gram.Loc.t) -> + (p : 'comma_patt)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.PaAnt (_loc, + (mk_anti ~c: "patt," n s)) : + 'comma_patt) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword ","; Gram.Sself ], + (Gram.Action.mk + (fun (p2 : 'comma_patt) _ (p1 : 'comma_patt) + (_loc : Gram.Loc.t) -> + (Ast.PaCom (_loc, p1, p2) : 'comma_patt)))) ]) ])) + ()); + Gram.extend (sem_patt : 'sem_patt Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'patt) (_loc : Gram.Loc.t) -> + (p : 'sem_patt)))); + ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword ";" ], + (Gram.Action.mk + (fun _ (p : 'patt) (_loc : Gram.Loc.t) -> + (p : 'sem_patt)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.PaAnt (_loc, + (mk_anti ~c: "patt;" n s)) : + 'sem_patt) + | _ -> assert false))); + ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (p2 : 'sem_patt) _ (p1 : 'patt) + (_loc : Gram.Loc.t) -> + (Ast.PaSem (_loc, p1, p2) : 'sem_patt)))) ]) ])) + ()); + Gram.extend + (sem_patt_for_list : 'sem_patt_for_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'patt) (_loc : Gram.Loc.t) -> + (fun acc -> + Ast.PaApp (_loc, + (Ast.PaApp (_loc, + (Ast.PaId (_loc, + (Ast.IdUid (_loc, "::")))), + p)), + acc) : + 'sem_patt_for_list)))); + ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword ";" ], + (Gram.Action.mk + (fun _ (p : 'patt) (_loc : Gram.Loc.t) -> + (fun acc -> + Ast.PaApp (_loc, + (Ast.PaApp (_loc, + (Ast.PaId (_loc, + (Ast.IdUid (_loc, "::")))), + p)), + acc) : + 'sem_patt_for_list)))); + ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (pl : 'sem_patt_for_list) _ (p : 'patt) + (_loc : Gram.Loc.t) -> + (fun acc -> + Ast.PaApp (_loc, + (Ast.PaApp (_loc, + (Ast.PaId (_loc, + (Ast.IdUid (_loc, "::")))), + p)), + (pl acc)) : + 'sem_patt_for_list)))) ]) ])) + ()); + Gram.extend (label_patt_list : 'label_patt_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (label_patt : 'label_patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p1 : 'label_patt) (_loc : Gram.Loc.t) -> + (p1 : 'label_patt_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (label_patt : 'label_patt Gram.Entry.t)); + Gram.Skeyword ";" ], + (Gram.Action.mk + (fun _ (p1 : 'label_patt) (_loc : Gram.Loc.t) + -> (p1 : 'label_patt_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (label_patt : 'label_patt Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Skeyword "_"; + Gram.Skeyword ";" ], + (Gram.Action.mk + (fun _ _ _ (p1 : 'label_patt) + (_loc : Gram.Loc.t) -> + (Ast.PaSem (_loc, p1, (Ast.PaAny _loc)) : + 'label_patt_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (label_patt : 'label_patt Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Skeyword "_" ], + (Gram.Action.mk + (fun _ _ (p1 : 'label_patt) + (_loc : Gram.Loc.t) -> + (Ast.PaSem (_loc, p1, (Ast.PaAny _loc)) : + 'label_patt_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (label_patt : 'label_patt Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (p2 : 'label_patt_list) _ + (p1 : 'label_patt) (_loc : Gram.Loc.t) -> + (Ast.PaSem (_loc, p1, p2) : + 'label_patt_list)))) ]) ])) + ()); + Gram.extend (label_patt : 'label_patt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (label_longident : + 'label_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'label_longident) + (_loc : Gram.Loc.t) -> + (Ast.PaEq (_loc, i, + (Ast.PaId (_loc, + (Ast.IdLid (_loc, (lid_of_ident i)))))) : + 'label_patt)))); + ([ Gram.Snterm + (Gram.Entry.obj + (label_longident : + 'label_longident Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'patt) _ (i : 'label_longident) + (_loc : Gram.Loc.t) -> + (Ast.PaEq (_loc, i, p) : 'label_patt)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.PaAnt (_loc, + (mk_anti ~c: "patt;" n s)) : + 'label_patt) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.patt_tag : + 'label_patt) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "pat" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"pat\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "pat" | "anti" as n)), + s) -> + (Ast.PaAnt (_loc, + (mk_anti ~c: "patt" n s)) : + 'label_patt) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (ipatt : 'ipatt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "_" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (Ast.PaAny _loc : 'ipatt)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_LIDENT) (_loc : Gram.Loc.t) -> + (Ast.PaId (_loc, (Ast.IdLid (_loc, s))) : + 'ipatt)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ","; + Gram.Snterm + (Gram.Entry.obj + (comma_ipatt : 'comma_ipatt Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (pl : 'comma_ipatt) _ (p : 'ipatt) _ + (_loc : Gram.Loc.t) -> + (Ast.PaTup (_loc, + (Ast.PaCom (_loc, p, pl))) : + 'ipatt)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword "as"; Gram.Sself; + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (p2 : 'ipatt) _ (p : 'ipatt) _ + (_loc : Gram.Loc.t) -> + (Ast.PaAli (_loc, p, p2) : 'ipatt)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (t : 'ctyp) _ (p : 'ipatt) _ + (_loc : Gram.Loc.t) -> + (Ast.PaTyc (_loc, p, t) : 'ipatt)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (p : 'ipatt) _ (_loc : Gram.Loc.t) -> + (p : 'ipatt)))); + ([ Gram.Skeyword "("; Gram.Skeyword "module"; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (package_type : + 'package_type Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (pt : 'package_type) _ (m : 'a_UIDENT) + _ _ (_loc : Gram.Loc.t) -> + (Ast.PaTyc (_loc, (Ast.PaMod (_loc, m)), + (Ast.TyPkg (_loc, pt))) : + 'ipatt)))); + ([ Gram.Skeyword "("; Gram.Skeyword "module"; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (m : 'a_UIDENT) _ _ (_loc : Gram.Loc.t) + -> (Ast.PaMod (_loc, m) : 'ipatt)))); + ([ Gram.Skeyword "("; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (Ast.PaId (_loc, (Ast.IdUid (_loc, "()"))) : + 'ipatt)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.patt_tag : + 'ipatt) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("tup", _) -> true + | _ -> false), + "ANTIQUOT (\"tup\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("tup" as n)), s) -> + (Ast.PaTup (_loc, + (Ast.PaAnt (_loc, + (mk_anti ~c: "patt" n s)))) : + 'ipatt) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "pat" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"pat\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "pat" | "anti" as n)), + s) -> + (Ast.PaAnt (_loc, + (mk_anti ~c: "patt" n s)) : + 'ipatt) + | _ -> assert false))); + ([ Gram.Skeyword "{"; + Gram.Snterm + (Gram.Entry.obj + (label_ipatt_list : + 'label_ipatt_list Gram.Entry.t)); + Gram.Skeyword "}" ], + (Gram.Action.mk + (fun _ (pl : 'label_ipatt_list) _ + (_loc : Gram.Loc.t) -> + (Ast.PaRec (_loc, pl) : 'ipatt)))) ]) ])) + ()); + Gram.extend (labeled_ipatt : 'labeled_ipatt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'ipatt) (_loc : Gram.Loc.t) -> + (p : 'labeled_ipatt)))) ]) ])) + ()); + Gram.extend (comma_ipatt : 'comma_ipatt Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'ipatt) (_loc : Gram.Loc.t) -> + (p : 'comma_ipatt)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.PaAnt (_loc, + (mk_anti ~c: "patt," n s)) : + 'comma_ipatt) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword ","; Gram.Sself ], + (Gram.Action.mk + (fun (p2 : 'comma_ipatt) _ (p1 : 'comma_ipatt) + (_loc : Gram.Loc.t) -> + (Ast.PaCom (_loc, p1, p2) : 'comma_ipatt)))) ]) ])) + ()); + Gram.extend + (label_ipatt_list : 'label_ipatt_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (label_ipatt : 'label_ipatt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p1 : 'label_ipatt) (_loc : Gram.Loc.t) + -> (p1 : 'label_ipatt_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (label_ipatt : 'label_ipatt Gram.Entry.t)); + Gram.Skeyword ";" ], + (Gram.Action.mk + (fun _ (p1 : 'label_ipatt) (_loc : Gram.Loc.t) + -> (p1 : 'label_ipatt_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (label_ipatt : 'label_ipatt Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Skeyword "_"; + Gram.Skeyword ";" ], + (Gram.Action.mk + (fun _ _ _ (p1 : 'label_ipatt) + (_loc : Gram.Loc.t) -> + (Ast.PaSem (_loc, p1, (Ast.PaAny _loc)) : + 'label_ipatt_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (label_ipatt : 'label_ipatt Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Skeyword "_" ], + (Gram.Action.mk + (fun _ _ (p1 : 'label_ipatt) + (_loc : Gram.Loc.t) -> + (Ast.PaSem (_loc, p1, (Ast.PaAny _loc)) : + 'label_ipatt_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (label_ipatt : 'label_ipatt Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (p2 : 'label_ipatt_list) _ + (p1 : 'label_ipatt) (_loc : Gram.Loc.t) -> + (Ast.PaSem (_loc, p1, p2) : + 'label_ipatt_list)))) ]) ])) + ()); + Gram.extend (label_ipatt : 'label_ipatt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (label_longident : + 'label_longident Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'ipatt) _ (i : 'label_longident) + (_loc : Gram.Loc.t) -> + (Ast.PaEq (_loc, i, p) : 'label_ipatt)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.patt_tag : + 'label_ipatt) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.PaAnt (_loc, + (mk_anti ~c: "patt;" n s)) : + 'label_ipatt) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "pat" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"pat\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "pat" | "anti" as n)), + s) -> + (Ast.PaAnt (_loc, + (mk_anti ~c: "patt" n s)) : + 'label_ipatt) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (type_declaration : 'type_declaration Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (type_ident_and_parameters : + 'type_ident_and_parameters Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_eq_ctyp : 'opt_eq_ctyp Gram.Entry.t)); + Gram.Slist0 + (Gram.Snterm + (Gram.Entry.obj + (constrain : 'constrain Gram.Entry.t))) ], + (Gram.Action.mk + (fun (cl : 'constrain list) + (tk : 'opt_eq_ctyp) + ((n, tpl) : 'type_ident_and_parameters) + (_loc : Gram.Loc.t) -> + (Ast.TyDcl (_loc, n, tpl, tk, cl) : + 'type_declaration)))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'type_declaration) _ + (t1 : 'type_declaration) + (_loc : Gram.Loc.t) -> + (Ast.TyAnd (_loc, t1, t2) : + 'type_declaration)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.ctyp_tag : + 'type_declaration) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctypand" n s)) : + 'type_declaration) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" | "anti" as n)), + s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp" n s)) : + 'type_declaration) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (constrain : 'constrain Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "constraint"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ + (_loc : Gram.Loc.t) -> + ((t1, t2) : 'constrain)))) ]) ])) + ()); + Gram.extend (opt_eq_ctyp : 'opt_eq_ctyp Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.TyNil _loc : 'opt_eq_ctyp)))); + ([ Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (type_kind : 'type_kind Gram.Entry.t)) ], + (Gram.Action.mk + (fun (tk : 'type_kind) _ (_loc : Gram.Loc.t) + -> (tk : 'opt_eq_ctyp)))) ]) ])) + ()); + Gram.extend (type_kind : 'type_kind Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) (_loc : Gram.Loc.t) -> + (t : 'type_kind)))) ]) ])) + ()); + Gram.extend + (type_ident_and_parameters : + 'type_ident_and_parameters Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Slist0 + (Gram.Snterm + (Gram.Entry.obj + (optional_type_parameter : + 'optional_type_parameter Gram.Entry.t))) ], + (Gram.Action.mk + (fun (tpl : 'optional_type_parameter list) + (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> + ((i, tpl) : 'type_ident_and_parameters)))) ]) ])) + ()); + Gram.extend + (type_longident_and_parameters : + 'type_longident_and_parameters Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (type_longident : + 'type_longident Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (type_parameters : + 'type_parameters Gram.Entry.t)) ], + (Gram.Action.mk + (fun (tpl : 'type_parameters) + (i : 'type_longident) (_loc : Gram.Loc.t) + -> + (tpl (Ast.TyId (_loc, i)) : + 'type_longident_and_parameters)))) ]) ])) + ()); + Gram.extend (type_parameters : 'type_parameters Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (fun t -> t : 'type_parameters)))); + ([ Gram.Snterm + (Gram.Entry.obj + (type_parameter : + 'type_parameter Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'type_parameter) (_loc : Gram.Loc.t) + -> + (fun acc -> Ast.TyApp (_loc, acc, t) : + 'type_parameters)))); + ([ Gram.Snterm + (Gram.Entry.obj + (type_parameter : + 'type_parameter Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'type_parameters) + (t1 : 'type_parameter) (_loc : Gram.Loc.t) + -> + (fun acc -> t2 (Ast.TyApp (_loc, acc, t1)) : + 'type_parameters)))) ]) ])) + ()); + Gram.extend (type_parameter : 'type_parameter Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "-"; Gram.Skeyword "'"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ _ (_loc : Gram.Loc.t) -> + (Ast.TyQuM (_loc, i) : 'type_parameter)))); + ([ Gram.Skeyword "+"; Gram.Skeyword "'"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ _ (_loc : Gram.Loc.t) -> + (Ast.TyQuP (_loc, i) : 'type_parameter)))); + ([ Gram.Skeyword "'"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ (_loc : Gram.Loc.t) -> + (Ast.TyQuo (_loc, i) : 'type_parameter)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.ctyp_tag : + 'type_parameter) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" | "anti" as n)), + s) -> + (Ast.TyAnt (_loc, (mk_anti n s)) : + 'type_parameter) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (optional_type_parameter : + 'optional_type_parameter Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "_" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (Ast.TyAny _loc : 'optional_type_parameter)))); + ([ Gram.Skeyword "-"; Gram.Skeyword "_" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (Ast.TyAnM _loc : 'optional_type_parameter)))); + ([ Gram.Skeyword "+"; Gram.Skeyword "_" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (Ast.TyAnP _loc : 'optional_type_parameter)))); + ([ Gram.Skeyword "-"; Gram.Skeyword "'"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ _ (_loc : Gram.Loc.t) -> + (Ast.TyQuM (_loc, i) : + 'optional_type_parameter)))); + ([ Gram.Skeyword "+"; Gram.Skeyword "'"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ _ (_loc : Gram.Loc.t) -> + (Ast.TyQuP (_loc, i) : + 'optional_type_parameter)))); + ([ Gram.Skeyword "'"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ (_loc : Gram.Loc.t) -> + (Ast.TyQuo (_loc, i) : + 'optional_type_parameter)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.ctyp_tag : + 'optional_type_parameter) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" | "anti" as n)), + s) -> + (Ast.TyAnt (_loc, (mk_anti n s)) : + 'optional_type_parameter) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (ctyp : 'ctyp Gram.Entry.t) + ((fun () -> + (None, + [ ((Some "=="), (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; Gram.Skeyword "=="; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ (t1 : 'ctyp) + (_loc : Gram.Loc.t) -> + (Ast.TyMan (_loc, t1, t2) : 'ctyp)))) ]); + ((Some "private"), (Some Camlp4.Sig.Grammar.NonA), + [ ([ Gram.Skeyword "private"; + Gram.Snterml + ((Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)), + "alias") ], + (Gram.Action.mk + (fun (t : 'ctyp) _ (_loc : Gram.Loc.t) -> + (Ast.TyPrv (_loc, t) : 'ctyp)))) ]); + ((Some "alias"), (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; Gram.Skeyword "as"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ (t1 : 'ctyp) + (_loc : Gram.Loc.t) -> + (Ast.TyAli (_loc, t1, t2) : 'ctyp)))) ]); + ((Some "forall"), (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Skeyword "!"; + Gram.Snterm + (Gram.Entry.obj + (typevars : 'typevars Gram.Entry.t)); + Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ (t1 : 'typevars) _ + (_loc : Gram.Loc.t) -> + (Ast.TyPol (_loc, t1, t2) : 'ctyp)))) ]); + ((Some "arrow"), (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Sself; Gram.Skeyword "->"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ (t1 : 'ctyp) + (_loc : Gram.Loc.t) -> + (Ast.TyArr (_loc, t1, t2) : 'ctyp)))) ]); + ((Some "label"), (Some Camlp4.Sig.Grammar.NonA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_OPTLABEL : 'a_OPTLABEL Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (t : 'ctyp) (i : 'a_OPTLABEL) + (_loc : Gram.Loc.t) -> + (Ast.TyOlb (_loc, i, t) : 'ctyp)))); + ([ Gram.Skeyword "?"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; Gram.Sself ], + (Gram.Action.mk + (fun (t : 'ctyp) _ (i : 'a_LIDENT) _ + (_loc : Gram.Loc.t) -> + (Ast.TyOlb (_loc, i, t) : 'ctyp)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LABEL : 'a_LABEL Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (t : 'ctyp) (i : 'a_LABEL) + (_loc : Gram.Loc.t) -> + (Ast.TyLab (_loc, i, t) : 'ctyp)))); + ([ Gram.Skeyword "~"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; Gram.Sself ], + (Gram.Action.mk + (fun (t : 'ctyp) _ (i : 'a_LIDENT) _ + (_loc : Gram.Loc.t) -> + (Ast.TyLab (_loc, i, t) : 'ctyp)))) ]); + ((Some "apply"), (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'ctyp) (t1 : 'ctyp) + (_loc : Gram.Loc.t) -> + (let t = Ast.TyApp (_loc, t1, t2) + in + try + Ast.TyId (_loc, (Ast.ident_of_ctyp t)) + with | Invalid_argument _ -> t : + 'ctyp)))) ]); + ((Some "."), (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ (t1 : 'ctyp) + (_loc : Gram.Loc.t) -> + (try + Ast.TyId (_loc, + (Ast.IdAcc (_loc, + (Ast.ident_of_ctyp t1), + (Ast.ident_of_ctyp t2)))) + with + | Invalid_argument s -> + raise (Stream.Error s) : + 'ctyp)))) ]); + ((Some "simple"), None, + [ ([ Gram.Skeyword "("; Gram.Skeyword "module"; + Gram.Snterm + (Gram.Entry.obj + (package_type : + 'package_type Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (p : 'package_type) _ _ + (_loc : Gram.Loc.t) -> + (Ast.TyPkg (_loc, p) : 'ctyp)))); + ([ Gram.Skeyword "<"; + Gram.Snterm + (Gram.Entry.obj + (opt_meth_list : + 'opt_meth_list Gram.Entry.t)); + Gram.Skeyword ">" ], + (Gram.Action.mk + (fun _ (t : 'opt_meth_list) _ + (_loc : Gram.Loc.t) -> (t : 'ctyp)))); + ([ Gram.Skeyword "#"; + Gram.Snterm + (Gram.Entry.obj + (class_longident : + 'class_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'class_longident) _ + (_loc : Gram.Loc.t) -> + (Ast.TyCls (_loc, i) : 'ctyp)))); + ([ Gram.Skeyword "{"; + Gram.Snterm + (Gram.Entry.obj + (label_declaration_list : + 'label_declaration_list Gram.Entry.t)); + Gram.Skeyword "}" ], + (Gram.Action.mk + (fun _ (t : 'label_declaration_list) _ + (_loc : Gram.Loc.t) -> + (Ast.TyRec (_loc, t) : 'ctyp)))); + ([ Gram.Skeyword "[<"; + Gram.Snterm + (Gram.Entry.obj + (row_field : 'row_field Gram.Entry.t)); + Gram.Skeyword ">"; + Gram.Snterm + (Gram.Entry.obj + (name_tags : 'name_tags Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (ntl : 'name_tags) _ (rfl : 'row_field) + _ (_loc : Gram.Loc.t) -> + (Ast.TyVrnInfSup (_loc, rfl, ntl) : 'ctyp)))); + ([ Gram.Skeyword "[<"; + Gram.Snterm + (Gram.Entry.obj + (row_field : 'row_field Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (rfl : 'row_field) _ + (_loc : Gram.Loc.t) -> + (Ast.TyVrnInf (_loc, rfl) : 'ctyp)))); + ([ Gram.Skeyword "["; Gram.Skeyword "<"; + Gram.Snterm + (Gram.Entry.obj + (row_field : 'row_field Gram.Entry.t)); + Gram.Skeyword ">"; + Gram.Snterm + (Gram.Entry.obj + (name_tags : 'name_tags Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (ntl : 'name_tags) _ (rfl : 'row_field) + _ _ (_loc : Gram.Loc.t) -> + (Ast.TyVrnInfSup (_loc, rfl, ntl) : 'ctyp)))); + ([ Gram.Skeyword "["; Gram.Skeyword "<"; + Gram.Snterm + (Gram.Entry.obj + (row_field : 'row_field Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (rfl : 'row_field) _ _ + (_loc : Gram.Loc.t) -> + (Ast.TyVrnInf (_loc, rfl) : 'ctyp)))); + ([ Gram.Skeyword "["; Gram.Skeyword ">"; + Gram.Snterm + (Gram.Entry.obj + (row_field : 'row_field Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (rfl : 'row_field) _ _ + (_loc : Gram.Loc.t) -> + (Ast.TyVrnSup (_loc, rfl) : 'ctyp)))); + ([ Gram.Skeyword "["; Gram.Skeyword ">"; + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ _ _ (_loc : Gram.Loc.t) -> + (Ast.TyVrnSup (_loc, (Ast.TyNil _loc)) : + 'ctyp)))); + ([ Gram.Skeyword "["; Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (row_field : 'row_field Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (rfl : 'row_field) _ _ + (_loc : Gram.Loc.t) -> + (Ast.TyVrnEq (_loc, rfl) : 'ctyp)))); + ([ Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (constructor_declarations : + 'constructor_declarations Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (t : 'constructor_declarations) _ + (_loc : Gram.Loc.t) -> + (Ast.TySum (_loc, t) : 'ctyp)))); + ([ Gram.Skeyword "["; Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (Ast.TySum (_loc, (Ast.TyNil _loc)) : + 'ctyp)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (t : 'ctyp) _ (_loc : Gram.Loc.t) -> + (t : 'ctyp)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword "*"; + Gram.Snterm + (Gram.Entry.obj + (star_ctyp : 'star_ctyp Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (tl : 'star_ctyp) _ (t : 'ctyp) _ + (_loc : Gram.Loc.t) -> + (Ast.TyTup (_loc, + (Ast.TySta (_loc, t, tl))) : + 'ctyp)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_UIDENT) (_loc : Gram.Loc.t) -> + (Ast.TyId (_loc, (Ast.IdUid (_loc, i))) : + 'ctyp)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> + (Ast.TyId (_loc, (Ast.IdLid (_loc, i))) : + 'ctyp)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.ctyp_tag : + 'ctyp) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("id", _) -> true + | _ -> false), + "ANTIQUOT (\"id\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("id" as n)), s) -> + (Ast.TyId (_loc, + (Ast.IdAnt (_loc, + (mk_anti ~c: "ident" n s)))) : + 'ctyp) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("tup", _) -> true + | _ -> false), + "ANTIQUOT (\"tup\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("tup" as n)), s) -> + (Ast.TyTup (_loc, + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp" n s)))) : + 'ctyp) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" | "anti" as n)), + s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp" n s)) : + 'ctyp) + | _ -> assert false))); + ([ Gram.Skeyword "_" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (Ast.TyAny _loc : 'ctyp)))); + ([ Gram.Skeyword "'"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ (_loc : Gram.Loc.t) -> + (Ast.TyQuo (_loc, i) : 'ctyp)))) ]) ])) + ()); + Gram.extend (star_ctyp : 'star_ctyp Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) (_loc : Gram.Loc.t) -> + (t : 'star_ctyp)))); + ([ Gram.Sself; Gram.Skeyword "*"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'star_ctyp) _ (t1 : 'star_ctyp) + (_loc : Gram.Loc.t) -> + (Ast.TySta (_loc, t1, t2) : 'star_ctyp)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp*" n s)) : + 'star_ctyp) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp" n s)) : + 'star_ctyp) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (constructor_declarations : + 'constructor_declarations Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_UIDENT) (_loc : Gram.Loc.t) -> + (Ast.TyId (_loc, (Ast.IdUid (_loc, s))) : + 'constructor_declarations)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) _ (s : 'a_UIDENT) + (_loc : Gram.Loc.t) -> + (let (tl, rt) = generalized_type_of_type t + in + Ast.TyCol (_loc, + (Ast.TyId (_loc, + (Ast.IdUid (_loc, s)))), + (Ast.TyArr (_loc, + (Ast.tyAnd_of_list tl), rt))) : + 'constructor_declarations)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword "of"; + Gram.Snterm + (Gram.Entry.obj + (constructor_arg_list : + 'constructor_arg_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'constructor_arg_list) _ + (s : 'a_UIDENT) (_loc : Gram.Loc.t) -> + (Ast.TyOf (_loc, + (Ast.TyId (_loc, (Ast.IdUid (_loc, s)))), + t) : + 'constructor_declarations)))); + ([ Gram.Sself; Gram.Skeyword "|"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'constructor_declarations) _ + (t1 : 'constructor_declarations) + (_loc : Gram.Loc.t) -> + (Ast.TyOr (_loc, t1, t2) : + 'constructor_declarations)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.ctyp_tag : + 'constructor_declarations) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp|" n s)) : + 'constructor_declarations) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp" n s)) : + 'constructor_declarations) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (constructor_declaration : + 'constructor_declaration Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_UIDENT) (_loc : Gram.Loc.t) -> + (Ast.TyId (_loc, (Ast.IdUid (_loc, s))) : + 'constructor_declaration)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword "of"; + Gram.Snterm + (Gram.Entry.obj + (constructor_arg_list : + 'constructor_arg_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'constructor_arg_list) _ + (s : 'a_UIDENT) (_loc : Gram.Loc.t) -> + (Ast.TyOf (_loc, + (Ast.TyId (_loc, (Ast.IdUid (_loc, s)))), + t) : + 'constructor_declaration)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.ctyp_tag : + 'constructor_declaration) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp" n s)) : + 'constructor_declaration) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (constructor_arg_list : 'constructor_arg_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) (_loc : Gram.Loc.t) -> + (t : 'constructor_arg_list)))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'constructor_arg_list) _ + (t1 : 'constructor_arg_list) + (_loc : Gram.Loc.t) -> + (Ast.TyAnd (_loc, t1, t2) : + 'constructor_arg_list)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctypand" n s)) : + 'constructor_arg_list) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (label_declaration_list : + 'label_declaration_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (label_declaration : + 'label_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t1 : 'label_declaration) + (_loc : Gram.Loc.t) -> + (t1 : 'label_declaration_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (label_declaration : + 'label_declaration Gram.Entry.t)); + Gram.Skeyword ";" ], + (Gram.Action.mk + (fun _ (t1 : 'label_declaration) + (_loc : Gram.Loc.t) -> + (t1 : 'label_declaration_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (label_declaration : + 'label_declaration Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'label_declaration_list) _ + (t1 : 'label_declaration) + (_loc : Gram.Loc.t) -> + (Ast.TySem (_loc, t1, t2) : + 'label_declaration_list)))) ]) ])) + ()); + Gram.extend + (label_declaration : 'label_declaration Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; Gram.Skeyword "mutable"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ _ (s : 'a_LIDENT) + (_loc : Gram.Loc.t) -> + (Ast.TyCol (_loc, + (Ast.TyId (_loc, (Ast.IdLid (_loc, s)))), + (Ast.TyMut (_loc, t))) : + 'label_declaration)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ (s : 'a_LIDENT) + (_loc : Gram.Loc.t) -> + (Ast.TyCol (_loc, + (Ast.TyId (_loc, (Ast.IdLid (_loc, s)))), + t) : + 'label_declaration)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.ctyp_tag : + 'label_declaration) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp;" n s)) : + 'label_declaration) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp" n s)) : + 'label_declaration) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_ident : 'a_ident Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_UIDENT) (_loc : Gram.Loc.t) -> + (i : 'a_ident)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> + (i : 'a_ident)))) ]) ])) + ()); + Gram.extend (ident : 'ident Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (j : 'ident) _ (i : 'a_UIDENT) + (_loc : Gram.Loc.t) -> + (Ast.IdAcc (_loc, (Ast.IdUid (_loc, i)), j) : + 'ident)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "id" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")); + Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (i : 'ident) _ + (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "id" | "anti" | "list" as n)), + s) -> + (Ast.IdAcc (_loc, + (Ast.IdAnt (_loc, + (mk_anti ~c: "ident" n s))), + i) : + 'ident) + | _ -> assert false))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> + (Ast.IdLid (_loc, i) : 'ident)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_UIDENT) (_loc : Gram.Loc.t) -> + (Ast.IdUid (_loc, i) : 'ident)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "id" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "id" | "anti" | "list" as n)), + s) -> + (Ast.IdAnt (_loc, + (mk_anti ~c: "ident" n s)) : + 'ident) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (module_longident : 'module_longident Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_UIDENT) (_loc : Gram.Loc.t) -> + (Ast.IdUid (_loc, i) : 'module_longident)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (l : 'module_longident) _ (m : 'a_UIDENT) + (_loc : Gram.Loc.t) -> + (Ast.IdAcc (_loc, (Ast.IdUid (_loc, m)), l) : + 'module_longident)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "id" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "id" | "anti" | "list" as n)), + s) -> + (Ast.IdAnt (_loc, + (mk_anti ~c: "ident" n s)) : + 'module_longident) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (module_longident_with_app : + 'module_longident_with_app Gram.Entry.t) + ((fun () -> + (None, + [ ((Some "apply"), None, + [ ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (j : 'module_longident_with_app) + (i : 'module_longident_with_app) + (_loc : Gram.Loc.t) -> + (Ast.IdApp (_loc, i, j) : + 'module_longident_with_app)))) ]); + ((Some "."), None, + [ ([ Gram.Sself; Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (j : 'module_longident_with_app) _ + (i : 'module_longident_with_app) + (_loc : Gram.Loc.t) -> + (Ast.IdAcc (_loc, i, j) : + 'module_longident_with_app)))) ]); + ((Some "simple"), None, + [ ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (i : 'module_longident_with_app) _ + (_loc : Gram.Loc.t) -> + (i : 'module_longident_with_app)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_UIDENT) (_loc : Gram.Loc.t) -> + (Ast.IdUid (_loc, i) : + 'module_longident_with_app)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "id" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "id" | "anti" | "list" as n)), + s) -> + (Ast.IdAnt (_loc, + (mk_anti ~c: "ident" n s)) : + 'module_longident_with_app) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (module_longident_dot_lparen : + 'module_longident_dot_lparen Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword "."; Gram.Skeyword "(" ], + (Gram.Action.mk + (fun _ _ (i : 'a_UIDENT) (_loc : Gram.Loc.t) + -> + (Ast.IdUid (_loc, i) : + 'module_longident_dot_lparen)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (l : 'module_longident_dot_lparen) _ + (m : 'a_UIDENT) (_loc : Gram.Loc.t) -> + (Ast.IdAcc (_loc, (Ast.IdUid (_loc, m)), l) : + 'module_longident_dot_lparen)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "id" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")); + Gram.Skeyword "."; Gram.Skeyword "(" ], + (Gram.Action.mk + (fun _ _ (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "id" | "anti" | "list" as n)), + s) -> + (Ast.IdAnt (_loc, + (mk_anti ~c: "ident" n s)) : + 'module_longident_dot_lparen) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (type_longident : 'type_longident Gram.Entry.t) + ((fun () -> + (None, + [ ((Some "apply"), None, + [ ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (j : 'type_longident) + (i : 'type_longident) (_loc : Gram.Loc.t) + -> + (Ast.IdApp (_loc, i, j) : 'type_longident)))) ]); + ((Some "."), None, + [ ([ Gram.Sself; Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (j : 'type_longident) _ + (i : 'type_longident) (_loc : Gram.Loc.t) + -> + (Ast.IdAcc (_loc, i, j) : 'type_longident)))) ]); + ((Some "simple"), None, + [ ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (i : 'type_longident) _ + (_loc : Gram.Loc.t) -> + (i : 'type_longident)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_UIDENT) (_loc : Gram.Loc.t) -> + (Ast.IdUid (_loc, i) : 'type_longident)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> + (Ast.IdLid (_loc, i) : 'type_longident)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "id" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "id" | "anti" | "list" as n)), + s) -> + (Ast.IdAnt (_loc, + (mk_anti ~c: "ident" n s)) : + 'type_longident) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (label_longident : 'label_longident Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> + (Ast.IdLid (_loc, i) : 'label_longident)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (l : 'label_longident) _ (m : 'a_UIDENT) + (_loc : Gram.Loc.t) -> + (Ast.IdAcc (_loc, (Ast.IdUid (_loc, m)), l) : + 'label_longident)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "id" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "id" | "anti" | "list" as n)), + s) -> + (Ast.IdAnt (_loc, + (mk_anti ~c: "ident" n s)) : + 'label_longident) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (class_type_longident : 'class_type_longident Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (type_longident : + 'type_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'type_longident) (_loc : Gram.Loc.t) + -> (x : 'class_type_longident)))) ]) ])) + ()); + Gram.extend (val_longident : 'val_longident Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ident : 'ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'ident) (_loc : Gram.Loc.t) -> + (x : 'val_longident)))) ]) ])) + ()); + Gram.extend (class_longident : 'class_longident Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (label_longident : + 'label_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'label_longident) + (_loc : Gram.Loc.t) -> + (x : 'class_longident)))) ]) ])) + ()); + Gram.extend + (class_declaration : 'class_declaration Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (class_info_for_class_expr : + 'class_info_for_class_expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (class_fun_binding : + 'class_fun_binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ce : 'class_fun_binding) + (ci : 'class_info_for_class_expr) + (_loc : Gram.Loc.t) -> + (Ast.CeEq (_loc, ci, ce) : + 'class_declaration)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.class_expr_tag : + 'class_declaration) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "cdcl" | "anti" | "list"), _) + -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"cdcl\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "cdcl" | "anti" | "list" as n)), + s) -> + (Ast.CeAnt (_loc, + (mk_anti ~c: "class_expr" n s)) : + 'class_declaration) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (c2 : 'class_declaration) _ + (c1 : 'class_declaration) + (_loc : Gram.Loc.t) -> + (Ast.CeAnd (_loc, c1, c2) : + 'class_declaration)))) ]) ])) + ()); + Gram.extend + (class_fun_binding : 'class_fun_binding Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (labeled_ipatt : + 'labeled_ipatt Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (cfb : 'class_fun_binding) + (p : 'labeled_ipatt) (_loc : Gram.Loc.t) -> + (Ast.CeFun (_loc, p, cfb) : + 'class_fun_binding)))); + ([ Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (class_type_plus : + 'class_type_plus Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (class_expr : 'class_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ce : 'class_expr) _ + (ct : 'class_type_plus) _ + (_loc : Gram.Loc.t) -> + (Ast.CeTyc (_loc, ce, ct) : + 'class_fun_binding)))); + ([ Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (class_expr : 'class_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ce : 'class_expr) _ (_loc : Gram.Loc.t) + -> (ce : 'class_fun_binding)))) ]) ])) + ()); + Gram.extend + (class_info_for_class_type : + 'class_info_for_class_type Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (opt_virtual : 'opt_virtual Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (class_name_and_param : + 'class_name_and_param Gram.Entry.t)) ], + (Gram.Action.mk + (fun ((i, ot) : 'class_name_and_param) + (mv : 'opt_virtual) (_loc : Gram.Loc.t) -> + (Ast.CtCon (_loc, mv, + (Ast.IdLid (_loc, i)), ot) : + 'class_info_for_class_type)))) ]) ])) + ()); + Gram.extend + (class_info_for_class_expr : + 'class_info_for_class_expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (opt_virtual : 'opt_virtual Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (class_name_and_param : + 'class_name_and_param Gram.Entry.t)) ], + (Gram.Action.mk + (fun ((i, ot) : 'class_name_and_param) + (mv : 'opt_virtual) (_loc : Gram.Loc.t) -> + (Ast.CeCon (_loc, mv, + (Ast.IdLid (_loc, i)), ot) : + 'class_info_for_class_expr)))) ]) ])) + ()); + Gram.extend + (class_name_and_param : 'class_name_and_param Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> + ((i, (Ast.TyNil _loc)) : + 'class_name_and_param)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (comma_type_parameter : + 'comma_type_parameter Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (x : 'comma_type_parameter) _ + (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> + ((i, x) : 'class_name_and_param)))) ]) ])) + ()); + Gram.extend + (comma_type_parameter : 'comma_type_parameter Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (type_parameter : + 'type_parameter Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'type_parameter) (_loc : Gram.Loc.t) + -> (t : 'comma_type_parameter)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp," n s)) : + 'comma_type_parameter) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword ","; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'comma_type_parameter) _ + (t1 : 'comma_type_parameter) + (_loc : Gram.Loc.t) -> + (Ast.TyCom (_loc, t1, t2) : + 'comma_type_parameter)))) ]) ])) + ()); + Gram.extend (opt_comma_ctyp : 'opt_comma_ctyp Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.TyNil _loc : 'opt_comma_ctyp)))); + ([ Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (comma_ctyp : 'comma_ctyp Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (x : 'comma_ctyp) _ (_loc : Gram.Loc.t) + -> (x : 'opt_comma_ctyp)))) ]) ])) + ()); + Gram.extend (comma_ctyp : 'comma_ctyp Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) (_loc : Gram.Loc.t) -> + (t : 'comma_ctyp)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp," n s)) : + 'comma_ctyp) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword ","; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'comma_ctyp) _ (t1 : 'comma_ctyp) + (_loc : Gram.Loc.t) -> + (Ast.TyCom (_loc, t1, t2) : 'comma_ctyp)))) ]) ])) + ()); + Gram.extend (class_fun_def : 'class_fun_def Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "->"; + Gram.Snterm + (Gram.Entry.obj + (class_expr : 'class_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ce : 'class_expr) _ (_loc : Gram.Loc.t) + -> (ce : 'class_fun_def)))); + ([ Gram.Snterm + (Gram.Entry.obj + (labeled_ipatt : + 'labeled_ipatt Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (ce : 'class_fun_def) + (p : 'labeled_ipatt) (_loc : Gram.Loc.t) -> + (Ast.CeFun (_loc, p, ce) : 'class_fun_def)))) ]) ])) + ()); + Gram.extend (class_expr : 'class_expr Gram.Entry.t) + ((fun () -> + (None, + [ ((Some "top"), None, + [ ([ Gram.Skeyword "let"; + Gram.Snterm + (Gram.Entry.obj + (opt_rec : 'opt_rec Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (binding : 'binding Gram.Entry.t)); + Gram.Skeyword "in"; Gram.Sself ], + (Gram.Action.mk + (fun (ce : 'class_expr) _ (bi : 'binding) + (rf : 'opt_rec) _ (_loc : Gram.Loc.t) -> + (Ast.CeLet (_loc, rf, bi, ce) : + 'class_expr)))); + ([ Gram.Skeyword "fun"; + Gram.Snterm + (Gram.Entry.obj + (labeled_ipatt : + 'labeled_ipatt Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (class_fun_def : + 'class_fun_def Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ce : 'class_fun_def) + (p : 'labeled_ipatt) _ (_loc : Gram.Loc.t) + -> (Ast.CeFun (_loc, p, ce) : 'class_expr)))) ]); + ((Some "apply"), (Some Camlp4.Sig.Grammar.NonA), + [ ([ Gram.Sself; + Gram.Snterml + ((Gram.Entry.obj (expr : 'expr Gram.Entry.t)), + "label") ], + (Gram.Action.mk + (fun (e : 'expr) (ce : 'class_expr) + (_loc : Gram.Loc.t) -> + (Ast.CeApp (_loc, ce, e) : 'class_expr)))) ]); + ((Some "simple"), None, + [ ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (ce : 'class_expr) _ + (_loc : Gram.Loc.t) -> (ce : 'class_expr)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (class_type : 'class_type Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (ct : 'class_type) _ (ce : 'class_expr) + _ (_loc : Gram.Loc.t) -> + (Ast.CeTyc (_loc, ce, ct) : 'class_expr)))); + ([ Gram.Skeyword "object"; + Gram.Snterm + (Gram.Entry.obj + (opt_class_self_patt : + 'opt_class_self_patt Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (class_structure : + 'class_structure Gram.Entry.t)); + Gram.Skeyword "end" ], + (Gram.Action.mk + (fun _ (cst : 'class_structure) + (csp : 'opt_class_self_patt) _ + (_loc : Gram.Loc.t) -> + (Ast.CeStr (_loc, csp, cst) : 'class_expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_longident_and_param : + 'class_longident_and_param Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ce : 'class_longident_and_param) + (_loc : Gram.Loc.t) -> (ce : 'class_expr)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.class_expr_tag : + 'class_expr) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "cexp" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"cexp\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "cexp" | "anti" as n)), + s) -> + (Ast.CeAnt (_loc, + (mk_anti ~c: "class_expr" n s)) : + 'class_expr) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (class_longident_and_param : + 'class_longident_and_param Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (class_longident : + 'class_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ci : 'class_longident) + (_loc : Gram.Loc.t) -> + (Ast.CeCon (_loc, Ast.ViNil, ci, + (Ast.TyNil _loc)) : + 'class_longident_and_param)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_longident : + 'class_longident Gram.Entry.t)); + Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (comma_ctyp : 'comma_ctyp Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (t : 'comma_ctyp) _ + (ci : 'class_longident) (_loc : Gram.Loc.t) + -> + (Ast.CeCon (_loc, Ast.ViNil, ci, t) : + 'class_longident_and_param)))) ]) ])) + ()); + Gram.extend (class_structure : 'class_structure Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Slist0 + (Gram.srules class_structure + [ ([ Gram.Snterm + (Gram.Entry.obj + (class_str_item : + 'class_str_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (semi : 'semi Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (cst : 'class_str_item) + (_loc : Gram.Loc.t) -> + (cst : 'e__10)))) ]) ], + (Gram.Action.mk + (fun (l : 'e__10 list) (_loc : Gram.Loc.t) -> + (Ast.crSem_of_list l : 'class_structure)))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "cst" | "anti" | "list"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"cst\" | \"anti\" | \"list\"), _)")); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (cst : 'class_structure) _ + (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "cst" | "anti" | "list" as n)), + s) -> + (Ast.CrSem (_loc, + (Ast.CrAnt (_loc, + (mk_anti ~c: "class_str_item" n s))), + cst) : + 'class_structure) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "cst" | "anti" | "list"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"cst\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "cst" | "anti" | "list" as n)), + s) -> + (Ast.CrAnt (_loc, + (mk_anti ~c: "class_str_item" n s)) : + 'class_structure) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (opt_class_self_patt : 'opt_class_self_patt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.PaNil _loc : 'opt_class_self_patt)))); + ([ Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (t : 'ctyp) _ (p : 'patt) _ + (_loc : Gram.Loc.t) -> + (Ast.PaTyc (_loc, p, t) : + 'opt_class_self_patt)))); + ([ Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (p : 'patt) _ (_loc : Gram.Loc.t) -> + (p : 'opt_class_self_patt)))) ]) ])) + ()); + Gram.extend (class_str_item : 'class_str_item Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Skeyword "initializer"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (se : 'expr) _ (_loc : Gram.Loc.t) -> + (Ast.CrIni (_loc, se) : 'class_str_item)))); + ([ Gram.Snterm + (Gram.Entry.obj + (type_constraint : + 'type_constraint Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ + (_loc : Gram.Loc.t) -> + (Ast.CrCtr (_loc, t1, t2) : + 'class_str_item)))); + ([ Gram.Snterm + (Gram.Entry.obj + (method_opt_override : + 'method_opt_override Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_private : 'opt_private Gram.Entry.t)); + Gram.Skeyword "virtual"; + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ (l : 'label) _ + (pf : 'opt_private) + (o : 'method_opt_override) + (_loc : Gram.Loc.t) -> + (if o <> Ast.OvNil + then + raise + (Stream.Error + "override (!) is incompatible with virtual") + else Ast.CrVir (_loc, l, pf, t) : + 'class_str_item)))); + ([ Gram.Snterm + (Gram.Entry.obj + (method_opt_override : + 'method_opt_override Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_private : 'opt_private Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_polyt : 'opt_polyt Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (fun_binding : 'fun_binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'fun_binding) (topt : 'opt_polyt) + (l : 'label) (pf : 'opt_private) + (o : 'method_opt_override) + (_loc : Gram.Loc.t) -> + (Ast.CrMth (_loc, l, o, pf, e, topt) : + 'class_str_item)))); + ([ Gram.Snterm + (Gram.Entry.obj + (method_opt_override : + 'method_opt_override Gram.Entry.t)); + Gram.Skeyword "virtual"; + Gram.Snterm + (Gram.Entry.obj + (opt_private : 'opt_private Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ (l : 'label) + (pf : 'opt_private) _ + (o : 'method_opt_override) + (_loc : Gram.Loc.t) -> + (if o <> Ast.OvNil + then + raise + (Stream.Error + "override (!) is incompatible with virtual") + else Ast.CrVir (_loc, l, pf, t) : + 'class_str_item)))); + ([ Gram.Snterm + (Gram.Entry.obj + (value_val_opt_override : + 'value_val_opt_override Gram.Entry.t)); + Gram.Skeyword "virtual"; + Gram.Snterm + (Gram.Entry.obj + (opt_mutable : 'opt_mutable Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ (l : 'label) + (mf : 'opt_mutable) _ + (o : 'value_val_opt_override) + (_loc : Gram.Loc.t) -> + (if o <> Ast.OvNil + then + raise + (Stream.Error + "override (!) is incompatible with virtual") + else Ast.CrVvr (_loc, l, mf, t) : + 'class_str_item)))); + ([ Gram.Snterm + (Gram.Entry.obj + (value_val_opt_override : + 'value_val_opt_override Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_mutable : 'opt_mutable Gram.Entry.t)); + Gram.Skeyword "virtual"; + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ (l : 'label) _ + (mf : 'opt_mutable) + (o : 'value_val_opt_override) + (_loc : Gram.Loc.t) -> + (if o <> Ast.OvNil + then + raise + (Stream.Error + "override (!) is incompatible with virtual") + else Ast.CrVvr (_loc, l, mf, t) : + 'class_str_item)))); + ([ Gram.Snterm + (Gram.Entry.obj + (value_val_opt_override : + 'value_val_opt_override Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_mutable : 'opt_mutable Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (cvalue_binding : + 'cvalue_binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'cvalue_binding) (lab : 'label) + (mf : 'opt_mutable) + (o : 'value_val_opt_override) + (_loc : Gram.Loc.t) -> + (Ast.CrVal (_loc, lab, o, mf, e) : + 'class_str_item)))); + ([ Gram.Skeyword "inherit"; + Gram.Snterm + (Gram.Entry.obj + (opt_override : + 'opt_override Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (class_expr : 'class_expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_as_lident : + 'opt_as_lident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (pb : 'opt_as_lident) (ce : 'class_expr) + (o : 'opt_override) _ (_loc : Gram.Loc.t) + -> + (Ast.CrInh (_loc, o, ce, pb) : + 'class_str_item)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.class_str_item_tag : + 'class_str_item) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "cst" | "anti" | "list"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"cst\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "cst" | "anti" | "list" as n)), + s) -> + (Ast.CrAnt (_loc, + (mk_anti ~c: "class_str_item" n s)) : + 'class_str_item) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (method_opt_override : 'method_opt_override Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "method" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (Ast.OvNil : 'method_opt_override)))); + ([ Gram.Skeyword "method"; + Gram.Stoken + (((function + | ANTIQUOT (("!" | "override" | "anti"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"!\" | \"override\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("!" | "override" | "anti" as n)), s) + -> + (Ast.OvAnt (mk_anti n s) : + 'method_opt_override) + | _ -> assert false))); + ([ Gram.Skeyword "method"; Gram.Skeyword "!" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (Ast.OvOverride : 'method_opt_override)))) ]) ])) + ()); + Gram.extend + (value_val_opt_override : + 'value_val_opt_override Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (value_val : 'value_val Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (Ast.OvNil : 'value_val_opt_override)))); + ([ Gram.Snterm + (Gram.Entry.obj + (value_val : 'value_val Gram.Entry.t)); + Gram.Stoken + (((function + | ANTIQUOT (("!" | "override" | "anti"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"!\" | \"override\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("!" | "override" | "anti" as n)), s) + -> + (Ast.OvAnt (mk_anti n s) : + 'value_val_opt_override) + | _ -> assert false))); + ([ Gram.Snterm + (Gram.Entry.obj + (value_val : 'value_val Gram.Entry.t)); + Gram.Skeyword "!" ], + (Gram.Action.mk + (fun _ _ (_loc : Gram.Loc.t) -> + (Ast.OvOverride : 'value_val_opt_override)))) ]) ])) + ()); + Gram.extend (opt_as_lident : 'opt_as_lident Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + ("" : 'opt_as_lident)))); + ([ Gram.Skeyword "as"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) _ (_loc : Gram.Loc.t) -> + (i : 'opt_as_lident)))) ]) ])) + ()); + Gram.extend (opt_polyt : 'opt_polyt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.TyNil _loc : 'opt_polyt)))); + ([ Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ (_loc : Gram.Loc.t) -> + (t : 'opt_polyt)))) ]) ])) + ()); + Gram.extend (cvalue_binding : 'cvalue_binding Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword ":>"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (t : 'ctyp) _ + (_loc : Gram.Loc.t) -> + (Ast.ExCoe (_loc, e, (Ast.TyNil _loc), t) : + 'cvalue_binding)))); + ([ Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)); + Gram.Skeyword ":>"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (t2 : 'ctyp) _ + (t : 'poly_type) _ (_loc : Gram.Loc.t) -> + (match t with + | Ast.TyPol (_, _, _) -> + raise + (Stream.Error + "unexpected polytype here") + | _ -> Ast.ExCoe (_loc, e, t, t2) : + 'cvalue_binding)))); + ([ Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (t : 'poly_type) _ + (_loc : Gram.Loc.t) -> + (Ast.ExTyc (_loc, e, t) : 'cvalue_binding)))); + ([ Gram.Skeyword ":"; Gram.Skeyword "type"; + Gram.Snterm + (Gram.Entry.obj + (unquoted_typevars : + 'unquoted_typevars Gram.Entry.t)); + Gram.Skeyword "."; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (t2 : 'ctyp) _ + (t1 : 'unquoted_typevars) _ _ + (_loc : Gram.Loc.t) -> + (let u = Ast.TyTypePol (_loc, t1, t2) + in Ast.ExTyc (_loc, e, u) : + 'cvalue_binding)))); + ([ Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Gram.Loc.t) -> + (e : 'cvalue_binding)))) ]) ])) + ()); + Gram.extend (label : 'label Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> + (i : 'label)))) ]) ])) + ()); + Gram.extend (class_type : 'class_type Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "object"; + Gram.Snterm + (Gram.Entry.obj + (opt_class_self_type : + 'opt_class_self_type Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (class_signature : + 'class_signature Gram.Entry.t)); + Gram.Skeyword "end" ], + (Gram.Action.mk + (fun _ (csg : 'class_signature) + (cst : 'opt_class_self_type) _ + (_loc : Gram.Loc.t) -> + (Ast.CtSig (_loc, cst, csg) : 'class_type)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_type_longident_and_param : + 'class_type_longident_and_param Gram. + Entry.t)) ], + (Gram.Action.mk + (fun (ct : 'class_type_longident_and_param) + (_loc : Gram.Loc.t) -> (ct : 'class_type)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.class_type_tag : + 'class_type) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "ctyp" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"ctyp\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "ctyp" | "anti" as n)), + s) -> + (Ast.CtAnt (_loc, + (mk_anti ~c: "class_type" n s)) : + 'class_type) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (class_type_longident_and_param : + 'class_type_longident_and_param Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (class_type_longident : + 'class_type_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'class_type_longident) + (_loc : Gram.Loc.t) -> + (Ast.CtCon (_loc, Ast.ViNil, i, + (Ast.TyNil _loc)) : + 'class_type_longident_and_param)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_type_longident : + 'class_type_longident Gram.Entry.t)); + Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (comma_ctyp : 'comma_ctyp Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (t : 'comma_ctyp) _ + (i : 'class_type_longident) + (_loc : Gram.Loc.t) -> + (Ast.CtCon (_loc, Ast.ViNil, i, t) : + 'class_type_longident_and_param)))) ]) ])) + ()); + Gram.extend (class_type_plus : 'class_type_plus Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (class_type : 'class_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ct : 'class_type) (_loc : Gram.Loc.t) -> + (ct : 'class_type_plus)))); + ([ Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "]"; Gram.Skeyword "->"; Gram. + Sself ], + (Gram.Action.mk + (fun (ct : 'class_type_plus) _ _ (t : 'ctyp) _ + (_loc : Gram.Loc.t) -> + (Ast.CtFun (_loc, t, ct) : + 'class_type_plus)))) ]) ])) + ()); + Gram.extend + (opt_class_self_type : 'opt_class_self_type Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.TyNil _loc : 'opt_class_self_type)))); + ([ Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (t : 'ctyp) _ (_loc : Gram.Loc.t) -> + (t : 'opt_class_self_type)))) ]) ])) + ()); + Gram.extend (class_signature : 'class_signature Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Slist0 + (Gram.srules class_signature + [ ([ Gram.Snterm + (Gram.Entry.obj + (class_sig_item : + 'class_sig_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (semi : 'semi Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (csg : 'class_sig_item) + (_loc : Gram.Loc.t) -> + (csg : 'e__11)))) ]) ], + (Gram.Action.mk + (fun (l : 'e__11 list) (_loc : Gram.Loc.t) -> + (Ast.cgSem_of_list l : 'class_signature)))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "csg" | "anti" | "list"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"csg\" | \"anti\" | \"list\"), _)")); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (csg : 'class_signature) _ + (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "csg" | "anti" | "list" as n)), + s) -> + (Ast.CgSem (_loc, + (Ast.CgAnt (_loc, + (mk_anti ~c: "class_sig_item" n s))), + csg) : + 'class_signature) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "csg" | "anti" | "list"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"csg\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "csg" | "anti" | "list" as n)), + s) -> + (Ast.CgAnt (_loc, + (mk_anti ~c: "class_sig_item" n s)) : + 'class_signature) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (class_sig_item : 'class_sig_item Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (type_constraint : + 'type_constraint Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ + (_loc : Gram.Loc.t) -> + (Ast.CgCtr (_loc, t1, t2) : + 'class_sig_item)))); + ([ Gram.Skeyword "method"; + Gram.Snterm + (Gram.Entry.obj + (opt_private : 'opt_private Gram.Entry.t)); + Gram.Skeyword "virtual"; + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ (l : 'label) _ + (pf : 'opt_private) _ (_loc : Gram.Loc.t) + -> + (Ast.CgVir (_loc, l, pf, t) : + 'class_sig_item)))); + ([ Gram.Skeyword "method"; + Gram.Snterm + (Gram.Entry.obj + (opt_private : 'opt_private Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ (l : 'label) + (pf : 'opt_private) _ (_loc : Gram.Loc.t) + -> + (Ast.CgMth (_loc, l, pf, t) : + 'class_sig_item)))); + ([ Gram.Skeyword "method"; + Gram.Skeyword "virtual"; + Gram.Snterm + (Gram.Entry.obj + (opt_private : 'opt_private Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ (l : 'label) + (pf : 'opt_private) _ _ (_loc : Gram.Loc.t) + -> + (Ast.CgVir (_loc, l, pf, t) : + 'class_sig_item)))); + ([ Gram.Snterm + (Gram.Entry.obj + (value_val : 'value_val Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_mutable : 'opt_mutable Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_virtual : 'opt_virtual Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) _ (l : 'label) + (mv : 'opt_virtual) (mf : 'opt_mutable) _ + (_loc : Gram.Loc.t) -> + (Ast.CgVal (_loc, l, mf, mv, t) : + 'class_sig_item)))); + ([ Gram.Skeyword "inherit"; + Gram.Snterm + (Gram.Entry.obj + (class_type : 'class_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (cs : 'class_type) _ (_loc : Gram.Loc.t) + -> (Ast.CgInh (_loc, cs) : 'class_sig_item)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.class_sig_item_tag : + 'class_sig_item) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "csg" | "anti" | "list"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"csg\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "csg" | "anti" | "list" as n)), + s) -> + (Ast.CgAnt (_loc, + (mk_anti ~c: "class_sig_item" n s)) : + 'class_sig_item) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (type_constraint : 'type_constraint Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "constraint" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (() : 'type_constraint)))); + ([ Gram.Skeyword "type" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (() : 'type_constraint)))) ]) ])) + ()); + Gram.extend + (class_description : 'class_description Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (class_info_for_class_type : + 'class_info_for_class_type Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (class_type_plus : + 'class_type_plus Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ct : 'class_type_plus) _ + (ci : 'class_info_for_class_type) + (_loc : Gram.Loc.t) -> + (Ast.CtCol (_loc, ci, ct) : + 'class_description)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.class_type_tag : + 'class_description) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "typ" | "anti" | "list"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "typ" | "anti" | "list" as n)), + s) -> + (Ast.CtAnt (_loc, + (mk_anti ~c: "class_type" n s)) : + 'class_description) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (cd2 : 'class_description) _ + (cd1 : 'class_description) + (_loc : Gram.Loc.t) -> + (Ast.CtAnd (_loc, cd1, cd2) : + 'class_description)))) ]) ])) + ()); + Gram.extend + (class_type_declaration : + 'class_type_declaration Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (class_info_for_class_type : + 'class_info_for_class_type Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (class_type : 'class_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ct : 'class_type) _ + (ci : 'class_info_for_class_type) + (_loc : Gram.Loc.t) -> + (Ast.CtEq (_loc, ci, ct) : + 'class_type_declaration)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.class_type_tag : + 'class_type_declaration) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "typ" | "anti" | "list"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "typ" | "anti" | "list" as n)), + s) -> + (Ast.CtAnt (_loc, + (mk_anti ~c: "class_type" n s)) : + 'class_type_declaration) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (cd2 : 'class_type_declaration) _ + (cd1 : 'class_type_declaration) + (_loc : Gram.Loc.t) -> + (Ast.CtAnd (_loc, cd1, cd2) : + 'class_type_declaration)))) ]) ])) + ()); + Gram.extend (field_expr_list : 'field_expr_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (field_expr : 'field_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (b1 : 'field_expr) (_loc : Gram.Loc.t) -> + (b1 : 'field_expr_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (field_expr : 'field_expr Gram.Entry.t)); + Gram.Skeyword ";" ], + (Gram.Action.mk + (fun _ (b1 : 'field_expr) (_loc : Gram.Loc.t) + -> (b1 : 'field_expr_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (field_expr : 'field_expr Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (b2 : 'field_expr_list) _ + (b1 : 'field_expr) (_loc : Gram.Loc.t) -> + (Ast.RbSem (_loc, b1, b2) : + 'field_expr_list)))) ]) ])) + ()); + Gram.extend (field_expr : 'field_expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterml + ((Gram.Entry.obj (expr : 'expr Gram.Entry.t)), + "top") ], + (Gram.Action.mk + (fun (e : 'expr) _ (l : 'label) + (_loc : Gram.Loc.t) -> + (Ast.RbEq (_loc, (Ast.IdLid (_loc, l)), e) : + 'field_expr)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.RbAnt (_loc, + (mk_anti ~c: "rec_binding" n s)) : + 'field_expr) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "bi" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"bi\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "bi" | "anti" as n)), s) + -> + (Ast.RbAnt (_loc, + (mk_anti ~c: "rec_binding" n s)) : + 'field_expr) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (meth_list : 'meth_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (meth_decl : 'meth_decl Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_dot_dot : 'opt_dot_dot Gram.Entry.t)) ], + (Gram.Action.mk + (fun (v : 'opt_dot_dot) (m : 'meth_decl) + (_loc : Gram.Loc.t) -> + ((m, v) : 'meth_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (meth_decl : 'meth_decl Gram.Entry.t)); + Gram.Skeyword ";"; + Gram.Snterm + (Gram.Entry.obj + (opt_dot_dot : 'opt_dot_dot Gram.Entry.t)) ], + (Gram.Action.mk + (fun (v : 'opt_dot_dot) _ (m : 'meth_decl) + (_loc : Gram.Loc.t) -> + ((m, v) : 'meth_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (meth_decl : 'meth_decl Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun ((ml, v) : 'meth_list) _ (m : 'meth_decl) + (_loc : Gram.Loc.t) -> + (((Ast.TySem (_loc, m, ml)), v) : + 'meth_list)))) ]) ])) + ()); + Gram.extend (meth_decl : 'meth_decl Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ (lab : 'a_LIDENT) + (_loc : Gram.Loc.t) -> + (Ast.TyCol (_loc, + (Ast.TyId (_loc, + (Ast.IdLid (_loc, lab)))), + t) : + 'meth_decl)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.ctyp_tag : + 'meth_decl) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp;" n s)) : + 'meth_decl) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp" n s)) : + 'meth_decl) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (opt_meth_list : 'opt_meth_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (opt_dot_dot : 'opt_dot_dot Gram.Entry.t)) ], + (Gram.Action.mk + (fun (v : 'opt_dot_dot) (_loc : Gram.Loc.t) -> + (Ast.TyObj (_loc, (Ast.TyNil _loc), v) : + 'opt_meth_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (meth_list : 'meth_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun ((ml, v) : 'meth_list) + (_loc : Gram.Loc.t) -> + (Ast.TyObj (_loc, ml, v) : 'opt_meth_list)))) ]) ])) + ()); + Gram.extend (poly_type : 'poly_type Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) (_loc : Gram.Loc.t) -> + (t : 'poly_type)))) ]) ])) + ()); + Gram.extend (package_type : 'package_type Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'module_type) (_loc : Gram.Loc.t) -> + (p : 'package_type)))) ]) ])) + ()); + Gram.extend (typevars : 'typevars Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Skeyword "'"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ (_loc : Gram.Loc.t) -> + (Ast.TyQuo (_loc, i) : 'typevars)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.ctyp_tag : + 'typevars) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp" n s)) : + 'typevars) + | _ -> assert false))); + ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'typevars) (t1 : 'typevars) + (_loc : Gram.Loc.t) -> + (Ast.TyApp (_loc, t1, t2) : 'typevars)))) ]) ])) + ()); + Gram.extend + (unquoted_typevars : 'unquoted_typevars Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) (_loc : Gram.Loc.t) -> + (Ast.TyId (_loc, (Ast.IdLid (_loc, i))) : + 'unquoted_typevars)))); + ([ Gram.Stoken + (((function + | QUOTATION _ -> true + | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand _loc x Quotation. + DynAst.ctyp_tag : + 'unquoted_typevars) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp" n s)) : + 'unquoted_typevars) + | _ -> assert false))); + ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'unquoted_typevars) + (t1 : 'unquoted_typevars) + (_loc : Gram.Loc.t) -> + (Ast.TyApp (_loc, t1, t2) : + 'unquoted_typevars)))) ]) ])) + ()); + Gram.extend (row_field : 'row_field Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) (_loc : Gram.Loc.t) -> + (t : 'row_field)))); + ([ Gram.Skeyword "`"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)); + Gram.Skeyword "of"; + Gram.Snterm + (Gram.Entry.obj + (amp_ctyp : 'amp_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'amp_ctyp) _ (i : 'a_ident) _ + (_loc : Gram.Loc.t) -> + (Ast.TyOf (_loc, (Ast.TyVrn (_loc, i)), t) : + 'row_field)))); + ([ Gram.Skeyword "`"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)); + Gram.Skeyword "of"; Gram.Skeyword "&"; + Gram.Snterm + (Gram.Entry.obj + (amp_ctyp : 'amp_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'amp_ctyp) _ _ (i : 'a_ident) _ + (_loc : Gram.Loc.t) -> + (Ast.TyOfAmp (_loc, (Ast.TyVrn (_loc, i)), + t) : + 'row_field)))); + ([ Gram.Skeyword "`"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ (_loc : Gram.Loc.t) -> + (Ast.TyVrn (_loc, i) : 'row_field)))); + ([ Gram.Sself; Gram.Skeyword "|"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'row_field) _ (t1 : 'row_field) + (_loc : Gram.Loc.t) -> + (Ast.TyOr (_loc, t1, t2) : 'row_field)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp|" n s)) : + 'row_field) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp" n s)) : + 'row_field) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (amp_ctyp : 'amp_ctyp Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) (_loc : Gram.Loc.t) -> + (t : 'amp_ctyp)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp&" n s)) : + 'amp_ctyp) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword "&"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'amp_ctyp) _ (t1 : 'amp_ctyp) + (_loc : Gram.Loc.t) -> + (Ast.TyAmp (_loc, t1, t2) : 'amp_ctyp)))) ]) ])) + ()); + Gram.extend (name_tags : 'name_tags Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "`"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ (_loc : Gram.Loc.t) -> + (Ast.TyVrn (_loc, i) : 'name_tags)))); + ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'name_tags) (t1 : 'name_tags) + (_loc : Gram.Loc.t) -> + (Ast.TyApp (_loc, t1, t2) : 'name_tags)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" as n)), s) -> + (Ast.TyAnt (_loc, + (mk_anti ~c: "ctyp" n s)) : + 'name_tags) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (eq_expr : 'eq_expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (fun i p -> Ast.PaOlb (_loc, i, p) : + 'eq_expr)))); + ([ Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Gram.Loc.t) -> + (fun i p -> Ast.PaOlbi (_loc, i, p, e) : + 'eq_expr)))) ]) ])) + ()); + Gram.extend (patt_tcon : 'patt_tcon Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'patt) (_loc : Gram.Loc.t) -> + (p : 'patt_tcon)))); + ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) _ (p : 'patt) + (_loc : Gram.Loc.t) -> + (Ast.PaTyc (_loc, p, t) : 'patt_tcon)))) ]) ])) + ()); + Gram.extend (ipatt : 'ipatt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "?"; Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (ipatt_tcon : 'ipatt_tcon Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (e : 'expr) _ (p : 'ipatt_tcon) _ _ + (_loc : Gram.Loc.t) -> + (Ast.PaOlbi (_loc, "", p, e) : 'ipatt)))); + ([ Gram.Skeyword "?"; Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (ipatt_tcon : 'ipatt_tcon Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (p : 'ipatt_tcon) _ _ + (_loc : Gram.Loc.t) -> + (Ast.PaOlb (_loc, "", p) : 'ipatt)))); + ([ Gram.Skeyword "?"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "lid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"lid\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "lid" as n)), i) -> + (Ast.PaOlb (_loc, (mk_anti n i), + (Ast.PaNil _loc)) : + 'ipatt) + | _ -> assert false))); + ([ Gram.Skeyword "?"; + Gram.Stoken + (((function | LIDENT _ -> true | _ -> false), + "LIDENT _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | LIDENT i -> + (Ast.PaOlb (_loc, i, (Ast.PaNil _loc)) : + 'ipatt) + | _ -> assert false))); + ([ Gram.Skeyword "?"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "lid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"lid\"), _)")); + Gram.Skeyword ":"; Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (ipatt_tcon : 'ipatt_tcon Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (eq_expr : 'eq_expr Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (f : 'eq_expr) (p : 'ipatt_tcon) _ _ + (__camlp4_0 : Gram.Token.t) _ + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "lid" as n)), i) -> + (f (mk_anti n i) p : 'ipatt) + | _ -> assert false))); + ([ Gram.Stoken + (((function | OPTLABEL _ -> true | _ -> false), + "OPTLABEL _")); + Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (ipatt_tcon : 'ipatt_tcon Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (eq_expr : 'eq_expr Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (f : 'eq_expr) (p : 'ipatt_tcon) _ + (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | OPTLABEL i -> (f i p : 'ipatt) + | _ -> assert false))); + ([ Gram.Skeyword "~"; + Gram.Stoken + (((function | LIDENT _ -> true | _ -> false), + "LIDENT _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | LIDENT i -> + (Ast.PaLab (_loc, i, (Ast.PaNil _loc)) : + 'ipatt) + | _ -> assert false))); + ([ Gram.Skeyword "~"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "lid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"lid\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "lid" as n)), i) -> + (Ast.PaLab (_loc, (mk_anti n i), + (Ast.PaNil _loc)) : + 'ipatt) + | _ -> assert false))); + ([ Gram.Skeyword "~"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "lid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"lid\"), _)")); + Gram.Skeyword ":"; Gram.Sself ], + (Gram.Action.mk + (fun (p : 'ipatt) _ + (__camlp4_0 : Gram.Token.t) _ + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "lid" as n)), i) -> + (Ast.PaLab (_loc, (mk_anti n i), p) : + 'ipatt) + | _ -> assert false))); + ([ Gram.Stoken + (((function | LABEL _ -> true | _ -> false), + "LABEL _")); + Gram.Sself ], + (Gram.Action.mk + (fun (p : 'ipatt) (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | LABEL i -> + (Ast.PaLab (_loc, i, p) : 'ipatt) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (ipatt_tcon : 'ipatt_tcon Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'ipatt) (_loc : Gram.Loc.t) -> + (p : 'ipatt_tcon)))); + ([ Gram.Snterm + (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) _ (p : 'ipatt) + (_loc : Gram.Loc.t) -> + (Ast.PaTyc (_loc, p, t) : 'ipatt_tcon)))) ]) ])) + ()); + Gram.extend (direction_flag : 'direction_flag Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function + | ANTIQUOT (("to" | "anti"), _) -> true + | _ -> false), + "ANTIQUOT ((\"to\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("to" | "anti" as n)), s) -> + (Ast.DiAnt (mk_anti n s) : + 'direction_flag) + | _ -> assert false))); + ([ Gram.Skeyword "downto" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (Ast.DiDownto : 'direction_flag)))); + ([ Gram.Skeyword "to" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (Ast.DiTo : 'direction_flag)))) ]) ])) + ()); + Gram.extend (opt_private : 'opt_private Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.PrNil : 'opt_private)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("private" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"private\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("private" | "anti" as n)), s) + -> + (Ast.PrAnt (mk_anti n s) : + 'opt_private) + | _ -> assert false))); + ([ Gram.Skeyword "private" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (Ast.PrPrivate : 'opt_private)))) ]) ])) + ()); + Gram.extend (opt_mutable : 'opt_mutable Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.MuNil : 'opt_mutable)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("mutable" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"mutable\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("mutable" | "anti" as n)), s) + -> + (Ast.MuAnt (mk_anti n s) : + 'opt_mutable) + | _ -> assert false))); + ([ Gram.Skeyword "mutable" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (Ast.MuMutable : 'opt_mutable)))) ]) ])) + ()); + Gram.extend (opt_virtual : 'opt_virtual Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.ViNil : 'opt_virtual)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("virtual" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"virtual\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("virtual" | "anti" as n)), s) + -> + (Ast.ViAnt (mk_anti n s) : + 'opt_virtual) + | _ -> assert false))); + ([ Gram.Skeyword "virtual" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (Ast.ViVirtual : 'opt_virtual)))) ]) ])) + ()); + Gram.extend (opt_dot_dot : 'opt_dot_dot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.RvNil : 'opt_dot_dot)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ((".." | "anti"), _) -> true + | _ -> false), + "ANTIQUOT ((\"..\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT (((".." | "anti" as n)), s) -> + (Ast.RvAnt (mk_anti n s) : + 'opt_dot_dot) + | _ -> assert false))); + ([ Gram.Skeyword ".." ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (Ast.RvRowVar : 'opt_dot_dot)))) ]) ])) + ()); + Gram.extend (opt_rec : 'opt_rec Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.ReNil : 'opt_rec)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("rec" | "anti"), _) -> true + | _ -> false), + "ANTIQUOT ((\"rec\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("rec" | "anti" as n)), s) -> + (Ast.ReAnt (mk_anti n s) : 'opt_rec) + | _ -> assert false))); + ([ Gram.Skeyword "rec" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (Ast.ReRecursive : 'opt_rec)))) ]) ])) + ()); + Gram.extend (opt_override : 'opt_override Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.OvNil : 'opt_override)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("!" | "override" | "anti"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"!\" | \"override\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("!" | "override" | "anti" as n)), s) + -> + (Ast.OvAnt (mk_anti n s) : + 'opt_override) + | _ -> assert false))); + ([ Gram.Skeyword "!" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (Ast.OvOverride : 'opt_override)))) ]) ])) + ()); + Gram.extend (opt_expr : 'opt_expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.ExNil _loc : 'opt_expr)))); + ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) (_loc : Gram.Loc.t) -> + (e : 'opt_expr)))) ]) ])) + ()); + Gram.extend (interf : 'interf Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | EOI -> true | _ -> false), + "EOI")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | EOI -> (([], None) : 'interf) + | _ -> assert false))); + ([ Gram.Snterm + (Gram.Entry.obj + (sig_item : 'sig_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun ((sil, stopped) : 'interf) _ + (si : 'sig_item) (_loc : Gram.Loc.t) -> + (((si :: sil), stopped) : 'interf)))); + ([ Gram.Skeyword "#"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_expr : 'opt_expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (dp : 'opt_expr) (n : 'a_LIDENT) _ + (_loc : Gram.Loc.t) -> + (([ Ast.SgDir (_loc, n, dp) ], + (stopped_at _loc)) : 'interf)))) ]) ])) + ()); + Gram.extend (sig_items : 'sig_items Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Slist0 + (Gram.srules sig_items + [ ([ Gram.Snterm + (Gram.Entry.obj + (sig_item : + 'sig_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (semi : 'semi Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (sg : 'sig_item) + (_loc : Gram.Loc.t) -> + (sg : 'e__12)))) ]) ], + (Gram.Action.mk + (fun (l : 'e__12 list) (_loc : Gram.Loc.t) -> + (Ast.sgSem_of_list l : 'sig_items)))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "sigi" | "anti" | "list"), _) + -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"sigi\" | \"anti\" | \"list\"), _)")); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (sg : 'sig_items) _ + (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "sigi" | "anti" | "list" as n)), + s) -> + (Ast.SgSem (_loc, + (Ast.SgAnt (_loc, + (mk_anti n ~c: "sig_item" s))), + sg) : + 'sig_items) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "sigi" | "anti" | "list"), _) + -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"sigi\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "sigi" | "anti" | "list" as n)), + s) -> + (Ast.SgAnt (_loc, + (mk_anti n ~c: "sig_item" s)) : + 'sig_items) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (implem : 'implem Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | EOI -> true | _ -> false), + "EOI")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | EOI -> (([], None) : 'implem) + | _ -> assert false))); + ([ Gram.Snterm + (Gram.Entry.obj + (str_item : 'str_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun ((sil, stopped) : 'implem) _ + (si : 'str_item) (_loc : Gram.Loc.t) -> + (((si :: sil), stopped) : 'implem)))); + ([ Gram.Skeyword "#"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_expr : 'opt_expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (dp : 'opt_expr) (n : 'a_LIDENT) _ + (_loc : Gram.Loc.t) -> + (([ Ast.StDir (_loc, n, dp) ], + (stopped_at _loc)) : 'implem)))) ]) ])) + ()); + Gram.extend (str_items : 'str_items Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Slist0 + (Gram.srules str_items + [ ([ Gram.Snterm + (Gram.Entry.obj + (str_item : + 'str_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (semi : 'semi Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (st : 'str_item) + (_loc : Gram.Loc.t) -> + (st : 'e__13)))) ]) ], + (Gram.Action.mk + (fun (l : 'e__13 list) (_loc : Gram.Loc.t) -> + (Ast.stSem_of_list l : 'str_items)))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "stri" | "anti" | "list"), _) + -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"stri\" | \"anti\" | \"list\"), _)")); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (st : 'str_items) _ + (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "stri" | "anti" | "list" as n)), + s) -> + (Ast.StSem (_loc, + (Ast.StAnt (_loc, + (mk_anti n ~c: "str_item" s))), + st) : + 'str_items) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "stri" | "anti" | "list"), _) + -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"stri\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "stri" | "anti" | "list" as n)), + s) -> + (Ast.StAnt (_loc, + (mk_anti n ~c: "str_item" s)) : + 'str_items) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (top_phrase : 'top_phrase Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | EOI -> true | _ -> false), + "EOI")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | EOI -> (None : 'top_phrase) + | _ -> assert false))); + ([ Gram.Snterm + (Gram.Entry.obj + (phrase : 'phrase Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ph : 'phrase) (_loc : Gram.Loc.t) -> + (Some ph : 'top_phrase)))) ]) ])) + ()); + Gram.extend (use_file : 'use_file Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | EOI -> true | _ -> false), + "EOI")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | EOI -> (([], None) : 'use_file) + | _ -> assert false))); + ([ Gram.Snterm + (Gram.Entry.obj + (str_item : 'str_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun ((sil, stopped) : 'use_file) _ + (si : 'str_item) (_loc : Gram.Loc.t) -> + (((si :: sil), stopped) : 'use_file)))); + ([ Gram.Skeyword "#"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_expr : 'opt_expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (dp : 'opt_expr) (n : 'a_LIDENT) _ + (_loc : Gram.Loc.t) -> + (([ Ast.StDir (_loc, n, dp) ], + (stopped_at _loc)) : 'use_file)))) ]) ])) + ()); + Gram.extend (phrase : 'phrase Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (str_item : 'str_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (st : 'str_item) (_loc : Gram.Loc.t) -> + (st : 'phrase)))); + ([ Gram.Skeyword "#"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_expr : 'opt_expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (dp : 'opt_expr) (n : 'a_LIDENT) _ + (_loc : Gram.Loc.t) -> + (Ast.StDir (_loc, n, dp) : 'phrase)))) ]) ])) + ()); + Gram.extend (a_INT : 'a_INT Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | INT (_, _) -> true | _ -> false), + "INT (_, _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | INT (_, s) -> (s : 'a_INT) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "int" | "`int"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"int\" | \"`int\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "int" | "`int" as n)), + s) -> (mk_anti n s : 'a_INT) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_INT32 : 'a_INT32 Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function + | INT32 (_, _) -> true + | _ -> false), + "INT32 (_, _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | INT32 (_, s) -> (s : 'a_INT32) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "int32" | "`int32"), _) + -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"int32\" | \"`int32\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "int32" | "`int32" as n)), s) + -> (mk_anti n s : 'a_INT32) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_INT64 : 'a_INT64 Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function + | INT64 (_, _) -> true + | _ -> false), + "INT64 (_, _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | INT64 (_, s) -> (s : 'a_INT64) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "int64" | "`int64"), _) + -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"int64\" | \"`int64\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "int64" | "`int64" as n)), s) + -> (mk_anti n s : 'a_INT64) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_NATIVEINT : 'a_NATIVEINT Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function + | NATIVEINT (_, _) -> true + | _ -> false), + "NATIVEINT (_, _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | NATIVEINT (_, s) -> (s : 'a_NATIVEINT) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "nativeint" | "`nativeint"), _) + -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"nativeint\" | \"`nativeint\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "nativeint" | "`nativeint" as + n)), + s) -> (mk_anti n s : 'a_NATIVEINT) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_FLOAT : 'a_FLOAT Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function + | FLOAT (_, _) -> true + | _ -> false), + "FLOAT (_, _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | FLOAT (_, s) -> (s : 'a_FLOAT) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "flo" | "`flo"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"flo\" | \"`flo\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "flo" | "`flo" as n)), + s) -> (mk_anti n s : 'a_FLOAT) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_CHAR : 'a_CHAR Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function + | CHAR (_, _) -> true + | _ -> false), + "CHAR (_, _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | CHAR (_, s) -> (s : 'a_CHAR) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "chr" | "`chr"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"chr\" | \"`chr\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "chr" | "`chr" as n)), + s) -> (mk_anti n s : 'a_CHAR) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_UIDENT : 'a_UIDENT Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | UIDENT _ -> true | _ -> false), + "UIDENT _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | UIDENT s -> (s : 'a_UIDENT) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "uid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"uid\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "uid" as n)), s) -> + (mk_anti n s : 'a_UIDENT) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_LIDENT : 'a_LIDENT Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | LIDENT _ -> true | _ -> false), + "LIDENT _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | LIDENT s -> (s : 'a_LIDENT) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "lid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"lid\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "lid" as n)), s) -> + (mk_anti n s : 'a_LIDENT) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_LABEL : 'a_LABEL Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | LABEL _ -> true | _ -> false), + "LABEL _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | LABEL s -> (s : 'a_LABEL) + | _ -> assert false))); + ([ Gram.Skeyword "~"; + Gram.Stoken + (((function + | ANTIQUOT ("", _) -> true + | _ -> false), + "ANTIQUOT (\"\", _)")); + Gram.Skeyword ":" ], + (Gram.Action.mk + (fun _ (__camlp4_0 : Gram.Token.t) _ + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" as n)), s) -> + (mk_anti n s : 'a_LABEL) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_OPTLABEL : 'a_OPTLABEL Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | OPTLABEL _ -> true | _ -> false), + "OPTLABEL _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | OPTLABEL s -> (s : 'a_OPTLABEL) + | _ -> assert false))); + ([ Gram.Skeyword "?"; + Gram.Stoken + (((function + | ANTIQUOT ("", _) -> true + | _ -> false), + "ANTIQUOT (\"\", _)")); + Gram.Skeyword ":" ], + (Gram.Action.mk + (fun _ (__camlp4_0 : Gram.Token.t) _ + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" as n)), s) -> + (mk_anti n s : 'a_OPTLABEL) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_STRING : 'a_STRING Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function + | STRING (_, _) -> true + | _ -> false), + "STRING (_, _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | STRING (_, s) -> (s : 'a_STRING) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "str" | "`str"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"str\" | \"`str\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "str" | "`str" as n)), + s) -> (mk_anti n s : 'a_STRING) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (string_list : 'string_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function + | STRING (_, _) -> true + | _ -> false), + "STRING (_, _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | STRING (_, x) -> + (Ast.LCons (x, Ast.LNil) : + 'string_list) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | STRING (_, _) -> true + | _ -> false), + "STRING (_, _)")); + Gram.Sself ], + (Gram.Action.mk + (fun (xs : 'string_list) + (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | STRING (_, x) -> + (Ast.LCons (x, xs) : 'string_list) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "str_list"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"str_list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT (("" | "str_list"), s) -> + (Ast.LAnt (mk_anti "str_list" s) : + 'string_list) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (value_let : 'value_let Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "value" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (() : 'value_let)))) ]) ])) + ()); + Gram.extend (value_val : 'value_val Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "value" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> + (() : 'value_val)))) ]) ])) + ()); + Gram.extend (semi : 'semi Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword ";" ], + (Gram.Action.mk + (fun _ (_loc : Gram.Loc.t) -> (() : 'semi)))) ]) ])) + ()); + Gram.extend (expr_quot : 'expr_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.ExNil _loc : 'expr_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) (_loc : Gram.Loc.t) -> + (e : 'expr_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword ";"; + Gram.Snterm + (Gram.Entry.obj + (sem_expr : 'sem_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e2 : 'sem_expr) _ (e1 : 'expr) + (_loc : Gram.Loc.t) -> + (Ast.ExSem (_loc, e1, e2) : 'expr_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword ","; + Gram.Snterm + (Gram.Entry.obj + (comma_expr : 'comma_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e2 : 'comma_expr) _ (e1 : 'expr) + (_loc : Gram.Loc.t) -> + (Ast.ExCom (_loc, e1, e2) : 'expr_quot)))) ]) ])) + ()); + Gram.extend (patt_quot : 'patt_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.PaNil _loc : 'patt_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'patt) (_loc : Gram.Loc.t) -> + (x : 'patt_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'patt) _ (x : 'patt) + (_loc : Gram.Loc.t) -> + (let i = + match x with + | Ast.PaAnt (loc, s) -> + Ast.IdAnt (loc, s) + | p -> Ast.ident_of_patt p + in Ast.PaEq (_loc, i, y) : 'patt_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword ";"; + Gram.Snterm + (Gram.Entry.obj + (sem_patt : 'sem_patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'sem_patt) _ (x : 'patt) + (_loc : Gram.Loc.t) -> + (Ast.PaSem (_loc, x, y) : 'patt_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword ","; + Gram.Snterm + (Gram.Entry.obj + (comma_patt : 'comma_patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'comma_patt) _ (x : 'patt) + (_loc : Gram.Loc.t) -> + (Ast.PaCom (_loc, x, y) : 'patt_quot)))) ]) ])) + ()); + Gram.extend (ctyp_quot : 'ctyp_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.TyNil _loc : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'more_ctyp) (_loc : Gram.Loc.t) -> + (x : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword "and"; + Gram.Snterm + (Gram.Entry.obj + (constructor_arg_list : + 'constructor_arg_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'constructor_arg_list) _ + (x : 'more_ctyp) (_loc : Gram.Loc.t) -> + (Ast.TyAnd (_loc, x, y) : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword "&"; + Gram.Snterm + (Gram.Entry.obj + (amp_ctyp : 'amp_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'amp_ctyp) _ (x : 'more_ctyp) + (_loc : Gram.Loc.t) -> + (Ast.TyAmp (_loc, x, y) : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword "*"; + Gram.Snterm + (Gram.Entry.obj + (star_ctyp : 'star_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'star_ctyp) _ (x : 'more_ctyp) + (_loc : Gram.Loc.t) -> + (Ast.TySta (_loc, x, y) : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword ";"; + Gram.Snterm + (Gram.Entry.obj + (label_declaration_list : + 'label_declaration_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (z : 'label_declaration_list) _ + (y : 'more_ctyp) _ (x : 'more_ctyp) + (_loc : Gram.Loc.t) -> + (Ast.TySem (_loc, (Ast.TyCol (_loc, x, y)), + z) : + 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'more_ctyp) _ (x : 'more_ctyp) + (_loc : Gram.Loc.t) -> + (Ast.TyCol (_loc, x, y) : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword "of"; Gram.Skeyword "&"; + Gram.Snterm + (Gram.Entry.obj + (amp_ctyp : 'amp_ctyp Gram.Entry.t)); + Gram.Skeyword "|"; + Gram.Snterm + (Gram.Entry.obj + (row_field : 'row_field Gram.Entry.t)) ], + (Gram.Action.mk + (fun (z : 'row_field) _ (y : 'amp_ctyp) _ _ + (x : 'more_ctyp) (_loc : Gram.Loc.t) -> + (Ast.TyOr (_loc, + (Ast.TyOfAmp (_loc, x, y)), z) : + 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword "of"; Gram.Skeyword "&"; + Gram.Snterm + (Gram.Entry.obj + (amp_ctyp : 'amp_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'amp_ctyp) _ _ (x : 'more_ctyp) + (_loc : Gram.Loc.t) -> + (Ast.TyOfAmp (_loc, x, y) : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword "of"; + Gram.Snterm + (Gram.Entry.obj + (constructor_arg_list : + 'constructor_arg_list Gram.Entry.t)); + Gram.Skeyword "|"; + Gram.Snterm + (Gram.Entry.obj + (constructor_declarations : + 'constructor_declarations Gram.Entry.t)) ], + (Gram.Action.mk + (fun (z : 'constructor_declarations) _ + (y : 'constructor_arg_list) _ + (x : 'more_ctyp) (_loc : Gram.Loc.t) -> + (Ast.TyOr (_loc, (Ast.TyOf (_loc, x, y)), + z) : + 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword "of"; + Gram.Snterm + (Gram.Entry.obj + (constructor_arg_list : + 'constructor_arg_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'constructor_arg_list) _ + (x : 'more_ctyp) (_loc : Gram.Loc.t) -> + (Ast.TyOf (_loc, x, y) : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword "|"; + Gram.Snterm + (Gram.Entry.obj + (constructor_declarations : + 'constructor_declarations Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'constructor_declarations) _ + (x : 'more_ctyp) (_loc : Gram.Loc.t) -> + (Ast.TyOr (_loc, x, y) : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword ";"; + Gram.Snterm + (Gram.Entry.obj + (label_declaration_list : + 'label_declaration_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'label_declaration_list) _ + (x : 'more_ctyp) (_loc : Gram.Loc.t) -> + (Ast.TySem (_loc, x, y) : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword ","; + Gram.Snterm + (Gram.Entry.obj + (comma_ctyp : 'comma_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'comma_ctyp) _ (x : 'more_ctyp) + (_loc : Gram.Loc.t) -> + (Ast.TyCom (_loc, x, y) : 'ctyp_quot)))) ]) ])) + ()); + Gram.extend (more_ctyp : 'more_ctyp Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (type_parameter : + 'type_parameter Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'type_parameter) (_loc : Gram.Loc.t) + -> (x : 'more_ctyp)))); + ([ Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'ctyp) (_loc : Gram.Loc.t) -> + (x : 'more_ctyp)))); + ([ Gram.Skeyword "`"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'a_ident) _ (_loc : Gram.Loc.t) -> + (Ast.TyVrn (_loc, x) : 'more_ctyp)))); + ([ Gram.Skeyword "mutable"; Gram.Sself ], + (Gram.Action.mk + (fun (x : 'more_ctyp) _ (_loc : Gram.Loc.t) -> + (Ast.TyMut (_loc, x) : 'more_ctyp)))) ]) ])) + ()); + Gram.extend (str_item_quot : 'str_item_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.StNil _loc : 'str_item_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (str_item : 'str_item Gram.Entry.t)) ], + (Gram.Action.mk + (fun (st : 'str_item) (_loc : Gram.Loc.t) -> + (st : 'str_item_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (str_item : 'str_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (st2 : 'str_item_quot) _ + (st1 : 'str_item) (_loc : Gram.Loc.t) -> + (match st2 with + | Ast.StNil _ -> st1 + | _ -> Ast.StSem (_loc, st1, st2) : + 'str_item_quot)))); + ([ Gram.Skeyword "#"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_expr : 'opt_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (dp : 'opt_expr) (n : 'a_LIDENT) _ + (_loc : Gram.Loc.t) -> + (Ast.StDir (_loc, n, dp) : 'str_item_quot)))) ]) ])) + ()); + Gram.extend (sig_item_quot : 'sig_item_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.SgNil _loc : 'sig_item_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (sig_item : 'sig_item Gram.Entry.t)) ], + (Gram.Action.mk + (fun (sg : 'sig_item) (_loc : Gram.Loc.t) -> + (sg : 'sig_item_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (sig_item : 'sig_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (sg2 : 'sig_item_quot) _ + (sg1 : 'sig_item) (_loc : Gram.Loc.t) -> + (match sg2 with + | Ast.SgNil _ -> sg1 + | _ -> Ast.SgSem (_loc, sg1, sg2) : + 'sig_item_quot)))); + ([ Gram.Skeyword "#"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_expr : 'opt_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (dp : 'opt_expr) (n : 'a_LIDENT) _ + (_loc : Gram.Loc.t) -> + (Ast.SgDir (_loc, n, dp) : 'sig_item_quot)))) ]) ])) + ()); + Gram.extend + (module_type_quot : 'module_type_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.MtNil _loc : 'module_type_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'module_type) (_loc : Gram.Loc.t) -> + (x : 'module_type_quot)))) ]) ])) + ()); + Gram.extend + (module_expr_quot : 'module_expr_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.MeNil _loc : 'module_expr_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'module_expr) (_loc : Gram.Loc.t) -> + (x : 'module_expr_quot)))) ]) ])) + ()); + Gram.extend (match_case_quot : 'match_case_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.McNil _loc : 'match_case_quot)))); + ([ Gram.Slist0sep + ((Gram.Snterm + (Gram.Entry.obj + (match_case0 : + 'match_case0 Gram.Entry.t))), + (Gram.Skeyword "|")) ], + (Gram.Action.mk + (fun (x : 'match_case0 list) + (_loc : Gram.Loc.t) -> + (Ast.mcOr_of_list x : 'match_case_quot)))) ]) ])) + ()); + Gram.extend (binding_quot : 'binding_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.BiNil _loc : 'binding_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (binding : 'binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'binding) (_loc : Gram.Loc.t) -> + (x : 'binding_quot)))) ]) ])) + ()); + Gram.extend + (rec_binding_quot : 'rec_binding_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.RbNil _loc : 'rec_binding_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (label_expr_list : + 'label_expr_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'label_expr_list) + (_loc : Gram.Loc.t) -> + (x : 'rec_binding_quot)))) ]) ])) + ()); + Gram.extend + (module_binding_quot : 'module_binding_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.MbNil _loc : 'module_binding_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (me : 'module_expr) _ (mt : 'module_type) + _ (m : 'a_UIDENT) (_loc : Gram.Loc.t) -> + (Ast.MbColEq (_loc, m, mt, me) : + 'module_binding_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mt : 'module_type) _ (m : 'a_UIDENT) + (_loc : Gram.Loc.t) -> + (Ast.MbCol (_loc, m, mt) : + 'module_binding_quot)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("", _) -> true + | _ -> false), + "ANTIQUOT (\"\", _)")); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (me : 'module_expr) _ (mt : 'module_type) + _ (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" as n)), m) -> + (Ast.MbColEq (_loc, (mk_anti n m), mt, + me) : + 'module_binding_quot) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("", _) -> true + | _ -> false), + "ANTIQUOT (\"\", _)")); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mt : 'module_type) _ + (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" as n)), m) -> + (Ast.MbCol (_loc, (mk_anti n m), mt) : + 'module_binding_quot) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("", _) -> true + | _ -> false), + "ANTIQUOT (\"\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" as n)), s) -> + (Ast.MbAnt (_loc, + (mk_anti ~c: "module_binding" n s)) : + 'module_binding_quot) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("module_binding" | "anti"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"module_binding\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("module_binding" | "anti" as n)), s) + -> + (Ast.MbAnt (_loc, + (mk_anti ~c: "module_binding" n s)) : + 'module_binding_quot) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (b2 : 'module_binding_quot) _ + (b1 : 'module_binding_quot) + (_loc : Gram.Loc.t) -> + (Ast.MbAnd (_loc, b1, b2) : + 'module_binding_quot)))) ]) ])) + ()); + Gram.extend (ident_quot : 'ident_quot Gram.Entry.t) + ((fun () -> + (None, + [ ((Some "apply"), None, + [ ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (j : 'ident_quot) (i : 'ident_quot) + (_loc : Gram.Loc.t) -> + (Ast.IdApp (_loc, i, j) : 'ident_quot)))) ]); + ((Some "."), None, + [ ([ Gram.Sself; Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (j : 'ident_quot) _ (i : 'ident_quot) + (_loc : Gram.Loc.t) -> + (Ast.IdAcc (_loc, i, j) : 'ident_quot)))) ]); + ((Some "simple"), None, + [ ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (i : 'ident_quot) _ (_loc : Gram.Loc.t) + -> (i : 'ident_quot)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "id" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")); + Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (i : 'ident_quot) _ + (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "id" | "anti" | "list" as n)), + s) -> + (Ast.IdAcc (_loc, + (Ast.IdAnt (_loc, + (mk_anti ~c: "ident" n s))), + i) : + 'ident_quot) + | _ -> assert false))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) (_loc : Gram.Loc.t) -> + (Ast.IdLid (_loc, i) : 'ident_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_UIDENT) (_loc : Gram.Loc.t) -> + (Ast.IdUid (_loc, i) : 'ident_quot)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "id" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "id" | "anti" | "list" as n)), + s) -> + (Ast.IdAnt (_loc, + (mk_anti ~c: "ident" n s)) : + 'ident_quot) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (class_expr_quot : 'class_expr_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.CeNil _loc : 'class_expr_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_expr : 'class_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'class_expr) (_loc : Gram.Loc.t) -> + (x : 'class_expr_quot)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("virtual", _) -> true + | _ -> false), + "ANTIQUOT (\"virtual\", _)")); + Gram.Snterm + (Gram.Entry.obj (ident : 'ident Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_comma_ctyp : + 'opt_comma_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ot : 'opt_comma_ctyp) (i : 'ident) + (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("virtual" as n)), s) -> + (let anti = + Ast.ViAnt + (mk_anti ~c: "class_expr" n s) + in Ast.CeCon (_loc, anti, i, ot) : + 'class_expr_quot) + | _ -> assert false))); + ([ Gram.Skeyword "virtual"; + Gram.Snterm + (Gram.Entry.obj + (class_name_and_param : + 'class_name_and_param Gram.Entry.t)) ], + (Gram.Action.mk + (fun ((i, ot) : 'class_name_and_param) _ + (_loc : Gram.Loc.t) -> + (Ast.CeCon (_loc, Ast.ViVirtual, + (Ast.IdLid (_loc, i)), ot) : + 'class_expr_quot)))); + ([ Gram.Sself; Gram.Skeyword "="; Gram.Sself ], + (Gram.Action.mk + (fun (ce2 : 'class_expr_quot) _ + (ce1 : 'class_expr_quot) + (_loc : Gram.Loc.t) -> + (Ast.CeEq (_loc, ce1, ce2) : + 'class_expr_quot)))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (ce2 : 'class_expr_quot) _ + (ce1 : 'class_expr_quot) + (_loc : Gram.Loc.t) -> + (Ast.CeAnd (_loc, ce1, ce2) : + 'class_expr_quot)))) ]) ])) + ()); + Gram.extend (class_type_quot : 'class_type_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.CtNil _loc : 'class_type_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_type_plus : + 'class_type_plus Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'class_type_plus) + (_loc : Gram.Loc.t) -> + (x : 'class_type_quot)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("virtual", _) -> true + | _ -> false), + "ANTIQUOT (\"virtual\", _)")); + Gram.Snterm + (Gram.Entry.obj (ident : 'ident Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_comma_ctyp : + 'opt_comma_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ot : 'opt_comma_ctyp) (i : 'ident) + (__camlp4_0 : Gram.Token.t) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("virtual" as n)), s) -> + (let anti = + Ast.ViAnt + (mk_anti ~c: "class_type" n s) + in Ast.CtCon (_loc, anti, i, ot) : + 'class_type_quot) + | _ -> assert false))); + ([ Gram.Skeyword "virtual"; + Gram.Snterm + (Gram.Entry.obj + (class_name_and_param : + 'class_name_and_param Gram.Entry.t)) ], + (Gram.Action.mk + (fun ((i, ot) : 'class_name_and_param) _ + (_loc : Gram.Loc.t) -> + (Ast.CtCon (_loc, Ast.ViVirtual, + (Ast.IdLid (_loc, i)), ot) : + 'class_type_quot)))); + ([ Gram.Sself; Gram.Skeyword ":"; Gram.Sself ], + (Gram.Action.mk + (fun (ct2 : 'class_type_quot) _ + (ct1 : 'class_type_quot) + (_loc : Gram.Loc.t) -> + (Ast.CtCol (_loc, ct1, ct2) : + 'class_type_quot)))); + ([ Gram.Sself; Gram.Skeyword "="; Gram.Sself ], + (Gram.Action.mk + (fun (ct2 : 'class_type_quot) _ + (ct1 : 'class_type_quot) + (_loc : Gram.Loc.t) -> + (Ast.CtEq (_loc, ct1, ct2) : + 'class_type_quot)))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (ct2 : 'class_type_quot) _ + (ct1 : 'class_type_quot) + (_loc : Gram.Loc.t) -> + (Ast.CtAnd (_loc, ct1, ct2) : + 'class_type_quot)))) ]) ])) + ()); + Gram.extend + (class_str_item_quot : 'class_str_item_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.CrNil _loc : 'class_str_item_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_str_item : + 'class_str_item Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'class_str_item) (_loc : Gram.Loc.t) + -> (x : 'class_str_item_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_str_item : + 'class_str_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (x2 : 'class_str_item_quot) _ + (x1 : 'class_str_item) (_loc : Gram.Loc.t) + -> + (match x2 with + | Ast.CrNil _ -> x1 + | _ -> Ast.CrSem (_loc, x1, x2) : + 'class_str_item_quot)))) ]) ])) + ()); + Gram.extend + (class_sig_item_quot : 'class_sig_item_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.CgNil _loc : 'class_sig_item_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_sig_item : + 'class_sig_item Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'class_sig_item) (_loc : Gram.Loc.t) + -> (x : 'class_sig_item_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_sig_item : + 'class_sig_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (x2 : 'class_sig_item_quot) _ + (x1 : 'class_sig_item) (_loc : Gram.Loc.t) + -> + (match x2 with + | Ast.CgNil _ -> x1 + | _ -> Ast.CgSem (_loc, x1, x2) : + 'class_sig_item_quot)))) ]) ])) + ()); + Gram.extend + (with_constr_quot : 'with_constr_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Gram.Loc.t) -> + (Ast.WcNil _loc : 'with_constr_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (with_constr : 'with_constr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'with_constr) (_loc : Gram.Loc.t) -> + (x : 'with_constr_quot)))) ]) ])) + ()); + Gram.extend (rec_flag_quot : 'rec_flag_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (opt_rec : 'opt_rec Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'opt_rec) (_loc : Gram.Loc.t) -> + (x : 'rec_flag_quot)))) ]) ])) + ()); + Gram.extend + (direction_flag_quot : 'direction_flag_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (direction_flag : + 'direction_flag Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'direction_flag) (_loc : Gram.Loc.t) + -> (x : 'direction_flag_quot)))) ]) ])) + ()); + Gram.extend + (mutable_flag_quot : 'mutable_flag_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (opt_mutable : 'opt_mutable Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'opt_mutable) (_loc : Gram.Loc.t) -> + (x : 'mutable_flag_quot)))) ]) ])) + ()); + Gram.extend + (private_flag_quot : 'private_flag_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (opt_private : 'opt_private Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'opt_private) (_loc : Gram.Loc.t) -> + (x : 'private_flag_quot)))) ]) ])) + ()); + Gram.extend + (virtual_flag_quot : 'virtual_flag_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (opt_virtual : 'opt_virtual Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'opt_virtual) (_loc : Gram.Loc.t) -> + (x : 'virtual_flag_quot)))) ]) ])) + ()); + Gram.extend + (row_var_flag_quot : 'row_var_flag_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (opt_dot_dot : 'opt_dot_dot Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'opt_dot_dot) (_loc : Gram.Loc.t) -> + (x : 'row_var_flag_quot)))) ]) ])) + ()); + Gram.extend + (override_flag_quot : 'override_flag_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (opt_override : + 'opt_override Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'opt_override) (_loc : Gram.Loc.t) + -> (x : 'override_flag_quot)))) ]) ])) + ()); + Gram.extend (patt_eoi : 'patt_eoi Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Stoken + (((function | EOI -> true | _ -> false), + "EOI")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (x : 'patt) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | EOI -> (x : 'patt_eoi) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (expr_eoi : 'expr_eoi Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Stoken + (((function | EOI -> true | _ -> false), + "EOI")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (x : 'expr) + (_loc : Gram.Loc.t) -> + match __camlp4_0 with + | EOI -> (x : 'expr_eoi) + | _ -> assert false))) ]) ])) + ())) + in apply () end @@ -9183,15 +9667,15 @@ (* -*- camlp4r -*- *) (****************************************************************************) (* *) - (* Objective Caml *) + (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) - (* exception on linking described in LICENSE at the top of the Objective *) - (* Caml source tree. *) + (* exception on linking described in LICENSE at the top of the OCaml *) + (* source tree. *) (* *) (****************************************************************************) (* Authors: @@ -9255,7 +9739,6 @@ let antiquot_expander = object inherit Ast.map as super - method patt = function | (Ast.PaAnt (_loc, s) | Ast.PaStr (_loc, s) as p) -> @@ -9420,7 +9903,6 @@ p) | _ -> p) | p -> super#patt p - method expr = function | (Ast.ExAnt (_loc, s) | Ast.ExStr (_loc, s) as e) -> @@ -9461,9 +9943,9 @@ (Ast.ExId (_loc, (Ast.IdAcc (_loc, (Ast.IdUid (_loc, "Camlp4_import")), - (Ast.IdAcc (_loc, - (Ast.IdUid (_loc, "Oprint")), - (Ast.IdLid (_loc, "float_repres")))))))), + (Ast.IdAcc (_loc, + (Ast.IdUid (_loc, "Oprint")), + (Ast.IdLid (_loc, "float_repres")))))))), e) | "`str" -> Ast.ExApp (_loc, @@ -9820,7 +10302,6 @@ e) | _ -> e) | e -> super#expr e - end let add_quotation name entry mexpr mpatt = @@ -9981,15 +10462,15 @@ (* -*- camlp4r -*- *) (****************************************************************************) (* *) - (* Objective Caml *) + (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) - (* exception on linking described in LICENSE at the top of the Objective *) - (* Caml source tree. *) + (* exception on linking described in LICENSE at the top of the OCaml *) + (* source tree. *) (* *) (****************************************************************************) (* Authors: @@ -10023,15 +10504,15 @@ (* -*- camlp4r -*- *) (****************************************************************************) (* *) - (* Objective Caml *) + (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 1998-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) - (* exception on linking described in LICENSE at the top of the Objective *) - (* Caml source tree. *) + (* exception on linking described in LICENSE at the top of the OCaml *) + (* source tree. *) (* *) (****************************************************************************) (* Authors: @@ -10966,15 +11447,15 @@ (* -*- camlp4r -*- *) (****************************************************************************) (* *) - (* Objective Caml *) + (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) - (* exception on linking described in LICENSE at the top of the Objective *) - (* Caml source tree. *) + (* exception on linking described in LICENSE at the top of the OCaml *) + (* source tree. *) (* *) (****************************************************************************) (* Authors: @@ -11813,12 +12294,10 @@ class subst gmod = object inherit Ast.map as super - method ident = function | Ast.IdUid (_, x) when x = gm -> gmod | x -> super#ident x - end let subst_gmod ast gmod = (new subst gmod)#expr ast @@ -11872,13 +12351,11 @@ let wildcarder = object (self) inherit Ast.map as super - method patt = function | Ast.PaId (_loc, (Ast.IdLid (_, _))) -> Ast.PaAny _loc | Ast.PaAli (_, p, _) -> self#patt p | p -> super#patt p - end let mk_tok _loc p t = @@ -13425,15 +13902,15 @@ (* -*- camlp4r -*- *) (****************************************************************************) (* *) - (* Objective Caml *) + (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) - (* exception on linking described in LICENSE at the top of the Objective *) - (* Caml source tree. *) + (* exception on linking described in LICENSE at the top of the OCaml *) + (* source tree. *) (* *) (****************************************************************************) (* Authors: @@ -13475,6 +13952,7 @@ DEFINE = IN __FILE__ __LOCATION__ + LOCATION_OF In patterns: @@ -13507,6 +13985,10 @@ The expression __FILE__ returns the current compiled file name. The expression __LOCATION__ returns the current location of itself. + If used inside a macro, it returns the location where the macro is + called. + The expression (LOCATION_OF parameter) returns the location of the given + macro parameter. It cannot be used outside a macro definition. *) open Camlp4 @@ -13566,22 +14048,60 @@ in loop class reloc _loc = - object inherit Ast.map as super - method loc = fun _ -> _loc - end + object inherit Ast.map as super method loc = fun _ -> _loc end (* method _Loc_t _ = _loc; *) class subst _loc env = object inherit reloc _loc as super - method expr = function | (Ast.ExId (_, (Ast.IdLid (_, x))) | Ast.ExId (_, (Ast.IdUid (_, x))) as e) -> (try List.assoc x env with | Not_found -> super#expr e) + | (Ast.ExApp (_loc, + (Ast.ExId (_, (Ast.IdUid (_, "LOCATION_OF")))), + (Ast.ExId (_, (Ast.IdLid (_, x))))) | + Ast.ExApp (_loc, + (Ast.ExId (_, (Ast.IdUid (_, "LOCATION_OF")))), + (Ast.ExId (_, (Ast.IdUid (_, x))))) + as e) -> + (try + let loc = Ast.loc_of_expr (List.assoc x env) in + let (a, b, c, d, e, f, g, h) = Loc.to_tuple loc + in + Ast.ExApp (_loc, + (Ast.ExId (_loc, + (Ast.IdAcc (_loc, (Ast.IdUid (_loc, "Loc")), + (Ast.IdLid (_loc, "of_tuple")))))), + (Ast.ExTup (_loc, + (Ast.ExCom (_loc, + (Ast.ExStr (_loc, (Ast.safe_string_escaped a))), + (Ast.ExCom (_loc, + (Ast.ExCom (_loc, + (Ast.ExCom (_loc, + (Ast.ExCom (_loc, + (Ast.ExCom (_loc, + (Ast.ExCom (_loc, + (Ast.ExInt (_loc, + (string_of_int b))), + (Ast.ExInt (_loc, + (string_of_int c))))), + (Ast.ExInt (_loc, + (string_of_int d))))), + (Ast.ExInt (_loc, + (string_of_int e))))), + (Ast.ExInt (_loc, (string_of_int f))))), + (Ast.ExInt (_loc, (string_of_int g))))), + (if h + then + Ast.ExId (_loc, + (Ast.IdUid (_loc, "True"))) + else + Ast.ExId (_loc, + (Ast.IdUid (_loc, "False"))))))))))) + with | Not_found -> super#expr e) | e -> super#expr e - method patt = function | (Ast.PaId (_, (Ast.IdLid (_, x))) | @@ -13590,7 +14110,6 @@ (try substp _loc [] (List.assoc x env) with | Not_found -> super#patt p) | p -> super#patt p - end let incorrect_number loc l1 l2 = @@ -14329,87 +14848,6 @@ (i : 'uident) _ (_loc : Gram.Loc.t) -> (if is_defined i then e1 else e2 : 'expr)))) ]) ])) ()); - Gram.extend (expr : 'expr Gram.Entry.t) - ((fun () -> - ((Some (Camlp4.Sig.Grammar.Level "simple")), - [ (None, None, - [ ([ Gram.Stoken - (((function - | LIDENT "__LOCATION__" -> true - | _ -> false), - "LIDENT \"__LOCATION__\"")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | LIDENT "__LOCATION__" -> - (let (a, b, c, d, e, f, g, h) = - Loc.to_tuple _loc - in - Ast.ExApp (_loc, - (Ast.ExId (_loc, - (Ast.IdAcc (_loc, - (Ast.IdUid (_loc, "Loc")), - (Ast.IdLid (_loc, "of_tuple")))))), - (Ast.ExTup (_loc, - (Ast.ExCom (_loc, - (Ast.ExStr (_loc, - (Ast.safe_string_escaped a))), - (Ast.ExCom (_loc, - (Ast.ExCom (_loc, - (Ast.ExCom (_loc, - (Ast.ExCom (_loc, - (Ast.ExCom (_loc, - (Ast.ExCom - (_loc, - (Ast.ExInt - (_loc, - ( - string_of_int - b))), - (Ast.ExInt - (_loc, - ( - string_of_int - c))))), - (Ast.ExInt - (_loc, - (string_of_int - d))))), - (Ast.ExInt (_loc, - (string_of_int - e))))), - (Ast.ExInt (_loc, - (string_of_int f))))), - (Ast.ExInt (_loc, - (string_of_int g))))), - (if h - then - Ast.ExId (_loc, - (Ast.IdUid (_loc, - "True"))) - else - Ast.ExId (_loc, - (Ast.IdUid (_loc, - "False"))))))))))) : - 'expr) - | _ -> assert false))); - ([ Gram.Stoken - (((function - | LIDENT "__FILE__" -> true - | _ -> false), - "LIDENT \"__FILE__\"")) ], - (Gram.Action.mk - (fun (__camlp4_0 : Gram.Token.t) - (_loc : Gram.Loc.t) -> - match __camlp4_0 with - | LIDENT "__FILE__" -> - (Ast.ExStr (_loc, - (Ast.safe_string_escaped - (Loc.file_name _loc))) : - 'expr) - | _ -> assert false))) ]) ])) - ()); Gram.extend (patt : 'patt Gram.Entry.t) ((fun () -> (None, @@ -14448,6 +14886,112 @@ (fun (i : Gram.Token.t) (_loc : Gram.Loc.t) -> (let i = Gram.Token.extract_string i in i : 'uident)))) ]) ])) + ()); + Gram.extend + (* dirty hack to allow polymorphic variants using the introduced keywords. *) + (expr : 'expr Gram.Entry.t) + ((fun () -> + ((Some (Camlp4.Sig.Grammar.Before "simple")), + [ (None, None, + [ ([ Gram.Skeyword "`"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_ident) _ (_loc : Gram.Loc.t) -> + (Ast.ExVrn (_loc, s) : 'expr)))); + ([ Gram.Skeyword "`"; + Gram.srules expr + [ ([ Gram.Skeyword "IN" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) + (_loc : Gram.Loc.t) -> + (Gram.Token.extract_string x : 'e__30)))); + ([ Gram.Skeyword "DEFINE" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) + (_loc : Gram.Loc.t) -> + (Gram.Token.extract_string x : 'e__30)))); + ([ Gram.Skeyword "ENDIF" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) + (_loc : Gram.Loc.t) -> + (Gram.Token.extract_string x : 'e__30)))); + ([ Gram.Skeyword "END" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) + (_loc : Gram.Loc.t) -> + (Gram.Token.extract_string x : 'e__30)))); + ([ Gram.Skeyword "ELSE" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) + (_loc : Gram.Loc.t) -> + (Gram.Token.extract_string x : 'e__30)))); + ([ Gram.Skeyword "THEN" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) + (_loc : Gram.Loc.t) -> + (Gram.Token.extract_string x : 'e__30)))); + ([ Gram.Skeyword "IFNDEF" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) + (_loc : Gram.Loc.t) -> + (Gram.Token.extract_string x : 'e__30)))); + ([ Gram.Skeyword "IFDEF" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) + (_loc : Gram.Loc.t) -> + (Gram.Token.extract_string x : 'e__30)))) ] ], + (Gram.Action.mk + (fun (kwd : 'e__30) _ (_loc : Gram.Loc.t) -> + (Ast.ExVrn (_loc, kwd) : 'expr)))) ]) ])) + ()); + Gram.extend (* idem *) (patt : 'patt Gram.Entry.t) + ((fun () -> + ((Some (Camlp4.Sig.Grammar.Before "simple")), + [ (None, None, + [ ([ Gram.Skeyword "`"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_ident) _ (_loc : Gram.Loc.t) -> + (Ast.PaVrn (_loc, s) : 'patt)))); + ([ Gram.Skeyword "`"; + Gram.srules patt + [ ([ Gram.Skeyword "ENDIF" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) + (_loc : Gram.Loc.t) -> + (Gram.Token.extract_string x : 'e__31)))); + ([ Gram.Skeyword "END" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) + (_loc : Gram.Loc.t) -> + (Gram.Token.extract_string x : 'e__31)))); + ([ Gram.Skeyword "ELSE" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) + (_loc : Gram.Loc.t) -> + (Gram.Token.extract_string x : 'e__31)))); + ([ Gram.Skeyword "THEN" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) + (_loc : Gram.Loc.t) -> + (Gram.Token.extract_string x : 'e__31)))); + ([ Gram.Skeyword "IFNDEF" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) + (_loc : Gram.Loc.t) -> + (Gram.Token.extract_string x : 'e__31)))); + ([ Gram.Skeyword "IFDEF" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) + (_loc : Gram.Loc.t) -> + (Gram.Token.extract_string x : 'e__31)))) ] ], + (Gram.Action.mk + (fun (kwd : 'e__31) _ (_loc : Gram.Loc.t) -> + (Ast.PaVrn (_loc, kwd) : 'patt)))) ]) ])) ())) let _ = @@ -14472,17 +15016,47 @@ open Ast - let remove_nothings = + (* Remove NOTHING and expanse __FILE__ and __LOCATION__ *) + let map_expr = function | Ast.ExApp (_, e, (Ast.ExId (_, (Ast.IdUid (_, "NOTHING"))))) | Ast.ExFun (_, (Ast.McArr (_, (Ast.PaId (_, (Ast.IdUid (_, "NOTHING")))), (Ast.ExNil _), e))) -> e + | Ast.ExId (_loc, (Ast.IdLid (_, "__FILE__"))) -> + Ast.ExStr (_loc, + (Ast.safe_string_escaped (Loc.file_name _loc))) + | Ast.ExId (_loc, (Ast.IdLid (_, "__LOCATION__"))) -> + let (a, b, c, d, e, f, g, h) = Loc.to_tuple _loc + in + Ast.ExApp (_loc, + (Ast.ExId (_loc, + (Ast.IdAcc (_loc, (Ast.IdUid (_loc, "Loc")), + (Ast.IdLid (_loc, "of_tuple")))))), + (Ast.ExTup (_loc, + (Ast.ExCom (_loc, + (Ast.ExStr (_loc, (Ast.safe_string_escaped a))), + (Ast.ExCom (_loc, + (Ast.ExCom (_loc, + (Ast.ExCom (_loc, + (Ast.ExCom (_loc, + (Ast.ExCom (_loc, + (Ast.ExCom (_loc, + (Ast.ExInt (_loc, + (string_of_int b))), + (Ast.ExInt (_loc, + (string_of_int c))))), + (Ast.ExInt (_loc, (string_of_int d))))), + (Ast.ExInt (_loc, (string_of_int e))))), + (Ast.ExInt (_loc, (string_of_int f))))), + (Ast.ExInt (_loc, (string_of_int g))))), + (if h + then Ast.ExId (_loc, (Ast.IdUid (_loc, "True"))) + else Ast.ExId (_loc, (Ast.IdUid (_loc, "False"))))))))))) | e -> e - let _ = - register_str_item_filter (Ast.map_expr remove_nothings)#str_item + let _ = register_str_item_filter (Ast.map_expr map_expr)#str_item end @@ -14497,15 +15071,15 @@ (* -*- camlp4r -*- *) (****************************************************************************) (* *) - (* Objective Caml *) + (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) - (* exception on linking described in LICENSE at the top of the Objective *) - (* Caml source tree. *) + (* exception on linking described in LICENSE at the top of the OCaml *) + (* source tree. *) (* *) (****************************************************************************) (* Authors: @@ -14690,15 +15264,15 @@ (* -*- camlp4r -*- *) (****************************************************************************) (* *) - (* Objective Caml *) + (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2007 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) - (* exception on linking described in LICENSE at the top of the Objective *) - (* Caml source tree. *) + (* exception on linking described in LICENSE at the top of the OCaml *) + (* source tree. *) (* *) (****************************************************************************) (* Authors: @@ -14876,7 +15450,7 @@ Gram.Snterm (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); Gram.Skeyword "]" ]; true) - with | Not_found -> false + with | Struct.Grammar.Delete.Rule_not_found _ -> false let comprehension_or_sem_expr_for_list = Gram.Entry.mk "comprehension_or_sem_expr_for_list" @@ -14989,12 +15563,12 @@ Gram.Skeyword "<-" ], (Gram.Action.mk (fun _ (p : 'patt) (_loc : Gram.Loc.t) - -> (p : 'e__30)))) ]); + -> (p : 'e__32)))) ]); Gram.Snterml ((Gram.Entry.obj (expr : 'expr Gram.Entry.t)), "top") ], (Gram.Action.mk - (fun (e : 'expr) (p : 'e__30) + (fun (e : 'expr) (p : 'e__32) (_loc : Gram.Loc.t) -> (`gen ((p, e)) : 'item)))) ]) ])) ())) @@ -15064,15 +15638,15 @@ struct (****************************************************************************) (* *) - (* Objective Caml *) + (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) - (* exception on linking described in LICENSE at the top of the Objective *) - (* Caml source tree. *) + (* exception on linking described in LICENSE at the top of the OCaml *) + (* source tree. *) (* *) (****************************************************************************) (* Authors: @@ -15087,15 +15661,15 @@ (* camlp4r *) (****************************************************************************) (* *) - (* Objective Caml *) + (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) - (* exception on linking described in LICENSE at the top of the Objective *) - (* Caml source tree. *) + (* exception on linking described in LICENSE at the top of the OCaml *) + (* source tree. *) (* *) (****************************************************************************) (* Authors: @@ -15184,7 +15758,7 @@ | (("Parsers" | ""), ("pa_rp.cmo" | "rp" | "rparser" | "camlp4ocamlrevisedparserparser.cmo")) - -> load [ pa_r; pa_o; pa_rp ] + -> load [ pa_r; pa_rp ] | (("Parsers" | ""), ("pa_op.cmo" | "op" | "parser" | "camlp4ocamlparserparser.cmo")) -> load [ pa_r; pa_o; pa_rp; pa_op ] @@ -15208,7 +15782,7 @@ load [ pa_r; pa_rp; pa_qb; pa_q; pa_g; pa_l; pa_m ] | (("Parsers" | ""), "of") -> load - [ pa_r; pa_o; pa_rp; pa_op; pa_qb; pa_rq; pa_g; pa_l; pa_m ] + [ pa_r; pa_o; pa_rp; pa_op; pa_qb; pa_q; pa_g; pa_l; pa_m ] | (("Parsers" | ""), ("comp" | "camlp4listcomprehension.cmo")) -> load [ pa_l ] | (("Filters" | ""), ("lift" | "camlp4astlifter.cmo")) -> diff -Nru ocaml-3.12.1/camlp4/build/.cvsignore ocaml-4.01.0/camlp4/build/.cvsignore --- ocaml-3.12.1/camlp4/build/.cvsignore 2007-02-09 15:09:56.000000000 +0000 +++ ocaml-4.01.0/camlp4/build/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,7 +0,0 @@ -camlp4_config.ml -linenum.mli -linenum.mll -location.ml -location.mli -terminfo.ml -terminfo.mli diff -Nru ocaml-3.12.1/camlp4/build/.ignore ocaml-4.01.0/camlp4/build/.ignore --- ocaml-3.12.1/camlp4/build/.ignore 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/camlp4/build/.ignore 2012-07-17 15:31:12.000000000 +0000 @@ -0,0 +1,5 @@ +camlp4_config.ml +location.ml +location.mli +terminfo.ml +terminfo.mli diff -Nru ocaml-3.12.1/camlp4/camlp4prof.ml ocaml-4.01.0/camlp4/camlp4prof.ml --- ocaml-3.12.1/camlp4/camlp4prof.ml 2007-02-07 10:09:29.000000000 +0000 +++ ocaml-4.01.0/camlp4/camlp4prof.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2006 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + module Debug = struct value mode _ = False; end; value count = diff -Nru ocaml-3.12.1/camlp4/camlp4prof.mli ocaml-4.01.0/camlp4/camlp4prof.mli --- ocaml-3.12.1/camlp4/camlp4prof.mli 2007-02-07 10:09:29.000000000 +0000 +++ ocaml-4.01.0/camlp4/camlp4prof.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + value count : string -> unit; value load : in_channel -> list (string * int); diff -Nru ocaml-3.12.1/camlp4/examples/_tags ocaml-4.01.0/camlp4/examples/_tags --- ocaml-3.12.1/camlp4/examples/_tags 2008-09-19 12:50:41.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/_tags 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,16 @@ +######################################################################### +# # +# OCaml # +# # +# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# # +# Copyright 2007 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the GNU Library General Public License, with # +# the special exception on linking described in file ../LICENSE. # +# # +######################################################################### + true: warn_A, warn_e <{apply_operator,type_quotation,global_handler,expression_closure{,_filter}}.ml> or : camlp4rf, use_camlp4 "lambda_quot.ml": camlp4rf, use_camlp4_full diff -Nru ocaml-3.12.1/camlp4/examples/apply_operator.ml ocaml-4.01.0/camlp4/examples/apply_operator.ml --- ocaml-3.12.1/camlp4/examples/apply_operator.ml 2007-11-21 17:50:26.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/apply_operator.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + open Camlp4.PreCast; AstFilters.register_str_item_filter (Ast.map_expr diff -Nru ocaml-3.12.1/camlp4/examples/apply_operator_test.ml ocaml-4.01.0/camlp4/examples/apply_operator_test.ml --- ocaml-3.12.1/camlp4/examples/apply_operator_test.ml 2007-11-21 17:50:26.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/apply_operator_test.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + let ( & ) = ();; (* To force it to be inlined. If not it's not well typed. *) fun f g h x -> f& g& h x diff -Nru ocaml-3.12.1/camlp4/examples/arith.ml ocaml-4.01.0/camlp4/examples/arith.ml --- ocaml-3.12.1/camlp4/examples/arith.ml 2007-11-21 17:50:26.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/arith.ml 2012-07-30 18:04:46.000000000 +0000 @@ -1,18 +1,32 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + (* Please keep me in sync with brion.inria.fr/gallium/index.php/Arithmetic_Example *) open Camlp4.PreCast;; module ArithGram = MakeGram(Lexer);; - + type t = Local of string * t * t | Binop of t * (int -> int -> int) * t | Int of int | Var of string;; - + let expression = ArithGram.Entry.mk "expression";; - + EXTEND ArithGram GLOBAL: expression; - + expression: (* A grammar entry for expressions *) [ "top" [ "let"; `LIDENT s; "="; e1 = SELF; "in"; e2 = SELF -> Local(s,e1,e2) ] @@ -27,12 +41,12 @@ | `LIDENT s -> Var(s) | "("; e = expression; ")" -> e ] ]; - + END;; - + let parse_arith s = ArithGram.parse_string expression (Loc.mk "") s;; - + let rec eval env = function | Local(x, e1, e2) -> @@ -42,8 +56,8 @@ op (eval env e1) (eval env e2) | Int(i) -> i | Var(x) -> List.assoc x env;; - + let calc s = Format.printf "%s ==> %d@." s (eval [] (parse_arith s));; - + calc "42 * let x = 21 in x + x";; diff -Nru ocaml-3.12.1/camlp4/examples/debug_extension.ml ocaml-4.01.0/camlp4/examples/debug_extension.ml --- ocaml-3.12.1/camlp4/examples/debug_extension.ml 2007-11-22 18:56:01.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/debug_extension.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + (* * No debugging code at all: * $ camlp4o -parser Camlp4DebugParser debug_extension.ml diff -Nru ocaml-3.12.1/camlp4/examples/ex_str.ml ocaml-4.01.0/camlp4/examples/ex_str.ml --- ocaml-3.12.1/camlp4/examples/ex_str.ml 2007-11-21 18:18:14.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/ex_str.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + open Camlp4.PreCast;; module Caml = Camlp4OCamlParser.Make diff -Nru ocaml-3.12.1/camlp4/examples/ex_str_test.ml ocaml-4.01.0/camlp4/examples/ex_str_test.ml --- ocaml-3.12.1/camlp4/examples/ex_str_test.ml 2007-11-21 18:18:14.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/ex_str_test.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1 +1,15 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + function <> -> <> diff -Nru ocaml-3.12.1/camlp4/examples/expression_closure.ml ocaml-4.01.0/camlp4/examples/expression_closure.ml --- ocaml-3.12.1/camlp4/examples/expression_closure.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/expression_closure.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2006 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + #default_quotation "expr"; open Camlp4.PreCast; diff -Nru ocaml-3.12.1/camlp4/examples/expression_closure_filter.ml ocaml-4.01.0/camlp4/examples/expression_closure_filter.ml --- ocaml-3.12.1/camlp4/examples/expression_closure_filter.ml 2006-07-26 12:07:58.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/expression_closure_filter.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,4 +1,18 @@ (* camlp4r *) +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2006 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + #default_quotation "expr"; open Camlp4.PreCast; diff -Nru ocaml-3.12.1/camlp4/examples/expression_closure_test.ml ocaml-4.01.0/camlp4/examples/expression_closure_test.ml --- ocaml-3.12.1/camlp4/examples/expression_closure_test.ml 2007-11-21 17:50:26.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/expression_closure_test.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + (* x and y are free *) close_expr(x y);; diff -Nru ocaml-3.12.1/camlp4/examples/fancy_lambda_quot.ml ocaml-4.01.0/camlp4/examples/fancy_lambda_quot.ml --- ocaml-3.12.1/camlp4/examples/fancy_lambda_quot.ml 2008-09-19 12:50:41.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/fancy_lambda_quot.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2008 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + (* module LambdaSyntax = struct module Loc = Camlp4.PreCast.Loc type 'a antiquotable = diff -Nru ocaml-3.12.1/camlp4/examples/fancy_lambda_quot_test.ml ocaml-4.01.0/camlp4/examples/fancy_lambda_quot_test.ml --- ocaml-3.12.1/camlp4/examples/fancy_lambda_quot_test.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/fancy_lambda_quot_test.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2008 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + open Fancy_lambda_quot.LambdaSyntax;; let _loc = Camlp4.PreCast.Loc.ghost;; let rec propagate = function diff -Nru ocaml-3.12.1/camlp4/examples/free_vars_test.ml ocaml-4.01.0/camlp4/examples/free_vars_test.ml --- ocaml-3.12.1/camlp4/examples/free_vars_test.ml 2008-10-03 13:06:37.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/free_vars_test.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2006 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + open Format; open Camlp4.PreCast; diff -Nru ocaml-3.12.1/camlp4/examples/gen_match_case.ml ocaml-4.01.0/camlp4/examples/gen_match_case.ml --- ocaml-3.12.1/camlp4/examples/gen_match_case.ml 2007-11-21 17:50:26.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/gen_match_case.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + open Camlp4.PreCast;; let gen patts exprs = diff -Nru ocaml-3.12.1/camlp4/examples/gen_type_N.ml ocaml-4.01.0/camlp4/examples/gen_type_N.ml --- ocaml-3.12.1/camlp4/examples/gen_type_N.ml 2007-11-21 17:50:26.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/gen_type_N.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + open Camlp4.PreCast;; let data_constructor_arguments _loc n t = diff -Nru ocaml-3.12.1/camlp4/examples/gettext_test.ml ocaml-4.01.0/camlp4/examples/gettext_test.ml --- ocaml-3.12.1/camlp4/examples/gettext_test.ml 2008-09-19 12:50:41.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/gettext_test.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1 +1,15 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2008 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + f "test", f "foo", "bar" diff -Nru ocaml-3.12.1/camlp4/examples/global_handler.ml ocaml-4.01.0/camlp4/examples/global_handler.ml --- ocaml-3.12.1/camlp4/examples/global_handler.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/global_handler.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2006 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + open Camlp4.PreCast; value ghost = Loc.ghost; diff -Nru ocaml-3.12.1/camlp4/examples/global_handler_test.ml ocaml-4.01.0/camlp4/examples/global_handler_test.ml --- ocaml-3.12.1/camlp4/examples/global_handler_test.ml 2006-07-26 12:07:58.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/global_handler_test.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2006 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + open Format;; let f1 x = printf "f1 %d@." x;; let f2 x = printf "f2 %f@." x;; diff -Nru ocaml-3.12.1/camlp4/examples/lambda_parser.ml ocaml-4.01.0/camlp4/examples/lambda_parser.ml --- ocaml-3.12.1/camlp4/examples/lambda_parser.ml 2008-09-19 12:50:41.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/lambda_parser.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2008 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + (* Please keep me in sync with brion.inria.fr/gallium/index.php/Lambda_calculus_quotations *) type term = diff -Nru ocaml-3.12.1/camlp4/examples/lambda_quot.ml ocaml-4.01.0/camlp4/examples/lambda_quot.ml --- ocaml-3.12.1/camlp4/examples/lambda_quot.ml 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/lambda_quot.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + open Camlp4.PreCast; module CamlSyntax = Camlp4OCamlParser.Make (Camlp4OCamlRevisedParser.Make Syntax); diff -Nru ocaml-3.12.1/camlp4/examples/lambda_quot_expr.ml ocaml-4.01.0/camlp4/examples/lambda_quot_expr.ml --- ocaml-3.12.1/camlp4/examples/lambda_quot_expr.ml 2008-09-19 12:50:41.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/lambda_quot_expr.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + (* Please keep me in sync with brion.inria.fr/gallium/index.php/Lambda_calculus_quotations *) open Camlp4.PreCast;; diff -Nru ocaml-3.12.1/camlp4/examples/lambda_quot_patt.ml ocaml-4.01.0/camlp4/examples/lambda_quot_patt.ml --- ocaml-3.12.1/camlp4/examples/lambda_quot_patt.ml 2008-09-19 12:50:41.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/lambda_quot_patt.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2008 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + (* Please keep me in sync with brion.inria.fr/gallium/index.php/Lambda_calculus_quotations *) open Camlp4.PreCast;; diff -Nru ocaml-3.12.1/camlp4/examples/lambda_test.ml ocaml-4.01.0/camlp4/examples/lambda_test.ml --- ocaml-3.12.1/camlp4/examples/lambda_test.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/lambda_test.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + let id = << fun x -> x >> (* Imported and traduced from CCT *) let zero = << fun s -> fun z -> z >> diff -Nru ocaml-3.12.1/camlp4/examples/macros.ml ocaml-4.01.0/camlp4/examples/macros.ml --- ocaml-3.12.1/camlp4/examples/macros.ml 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/macros.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + open Camlp4.PreCast;; let foldr_funs = ref [];; let foldl_funs = ref [];; diff -Nru ocaml-3.12.1/camlp4/examples/parse_files.ml ocaml-4.01.0/camlp4/examples/parse_files.ml --- ocaml-3.12.1/camlp4/examples/parse_files.ml 2007-11-21 17:50:26.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/parse_files.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + open Camlp4.PreCast;; module Caml = diff -Nru ocaml-3.12.1/camlp4/examples/syb_fold.ml ocaml-4.01.0/camlp4/examples/syb_fold.ml --- ocaml-3.12.1/camlp4/examples/syb_fold.ml 2007-11-21 17:50:26.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/syb_fold.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + type variable = string and term = | Var of variable diff -Nru ocaml-3.12.1/camlp4/examples/syb_map.ml ocaml-4.01.0/camlp4/examples/syb_map.ml --- ocaml-3.12.1/camlp4/examples/syb_map.ml 2007-11-21 17:50:26.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/syb_map.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + type variable = string and term = | Var of variable diff -Nru ocaml-3.12.1/camlp4/examples/test_macros.ml ocaml-4.01.0/camlp4/examples/test_macros.ml --- ocaml-3.12.1/camlp4/examples/test_macros.ml 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/test_macros.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + (* DEFINE F(x, y, z) = x + y * z;; *) (* F(F(1, 2, 3), 4, 5);; *) diff -Nru ocaml-3.12.1/camlp4/examples/test_type_quotation.ml ocaml-4.01.0/camlp4/examples/test_type_quotation.ml --- ocaml-3.12.1/camlp4/examples/test_type_quotation.ml 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/test_type_quotation.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + type t1 = <:power< 6 | int >> type t2 = <:power< 3 | int -> int >> -> int type t3 = <:power< 3 | int -> <:power< 2 | int >> >> -> int diff -Nru ocaml-3.12.1/camlp4/examples/type_quotation.ml ocaml-4.01.0/camlp4/examples/type_quotation.ml --- ocaml-3.12.1/camlp4/examples/type_quotation.ml 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/examples/type_quotation.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,17 @@ +(****************************************************************************) +(* *) +(* OCaml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) +(* *) +(****************************************************************************) + open Camlp4.PreCast; value rec mk_tuple _loc t n = diff -Nru ocaml-3.12.1/camlp4/man/.cvsignore ocaml-4.01.0/camlp4/man/.cvsignore --- ocaml-3.12.1/camlp4/man/.cvsignore 2001-12-13 13:59:27.000000000 +0000 +++ ocaml-4.01.0/camlp4/man/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -camlp4.1 -camlp4.help diff -Nru ocaml-3.12.1/camlp4/man/.ignore ocaml-4.01.0/camlp4/man/.ignore --- ocaml-3.12.1/camlp4/man/.ignore 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/camlp4/man/.ignore 2012-07-17 15:31:12.000000000 +0000 @@ -0,0 +1,2 @@ +camlp4.1 +camlp4.help diff -Nru ocaml-3.12.1/camlp4/man/Makefile ocaml-4.01.0/camlp4/man/Makefile --- ocaml-3.12.1/camlp4/man/Makefile 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/camlp4/man/Makefile 2012-07-17 15:31:12.000000000 +0000 @@ -1,4 +1,15 @@ - +######################################################################### +# # +# OCaml # +# # +# Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt # +# # +# Copyright 2001 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the GNU Library General Public License, with # +# the special exception on linking described in file ../LICENSE. # +# # +######################################################################### include ../config/Makefile.cnf diff -Nru ocaml-3.12.1/camlp4/man/camlp4.1.tpl ocaml-4.01.0/camlp4/man/camlp4.1.tpl --- ocaml-3.12.1/camlp4/man/camlp4.1.tpl 2004-08-02 08:05:29.000000000 +0000 +++ ocaml-4.01.0/camlp4/man/camlp4.1.tpl 2012-10-15 17:50:56.000000000 +0000 @@ -1,3 +1,16 @@ +.\"*********************************************************************** +.\"* * +.\"* OCaml * +.\"* * +.\"* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt * +.\"* * +.\"* Copyright 2001 Institut National de Recherche en Informatique et * +.\"* en Automatique. All rights reserved. This file is distributed * +.\"* under the terms of the GNU Library General Public License, with * +.\"* the special exception on linking described in file ../LICENSE. * +.\"* * +.\"*********************************************************************** +.\" .TH CAMLP4 1 "" "INRIA" .SH NAME camlp4 - Pre-Precessor-Pretty-Printer for OCaml diff -Nru ocaml-3.12.1/camlp4/mkcamlp4.ml ocaml-4.01.0/camlp4/mkcamlp4.ml --- ocaml-3.12.1/camlp4/mkcamlp4.ml 2010-12-29 13:46:10.000000000 +0000 +++ ocaml-4.01.0/camlp4/mkcamlp4.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,14 +1,14 @@ (****************************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) +(* exception on linking described in LICENSE at the top of the OCaml *) +(* source tree. *) (* *) (****************************************************************************) diff -Nru ocaml-3.12.1/camlp4/test/fixtures/assert.ml ocaml-4.01.0/camlp4/test/fixtures/assert.ml --- ocaml-3.12.1/camlp4/test/fixtures/assert.ml 2008-09-19 12:54:10.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/assert.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -module MySet = Set.Make(String);; -let set = MySet.empty;; -assert (MySet.is_empty set);; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/backquoted_irrefutable_tuple.ml ocaml-4.01.0/camlp4/test/fixtures/backquoted_irrefutable_tuple.ml --- ocaml-3.12.1/camlp4/test/fixtures/backquoted_irrefutable_tuple.ml 2006-09-26 09:03:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/backquoted_irrefutable_tuple.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -EXTEND Gram - abc: [ [ `(x,y) -> x + y ] ]; -END; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/backquoted_record.ml ocaml-4.01.0/camlp4/test/fixtures/backquoted_record.ml --- ocaml-3.12.1/camlp4/test/fixtures/backquoted_record.ml 2006-09-26 09:03:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/backquoted_record.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,4 +0,0 @@ -EXTEND Gram - raw_string: - [[ `QUOTATION { Sig.Quotation.q_contents = c; q_name = n } -> (c, n) ]]; -END; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/backquoted_tuple.ml ocaml-4.01.0/camlp4/test/fixtures/backquoted_tuple.ml --- ocaml-3.12.1/camlp4/test/fixtures/backquoted_tuple.ml 2006-09-26 09:03:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/backquoted_tuple.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -EXTEND Gram - abc: [ [ `(A,y) -> y ] ]; -END; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/big-tab1.ml ocaml-4.01.0/camlp4/test/fixtures/big-tab1.ml --- ocaml-3.12.1/camlp4/test/fixtures/big-tab1.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/big-tab1.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,704 +0,0 @@ -[| -aaa; -aab; -aac; -aad; -aae; -aaf; -aag; -aah; -aai; -aaj; -aak; -aal; -aam; -aan; -aao; -aap; -aaq; -aar; -aas; -aat; -aau; -aav; -aaw; -aax; -aay; -aaz; -aba; -abb; -abc; -abd; -abe; -abf; -abg; -abh; -abi; -abj; -abk; -abl; -abm; -abn; -abo; -abp; -abq; -abr; -abs; -abt; -abu; -abv; -abw; -abx; -aby; -abz; -aca; -acb; -acc; -acd; -ace; -acf; -acg; -ach; -aci; -acj; -ack; -acl; -acm; -acn; -aco; -acp; -acq; -acr; -acs; -act; -acu; -acv; -acw; -acx; -acy; -acz; -ada; -adb; -adc; -add; -ade; -adf; -adg; -adh; -adi; -adj; -adk; -adl; -adm; -adn; -ado; -adp; -adq; -adr; -ads; -adt; -adu; -adv; -adw; -adx; -ady; -adz; -aea; -aeb; -aec; -aed; -aee; -aef; -aeg; -aeh; -aei; -aej; -aek; -ael; -aem; -aen; -aeo; -aep; -aeq; -aer; -aes; -aet; -aeu; -aev; -aew; -aex; -aey; -aez; -afa; -afb; -afc; -afd; -afe; -aff; -afg; -afh; -afi; -afj; -afk; -afl; -afm; -afn; -afo; -afp; -afq; -afr; -afs; -aft; -afu; -afv; -afw; -afx; -afy; -afz; -aga; -agb; -agc; -agd; -age; -agf; -agg; -agh; -agi; -agj; -agk; -agl; -agm; -agn; -ago; -agp; -agq; -agr; -ags; -agt; -agu; -agv; -agw; -agx; -agy; -agz; -aha; -ahb; -ahc; -ahd; -ahe; -ahf; -ahg; -ahh; -ahi; -ahj; -ahk; -ahl; -ahm; -ahn; -aho; -ahp; -ahq; -ahr; -ahs; -aht; -ahu; -ahv; -ahw; -ahx; -ahy; -ahz; -aia; -aib; -aic; -aid; -aie; -aif; -aig; -aih; -aii; -aij; -aik; -ail; -aim; -ain; -aio; -aip; -aiq; -air; -ais; -ait; -aiu; -aiv; -aiw; -aix; -aiy; -aiz; -aja; -ajb; -ajc; -ajd; -aje; -ajf; -ajg; -ajh; -aji; -ajj; -ajk; -ajl; -ajm; -ajn; -ajo; -ajp; -ajq; -ajr; -ajs; -ajt; -aju; -ajv; -ajw; -ajx; -ajy; -ajz; -aka; -akb; -akc; -akd; -ake; -akf; -akg; -akh; -aki; -akj; -akk; -akl; -akm; -akn; -ako; -akp; -akq; -akr; -aks; -akt; -aku; -akv; -akw; -akx; -aky; -akz; -ala; -alb; -alc; -ald; -ale; -alf; -alg; -alh; -ali; -alj; -alk; -all; -alm; -aln; -alo; -alp; -alq; -alr; -als; -alt; -alu; -alv; -alw; -alx; -aly; -alz; -ama; -amb; -amc; -amd; -ame; -amf; -amg; -amh; -ami; -amj; -amk; -aml; -amm; -amn; -amo; -amp; -amq; -amr; -ams; -amt; -amu; -amv; -amw; -amx; -amy; -amz; -ana; -anb; -anc; -ane; -anf; -ang; -anh; -ani; -anj; -ank; -anl; -anm; -ann; -ano; -anp; -anq; -anr; -ans; -ant; -anu; -anv; -anw; -anx; -any; -anz; -aoa; -aob; -aoc; -aod; -aoe; -aof; -aog; -aoh; -aoi; -aoj; -aok; -aol; -aom; -aon; -aoo; -aop; -aoq; -aor; -aos; -aot; -aou; -aov; -aow; -aox; -aoy; -aoz; -apa; -apb; -apc; -apd; -ape; -apf; -apg; -aph; -api; -apj; -apk; -apl; -apm; -apn; -apo; -app; -apq; -apr; -aps; -apt; -apu; -apv; -apw; -apx; -apy; -apz; -aqa; -aqb; -aqc; -aqd; -aqe; -aqf; -aqg; -aqh; -aqi; -aqj; -aqk; -aql; -aqm; -aqn; -aqo; -aqp; -aqq; -aqr; -aqs; -aqt; -aqu; -aqv; -aqw; -aqx; -aqy; -aqz; -ara; -arb; -arc; -ard; -are; -arf; -arg; -arh; -ari; -arj; -ark; -arl; -arm; -arn; -aro; -arp; -arq; -arr; -ars; -art; -aru; -arv; -arw; -arx; -ary; -arz; -asa; -asb; -asc; -asd; -ase; -asf; -asg; -ash; -asi; -asj; -ask; -asl; -asm; -asn; -aso; -asp; -asq; -ass; -ast; -asu; -asv; -asw; -asx; -asy; -asz; -ata; -atb; -atc; -atd; -ate; -atf; -atg; -ath; -ati; -atj; -atk; -atl; -atm; -atn; -ato; -atp; -atq; -atr; -ats; -att; -atu; -atv; -atw; -atx; -aty; -atz; -aua; -aub; -auc; -aud; -aue; -auf; -aug; -auh; -aui; -auj; -auk; -aul; -aum; -aun; -auo; -aup; -auq; -aur; -aus; -aut; -auu; -auv; -auw; -aux; -auy; -auz; -ava; -avb; -avc; -avd; -ave; -avf; -avg; -avh; -avi; -avj; -avk; -avl; -avm; -avn; -avo; -avp; -avq; -avr; -avs; -avt; -avu; -avv; -avw; -avx; -avy; -avz; -awa; -awb; -awc; -awd; -awe; -awf; -awg; -awh; -awi; -awj; -awk; -awl; -awm; -awn; -awo; -awp; -awq; -awr; -aws; -awt; -awu; -awv; -aww; -awx; -awy; -awz; -axa; -axb; -axc; -axd; -axe; -axf; -axg; -axh; -axi; -axj; -axk; -axl; -axm; -axn; -axo; -axp; -axq; -axr; -axs; -axt; -axu; -axv; -axw; -axx; -axy; -axz; -aya; -ayb; -ayc; -ayd; -aye; -ayf; -ayg; -ayh; -ayi; -ayj; -ayk; -ayl; -aym; -ayn; -ayo; -ayp; -ayq; -ayr; -ays; -ayt; -ayu; -ayv; -ayw; -ayx; -ayy; -ayz; -aza; -azb; -azc; -azd; -aze; -azf; -azg; -azh; -azi; -azj; -azk; -azl; -azm; -azn; -azo; -azp; -azq; -azr; -azs; -azt; -azu; -azv; -azw; -azx; -azy; -azz; -baa; -bab; -bac; -bad; -bae; -baf; -bag; -bah; -bai; -baj; -bak; -bal; -bam; -ban; -bao; -bap; -baq; -bar; -bas; -bat; -bau; -bav; -baw; -bax; -bay; -baz; -bba; -bbb -|]; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/big-tab2.ml ocaml-4.01.0/camlp4/test/fixtures/big-tab2.ml --- ocaml-3.12.1/camlp4/test/fixtures/big-tab2.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/big-tab2.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,18282 +0,0 @@ -[| -aaaa; -aaab; -aaac; -aaad; -aaae; -aaaf; -aaag; -aaah; -aaai; -aaaj; -aaak; -aaal; -aaam; -aaan; -aaao; -aaap; -aaaq; -aaar; -aaas; -aaat; -aaau; -aaav; -aaaw; -aaax; -aaay; -aaaz; -aaba; -aabb; -aabc; -aabd; -aabe; -aabf; -aabg; -aabh; -aabi; -aabj; -aabk; -aabl; -aabm; -aabn; -aabo; -aabp; -aabq; -aabr; -aabs; -aabt; -aabu; -aabv; -aabw; -aabx; -aaby; -aabz; -aaca; -aacb; -aacc; -aacd; -aace; -aacf; -aacg; -aach; -aaci; -aacj; -aack; -aacl; -aacm; -aacn; -aaco; -aacp; -aacq; -aacr; -aacs; -aact; -aacu; -aacv; -aacw; -aacx; -aacy; -aacz; -aada; -aadb; -aadc; -aadd; -aade; -aadf; -aadg; -aadh; -aadi; -aadj; -aadk; -aadl; -aadm; -aadn; -aado; -aadp; -aadq; -aadr; -aads; -aadt; -aadu; -aadv; -aadw; -aadx; -aady; -aadz; -aaea; -aaeb; -aaec; -aaed; -aaee; -aaef; -aaeg; -aaeh; -aaei; -aaej; -aaek; -aael; -aaem; -aaen; -aaeo; -aaep; -aaeq; -aaer; -aaes; -aaet; -aaeu; -aaev; -aaew; -aaex; -aaey; -aaez; -aafa; -aafb; -aafc; -aafd; -aafe; -aaff; -aafg; -aafh; -aafi; -aafj; -aafk; -aafl; -aafm; -aafn; -aafo; -aafp; -aafq; -aafr; -aafs; -aaft; -aafu; -aafv; -aafw; -aafx; -aafy; -aafz; -aaga; -aagb; -aagc; -aagd; -aage; -aagf; -aagg; -aagh; -aagi; -aagj; -aagk; -aagl; -aagm; -aagn; -aago; -aagp; -aagq; -aagr; -aags; -aagt; -aagu; -aagv; -aagw; -aagx; -aagy; -aagz; -aaha; -aahb; -aahc; -aahd; -aahe; -aahf; -aahg; -aahh; -aahi; -aahj; -aahk; -aahl; -aahm; -aahn; -aaho; -aahp; -aahq; -aahr; -aahs; -aaht; -aahu; -aahv; -aahw; -aahx; -aahy; -aahz; -aaia; -aaib; -aaic; -aaid; -aaie; -aaif; -aaig; -aaih; -aaii; -aaij; -aaik; -aail; -aaim; -aain; -aaio; -aaip; -aaiq; -aair; -aais; -aait; -aaiu; -aaiv; -aaiw; -aaix; -aaiy; -aaiz; -aaja; -aajb; -aajc; -aajd; -aaje; -aajf; -aajg; -aajh; -aaji; -aajj; -aajk; -aajl; -aajm; -aajn; -aajo; -aajp; -aajq; -aajr; -aajs; -aajt; -aaju; -aajv; -aajw; -aajx; -aajy; -aajz; -aaka; -aakb; -aakc; -aakd; -aake; -aakf; -aakg; -aakh; -aaki; -aakj; -aakk; -aakl; -aakm; -aakn; -aako; -aakp; -aakq; -aakr; -aaks; -aakt; -aaku; -aakv; -aakw; -aakx; -aaky; -aakz; -aala; -aalb; -aalc; -aald; -aale; -aalf; -aalg; -aalh; -aali; -aalj; -aalk; -aall; -aalm; -aaln; -aalo; -aalp; -aalq; -aalr; -aals; -aalt; -aalu; -aalv; -aalw; -aalx; -aaly; -aalz; -aama; -aamb; -aamc; -aamd; -aame; -aamf; -aamg; -aamh; -aami; -aamj; -aamk; -aaml; -aamm; -aamn; -aamo; -aamp; -aamq; -aamr; -aams; -aamt; -aamu; -aamv; -aamw; -aamx; -aamy; -aamz; -aana; -aanb; -aanc; -aand; -aane; -aanf; -aang; -aanh; -aani; -aanj; -aank; -aanl; -aanm; -aann; -aano; -aanp; -aanq; -aanr; -aans; -aant; -aanu; -aanv; -aanw; -aanx; -aany; -aanz; -aaoa; -aaob; -aaoc; -aaod; -aaoe; -aaof; -aaog; -aaoh; -aaoi; -aaoj; -aaok; -aaol; -aaom; -aaon; -aaoo; -aaop; -aaoq; -aaor; -aaos; -aaot; -aaou; -aaov; -aaow; -aaox; -aaoy; -aaoz; -aapa; -aapb; -aapc; -aapd; -aape; -aapf; -aapg; -aaph; -aapi; -aapj; -aapk; -aapl; -aapm; -aapn; -aapo; -aapp; -aapq; -aapr; -aaps; -aapt; -aapu; -aapv; -aapw; -aapx; -aapy; -aapz; -aaqa; -aaqb; -aaqc; -aaqd; -aaqe; -aaqf; -aaqg; -aaqh; -aaqi; -aaqj; -aaqk; -aaql; -aaqm; -aaqn; -aaqo; -aaqp; -aaqq; -aaqr; -aaqs; -aaqt; -aaqu; -aaqv; -aaqw; -aaqx; -aaqy; -aaqz; -aara; -aarb; -aarc; -aard; -aare; -aarf; -aarg; -aarh; -aari; -aarj; -aark; -aarl; -aarm; -aarn; -aaro; -aarp; -aarq; -aarr; -aars; -aart; -aaru; -aarv; -aarw; -aarx; -aary; -aarz; -aasa; -aasb; -aasc; -aasd; -aase; -aasf; -aasg; -aash; -aasi; -aasj; -aask; -aasl; -aasm; -aasn; -aaso; -aasp; -aasq; -aasr; -aass; -aast; -aasu; -aasv; -aasw; -aasx; -aasy; -aasz; -aata; -aatb; -aatc; -aatd; -aate; -aatf; -aatg; -aath; -aati; -aatj; -aatk; -aatl; -aatm; -aatn; -aato; -aatp; -aatq; -aatr; -aats; -aatt; -aatu; -aatv; -aatw; -aatx; -aaty; -aatz; -aaua; -aaub; -aauc; -aaud; -aaue; -aauf; -aaug; -aauh; -aaui; -aauj; -aauk; -aaul; -aaum; -aaun; -aauo; -aaup; -aauq; -aaur; -aaus; -aaut; -aauu; -aauv; -aauw; -aaux; -aauy; -aauz; -aava; -aavb; -aavc; -aavd; -aave; -aavf; -aavg; -aavh; -aavi; -aavj; -aavk; -aavl; -aavm; -aavn; -aavo; -aavp; -aavq; -aavr; -aavs; -aavt; -aavu; -aavv; -aavw; -aavx; -aavy; -aavz; -aawa; -aawb; -aawc; -aawd; -aawe; -aawf; -aawg; -aawh; -aawi; -aawj; -aawk; -aawl; -aawm; -aawn; -aawo; -aawp; -aawq; -aawr; -aaws; -aawt; -aawu; -aawv; -aaww; -aawx; -aawy; -aawz; -aaxa; -aaxb; -aaxc; -aaxd; -aaxe; -aaxf; -aaxg; -aaxh; -aaxi; -aaxj; -aaxk; -aaxl; -aaxm; -aaxn; -aaxo; -aaxp; -aaxq; -aaxr; -aaxs; -aaxt; -aaxu; -aaxv; -aaxw; -aaxx; -aaxy; -aaxz; -aaya; -aayb; -aayc; -aayd; -aaye; -aayf; -aayg; -aayh; -aayi; -aayj; -aayk; -aayl; -aaym; -aayn; -aayo; -aayp; -aayq; -aayr; -aays; -aayt; -aayu; -aayv; -aayw; -aayx; -aayy; -aayz; -aaza; -aazb; -aazc; -aazd; -aaze; -aazf; -aazg; -aazh; -aazi; -aazj; -aazk; -aazl; -aazm; -aazn; -aazo; -aazp; -aazq; -aazr; -aazs; -aazt; -aazu; -aazv; -aazw; -aazx; -aazy; -aazz; -abaa; -abab; -abac; -abad; -abae; -abaf; -abag; -abah; -abai; -abaj; -abak; -abal; -abam; -aban; -abao; -abap; -abaq; -abar; -abas; -abat; -abau; -abav; -abaw; -abax; -abay; -abaz; -abba; -abbb; -abbc; -abbd; -abbe; -abbf; -abbg; -abbh; -abbi; -abbj; -abbk; -abbl; -abbm; -abbn; -abbo; -abbp; -abbq; -abbr; -abbs; -abbt; -abbu; -abbv; -abbw; -abbx; -abby; -abbz; -abca; -abcb; -abcc; -abcd; -abce; -abcf; -abcg; -abch; -abci; -abcj; -abck; -abcl; -abcm; -abcn; -abco; -abcp; -abcq; -abcr; -abcs; -abct; -abcu; -abcv; -abcw; -abcx; -abcy; -abcz; -abda; -abdb; -abdc; -abdd; -abde; -abdf; -abdg; -abdh; -abdi; -abdj; -abdk; -abdl; -abdm; -abdn; -abdo; -abdp; -abdq; -abdr; -abds; -abdt; -abdu; -abdv; -abdw; -abdx; -abdy; -abdz; -abea; -abeb; -abec; -abed; -abee; -abef; -abeg; -abeh; -abei; -abej; -abek; -abel; -abem; -aben; -abeo; -abep; -abeq; -aber; -abes; -abet; -abeu; -abev; -abew; -abex; -abey; -abez; -abfa; -abfb; -abfc; -abfd; -abfe; -abff; -abfg; -abfh; -abfi; -abfj; -abfk; -abfl; -abfm; -abfn; -abfo; -abfp; -abfq; -abfr; -abfs; -abft; -abfu; -abfv; -abfw; -abfx; -abfy; -abfz; -abga; -abgb; -abgc; -abgd; -abge; -abgf; -abgg; -abgh; -abgi; -abgj; -abgk; -abgl; -abgm; -abgn; -abgo; -abgp; -abgq; -abgr; -abgs; -abgt; -abgu; -abgv; -abgw; -abgx; -abgy; -abgz; -abha; -abhb; -abhc; -abhd; -abhe; -abhf; -abhg; -abhh; -abhi; -abhj; -abhk; -abhl; -abhm; -abhn; -abho; -abhp; -abhq; -abhr; -abhs; -abht; -abhu; -abhv; -abhw; -abhx; -abhy; -abhz; -abia; -abib; -abic; -abid; -abie; -abif; -abig; -abih; -abii; -abij; -abik; -abil; -abim; -abin; -abio; -abip; -abiq; -abir; -abis; -abit; -abiu; -abiv; -abiw; -abix; -abiy; -abiz; -abja; -abjb; -abjc; -abjd; -abje; -abjf; -abjg; -abjh; -abji; -abjj; -abjk; -abjl; -abjm; -abjn; -abjo; -abjp; -abjq; -abjr; -abjs; -abjt; -abju; -abjv; -abjw; -abjx; -abjy; -abjz; -abka; -abkb; -abkc; -abkd; -abke; -abkf; -abkg; -abkh; -abki; -abkj; -abkk; -abkl; -abkm; -abkn; -abko; -abkp; -abkq; -abkr; -abks; -abkt; -abku; -abkv; -abkw; -abkx; -abky; -abkz; -abla; -ablb; -ablc; -abld; -able; -ablf; -ablg; -ablh; -abli; -ablj; -ablk; -abll; -ablm; -abln; -ablo; -ablp; -ablq; -ablr; -abls; -ablt; -ablu; -ablv; -ablw; -ablx; -ably; -ablz; -abma; -abmb; -abmc; -abmd; -abme; -abmf; -abmg; -abmh; -abmi; -abmj; -abmk; -abml; -abmm; -abmn; -abmo; -abmp; -abmq; -abmr; -abms; -abmt; -abmu; -abmv; -abmw; -abmx; -abmy; -abmz; -abna; -abnb; -abnc; -abnd; -abne; -abnf; -abng; -abnh; -abni; -abnj; -abnk; -abnl; -abnm; -abnn; -abno; -abnp; -abnq; -abnr; -abns; -abnt; -abnu; -abnv; -abnw; -abnx; -abny; -abnz; -aboa; -abob; -aboc; -abod; -aboe; -abof; -abog; -aboh; -aboi; -aboj; -abok; -abol; -abom; -abon; -aboo; -abop; -aboq; -abor; -abos; -abot; -abou; -abov; -abow; -abox; -aboy; -aboz; -abpa; -abpb; -abpc; -abpd; -abpe; -abpf; -abpg; -abph; -abpi; -abpj; -abpk; -abpl; -abpm; -abpn; -abpo; -abpp; -abpq; -abpr; -abps; -abpt; -abpu; -abpv; -abpw; -abpx; -abpy; -abpz; -abqa; -abqb; -abqc; -abqd; -abqe; -abqf; -abqg; -abqh; -abqi; -abqj; -abqk; -abql; -abqm; -abqn; -abqo; -abqp; -abqq; -abqr; -abqs; -abqt; -abqu; -abqv; -abqw; -abqx; -abqy; -abqz; -abra; -abrb; -abrc; -abrd; -abre; -abrf; -abrg; -abrh; -abri; -abrj; -abrk; -abrl; -abrm; -abrn; -abro; -abrp; -abrq; -abrr; -abrs; -abrt; -abru; -abrv; -abrw; -abrx; -abry; -abrz; -absa; -absb; -absc; -absd; -abse; -absf; -absg; -absh; -absi; -absj; -absk; -absl; -absm; -absn; -abso; -absp; -absq; -absr; -abss; -abst; -absu; -absv; -absw; -absx; -absy; -absz; -abta; -abtb; -abtc; -abtd; -abte; -abtf; -abtg; -abth; -abti; -abtj; -abtk; -abtl; -abtm; -abtn; -abto; -abtp; -abtq; -abtr; -abts; -abtt; -abtu; -abtv; -abtw; -abtx; -abty; -abtz; -abua; -abub; -abuc; -abud; -abue; -abuf; -abug; -abuh; -abui; -abuj; -abuk; -abul; -abum; -abun; -abuo; -abup; -abuq; -abur; -abus; -abut; -abuu; -abuv; -abuw; -abux; -abuy; -abuz; -abva; -abvb; -abvc; -abvd; -abve; -abvf; -abvg; -abvh; -abvi; -abvj; -abvk; -abvl; -abvm; -abvn; -abvo; -abvp; -abvq; -abvr; -abvs; -abvt; -abvu; -abvv; -abvw; -abvx; -abvy; -abvz; -abwa; -abwb; -abwc; -abwd; -abwe; -abwf; -abwg; -abwh; -abwi; -abwj; -abwk; -abwl; -abwm; -abwn; -abwo; -abwp; -abwq; -abwr; -abws; -abwt; -abwu; -abwv; -abww; -abwx; -abwy; -abwz; -abxa; -abxb; -abxc; -abxd; -abxe; -abxf; -abxg; -abxh; -abxi; -abxj; -abxk; -abxl; -abxm; -abxn; -abxo; -abxp; -abxq; -abxr; -abxs; -abxt; -abxu; -abxv; -abxw; -abxx; -abxy; -abxz; -abya; -abyb; -abyc; -abyd; -abye; -abyf; -abyg; -abyh; -abyi; -abyj; -abyk; -abyl; -abym; -abyn; -abyo; -abyp; -abyq; -abyr; -abys; -abyt; -abyu; -abyv; -abyw; -abyx; -abyy; -abyz; -abza; -abzb; -abzc; -abzd; -abze; -abzf; -abzg; -abzh; -abzi; -abzj; -abzk; -abzl; -abzm; -abzn; -abzo; -abzp; -abzq; -abzr; -abzs; -abzt; -abzu; -abzv; -abzw; -abzx; -abzy; -abzz; -acaa; -acab; -acac; -acad; -acae; -acaf; -acag; -acah; -acai; -acaj; -acak; -acal; -acam; -acan; -acao; -acap; -acaq; -acar; -acas; -acat; -acau; -acav; -acaw; -acax; -acay; -acaz; -acba; -acbb; -acbc; -acbd; -acbe; -acbf; -acbg; -acbh; -acbi; -acbj; -acbk; -acbl; -acbm; -acbn; -acbo; -acbp; -acbq; -acbr; -acbs; -acbt; -acbu; -acbv; -acbw; -acbx; -acby; -acbz; -acca; -accb; -accc; -accd; -acce; -accf; -accg; -acch; -acci; -accj; -acck; -accl; -accm; -accn; -acco; -accp; -accq; -accr; -accs; -acct; -accu; -accv; -accw; -accx; -accy; -accz; -acda; -acdb; -acdc; -acdd; -acde; -acdf; -acdg; -acdh; -acdi; -acdj; -acdk; -acdl; -acdm; -acdn; -acdo; -acdp; -acdq; -acdr; -acds; -acdt; -acdu; -acdv; -acdw; -acdx; -acdy; -acdz; -acea; -aceb; -acec; -aced; -acee; -acef; -aceg; -aceh; -acei; -acej; -acek; -acel; -acem; -acen; -aceo; -acep; -aceq; -acer; -aces; -acet; -aceu; -acev; -acew; -acex; -acey; -acez; -acfa; -acfb; -acfc; -acfd; -acfe; -acff; -acfg; -acfh; -acfi; -acfj; -acfk; -acfl; -acfm; -acfn; -acfo; -acfp; -acfq; -acfr; -acfs; -acft; -acfu; -acfv; -acfw; -acfx; -acfy; -acfz; -acga; -acgb; -acgc; -acgd; -acge; -acgf; -acgg; -acgh; -acgi; -acgj; -acgk; -acgl; -acgm; -acgn; -acgo; -acgp; -acgq; -acgr; -acgs; -acgt; -acgu; -acgv; -acgw; -acgx; -acgy; -acgz; -acha; -achb; -achc; -achd; -ache; -achf; -achg; -achh; -achi; -achj; -achk; -achl; -achm; -achn; -acho; -achp; -achq; -achr; -achs; -acht; -achu; -achv; -achw; -achx; -achy; -achz; -acia; -acib; -acic; -acid; -acie; -acif; -acig; -acih; -acii; -acij; -acik; -acil; -acim; -acin; -acio; -acip; -aciq; -acir; -acis; -acit; -aciu; -aciv; -aciw; -acix; -aciy; -aciz; -acja; -acjb; -acjc; -acjd; -acje; -acjf; -acjg; -acjh; -acji; -acjj; -acjk; -acjl; -acjm; -acjn; -acjo; -acjp; -acjq; -acjr; -acjs; -acjt; -acju; -acjv; -acjw; -acjx; -acjy; -acjz; -acka; -ackb; -ackc; -ackd; -acke; -ackf; -ackg; -ackh; -acki; -ackj; -ackk; -ackl; -ackm; -ackn; -acko; -ackp; -ackq; -ackr; -acks; -ackt; -acku; -ackv; -ackw; -ackx; -acky; -ackz; -acla; -aclb; -aclc; -acld; -acle; -aclf; -aclg; -aclh; -acli; -aclj; -aclk; -acll; -aclm; -acln; -aclo; -aclp; -aclq; -aclr; -acls; -aclt; -aclu; -aclv; -aclw; -aclx; -acly; -aclz; -acma; -acmb; -acmc; -acmd; -acme; -acmf; -acmg; -acmh; -acmi; -acmj; -acmk; -acml; -acmm; -acmn; -acmo; -acmp; -acmq; -acmr; -acms; -acmt; -acmu; -acmv; -acmw; -acmx; -acmy; -acmz; -acna; -acnb; -acnc; -acnd; -acne; -acnf; -acng; -acnh; -acni; -acnj; -acnk; -acnl; -acnm; -acnn; -acno; -acnp; -acnq; -acnr; -acns; -acnt; -acnu; -acnv; -acnw; -acnx; -acny; -acnz; -acoa; -acob; -acoc; -acod; -acoe; -acof; -acog; -acoh; -acoi; -acoj; -acok; -acol; -acom; -acon; -acoo; -acop; -acoq; -acor; -acos; -acot; -acou; -acov; -acow; -acox; -acoy; -acoz; -acpa; -acpb; -acpc; -acpd; -acpe; -acpf; -acpg; -acph; -acpi; -acpj; -acpk; -acpl; -acpm; -acpn; -acpo; -acpp; -acpq; -acpr; -acps; -acpt; -acpu; -acpv; -acpw; -acpx; -acpy; -acpz; -acqa; -acqb; -acqc; -acqd; -acqe; -acqf; -acqg; -acqh; -acqi; -acqj; -acqk; -acql; -acqm; -acqn; -acqo; -acqp; -acqq; -acqr; -acqs; -acqt; -acqu; -acqv; -acqw; -acqx; -acqy; -acqz; -acra; -acrb; -acrc; -acrd; -acre; -acrf; -acrg; -acrh; -acri; -acrj; -acrk; -acrl; -acrm; -acrn; -acro; -acrp; -acrq; -acrr; -acrs; -acrt; -acru; -acrv; -acrw; -acrx; -acry; -acrz; -acsa; -acsb; -acsc; -acsd; -acse; -acsf; -acsg; -acsh; -acsi; -acsj; -acsk; -acsl; -acsm; -acsn; -acso; -acsp; -acsq; -acsr; -acss; -acst; -acsu; -acsv; -acsw; -acsx; -acsy; -acsz; -acta; -actb; -actc; -actd; -acte; -actf; -actg; -acth; -acti; -actj; -actk; -actl; -actm; -actn; -acto; -actp; -actq; -actr; -acts; -actt; -actu; -actv; -actw; -actx; -acty; -actz; -acua; -acub; -acuc; -acud; -acue; -acuf; -acug; -acuh; -acui; -acuj; -acuk; -acul; -acum; -acun; -acuo; -acup; -acuq; -acur; -acus; -acut; -acuu; -acuv; -acuw; -acux; -acuy; -acuz; -acva; -acvb; -acvc; -acvd; -acve; -acvf; -acvg; -acvh; -acvi; -acvj; -acvk; -acvl; -acvm; -acvn; -acvo; -acvp; -acvq; -acvr; -acvs; -acvt; -acvu; -acvv; -acvw; -acvx; -acvy; -acvz; -acwa; -acwb; -acwc; -acwd; -acwe; -acwf; -acwg; -acwh; -acwi; -acwj; -acwk; -acwl; -acwm; -acwn; -acwo; -acwp; -acwq; -acwr; -acws; -acwt; -acwu; -acwv; -acww; -acwx; -acwy; -acwz; -acxa; -acxb; -acxc; -acxd; -acxe; -acxf; -acxg; -acxh; -acxi; -acxj; -acxk; -acxl; -acxm; -acxn; -acxo; -acxp; -acxq; -acxr; -acxs; -acxt; -acxu; -acxv; -acxw; -acxx; -acxy; -acxz; -acya; -acyb; -acyc; -acyd; -acye; -acyf; -acyg; -acyh; -acyi; -acyj; -acyk; -acyl; -acym; -acyn; -acyo; -acyp; -acyq; -acyr; -acys; -acyt; -acyu; -acyv; -acyw; -acyx; -acyy; -acyz; -acza; -aczb; -aczc; -aczd; -acze; -aczf; -aczg; -aczh; -aczi; -aczj; -aczk; -aczl; -aczm; -aczn; -aczo; -aczp; -aczq; -aczr; -aczs; -aczt; -aczu; -aczv; -aczw; -aczx; -aczy; -aczz; -adaa; -adab; -adac; -adad; -adae; -adaf; -adag; -adah; -adai; -adaj; -adak; -adal; -adam; -adan; -adao; -adap; -adaq; -adar; -adas; -adat; -adau; -adav; -adaw; -adax; -aday; -adaz; -adba; -adbb; -adbc; -adbd; -adbe; -adbf; -adbg; -adbh; -adbi; -adbj; -adbk; -adbl; -adbm; -adbn; -adbo; -adbp; -adbq; -adbr; -adbs; -adbt; -adbu; -adbv; -adbw; -adbx; -adby; -adbz; -adca; -adcb; -adcc; -adcd; -adce; -adcf; -adcg; -adch; -adci; -adcj; -adck; -adcl; -adcm; -adcn; -adco; -adcp; -adcq; -adcr; -adcs; -adct; -adcu; -adcv; -adcw; -adcx; -adcy; -adcz; -adda; -addb; -addc; -addd; -adde; -addf; -addg; -addh; -addi; -addj; -addk; -addl; -addm; -addn; -addo; -addp; -addq; -addr; -adds; -addt; -addu; -addv; -addw; -addx; -addy; -addz; -adea; -adeb; -adec; -aded; -adee; -adef; -adeg; -adeh; -adei; -adej; -adek; -adel; -adem; -aden; -adeo; -adep; -adeq; -ader; -ades; -adet; -adeu; -adev; -adew; -adex; -adey; -adez; -adfa; -adfb; -adfc; -adfd; -adfe; -adff; -adfg; -adfh; -adfi; -adfj; -adfk; -adfl; -adfm; -adfn; -adfo; -adfp; -adfq; -adfr; -adfs; -adft; -adfu; -adfv; -adfw; -adfx; -adfy; -adfz; -adga; -adgb; -adgc; -adgd; -adge; -adgf; -adgg; -adgh; -adgi; -adgj; -adgk; -adgl; -adgm; -adgn; -adgo; -adgp; -adgq; -adgr; -adgs; -adgt; -adgu; -adgv; -adgw; -adgx; -adgy; -adgz; -adha; -adhb; -adhc; -adhd; -adhe; -adhf; -adhg; -adhh; -adhi; -adhj; -adhk; -adhl; -adhm; -adhn; -adho; -adhp; -adhq; -adhr; -adhs; -adht; -adhu; -adhv; -adhw; -adhx; -adhy; -adhz; -adia; -adib; -adic; -adid; -adie; -adif; -adig; -adih; -adii; -adij; -adik; -adil; -adim; -adin; -adio; -adip; -adiq; -adir; -adis; -adit; -adiu; -adiv; -adiw; -adix; -adiy; -adiz; -adja; -adjb; -adjc; -adjd; -adje; -adjf; -adjg; -adjh; -adji; -adjj; -adjk; -adjl; -adjm; -adjn; -adjo; -adjp; -adjq; -adjr; -adjs; -adjt; -adju; -adjv; -adjw; -adjx; -adjy; -adjz; -adka; -adkb; -adkc; -adkd; -adke; -adkf; -adkg; -adkh; -adki; -adkj; -adkk; -adkl; -adkm; -adkn; -adko; -adkp; -adkq; -adkr; -adks; -adkt; -adku; -adkv; -adkw; -adkx; -adky; -adkz; -adla; -adlb; -adlc; -adld; -adle; -adlf; -adlg; -adlh; -adli; -adlj; -adlk; -adll; -adlm; -adln; -adlo; -adlp; -adlq; -adlr; -adls; -adlt; -adlu; -adlv; -adlw; -adlx; -adly; -adlz; -adma; -admb; -admc; -admd; -adme; -admf; -admg; -admh; -admi; -admj; -admk; -adml; -admm; -admn; -admo; -admp; -admq; -admr; -adms; -admt; -admu; -admv; -admw; -admx; -admy; -admz; -adna; -adnb; -adnc; -adnd; -adne; -adnf; -adng; -adnh; -adni; -adnj; -adnk; -adnl; -adnm; -adnn; -adno; -adnp; -adnq; -adnr; -adns; -adnt; -adnu; -adnv; -adnw; -adnx; -adny; -adnz; -adoa; -adob; -adoc; -adod; -adoe; -adof; -adog; -adoh; -adoi; -adoj; -adok; -adol; -adom; -adon; -adoo; -adop; -adoq; -ador; -ados; -adot; -adou; -adov; -adow; -adox; -adoy; -adoz; -adpa; -adpb; -adpc; -adpd; -adpe; -adpf; -adpg; -adph; -adpi; -adpj; -adpk; -adpl; -adpm; -adpn; -adpo; -adpp; -adpq; -adpr; -adps; -adpt; -adpu; -adpv; -adpw; -adpx; -adpy; -adpz; -adqa; -adqb; -adqc; -adqd; -adqe; -adqf; -adqg; -adqh; -adqi; -adqj; -adqk; -adql; -adqm; -adqn; -adqo; -adqp; -adqq; -adqr; -adqs; -adqt; -adqu; -adqv; -adqw; -adqx; -adqy; -adqz; -adra; -adrb; -adrc; -adrd; -adre; -adrf; -adrg; -adrh; -adri; -adrj; -adrk; -adrl; -adrm; -adrn; -adro; -adrp; -adrq; -adrr; -adrs; -adrt; -adru; -adrv; -adrw; -adrx; -adry; -adrz; -adsa; -adsb; -adsc; -adsd; -adse; -adsf; -adsg; -adsh; -adsi; -adsj; -adsk; -adsl; -adsm; -adsn; -adso; -adsp; -adsq; -adsr; -adss; -adst; -adsu; -adsv; -adsw; -adsx; -adsy; -adsz; -adta; -adtb; -adtc; -adtd; -adte; -adtf; -adtg; -adth; -adti; -adtj; -adtk; -adtl; -adtm; -adtn; -adto; -adtp; -adtq; -adtr; -adts; -adtt; -adtu; -adtv; -adtw; -adtx; -adty; -adtz; -adua; -adub; -aduc; -adud; -adue; -aduf; -adug; -aduh; -adui; -aduj; -aduk; -adul; -adum; -adun; -aduo; -adup; -aduq; -adur; -adus; -adut; -aduu; -aduv; -aduw; -adux; -aduy; -aduz; -adva; -advb; -advc; -advd; -adve; -advf; -advg; -advh; -advi; -advj; -advk; -advl; -advm; -advn; -advo; -advp; -advq; -advr; -advs; -advt; -advu; -advv; -advw; -advx; -advy; -advz; -adwa; -adwb; -adwc; -adwd; -adwe; -adwf; -adwg; -adwh; -adwi; -adwj; -adwk; -adwl; -adwm; -adwn; -adwo; -adwp; -adwq; -adwr; -adws; -adwt; -adwu; -adwv; -adww; -adwx; -adwy; -adwz; -adxa; -adxb; -adxc; -adxd; -adxe; -adxf; -adxg; -adxh; -adxi; -adxj; -adxk; -adxl; -adxm; -adxn; -adxo; -adxp; -adxq; -adxr; -adxs; -adxt; -adxu; -adxv; -adxw; -adxx; -adxy; -adxz; -adya; -adyb; -adyc; -adyd; -adye; -adyf; -adyg; -adyh; -adyi; -adyj; -adyk; -adyl; -adym; -adyn; -adyo; -adyp; -adyq; -adyr; -adys; -adyt; -adyu; -adyv; -adyw; -adyx; -adyy; -adyz; -adza; -adzb; -adzc; -adzd; -adze; -adzf; -adzg; -adzh; -adzi; -adzj; -adzk; -adzl; -adzm; -adzn; -adzo; -adzp; -adzq; -adzr; -adzs; -adzt; -adzu; -adzv; -adzw; -adzx; -adzy; -adzz; -aeaa; -aeab; -aeac; -aead; -aeae; -aeaf; -aeag; -aeah; -aeai; -aeaj; -aeak; -aeal; -aeam; -aean; -aeao; -aeap; -aeaq; -aear; -aeas; -aeat; -aeau; -aeav; -aeaw; -aeax; -aeay; -aeaz; -aeba; -aebb; -aebc; -aebd; -aebe; -aebf; -aebg; -aebh; -aebi; -aebj; -aebk; -aebl; -aebm; -aebn; -aebo; -aebp; -aebq; -aebr; -aebs; -aebt; -aebu; -aebv; -aebw; -aebx; -aeby; -aebz; -aeca; -aecb; -aecc; -aecd; -aece; -aecf; -aecg; -aech; -aeci; -aecj; -aeck; -aecl; -aecm; -aecn; -aeco; -aecp; -aecq; -aecr; -aecs; -aect; -aecu; -aecv; -aecw; -aecx; -aecy; -aecz; -aeda; -aedb; -aedc; -aedd; -aede; -aedf; -aedg; -aedh; -aedi; -aedj; -aedk; -aedl; -aedm; -aedn; -aedo; -aedp; -aedq; -aedr; -aeds; -aedt; -aedu; -aedv; -aedw; -aedx; -aedy; -aedz; -aeea; -aeeb; -aeec; -aeed; -aeee; -aeef; -aeeg; -aeeh; -aeei; -aeej; -aeek; -aeel; -aeem; -aeen; -aeeo; -aeep; -aeeq; -aeer; -aees; -aeet; -aeeu; -aeev; -aeew; -aeex; -aeey; -aeez; -aefa; -aefb; -aefc; -aefd; -aefe; -aeff; -aefg; -aefh; -aefi; -aefj; -aefk; -aefl; -aefm; -aefn; -aefo; -aefp; -aefq; -aefr; -aefs; -aeft; -aefu; -aefv; -aefw; -aefx; -aefy; -aefz; -aega; -aegb; -aegc; -aegd; -aege; -aegf; -aegg; -aegh; -aegi; -aegj; -aegk; -aegl; -aegm; -aegn; -aego; -aegp; -aegq; -aegr; -aegs; -aegt; -aegu; -aegv; -aegw; -aegx; -aegy; -aegz; -aeha; -aehb; -aehc; -aehd; -aehe; -aehf; -aehg; -aehh; -aehi; -aehj; -aehk; -aehl; -aehm; -aehn; -aeho; -aehp; -aehq; -aehr; -aehs; -aeht; -aehu; -aehv; -aehw; -aehx; -aehy; -aehz; -aeia; -aeib; -aeic; -aeid; -aeie; -aeif; -aeig; -aeih; -aeii; -aeij; -aeik; -aeil; -aeim; -aein; -aeio; -aeip; -aeiq; -aeir; -aeis; -aeit; -aeiu; -aeiv; -aeiw; -aeix; -aeiy; -aeiz; -aeja; -aejb; -aejc; -aejd; -aeje; -aejf; -aejg; -aejh; -aeji; -aejj; -aejk; -aejl; -aejm; -aejn; -aejo; -aejp; -aejq; -aejr; -aejs; -aejt; -aeju; -aejv; -aejw; -aejx; -aejy; -aejz; -aeka; -aekb; -aekc; -aekd; -aeke; -aekf; -aekg; -aekh; -aeki; -aekj; -aekk; -aekl; -aekm; -aekn; -aeko; -aekp; -aekq; -aekr; -aeks; -aekt; -aeku; -aekv; -aekw; -aekx; -aeky; -aekz; -aela; -aelb; -aelc; -aeld; -aele; -aelf; -aelg; -aelh; -aeli; -aelj; -aelk; -aell; -aelm; -aeln; -aelo; -aelp; -aelq; -aelr; -aels; -aelt; -aelu; -aelv; -aelw; -aelx; -aely; -aelz; -aema; -aemb; -aemc; -aemd; -aeme; -aemf; -aemg; -aemh; -aemi; -aemj; -aemk; -aeml; -aemm; -aemn; -aemo; -aemp; -aemq; -aemr; -aems; -aemt; -aemu; -aemv; -aemw; -aemx; -aemy; -aemz; -aena; -aenb; -aenc; -aend; -aene; -aenf; -aeng; -aenh; -aeni; -aenj; -aenk; -aenl; -aenm; -aenn; -aeno; -aenp; -aenq; -aenr; -aens; -aent; -aenu; -aenv; -aenw; -aenx; -aeny; -aenz; -aeoa; -aeob; -aeoc; -aeod; -aeoe; -aeof; -aeog; -aeoh; -aeoi; -aeoj; -aeok; -aeol; -aeom; -aeon; -aeoo; -aeop; -aeoq; -aeor; -aeos; -aeot; -aeou; -aeov; -aeow; -aeox; -aeoy; -aeoz; -aepa; -aepb; -aepc; -aepd; -aepe; -aepf; -aepg; -aeph; -aepi; -aepj; -aepk; -aepl; -aepm; -aepn; -aepo; -aepp; -aepq; -aepr; -aeps; -aept; -aepu; -aepv; -aepw; -aepx; -aepy; -aepz; -aeqa; -aeqb; -aeqc; -aeqd; -aeqe; -aeqf; -aeqg; -aeqh; -aeqi; -aeqj; -aeqk; -aeql; -aeqm; -aeqn; -aeqo; -aeqp; -aeqq; -aeqr; -aeqs; -aeqt; -aequ; -aeqv; -aeqw; -aeqx; -aeqy; -aeqz; -aera; -aerb; -aerc; -aerd; -aere; -aerf; -aerg; -aerh; -aeri; -aerj; -aerk; -aerl; -aerm; -aern; -aero; -aerp; -aerq; -aerr; -aers; -aert; -aeru; -aerv; -aerw; -aerx; -aery; -aerz; -aesa; -aesb; -aesc; -aesd; -aese; -aesf; -aesg; -aesh; -aesi; -aesj; -aesk; -aesl; -aesm; -aesn; -aeso; -aesp; -aesq; -aesr; -aess; -aest; -aesu; -aesv; -aesw; -aesx; -aesy; -aesz; -aeta; -aetb; -aetc; -aetd; -aete; -aetf; -aetg; -aeth; -aeti; -aetj; -aetk; -aetl; -aetm; -aetn; -aeto; -aetp; -aetq; -aetr; -aets; -aett; -aetu; -aetv; -aetw; -aetx; -aety; -aetz; -aeua; -aeub; -aeuc; -aeud; -aeue; -aeuf; -aeug; -aeuh; -aeui; -aeuj; -aeuk; -aeul; -aeum; -aeun; -aeuo; -aeup; -aeuq; -aeur; -aeus; -aeut; -aeuu; -aeuv; -aeuw; -aeux; -aeuy; -aeuz; -aeva; -aevb; -aevc; -aevd; -aeve; -aevf; -aevg; -aevh; -aevi; -aevj; -aevk; -aevl; -aevm; -aevn; -aevo; -aevp; -aevq; -aevr; -aevs; -aevt; -aevu; -aevv; -aevw; -aevx; -aevy; -aevz; -aewa; -aewb; -aewc; -aewd; -aewe; -aewf; -aewg; -aewh; -aewi; -aewj; -aewk; -aewl; -aewm; -aewn; -aewo; -aewp; -aewq; -aewr; -aews; -aewt; -aewu; -aewv; -aeww; -aewx; -aewy; -aewz; -aexa; -aexb; -aexc; -aexd; -aexe; -aexf; -aexg; -aexh; -aexi; -aexj; -aexk; -aexl; -aexm; -aexn; -aexo; -aexp; -aexq; -aexr; -aexs; -aext; -aexu; -aexv; -aexw; -aexx; -aexy; -aexz; -aeya; -aeyb; -aeyc; -aeyd; -aeye; -aeyf; -aeyg; -aeyh; -aeyi; -aeyj; -aeyk; -aeyl; -aeym; -aeyn; -aeyo; -aeyp; -aeyq; -aeyr; -aeys; -aeyt; -aeyu; -aeyv; -aeyw; -aeyx; -aeyy; -aeyz; -aeza; -aezb; -aezc; -aezd; -aeze; -aezf; -aezg; -aezh; -aezi; -aezj; -aezk; -aezl; -aezm; -aezn; -aezo; -aezp; -aezq; -aezr; -aezs; -aezt; -aezu; -aezv; -aezw; -aezx; -aezy; -aezz; -afaa; -afab; -afac; -afad; -afae; -afaf; -afag; -afah; -afai; -afaj; -afak; -afal; -afam; -afan; -afao; -afap; -afaq; -afar; -afas; -afat; -afau; -afav; -afaw; -afax; -afay; -afaz; -afba; -afbb; -afbc; -afbd; -afbe; -afbf; -afbg; -afbh; -afbi; -afbj; -afbk; -afbl; -afbm; -afbn; -afbo; -afbp; -afbq; -afbr; -afbs; -afbt; -afbu; -afbv; -afbw; -afbx; -afby; -afbz; -afca; -afcb; -afcc; -afcd; -afce; -afcf; -afcg; -afch; -afci; -afcj; -afck; -afcl; -afcm; -afcn; -afco; -afcp; -afcq; -afcr; -afcs; -afct; -afcu; -afcv; -afcw; -afcx; -afcy; -afcz; -afda; -afdb; -afdc; -afdd; -afde; -afdf; -afdg; -afdh; -afdi; -afdj; -afdk; -afdl; -afdm; -afdn; -afdo; -afdp; -afdq; -afdr; -afds; -afdt; -afdu; -afdv; -afdw; -afdx; -afdy; -afdz; -afea; -afeb; -afec; -afed; -afee; -afef; -afeg; -afeh; -afei; -afej; -afek; -afel; -afem; -afen; -afeo; -afep; -afeq; -afer; -afes; -afet; -afeu; -afev; -afew; -afex; -afey; -afez; -affa; -affb; -affc; -affd; -affe; -afff; -affg; -affh; -affi; -affj; -affk; -affl; -affm; -affn; -affo; -affp; -affq; -affr; -affs; -afft; -affu; -affv; -affw; -affx; -affy; -affz; -afga; -afgb; -afgc; -afgd; -afge; -afgf; -afgg; -afgh; -afgi; -afgj; -afgk; -afgl; -afgm; -afgn; -afgo; -afgp; -afgq; -afgr; -afgs; -afgt; -afgu; -afgv; -afgw; -afgx; -afgy; -afgz; -afha; -afhb; -afhc; -afhd; -afhe; -afhf; -afhg; -afhh; -afhi; -afhj; -afhk; -afhl; -afhm; -afhn; -afho; -afhp; -afhq; -afhr; -afhs; -afht; -afhu; -afhv; -afhw; -afhx; -afhy; -afhz; -afia; -afib; -afic; -afid; -afie; -afif; -afig; -afih; -afii; -afij; -afik; -afil; -afim; -afin; -afio; -afip; -afiq; -afir; -afis; -afit; -afiu; -afiv; -afiw; -afix; -afiy; -afiz; -afja; -afjb; -afjc; -afjd; -afje; -afjf; -afjg; -afjh; -afji; -afjj; -afjk; -afjl; -afjm; -afjn; -afjo; -afjp; -afjq; -afjr; -afjs; -afjt; -afju; -afjv; -afjw; -afjx; -afjy; -afjz; -afka; -afkb; -afkc; -afkd; -afke; -afkf; -afkg; -afkh; -afki; -afkj; -afkk; -afkl; -afkm; -afkn; -afko; -afkp; -afkq; -afkr; -afks; -afkt; -afku; -afkv; -afkw; -afkx; -afky; -afkz; -afla; -aflb; -aflc; -afld; -afle; -aflf; -aflg; -aflh; -afli; -aflj; -aflk; -afll; -aflm; -afln; -aflo; -aflp; -aflq; -aflr; -afls; -aflt; -aflu; -aflv; -aflw; -aflx; -afly; -aflz; -afma; -afmb; -afmc; -afmd; -afme; -afmf; -afmg; -afmh; -afmi; -afmj; -afmk; -afml; -afmm; -afmn; -afmo; -afmp; -afmq; -afmr; -afms; -afmt; -afmu; -afmv; -afmw; -afmx; -afmy; -afmz; -afna; -afnb; -afnc; -afnd; -afne; -afnf; -afng; -afnh; -afni; -afnj; -afnk; -afnl; -afnm; -afnn; -afno; -afnp; -afnq; -afnr; -afns; -afnt; -afnu; -afnv; -afnw; -afnx; -afny; -afnz; -afoa; -afob; -afoc; -afod; -afoe; -afof; -afog; -afoh; -afoi; -afoj; -afok; -afol; -afom; -afon; -afoo; -afop; -afoq; -afor; -afos; -afot; -afou; -afov; -afow; -afox; -afoy; -afoz; -afpa; -afpb; -afpc; -afpd; -afpe; -afpf; -afpg; -afph; -afpi; -afpj; -afpk; -afpl; -afpm; -afpn; -afpo; -afpp; -afpq; -afpr; -afps; -afpt; -afpu; -afpv; -afpw; -afpx; -afpy; -afpz; -afqa; -afqb; -afqc; -afqd; -afqe; -afqf; -afqg; -afqh; -afqi; -afqj; -afqk; -afql; -afqm; -afqn; -afqo; -afqp; -afqq; -afqr; -afqs; -afqt; -afqu; -afqv; -afqw; -afqx; -afqy; -afqz; -afra; -afrb; -afrc; -afrd; -afre; -afrf; -afrg; -afrh; -afri; -afrj; -afrk; -afrl; -afrm; -afrn; -afro; -afrp; -afrq; -afrr; -afrs; -afrt; -afru; -afrv; -afrw; -afrx; -afry; -afrz; -afsa; -afsb; -afsc; -afsd; -afse; -afsf; -afsg; -afsh; -afsi; -afsj; -afsk; -afsl; -afsm; -afsn; -afso; -afsp; -afsq; -afsr; -afss; -afst; -afsu; -afsv; -afsw; -afsx; -afsy; -afsz; -afta; -aftb; -aftc; -aftd; -afte; -aftf; -aftg; -afth; -afti; -aftj; -aftk; -aftl; -aftm; -aftn; -afto; -aftp; -aftq; -aftr; -afts; -aftt; -aftu; -aftv; -aftw; -aftx; -afty; -aftz; -afua; -afub; -afuc; -afud; -afue; -afuf; -afug; -afuh; -afui; -afuj; -afuk; -aful; -afum; -afun; -afuo; -afup; -afuq; -afur; -afus; -afut; -afuu; -afuv; -afuw; -afux; -afuy; -afuz; -afva; -afvb; -afvc; -afvd; -afve; -afvf; -afvg; -afvh; -afvi; -afvj; -afvk; -afvl; -afvm; -afvn; -afvo; -afvp; -afvq; -afvr; -afvs; -afvt; -afvu; -afvv; -afvw; -afvx; -afvy; -afvz; -afwa; -afwb; -afwc; -afwd; -afwe; -afwf; -afwg; -afwh; -afwi; -afwj; -afwk; -afwl; -afwm; -afwn; -afwo; -afwp; -afwq; -afwr; -afws; -afwt; -afwu; -afwv; -afww; -afwx; -afwy; -afwz; -afxa; -afxb; -afxc; -afxd; -afxe; -afxf; -afxg; -afxh; -afxi; -afxj; -afxk; -afxl; -afxm; -afxn; -afxo; -afxp; -afxq; -afxr; -afxs; -afxt; -afxu; -afxv; -afxw; -afxx; -afxy; -afxz; -afya; -afyb; -afyc; -afyd; -afye; -afyf; -afyg; -afyh; -afyi; -afyj; -afyk; -afyl; -afym; -afyn; -afyo; -afyp; -afyq; -afyr; -afys; -afyt; -afyu; -afyv; -afyw; -afyx; -afyy; -afyz; -afza; -afzb; -afzc; -afzd; -afze; -afzf; -afzg; -afzh; -afzi; -afzj; -afzk; -afzl; -afzm; -afzn; -afzo; -afzp; -afzq; -afzr; -afzs; -afzt; -afzu; -afzv; -afzw; -afzx; -afzy; -afzz; -agaa; -agab; -agac; -agad; -agae; -agaf; -agag; -agah; -agai; -agaj; -agak; -agal; -agam; -agan; -agao; -agap; -agaq; -agar; -agas; -agat; -agau; -agav; -agaw; -agax; -agay; -agaz; -agba; -agbb; -agbc; -agbd; -agbe; -agbf; -agbg; -agbh; -agbi; -agbj; -agbk; -agbl; -agbm; -agbn; -agbo; -agbp; -agbq; -agbr; -agbs; -agbt; -agbu; -agbv; -agbw; -agbx; -agby; -agbz; -agca; -agcb; -agcc; -agcd; -agce; -agcf; -agcg; -agch; -agci; -agcj; -agck; -agcl; -agcm; -agcn; -agco; -agcp; -agcq; -agcr; -agcs; -agct; -agcu; -agcv; -agcw; -agcx; -agcy; -agcz; -agda; -agdb; -agdc; -agdd; -agde; -agdf; -agdg; -agdh; -agdi; -agdj; -agdk; -agdl; -agdm; -agdn; -agdo; -agdp; -agdq; -agdr; -agds; -agdt; -agdu; -agdv; -agdw; -agdx; -agdy; -agdz; -agea; -ageb; -agec; -aged; -agee; -agef; -ageg; -ageh; -agei; -agej; -agek; -agel; -agem; -agen; -ageo; -agep; -ageq; -ager; -ages; -aget; -ageu; -agev; -agew; -agex; -agey; -agez; -agfa; -agfb; -agfc; -agfd; -agfe; -agff; -agfg; -agfh; -agfi; -agfj; -agfk; -agfl; -agfm; -agfn; -agfo; -agfp; -agfq; -agfr; -agfs; -agft; -agfu; -agfv; -agfw; -agfx; -agfy; -agfz; -agga; -aggb; -aggc; -aggd; -agge; -aggf; -aggg; -aggh; -aggi; -aggj; -aggk; -aggl; -aggm; -aggn; -aggo; -aggp; -aggq; -aggr; -aggs; -aggt; -aggu; -aggv; -aggw; -aggx; -aggy; -aggz; -agha; -aghb; -aghc; -aghd; -aghe; -aghf; -aghg; -aghh; -aghi; -aghj; -aghk; -aghl; -aghm; -aghn; -agho; -aghp; -aghq; -aghr; -aghs; -aght; -aghu; -aghv; -aghw; -aghx; -aghy; -aghz; -agia; -agib; -agic; -agid; -agie; -agif; -agig; -agih; -agii; -agij; -agik; -agil; -agim; -agin; -agio; -agip; -agiq; -agir; -agis; -agit; -agiu; -agiv; -agiw; -agix; -agiy; -agiz; -agja; -agjb; -agjc; -agjd; -agje; -agjf; -agjg; -agjh; -agji; -agjj; -agjk; -agjl; -agjm; -agjn; -agjo; -agjp; -agjq; -agjr; -agjs; -agjt; -agju; -agjv; -agjw; -agjx; -agjy; -agjz; -agka; -agkb; -agkc; -agkd; -agke; -agkf; -agkg; -agkh; -agki; -agkj; -agkk; -agkl; -agkm; -agkn; -agko; -agkp; -agkq; -agkr; -agks; -agkt; -agku; -agkv; -agkw; -agkx; -agky; -agkz; -agla; -aglb; -aglc; -agld; -agle; -aglf; -aglg; -aglh; -agli; -aglj; -aglk; -agll; -aglm; -agln; -aglo; -aglp; -aglq; -aglr; -agls; -aglt; -aglu; -aglv; -aglw; -aglx; -agly; -aglz; -agma; -agmb; -agmc; -agmd; -agme; -agmf; -agmg; -agmh; -agmi; -agmj; -agmk; -agml; -agmm; -agmn; -agmo; -agmp; -agmq; -agmr; -agms; -agmt; -agmu; -agmv; -agmw; -agmx; -agmy; -agmz; -agna; -agnb; -agnc; -agnd; -agne; -agnf; -agng; -agnh; -agni; -agnj; -agnk; -agnl; -agnm; -agnn; -agno; -agnp; -agnq; -agnr; -agns; -agnt; -agnu; -agnv; -agnw; -agnx; -agny; -agnz; -agoa; -agob; -agoc; -agod; -agoe; -agof; -agog; -agoh; -agoi; -agoj; -agok; -agol; -agom; -agon; -agoo; -agop; -agoq; -agor; -agos; -agot; -agou; -agov; -agow; -agox; -agoy; -agoz; -agpa; -agpb; -agpc; -agpd; -agpe; -agpf; -agpg; -agph; -agpi; -agpj; -agpk; -agpl; -agpm; -agpn; -agpo; -agpp; -agpq; -agpr; -agps; -agpt; -agpu; -agpv; -agpw; -agpx; -agpy; -agpz; -agqa; -agqb; -agqc; -agqd; -agqe; -agqf; -agqg; -agqh; -agqi; -agqj; -agqk; -agql; -agqm; -agqn; -agqo; -agqp; -agqq; -agqr; -agqs; -agqt; -agqu; -agqv; -agqw; -agqx; -agqy; -agqz; -agra; -agrb; -agrc; -agrd; -agre; -agrf; -agrg; -agrh; -agri; -agrj; -agrk; -agrl; -agrm; -agrn; -agro; -agrp; -agrq; -agrr; -agrs; -agrt; -agru; -agrv; -agrw; -agrx; -agry; -agrz; -agsa; -agsb; -agsc; -agsd; -agse; -agsf; -agsg; -agsh; -agsi; -agsj; -agsk; -agsl; -agsm; -agsn; -agso; -agsp; -agsq; -agsr; -agss; -agst; -agsu; -agsv; -agsw; -agsx; -agsy; -agsz; -agta; -agtb; -agtc; -agtd; -agte; -agtf; -agtg; -agth; -agti; -agtj; -agtk; -agtl; -agtm; -agtn; -agto; -agtp; -agtq; -agtr; -agts; -agtt; -agtu; -agtv; -agtw; -agtx; -agty; -agtz; -agua; -agub; -aguc; -agud; -ague; -aguf; -agug; -aguh; -agui; -aguj; -aguk; -agul; -agum; -agun; -aguo; -agup; -aguq; -agur; -agus; -agut; -aguu; -aguv; -aguw; -agux; -aguy; -aguz; -agva; -agvb; -agvc; -agvd; -agve; -agvf; -agvg; -agvh; -agvi; -agvj; -agvk; -agvl; -agvm; -agvn; -agvo; -agvp; -agvq; -agvr; -agvs; -agvt; -agvu; -agvv; -agvw; -agvx; -agvy; -agvz; -agwa; -agwb; -agwc; -agwd; -agwe; -agwf; -agwg; -agwh; -agwi; -agwj; -agwk; -agwl; -agwm; -agwn; -agwo; -agwp; -agwq; -agwr; -agws; -agwt; -agwu; -agwv; -agww; -agwx; -agwy; -agwz; -agxa; -agxb; -agxc; -agxd; -agxe; -agxf; -agxg; -agxh; -agxi; -agxj; -agxk; -agxl; -agxm; -agxn; -agxo; -agxp; -agxq; -agxr; -agxs; -agxt; -agxu; -agxv; -agxw; -agxx; -agxy; -agxz; -agya; -agyb; -agyc; -agyd; -agye; -agyf; -agyg; -agyh; -agyi; -agyj; -agyk; -agyl; -agym; -agyn; -agyo; -agyp; -agyq; -agyr; -agys; -agyt; -agyu; -agyv; -agyw; -agyx; -agyy; -agyz; -agza; -agzb; -agzc; -agzd; -agze; -agzf; -agzg; -agzh; -agzi; -agzj; -agzk; -agzl; -agzm; -agzn; -agzo; -agzp; -agzq; -agzr; -agzs; -agzt; -agzu; -agzv; -agzw; -agzx; -agzy; -agzz; -ahaa; -ahab; -ahac; -ahad; -ahae; -ahaf; -ahag; -ahah; -ahai; -ahaj; -ahak; -ahal; -aham; -ahan; -ahao; -ahap; -ahaq; -ahar; -ahas; -ahat; -ahau; -ahav; -ahaw; -ahax; -ahay; -ahaz; -ahba; -ahbb; -ahbc; -ahbd; -ahbe; -ahbf; -ahbg; -ahbh; -ahbi; -ahbj; -ahbk; -ahbl; -ahbm; -ahbn; -ahbo; -ahbp; -ahbq; -ahbr; -ahbs; -ahbt; -ahbu; -ahbv; -ahbw; -ahbx; -ahby; -ahbz; -ahca; -ahcb; -ahcc; -ahcd; -ahce; -ahcf; -ahcg; -ahch; -ahci; -ahcj; -ahck; -ahcl; -ahcm; -ahcn; -ahco; -ahcp; -ahcq; -ahcr; -ahcs; -ahct; -ahcu; -ahcv; -ahcw; -ahcx; -ahcy; -ahcz; -ahda; -ahdb; -ahdc; -ahdd; -ahde; -ahdf; -ahdg; -ahdh; -ahdi; -ahdj; -ahdk; -ahdl; -ahdm; -ahdn; -ahdo; -ahdp; -ahdq; -ahdr; -ahds; -ahdt; -ahdu; -ahdv; -ahdw; -ahdx; -ahdy; -ahdz; -ahea; -aheb; -ahec; -ahed; -ahee; -ahef; -aheg; -aheh; -ahei; -ahej; -ahek; -ahel; -ahem; -ahen; -aheo; -ahep; -aheq; -aher; -ahes; -ahet; -aheu; -ahev; -ahew; -ahex; -ahey; -ahez; -ahfa; -ahfb; -ahfc; -ahfd; -ahfe; -ahff; -ahfg; -ahfh; -ahfi; -ahfj; -ahfk; -ahfl; -ahfm; -ahfn; -ahfo; -ahfp; -ahfq; -ahfr; -ahfs; -ahft; -ahfu; -ahfv; -ahfw; -ahfx; -ahfy; -ahfz; -ahga; -ahgb; -ahgc; -ahgd; -ahge; -ahgf; -ahgg; -ahgh; -ahgi; -ahgj; -ahgk; -ahgl; -ahgm; -ahgn; -ahgo; -ahgp; -ahgq; -ahgr; -ahgs; -ahgt; -ahgu; -ahgv; -ahgw; -ahgx; -ahgy; -ahgz; -ahha; -ahhb; -ahhc; -ahhd; -ahhe; -ahhf; -ahhg; -ahhh; -ahhi; -ahhj; -ahhk; -ahhl; -ahhm; -ahhn; -ahho; -ahhp; -ahhq; -ahhr; -ahhs; -ahht; -ahhu; -ahhv; -ahhw; -ahhx; -ahhy; -ahhz; -ahia; -ahib; -ahic; -ahid; -ahie; -ahif; -ahig; -ahih; -ahii; -ahij; -ahik; -ahil; -ahim; -ahin; -ahio; -ahip; -ahiq; -ahir; -ahis; -ahit; -ahiu; -ahiv; -ahiw; -ahix; -ahiy; -ahiz; -ahja; -ahjb; -ahjc; -ahjd; -ahje; -ahjf; -ahjg; -ahjh; -ahji; -ahjj; -ahjk; -ahjl; -ahjm; -ahjn; -ahjo; -ahjp; -ahjq; -ahjr; -ahjs; -ahjt; -ahju; -ahjv; -ahjw; -ahjx; -ahjy; -ahjz; -ahka; -ahkb; -ahkc; -ahkd; -ahke; -ahkf; -ahkg; -ahkh; -ahki; -ahkj; -ahkk; -ahkl; -ahkm; -ahkn; -ahko; -ahkp; -ahkq; -ahkr; -ahks; -ahkt; -ahku; -ahkv; -ahkw; -ahkx; -ahky; -ahkz; -ahla; -ahlb; -ahlc; -ahld; -ahle; -ahlf; -ahlg; -ahlh; -ahli; -ahlj; -ahlk; -ahll; -ahlm; -ahln; -ahlo; -ahlp; -ahlq; -ahlr; -ahls; -ahlt; -ahlu; -ahlv; -ahlw; -ahlx; -ahly; -ahlz; -ahma; -ahmb; -ahmc; -ahmd; -ahme; -ahmf; -ahmg; -ahmh; -ahmi; -ahmj; -ahmk; -ahml; -ahmm; -ahmn; -ahmo; -ahmp; -ahmq; -ahmr; -ahms; -ahmt; -ahmu; -ahmv; -ahmw; -ahmx; -ahmy; -ahmz; -ahna; -ahnb; -ahnc; -ahnd; -ahne; -ahnf; -ahng; -ahnh; -ahni; -ahnj; -ahnk; -ahnl; -ahnm; -ahnn; -ahno; -ahnp; -ahnq; -ahnr; -ahns; -ahnt; -ahnu; -ahnv; -ahnw; -ahnx; -ahny; -ahnz; -ahoa; -ahob; -ahoc; -ahod; -ahoe; -ahof; -ahog; -ahoh; -ahoi; -ahoj; -ahok; -ahol; -ahom; -ahon; -ahoo; -ahop; -ahoq; -ahor; -ahos; -ahot; -ahou; -ahov; -ahow; -ahox; -ahoy; -ahoz; -ahpa; -ahpb; -ahpc; -ahpd; -ahpe; -ahpf; -ahpg; -ahph; -ahpi; -ahpj; -ahpk; -ahpl; -ahpm; -ahpn; -ahpo; -ahpp; -ahpq; -ahpr; -ahps; -ahpt; -ahpu; -ahpv; -ahpw; -ahpx; -ahpy; -ahpz; -ahqa; -ahqb; -ahqc; -ahqd; -ahqe; -ahqf; -ahqg; -ahqh; -ahqi; -ahqj; -ahqk; -ahql; -ahqm; -ahqn; -ahqo; -ahqp; -ahqq; -ahqr; -ahqs; -ahqt; -ahqu; -ahqv; -ahqw; -ahqx; -ahqy; -ahqz; -ahra; -ahrb; -ahrc; -ahrd; -ahre; -ahrf; -ahrg; -ahrh; -ahri; -ahrj; -ahrk; -ahrl; -ahrm; -ahrn; -ahro; -ahrp; -ahrq; -ahrr; -ahrs; -ahrt; -ahru; -ahrv; -ahrw; -ahrx; -ahry; -ahrz; -ahsa; -ahsb; -ahsc; -ahsd; -ahse; -ahsf; -ahsg; -ahsh; -ahsi; -ahsj; -ahsk; -ahsl; -ahsm; -ahsn; -ahso; -ahsp; -ahsq; -ahsr; -ahss; -ahst; -ahsu; -ahsv; -ahsw; -ahsx; -ahsy; -ahsz; -ahta; -ahtb; -ahtc; -ahtd; -ahte; -ahtf; -ahtg; -ahth; -ahti; -ahtj; -ahtk; -ahtl; -ahtm; -ahtn; -ahto; -ahtp; -ahtq; -ahtr; -ahts; -ahtt; -ahtu; -ahtv; -ahtw; -ahtx; -ahty; -ahtz; -ahua; -ahub; -ahuc; -ahud; -ahue; -ahuf; -ahug; -ahuh; -ahui; -ahuj; -ahuk; -ahul; -ahum; -ahun; -ahuo; -ahup; -ahuq; -ahur; -ahus; -ahut; -ahuu; -ahuv; -ahuw; -ahux; -ahuy; -ahuz; -ahva; -ahvb; -ahvc; -ahvd; -ahve; -ahvf; -ahvg; -ahvh; -ahvi; -ahvj; -ahvk; -ahvl; -ahvm; -ahvn; -ahvo; -ahvp; -ahvq; -ahvr; -ahvs; -ahvt; -ahvu; -ahvv; -ahvw; -ahvx; -ahvy; -ahvz; -ahwa; -ahwb; -ahwc; -ahwd; -ahwe; -ahwf; -ahwg; -ahwh; -ahwi; -ahwj; -ahwk; -ahwl; -ahwm; -ahwn; -ahwo; -ahwp; -ahwq; -ahwr; -ahws; -ahwt; -ahwu; -ahwv; -ahww; -ahwx; -ahwy; -ahwz; -ahxa; -ahxb; -ahxc; -ahxd; -ahxe; -ahxf; -ahxg; -ahxh; -ahxi; -ahxj; -ahxk; -ahxl; -ahxm; -ahxn; -ahxo; -ahxp; -ahxq; -ahxr; -ahxs; -ahxt; -ahxu; -ahxv; -ahxw; -ahxx; -ahxy; -ahxz; -ahya; -ahyb; -ahyc; -ahyd; -ahye; -ahyf; -ahyg; -ahyh; -ahyi; -ahyj; -ahyk; -ahyl; -ahym; -ahyn; -ahyo; -ahyp; -ahyq; -ahyr; -ahys; -ahyt; -ahyu; -ahyv; -ahyw; -ahyx; -ahyy; -ahyz; -ahza; -ahzb; -ahzc; -ahzd; -ahze; -ahzf; -ahzg; -ahzh; -ahzi; -ahzj; -ahzk; -ahzl; -ahzm; -ahzn; -ahzo; -ahzp; -ahzq; -ahzr; -ahzs; -ahzt; -ahzu; -ahzv; -ahzw; -ahzx; -ahzy; -ahzz; -aiaa; -aiab; -aiac; -aiad; -aiae; -aiaf; -aiag; -aiah; -aiai; -aiaj; -aiak; -aial; -aiam; -aian; -aiao; -aiap; -aiaq; -aiar; -aias; -aiat; -aiau; -aiav; -aiaw; -aiax; -aiay; -aiaz; -aiba; -aibb; -aibc; -aibd; -aibe; -aibf; -aibg; -aibh; -aibi; -aibj; -aibk; -aibl; -aibm; -aibn; -aibo; -aibp; -aibq; -aibr; -aibs; -aibt; -aibu; -aibv; -aibw; -aibx; -aiby; -aibz; -aica; -aicb; -aicc; -aicd; -aice; -aicf; -aicg; -aich; -aici; -aicj; -aick; -aicl; -aicm; -aicn; -aico; -aicp; -aicq; -aicr; -aics; -aict; -aicu; -aicv; -aicw; -aicx; -aicy; -aicz; -aida; -aidb; -aidc; -aidd; -aide; -aidf; -aidg; -aidh; -aidi; -aidj; -aidk; -aidl; -aidm; -aidn; -aido; -aidp; -aidq; -aidr; -aids; -aidt; -aidu; -aidv; -aidw; -aidx; -aidy; -aidz; -aiea; -aieb; -aiec; -aied; -aiee; -aief; -aieg; -aieh; -aiei; -aiej; -aiek; -aiel; -aiem; -aien; -aieo; -aiep; -aieq; -aier; -aies; -aiet; -aieu; -aiev; -aiew; -aiex; -aiey; -aiez; -aifa; -aifb; -aifc; -aifd; -aife; -aiff; -aifg; -aifh; -aifi; -aifj; -aifk; -aifl; -aifm; -aifn; -aifo; -aifp; -aifq; -aifr; -aifs; -aift; -aifu; -aifv; -aifw; -aifx; -aify; -aifz; -aiga; -aigb; -aigc; -aigd; -aige; -aigf; -aigg; -aigh; -aigi; -aigj; -aigk; -aigl; -aigm; -aign; -aigo; -aigp; -aigq; -aigr; -aigs; -aigt; -aigu; -aigv; -aigw; -aigx; -aigy; -aigz; -aiha; -aihb; -aihc; -aihd; -aihe; -aihf; -aihg; -aihh; -aihi; -aihj; -aihk; -aihl; -aihm; -aihn; -aiho; -aihp; -aihq; -aihr; -aihs; -aiht; -aihu; -aihv; -aihw; -aihx; -aihy; -aihz; -aiia; -aiib; -aiic; -aiid; -aiie; -aiif; -aiig; -aiih; -aiii; -aiij; -aiik; -aiil; -aiim; -aiin; -aiio; -aiip; -aiiq; -aiir; -aiis; -aiit; -aiiu; -aiiv; -aiiw; -aiix; -aiiy; -aiiz; -aija; -aijb; -aijc; -aijd; -aije; -aijf; -aijg; -aijh; -aiji; -aijj; -aijk; -aijl; -aijm; -aijn; -aijo; -aijp; -aijq; -aijr; -aijs; -aijt; -aiju; -aijv; -aijw; -aijx; -aijy; -aijz; -aika; -aikb; -aikc; -aikd; -aike; -aikf; -aikg; -aikh; -aiki; -aikj; -aikk; -aikl; -aikm; -aikn; -aiko; -aikp; -aikq; -aikr; -aiks; -aikt; -aiku; -aikv; -aikw; -aikx; -aiky; -aikz; -aila; -ailb; -ailc; -aild; -aile; -ailf; -ailg; -ailh; -aili; -ailj; -ailk; -aill; -ailm; -ailn; -ailo; -ailp; -ailq; -ailr; -ails; -ailt; -ailu; -ailv; -ailw; -ailx; -aily; -ailz; -aima; -aimb; -aimc; -aimd; -aime; -aimf; -aimg; -aimh; -aimi; -aimj; -aimk; -aiml; -aimm; -aimn; -aimo; -aimp; -aimq; -aimr; -aims; -aimt; -aimu; -aimv; -aimw; -aimx; -aimy; -aimz; -aina; -ainb; -ainc; -aind; -aine; -ainf; -aing; -ainh; -aini; -ainj; -aink; -ainl; -ainm; -ainn; -aino; -ainp; -ainq; -ainr; -ains; -aint; -ainu; -ainv; -ainw; -ainx; -ainy; -ainz; -aioa; -aiob; -aioc; -aiod; -aioe; -aiof; -aiog; -aioh; -aioi; -aioj; -aiok; -aiol; -aiom; -aion; -aioo; -aiop; -aioq; -aior; -aios; -aiot; -aiou; -aiov; -aiow; -aiox; -aioy; -aioz; -aipa; -aipb; -aipc; -aipd; -aipe; -aipf; -aipg; -aiph; -aipi; -aipj; -aipk; -aipl; -aipm; -aipn; -aipo; -aipp; -aipq; -aipr; -aips; -aipt; -aipu; -aipv; -aipw; -aipx; -aipy; -aipz; -aiqa; -aiqb; -aiqc; -aiqd; -aiqe; -aiqf; -aiqg; -aiqh; -aiqi; -aiqj; -aiqk; -aiql; -aiqm; -aiqn; -aiqo; -aiqp; -aiqq; -aiqr; -aiqs; -aiqt; -aiqu; -aiqv; -aiqw; -aiqx; -aiqy; -aiqz; -aira; -airb; -airc; -aird; -aire; -airf; -airg; -airh; -airi; -airj; -airk; -airl; -airm; -airn; -airo; -airp; -airq; -airr; -airs; -airt; -airu; -airv; -airw; -airx; -airy; -airz; -aisa; -aisb; -aisc; -aisd; -aise; -aisf; -aisg; -aish; -aisi; -aisj; -aisk; -aisl; -aism; -aisn; -aiso; -aisp; -aisq; -aisr; -aiss; -aist; -aisu; -aisv; -aisw; -aisx; -aisy; -aisz; -aita; -aitb; -aitc; -aitd; -aite; -aitf; -aitg; -aith; -aiti; -aitj; -aitk; -aitl; -aitm; -aitn; -aito; -aitp; -aitq; -aitr; -aits; -aitt; -aitu; -aitv; -aitw; -aitx; -aity; -aitz; -aiua; -aiub; -aiuc; -aiud; -aiue; -aiuf; -aiug; -aiuh; -aiui; -aiuj; -aiuk; -aiul; -aium; -aiun; -aiuo; -aiup; -aiuq; -aiur; -aius; -aiut; -aiuu; -aiuv; -aiuw; -aiux; -aiuy; -aiuz; -aiva; -aivb; -aivc; -aivd; -aive; -aivf; -aivg; -aivh; -aivi; -aivj; -aivk; -aivl; -aivm; -aivn; -aivo; -aivp; -aivq; -aivr; -aivs; -aivt; -aivu; -aivv; -aivw; -aivx; -aivy; -aivz; -aiwa; -aiwb; -aiwc; -aiwd; -aiwe; -aiwf; -aiwg; -aiwh; -aiwi; -aiwj; -aiwk; -aiwl; -aiwm; -aiwn; -aiwo; -aiwp; -aiwq; -aiwr; -aiws; -aiwt; -aiwu; -aiwv; -aiww; -aiwx; -aiwy; -aiwz; -aixa; -aixb; -aixc; -aixd; -aixe; -aixf; -aixg; -aixh; -aixi; -aixj; -aixk; -aixl; -aixm; -aixn; -aixo; -aixp; -aixq; -aixr; -aixs; -aixt; -aixu; -aixv; -aixw; -aixx; -aixy; -aixz; -aiya; -aiyb; -aiyc; -aiyd; -aiye; -aiyf; -aiyg; -aiyh; -aiyi; -aiyj; -aiyk; -aiyl; -aiym; -aiyn; -aiyo; -aiyp; -aiyq; -aiyr; -aiys; -aiyt; -aiyu; -aiyv; -aiyw; -aiyx; -aiyy; -aiyz; -aiza; -aizb; -aizc; -aizd; -aize; -aizf; -aizg; -aizh; -aizi; -aizj; -aizk; -aizl; -aizm; -aizn; -aizo; -aizp; -aizq; -aizr; -aizs; -aizt; -aizu; -aizv; -aizw; -aizx; -aizy; -aizz; -ajaa; -ajab; -ajac; -ajad; -ajae; -ajaf; -ajag; -ajah; -ajai; -ajaj; -ajak; -ajal; -ajam; -ajan; -ajao; -ajap; -ajaq; -ajar; -ajas; -ajat; -ajau; -ajav; -ajaw; -ajax; -ajay; -ajaz; -ajba; -ajbb; -ajbc; -ajbd; -ajbe; -ajbf; -ajbg; -ajbh; -ajbi; -ajbj; -ajbk; -ajbl; -ajbm; -ajbn; -ajbo; -ajbp; -ajbq; -ajbr; -ajbs; -ajbt; -ajbu; -ajbv; -ajbw; -ajbx; -ajby; -ajbz; -ajca; -ajcb; -ajcc; -ajcd; -ajce; -ajcf; -ajcg; -ajch; -ajci; -ajcj; -ajck; -ajcl; -ajcm; -ajcn; -ajco; -ajcp; -ajcq; -ajcr; -ajcs; -ajct; -ajcu; -ajcv; -ajcw; -ajcx; -ajcy; -ajcz; -ajda; -ajdb; -ajdc; -ajdd; -ajde; -ajdf; -ajdg; -ajdh; -ajdi; -ajdj; -ajdk; -ajdl; -ajdm; -ajdn; -ajdo; -ajdp; -ajdq; -ajdr; -ajds; -ajdt; -ajdu; -ajdv; -ajdw; -ajdx; -ajdy; -ajdz; -ajea; -ajeb; -ajec; -ajed; -ajee; -ajef; -ajeg; -ajeh; -ajei; -ajej; -ajek; -ajel; -ajem; -ajen; -ajeo; -ajep; -ajeq; -ajer; -ajes; -ajet; -ajeu; -ajev; -ajew; -ajex; -ajey; -ajez; -ajfa; -ajfb; -ajfc; -ajfd; -ajfe; -ajff; -ajfg; -ajfh; -ajfi; -ajfj; -ajfk; -ajfl; -ajfm; -ajfn; -ajfo; -ajfp; -ajfq; -ajfr; -ajfs; -ajft; -ajfu; -ajfv; -ajfw; -ajfx; -ajfy; -ajfz; -ajga; -ajgb; -ajgc; -ajgd; -ajge; -ajgf; -ajgg; -ajgh; -ajgi; -ajgj; -ajgk; -ajgl; -ajgm; -ajgn; -ajgo; -ajgp; -ajgq; -ajgr; -ajgs; -ajgt; -ajgu; -ajgv; -ajgw; -ajgx; -ajgy; -ajgz; -ajha; -ajhb; -ajhc; -ajhd; -ajhe; -ajhf; -ajhg; -ajhh; -ajhi; -ajhj; -ajhk; -ajhl; -ajhm; -ajhn; -ajho; -ajhp; -ajhq; -ajhr; -ajhs; -ajht; -ajhu; -ajhv; -ajhw; -ajhx; -ajhy; -ajhz; -ajia; -ajib; -ajic; -ajid; -ajie; -ajif; -ajig; -ajih; -ajii; -ajij; -ajik; -ajil; -ajim; -ajin; -ajio; -ajip; -ajiq; -ajir; -ajis; -ajit; -ajiu; -ajiv; -ajiw; -ajix; -ajiy; -ajiz; -ajja; -ajjb; -ajjc; -ajjd; -ajje; -ajjf; -ajjg; -ajjh; -ajji; -ajjj; -ajjk; -ajjl; -ajjm; -ajjn; -ajjo; -ajjp; -ajjq; -ajjr; -ajjs; -ajjt; -ajju; -ajjv; -ajjw; -ajjx; -ajjy; -ajjz; -ajka; -ajkb; -ajkc; -ajkd; -ajke; -ajkf; -ajkg; -ajkh; -ajki; -ajkj; -ajkk; -ajkl; -ajkm; -ajkn; -ajko; -ajkp; -ajkq; -ajkr; -ajks; -ajkt; -ajku; -ajkv; -ajkw; -ajkx; -ajky; -ajkz; -ajla; -ajlb; -ajlc; -ajld; -ajle; -ajlf; -ajlg; -ajlh; -ajli; -ajlj; -ajlk; -ajll; -ajlm; -ajln; -ajlo; -ajlp; -ajlq; -ajlr; -ajls; -ajlt; -ajlu; -ajlv; -ajlw; -ajlx; -ajly; -ajlz; -ajma; -ajmb; -ajmc; -ajmd; -ajme; -ajmf; -ajmg; -ajmh; -ajmi; -ajmj; -ajmk; -ajml; -ajmm; -ajmn; -ajmo; -ajmp; -ajmq; -ajmr; -ajms; -ajmt; -ajmu; -ajmv; -ajmw; -ajmx; -ajmy; -ajmz; -ajna; -ajnb; -ajnc; -ajnd; -ajne; -ajnf; -ajng; -ajnh; -ajni; -ajnj; -ajnk; -ajnl; -ajnm; -ajnn; -ajno; -ajnp; -ajnq; -ajnr; -ajns; -ajnt; -ajnu; -ajnv; -ajnw; -ajnx; -ajny; -ajnz; -ajoa; -ajob; -ajoc; -ajod; -ajoe; -ajof; -ajog; -ajoh; -ajoi; -ajoj; -ajok; -ajol; -ajom; -ajon; -ajoo; -ajop; -ajoq; -ajor; -ajos; -ajot; -ajou; -ajov; -ajow; -ajox; -ajoy; -ajoz; -ajpa; -ajpb; -ajpc; -ajpd; -ajpe; -ajpf; -ajpg; -ajph; -ajpi; -ajpj; -ajpk; -ajpl; -ajpm; -ajpn; -ajpo; -ajpp; -ajpq; -ajpr; -ajps; -ajpt; -ajpu; -ajpv; -ajpw; -ajpx; -ajpy; -ajpz; -ajqa; -ajqb; -ajqc; -ajqd; -ajqe; -ajqf; -ajqg; -ajqh; -ajqi; -ajqj; -ajqk; -ajql; -ajqm; -ajqn; -ajqo; -ajqp; -ajqq; -ajqr; -ajqs; -ajqt; -ajqu; -ajqv; -ajqw; -ajqx; -ajqy; -ajqz; -ajra; -ajrb; -ajrc; -ajrd; -ajre; -ajrf; -ajrg; -ajrh; -ajri; -ajrj; -ajrk; -ajrl; -ajrm; -ajrn; -ajro; -ajrp; -ajrq; -ajrr; -ajrs; -ajrt; -ajru; -ajrv; -ajrw; -ajrx; -ajry; -ajrz; -ajsa; -ajsb; -ajsc; -ajsd; -ajse; -ajsf; -ajsg; -ajsh; -ajsi; -ajsj; -ajsk; -ajsl; -ajsm; -ajsn; -ajso; -ajsp; -ajsq; -ajsr; -ajss; -ajst; -ajsu; -ajsv; -ajsw; -ajsx; -ajsy; -ajsz; -ajta; -ajtb; -ajtc; -ajtd; -ajte; -ajtf; -ajtg; -ajth; -ajti; -ajtj; -ajtk; -ajtl; -ajtm; -ajtn; -ajto; -ajtp; -ajtq; -ajtr; -ajts; -ajtt; -ajtu; -ajtv; -ajtw; -ajtx; -ajty; -ajtz; -ajua; -ajub; -ajuc; -ajud; -ajue; -ajuf; -ajug; -ajuh; -ajui; -ajuj; -ajuk; -ajul; -ajum; -ajun; -ajuo; -ajup; -ajuq; -ajur; -ajus; -ajut; -ajuu; -ajuv; -ajuw; -ajux; -ajuy; -ajuz; -ajva; -ajvb; -ajvc; -ajvd; -ajve; -ajvf; -ajvg; -ajvh; -ajvi; -ajvj; -ajvk; -ajvl; -ajvm; -ajvn; -ajvo; -ajvp; -ajvq; -ajvr; -ajvs; -ajvt; -ajvu; -ajvv; -ajvw; -ajvx; -ajvy; -ajvz; -ajwa; -ajwb; -ajwc; -ajwd; -ajwe; -ajwf; -ajwg; -ajwh; -ajwi; -ajwj; -ajwk; -ajwl; -ajwm; -ajwn; -ajwo; -ajwp; -ajwq; -ajwr; -ajws; -ajwt; -ajwu; -ajwv; -ajww; -ajwx; -ajwy; -ajwz; -ajxa; -ajxb; -ajxc; -ajxd; -ajxe; -ajxf; -ajxg; -ajxh; -ajxi; -ajxj; -ajxk; -ajxl; -ajxm; -ajxn; -ajxo; -ajxp; -ajxq; -ajxr; -ajxs; -ajxt; -ajxu; -ajxv; -ajxw; -ajxx; -ajxy; -ajxz; -ajya; -ajyb; -ajyc; -ajyd; -ajye; -ajyf; -ajyg; -ajyh; -ajyi; -ajyj; -ajyk; -ajyl; -ajym; -ajyn; -ajyo; -ajyp; -ajyq; -ajyr; -ajys; -ajyt; -ajyu; -ajyv; -ajyw; -ajyx; -ajyy; -ajyz; -ajza; -ajzb; -ajzc; -ajzd; -ajze; -ajzf; -ajzg; -ajzh; -ajzi; -ajzj; -ajzk; -ajzl; -ajzm; -ajzn; -ajzo; -ajzp; -ajzq; -ajzr; -ajzs; -ajzt; -ajzu; -ajzv; -ajzw; -ajzx; -ajzy; -ajzz; -akaa; -akab; -akac; -akad; -akae; -akaf; -akag; -akah; -akai; -akaj; -akak; -akal; -akam; -akan; -akao; -akap; -akaq; -akar; -akas; -akat; -akau; -akav; -akaw; -akax; -akay; -akaz; -akba; -akbb; -akbc; -akbd; -akbe; -akbf; -akbg; -akbh; -akbi; -akbj; -akbk; -akbl; -akbm; -akbn; -akbo; -akbp; -akbq; -akbr; -akbs; -akbt; -akbu; -akbv; -akbw; -akbx; -akby; -akbz; -akca; -akcb; -akcc; -akcd; -akce; -akcf; -akcg; -akch; -akci; -akcj; -akck; -akcl; -akcm; -akcn; -akco; -akcp; -akcq; -akcr; -akcs; -akct; -akcu; -akcv; -akcw; -akcx; -akcy; -akcz; -akda; -akdb; -akdc; -akdd; -akde; -akdf; -akdg; -akdh; -akdi; -akdj; -akdk; -akdl; -akdm; -akdn; -akdo; -akdp; -akdq; -akdr; -akds; -akdt; -akdu; -akdv; -akdw; -akdx; -akdy; -akdz; -akea; -akeb; -akec; -aked; -akee; -akef; -akeg; -akeh; -akei; -akej; -akek; -akel; -akem; -aken; -akeo; -akep; -akeq; -aker; -akes; -aket; -akeu; -akev; -akew; -akex; -akey; -akez; -akfa; -akfb; -akfc; -akfd; -akfe; -akff; -akfg; -akfh; -akfi; -akfj; -akfk; -akfl; -akfm; -akfn; -akfo; -akfp; -akfq; -akfr; -akfs; -akft; -akfu; -akfv; -akfw; -akfx; -akfy; -akfz; -akga; -akgb; -akgc; -akgd; -akge; -akgf; -akgg; -akgh; -akgi; -akgj; -akgk; -akgl; -akgm; -akgn; -akgo; -akgp; -akgq; -akgr; -akgs; -akgt; -akgu; -akgv; -akgw; -akgx; -akgy; -akgz; -akha; -akhb; -akhc; -akhd; -akhe; -akhf; -akhg; -akhh; -akhi; -akhj; -akhk; -akhl; -akhm; -akhn; -akho; -akhp; -akhq; -akhr; -akhs; -akht; -akhu; -akhv; -akhw; -akhx; -akhy; -akhz; -akia; -akib; -akic; -akid; -akie; -akif; -akig; -akih; -akii; -akij; -akik; -akil; -akim; -akin; -akio; -akip; -akiq; -akir; -akis; -akit; -akiu; -akiv; -akiw; -akix; -akiy; -akiz; -akja; -akjb; -akjc; -akjd; -akje; -akjf; -akjg; -akjh; -akji; -akjj; -akjk; -akjl; -akjm; -akjn; -akjo; -akjp; -akjq; -akjr; -akjs; -akjt; -akju; -akjv; -akjw; -akjx; -akjy; -akjz; -akka; -akkb; -akkc; -akkd; -akke; -akkf; -akkg; -akkh; -akki; -akkj; -akkk; -akkl; -akkm; -akkn; -akko; -akkp; -akkq; -akkr; -akks; -akkt; -akku; -akkv; -akkw; -akkx; -akky; -akkz; -akla; -aklb; -aklc; -akld; -akle; -aklf; -aklg; -aklh; -akli; -aklj; -aklk; -akll; -aklm; -akln; -aklo; -aklp; -aklq; -aklr; -akls; -aklt; -aklu; -aklv; -aklw; -aklx; -akly; -aklz; -akma; -akmb; -akmc; -akmd; -akme; -akmf; -akmg; -akmh; -akmi; -akmj; -akmk; -akml; -akmm; -akmn; -akmo; -akmp; -akmq; -akmr; -akms; -akmt; -akmu; -akmv; -akmw; -akmx; -akmy; -akmz; -akna; -aknb; -aknc; -aknd; -akne; -aknf; -akng; -aknh; -akni; -aknj; -aknk; -aknl; -aknm; -aknn; -akno; -aknp; -aknq; -aknr; -akns; -aknt; -aknu; -aknv; -aknw; -aknx; -akny; -aknz; -akoa; -akob; -akoc; -akod; -akoe; -akof; -akog; -akoh; -akoi; -akoj; -akok; -akol; -akom; -akon; -akoo; -akop; -akoq; -akor; -akos; -akot; -akou; -akov; -akow; -akox; -akoy; -akoz; -akpa; -akpb; -akpc; -akpd; -akpe; -akpf; -akpg; -akph; -akpi; -akpj; -akpk; -akpl; -akpm; -akpn; -akpo; -akpp; -akpq; -akpr; -akps; -akpt; -akpu; -akpv; -akpw; -akpx; -akpy; -akpz; -akqa; -akqb; -akqc; -akqd; -akqe; -akqf; -akqg; -akqh; -akqi; -akqj; -akqk; -akql; -akqm; -akqn; -akqo; -akqp; -akqq; -akqr; -akqs; -akqt; -akqu; -akqv; -akqw; -akqx; -akqy; -akqz; -akra; -akrb; -akrc; -akrd; -akre; -akrf; -akrg; -akrh; -akri; -akrj; -akrk; -akrl; -akrm; -akrn; -akro; -akrp; -akrq; -akrr; -akrs; -akrt; -akru; -akrv; -akrw; -akrx; -akry; -akrz; -aksa; -aksb; -aksc; -aksd; -akse; -aksf; -aksg; -aksh; -aksi; -aksj; -aksk; -aksl; -aksm; -aksn; -akso; -aksp; -aksq; -aksr; -akss; -akst; -aksu; -aksv; -aksw; -aksx; -aksy; -aksz; -akta; -aktb; -aktc; -aktd; -akte; -aktf; -aktg; -akth; -akti; -aktj; -aktk; -aktl; -aktm; -aktn; -akto; -aktp; -aktq; -aktr; -akts; -aktt; -aktu; -aktv; -aktw; -aktx; -akty; -aktz; -akua; -akub; -akuc; -akud; -akue; -akuf; -akug; -akuh; -akui; -akuj; -akuk; -akul; -akum; -akun; -akuo; -akup; -akuq; -akur; -akus; -akut; -akuu; -akuv; -akuw; -akux; -akuy; -akuz; -akva; -akvb; -akvc; -akvd; -akve; -akvf; -akvg; -akvh; -akvi; -akvj; -akvk; -akvl; -akvm; -akvn; -akvo; -akvp; -akvq; -akvr; -akvs; -akvt; -akvu; -akvv; -akvw; -akvx; -akvy; -akvz; -akwa; -akwb; -akwc; -akwd; -akwe; -akwf; -akwg; -akwh; -akwi; -akwj; -akwk; -akwl; -akwm; -akwn; -akwo; -akwp; -akwq; -akwr; -akws; -akwt; -akwu; -akwv; -akww; -akwx; -akwy; -akwz; -akxa; -akxb; -akxc; -akxd; -akxe; -akxf; -akxg; -akxh; -akxi; -akxj; -akxk; -akxl; -akxm; -akxn; -akxo; -akxp; -akxq; -akxr; -akxs; -akxt; -akxu; -akxv; -akxw; -akxx; -akxy; -akxz; -akya; -akyb; -akyc; -akyd; -akye; -akyf; -akyg; -akyh; -akyi; -akyj; -akyk; -akyl; -akym; -akyn; -akyo; -akyp; -akyq; -akyr; -akys; -akyt; -akyu; -akyv; -akyw; -akyx; -akyy; -akyz; -akza; -akzb; -akzc; -akzd; -akze; -akzf; -akzg; -akzh; -akzi; -akzj; -akzk; -akzl; -akzm; -akzn; -akzo; -akzp; -akzq; -akzr; -akzs; -akzt; -akzu; -akzv; -akzw; -akzx; -akzy; -akzz; -alaa; -alab; -alac; -alad; -alae; -alaf; -alag; -alah; -alai; -alaj; -alak; -alal; -alam; -alan; -alao; -alap; -alaq; -alar; -alas; -alat; -alau; -alav; -alaw; -alax; -alay; -alaz; -alba; -albb; -albc; -albd; -albe; -albf; -albg; -albh; -albi; -albj; -albk; -albl; -albm; -albn; -albo; -albp; -albq; -albr; -albs; -albt; -albu; -albv; -albw; -albx; -alby; -albz; -alca; -alcb; -alcc; -alcd; -alce; -alcf; -alcg; -alch; -alci; -alcj; -alck; -alcl; -alcm; -alcn; -alco; -alcp; -alcq; -alcr; -alcs; -alct; -alcu; -alcv; -alcw; -alcx; -alcy; -alcz; -alda; -aldb; -aldc; -aldd; -alde; -aldf; -aldg; -aldh; -aldi; -aldj; -aldk; -aldl; -aldm; -aldn; -aldo; -aldp; -aldq; -aldr; -alds; -aldt; -aldu; -aldv; -aldw; -aldx; -aldy; -aldz; -alea; -aleb; -alec; -aled; -alee; -alef; -aleg; -aleh; -alei; -alej; -alek; -alel; -alem; -alen; -aleo; -alep; -aleq; -aler; -ales; -alet; -aleu; -alev; -alew; -alex; -aley; -alez; -alfa; -alfb; -alfc; -alfd; -alfe; -alff; -alfg; -alfh; -alfi; -alfj; -alfk; -alfl; -alfm; -alfn; -alfo; -alfp; -alfq; -alfr; -alfs; -alft; -alfu; -alfv; -alfw; -alfx; -alfy; -alfz; -alga; -algb; -algc; -algd; -alge; -algf; -algg; -algh; -algi; -algj; -algk; -algl; -algm; -algn; -algo; -algp; -algq; -algr; -algs; -algt; -algu; -algv; -algw; -algx; -algy; -algz; -alha; -alhb; -alhc; -alhd; -alhe; -alhf; -alhg; -alhh; -alhi; -alhj; -alhk; -alhl; -alhm; -alhn; -alho; -alhp; -alhq; -alhr; -alhs; -alht; -alhu; -alhv; -alhw; -alhx; -alhy; -alhz; -alia; -alib; -alic; -alid; -alie; -alif; -alig; -alih; -alii; -alij; -alik; -alil; -alim; -alin; -alio; -alip; -aliq; -alir; -alis; -alit; -aliu; -aliv; -aliw; -alix; -aliy; -aliz; -alja; -aljb; -aljc; -aljd; -alje; -aljf; -aljg; -aljh; -alji; -aljj; -aljk; -aljl; -aljm; -aljn; -aljo; -aljp; -aljq; -aljr; -aljs; -aljt; -alju; -aljv; -aljw; -aljx; -aljy; -aljz; -alka; -alkb; -alkc; -alkd; -alke; -alkf; -alkg; -alkh; -alki; -alkj; -alkk; -alkl; -alkm; -alkn; -alko; -alkp; -alkq; -alkr; -alks; -alkt; -alku; -alkv; -alkw; -alkx; -alky; -alkz; -alla; -allb; -allc; -alld; -alle; -allf; -allg; -allh; -alli; -allj; -allk; -alll; -allm; -alln; -allo; -allp; -allq; -allr; -alls; -allt; -allu; -allv; -allw; -allx; -ally; -allz; -alma; -almb; -almc; -almd; -alme; -almf; -almg; -almh; -almi; -almj; -almk; -alml; -almm; -almn; -almo; -almp; -almq; -almr; -alms; -almt; -almu; -almv; -almw; -almx; -almy; -almz; -alna; -alnb; -alnc; -alnd; -alne; -alnf; -alng; -alnh; -alni; -alnj; -alnk; -alnl; -alnm; -alnn; -alno; -alnp; -alnq; -alnr; -alns; -alnt; -alnu; -alnv; -alnw; -alnx; -alny; -alnz; -aloa; -alob; -aloc; -alod; -aloe; -alof; -alog; -aloh; -aloi; -aloj; -alok; -alol; -alom; -alon; -aloo; -alop; -aloq; -alor; -alos; -alot; -alou; -alov; -alow; -alox; -aloy; -aloz; -alpa; -alpb; -alpc; -alpd; -alpe; -alpf; -alpg; -alph; -alpi; -alpj; -alpk; -alpl; -alpm; -alpn; -alpo; -alpp; -alpq; -alpr; -alps; -alpt; -alpu; -alpv; -alpw; -alpx; -alpy; -alpz; -alqa; -alqb; -alqc; -alqd; -alqe; -alqf; -alqg; -alqh; -alqi; -alqj; -alqk; -alql; -alqm; -alqn; -alqo; -alqp; -alqq; -alqr; -alqs; -alqt; -alqu; -alqv; -alqw; -alqx; -alqy; -alqz; -alra; -alrb; -alrc; -alrd; -alre; -alrf; -alrg; -alrh; -alri; -alrj; -alrk; -alrl; -alrm; -alrn; -alro; -alrp; -alrq; -alrr; -alrs; -alrt; -alru; -alrv; -alrw; -alrx; -alry; -alrz; -alsa; -alsb; -alsc; -alsd; -alse; -alsf; -alsg; -alsh; -alsi; -alsj; -alsk; -alsl; -alsm; -alsn; -also; -alsp; -alsq; -alsr; -alss; -alst; -alsu; -alsv; -alsw; -alsx; -alsy; -alsz; -alta; -altb; -altc; -altd; -alte; -altf; -altg; -alth; -alti; -altj; -altk; -altl; -altm; -altn; -alto; -altp; -altq; -altr; -alts; -altt; -altu; -altv; -altw; -altx; -alty; -altz; -alua; -alub; -aluc; -alud; -alue; -aluf; -alug; -aluh; -alui; -aluj; -aluk; -alul; -alum; -alun; -aluo; -alup; -aluq; -alur; -alus; -alut; -aluu; -aluv; -aluw; -alux; -aluy; -aluz; -alva; -alvb; -alvc; -alvd; -alve; -alvf; -alvg; -alvh; -alvi; -alvj; -alvk; -alvl; -alvm; -alvn; -alvo; -alvp; -alvq; -alvr; -alvs; -alvt; -alvu; -alvv; -alvw; -alvx; -alvy; -alvz; -alwa; -alwb; -alwc; -alwd; -alwe; -alwf; -alwg; -alwh; -alwi; -alwj; -alwk; -alwl; -alwm; -alwn; -alwo; -alwp; -alwq; -alwr; -alws; -alwt; -alwu; -alwv; -alww; -alwx; -alwy; -alwz; -alxa; -alxb; -alxc; -alxd; -alxe; -alxf; -alxg; -alxh; -alxi; -alxj; -alxk; -alxl; -alxm; -alxn; -alxo; -alxp; -alxq; -alxr; -alxs; -alxt; -alxu; -alxv; -alxw; -alxx; -alxy; -alxz; -alya; -alyb; -alyc; -alyd; -alye; -alyf; -alyg; -alyh; -alyi; -alyj; -alyk; -alyl; -alym; -alyn; -alyo; -alyp; -alyq; -alyr; -alys; -alyt; -alyu; -alyv; -alyw; -alyx; -alyy; -alyz; -alza; -alzb; -alzc; -alzd; -alze; -alzf; -alzg; -alzh; -alzi; -alzj; -alzk; -alzl; -alzm; -alzn; -alzo; -alzp; -alzq; -alzr; -alzs; -alzt; -alzu; -alzv; -alzw; -alzx; -alzy; -alzz; -amaa; -amab; -amac; -amad; -amae; -amaf; -amag; -amah; -amai; -amaj; -amak; -amal; -amam; -aman; -amao; -amap; -amaq; -amar; -amas; -amat; -amau; -amav; -amaw; -amax; -amay; -amaz; -amba; -ambb; -ambc; -ambd; -ambe; -ambf; -ambg; -ambh; -ambi; -ambj; -ambk; -ambl; -ambm; -ambn; -ambo; -ambp; -ambq; -ambr; -ambs; -ambt; -ambu; -ambv; -ambw; -ambx; -amby; -ambz; -amca; -amcb; -amcc; -amcd; -amce; -amcf; -amcg; -amch; -amci; -amcj; -amck; -amcl; -amcm; -amcn; -amco; -amcp; -amcq; -amcr; -amcs; -amct; -amcu; -amcv; -amcw; -amcx; -amcy; -amcz; -amda; -amdb; -amdc; -amdd; -amde; -amdf; -amdg; -amdh; -amdi; -amdj; -amdk; -amdl; -amdm; -amdn; -amdo; -amdp; -amdq; -amdr; -amds; -amdt; -amdu; -amdv; -amdw; -amdx; -amdy; -amdz; -amea; -ameb; -amec; -amed; -amee; -amef; -ameg; -ameh; -amei; -amej; -amek; -amel; -amem; -amen; -ameo; -amep; -ameq; -amer; -ames; -amet; -ameu; -amev; -amew; -amex; -amey; -amez; -amfa; -amfb; -amfc; -amfd; -amfe; -amff; -amfg; -amfh; -amfi; -amfj; -amfk; -amfl; -amfm; -amfn; -amfo; -amfp; -amfq; -amfr; -amfs; -amft; -amfu; -amfv; -amfw; -amfx; -amfy; -amfz; -amga; -amgb; -amgc; -amgd; -amge; -amgf; -amgg; -amgh; -amgi; -amgj; -amgk; -amgl; -amgm; -amgn; -amgo; -amgp; -amgq; -amgr; -amgs; -amgt; -amgu; -amgv; -amgw; -amgx; -amgy; -amgz; -amha; -amhb; -amhc; -amhd; -amhe; -amhf; -amhg; -amhh; -amhi; -amhj; -amhk; -amhl; -amhm; -amhn; -amho; -amhp; -amhq; -amhr; -amhs; -amht; -amhu; -amhv; -amhw; -amhx; -amhy; -amhz; -amia; -amib; -amic; -amid; -amie; -amif; -amig; -amih; -amii; -amij; -amik; -amil; -amim; -amin; -amio; -amip; -amiq; -amir; -amis; -amit; -amiu; -amiv; -amiw; -amix; -amiy; -amiz; -amja; -amjb; -amjc; -amjd; -amje; -amjf; -amjg; -amjh; -amji; -amjj; -amjk; -amjl; -amjm; -amjn; -amjo; -amjp; -amjq; -amjr; -amjs; -amjt; -amju; -amjv; -amjw; -amjx; -amjy; -amjz; -amka; -amkb; -amkc; -amkd; -amke; -amkf; -amkg; -amkh; -amki; -amkj; -amkk; -amkl; -amkm; -amkn; -amko; -amkp; -amkq; -amkr; -amks; -amkt; -amku; -amkv; -amkw; -amkx; -amky; -amkz; -amla; -amlb; -amlc; -amld; -amle; -amlf; -amlg; -amlh; -amli; -amlj; -amlk; -amll; -amlm; -amln; -amlo; -amlp; -amlq; -amlr; -amls; -amlt; -amlu; -amlv; -amlw; -amlx; -amly; -amlz; -amma; -ammb; -ammc; -ammd; -amme; -ammf; -ammg; -ammh; -ammi; -ammj; -ammk; -amml; -ammm; -ammn; -ammo; -ammp; -ammq; -ammr; -amms; -ammt; -ammu; -ammv; -ammw; -ammx; -ammy; -ammz; -amna; -amnb; -amnc; -amnd; -amne; -amnf; -amng; -amnh; -amni; -amnj; -amnk; -amnl; -amnm; -amnn; -amno; -amnp; -amnq; -amnr; -amns; -amnt; -amnu; -amnv; -amnw; -amnx; -amny; -amnz; -amoa; -amob; -amoc; -amod; -amoe; -amof; -amog; -amoh; -amoi; -amoj; -amok; -amol; -amom; -amon; -amoo; -amop; -amoq; -amor; -amos; -amot; -amou; -amov; -amow; -amox; -amoy; -amoz; -ampa; -ampb; -ampc; -ampd; -ampe; -ampf; -ampg; -amph; -ampi; -ampj; -ampk; -ampl; -ampm; -ampn; -ampo; -ampp; -ampq; -ampr; -amps; -ampt; -ampu; -ampv; -ampw; -ampx; -ampy; -ampz; -amqa; -amqb; -amqc; -amqd; -amqe; -amqf; -amqg; -amqh; -amqi; -amqj; -amqk; -amql; -amqm; -amqn; -amqo; -amqp; -amqq; -amqr; -amqs; -amqt; -amqu; -amqv; -amqw; -amqx; -amqy; -amqz; -amra; -amrb; -amrc; -amrd; -amre; -amrf; -amrg; -amrh; -amri; -amrj; -amrk; -amrl; -amrm; -amrn; -amro; -amrp; -amrq; -amrr; -amrs; -amrt; -amru; -amrv; -amrw; -amrx; -amry; -amrz; -amsa; -amsb; -amsc; -amsd; -amse; -amsf; -amsg; -amsh; -amsi; -amsj; -amsk; -amsl; -amsm; -amsn; -amso; -amsp; -amsq; -amsr; -amss; -amst; -amsu; -amsv; -amsw; -amsx; -amsy; -amsz; -amta; -amtb; -amtc; -amtd; -amte; -amtf; -amtg; -amth; -amti; -amtj; -amtk; -amtl; -amtm; -amtn; -amto; -amtp; -amtq; -amtr; -amts; -amtt; -amtu; -amtv; -amtw; -amtx; -amty; -amtz; -amua; -amub; -amuc; -amud; -amue; -amuf; -amug; -amuh; -amui; -amuj; -amuk; -amul; -amum; -amun; -amuo; -amup; -amuq; -amur; -amus; -amut; -amuu; -amuv; -amuw; -amux; -amuy; -amuz; -amva; -amvb; -amvc; -amvd; -amve; -amvf; -amvg; -amvh; -amvi; -amvj; -amvk; -amvl; -amvm; -amvn; -amvo; -amvp; -amvq; -amvr; -amvs; -amvt; -amvu; -amvv; -amvw; -amvx; -amvy; -amvz; -amwa; -amwb; -amwc; -amwd; -amwe; -amwf; -amwg; -amwh; -amwi; -amwj; -amwk; -amwl; -amwm; -amwn; -amwo; -amwp; -amwq; -amwr; -amws; -amwt; -amwu; -amwv; -amww; -amwx; -amwy; -amwz; -amxa; -amxb; -amxc; -amxd; -amxe; -amxf; -amxg; -amxh; -amxi; -amxj; -amxk; -amxl; -amxm; -amxn; -amxo; -amxp; -amxq; -amxr; -amxs; -amxt; -amxu; -amxv; -amxw; -amxx; -amxy; -amxz; -amya; -amyb; -amyc; -amyd; -amye; -amyf; -amyg; -amyh; -amyi; -amyj; -amyk; -amyl; -amym; -amyn; -amyo; -amyp; -amyq; -amyr; -amys; -amyt; -amyu; -amyv; -amyw; -amyx; -amyy; -amyz; -amza; -amzb; -amzc; -amzd; -amze; -amzf; -amzg; -amzh; -amzi; -amzj; -amzk; -amzl; -amzm; -amzn; -amzo; -amzp; -amzq; -amzr; -amzs; -amzt; -amzu; -amzv; -amzw; -amzx; -amzy; -amzz; -anaa; -anab; -anac; -anad; -anae; -anaf; -anag; -anah; -anai; -anaj; -anak; -anal; -anam; -anan; -anao; -anap; -anaq; -anar; -anas; -anat; -anau; -anav; -anaw; -anax; -anay; -anaz; -anba; -anbb; -anbc; -anbd; -anbe; -anbf; -anbg; -anbh; -anbi; -anbj; -anbk; -anbl; -anbm; -anbn; -anbo; -anbp; -anbq; -anbr; -anbs; -anbt; -anbu; -anbv; -anbw; -anbx; -anby; -anbz; -anca; -ancb; -ancc; -ancd; -ance; -ancf; -ancg; -anch; -anci; -ancj; -anck; -ancl; -ancm; -ancn; -anco; -ancp; -ancq; -ancr; -ancs; -anct; -ancu; -ancv; -ancw; -ancx; -ancy; -ancz; -anda; -andb; -andc; -andd; -ande; -andf; -andg; -andh; -andi; -andj; -andk; -andl; -andm; -andn; -ando; -andp; -andq; -andr; -ands; -andt; -andu; -andv; -andw; -andx; -andy; -andz; -anea; -aneb; -anec; -aned; -anee; -anef; -aneg; -aneh; -anei; -anej; -anek; -anel; -anem; -anen; -aneo; -anep; -aneq; -aner; -anes; -anet; -aneu; -anev; -anew; -anex; -aney; -anez; -anfa; -anfb; -anfc; -anfd; -anfe; -anff; -anfg; -anfh; -anfi; -anfj; -anfk; -anfl; -anfm; -anfn; -anfo; -anfp; -anfq; -anfr; -anfs; -anft; -anfu; -anfv; -anfw; -anfx; -anfy; -anfz; -anga; -angb; -angc; -angd; -ange; -angf; -angg; -angh; -angi; -angj; -angk; -angl; -angm; -angn; -ango; -angp; -angq; -angr; -angs; -angt; -angu; -angv; -angw; -angx; -angy; -angz; -anha; -anhb; -anhc; -anhd; -anhe; -anhf; -anhg; -anhh; -anhi; -anhj; -anhk; -anhl; -anhm; -anhn; -anho; -anhp; -anhq; -anhr; -anhs; -anht; -anhu; -anhv; -anhw; -anhx; -anhy; -anhz; -ania; -anib; -anic; -anid; -anie; -anif; -anig; -anih; -anii; -anij; -anik; -anil; -anim; -anin; -anio; -anip; -aniq; -anir; -anis; -anit; -aniu; -aniv; -aniw; -anix; -aniy; -aniz; -anja; -anjb; -anjc; -anjd; -anje; -anjf; -anjg; -anjh; -anji; -anjj; -anjk; -anjl; -anjm; -anjn; -anjo; -anjp; -anjq; -anjr; -anjs; -anjt; -anju; -anjv; -anjw; -anjx; -anjy; -anjz; -anka; -ankb; -ankc; -ankd; -anke; -ankf; -ankg; -ankh; -anki; -ankj; -ankk; -ankl; -ankm; -ankn; -anko; -ankp; -ankq; -ankr; -anks; -ankt; -anku; -ankv; -ankw; -ankx; -anky; -ankz; -anla; -anlb; -anlc; -anld; -anle; -anlf; -anlg; -anlh; -anli; -anlj; -anlk; -anll; -anlm; -anln; -anlo; -anlp; -anlq; -anlr; -anls; -anlt; -anlu; -anlv; -anlw; -anlx; -anly; -anlz; -anma; -anmb; -anmc; -anmd; -anme; -anmf; -anmg; -anmh; -anmi; -anmj; -anmk; -anml; -anmm; -anmn; -anmo; -anmp; -anmq; -anmr; -anms; -anmt; -anmu; -anmv; -anmw; -anmx; -anmy; -anmz; -anna; -annb; -annc; -annd; -anne; -annf; -anng; -annh; -anni; -annj; -annk; -annl; -annm; -annn; -anno; -annp; -annq; -annr; -anns; -annt; -annu; -annv; -annw; -annx; -anny; -annz; -anoa; -anob; -anoc; -anod; -anoe; -anof; -anog; -anoh; -anoi; -anoj; -anok; -anol; -anom; -anon; -anoo; -anop; -anoq; -anor; -anos; -anot; -anou; -anov; -anow; -anox; -anoy; -anoz; -anpa; -anpb; -anpc; -anpd; -anpe; -anpf; -anpg; -anph; -anpi; -anpj; -anpk; -anpl; -anpm; -anpn; -anpo; -anpp; -anpq; -anpr; -anps; -anpt; -anpu; -anpv; -anpw; -anpx; -anpy; -anpz; -anqa; -anqb; -anqc; -anqd; -anqe; -anqf; -anqg; -anqh; -anqi; -anqj; -anqk; -anql; -anqm; -anqn; -anqo; -anqp; -anqq; -anqr; -anqs; -anqt; -anqu; -anqv; -anqw; -anqx; -anqy; -anqz; -anra; -anrb; -anrc; -anrd; -anre; -anrf; -anrg; -anrh; -anri; -anrj; -anrk; -anrl; -anrm; -anrn; -anro; -anrp; -anrq; -anrr; -anrs; -anrt; -anru; -anrv; -anrw; -anrx; -anry; -anrz; -ansa; -ansb; -ansc; -ansd; -anse; -ansf; -ansg; -ansh; -ansi; -ansj; -ansk; -ansl; -ansm; -ansn; -anso; -ansp; -ansq; -ansr; -anss; -anst; -ansu; -ansv; -answ; -ansx; -ansy; -ansz; -anta; -antb; -antc; -antd; -ante; -antf; -antg; -anth; -anti; -antj; -antk; -antl; -antm; -antn; -anto; -antp; -antq; -antr; -ants; -antt; -antu; -antv; -antw; -antx; -anty; -antz; -anua; -anub; -anuc; -anud; -anue; -anuf; -anug; -anuh; -anui; -anuj; -anuk; -anul; -anum; -anun; -anuo; -anup; -anuq; -anur; -anus; -anut; -anuu; -anuv; -anuw; -anux; -anuy; -anuz; -anva; -anvb; -anvc; -anvd; -anve; -anvf; -anvg; -anvh; -anvi; -anvj; -anvk; -anvl; -anvm; -anvn; -anvo; -anvp; -anvq; -anvr; -anvs; -anvt; -anvu; -anvv; -anvw; -anvx; -anvy; -anvz; -anwa; -anwb; -anwc; -anwd; -anwe; -anwf; -anwg; -anwh; -anwi; -anwj; -anwk; -anwl; -anwm; -anwn; -anwo; -anwp; -anwq; -anwr; -anws; -anwt; -anwu; -anwv; -anww; -anwx; -anwy; -anwz; -anxa; -anxb; -anxc; -anxd; -anxe; -anxf; -anxg; -anxh; -anxi; -anxj; -anxk; -anxl; -anxm; -anxn; -anxo; -anxp; -anxq; -anxr; -anxs; -anxt; -anxu; -anxv; -anxw; -anxx; -anxy; -anxz; -anya; -anyb; -anyc; -anyd; -anye; -anyf; -anyg; -anyh; -anyi; -anyj; -anyk; -anyl; -anym; -anyn; -anyo; -anyp; -anyq; -anyr; -anys; -anyt; -anyu; -anyv; -anyw; -anyx; -anyy; -anyz; -anza; -anzb; -anzc; -anzd; -anze; -anzf; -anzg; -anzh; -anzi; -anzj; -anzk; -anzl; -anzm; -anzn; -anzo; -anzp; -anzq; -anzr; -anzs; -anzt; -anzu; -anzv; -anzw; -anzx; -anzy; -anzz; -aoaa; -aoab; -aoac; -aoad; -aoae; -aoaf; -aoag; -aoah; -aoai; -aoaj; -aoak; -aoal; -aoam; -aoan; -aoao; -aoap; -aoaq; -aoar; -aoas; -aoat; -aoau; -aoav; -aoaw; -aoax; -aoay; -aoaz; -aoba; -aobb; -aobc; -aobd; -aobe; -aobf; -aobg; -aobh; -aobi; -aobj; -aobk; -aobl; -aobm; -aobn; -aobo; -aobp; -aobq; -aobr; -aobs; -aobt; -aobu; -aobv; -aobw; -aobx; -aoby; -aobz; -aoca; -aocb; -aocc; -aocd; -aoce; -aocf; -aocg; -aoch; -aoci; -aocj; -aock; -aocl; -aocm; -aocn; -aoco; -aocp; -aocq; -aocr; -aocs; -aoct; -aocu; -aocv; -aocw; -aocx; -aocy; -aocz; -aoda; -aodb; -aodc; -aodd; -aode; -aodf; -aodg; -aodh; -aodi; -aodj; -aodk; -aodl; -aodm; -aodn; -aodo; -aodp; -aodq; -aodr; -aods; -aodt; -aodu; -aodv; -aodw; -aodx; -aody; -aodz; -aoea; -aoeb; -aoec; -aoed; -aoee; -aoef; -aoeg; -aoeh; -aoei; -aoej; -aoek; -aoel; -aoem; -aoen; -aoeo; -aoep; -aoeq; -aoer; -aoes; -aoet; -aoeu; -aoev; -aoew; -aoex; -aoey; -aoez; -aofa; -aofb; -aofc; -aofd; -aofe; -aoff; -aofg; -aofh; -aofi; -aofj; -aofk; -aofl; -aofm; -aofn; -aofo; -aofp; -aofq; -aofr; -aofs; -aoft; -aofu; -aofv; -aofw; -aofx; -aofy; -aofz; -aoga; -aogb; -aogc; -aogd; -aoge; -aogf; -aogg; -aogh; -aogi; -aogj; -aogk; -aogl; -aogm; -aogn; -aogo; -aogp; -aogq; -aogr; -aogs; -aogt; -aogu; -aogv; -aogw; -aogx; -aogy; -aogz; -aoha; -aohb; -aohc; -aohd; -aohe; -aohf; -aohg; -aohh; -aohi; -aohj; -aohk; -aohl; -aohm; -aohn; -aoho; -aohp; -aohq; -aohr; -aohs; -aoht; -aohu; -aohv; -aohw; -aohx; -aohy; -aohz; -aoia; -aoib; -aoic; -aoid; -aoie; -aoif; -aoig; -aoih; -aoii; -aoij; -aoik; -aoil; -aoim; -aoin; -aoio; -aoip; -aoiq; -aoir; -aois; -aoit; -aoiu; -aoiv; -aoiw; -aoix; -aoiy; -aoiz; -aoja; -aojb; -aojc; -aojd; -aoje; -aojf; -aojg; -aojh; -aoji; -aojj; -aojk; -aojl; -aojm; -aojn; -aojo; -aojp; -aojq; -aojr; -aojs; -aojt; -aoju; -aojv; -aojw; -aojx; -aojy; -aojz; -aoka; -aokb; -aokc; -aokd; -aoke; -aokf; -aokg; -aokh; -aoki; -aokj; -aokk; -aokl; -aokm; -aokn; -aoko; -aokp; -aokq; -aokr; -aoks; -aokt; -aoku; -aokv; -aokw; -aokx; -aoky; -aokz; -aola; -aolb; -aolc; -aold; -aole; -aolf; -aolg; -aolh; -aoli; -aolj; -aolk; -aoll; -aolm; -aoln; -aolo; -aolp; -aolq; -aolr; -aols; -aolt; -aolu; -aolv; -aolw; -aolx; -aoly; -aolz; -aoma; -aomb; -aomc; -aomd; -aome; -aomf; -aomg; -aomh; -aomi; -aomj; -aomk; -aoml; -aomm; -aomn; -aomo; -aomp; -aomq; -aomr; -aoms; -aomt; -aomu; -aomv; -aomw; -aomx; -aomy; -aomz; -aona; -aonb; -aonc; -aond; -aone; -aonf; -aong; -aonh; -aoni; -aonj; -aonk; -aonl; -aonm; -aonn; -aono; -aonp; -aonq; -aonr; -aons; -aont; -aonu; -aonv; -aonw; -aonx; -aony; -aonz; -aooa; -aoob; -aooc; -aood; -aooe; -aoof; -aoog; -aooh; -aooi; -aooj; -aook; -aool; -aoom; -aoon; -aooo; -aoop; -aooq; -aoor; -aoos; -aoot; -aoou; -aoov; -aoow; -aoox; -aooy; -aooz; -aopa; -aopb; -aopc; -aopd; -aope; -aopf; -aopg; -aoph; -aopi; -aopj; -aopk; -aopl; -aopm; -aopn; -aopo; -aopp; -aopq; -aopr; -aops; -aopt; -aopu; -aopv; -aopw; -aopx; -aopy; -aopz; -aoqa; -aoqb; -aoqc; -aoqd; -aoqe; -aoqf; -aoqg; -aoqh; -aoqi; -aoqj; -aoqk; -aoql; -aoqm; -aoqn; -aoqo; -aoqp; -aoqq; -aoqr; -aoqs; -aoqt; -aoqu; -aoqv; -aoqw; -aoqx; -aoqy; -aoqz; -aora; -aorb; -aorc; -aord; -aore; -aorf; -aorg; -aorh; -aori; -aorj; -aork; -aorl; -aorm; -aorn; -aoro; -aorp; -aorq; -aorr; -aors; -aort; -aoru; -aorv; -aorw; -aorx; -aory; -aorz; -aosa; -aosb; -aosc; -aosd; -aose; -aosf; -aosg; -aosh; -aosi; -aosj; -aosk; -aosl; -aosm; -aosn; -aoso; -aosp; -aosq; -aosr; -aoss; -aost; -aosu; -aosv; -aosw; -aosx; -aosy; -aosz; -aota; -aotb; -aotc; -aotd; -aote; -aotf; -aotg; -aoth; -aoti; -aotj; -aotk; -aotl; -aotm; -aotn; -aoto; -aotp; -aotq; -aotr; -aots; -aott; -aotu; -aotv; -aotw; -aotx; -aoty; -aotz; -aoua; -aoub; -aouc; -aoud; -aoue; -aouf; -aoug; -aouh; -aoui; -aouj; -aouk; -aoul; -aoum; -aoun; -aouo; -aoup; -aouq; -aour; -aous; -aout; -aouu; -aouv; -aouw; -aoux; -aouy; -aouz; -aova; -aovb; -aovc; -aovd; -aove; -aovf; -aovg; -aovh; -aovi; -aovj; -aovk; -aovl; -aovm; -aovn; -aovo; -aovp; -aovq; -aovr; -aovs; -aovt; -aovu; -aovv; -aovw; -aovx; -aovy; -aovz; -aowa; -aowb; -aowc; -aowd; -aowe; -aowf; -aowg; -aowh; -aowi; -aowj; -aowk; -aowl; -aowm; -aown; -aowo; -aowp; -aowq; -aowr; -aows; -aowt; -aowu; -aowv; -aoww; -aowx; -aowy; -aowz; -aoxa; -aoxb; -aoxc; -aoxd; -aoxe; -aoxf; -aoxg; -aoxh; -aoxi; -aoxj; -aoxk; -aoxl; -aoxm; -aoxn; -aoxo; -aoxp; -aoxq; -aoxr; -aoxs; -aoxt; -aoxu; -aoxv; -aoxw; -aoxx; -aoxy; -aoxz; -aoya; -aoyb; -aoyc; -aoyd; -aoye; -aoyf; -aoyg; -aoyh; -aoyi; -aoyj; -aoyk; -aoyl; -aoym; -aoyn; -aoyo; -aoyp; -aoyq; -aoyr; -aoys; -aoyt; -aoyu; -aoyv; -aoyw; -aoyx; -aoyy; -aoyz; -aoza; -aozb; -aozc; -aozd; -aoze; -aozf; -aozg; -aozh; -aozi; -aozj; -aozk; -aozl; -aozm; -aozn; -aozo; -aozp; -aozq; -aozr; -aozs; -aozt; -aozu; -aozv; -aozw; -aozx; -aozy; -aozz; -apaa; -apab; -apac; -apad; -apae; -apaf; -apag; -apah; -apai; -apaj; -apak; -apal; -apam; -apan; -apao; -apap; -apaq; -apar; -apas; -apat; -apau; -apav; -apaw; -apax; -apay; -apaz; -apba; -apbb; -apbc; -apbd; -apbe; -apbf; -apbg; -apbh; -apbi; -apbj; -apbk; -apbl; -apbm; -apbn; -apbo; -apbp; -apbq; -apbr; -apbs; -apbt; -apbu; -apbv; -apbw; -apbx; -apby; -apbz; -apca; -apcb; -apcc; -apcd; -apce; -apcf; -apcg; -apch; -apci; -apcj; -apck; -apcl; -apcm; -apcn; -apco; -apcp; -apcq; -apcr; -apcs; -apct; -apcu; -apcv; -apcw; -apcx; -apcy; -apcz; -apda; -apdb; -apdc; -apdd; -apde; -apdf; -apdg; -apdh; -apdi; -apdj; -apdk; -apdl; -apdm; -apdn; -apdo; -apdp; -apdq; -apdr; -apds; -apdt; -apdu; -apdv; -apdw; -apdx; -apdy; -apdz; -apea; -apeb; -apec; -aped; -apee; -apef; -apeg; -apeh; -apei; -apej; -apek; -apel; -apem; -apen; -apeo; -apep; -apeq; -aper; -apes; -apet; -apeu; -apev; -apew; -apex; -apey; -apez; -apfa; -apfb; -apfc; -apfd; -apfe; -apff; -apfg; -apfh; -apfi; -apfj; -apfk; -apfl; -apfm; -apfn; -apfo; -apfp; -apfq; -apfr; -apfs; -apft; -apfu; -apfv; -apfw; -apfx; -apfy; -apfz; -apga; -apgb; -apgc; -apgd; -apge; -apgf; -apgg; -apgh; -apgi; -apgj; -apgk; -apgl; -apgm; -apgn; -apgo; -apgp; -apgq; -apgr; -apgs; -apgt; -apgu; -apgv; -apgw; -apgx; -apgy; -apgz; -apha; -aphb; -aphc; -aphd; -aphe; -aphf; -aphg; -aphh; -aphi; -aphj; -aphk; -aphl; -aphm; -aphn; -apho; -aphp; -aphq; -aphr; -aphs; -apht; -aphu; -aphv; -aphw; -aphx; -aphy; -aphz; -apia; -apib; -apic; -apid; -apie; -apif; -apig; -apih; -apii; -apij; -apik; -apil; -apim; -apin; -apio; -apip; -apiq; -apir; -apis; -apit; -apiu; -apiv; -apiw; -apix; -apiy; -apiz; -apja; -apjb; -apjc; -apjd; -apje; -apjf; -apjg; -apjh; -apji; -apjj; -apjk; -apjl; -apjm; -apjn; -apjo; -apjp; -apjq; -apjr; -apjs; -apjt; -apju; -apjv; -apjw; -apjx; -apjy; -apjz; -apka; -apkb; -apkc; -apkd; -apke; -apkf; -apkg; -apkh; -apki; -apkj; -apkk; -apkl; -apkm; -apkn; -apko; -apkp; -apkq; -apkr; -apks; -apkt; -apku; -apkv; -apkw; -apkx; -apky; -apkz; -apla; -aplb; -aplc; -apld; -aple; -aplf; -aplg; -aplh; -apli; -aplj; -aplk; -apll; -aplm; -apln; -aplo; -aplp; -aplq; -aplr; -apls; -aplt; -aplu; -aplv; -aplw; -aplx; -aply; -aplz; -apma; -apmb; -apmc; -apmd; -apme; -apmf; -apmg; -apmh; -apmi; -apmj; -apmk; -apml; -apmm; -apmn; -apmo; -apmp; -apmq; -apmr; -apms; -apmt; -apmu; -apmv; -apmw; -apmx; -apmy; -apmz; -apna; -apnb; -apnc; -apnd; -apne; -apnf; -apng; -apnh; -apni; -apnj; -apnk; -apnl; -apnm; -apnn; -apno; -apnp; -apnq; -apnr; -apns; -apnt; -apnu; -apnv; -apnw; -apnx; -apny; -apnz; -apoa; -apob; -apoc; -apod; -apoe; -apof; -apog; -apoh; -apoi; -apoj; -apok; -apol; -apom; -apon; -apoo; -apop; -apoq; -apor; -apos; -apot; -apou; -apov; -apow; -apox; -apoy; -apoz; -appa; -appb; -appc; -appd; -appe; -appf; -appg; -apph; -appi; -appj; -appk; -appl; -appm; -appn; -appo; -appp; -appq; -appr; -apps; -appt; -appu; -appv; -appw; -appx; -appy; -appz; -apqa; -apqb; -apqc; -apqd; -apqe; -apqf; -apqg; -apqh; -apqi; -apqj; -apqk; -apql; -apqm; -apqn; -apqo; -apqp; -apqq; -apqr; -apqs; -apqt; -apqu; -apqv; -apqw; -apqx; -apqy; -apqz; -apra; -aprb; -aprc; -aprd; -apre; -aprf; -aprg; -aprh; -apri; -aprj; -aprk; -aprl; -aprm; -aprn; -apro; -aprp; -aprq; -aprr; -aprs; -aprt; -apru; -aprv; -aprw; -aprx; -apry; -aprz; -apsa; -apsb; -apsc; -apsd; -apse; -apsf; -apsg; -apsh; -apsi; -apsj; -apsk; -apsl; -apsm; -apsn; -apso; -apsp; -apsq; -apsr; -apss; -apst; -apsu; -apsv; -apsw; -apsx; -apsy; -apsz; -apta; -aptb; -aptc; -aptd; -apte; -aptf; -aptg; -apth; -apti; -aptj; -aptk; -aptl; -aptm; -aptn; -apto; -aptp; -aptq; -aptr; -apts; -aptt; -aptu; -aptv; -aptw; -aptx; -apty; -aptz; -apua; -apub; -apuc; -apud; -apue; -apuf; -apug; -apuh; -apui; -apuj; -apuk; -apul; -apum; -apun; -apuo; -apup; -apuq; -apur; -apus; -aput; -apuu; -apuv; -apuw; -apux; -apuy; -apuz; -apva; -apvb; -apvc; -apvd; -apve; -apvf; -apvg; -apvh; -apvi; -apvj; -apvk; -apvl; -apvm; -apvn; -apvo; -apvp; -apvq; -apvr; -apvs; -apvt; -apvu; -apvv; -apvw; -apvx; -apvy; -apvz; -apwa; -apwb; -apwc; -apwd; -apwe; -apwf; -apwg; -apwh; -apwi; -apwj; -apwk; -apwl; -apwm; -apwn; -apwo; -apwp; -apwq; -apwr; -apws; -apwt; -apwu; -apwv; -apww; -apwx; -apwy; -apwz; -apxa; -apxb; -apxc; -apxd; -apxe; -apxf; -apxg; -apxh; -apxi; -apxj; -apxk; -apxl; -apxm; -apxn; -apxo; -apxp; -apxq; -apxr; -apxs; -apxt; -apxu; -apxv; -apxw; -apxx; -apxy; -apxz; -apya; -apyb; -apyc; -apyd; -apye; -apyf; -apyg; -apyh; -apyi; -apyj; -apyk; -apyl; -apym; -apyn; -apyo; -apyp; -apyq; -apyr; -apys; -apyt; -apyu; -apyv; -apyw; -apyx; -apyy; -apyz; -apza; -apzb; -apzc; -apzd; -apze; -apzf; -apzg; -apzh; -apzi; -apzj; -apzk; -apzl; -apzm; -apzn; -apzo; -apzp; -apzq; -apzr; -apzs; -apzt; -apzu; -apzv; -apzw; -apzx; -apzy; -apzz; -aqaa; -aqab; -aqac; -aqad; -aqae; -aqaf; -aqag; -aqah; -aqai; -aqaj; -aqak; -aqal; -aqam; -aqan; -aqao; -aqap; -aqaq; -aqar; -aqas; -aqat; -aqau; -aqav; -aqaw; -aqax; -aqay; -aqaz; -aqba; -aqbb; -aqbc; -aqbd; -aqbe; -aqbf; -aqbg; -aqbh; -aqbi; -aqbj; -aqbk; -aqbl; -aqbm; -aqbn; -aqbo; -aqbp; -aqbq; -aqbr; -aqbs; -aqbt; -aqbu; -aqbv; -aqbw; -aqbx; -aqby; -aqbz; -aqca; -aqcb; -aqcc; -aqcd; -aqce; -aqcf; -aqcg; -aqch; -aqci; -aqcj; -aqck; -aqcl; -aqcm; -aqcn; -aqco; -aqcp; -aqcq; -aqcr; -aqcs; -aqct; -aqcu; -aqcv; -aqcw; -aqcx; -aqcy; -aqcz; -aqda; -aqdb; -aqdc; -aqdd; -aqde; -aqdf; -aqdg; -aqdh; -aqdi; -aqdj; -aqdk; -aqdl; -aqdm; -aqdn; -aqdo; -aqdp; -aqdq; -aqdr; -aqds; -aqdt; -aqdu; -aqdv; -aqdw; -aqdx; -aqdy; -aqdz; -aqea; -aqeb; -aqec; -aqed; -aqee; -aqef; -aqeg; -aqeh; -aqei; -aqej; -aqek; -aqel; -aqem; -aqen; -aqeo; -aqep; -aqeq; -aqer; -aqes; -aqet; -aqeu; -aqev; -aqew; -aqex; -aqey; -aqez; -aqfa; -aqfb; -aqfc; -aqfd; -aqfe; -aqff; -aqfg; -aqfh; -aqfi; -aqfj; -aqfk; -aqfl; -aqfm; -aqfn; -aqfo; -aqfp; -aqfq; -aqfr; -aqfs; -aqft; -aqfu; -aqfv; -aqfw; -aqfx; -aqfy; -aqfz; -aqga; -aqgb; -aqgc; -aqgd; -aqge; -aqgf; -aqgg; -aqgh; -aqgi; -aqgj; -aqgk; -aqgl; -aqgm; -aqgn; -aqgo; -aqgp; -aqgq; -aqgr; -aqgs; -aqgt; -aqgu; -aqgv; -aqgw; -aqgx; -aqgy; -aqgz; -aqha; -aqhb; -aqhc; -aqhd; -aqhe; -aqhf; -aqhg; -aqhh; -aqhi; -aqhj; -aqhk; -aqhl; -aqhm; -aqhn; -aqho; -aqhp; -aqhq; -aqhr; -aqhs; -aqht; -aqhu; -aqhv; -aqhw; -aqhx; -aqhy; -aqhz; -aqia; -aqib; -aqic; -aqid; -aqie; -aqif; -aqig; -aqih; -aqii; -aqij; -aqik; -aqil; -aqim; -aqin; -aqio; -aqip; -aqiq; -aqir; -aqis; -aqit; -aqiu; -aqiv; -aqiw; -aqix; -aqiy; -aqiz; -aqja; -aqjb; -aqjc; -aqjd; -aqje; -aqjf; -aqjg; -aqjh; -aqji; -aqjj; -aqjk; -aqjl; -aqjm; -aqjn; -aqjo; -aqjp; -aqjq; -aqjr; -aqjs; -aqjt; -aqju; -aqjv; -aqjw; -aqjx; -aqjy; -aqjz; -aqka; -aqkb; -aqkc; -aqkd; -aqke; -aqkf; -aqkg; -aqkh; -aqki; -aqkj; -aqkk; -aqkl; -aqkm; -aqkn; -aqko; -aqkp; -aqkq; -aqkr; -aqks; -aqkt; -aqku; -aqkv; -aqkw; -aqkx; -aqky; -aqkz; -aqla; -aqlb; -aqlc; -aqld; -aqle; -aqlf; -aqlg; -aqlh; -aqli; -aqlj; -aqlk; -aqll; -aqlm; -aqln; -aqlo; -aqlp; -aqlq; -aqlr; -aqls; -aqlt; -aqlu; -aqlv; -aqlw; -aqlx; -aqly; -aqlz; -aqma; -aqmb; -aqmc; -aqmd; -aqme; -aqmf; -aqmg; -aqmh; -aqmi; -aqmj; -aqmk; -aqml; -aqmm; -aqmn; -aqmo; -aqmp; -aqmq; -aqmr; -aqms; -aqmt; -aqmu; -aqmv; -aqmw; -aqmx; -aqmy; -aqmz; -aqna; -aqnb; -aqnc; -aqnd; -aqne; -aqnf; -aqng; -aqnh; -aqni; -aqnj; -aqnk; -aqnl; -aqnm; -aqnn; -aqno; -aqnp; -aqnq; -aqnr; -aqns; -aqnt; -aqnu; -aqnv; -aqnw; -aqnx; -aqny; -aqnz; -aqoa; -aqob; -aqoc; -aqod; -aqoe; -aqof; -aqog; -aqoh; -aqoi; -aqoj; -aqok; -aqol; -aqom; -aqon; -aqoo; -aqop; -aqoq; -aqor; -aqos; -aqot; -aqou; -aqov; -aqow; -aqox; -aqoy; -aqoz; -aqpa; -aqpb; -aqpc; -aqpd; -aqpe; -aqpf; -aqpg; -aqph; -aqpi; -aqpj; -aqpk; -aqpl; -aqpm; -aqpn; -aqpo; -aqpp; -aqpq; -aqpr; -aqps; -aqpt; -aqpu; -aqpv; -aqpw; -aqpx; -aqpy; -aqpz; -aqqa; -aqqb; -aqqc; -aqqd; -aqqe; -aqqf; -aqqg; -aqqh; -aqqi; -aqqj; -aqqk; -aqql; -aqqm; -aqqn; -aqqo; -aqqp; -aqqq; -aqqr; -aqqs; -aqqt; -aqqu; -aqqv; -aqqw; -aqqx; -aqqy; -aqqz; -aqra; -aqrb; -aqrc; -aqrd; -aqre; -aqrf; -aqrg; -aqrh; -aqri; -aqrj; -aqrk; -aqrl; -aqrm; -aqrn; -aqro; -aqrp; -aqrq; -aqrr; -aqrs; -aqrt; -aqru; -aqrv; -aqrw; -aqrx; -aqry; -aqrz; -aqsa; -aqsb; -aqsc; -aqsd; -aqse; -aqsf; -aqsg; -aqsh; -aqsi; -aqsj; -aqsk; -aqsl; -aqsm; -aqsn; -aqso; -aqsp; -aqsq; -aqsr; -aqss; -aqst; -aqsu; -aqsv; -aqsw; -aqsx; -aqsy; -aqsz; -aqta; -aqtb; -aqtc; -aqtd; -aqte; -aqtf; -aqtg; -aqth; -aqti; -aqtj; -aqtk; -aqtl; -aqtm; -aqtn; -aqto; -aqtp; -aqtq; -aqtr; -aqts; -aqtt; -aqtu; -aqtv; -aqtw; -aqtx; -aqty; -aqtz; -aqua; -aqub; -aquc; -aqud; -aque; -aquf; -aqug; -aquh; -aqui; -aquj; -aquk; -aqul; -aqum; -aqun; -aquo; -aqup; -aquq; -aqur; -aqus; -aqut; -aquu; -aquv; -aquw; -aqux; -aquy; -aquz; -aqva; -aqvb; -aqvc; -aqvd; -aqve; -aqvf; -aqvg; -aqvh; -aqvi; -aqvj; -aqvk; -aqvl; -aqvm; -aqvn; -aqvo; -aqvp; -aqvq; -aqvr; -aqvs; -aqvt; -aqvu; -aqvv; -aqvw; -aqvx; -aqvy; -aqvz; -aqwa; -aqwb; -aqwc; -aqwd; -aqwe; -aqwf; -aqwg; -aqwh; -aqwi; -aqwj; -aqwk; -aqwl; -aqwm; -aqwn; -aqwo; -aqwp; -aqwq; -aqwr; -aqws; -aqwt; -aqwu; -aqwv; -aqww; -aqwx; -aqwy; -aqwz; -aqxa; -aqxb; -aqxc; -aqxd; -aqxe; -aqxf; -aqxg; -aqxh; -aqxi; -aqxj; -aqxk; -aqxl; -aqxm; -aqxn; -aqxo; -aqxp; -aqxq; -aqxr; -aqxs; -aqxt; -aqxu; -aqxv; -aqxw; -aqxx; -aqxy; -aqxz; -aqya; -aqyb; -aqyc; -aqyd; -aqye; -aqyf; -aqyg; -aqyh; -aqyi; -aqyj; -aqyk; -aqyl; -aqym; -aqyn; -aqyo; -aqyp; -aqyq; -aqyr; -aqys; -aqyt; -aqyu; -aqyv; -aqyw; -aqyx; -aqyy; -aqyz; -aqza; -aqzb; -aqzc; -aqzd; -aqze; -aqzf; -aqzg; -aqzh; -aqzi; -aqzj; -aqzk; -aqzl; -aqzm; -aqzn; -aqzo; -aqzp; -aqzq; -aqzr; -aqzs; -aqzt; -aqzu; -aqzv; -aqzw; -aqzx; -aqzy; -aqzz; -araa; -arab; -arac; -arad; -arae; -araf; -arag; -arah; -arai; -araj; -arak; -aral; -aram; -aran; -arao; -arap; -araq; -arar; -aras; -arat; -arau; -arav; -araw; -arax; -aray; -araz; -arba; -arbb; -arbc; -arbd; -arbe; -arbf; -arbg; -arbh; -arbi; -arbj; -arbk; -arbl; -arbm; -arbn; -arbo; -arbp; -arbq; -arbr; -arbs; -arbt; -arbu; -arbv; -arbw; -arbx; -arby; -arbz; -arca; -arcb; -arcc; -arcd; -arce; -arcf; -arcg; -arch; -arci; -arcj; -arck; -arcl; -arcm; -arcn; -arco; -arcp; -arcq; -arcr; -arcs; -arct; -arcu; -arcv; -arcw; -arcx; -arcy; -arcz; -arda; -ardb; -ardc; -ardd; -arde; -ardf; -ardg; -ardh; -ardi; -ardj; -ardk; -ardl; -ardm; -ardn; -ardo; -ardp; -ardq; -ardr; -ards; -ardt; -ardu; -ardv; -ardw; -ardx; -ardy; -ardz; -area; -areb; -arec; -ared; -aree; -aref; -areg; -areh; -arei; -arej; -arek; -arel; -arem; -aren; -areo; -arep; -areq; -arer; -ares; -aret; -areu; -arev; -arew; -arex; -arey; -arez; -arfa; -arfb; -arfc; -arfd; -arfe; -arff; -arfg; -arfh; -arfi; -arfj; -arfk; -arfl; -arfm; -arfn; -arfo; -arfp; -arfq; -arfr; -arfs; -arft; -arfu; -arfv; -arfw; -arfx; -arfy; -arfz; -arga; -argb; -argc; -argd; -arge; -argf; -argg; -argh; -argi; -argj; -argk; -argl; -argm; -argn; -argo; -argp; -argq; -argr; -args; -argt; -argu; -argv; -argw; -argx; -argy; -argz; -arha; -arhb; -arhc; -arhd; -arhe; -arhf; -arhg; -arhh; -arhi; -arhj; -arhk; -arhl; -arhm; -arhn; -arho; -arhp; -arhq; -arhr; -arhs; -arht; -arhu; -arhv; -arhw; -arhx; -arhy; -arhz; -aria; -arib; -aric; -arid; -arie; -arif; -arig; -arih; -arii; -arij; -arik; -aril; -arim; -arin; -ario; -arip; -ariq; -arir; -aris; -arit; -ariu; -ariv; -ariw; -arix; -ariy; -ariz; -arja; -arjb; -arjc; -arjd; -arje; -arjf; -arjg; -arjh; -arji; -arjj; -arjk; -arjl; -arjm; -arjn; -arjo; -arjp; -arjq; -arjr; -arjs; -arjt; -arju; -arjv; -arjw; -arjx; -arjy; -arjz; -arka; -arkb; -arkc; -arkd; -arke; -arkf; -arkg; -arkh; -arki; -arkj; -arkk; -arkl; -arkm; -arkn; -arko; -arkp; -arkq; -arkr; -arks; -arkt; -arku; -arkv; -arkw; -arkx; -arky; -arkz; -arla; -arlb; -arlc; -arld; -arle; -arlf; -arlg; -arlh; -arli; -arlj; -arlk; -arll; -arlm; -arln; -arlo; -arlp; -arlq; -arlr; -arls; -arlt; -arlu; -arlv; -arlw; -arlx; -arly; -arlz; -arma; -armb; -armc; -armd; -arme; -armf; -armg; -armh; -armi; -armj; -armk; -arml; -armm; -armn; -armo; -armp; -armq; -armr; -arms; -armt; -armu; -armv; -armw; -armx; -army; -armz; -arna; -arnb; -arnc; -arnd; -arne; -arnf; -arng; -arnh; -arni; -arnj; -arnk; -arnl; -arnm; -arnn; -arno; -arnp; -arnq; -arnr; -arns; -arnt; -arnu; -arnv; -arnw; -arnx; -arny; -arnz; -aroa; -arob; -aroc; -arod; -aroe; -arof; -arog; -aroh; -aroi; -aroj; -arok; -arol; -arom; -aron; -aroo; -arop; -aroq; -aror; -aros; -arot; -arou; -arov; -arow; -arox; -aroy; -aroz; -arpa; -arpb; -arpc; -arpd; -arpe; -arpf; -arpg; -arph; -arpi; -arpj; -arpk; -arpl; -arpm; -arpn; -arpo; -arpp; -arpq; -arpr; -arps; -arpt; -arpu; -arpv; -arpw; -arpx; -arpy; -arpz; -arqa; -arqb; -arqc; -arqd; -arqe; -arqf; -arqg; -arqh; -arqi; -arqj; -arqk; -arql; -arqm; -arqn; -arqo; -arqp; -arqq; -arqr; -arqs; -arqt; -arqu; -arqv; -arqw; -arqx; -arqy; -arqz; -arra; -arrb; -arrc; -arrd; -arre; -arrf; -arrg; -arrh; -arri; -arrj; -arrk; -arrl; -arrm; -arrn; -arro; -arrp; -arrq; -arrr; -arrs; -arrt; -arru; -arrv; -arrw; -arrx; -arry; -arrz; -arsa; -arsb; -arsc; -arsd; -arse; -arsf; -arsg; -arsh; -arsi; -arsj; -arsk; -arsl; -arsm; -arsn; -arso; -arsp; -arsq; -arsr; -arss; -arst; -arsu; -arsv; -arsw; -arsx; -arsy; -arsz; -arta; -artb; -artc; -artd; -arte; -artf; -artg; -arth; -arti; -artj; -artk; -artl; -artm; -artn; -arto; -artp; -artq; -artr; -arts; -artt; -artu; -artv; -artw; -artx; -arty; -artz; -arua; -arub; -aruc; -arud; -arue; -aruf; -arug; -aruh; -arui; -aruj; -aruk; -arul; -arum; -arun; -aruo; -arup; -aruq; -arur; -arus; -arut; -aruu; -aruv; -aruw; -arux; -aruy; -aruz; -arva; -arvb; -arvc; -arvd; -arve; -arvf; -arvg; -arvh; -arvi; -arvj; -arvk; -arvl; -arvm; -arvn; -arvo; -arvp; -arvq; -arvr; -arvs; -arvt; -arvu; -arvv; -arvw; -arvx; -arvy; -arvz; -arwa; -arwb; -arwc; -arwd; -arwe; -arwf; -arwg; -arwh; -arwi; -arwj; -arwk; -arwl; -arwm; -arwn; -arwo; -arwp; -arwq; -arwr; -arws; -arwt; -arwu; -arwv; -arww; -arwx; -arwy; -arwz; -arxa; -arxb; -arxc; -arxd; -arxe; -arxf; -arxg; -arxh; -arxi; -arxj; -arxk; -arxl; -arxm; -arxn; -arxo; -arxp; -arxq; -arxr; -arxs; -arxt; -arxu; -arxv; -arxw; -arxx; -arxy; -arxz; -arya; -aryb; -aryc; -aryd; -arye; -aryf; -aryg; -aryh; -aryi; -aryj; -aryk; -aryl; -arym; -aryn; -aryo; -aryp; -aryq; -aryr; -arys; -aryt; -aryu; -aryv; -aryw; -aryx; -aryy; -aryz; -arza; -arzb; -arzc; -arzd; -arze; -arzf; -arzg; -arzh; -arzi; -arzj; -arzk; -arzl; -arzm; -arzn; -arzo; -arzp; -arzq; -arzr; -arzs; -arzt; -arzu; -arzv; -arzw; -arzx; -arzy; -arzz; -asaa; -asab; -asac; -asad; -asae; -asaf; -asag; -asah; -asai; -asaj; -asak; -asal; -asam; -asan; -asao; -asap; -asaq; -asar; -asas; -asat; -asau; -asav; -asaw; -asax; -asay; -asaz; -asba; -asbb; -asbc; -asbd; -asbe; -asbf; -asbg; -asbh; -asbi; -asbj; -asbk; -asbl; -asbm; -asbn; -asbo; -asbp; -asbq; -asbr; -asbs; -asbt; -asbu; -asbv; -asbw; -asbx; -asby; -asbz; -asca; -ascb; -ascc; -ascd; -asce; -ascf; -ascg; -asch; -asci; -ascj; -asck; -ascl; -ascm; -ascn; -asco; -ascp; -ascq; -ascr; -ascs; -asct; -ascu; -ascv; -ascw; -ascx; -ascy; -ascz; -asda; -asdb; -asdc; -asdd; -asde; -asdf; -asdg; -asdh; -asdi; -asdj; -asdk; -asdl; -asdm; -asdn; -asdo; -asdp; -asdq; -asdr; -asds; -asdt; -asdu; -asdv; -asdw; -asdx; -asdy; -asdz; -asea; -aseb; -asec; -ased; -asee; -asef; -aseg; -aseh; -asei; -asej; -asek; -asel; -asem; -asen; -aseo; -asep; -aseq; -aser; -ases; -aset; -aseu; -asev; -asew; -asex; -asey; -asez; -asfa; -asfb; -asfc; -asfd; -asfe; -asff; -asfg; -asfh; -asfi; -asfj; -asfk; -asfl; -asfm; -asfn; -asfo; -asfp; -asfq; -asfr; -asfs; -asft; -asfu; -asfv; -asfw; -asfx; -asfy; -asfz; -asga; -asgb; -asgc; -asgd; -asge; -asgf; -asgg; -asgh; -asgi; -asgj; -asgk; -asgl; -asgm; -asgn; -asgo; -asgp; -asgq; -asgr; -asgs; -asgt; -asgu; -asgv; -asgw; -asgx; -asgy; -asgz; -asha; -ashb; -ashc; -ashd; -ashe; -ashf; -ashg; -ashh; -ashi; -ashj; -ashk; -ashl; -ashm; -ashn; -asho; -ashp; -ashq; -ashr; -ashs; -asht; -ashu; -ashv; -ashw; -ashx; -ashy; -ashz; -asia; -asib; -asic; -asid; -asie; -asif; -asig; -asih; -asii; -asij; -asik; -asil; -asim; -asin; -asio; -asip; -asiq; -asir; -asis; -asit; -asiu; -asiv; -asiw; -asix; -asiy; -asiz; -asja; -asjb; -asjc; -asjd; -asje; -asjf; -asjg; -asjh; -asji; -asjj; -asjk; -asjl; -asjm; -asjn; -asjo; -asjp; -asjq; -asjr; -asjs; -asjt; -asju; -asjv; -asjw; -asjx; -asjy; -asjz; -aska; -askb; -askc; -askd; -aske; -askf; -askg; -askh; -aski; -askj; -askk; -askl; -askm; -askn; -asko; -askp; -askq; -askr; -asks; -askt; -asku; -askv; -askw; -askx; -asky; -askz; -asla; -aslb; -aslc; -asld; -asle; -aslf; -aslg; -aslh; -asli; -aslj; -aslk; -asll; -aslm; -asln; -aslo; -aslp; -aslq; -aslr; -asls; -aslt; -aslu; -aslv; -aslw; -aslx; -asly; -aslz; -asma; -asmb; -asmc; -asmd; -asme; -asmf; -asmg; -asmh; -asmi; -asmj; -asmk; -asml; -asmm; -asmn; -asmo; -asmp; -asmq; -asmr; -asms; -asmt; -asmu; -asmv; -asmw; -asmx; -asmy; -asmz; -asna; -asnb; -asnc; -asnd; -asne; -asnf; -asng; -asnh; -asni; -asnj; -asnk; -asnl; -asnm; -asnn; -asno; -asnp; -asnq; -asnr; -asns; -asnt; -asnu; -asnv; -asnw; -asnx; -asny; -asnz; -asoa; -asob; -asoc; -asod; -asoe; -asof; -asog; -asoh; -asoi; -asoj; -asok; -asol; -asom; -ason; -asoo; -asop; -asoq; -asor; -asos; -asot; -asou; -asov; -asow; -asox; -asoy; -asoz; -aspa; -aspb; -aspc; -aspd; -aspe; -aspf; -aspg; -asph; -aspi; -aspj; -aspk; -aspl; -aspm; -aspn; -aspo; -aspp; -aspq; -aspr; -asps; -aspt; -aspu; -aspv; -aspw; -aspx; -aspy; -aspz; -asqa; -asqb; -asqc; -asqd; -asqe; -asqf; -asqg; -asqh; -asqi; -asqj; -asqk; -asql; -asqm; -asqn; -asqo; -asqp; -asqq; -asqr; -asqs; -asqt; -asqu; -asqv; -asqw; -asqx; -asqy; -asqz; -asra; -asrb; -asrc; -asrd; -asre; -asrf; -asrg; -asrh; -asri; -asrj; -asrk; -asrl; -asrm; -asrn; -asro; -asrp; -asrq; -asrr; -asrs; -asrt; -asru; -asrv; -asrw; -asrx; -asry; -asrz; -assa; -assb; -assc; -assd; -asse; -assf; -assg; -assh; -assi; -assj; -assk; -assl; -assm; -assn; -asso; -assp; -assq; -assr; -asss; -asst; -assu; -assv; -assw; -assx; -assy; -assz; -asta; -astb; -astc; -astd; -aste; -astf; -astg; -asth; -asti; -astj; -astk; -astl; -astm; -astn; -asto; -astp; -astq; -astr; -asts; -astt; -astu; -astv; -astw; -astx; -asty; -astz; -asua; -asub; -asuc; -asud; -asue; -asuf; -asug; -asuh; -asui; -asuj; -asuk; -asul; -asum; -asun; -asuo; -asup; -asuq; -asur; -asus; -asut; -asuu; -asuv; -asuw; -asux; -asuy; -asuz; -asva; -asvb; -asvc; -asvd; -asve; -asvf; -asvg; -asvh; -asvi; -asvj; -asvk; -asvl; -asvm; -asvn; -asvo; -asvp; -asvq; -asvr; -asvs; -asvt; -asvu; -asvv; -asvw; -asvx; -asvy; -asvz; -aswa; -aswb; -aswc; -aswd; -aswe; -aswf; -aswg; -aswh; -aswi; -aswj; -aswk; -aswl; -aswm; -aswn; -aswo; -aswp; -aswq; -aswr; -asws; -aswt; -aswu; -aswv; -asww; -aswx; -aswy; -aswz; -asxa; -asxb; -asxc; -asxd; -asxe; -asxf; -asxg; -asxh; -asxi; -asxj; -asxk; -asxl; -asxm; -asxn; -asxo; -asxp; -asxq; -asxr; -asxs; -asxt; -asxu; -asxv; -asxw; -asxx; -asxy; -asxz; -asya; -asyb; -asyc; -asyd; -asye; -asyf; -asyg; -asyh; -asyi; -asyj; -asyk; -asyl; -asym; -asyn; -asyo; -asyp; -asyq; -asyr; -asys; -asyt; -asyu; -asyv; -asyw; -asyx; -asyy; -asyz; -asza; -aszb; -aszc; -aszd; -asze; -aszf; -aszg; -aszh; -aszi; -aszj; -aszk; -aszl; -aszm; -aszn; -aszo; -aszp; -aszq; -aszr; -aszs; -aszt; -aszu; -aszv; -aszw; -aszx; -aszy; -aszz; -ataa; -atab; -atac; -atad; -atae; -ataf; -atag; -atah; -atai; -ataj; -atak; -atal; -atam; -atan; -atao; -atap; -ataq; -atar; -atas; -atat; -atau; -atav; -ataw; -atax; -atay; -ataz; -atba; -atbb; -atbc; -atbd; -atbe; -atbf; -atbg; -atbh; -atbi; -atbj; -atbk; -atbl; -atbm; -atbn; -atbo; -atbp; -atbq; -atbr; -atbs; -atbt; -atbu; -atbv; -atbw; -atbx; -atby; -atbz; -atca; -atcb; -atcc; -atcd; -atce; -atcf; -atcg; -atch; -atci; -atcj; -atck; -atcl; -atcm; -atcn; -atco; -atcp; -atcq; -atcr; -atcs; -atct; -atcu; -atcv; -atcw; -atcx; -atcy; -atcz; -atda; -atdb; -atdc; -atdd; -atde; -atdf; -atdg; -atdh; -atdi; -atdj; -atdk; -atdl; -atdm; -atdn; -atdo; -atdp; -atdq; -atdr; -atds; -atdt; -atdu; -atdv; -atdw; -atdx; -atdy; -atdz; -atea; -ateb; -atec; -ated; -atee; -atef; -ateg; -ateh; -atei; -atej; -atek; -atel; -atem; -aten; -ateo; -atep; -ateq; -ater; -ates; -atet; -ateu; -atev; -atew; -atex; -atey; -atez; -atfa; -atfb; -atfc; -atfd; -atfe; -atff; -atfg; -atfh; -atfi; -atfj; -atfk; -atfl; -atfm; -atfn; -atfo; -atfp; -atfq; -atfr; -atfs; -atft; -atfu; -atfv; -atfw; -atfx; -atfy; -atfz; -atga; -atgb; -atgc; -atgd; -atge; -atgf; -atgg; -atgh; -atgi; -atgj; -atgk; -atgl; -atgm; -atgn; -atgo; -atgp; -atgq; -atgr; -atgs; -atgt; -atgu; -atgv; -atgw; -atgx; -atgy; -atgz; -atha; -athb; -athc; -athd; -athe; -athf; -athg; -athh; -athi; -athj; -athk; -athl; -athm; -athn; -atho; -athp; -athq; -athr; -aths; -atht; -athu; -athv; -athw; -athx; -athy; -athz; -atia; -atib; -atic; -atid; -atie; -atif; -atig; -atih; -atii; -atij; -atik; -atil; -atim; -atin; -atio; -atip; -atiq; -atir; -atis; -atit; -atiu; -ativ; -atiw; -atix; -atiy; -atiz; -atja; -atjb; -atjc; -atjd; -atje; -atjf; -atjg; -atjh; -atji; -atjj; -atjk; -atjl; -atjm; -atjn; -atjo; -atjp; -atjq; -atjr; -atjs; -atjt; -atju; -atjv; -atjw; -atjx; -atjy; -atjz; -atka; -atkb; -atkc; -atkd; -atke; -atkf; -atkg; -atkh; -atki; -atkj; -atkk; -atkl; -atkm; -atkn; -atko; -atkp; -atkq; -atkr; -atks; -atkt; -atku; -atkv; -atkw; -atkx; -atky; -atkz; -atla; -atlb; -atlc; -atld; -atle; -atlf; -atlg; -atlh; -atli; -atlj; -atlk; -atll; -atlm; -atln; -atlo; -atlp; -atlq; -atlr; -atls; -atlt; -atlu; -atlv; -atlw; -atlx; -atly; -atlz; -atma; -atmb; -atmc; -atmd; -atme; -atmf; -atmg; -atmh; -atmi; -atmj; -atmk; -atml; -atmm; -atmn; -atmo; -atmp; -atmq; -atmr; -atms; -atmt; -atmu; -atmv; -atmw; -atmx; -atmy; -atmz; -atna; -atnb; -atnc; -atnd; -atne; -atnf; -atng; -atnh; -atni; -atnj; -atnk; -atnl; -atnm; -atnn; -atno; -atnp; -atnq; -atnr; -atns; -atnt; -atnu; -atnv; -atnw; -atnx; -atny; -atnz; -atoa; -atob; -atoc; -atod; -atoe; -atof; -atog; -atoh; -atoi; -atoj; -atok; -atol; -atom; -aton; -atoo; -atop; -atoq; -ator; -atos; -atot; -atou; -atov; -atow; -atox; -atoy; -atoz; -atpa; -atpb; -atpc; -atpd; -atpe; -atpf; -atpg; -atph; -atpi; -atpj; -atpk; -atpl; -atpm; -atpn; -atpo; -atpp; -atpq; -atpr; -atps; -atpt; -atpu; -atpv; -atpw; -atpx; -atpy; -atpz; -atqa; -atqb; -atqc; -atqd; -atqe; -atqf; -atqg; -atqh; -atqi; -atqj; -atqk; -atql; -atqm; -atqn; -atqo; -atqp; -atqq; -atqr; -atqs; -atqt; -atqu; -atqv; -atqw; -atqx; -atqy; -atqz; -atra; -atrb; -atrc; -atrd; -atre; -atrf; -atrg; -atrh; -atri; -atrj; -atrk; -atrl; -atrm; -atrn; -atro; -atrp; -atrq; -atrr; -atrs; -atrt; -atru; -atrv; -atrw; -atrx; -atry; -atrz; -atsa; -atsb; -atsc; -atsd; -atse; -atsf; -atsg; -atsh; -atsi; -atsj; -atsk; -atsl; -atsm; -atsn; -atso; -atsp; -atsq; -atsr; -atss; -atst; -atsu; -atsv; -atsw; -atsx; -atsy; -atsz; -atta; -attb; -attc; -attd; -atte; -attf; -attg; -atth; -atti; -attj; -attk; -attl; -attm; -attn; -atto; -attp; -attq; -attr; -atts; -attt; -attu; -attv; -attw; -attx; -atty; -attz; -atua; -atub; -atuc; -atud; -atue; -atuf; -atug; -atuh; -atui; -atuj; -atuk; -atul; -atum; -atun; -atuo; -atup; -atuq; -atur; -atus; -atut; -atuu; -atuv; -atuw; -atux; -atuy; -atuz; -atva; -atvb; -atvc; -atvd; -atve; -atvf; -atvg; -atvh; -atvi; -atvj; -atvk; -atvl; -atvm; -atvn; -atvo; -atvp; -atvq; -atvr; -atvs; -atvt; -atvu; -atvv; -atvw; -atvx; -atvy; -atvz; -atwa; -atwb; -atwc; -atwd; -atwe; -atwf; -atwg; -atwh; -atwi; -atwj; -atwk; -atwl; -atwm; -atwn; -atwo; -atwp; -atwq; -atwr; -atws; -atwt; -atwu; -atwv; -atww; -atwx; -atwy; -atwz; -atxa; -atxb; -atxc; -atxd; -atxe; -atxf; -atxg; -atxh; -atxi; -atxj; -atxk; -atxl; -atxm; -atxn; -atxo; -atxp; -atxq; -atxr; -atxs; -atxt; -atxu; -atxv; -atxw; -atxx; -atxy; -atxz; -atya; -atyb; -atyc; -atyd; -atye; -atyf; -atyg; -atyh; -atyi; -atyj; -atyk; -atyl; -atym; -atyn; -atyo; -atyp; -atyq; -atyr; -atys; -atyt; -atyu; -atyv; -atyw; -atyx; -atyy; -atyz; -atza; -atzb; -atzc; -atzd; -atze; -atzf; -atzg; -atzh; -atzi; -atzj; -atzk; -atzl; -atzm; -atzn; -atzo; -atzp; -atzq; -atzr; -atzs; -atzt; -atzu; -atzv; -atzw; -atzx; -atzy; -atzz; -auaa; -auab; -auac; -auad; -auae; -auaf; -auag; -auah; -auai; -auaj; -auak; -aual; -auam; -auan; -auao; -auap; -auaq; -auar; -auas; -auat; -auau; -auav; -auaw; -auax; -auay; -auaz; -auba; -aubb; -aubc; -aubd; -aube; -aubf; -aubg; -aubh; -aubi; -aubj; -aubk; -aubl; -aubm; -aubn; -aubo; -aubp; -aubq; -aubr; -aubs; -aubt; -aubu; -aubv; -aubw; -aubx; -auby; -aubz; -auca; -aucb; -aucc; -aucd; -auce; -aucf; -aucg; -auch; -auci; -aucj; -auck; -aucl; -aucm; -aucn; -auco; -aucp; -aucq; -aucr; -aucs; -auct; -aucu; -aucv; -aucw; -aucx; -aucy; -aucz; -auda; -audb; -audc; -audd; -aude; -audf; -audg; -audh; -audi; -audj; -audk; -audl; -audm; -audn; -audo; -audp; -audq; -audr; -auds; -audt; -audu; -audv; -audw; -audx; -audy; -audz; -auea; -aueb; -auec; -aued; -auee; -auef; -aueg; -aueh; -auei; -auej; -auek; -auel; -auem; -auen; -aueo; -auep; -aueq; -auer; -aues; -auet; -aueu; -auev; -auew; -auex; -auey; -auez; -aufa; -aufb; -aufc; -aufd; -aufe; -auff; -aufg; -aufh; -aufi; -aufj; -aufk; -aufl; -aufm; -aufn; -aufo; -aufp; -aufq; -aufr; -aufs; -auft; -aufu; -aufv; -aufw; -aufx; -aufy; -aufz; -auga; -augb; -augc; -augd; -auge; -augf; -augg; -augh; -augi; -augj; -augk; -augl; -augm; -augn; -augo; -augp; -augq; -augr; -augs; -augt; -augu; -augv; -augw; -augx; -augy; -augz; -auha; -auhb; -auhc; -auhd; -auhe; -auhf; -auhg; -auhh; -auhi; -auhj; -auhk; -auhl; -auhm; -auhn; -auho; -auhp; -auhq; -auhr; -auhs; -auht; -auhu; -auhv; -auhw; -auhx; -auhy; -auhz; -auia; -auib; -auic; -auid; -auie; -auif; -auig; -auih; -auii; -auij; -auik; -auil; -auim; -auin; -auio; -auip; -auiq; -auir; -auis; -auit; -auiu; -auiv; -auiw; -auix; -auiy; -auiz; -auja; -aujb; -aujc; -aujd; -auje; -aujf; -aujg; -aujh; -auji; -aujj; -aujk; -aujl; -aujm; -aujn; -aujo; -aujp; -aujq; -aujr; -aujs; -aujt; -auju; -aujv; -aujw; -aujx; -aujy; -aujz; -auka; -aukb; -aukc; -aukd; -auke; -aukf; -aukg; -aukh; -auki; -aukj; -aukk; -aukl; -aukm; -aukn; -auko; -aukp; -aukq; -aukr; -auks; -aukt; -auku; -aukv; -aukw; -aukx; -auky; -aukz; -aula; -aulb; -aulc; -auld; -aule; -aulf; -aulg; -aulh; -auli; -aulj; -aulk; -aull; -aulm; -auln; -aulo; -aulp; -aulq; -aulr; -auls; -ault; -aulu; -aulv; -aulw; -aulx; -auly; -aulz; -auma; -aumb; -aumc; -aumd; -aume; -aumf; -aumg; -aumh; -aumi; -aumj; -aumk; -auml; -aumm; -aumn; -aumo; -aump; -aumq; -aumr; -aums; -aumt; -aumu; -aumv; -aumw; -aumx; -aumy; -aumz; -auna; -aunb; -aunc; -aund; -aune; -aunf; -aung; -aunh; -auni; -aunj; -aunk; -aunl; -aunm; -aunn; -auno; -aunp; -aunq; -aunr; -auns; -aunt; -aunu; -aunv; -aunw; -aunx; -auny; -aunz; -auoa; -auob; -auoc; -auod; -auoe; -auof; -auog; -auoh; -auoi; -auoj; -auok; -auol; -auom; -auon; -auoo; -auop; -auoq; -auor; -auos; -auot; -auou; -auov; -auow; -auox; -auoy; -auoz; -aupa; -aupb; -aupc; -aupd; -aupe; -aupf; -aupg; -auph; -aupi; -aupj; -aupk; -aupl; -aupm; -aupn; -aupo; -aupp; -aupq; -aupr; -aups; -aupt; -aupu; -aupv; -aupw; -aupx; -aupy; -aupz; -auqa; -auqb; -auqc; -auqd; -auqe; -auqf; -auqg; -auqh; -auqi; -auqj; -auqk; -auql; -auqm; -auqn; -auqo; -auqp; -auqq; -auqr; -auqs; -auqt; -auqu; -auqv; -auqw; -auqx; -auqy; -auqz; -aura; -aurb; -aurc; -aurd; -aure; -aurf; -aurg; -aurh; -auri; -aurj; -aurk; -aurl; -aurm; -aurn; -auro; -aurp; -aurq; -aurr; -aurs; -aurt; -auru; -aurv; -aurw; -aurx; -aury; -aurz; -ausa; -ausb; -ausc; -ausd; -ause; -ausf; -ausg; -aush; -ausi; -ausj; -ausk; -ausl; -ausm; -ausn; -auso; -ausp; -ausq; -ausr; -auss; -aust; -ausu; -ausv; -ausw; -ausx; -ausy; -ausz; -auta; -autb; -autc; -autd; -aute; -autf; -autg; -auth; -auti; -autj; -autk; -autl; -autm; -autn; -auto; -autp; -autq; -autr; -auts; -autt; -autu; -autv; -autw; -autx; -auty; -autz; -auua; -auub; -auuc; -auud; -auue; -auuf; -auug; -auuh; -auui; -auuj; -auuk; -auul; -auum; -auun; -auuo; -auup; -auuq; -auur; -auus; -auut; -auuu; -auuv; -auuw; -auux; -auuy; -auuz; -auva; -auvb; -auvc; -auvd; -auve; -auvf; -auvg; -auvh; -auvi; -auvj; -auvk; -auvl; -auvm; -auvn; -auvo; -auvp; -auvq; -auvr; -auvs; -auvt; -auvu; -auvv; -auvw; -auvx; -auvy; -auvz; -auwa; -auwb; -auwc; -auwd; -auwe; -auwf; -auwg; -auwh; -auwi; -auwj; -auwk; -auwl; -auwm; -auwn; -auwo; -auwp; -auwq; -auwr; -auws; -auwt; -auwu; -auwv; -auww; -auwx; -auwy; -auwz; -auxa; -auxb; -auxc; -auxd; -auxe; -auxf; -auxg; -auxh; -auxi; -auxj; -auxk; -auxl; -auxm; -auxn; -auxo; -auxp; -auxq; -auxr; -auxs; -auxt; -auxu; -auxv; -auxw; -auxx; -auxy; -auxz; -auya; -auyb; -auyc; -auyd; -auye; -auyf; -auyg; -auyh; -auyi; -auyj; -auyk; -auyl; -auym; -auyn; -auyo; -auyp; -auyq; -auyr; -auys; -auyt; -auyu; -auyv; -auyw; -auyx; -auyy; -auyz; -auza; -auzb; -auzc; -auzd; -auze; -auzf; -auzg; -auzh; -auzi; -auzj; -auzk; -auzl; -auzm; -auzn; -auzo; -auzp; -auzq; -auzr; -auzs; -auzt; -auzu; -auzv; -auzw; -auzx; -auzy; -auzz; -avaa; -avab; -avac; -avad; -avae; -avaf; -avag; -avah; -avai; -avaj; -avak; -aval; -avam; -avan; -avao; -avap; -avaq; -avar; -avas; -avat; -avau; -avav; -avaw; -avax; -avay; -avaz; -avba; -avbb; -avbc; -avbd; -avbe; -avbf; -avbg; -avbh; -avbi; -avbj; -avbk; -avbl; -avbm; -avbn; -avbo; -avbp; -avbq; -avbr; -avbs; -avbt; -avbu; -avbv; -avbw; -avbx; -avby; -avbz; -avca; -avcb; -avcc; -avcd; -avce; -avcf; -avcg; -avch; -avci; -avcj; -avck; -avcl; -avcm; -avcn; -avco; -avcp; -avcq; -avcr; -avcs; -avct; -avcu; -avcv; -avcw; -avcx; -avcy; -avcz; -avda; -avdb; -avdc; -avdd; -avde; -avdf; -avdg; -avdh; -avdi; -avdj; -avdk; -avdl; -avdm; -avdn; -avdo; -avdp; -avdq; -avdr; -avds; -avdt; -avdu; -avdv; -avdw; -avdx; -avdy; -avdz; -avea; -aveb; -avec; -aved; -avee; -avef; -aveg; -aveh; -avei; -avej; -avek; -avel; -avem; -aven; -aveo; -avep; -aveq; -aver; -aves; -avet; -aveu; -avev; -avew; -avex; -avey; -avez; -avfa; -avfb; -avfc; -avfd; -avfe; -avff; -avfg; -avfh; -avfi; -avfj; -avfk; -avfl; -avfm; -avfn; -avfo; -avfp; -avfq; -avfr; -avfs; -avft; -avfu; -avfv; -avfw; -avfx; -avfy; -avfz; -avga; -avgb; -avgc; -avgd; -avge; -avgf; -avgg; -avgh; -avgi; -avgj; -avgk; -avgl; -avgm; -avgn; -avgo; -avgp; -avgq; -avgr; -avgs; -avgt; -avgu; -avgv; -avgw; -avgx; -avgy; -avgz; -avha; -avhb; -avhc; -avhd; -avhe; -avhf; -avhg; -avhh; -avhi; -avhj; -avhk; -avhl; -avhm; -avhn; -avho; -avhp; -avhq; -avhr; -avhs; -avht; -avhu; -avhv; -avhw; -avhx; -avhy; -avhz; -avia; -avib; -avic; -avid; -avie; -avif; -avig; -avih; -avii; -avij; -avik; -avil; -avim; -avin; -avio; -avip; -aviq; -avir; -avis; -avit; -aviu; -aviv; -aviw; -avix; -aviy; -aviz; -avja; -avjb; -avjc; -avjd; -avje; -avjf; -avjg; -avjh; -avji; -avjj; -avjk; -avjl; -avjm; -avjn; -avjo; -avjp; -avjq; -avjr; -avjs; -avjt; -avju; -avjv; -avjw; -avjx; -avjy; -avjz; -avka; -avkb; -avkc; -avkd; -avke; -avkf; -avkg; -avkh; -avki; -avkj; -avkk; -avkl; -avkm; -avkn; -avko; -avkp; -avkq; -avkr; -avks; -avkt; -avku; -avkv; -avkw; -avkx; -avky; -avkz; -avla; -avlb; -avlc; -avld; -avle; -avlf; -avlg; -avlh; -avli; -avlj; -avlk; -avll; -avlm; -avln; -avlo; -avlp; -avlq; -avlr; -avls; -avlt; -avlu; -avlv; -avlw; -avlx; -avly; -avlz; -avma; -avmb; -avmc; -avmd; -avme; -avmf; -avmg; -avmh; -avmi; -avmj; -avmk; -avml; -avmm; -avmn; -avmo; -avmp; -avmq; -avmr; -avms; -avmt; -avmu; -avmv; -avmw; -avmx; -avmy; -avmz; -avna; -avnb; -avnc; -avnd; -avne; -avnf; -avng; -avnh; -avni; -avnj; -avnk; -avnl; -avnm; -avnn; -avno; -avnp; -avnq; -avnr; -avns; -avnt; -avnu; -avnv; -avnw; -avnx; -avny; -avnz; -avoa; -avob; -avoc; -avod; -avoe; -avof; -avog; -avoh; -avoi; -avoj; -avok; -avol; -avom; -avon; -avoo; -avop; -avoq; -avor; -avos; -avot; -avou; -avov; -avow; -avox; -avoy; -avoz; -avpa; -avpb; -avpc; -avpd; -avpe; -avpf; -avpg; -avph; -avpi; -avpj; -avpk; -avpl; -avpm; -avpn; -avpo; -avpp; -avpq; -avpr; -avps; -avpt; -avpu; -avpv; -avpw; -avpx; -avpy; -avpz; -avqa; -avqb; -avqc; -avqd; -avqe; -avqf; -avqg; -avqh; -avqi; -avqj; -avqk; -avql; -avqm; -avqn; -avqo; -avqp; -avqq; -avqr; -avqs; -avqt; -avqu; -avqv; -avqw; -avqx; -avqy; -avqz; -avra; -avrb; -avrc; -avrd; -avre; -avrf; -avrg; -avrh; -avri; -avrj; -avrk; -avrl; -avrm; -avrn; -avro; -avrp; -avrq; -avrr; -avrs; -avrt; -avru; -avrv; -avrw; -avrx; -avry; -avrz; -avsa; -avsb; -avsc; -avsd; -avse; -avsf; -avsg; -avsh; -avsi; -avsj; -avsk; -avsl; -avsm; -avsn; -avso; -avsp; -avsq; -avsr; -avss; -avst; -avsu; -avsv; -avsw; -avsx; -avsy; -avsz; -avta; -avtb; -avtc; -avtd; -avte; -avtf; -avtg; -avth; -avti; -avtj; -avtk; -avtl; -avtm; -avtn; -avto; -avtp; -avtq; -avtr; -avts; -avtt; -avtu; -avtv; -avtw; -avtx; -avty; -avtz; -avua; -avub; -avuc; -avud; -avue; -avuf; -avug; -avuh; -avui; -avuj; -avuk; -avul; -avum; -avun; -avuo; -avup; -avuq; -avur; -avus; -avut; -avuu; -avuv; -avuw; -avux; -avuy; -avuz; -avva; -avvb; -avvc; -avvd; -avve; -avvf; -avvg; -avvh; -avvi; -avvj; -avvk; -avvl; -avvm; -avvn; -avvo; -avvp; -avvq; -avvr; -avvs; -avvt; -avvu; -avvv; -avvw; -avvx; -avvy; -avvz; -avwa; -avwb; -avwc; -avwd; -avwe; -avwf; -avwg; -avwh; -avwi; -avwj; -avwk; -avwl; -avwm; -avwn; -avwo; -avwp; -avwq; -avwr; -avws; -avwt; -avwu; -avwv; -avww; -avwx; -avwy; -avwz; -avxa; -avxb; -avxc; -avxd; -avxe; -avxf; -avxg; -avxh; -avxi; -avxj; -avxk; -avxl; -avxm; -avxn; -avxo; -avxp; -avxq; -avxr; -avxs; -avxt; -avxu; -avxv; -avxw; -avxx; -avxy; -avxz; -avya; -avyb; -avyc; -avyd; -avye; -avyf; -avyg; -avyh; -avyi; -avyj; -avyk; -avyl; -avym; -avyn; -avyo; -avyp; -avyq; -avyr; -avys; -avyt; -avyu; -avyv; -avyw; -avyx; -avyy; -avyz; -avza; -avzb; -avzc; -avzd; -avze; -avzf; -avzg; -avzh; -avzi; -avzj; -avzk; -avzl; -avzm; -avzn; -avzo; -avzp; -avzq; -avzr; -avzs; -avzt; -avzu; -avzv; -avzw; -avzx; -avzy; -avzz; -awaa; -awab; -awac; -awad; -awae; -awaf; -awag; -awah; -awai; -awaj; -awak; -awal; -awam; -awan; -awao; -awap; -awaq; -awar; -awas; -awat; -awau; -awav; -awaw; -awax; -away; -awaz; -awba; -awbb; -awbc; -awbd; -awbe; -awbf; -awbg; -awbh; -awbi; -awbj; -awbk; -awbl; -awbm; -awbn; -awbo; -awbp; -awbq; -awbr; -awbs; -awbt; -awbu; -awbv; -awbw; -awbx; -awby; -awbz; -awca; -awcb; -awcc; -awcd; -awce; -awcf; -awcg; -awch; -awci; -awcj; -awck; -awcl; -awcm; -awcn; -awco; -awcp; -awcq; -awcr; -awcs; -awct; -awcu; -awcv; -awcw; -awcx; -awcy; -awcz; -awda; -awdb; -awdc; -awdd; -awde; -awdf; -awdg; -awdh; -awdi; -awdj; -awdk; -awdl; -awdm; -awdn; -awdo; -awdp; -awdq; -awdr; -awds; -awdt; -awdu; -awdv; -awdw; -awdx; -awdy; -awdz; -awea; -aweb; -awec; -awed; -awee; -awef; -aweg; -aweh; -awei; -awej; -awek; -awel; -awem; -awen; -aweo; -awep; -aweq; -awer; -awes; -awet; -aweu; -awev; -awew; -awex; -awey; -awez; -awfa; -awfb; -awfc; -awfd; -awfe; -awff; -awfg; -awfh; -awfi; -awfj; -awfk; -awfl; -awfm; -awfn; -awfo; -awfp; -awfq; -awfr; -awfs; -awft; -awfu; -awfv; -awfw; -awfx; -awfy; -awfz; -awga; -awgb; -awgc; -awgd; -awge; -awgf; -awgg; -awgh; -awgi; -awgj; -awgk; -awgl; -awgm; -awgn; -awgo; -awgp; -awgq; -awgr; -awgs; -awgt; -awgu; -awgv; -awgw; -awgx; -awgy; -awgz; -awha; -awhb; -awhc; -awhd; -awhe; -awhf; -awhg; -awhh; -awhi; -awhj; -awhk; -awhl; -awhm; -awhn; -awho; -awhp; -awhq; -awhr; -awhs; -awht; -awhu; -awhv; -awhw; -awhx; -awhy; -awhz; -awia; -awib; -awic; -awid; -awie; -awif; -awig; -awih; -awii; -awij; -awik; -awil; -awim; -awin; -awio; -awip; -awiq; -awir; -awis; -awit; -awiu; -awiv; -awiw; -awix; -awiy; -awiz; -awja; -awjb; -awjc; -awjd; -awje; -awjf; -awjg; -awjh; -awji; -awjj; -awjk; -awjl; -awjm; -awjn; -awjo; -awjp; -awjq; -awjr; -awjs; -awjt; -awju; -awjv; -awjw; -awjx; -awjy; -awjz; -awka; -awkb; -awkc; -awkd; -awke; -awkf; -awkg; -awkh; -awki; -awkj; -awkk; -awkl; -awkm; -awkn; -awko; -awkp; -awkq; -awkr; -awks; -awkt; -awku; -awkv; -awkw; -awkx; -awky; -awkz; -awla; -awlb; -awlc; -awld; -awle; -awlf; -awlg; -awlh; -awli; -awlj; -awlk; -awll; -awlm; -awln; -awlo; -awlp; -awlq; -awlr; -awls; -awlt; -awlu; -awlv; -awlw; -awlx; -awly; -awlz; -awma; -awmb; -awmc; -awmd; -awme; -awmf; -awmg; -awmh; -awmi; -awmj; -awmk; -awml; -awmm; -awmn; -awmo; -awmp; -awmq; -awmr; -awms; -awmt; -awmu; -awmv; -awmw; -awmx; -awmy; -awmz; -awna; -awnb; -awnc; -awnd; -awne; -awnf; -awng; -awnh; -awni; -awnj; -awnk; -awnl; -awnm; -awnn; -awno; -awnp; -awnq; -awnr; -awns; -awnt; -awnu; -awnv; -awnw; -awnx; -awny; -awnz; -awoa; -awob; -awoc; -awod; -awoe; -awof; -awog; -awoh; -awoi; -awoj; -awok; -awol; -awom; -awon; -awoo; -awop; -awoq; -awor; -awos; -awot; -awou; -awov; -awow; -awox; -awoy; -awoz; -awpa; -awpb; -awpc; -awpd; -awpe; -awpf; -awpg; -awph; -awpi; -awpj; -awpk; -awpl; -awpm; -awpn; -awpo; -awpp; -awpq; -awpr; -awps; -awpt; -awpu; -awpv; -awpw; -awpx; -awpy; -awpz; -awqa; -awqb; -awqc; -awqd; -awqe; -awqf; -awqg; -awqh; -awqi; -awqj; -awqk; -awql; -awqm; -awqn; -awqo; -awqp; -awqq; -awqr; -awqs; -awqt; -awqu; -awqv; -awqw; -awqx; -awqy; -awqz; -awra; -awrb; -awrc; -awrd; -awre; -awrf; -awrg; -awrh; -awri; -awrj; -awrk; -awrl; -awrm; -awrn; -awro; -awrp; -awrq; -awrr; -awrs; -awrt; -awru; -awrv; -awrw; -awrx; -awry; -awrz; -awsa; -awsb; -awsc; -awsd; -awse; -awsf; -awsg; -awsh; -awsi; -awsj; -awsk; -awsl; -awsm; -awsn; -awso; -awsp; -awsq; -awsr; -awss; -awst; -awsu; -awsv; -awsw; -awsx; -awsy; -awsz; -awta; -awtb; -awtc; -awtd; -awte; -awtf; -awtg; -awth; -awti; -awtj; -awtk; -awtl; -awtm; -awtn; -awto; -awtp; -awtq; -awtr; -awts; -awtt; -awtu; -awtv; -awtw; -awtx; -awty; -awtz; -awua; -awub; -awuc; -awud; -awue; -awuf; -awug; -awuh; -awui; -awuj; -awuk; -awul; -awum; -awun; -awuo; -awup; -awuq; -awur; -awus; -awut; -awuu; -awuv; -awuw; -awux; -awuy; -awuz; -awva; -awvb; -awvc; -awvd; -awve; -awvf; -awvg; -awvh; -awvi; -awvj; -awvk; -awvl; -awvm; -awvn; -awvo; -awvp; -awvq; -awvr; -awvs; -awvt; -awvu; -awvv; -awvw; -awvx; -awvy; -awvz; -awwa; -awwb; -awwc; -awwd; -awwe; -awwf; -awwg; -awwh; -awwi; -awwj; -awwk; -awwl; -awwm; -awwn; -awwo; -awwp; -awwq; -awwr; -awws; -awwt; -awwu; -awwv; -awww; -awwx; -awwy; -awwz; -awxa; -awxb; -awxc; -awxd; -awxe; -awxf; -awxg; -awxh; -awxi; -awxj; -awxk; -awxl; -awxm; -awxn; -awxo; -awxp; -awxq; -awxr; -awxs; -awxt; -awxu; -awxv; -awxw; -awxx; -awxy; -awxz; -awya; -awyb; -awyc; -awyd; -awye; -awyf; -awyg; -awyh; -awyi; -awyj; -awyk; -awyl; -awym; -awyn; -awyo; -awyp; -awyq; -awyr; -awys; -awyt; -awyu; -awyv; -awyw; -awyx; -awyy; -awyz; -awza; -awzb; -awzc; -awzd; -awze; -awzf; -awzg; -awzh; -awzi; -awzj; -awzk; -awzl; -awzm; -awzn; -awzo; -awzp; -awzq; -awzr; -awzs; -awzt; -awzu; -awzv; -awzw; -awzx; -awzy; -awzz; -axaa; -axab; -axac; -axad; -axae; -axaf; -axag; -axah; -axai; -axaj; -axak; -axal; -axam; -axan; -axao; -axap; -axaq; -axar; -axas; -axat; -axau; -axav; -axaw; -axax; -axay; -axaz; -axba; -axbb; -axbc; -axbd; -axbe; -axbf; -axbg; -axbh; -axbi; -axbj; -axbk; -axbl; -axbm; -axbn; -axbo; -axbp; -axbq; -axbr; -axbs; -axbt; -axbu; -axbv; -axbw; -axbx; -axby; -axbz; -axca; -axcb; -axcc; -axcd; -axce; -axcf; -axcg; -axch; -axci; -axcj; -axck; -axcl; -axcm; -axcn; -axco; -axcp; -axcq; -axcr; -axcs; -axct; -axcu; -axcv; -axcw; -axcx; -axcy; -axcz; -axda; -axdb; -axdc; -axdd; -axde; -axdf; -axdg; -axdh; -axdi; -axdj; -axdk; -axdl; -axdm; -axdn; -axdo; -axdp; -axdq; -axdr; -axds; -axdt; -axdu; -axdv; -axdw; -axdx; -axdy; -axdz; -axea; -axeb; -axec; -axed; -axee; -axef; -axeg; -axeh; -axei; -axej; -axek; -axel; -axem; -axen; -axeo; -axep; -axeq; -axer; -axes; -axet; -axeu; -axev; -axew; -axex; -axey; -axez; -axfa; -axfb; -axfc; -axfd; -axfe; -axff; -axfg; -axfh; -axfi; -axfj; -axfk; -axfl; -axfm; -axfn; -axfo; -axfp; -axfq; -axfr; -axfs; -axft; -axfu; -axfv; -axfw; -axfx; -axfy; -axfz; -axga; -axgb; -axgc; -axgd; -axge; -axgf; -axgg; -axgh; -axgi; -axgj; -axgk; -axgl; -axgm; -axgn; -axgo; -axgp; -axgq; -axgr; -axgs; -axgt; -axgu; -axgv; -axgw; -axgx; -axgy; -axgz; -axha; -axhb; -axhc; -axhd; -axhe; -axhf; -axhg; -axhh; -axhi; -axhj; -axhk; -axhl; -axhm; -axhn; -axho; -axhp; -axhq; -axhr; -axhs; -axht; -axhu; -axhv; -axhw; -axhx; -axhy; -axhz; -axia; -axib; -axic; -axid; -axie; -axif; -axig; -axih; -axii; -axij; -axik; -axil; -axim; -axin; -axio; -axip; -axiq; -axir; -axis; -axit; -axiu; -axiv; -axiw; -axix; -axiy; -axiz; -axja; -axjb; -axjc; -axjd; -axje; -axjf; -axjg; -axjh; -axji; -axjj; -axjk; -axjl; -axjm; -axjn; -axjo; -axjp; -axjq; -axjr; -axjs; -axjt; -axju; -axjv; -axjw; -axjx; -axjy; -axjz; -axka; -axkb; -axkc; -axkd; -axke; -axkf; -axkg; -axkh; -axki; -axkj; -axkk; -axkl; -axkm; -axkn; -axko; -axkp; -axkq; -axkr; -axks; -axkt; -axku; -axkv; -axkw; -axkx; -axky; -axkz; -axla; -axlb; -axlc; -axld; -axle; -axlf; -axlg; -axlh; -axli; -axlj; -axlk; -axll; -axlm; -axln; -axlo; -axlp; -axlq; -axlr; -axls; -axlt; -axlu; -axlv; -axlw; -axlx; -axly; -axlz; -axma; -axmb; -axmc; -axmd; -axme; -axmf; -axmg; -axmh; -axmi; -axmj; -axmk; -axml; -axmm; -axmn; -axmo; -axmp; -axmq; -axmr; -axms; -axmt; -axmu; -axmv; -axmw; -axmx; -axmy; -axmz; -axna; -axnb; -axnc; -axnd; -axne; -axnf; -axng; -axnh; -axni; -axnj; -axnk; -axnl; -axnm; -axnn; -axno; -axnp; -axnq; -axnr; -axns; -axnt; -axnu; -axnv; -axnw; -axnx; -axny; -axnz; -axoa; -axob; -axoc; -axod; -axoe; -axof; -axog; -axoh; -axoi; -axoj; -axok; -axol; -axom; -axon; -axoo; -axop; -axoq; -axor; -axos; -axot; -axou; -axov; -axow; -axox; -axoy; -axoz; -axpa; -axpb; -axpc; -axpd; -axpe; -axpf; -axpg; -axph; -axpi; -axpj; -axpk; -axpl; -axpm; -axpn; -axpo; -axpp; -axpq; -axpr; -axps; -axpt; -axpu; -axpv; -axpw; -axpx; -axpy; -axpz; -axqa; -axqb; -axqc; -axqd; -axqe; -axqf; -axqg; -axqh; -axqi; -axqj; -axqk; -axql; -axqm; -axqn; -axqo; -axqp; -axqq; -axqr; -axqs; -axqt; -axqu; -axqv; -axqw; -axqx; -axqy; -axqz; -axra; -axrb; -axrc; -axrd; -axre; -axrf; -axrg; -axrh; -axri; -axrj; -axrk; -axrl; -axrm; -axrn; -axro; -axrp; -axrq; -axrr; -axrs; -axrt; -axru; -axrv; -axrw; -axrx; -axry; -axrz; -axsa; -axsb; -axsc; -axsd; -axse; -axsf; -axsg; -axsh; -axsi; -axsj; -axsk; -axsl; -axsm; -axsn; -axso; -axsp; -axsq; -axsr; -axss; -axst; -axsu; -axsv; -axsw; -axsx; -axsy; -axsz; -axta; -axtb; -axtc; -axtd; -axte; -axtf; -axtg; -axth; -axti; -axtj; -axtk; -axtl; -axtm; -axtn; -axto; -axtp; -axtq; -axtr; -axts; -axtt; -axtu; -axtv; -axtw; -axtx; -axty; -axtz; -axua; -axub; -axuc; -axud; -axue; -axuf; -axug; -axuh; -axui; -axuj; -axuk; -axul; -axum; -axun; -axuo; -axup; -axuq; -axur; -axus; -axut; -axuu; -axuv; -axuw; -axux; -axuy; -axuz; -axva; -axvb; -axvc; -axvd; -axve; -axvf; -axvg; -axvh; -axvi; -axvj; -axvk; -axvl; -axvm; -axvn; -axvo; -axvp; -axvq; -axvr; -axvs; -axvt; -axvu; -axvv; -axvw; -axvx; -axvy; -axvz; -axwa; -axwb; -axwc; -axwd; -axwe; -axwf; -axwg; -axwh; -axwi; -axwj; -axwk; -axwl; -axwm; -axwn; -axwo; -axwp; -axwq; -axwr; -axws; -axwt; -axwu; -axwv; -axww; -axwx; -axwy; -axwz; -axxa; -axxb; -axxc; -axxd; -axxe; -axxf; -axxg; -axxh; -axxi; -axxj; -axxk; -axxl; -axxm; -axxn; -axxo; -axxp; -axxq; -axxr; -axxs; -axxt; -axxu; -axxv; -axxw; -axxx; -axxy; -axxz; -axya; -axyb; -axyc; -axyd; -axye; -axyf; -axyg; -axyh; -axyi; -axyj; -axyk; -axyl; -axym; -axyn; -axyo; -axyp; -axyq; -axyr; -axys; -axyt; -axyu; -axyv; -axyw; -axyx; -axyy; -axyz; -axza; -axzb; -axzc; -axzd; -axze; -axzf; -axzg; -axzh; -axzi; -axzj; -axzk; -axzl; -axzm; -axzn; -axzo; -axzp; -axzq; -axzr; -axzs; -axzt; -axzu; -axzv; -axzw; -axzx; -axzy; -axzz; -ayaa; -ayab; -ayac; -ayad; -ayae; -ayaf; -ayag; -ayah; -ayai; -ayaj; -ayak; -ayal; -ayam; -ayan; -ayao; -ayap; -ayaq; -ayar; -ayas; -ayat; -ayau; -ayav; -ayaw; -ayax; -ayay; -ayaz; -ayba; -aybb; -aybc; -aybd; -aybe; -aybf; -aybg; -aybh; -aybi; -aybj; -aybk; -aybl; -aybm; -aybn; -aybo; -aybp; -aybq; -aybr; -aybs; -aybt; -aybu; -aybv; -aybw; -aybx; -ayby; -aybz; -ayca; -aycb; -aycc; -aycd; -ayce; -aycf; -aycg; -aych; -ayci; -aycj; -ayck; -aycl; -aycm; -aycn; -ayco; -aycp; -aycq; -aycr; -aycs; -ayct; -aycu; -aycv; -aycw; -aycx; -aycy; -aycz; -ayda; -aydb; -aydc; -aydd; -ayde; -aydf; -aydg; -aydh; -aydi; -aydj; -aydk; -aydl; -aydm; -aydn; -aydo; -aydp; -aydq; -aydr; -ayds; -aydt; -aydu; -aydv; -aydw; -aydx; -aydy; -aydz; -ayea; -ayeb; -ayec; -ayed; -ayee; -ayef; -ayeg; -ayeh; -ayei; -ayej; -ayek; -ayel; -ayem; -ayen; -ayeo; -ayep; -ayeq; -ayer; -ayes; -ayet; -ayeu; -ayev; -ayew; -ayex; -ayey; -ayez; -ayfa; -ayfb; -ayfc; -ayfd; -ayfe; -ayff; -ayfg; -ayfh; -ayfi; -ayfj; -ayfk; -ayfl; -ayfm; -ayfn; -ayfo; -ayfp; -ayfq; -ayfr; -ayfs; -ayft; -ayfu; -ayfv; -ayfw; -ayfx; -ayfy; -ayfz; -ayga; -aygb; -aygc; -aygd; -ayge; -aygf; -aygg; -aygh; -aygi; -aygj; -aygk; -aygl; -aygm; -aygn; -aygo; -aygp; -aygq; -aygr; -aygs; -aygt; -aygu; -aygv; -aygw; -aygx; -aygy; -aygz; -ayha; -ayhb; -ayhc; -ayhd; -ayhe; -ayhf; -ayhg; -ayhh; -ayhi; -ayhj; -ayhk; -ayhl; -ayhm; -ayhn; -ayho; -ayhp; -ayhq; -ayhr; -ayhs; -ayht; -ayhu; -ayhv; -ayhw; -ayhx; -ayhy; -ayhz; -ayia; -ayib; -ayic; -ayid; -ayie; -ayif; -ayig; -ayih; -ayii; -ayij; -ayik; -ayil; -ayim; -ayin; -ayio; -ayip; -ayiq; -ayir; -ayis; -ayit; -ayiu; -ayiv; -ayiw; -ayix; -ayiy; -ayiz; -ayja; -ayjb; -ayjc; -ayjd; -ayje; -ayjf; -ayjg; -ayjh; -ayji; -ayjj; -ayjk; -ayjl; -ayjm; -ayjn; -ayjo; -ayjp; -ayjq; -ayjr; -ayjs; -ayjt; -ayju; -ayjv; -ayjw; -ayjx; -ayjy; -ayjz; -ayka; -aykb; -aykc; -aykd; -ayke; -aykf; -aykg; -aykh; -ayki; -aykj; -aykk; -aykl; -aykm; -aykn; -ayko; -aykp; -aykq; -aykr; -ayks; -aykt; -ayku; -aykv; -aykw; -aykx; -ayky; -aykz; -ayla; -aylb; -aylc; -ayld; -ayle; -aylf; -aylg; -aylh; -ayli; -aylj; -aylk; -ayll; -aylm; -ayln; -aylo; -aylp; -aylq; -aylr; -ayls; -aylt; -aylu; -aylv; -aylw; -aylx; -ayly; -aylz; -ayma; -aymb; -aymc; -aymd; -ayme; -aymf; -aymg; -aymh; -aymi; -aymj; -aymk; -ayml; -aymm; -aymn; -aymo; -aymp; -aymq; -aymr; -ayms; -aymt; -aymu; -aymv; -aymw; -aymx; -aymy; -aymz; -ayna; -aynb; -aync; -aynd; -ayne; -aynf; -ayng; -aynh; -ayni; -aynj; -aynk; -aynl; -aynm; -aynn; -ayno; -aynp; -aynq; -aynr; -ayns; -aynt; -aynu; -aynv; -aynw; -aynx; -ayny; -aynz; -ayoa; -ayob; -ayoc; -ayod; -ayoe; -ayof; -ayog; -ayoh; -ayoi; -ayoj; -ayok; -ayol; -ayom; -ayon; -ayoo; -ayop; -ayoq; -ayor; -ayos; -ayot; -ayou; -ayov; -ayow; -ayox; -ayoy; -ayoz; -aypa; -aypb; -aypc; -aypd; -aype; -aypf; -aypg; -ayph; -aypi; -aypj; -aypk; -aypl; -aypm; -aypn; -aypo; -aypp; -aypq; -aypr; -ayps; -aypt; -aypu; -aypv; -aypw; -aypx; -aypy; -aypz; -ayqa; -ayqb; -ayqc; -ayqd; -ayqe; -ayqf; -ayqg; -ayqh; -ayqi; -ayqj; -ayqk; -ayql; -ayqm; -ayqn; -ayqo; -ayqp; -ayqq; -ayqr; -ayqs; -ayqt; -ayqu; -ayqv; -ayqw; -ayqx; -ayqy; -ayqz; -ayra; -ayrb; -ayrc; -ayrd; -ayre; -ayrf; -ayrg; -ayrh; -ayri; -ayrj; -ayrk; -ayrl; -ayrm; -ayrn; -ayro; -ayrp; -ayrq; -ayrr; -ayrs; -ayrt; -ayru; -ayrv; -ayrw; -ayrx; -ayry; -ayrz; -aysa; -aysb; -aysc; -aysd; -ayse; -aysf; -aysg; -aysh; -aysi; -aysj; -aysk; -aysl; -aysm; -aysn; -ayso; -aysp; -aysq; -aysr; -ayss; -ayst; -aysu; -aysv; -aysw; -aysx; -aysy; -aysz; -ayta; -aytb; -aytc; -aytd; -ayte; -aytf; -aytg; -ayth; -ayti; -aytj; -aytk; -aytl; -aytm; -aytn; -ayto; -aytp; -aytq; -aytr; -ayts; -aytt; -aytu; -aytv; -aytw; -aytx; -ayty; -aytz; -ayua; -ayub; -ayuc; -ayud; -ayue; -ayuf; -ayug; -ayuh; -ayui; -ayuj; -ayuk; -ayul; -ayum; -ayun; -ayuo; -ayup; -ayuq; -ayur; -ayus; -ayut; -ayuu; -ayuv; -ayuw; -ayux; -ayuy; -ayuz; -ayva; -ayvb; -ayvc; -ayvd; -ayve; -ayvf; -ayvg; -ayvh; -ayvi; -ayvj; -ayvk; -ayvl; -ayvm; -ayvn; -ayvo; -ayvp; -ayvq; -ayvr; -ayvs; -ayvt; -ayvu; -ayvv; -ayvw; -ayvx; -ayvy; -ayvz; -aywa; -aywb; -aywc; -aywd; -aywe; -aywf; -aywg; -aywh; -aywi; -aywj; -aywk; -aywl; -aywm; -aywn; -aywo; -aywp; -aywq; -aywr; -ayws; -aywt; -aywu; -aywv; -ayww; -aywx; -aywy; -aywz; -ayxa; -ayxb; -ayxc; -ayxd; -ayxe; -ayxf; -ayxg; -ayxh; -ayxi; -ayxj; -ayxk; -ayxl; -ayxm; -ayxn; -ayxo; -ayxp; -ayxq; -ayxr; -ayxs; -ayxt; -ayxu; -ayxv; -ayxw; -ayxx; -ayxy; -ayxz; -ayya; -ayyb; -ayyc; -ayyd; -ayye; -ayyf; -ayyg; -ayyh; -ayyi; -ayyj; -ayyk; -ayyl; -ayym; -ayyn; -ayyo; -ayyp; -ayyq; -ayyr; -ayys; -ayyt; -ayyu; -ayyv; -ayyw; -ayyx; -ayyy; -ayyz; -ayza; -ayzb; -ayzc; -ayzd; -ayze; -ayzf; -ayzg; -ayzh; -ayzi; -ayzj; -ayzk; -ayzl; -ayzm; -ayzn; -ayzo; -ayzp; -ayzq; -ayzr; -ayzs; -ayzt; -ayzu; -ayzv; -ayzw; -ayzx; -ayzy; -ayzz; -azaa; -azab; -azac; -azad; -azae; -azaf; -azag; -azah; -azai; -azaj; -azak; -azal; -azam; -azan; -azao; -azap; -azaq; -azar; -azas; -azat; -azau; -azav; -azaw; -azax; -azay; -azaz; -azba; -azbb; -azbc; -azbd; -azbe; -azbf; -azbg; -azbh; -azbi; -azbj; -azbk; -azbl; -azbm; -azbn; -azbo; -azbp; -azbq; -azbr; -azbs; -azbt; -azbu; -azbv; -azbw; -azbx; -azby; -azbz; -azca; -azcb; -azcc; -azcd; -azce; -azcf; -azcg; -azch; -azci; -azcj; -azck; -azcl; -azcm; -azcn; -azco; -azcp; -azcq; -azcr; -azcs; -azct; -azcu; -azcv; -azcw; -azcx; -azcy; -azcz; -azda; -azdb; -azdc; -azdd; -azde; -azdf; -azdg; -azdh; -azdi; -azdj; -azdk; -azdl; -azdm; -azdn; -azdo; -azdp; -azdq; -azdr; -azds; -azdt; -azdu; -azdv; -azdw; -azdx; -azdy; -azdz; -azea; -azeb; -azec; -azed; -azee; -azef; -azeg; -azeh; -azei; -azej; -azek; -azel; -azem; -azen; -azeo; -azep; -azeq; -azer; -azes; -azet; -azeu; -azev; -azew; -azex; -azey; -azez; -azfa; -azfb; -azfc; -azfd; -azfe; -azff; -azfg; -azfh; -azfi; -azfj; -azfk; -azfl; -azfm; -azfn; -azfo; -azfp; -azfq; -azfr; -azfs; -azft; -azfu; -azfv; -azfw; -azfx; -azfy; -azfz; -azga; -azgb; -azgc; -azgd; -azge; -azgf; -azgg; -azgh; -azgi; -azgj; -azgk; -azgl; -azgm; -azgn; -azgo; -azgp; -azgq; -azgr; -azgs; -azgt; -azgu; -azgv; -azgw; -azgx; -azgy; -azgz; -azha; -azhb; -azhc; -azhd; -azhe; -azhf; -azhg; -azhh; -azhi; -azhj; -azhk; -azhl; -azhm; -azhn; -azho; -azhp; -azhq; -azhr; -azhs; -azht; -azhu; -azhv; -azhw; -azhx; -azhy; -azhz; -azia; -azib; -azic; -azid; -azie; -azif; -azig; -azih; -azii; -azij; -azik; -azil; -azim; -azin; -azio; -azip; -aziq; -azir; -azis; -azit; -aziu; -aziv; -aziw; -azix; -aziy; -aziz; -azja; -azjb; -azjc; -azjd; -azje; -azjf; -azjg; -azjh; -azji; -azjj; -azjk; -azjl; -azjm; -azjn; -azjo; -azjp; -azjq; -azjr; -azjs; -azjt; -azju; -azjv; -azjw; -azjx; -azjy; -azjz; -azka; -azkb; -azkc; -azkd; -azke; -azkf; -azkg; -azkh; -azki; -azkj; -azkk; -azkl; -azkm; -azkn; -azko; -azkp; -azkq; -azkr; -azks; -azkt; -azku; -azkv; -azkw; -azkx; -azky; -azkz; -azla; -azlb; -azlc; -azld; -azle; -azlf; -azlg; -azlh; -azli; -azlj; -azlk; -azll; -azlm; -azln; -azlo; -azlp; -azlq; -azlr; -azls; -azlt; -azlu; -azlv; -azlw; -azlx; -azly; -azlz; -azma; -azmb; -azmc; -azmd; -azme; -azmf; -azmg; -azmh; -azmi; -azmj; -azmk; -azml; -azmm; -azmn; -azmo; -azmp; -azmq; -azmr; -azms; -azmt; -azmu; -azmv; -azmw; -azmx; -azmy; -azmz; -azna; -aznb; -aznc; -aznd; -azne; -aznf; -azng; -aznh; -azni; -aznj; -aznk; -aznl; -aznm; -aznn; -azno; -aznp; -aznq; -aznr; -azns; -aznt; -aznu; -aznv; -aznw; -aznx; -azny; -aznz; -azoa; -azob; -azoc; -azod; -azoe; -azof; -azog; -azoh; -azoi; -azoj; -azok; -azol; -azom; -azon; -azoo; -azop; -azoq; -azor; -azos; -azot; -azou; -azov; -azow; -azox; -azoy; -azoz; -azpa; -azpb; -azpc; -azpd; -azpe; -azpf; -azpg; -azph; -azpi; -azpj; -azpk; -azpl; -azpm; -azpn; -azpo; -azpp; -azpq; -azpr; -azps; -azpt; -azpu; -azpv; -azpw; -azpx; -azpy; -azpz; -azqa; -azqb; -azqc; -azqd; -azqe; -azqf; -azqg; -azqh; -azqi; -azqj; -azqk; -azql; -azqm; -azqn; -azqo; -azqp; -azqq; -azqr; -azqs; -azqt; -azqu; -azqv; -azqw; -azqx; -azqy; -azqz; -azra; -azrb; -azrc; -azrd; -azre; -azrf; -azrg; -azrh; -azri; -azrj; -azrk; -azrl; -azrm; -azrn; -azro; -azrp; -azrq; -azrr; -azrs; -azrt; -azru; -azrv; -azrw; -azrx; -azry; -azrz; -azsa; -azsb; -azsc; -azsd; -azse; -azsf; -azsg; -azsh; -azsi; -azsj; -azsk; -azsl; -azsm; -azsn; -azso; -azsp; -azsq; -azsr; -azss; -azst; -azsu; -azsv; -azsw; -azsx; -azsy; -azsz; -azta; -aztb; -aztc; -aztd; -azte; -aztf; -aztg; -azth; -azti; -aztj; -aztk; -aztl; -aztm; -aztn; -azto; -aztp; -aztq; -aztr; -azts; -aztt; -aztu; -aztv; -aztw; -aztx; -azty; -aztz; -azua; -azub; -azuc; -azud; -azue; -azuf; -azug; -azuh; -azui; -azuj; -azuk; -azul; -azum; -azun; -azuo; -azup; -azuq; -azur; -azus; -azut; -azuu; -azuv; -azuw; -azux; -azuy; -azuz; -azva; -azvb; -azvc; -azvd; -azve; -azvf; -azvg; -azvh; -azvi; -azvj; -azvk; -azvl; -azvm; -azvn; -azvo; -azvp; -azvq; -azvr; -azvs; -azvt; -azvu; -azvv; -azvw; -azvx; -azvy; -azvz; -azwa; -azwb; -azwc; -azwd; -azwe; -azwf; -azwg; -azwh; -azwi; -azwj; -azwk; -azwl; -azwm; -azwn; -azwo; -azwp; -azwq; -azwr; -azws; -azwt; -azwu; -azwv; -azww; -azwx; -azwy; -azwz; -azxa; -azxb; -azxc; -azxd; -azxe; -azxf; -azxg; -azxh; -azxi; -azxj; -azxk; -azxl; -azxm; -azxn; -azxo; -azxp; -azxq; -azxr; -azxs; -azxt; -azxu; -azxv; -azxw; -azxx; -azxy; -azxz; -azya; -azyb; -azyc; -azyd; -azye; -azyf; -azyg; -azyh; -azyi; -azyj; -azyk; -azyl; -azym; -azyn; -azyo; -azyp; -azyq; -azyr; -azys; -azyt; -azyu; -azyv; -azyw; -azyx; -azyy; -azyz; -azza; -azzb; -azzc; -azzd; -azze; -azzf; -azzg; -azzh; -azzi; -azzj; -azzk; -azzl; -azzm; -azzn; -azzo; -azzp; -azzq; -azzr; -azzs; -azzt; -azzu; -azzv; -azzw; -azzx; -azzy; -azzz; -baaa; -baab; -baac; -baad; -baae; -baaf; -baag; -baah; -baai; -baaj; -baak; -baal; -baam; -baan; -baao; -baap; -baaq; -baar; -baas; -baat; -baau; -baav; -baaw; -baax; -baay; -baaz; -baba; -babb; -babc; -babd; -babe; -babf; -babg; -babh; -babi; -babj; -babk; -babl; -babm; -babn; -babo; -babp; -babq; -babr; -babs; -babt; -babu; -babv; -babw; -babx; -baby; -babz; -baca; -bacb; -bacc; -bacd; -bace; -bacf; -bacg; -bach; -baci; -bacj; -back; -bacl; -bacm; -bacn; -baco; -bacp; -bacq; -bacr; -bacs; -bact; -bacu; -bacv; -bacw; -bacx; -bacy; -bacz; -bada; -badb; -badc; -badd; -bade; -badf; -badg; -badh; -badi; -badj; -badk; -badl; -badm; -badn; -bado; -badp; -badq; -badr; -bads; -badt; -badu; -badv; -badw; -badx; -bady; -badz; -baea; -baeb; -baec; -baed; -baee; -baef; -baeg; -baeh; -baei; -baej; -baek; -bael; -baem; -baen; -baeo; -baep; -baeq; -baer; -baes; -baet; -baeu; -baev; -baew; -baex; -baey; -baez; -bafa; -bafb; -bafc; -bafd; -bafe; -baff; -bafg; -bafh; -bafi; -bafj; -bafk; -bafl; -bafm; -bafn; -bafo; -bafp; -bafq; -bafr; -bafs; -baft; -bafu; -bafv; -bafw; -bafx; -bafy; -bafz; -baga; -bagb; -bagc; -bagd; -bage; -bagf; -bagg; -bagh; -bagi; -bagj; -bagk; -bagl; -bagm; -bagn; -bago; -bagp; -bagq; -bagr; -bags; -bagt; -bagu; -bagv; -bagw; -bagx; -bagy; -bagz; -baha; -bahb; -bahc; -bahd; -bahe; -bahf; -bahg; -bahh; -bahi; -bahj; -bahk; -bahl; -bahm; -bahn; -baho; -bahp; -bahq; -bahr; -bahs; -baht; -bahu; -bahv; -bahw; -bahx; -bahy; -bahz; -baia; -baib; -baic; -baid; -baie; -baif; -baig; -baih; -baii; -baij; -baik; -bail; -baim; -bain; -baio; -baip; -baiq; -bair; -bais; -bait; -baiu; -baiv; -baiw; -baix; -baiy; -baiz; -baja; -bajb; -bajc; -bajd; -baje; -bajf; -bajg; -bajh; -baji; -bajj; -bajk; -bajl; -bajm; -bajn; -bajo; -bajp; -bajq; -bajr; -bajs; -bajt; -baju; -bajv; -bajw; -bajx; -bajy; -bajz; -baka; -bakb; -bakc; -bakd; -bake; -bakf; -bakg; -bakh; -baki; -bakj; -bakk; -bakl; -bakm; -bakn; -bako; -bakp; -bakq; -bakr; -baks; -bakt; -baku; -bakv; -bakw; -bakx; -baky; -bakz; -bala; -balb; -balc; -bald; -bale; -balf; -balg; -balh; -bali; -balj; -balk; -ball; -balm; -baln; -balo; -balp; -balq; -balr; -bals; -balt; -balu; -balv; -balw; -balx; -baly; -balz; -bama; -bamb; -bamc; -bamd; -bame; -bamf; -bamg; -bamh; -bami; -bamj; -bamk; -baml; -bamm; -bamn; -bamo; -bamp; -bamq; -bamr; -bams; -bamt; -bamu; -bamv; -bamw; -bamx; -bamy; -bamz; -bana; -banb; -banc; -band; -bane; -banf; -bang; -banh; -bani; -banj; -bank; -banl; -banm; -bann; -bano; -banp; -banq; -banr; -bans; -bant; -banu; -banv; -banw; -banx; -bany; -banz; -baoa; -baob; -baoc; -baod; -baoe; -baof; -baog; -baoh; -baoi; -baoj; -baok; -baol; -baom; -baon; -baoo; -baop; -baoq; -baor; -baos; -baot; -baou; -baov; -baow; -baox; -baoy; -baoz; -bapa; -bapb; -bapc; -bapd; -bape; -bapf; -bapg; -baph; -bapi; -bapj; -bapk; -bapl; -bapm; -bapn; -bapo; -bapp; -bapq; -bapr; -baps; -bapt; -bapu; -bapv; -bapw; -bapx; -bapy; -bapz; -baqa; -baqb; -baqc; -baqd; -baqe; -baqf; -baqg; -baqh; -baqi; -baqj; -baqk; -baql; -baqm; -baqn; -baqo; -baqp; -baqq; -baqr; -baqs; -baqt; -baqu; -baqv; -baqw; -baqx; -baqy; -baqz; -bara; -barb; -barc; -bard; -bare; -barf; -barg; -barh; -bari; -barj; -bark; -barl; -barm; -barn; -baro; -barp; -barq; -barr; -bars; -bart; -baru; -barv; -barw; -barx; -bary; -barz; -basa; -basb; -basc; -basd; -base; -basf; -basg; -bash; -basi; -basj; -bask; -basl; -basm; -basn; -baso; -basp; -basq; -basr; -bass; -bast; -basu; -basv; -basw; -basx; -basy; -basz; -bata; -batb; -batc; -batd; -bate; -batf; -batg; -bath; -bati; -batj; -batk; -batl; -batm; -batn; -bato; -batp; -batq; -batr; -bats; -batt; -batu; -batv; -batw; -batx; -baty; -batz; -baua; -baub; -bauc; -baud; -baue; -bauf; -baug; -bauh; -baui; -bauj; -bauk; -baul; -baum; -baun; -bauo; -baup; -bauq; -baur; -baus; -baut; -bauu; -bauv; -bauw; -baux; -bauy; -bauz; -bava; -bavb; -bavc; -bavd; -bave; -bavf; -bavg; -bavh; -bavi; -bavj; -bavk; -bavl; -bavm; -bavn; -bavo; -bavp; -bavq; -bavr; -bavs; -bavt; -bavu; -bavv; -bavw; -bavx; -bavy; -bavz; -bawa; -bawb; -bawc; -bawd; -bawe; -bawf; -bawg; -bawh; -bawi; -bawj; -bawk; -bawl; -bawm; -bawn; -bawo; -bawp; -bawq; -bawr; -baws; -bawt; -bawu; -bawv; -baww; -bawx; -bawy; -bawz; -baxa; -baxb; -baxc; -baxd; -baxe; -baxf; -baxg; -baxh; -baxi; -baxj; -baxk; -baxl; -baxm; -baxn; -baxo; -baxp; -baxq; -baxr; -baxs; -baxt; -baxu; -baxv; -baxw; -baxx; -baxy; -baxz; -baya; -bayb; -bayc; -bayd; -baye; -bayf; -bayg; -bayh; -bayi; -bayj; -bayk; -bayl; -baym; -bayn; -bayo; -bayp; -bayq; -bayr; -bays; -bayt; -bayu; -bayv; -bayw; -bayx; -bayy; -bayz; -baza; -bazb; -bazc; -bazd; -baze; -bazf; -bazg; -bazh; -bazi; -bazj; -bazk; -bazl; -bazm; -bazn; -bazo; -bazp; -bazq; -bazr; -bazs; -bazt; -bazu; -bazv; -bazw; -bazx; -bazy; -bazz; -bbaa; -bbab; -bbac; -bbad; -bbae; -bbaf; -bbag; -bbah; -bbai; -bbaj; -bbak; -bbal; -bbam; -bban; -bbao; -bbap; -bbaq; -bbar; -bbas; -bbat; -bbau; -bbav; -bbaw; -bbax; -bbay; -bbaz; -bbba; -bbbb -|]; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/big-tab3.ml ocaml-4.01.0/camlp4/test/fixtures/big-tab3.ml --- ocaml-3.12.1/camlp4/test/fixtures/big-tab3.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/big-tab3.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,20001 +0,0 @@ -[| -aaaaa; -aaaab; -aaaac; -aaaad; -aaaae; -aaaaf; -aaaag; -aaaah; -aaaai; -aaaaj; -aaaak; -aaaal; -aaaam; -aaaan; -aaaao; -aaaap; -aaaaq; -aaaar; -aaaas; -aaaat; -aaaau; -aaaav; -aaaaw; -aaaax; -aaaay; -aaaaz; -aaaba; -aaabb; -aaabc; -aaabd; -aaabe; -aaabf; -aaabg; -aaabh; -aaabi; -aaabj; -aaabk; -aaabl; -aaabm; -aaabn; -aaabo; -aaabp; -aaabq; -aaabr; -aaabs; -aaabt; -aaabu; -aaabv; -aaabw; -aaabx; -aaaby; -aaabz; -aaaca; -aaacb; -aaacc; -aaacd; -aaace; -aaacf; -aaacg; -aaach; -aaaci; -aaacj; -aaack; -aaacl; -aaacm; -aaacn; -aaaco; -aaacp; -aaacq; -aaacr; -aaacs; -aaact; -aaacu; -aaacv; -aaacw; -aaacx; -aaacy; -aaacz; -aaada; -aaadb; -aaadc; -aaadd; -aaade; -aaadf; -aaadg; -aaadh; -aaadi; -aaadj; -aaadk; -aaadl; -aaadm; -aaadn; -aaado; -aaadp; -aaadq; -aaadr; -aaads; -aaadt; -aaadu; -aaadv; -aaadw; -aaadx; -aaady; -aaadz; -aaaea; -aaaeb; -aaaec; -aaaed; -aaaee; -aaaef; -aaaeg; -aaaeh; -aaaei; -aaaej; -aaaek; -aaael; -aaaem; -aaaen; -aaaeo; -aaaep; -aaaeq; -aaaer; -aaaes; -aaaet; -aaaeu; -aaaev; -aaaew; -aaaex; -aaaey; -aaaez; -aaafa; -aaafb; -aaafc; -aaafd; -aaafe; -aaaff; -aaafg; -aaafh; -aaafi; -aaafj; -aaafk; -aaafl; -aaafm; -aaafn; -aaafo; -aaafp; -aaafq; -aaafr; -aaafs; -aaaft; -aaafu; -aaafv; -aaafw; -aaafx; -aaafy; -aaafz; -aaaga; -aaagb; -aaagc; -aaagd; -aaage; -aaagf; -aaagg; -aaagh; -aaagi; -aaagj; -aaagk; -aaagl; -aaagm; -aaagn; -aaago; -aaagp; -aaagq; -aaagr; -aaags; -aaagt; -aaagu; -aaagv; -aaagw; -aaagx; -aaagy; -aaagz; -aaaha; -aaahb; -aaahc; -aaahd; -aaahe; -aaahf; -aaahg; -aaahh; -aaahi; -aaahj; -aaahk; -aaahl; -aaahm; -aaahn; -aaaho; -aaahp; -aaahq; -aaahr; -aaahs; -aaaht; -aaahu; -aaahv; -aaahw; -aaahx; -aaahy; -aaahz; -aaaia; -aaaib; -aaaic; -aaaid; -aaaie; -aaaif; -aaaig; -aaaih; -aaaii; -aaaij; -aaaik; -aaail; -aaaim; -aaain; -aaaio; -aaaip; -aaaiq; -aaair; -aaais; -aaait; -aaaiu; -aaaiv; -aaaiw; -aaaix; -aaaiy; -aaaiz; -aaaja; -aaajb; -aaajc; -aaajd; -aaaje; -aaajf; -aaajg; -aaajh; -aaaji; -aaajj; -aaajk; -aaajl; -aaajm; -aaajn; -aaajo; -aaajp; -aaajq; -aaajr; -aaajs; -aaajt; -aaaju; -aaajv; -aaajw; -aaajx; -aaajy; -aaajz; -aaaka; -aaakb; -aaakc; -aaakd; -aaake; -aaakf; -aaakg; -aaakh; -aaaki; -aaakj; -aaakk; -aaakl; -aaakm; -aaakn; -aaako; -aaakp; -aaakq; -aaakr; -aaaks; -aaakt; -aaaku; -aaakv; -aaakw; -aaakx; -aaaky; -aaakz; -aaala; -aaalb; -aaalc; -aaald; -aaale; -aaalf; -aaalg; -aaalh; -aaali; -aaalj; -aaalk; -aaall; -aaalm; -aaaln; -aaalo; -aaalp; -aaalq; -aaalr; -aaals; -aaalt; -aaalu; -aaalv; -aaalw; -aaalx; -aaaly; -aaalz; -aaama; -aaamb; -aaamc; -aaamd; -aaame; -aaamf; -aaamg; -aaamh; -aaami; -aaamj; -aaamk; -aaaml; -aaamm; -aaamn; -aaamo; -aaamp; -aaamq; -aaamr; -aaams; -aaamt; -aaamu; -aaamv; -aaamw; -aaamx; -aaamy; -aaamz; -aaana; -aaanb; -aaanc; -aaand; -aaane; -aaanf; -aaang; -aaanh; -aaani; -aaanj; -aaank; -aaanl; -aaanm; -aaann; -aaano; -aaanp; -aaanq; -aaanr; -aaans; -aaant; -aaanu; -aaanv; -aaanw; -aaanx; -aaany; -aaanz; -aaaoa; -aaaob; -aaaoc; -aaaod; -aaaoe; -aaaof; -aaaog; -aaaoh; -aaaoi; -aaaoj; -aaaok; -aaaol; -aaaom; -aaaon; -aaaoo; -aaaop; -aaaoq; -aaaor; -aaaos; -aaaot; -aaaou; -aaaov; -aaaow; -aaaox; -aaaoy; -aaaoz; -aaapa; -aaapb; -aaapc; -aaapd; -aaape; -aaapf; -aaapg; -aaaph; -aaapi; -aaapj; -aaapk; -aaapl; -aaapm; -aaapn; -aaapo; -aaapp; -aaapq; -aaapr; -aaaps; -aaapt; -aaapu; -aaapv; -aaapw; -aaapx; -aaapy; -aaapz; -aaaqa; -aaaqb; -aaaqc; -aaaqd; -aaaqe; -aaaqf; -aaaqg; -aaaqh; -aaaqi; -aaaqj; -aaaqk; -aaaql; -aaaqm; -aaaqn; -aaaqo; -aaaqp; -aaaqq; -aaaqr; -aaaqs; -aaaqt; -aaaqu; -aaaqv; -aaaqw; -aaaqx; -aaaqy; -aaaqz; -aaara; -aaarb; -aaarc; -aaard; -aaare; -aaarf; -aaarg; -aaarh; -aaari; -aaarj; -aaark; -aaarl; -aaarm; -aaarn; -aaaro; -aaarp; -aaarq; -aaarr; -aaars; -aaart; -aaaru; -aaarv; -aaarw; -aaarx; -aaary; -aaarz; -aaasa; -aaasb; -aaasc; -aaasd; -aaase; -aaasf; -aaasg; -aaash; -aaasi; -aaasj; -aaask; -aaasl; -aaasm; -aaasn; -aaaso; -aaasp; -aaasq; -aaasr; -aaass; -aaast; -aaasu; -aaasv; -aaasw; -aaasx; -aaasy; -aaasz; -aaata; -aaatb; -aaatc; -aaatd; -aaate; -aaatf; -aaatg; -aaath; -aaati; -aaatj; -aaatk; -aaatl; -aaatm; -aaatn; -aaato; -aaatp; -aaatq; -aaatr; -aaats; -aaatt; -aaatu; -aaatv; -aaatw; -aaatx; -aaaty; -aaatz; -aaaua; -aaaub; -aaauc; -aaaud; -aaaue; -aaauf; -aaaug; -aaauh; -aaaui; -aaauj; -aaauk; -aaaul; -aaaum; -aaaun; -aaauo; -aaaup; -aaauq; -aaaur; -aaaus; -aaaut; -aaauu; -aaauv; -aaauw; -aaaux; -aaauy; -aaauz; -aaava; -aaavb; -aaavc; -aaavd; -aaave; -aaavf; -aaavg; -aaavh; -aaavi; -aaavj; -aaavk; -aaavl; -aaavm; -aaavn; -aaavo; -aaavp; -aaavq; -aaavr; -aaavs; -aaavt; -aaavu; -aaavv; -aaavw; -aaavx; -aaavy; -aaavz; -aaawa; -aaawb; -aaawc; -aaawd; -aaawe; -aaawf; -aaawg; -aaawh; -aaawi; -aaawj; -aaawk; -aaawl; -aaawm; -aaawn; -aaawo; -aaawp; -aaawq; -aaawr; -aaaws; -aaawt; -aaawu; -aaawv; -aaaww; -aaawx; -aaawy; -aaawz; -aaaxa; -aaaxb; -aaaxc; -aaaxd; -aaaxe; -aaaxf; -aaaxg; -aaaxh; -aaaxi; -aaaxj; -aaaxk; -aaaxl; -aaaxm; -aaaxn; -aaaxo; -aaaxp; -aaaxq; -aaaxr; -aaaxs; -aaaxt; -aaaxu; -aaaxv; -aaaxw; -aaaxx; -aaaxy; -aaaxz; -aaaya; -aaayb; -aaayc; -aaayd; -aaaye; -aaayf; -aaayg; -aaayh; -aaayi; -aaayj; -aaayk; -aaayl; -aaaym; -aaayn; -aaayo; -aaayp; -aaayq; -aaayr; -aaays; -aaayt; -aaayu; -aaayv; -aaayw; -aaayx; -aaayy; -aaayz; -aaaza; -aaazb; -aaazc; -aaazd; -aaaze; -aaazf; -aaazg; -aaazh; -aaazi; -aaazj; -aaazk; -aaazl; -aaazm; -aaazn; -aaazo; -aaazp; -aaazq; -aaazr; -aaazs; -aaazt; -aaazu; -aaazv; -aaazw; -aaazx; -aaazy; -aaazz; -aabaa; -aabab; -aabac; -aabad; -aabae; -aabaf; -aabag; -aabah; -aabai; -aabaj; -aabak; -aabal; -aabam; -aaban; -aabao; -aabap; -aabaq; -aabar; -aabas; -aabat; -aabau; -aabav; -aabaw; -aabax; -aabay; -aabaz; -aabba; -aabbb; -aabbc; -aabbd; -aabbe; -aabbf; -aabbg; -aabbh; -aabbi; -aabbj; -aabbk; -aabbl; -aabbm; -aabbn; -aabbo; -aabbp; -aabbq; -aabbr; -aabbs; -aabbt; -aabbu; -aabbv; -aabbw; -aabbx; -aabby; -aabbz; -aabca; -aabcb; -aabcc; -aabcd; -aabce; -aabcf; -aabcg; -aabch; -aabci; -aabcj; -aabck; -aabcl; -aabcm; -aabcn; -aabco; -aabcp; -aabcq; -aabcr; -aabcs; -aabct; -aabcu; -aabcv; -aabcw; -aabcx; -aabcy; -aabcz; -aabda; -aabdb; -aabdc; -aabdd; -aabde; -aabdf; -aabdg; -aabdh; -aabdi; -aabdj; -aabdk; -aabdl; -aabdm; -aabdn; -aabdo; -aabdp; -aabdq; -aabdr; -aabds; -aabdt; -aabdu; -aabdv; -aabdw; -aabdx; -aabdy; -aabdz; -aabea; -aabeb; -aabec; -aabed; -aabee; -aabef; -aabeg; -aabeh; -aabei; -aabej; -aabek; -aabel; -aabem; -aaben; -aabeo; -aabep; -aabeq; -aaber; -aabes; -aabet; -aabeu; -aabev; -aabew; -aabex; -aabey; -aabez; -aabfa; -aabfb; -aabfc; -aabfd; -aabfe; -aabff; -aabfg; -aabfh; -aabfi; -aabfj; -aabfk; -aabfl; -aabfm; -aabfn; -aabfo; -aabfp; -aabfq; -aabfr; -aabfs; -aabft; -aabfu; -aabfv; -aabfw; -aabfx; -aabfy; -aabfz; -aabga; -aabgb; -aabgc; -aabgd; -aabge; -aabgf; -aabgg; -aabgh; -aabgi; -aabgj; -aabgk; -aabgl; -aabgm; -aabgn; -aabgo; -aabgp; -aabgq; -aabgr; -aabgs; -aabgt; -aabgu; -aabgv; -aabgw; -aabgx; -aabgy; -aabgz; -aabha; -aabhb; -aabhc; -aabhd; -aabhe; -aabhf; -aabhg; -aabhh; -aabhi; -aabhj; -aabhk; -aabhl; -aabhm; -aabhn; -aabho; -aabhp; -aabhq; -aabhr; -aabhs; -aabht; -aabhu; -aabhv; -aabhw; -aabhx; -aabhy; -aabhz; -aabia; -aabib; -aabic; -aabid; -aabie; -aabif; -aabig; -aabih; -aabii; -aabij; -aabik; -aabil; -aabim; -aabin; -aabio; -aabip; -aabiq; -aabir; -aabis; -aabit; -aabiu; -aabiv; -aabiw; -aabix; -aabiy; -aabiz; -aabja; -aabjb; -aabjc; -aabjd; -aabje; -aabjf; -aabjg; -aabjh; -aabji; -aabjj; -aabjk; -aabjl; -aabjm; -aabjn; -aabjo; -aabjp; -aabjq; -aabjr; -aabjs; -aabjt; -aabju; -aabjv; -aabjw; -aabjx; -aabjy; -aabjz; -aabka; -aabkb; -aabkc; -aabkd; -aabke; -aabkf; -aabkg; -aabkh; -aabki; -aabkj; -aabkk; -aabkl; -aabkm; -aabkn; -aabko; -aabkp; -aabkq; -aabkr; -aabks; -aabkt; -aabku; -aabkv; -aabkw; -aabkx; -aabky; -aabkz; -aabla; -aablb; -aablc; -aabld; -aable; -aablf; -aablg; -aablh; -aabli; -aablj; -aablk; -aabll; -aablm; -aabln; -aablo; -aablp; -aablq; -aablr; -aabls; -aablt; -aablu; -aablv; -aablw; -aablx; -aably; -aablz; -aabma; -aabmb; -aabmc; -aabmd; -aabme; -aabmf; -aabmg; -aabmh; -aabmi; -aabmj; -aabmk; -aabml; -aabmm; -aabmn; -aabmo; -aabmp; -aabmq; -aabmr; -aabms; -aabmt; -aabmu; -aabmv; -aabmw; -aabmx; -aabmy; -aabmz; -aabna; -aabnb; -aabnc; -aabnd; -aabne; -aabnf; -aabng; -aabnh; -aabni; -aabnj; -aabnk; -aabnl; -aabnm; -aabnn; -aabno; -aabnp; -aabnq; -aabnr; -aabns; -aabnt; -aabnu; -aabnv; -aabnw; -aabnx; -aabny; -aabnz; -aaboa; -aabob; -aaboc; -aabod; -aaboe; -aabof; -aabog; -aaboh; -aaboi; -aaboj; -aabok; -aabol; -aabom; -aabon; -aaboo; -aabop; -aaboq; -aabor; -aabos; -aabot; -aabou; -aabov; -aabow; -aabox; -aaboy; -aaboz; -aabpa; -aabpb; -aabpc; -aabpd; -aabpe; -aabpf; -aabpg; -aabph; -aabpi; -aabpj; -aabpk; -aabpl; -aabpm; -aabpn; -aabpo; -aabpp; -aabpq; -aabpr; -aabps; -aabpt; -aabpu; -aabpv; -aabpw; -aabpx; -aabpy; -aabpz; -aabqa; -aabqb; -aabqc; -aabqd; -aabqe; -aabqf; -aabqg; -aabqh; -aabqi; -aabqj; -aabqk; -aabql; -aabqm; -aabqn; -aabqo; -aabqp; -aabqq; -aabqr; -aabqs; -aabqt; -aabqu; -aabqv; -aabqw; -aabqx; -aabqy; -aabqz; -aabra; -aabrb; -aabrc; -aabrd; -aabre; -aabrf; -aabrg; -aabrh; -aabri; -aabrj; -aabrk; -aabrl; -aabrm; -aabrn; -aabro; -aabrp; -aabrq; -aabrr; -aabrs; -aabrt; -aabru; -aabrv; -aabrw; -aabrx; -aabry; -aabrz; -aabsa; -aabsb; -aabsc; -aabsd; -aabse; -aabsf; -aabsg; -aabsh; -aabsi; -aabsj; -aabsk; -aabsl; -aabsm; -aabsn; -aabso; -aabsp; -aabsq; -aabsr; -aabss; -aabst; -aabsu; -aabsv; -aabsw; -aabsx; -aabsy; -aabsz; -aabta; -aabtb; -aabtc; -aabtd; -aabte; -aabtf; -aabtg; -aabth; -aabti; -aabtj; -aabtk; -aabtl; -aabtm; -aabtn; -aabto; -aabtp; -aabtq; -aabtr; -aabts; -aabtt; -aabtu; -aabtv; -aabtw; -aabtx; -aabty; -aabtz; -aabua; -aabub; -aabuc; -aabud; -aabue; -aabuf; -aabug; -aabuh; -aabui; -aabuj; -aabuk; -aabul; -aabum; -aabun; -aabuo; -aabup; -aabuq; -aabur; -aabus; -aabut; -aabuu; -aabuv; -aabuw; -aabux; -aabuy; -aabuz; -aabva; -aabvb; -aabvc; -aabvd; -aabve; -aabvf; -aabvg; -aabvh; -aabvi; -aabvj; -aabvk; -aabvl; -aabvm; -aabvn; -aabvo; -aabvp; -aabvq; -aabvr; -aabvs; -aabvt; -aabvu; -aabvv; -aabvw; -aabvx; -aabvy; -aabvz; -aabwa; -aabwb; -aabwc; -aabwd; -aabwe; -aabwf; -aabwg; -aabwh; -aabwi; -aabwj; -aabwk; -aabwl; -aabwm; -aabwn; -aabwo; -aabwp; -aabwq; -aabwr; -aabws; -aabwt; -aabwu; -aabwv; -aabww; -aabwx; -aabwy; -aabwz; -aabxa; -aabxb; -aabxc; -aabxd; -aabxe; -aabxf; -aabxg; -aabxh; -aabxi; -aabxj; -aabxk; -aabxl; -aabxm; -aabxn; -aabxo; -aabxp; -aabxq; -aabxr; -aabxs; -aabxt; -aabxu; -aabxv; -aabxw; -aabxx; -aabxy; -aabxz; -aabya; -aabyb; -aabyc; -aabyd; -aabye; -aabyf; -aabyg; -aabyh; -aabyi; -aabyj; -aabyk; -aabyl; -aabym; -aabyn; -aabyo; -aabyp; -aabyq; -aabyr; -aabys; -aabyt; -aabyu; -aabyv; -aabyw; -aabyx; -aabyy; -aabyz; -aabza; -aabzb; -aabzc; -aabzd; -aabze; -aabzf; -aabzg; -aabzh; -aabzi; -aabzj; -aabzk; -aabzl; -aabzm; -aabzn; -aabzo; -aabzp; -aabzq; -aabzr; -aabzs; -aabzt; -aabzu; -aabzv; -aabzw; -aabzx; -aabzy; -aabzz; -aacaa; -aacab; -aacac; -aacad; -aacae; -aacaf; -aacag; -aacah; -aacai; -aacaj; -aacak; -aacal; -aacam; -aacan; -aacao; -aacap; -aacaq; -aacar; -aacas; -aacat; -aacau; -aacav; -aacaw; -aacax; -aacay; -aacaz; -aacba; -aacbb; -aacbc; -aacbd; -aacbe; -aacbf; -aacbg; -aacbh; -aacbi; -aacbj; -aacbk; -aacbl; -aacbm; -aacbn; -aacbo; -aacbp; -aacbq; -aacbr; -aacbs; -aacbt; -aacbu; -aacbv; -aacbw; -aacbx; -aacby; -aacbz; -aacca; -aaccb; -aaccc; -aaccd; -aacce; -aaccf; -aaccg; -aacch; -aacci; -aaccj; -aacck; -aaccl; -aaccm; -aaccn; -aacco; -aaccp; -aaccq; -aaccr; -aaccs; -aacct; -aaccu; -aaccv; -aaccw; -aaccx; -aaccy; -aaccz; -aacda; -aacdb; -aacdc; -aacdd; -aacde; -aacdf; -aacdg; -aacdh; -aacdi; -aacdj; -aacdk; -aacdl; -aacdm; -aacdn; -aacdo; -aacdp; -aacdq; -aacdr; -aacds; -aacdt; -aacdu; -aacdv; -aacdw; -aacdx; -aacdy; -aacdz; -aacea; -aaceb; -aacec; -aaced; -aacee; -aacef; -aaceg; -aaceh; -aacei; -aacej; -aacek; -aacel; -aacem; -aacen; -aaceo; -aacep; -aaceq; -aacer; -aaces; -aacet; -aaceu; -aacev; -aacew; -aacex; -aacey; -aacez; -aacfa; -aacfb; -aacfc; -aacfd; -aacfe; -aacff; -aacfg; -aacfh; -aacfi; -aacfj; -aacfk; -aacfl; -aacfm; -aacfn; -aacfo; -aacfp; -aacfq; -aacfr; -aacfs; -aacft; -aacfu; -aacfv; -aacfw; -aacfx; -aacfy; -aacfz; -aacga; -aacgb; -aacgc; -aacgd; -aacge; -aacgf; -aacgg; -aacgh; -aacgi; -aacgj; -aacgk; -aacgl; -aacgm; -aacgn; -aacgo; -aacgp; -aacgq; -aacgr; -aacgs; -aacgt; -aacgu; -aacgv; -aacgw; -aacgx; -aacgy; -aacgz; -aacha; -aachb; -aachc; -aachd; -aache; -aachf; -aachg; -aachh; -aachi; -aachj; -aachk; -aachl; -aachm; -aachn; -aacho; -aachp; -aachq; -aachr; -aachs; -aacht; -aachu; -aachv; -aachw; -aachx; -aachy; -aachz; -aacia; -aacib; -aacic; -aacid; -aacie; -aacif; -aacig; -aacih; -aacii; -aacij; -aacik; -aacil; -aacim; -aacin; -aacio; -aacip; -aaciq; -aacir; -aacis; -aacit; -aaciu; -aaciv; -aaciw; -aacix; -aaciy; -aaciz; -aacja; -aacjb; -aacjc; -aacjd; -aacje; -aacjf; -aacjg; -aacjh; -aacji; -aacjj; -aacjk; -aacjl; -aacjm; -aacjn; -aacjo; -aacjp; -aacjq; -aacjr; -aacjs; -aacjt; -aacju; -aacjv; -aacjw; -aacjx; -aacjy; -aacjz; -aacka; -aackb; -aackc; -aackd; -aacke; -aackf; -aackg; -aackh; -aacki; -aackj; -aackk; -aackl; -aackm; -aackn; -aacko; -aackp; -aackq; -aackr; -aacks; -aackt; -aacku; -aackv; -aackw; -aackx; -aacky; -aackz; -aacla; -aaclb; -aaclc; -aacld; -aacle; -aaclf; -aaclg; -aaclh; -aacli; -aaclj; -aaclk; -aacll; -aaclm; -aacln; -aaclo; -aaclp; -aaclq; -aaclr; -aacls; -aaclt; -aaclu; -aaclv; -aaclw; -aaclx; -aacly; -aaclz; -aacma; -aacmb; -aacmc; -aacmd; -aacme; -aacmf; -aacmg; -aacmh; -aacmi; -aacmj; -aacmk; -aacml; -aacmm; -aacmn; -aacmo; -aacmp; -aacmq; -aacmr; -aacms; -aacmt; -aacmu; -aacmv; -aacmw; -aacmx; -aacmy; -aacmz; -aacna; -aacnb; -aacnc; -aacnd; -aacne; -aacnf; -aacng; -aacnh; -aacni; -aacnj; -aacnk; -aacnl; -aacnm; -aacnn; -aacno; -aacnp; -aacnq; -aacnr; -aacns; -aacnt; -aacnu; -aacnv; -aacnw; -aacnx; -aacny; -aacnz; -aacoa; -aacob; -aacoc; -aacod; -aacoe; -aacof; -aacog; -aacoh; -aacoi; -aacoj; -aacok; -aacol; -aacom; -aacon; -aacoo; -aacop; -aacoq; -aacor; -aacos; -aacot; -aacou; -aacov; -aacow; -aacox; -aacoy; -aacoz; -aacpa; -aacpb; -aacpc; -aacpd; -aacpe; -aacpf; -aacpg; -aacph; -aacpi; -aacpj; -aacpk; -aacpl; -aacpm; -aacpn; -aacpo; -aacpp; -aacpq; -aacpr; -aacps; -aacpt; -aacpu; -aacpv; -aacpw; -aacpx; -aacpy; -aacpz; -aacqa; -aacqb; -aacqc; -aacqd; -aacqe; -aacqf; -aacqg; -aacqh; -aacqi; -aacqj; -aacqk; -aacql; -aacqm; -aacqn; -aacqo; -aacqp; -aacqq; -aacqr; -aacqs; -aacqt; -aacqu; -aacqv; -aacqw; -aacqx; -aacqy; -aacqz; -aacra; -aacrb; -aacrc; -aacrd; -aacre; -aacrf; -aacrg; -aacrh; -aacri; -aacrj; -aacrk; -aacrl; -aacrm; -aacrn; -aacro; -aacrp; -aacrq; -aacrr; -aacrs; -aacrt; -aacru; -aacrv; -aacrw; -aacrx; -aacry; -aacrz; -aacsa; -aacsb; -aacsc; -aacsd; -aacse; -aacsf; -aacsg; -aacsh; -aacsi; -aacsj; -aacsk; -aacsl; -aacsm; -aacsn; -aacso; -aacsp; -aacsq; -aacsr; -aacss; -aacst; -aacsu; -aacsv; -aacsw; -aacsx; -aacsy; -aacsz; -aacta; -aactb; -aactc; -aactd; -aacte; -aactf; -aactg; -aacth; -aacti; -aactj; -aactk; -aactl; -aactm; -aactn; -aacto; -aactp; -aactq; -aactr; -aacts; -aactt; -aactu; -aactv; -aactw; -aactx; -aacty; -aactz; -aacua; -aacub; -aacuc; -aacud; -aacue; -aacuf; -aacug; -aacuh; -aacui; -aacuj; -aacuk; -aacul; -aacum; -aacun; -aacuo; -aacup; -aacuq; -aacur; -aacus; -aacut; -aacuu; -aacuv; -aacuw; -aacux; -aacuy; -aacuz; -aacva; -aacvb; -aacvc; -aacvd; -aacve; -aacvf; -aacvg; -aacvh; -aacvi; -aacvj; -aacvk; -aacvl; -aacvm; -aacvn; -aacvo; -aacvp; -aacvq; -aacvr; -aacvs; -aacvt; -aacvu; -aacvv; -aacvw; -aacvx; -aacvy; -aacvz; -aacwa; -aacwb; -aacwc; -aacwd; -aacwe; -aacwf; -aacwg; -aacwh; -aacwi; -aacwj; -aacwk; -aacwl; -aacwm; -aacwn; -aacwo; -aacwp; -aacwq; -aacwr; -aacws; -aacwt; -aacwu; -aacwv; -aacww; -aacwx; -aacwy; -aacwz; -aacxa; -aacxb; -aacxc; -aacxd; -aacxe; -aacxf; -aacxg; -aacxh; -aacxi; -aacxj; -aacxk; -aacxl; -aacxm; -aacxn; -aacxo; -aacxp; -aacxq; -aacxr; -aacxs; -aacxt; -aacxu; -aacxv; -aacxw; -aacxx; -aacxy; -aacxz; -aacya; -aacyb; -aacyc; -aacyd; -aacye; -aacyf; -aacyg; -aacyh; -aacyi; -aacyj; -aacyk; -aacyl; -aacym; -aacyn; -aacyo; -aacyp; -aacyq; -aacyr; -aacys; -aacyt; -aacyu; -aacyv; -aacyw; -aacyx; -aacyy; -aacyz; -aacza; -aaczb; -aaczc; -aaczd; -aacze; -aaczf; -aaczg; -aaczh; -aaczi; -aaczj; -aaczk; -aaczl; -aaczm; -aaczn; -aaczo; -aaczp; -aaczq; -aaczr; -aaczs; -aaczt; -aaczu; -aaczv; -aaczw; -aaczx; -aaczy; -aaczz; -aadaa; -aadab; -aadac; -aadad; -aadae; -aadaf; -aadag; -aadah; -aadai; -aadaj; -aadak; -aadal; -aadam; -aadan; -aadao; -aadap; -aadaq; -aadar; -aadas; -aadat; -aadau; -aadav; -aadaw; -aadax; -aaday; -aadaz; -aadba; -aadbb; -aadbc; -aadbd; -aadbe; -aadbf; -aadbg; -aadbh; -aadbi; -aadbj; -aadbk; -aadbl; -aadbm; -aadbn; -aadbo; -aadbp; -aadbq; -aadbr; -aadbs; -aadbt; -aadbu; -aadbv; -aadbw; -aadbx; -aadby; -aadbz; -aadca; -aadcb; -aadcc; -aadcd; -aadce; -aadcf; -aadcg; -aadch; -aadci; -aadcj; -aadck; -aadcl; -aadcm; -aadcn; -aadco; -aadcp; -aadcq; -aadcr; -aadcs; -aadct; -aadcu; -aadcv; -aadcw; -aadcx; -aadcy; -aadcz; -aadda; -aaddb; -aaddc; -aaddd; -aadde; -aaddf; -aaddg; -aaddh; -aaddi; -aaddj; -aaddk; -aaddl; -aaddm; -aaddn; -aaddo; -aaddp; -aaddq; -aaddr; -aadds; -aaddt; -aaddu; -aaddv; -aaddw; -aaddx; -aaddy; -aaddz; -aadea; -aadeb; -aadec; -aaded; -aadee; -aadef; -aadeg; -aadeh; -aadei; -aadej; -aadek; -aadel; -aadem; -aaden; -aadeo; -aadep; -aadeq; -aader; -aades; -aadet; -aadeu; -aadev; -aadew; -aadex; -aadey; -aadez; -aadfa; -aadfb; -aadfc; -aadfd; -aadfe; -aadff; -aadfg; -aadfh; -aadfi; -aadfj; -aadfk; -aadfl; -aadfm; -aadfn; -aadfo; -aadfp; -aadfq; -aadfr; -aadfs; -aadft; -aadfu; -aadfv; -aadfw; -aadfx; -aadfy; -aadfz; -aadga; -aadgb; -aadgc; -aadgd; -aadge; -aadgf; -aadgg; -aadgh; -aadgi; -aadgj; -aadgk; -aadgl; -aadgm; -aadgn; -aadgo; -aadgp; -aadgq; -aadgr; -aadgs; -aadgt; -aadgu; -aadgv; -aadgw; -aadgx; -aadgy; -aadgz; -aadha; -aadhb; -aadhc; -aadhd; -aadhe; -aadhf; -aadhg; -aadhh; -aadhi; -aadhj; -aadhk; -aadhl; -aadhm; -aadhn; -aadho; -aadhp; -aadhq; -aadhr; -aadhs; -aadht; -aadhu; -aadhv; -aadhw; -aadhx; -aadhy; -aadhz; -aadia; -aadib; -aadic; -aadid; -aadie; -aadif; -aadig; -aadih; -aadii; -aadij; -aadik; -aadil; -aadim; -aadin; -aadio; -aadip; -aadiq; -aadir; -aadis; -aadit; -aadiu; -aadiv; -aadiw; -aadix; -aadiy; -aadiz; -aadja; -aadjb; -aadjc; -aadjd; -aadje; -aadjf; -aadjg; -aadjh; -aadji; -aadjj; -aadjk; -aadjl; -aadjm; -aadjn; -aadjo; -aadjp; -aadjq; -aadjr; -aadjs; -aadjt; -aadju; -aadjv; -aadjw; -aadjx; -aadjy; -aadjz; -aadka; -aadkb; -aadkc; -aadkd; -aadke; -aadkf; -aadkg; -aadkh; -aadki; -aadkj; -aadkk; -aadkl; -aadkm; -aadkn; -aadko; -aadkp; -aadkq; -aadkr; -aadks; -aadkt; -aadku; -aadkv; -aadkw; -aadkx; -aadky; -aadkz; -aadla; -aadlb; -aadlc; -aadld; -aadle; -aadlf; -aadlg; -aadlh; -aadli; -aadlj; -aadlk; -aadll; -aadlm; -aadln; -aadlo; -aadlp; -aadlq; -aadlr; -aadls; -aadlt; -aadlu; -aadlv; -aadlw; -aadlx; -aadly; -aadlz; -aadma; -aadmb; -aadmc; -aadmd; -aadme; -aadmf; -aadmg; -aadmh; -aadmi; -aadmj; -aadmk; -aadml; -aadmm; -aadmn; -aadmo; -aadmp; -aadmq; -aadmr; -aadms; -aadmt; -aadmu; -aadmv; -aadmw; -aadmx; -aadmy; -aadmz; -aadna; -aadnb; -aadnc; -aadnd; -aadne; -aadnf; -aadng; -aadnh; -aadni; -aadnj; -aadnk; -aadnl; -aadnm; -aadnn; -aadno; -aadnp; -aadnq; -aadnr; -aadns; -aadnt; -aadnu; -aadnv; -aadnw; -aadnx; -aadny; -aadnz; -aadoa; -aadob; -aadoc; -aadod; -aadoe; -aadof; -aadog; -aadoh; -aadoi; -aadoj; -aadok; -aadol; -aadom; -aadon; -aadoo; -aadop; -aadoq; -aador; -aados; -aadot; -aadou; -aadov; -aadow; -aadox; -aadoy; -aadoz; -aadpa; -aadpb; -aadpc; -aadpd; -aadpe; -aadpf; -aadpg; -aadph; -aadpi; -aadpj; -aadpk; -aadpl; -aadpm; -aadpn; -aadpo; -aadpp; -aadpq; -aadpr; -aadps; -aadpt; -aadpu; -aadpv; -aadpw; -aadpx; -aadpy; -aadpz; -aadqa; -aadqb; -aadqc; -aadqd; -aadqe; -aadqf; -aadqg; -aadqh; -aadqi; -aadqj; -aadqk; -aadql; -aadqm; -aadqn; -aadqo; -aadqp; -aadqq; -aadqr; -aadqs; -aadqt; -aadqu; -aadqv; -aadqw; -aadqx; -aadqy; -aadqz; -aadra; -aadrb; -aadrc; -aadrd; -aadre; -aadrf; -aadrg; -aadrh; -aadri; -aadrj; -aadrk; -aadrl; -aadrm; -aadrn; -aadro; -aadrp; -aadrq; -aadrr; -aadrs; -aadrt; -aadru; -aadrv; -aadrw; -aadrx; -aadry; -aadrz; -aadsa; -aadsb; -aadsc; -aadsd; -aadse; -aadsf; -aadsg; -aadsh; -aadsi; -aadsj; -aadsk; -aadsl; -aadsm; -aadsn; -aadso; -aadsp; -aadsq; -aadsr; -aadss; -aadst; -aadsu; -aadsv; -aadsw; -aadsx; -aadsy; -aadsz; -aadta; -aadtb; -aadtc; -aadtd; -aadte; -aadtf; -aadtg; -aadth; -aadti; -aadtj; -aadtk; -aadtl; -aadtm; -aadtn; -aadto; -aadtp; -aadtq; -aadtr; -aadts; -aadtt; -aadtu; -aadtv; -aadtw; -aadtx; -aadty; -aadtz; -aadua; -aadub; -aaduc; -aadud; -aadue; -aaduf; -aadug; -aaduh; -aadui; -aaduj; -aaduk; -aadul; -aadum; -aadun; -aaduo; -aadup; -aaduq; -aadur; -aadus; -aadut; -aaduu; -aaduv; -aaduw; -aadux; -aaduy; -aaduz; -aadva; -aadvb; -aadvc; -aadvd; -aadve; -aadvf; -aadvg; -aadvh; -aadvi; -aadvj; -aadvk; -aadvl; -aadvm; -aadvn; -aadvo; -aadvp; -aadvq; -aadvr; -aadvs; -aadvt; -aadvu; -aadvv; -aadvw; -aadvx; -aadvy; -aadvz; -aadwa; -aadwb; -aadwc; -aadwd; -aadwe; -aadwf; -aadwg; -aadwh; -aadwi; -aadwj; -aadwk; -aadwl; -aadwm; -aadwn; -aadwo; -aadwp; -aadwq; -aadwr; -aadws; -aadwt; -aadwu; -aadwv; -aadww; -aadwx; -aadwy; -aadwz; -aadxa; -aadxb; -aadxc; -aadxd; -aadxe; -aadxf; -aadxg; -aadxh; -aadxi; -aadxj; -aadxk; -aadxl; -aadxm; -aadxn; -aadxo; -aadxp; -aadxq; -aadxr; -aadxs; -aadxt; -aadxu; -aadxv; -aadxw; -aadxx; -aadxy; -aadxz; -aadya; -aadyb; -aadyc; -aadyd; -aadye; -aadyf; -aadyg; -aadyh; -aadyi; -aadyj; -aadyk; -aadyl; -aadym; -aadyn; -aadyo; -aadyp; -aadyq; -aadyr; -aadys; -aadyt; -aadyu; -aadyv; -aadyw; -aadyx; -aadyy; -aadyz; -aadza; -aadzb; -aadzc; -aadzd; -aadze; -aadzf; -aadzg; -aadzh; -aadzi; -aadzj; -aadzk; -aadzl; -aadzm; -aadzn; -aadzo; -aadzp; -aadzq; -aadzr; -aadzs; -aadzt; -aadzu; -aadzv; -aadzw; -aadzx; -aadzy; -aadzz; -aaeaa; -aaeab; -aaeac; -aaead; -aaeae; -aaeaf; -aaeag; -aaeah; -aaeai; -aaeaj; -aaeak; -aaeal; -aaeam; -aaean; -aaeao; -aaeap; -aaeaq; -aaear; -aaeas; -aaeat; -aaeau; -aaeav; -aaeaw; -aaeax; -aaeay; -aaeaz; -aaeba; -aaebb; -aaebc; -aaebd; -aaebe; -aaebf; -aaebg; -aaebh; -aaebi; -aaebj; -aaebk; -aaebl; -aaebm; -aaebn; -aaebo; -aaebp; -aaebq; -aaebr; -aaebs; -aaebt; -aaebu; -aaebv; -aaebw; -aaebx; -aaeby; -aaebz; -aaeca; -aaecb; -aaecc; -aaecd; -aaece; -aaecf; -aaecg; -aaech; -aaeci; -aaecj; -aaeck; -aaecl; -aaecm; -aaecn; -aaeco; -aaecp; -aaecq; -aaecr; -aaecs; -aaect; -aaecu; -aaecv; -aaecw; -aaecx; -aaecy; -aaecz; -aaeda; -aaedb; -aaedc; -aaedd; -aaede; -aaedf; -aaedg; -aaedh; -aaedi; -aaedj; -aaedk; -aaedl; -aaedm; -aaedn; -aaedo; -aaedp; -aaedq; -aaedr; -aaeds; -aaedt; -aaedu; -aaedv; -aaedw; -aaedx; -aaedy; -aaedz; -aaeea; -aaeeb; -aaeec; -aaeed; -aaeee; -aaeef; -aaeeg; -aaeeh; -aaeei; -aaeej; -aaeek; -aaeel; -aaeem; -aaeen; -aaeeo; -aaeep; -aaeeq; -aaeer; -aaees; -aaeet; -aaeeu; -aaeev; -aaeew; -aaeex; -aaeey; -aaeez; -aaefa; -aaefb; -aaefc; -aaefd; -aaefe; -aaeff; -aaefg; -aaefh; -aaefi; -aaefj; -aaefk; -aaefl; -aaefm; -aaefn; -aaefo; -aaefp; -aaefq; -aaefr; -aaefs; -aaeft; -aaefu; -aaefv; -aaefw; -aaefx; -aaefy; -aaefz; -aaega; -aaegb; -aaegc; -aaegd; -aaege; -aaegf; -aaegg; -aaegh; -aaegi; -aaegj; -aaegk; -aaegl; -aaegm; -aaegn; -aaego; -aaegp; -aaegq; -aaegr; -aaegs; -aaegt; -aaegu; -aaegv; -aaegw; -aaegx; -aaegy; -aaegz; -aaeha; -aaehb; -aaehc; -aaehd; -aaehe; -aaehf; -aaehg; -aaehh; -aaehi; -aaehj; -aaehk; -aaehl; -aaehm; -aaehn; -aaeho; -aaehp; -aaehq; -aaehr; -aaehs; -aaeht; -aaehu; -aaehv; -aaehw; -aaehx; -aaehy; -aaehz; -aaeia; -aaeib; -aaeic; -aaeid; -aaeie; -aaeif; -aaeig; -aaeih; -aaeii; -aaeij; -aaeik; -aaeil; -aaeim; -aaein; -aaeio; -aaeip; -aaeiq; -aaeir; -aaeis; -aaeit; -aaeiu; -aaeiv; -aaeiw; -aaeix; -aaeiy; -aaeiz; -aaeja; -aaejb; -aaejc; -aaejd; -aaeje; -aaejf; -aaejg; -aaejh; -aaeji; -aaejj; -aaejk; -aaejl; -aaejm; -aaejn; -aaejo; -aaejp; -aaejq; -aaejr; -aaejs; -aaejt; -aaeju; -aaejv; -aaejw; -aaejx; -aaejy; -aaejz; -aaeka; -aaekb; -aaekc; -aaekd; -aaeke; -aaekf; -aaekg; -aaekh; -aaeki; -aaekj; -aaekk; -aaekl; -aaekm; -aaekn; -aaeko; -aaekp; -aaekq; -aaekr; -aaeks; -aaekt; -aaeku; -aaekv; -aaekw; -aaekx; -aaeky; -aaekz; -aaela; -aaelb; -aaelc; -aaeld; -aaele; -aaelf; -aaelg; -aaelh; -aaeli; -aaelj; -aaelk; -aaell; -aaelm; -aaeln; -aaelo; -aaelp; -aaelq; -aaelr; -aaels; -aaelt; -aaelu; -aaelv; -aaelw; -aaelx; -aaely; -aaelz; -aaema; -aaemb; -aaemc; -aaemd; -aaeme; -aaemf; -aaemg; -aaemh; -aaemi; -aaemj; -aaemk; -aaeml; -aaemm; -aaemn; -aaemo; -aaemp; -aaemq; -aaemr; -aaems; -aaemt; -aaemu; -aaemv; -aaemw; -aaemx; -aaemy; -aaemz; -aaena; -aaenb; -aaenc; -aaend; -aaene; -aaenf; -aaeng; -aaenh; -aaeni; -aaenj; -aaenk; -aaenl; -aaenm; -aaenn; -aaeno; -aaenp; -aaenq; -aaenr; -aaens; -aaent; -aaenu; -aaenv; -aaenw; -aaenx; -aaeny; -aaenz; -aaeoa; -aaeob; -aaeoc; -aaeod; -aaeoe; -aaeof; -aaeog; -aaeoh; -aaeoi; -aaeoj; -aaeok; -aaeol; -aaeom; -aaeon; -aaeoo; -aaeop; -aaeoq; -aaeor; -aaeos; -aaeot; -aaeou; -aaeov; -aaeow; -aaeox; -aaeoy; -aaeoz; -aaepa; -aaepb; -aaepc; -aaepd; -aaepe; -aaepf; -aaepg; -aaeph; -aaepi; -aaepj; -aaepk; -aaepl; -aaepm; -aaepn; -aaepo; -aaepp; -aaepq; -aaepr; -aaeps; -aaept; -aaepu; -aaepv; -aaepw; -aaepx; -aaepy; -aaepz; -aaeqa; -aaeqb; -aaeqc; -aaeqd; -aaeqe; -aaeqf; -aaeqg; -aaeqh; -aaeqi; -aaeqj; -aaeqk; -aaeql; -aaeqm; -aaeqn; -aaeqo; -aaeqp; -aaeqq; -aaeqr; -aaeqs; -aaeqt; -aaequ; -aaeqv; -aaeqw; -aaeqx; -aaeqy; -aaeqz; -aaera; -aaerb; -aaerc; -aaerd; -aaere; -aaerf; -aaerg; -aaerh; -aaeri; -aaerj; -aaerk; -aaerl; -aaerm; -aaern; -aaero; -aaerp; -aaerq; -aaerr; -aaers; -aaert; -aaeru; -aaerv; -aaerw; -aaerx; -aaery; -aaerz; -aaesa; -aaesb; -aaesc; -aaesd; -aaese; -aaesf; -aaesg; -aaesh; -aaesi; -aaesj; -aaesk; -aaesl; -aaesm; -aaesn; -aaeso; -aaesp; -aaesq; -aaesr; -aaess; -aaest; -aaesu; -aaesv; -aaesw; -aaesx; -aaesy; -aaesz; -aaeta; -aaetb; -aaetc; -aaetd; -aaete; -aaetf; -aaetg; -aaeth; -aaeti; -aaetj; -aaetk; -aaetl; -aaetm; -aaetn; -aaeto; -aaetp; -aaetq; -aaetr; -aaets; -aaett; -aaetu; -aaetv; -aaetw; -aaetx; -aaety; -aaetz; -aaeua; -aaeub; -aaeuc; -aaeud; -aaeue; -aaeuf; -aaeug; -aaeuh; -aaeui; -aaeuj; -aaeuk; -aaeul; -aaeum; -aaeun; -aaeuo; -aaeup; -aaeuq; -aaeur; -aaeus; -aaeut; -aaeuu; -aaeuv; -aaeuw; -aaeux; -aaeuy; -aaeuz; -aaeva; -aaevb; -aaevc; -aaevd; -aaeve; -aaevf; -aaevg; -aaevh; -aaevi; -aaevj; -aaevk; -aaevl; -aaevm; -aaevn; -aaevo; -aaevp; -aaevq; -aaevr; -aaevs; -aaevt; -aaevu; -aaevv; -aaevw; -aaevx; -aaevy; -aaevz; -aaewa; -aaewb; -aaewc; -aaewd; -aaewe; -aaewf; -aaewg; -aaewh; -aaewi; -aaewj; -aaewk; -aaewl; -aaewm; -aaewn; -aaewo; -aaewp; -aaewq; -aaewr; -aaews; -aaewt; -aaewu; -aaewv; -aaeww; -aaewx; -aaewy; -aaewz; -aaexa; -aaexb; -aaexc; -aaexd; -aaexe; -aaexf; -aaexg; -aaexh; -aaexi; -aaexj; -aaexk; -aaexl; -aaexm; -aaexn; -aaexo; -aaexp; -aaexq; -aaexr; -aaexs; -aaext; -aaexu; -aaexv; -aaexw; -aaexx; -aaexy; -aaexz; -aaeya; -aaeyb; -aaeyc; -aaeyd; -aaeye; -aaeyf; -aaeyg; -aaeyh; -aaeyi; -aaeyj; -aaeyk; -aaeyl; -aaeym; -aaeyn; -aaeyo; -aaeyp; -aaeyq; -aaeyr; -aaeys; -aaeyt; -aaeyu; -aaeyv; -aaeyw; -aaeyx; -aaeyy; -aaeyz; -aaeza; -aaezb; -aaezc; -aaezd; -aaeze; -aaezf; -aaezg; -aaezh; -aaezi; -aaezj; -aaezk; -aaezl; -aaezm; -aaezn; -aaezo; -aaezp; -aaezq; -aaezr; -aaezs; -aaezt; -aaezu; -aaezv; -aaezw; -aaezx; -aaezy; -aaezz; -aafaa; -aafab; -aafac; -aafad; -aafae; -aafaf; -aafag; -aafah; -aafai; -aafaj; -aafak; -aafal; -aafam; -aafan; -aafao; -aafap; -aafaq; -aafar; -aafas; -aafat; -aafau; -aafav; -aafaw; -aafax; -aafay; -aafaz; -aafba; -aafbb; -aafbc; -aafbd; -aafbe; -aafbf; -aafbg; -aafbh; -aafbi; -aafbj; -aafbk; -aafbl; -aafbm; -aafbn; -aafbo; -aafbp; -aafbq; -aafbr; -aafbs; -aafbt; -aafbu; -aafbv; -aafbw; -aafbx; -aafby; -aafbz; -aafca; -aafcb; -aafcc; -aafcd; -aafce; -aafcf; -aafcg; -aafch; -aafci; -aafcj; -aafck; -aafcl; -aafcm; -aafcn; -aafco; -aafcp; -aafcq; -aafcr; -aafcs; -aafct; -aafcu; -aafcv; -aafcw; -aafcx; -aafcy; -aafcz; -aafda; -aafdb; -aafdc; -aafdd; -aafde; -aafdf; -aafdg; -aafdh; -aafdi; -aafdj; -aafdk; -aafdl; -aafdm; -aafdn; -aafdo; -aafdp; -aafdq; -aafdr; -aafds; -aafdt; -aafdu; -aafdv; -aafdw; -aafdx; -aafdy; -aafdz; -aafea; -aafeb; -aafec; -aafed; -aafee; -aafef; -aafeg; -aafeh; -aafei; -aafej; -aafek; -aafel; -aafem; -aafen; -aafeo; -aafep; -aafeq; -aafer; -aafes; -aafet; -aafeu; -aafev; -aafew; -aafex; -aafey; -aafez; -aaffa; -aaffb; -aaffc; -aaffd; -aaffe; -aafff; -aaffg; -aaffh; -aaffi; -aaffj; -aaffk; -aaffl; -aaffm; -aaffn; -aaffo; -aaffp; -aaffq; -aaffr; -aaffs; -aafft; -aaffu; -aaffv; -aaffw; -aaffx; -aaffy; -aaffz; -aafga; -aafgb; -aafgc; -aafgd; -aafge; -aafgf; -aafgg; -aafgh; -aafgi; -aafgj; -aafgk; -aafgl; -aafgm; -aafgn; -aafgo; -aafgp; -aafgq; -aafgr; -aafgs; -aafgt; -aafgu; -aafgv; -aafgw; -aafgx; -aafgy; -aafgz; -aafha; -aafhb; -aafhc; -aafhd; -aafhe; -aafhf; -aafhg; -aafhh; -aafhi; -aafhj; -aafhk; -aafhl; -aafhm; -aafhn; -aafho; -aafhp; -aafhq; -aafhr; -aafhs; -aafht; -aafhu; -aafhv; -aafhw; -aafhx; -aafhy; -aafhz; -aafia; -aafib; -aafic; -aafid; -aafie; -aafif; -aafig; -aafih; -aafii; -aafij; -aafik; -aafil; -aafim; -aafin; -aafio; -aafip; -aafiq; -aafir; -aafis; -aafit; -aafiu; -aafiv; -aafiw; -aafix; -aafiy; -aafiz; -aafja; -aafjb; -aafjc; -aafjd; -aafje; -aafjf; -aafjg; -aafjh; -aafji; -aafjj; -aafjk; -aafjl; -aafjm; -aafjn; -aafjo; -aafjp; -aafjq; -aafjr; -aafjs; -aafjt; -aafju; -aafjv; -aafjw; -aafjx; -aafjy; -aafjz; -aafka; -aafkb; -aafkc; -aafkd; -aafke; -aafkf; -aafkg; -aafkh; -aafki; -aafkj; -aafkk; -aafkl; -aafkm; -aafkn; -aafko; -aafkp; -aafkq; -aafkr; -aafks; -aafkt; -aafku; -aafkv; -aafkw; -aafkx; -aafky; -aafkz; -aafla; -aaflb; -aaflc; -aafld; -aafle; -aaflf; -aaflg; -aaflh; -aafli; -aaflj; -aaflk; -aafll; -aaflm; -aafln; -aaflo; -aaflp; -aaflq; -aaflr; -aafls; -aaflt; -aaflu; -aaflv; -aaflw; -aaflx; -aafly; -aaflz; -aafma; -aafmb; -aafmc; -aafmd; -aafme; -aafmf; -aafmg; -aafmh; -aafmi; -aafmj; -aafmk; -aafml; -aafmm; -aafmn; -aafmo; -aafmp; -aafmq; -aafmr; -aafms; -aafmt; -aafmu; -aafmv; -aafmw; -aafmx; -aafmy; -aafmz; -aafna; -aafnb; -aafnc; -aafnd; -aafne; -aafnf; -aafng; -aafnh; -aafni; -aafnj; -aafnk; -aafnl; -aafnm; -aafnn; -aafno; -aafnp; -aafnq; -aafnr; -aafns; -aafnt; -aafnu; -aafnv; -aafnw; -aafnx; -aafny; -aafnz; -aafoa; -aafob; -aafoc; -aafod; -aafoe; -aafof; -aafog; -aafoh; -aafoi; -aafoj; -aafok; -aafol; -aafom; -aafon; -aafoo; -aafop; -aafoq; -aafor; -aafos; -aafot; -aafou; -aafov; -aafow; -aafox; -aafoy; -aafoz; -aafpa; -aafpb; -aafpc; -aafpd; -aafpe; -aafpf; -aafpg; -aafph; -aafpi; -aafpj; -aafpk; -aafpl; -aafpm; -aafpn; -aafpo; -aafpp; -aafpq; -aafpr; -aafps; -aafpt; -aafpu; -aafpv; -aafpw; -aafpx; -aafpy; -aafpz; -aafqa; -aafqb; -aafqc; -aafqd; -aafqe; -aafqf; -aafqg; -aafqh; -aafqi; -aafqj; -aafqk; -aafql; -aafqm; -aafqn; -aafqo; -aafqp; -aafqq; -aafqr; -aafqs; -aafqt; -aafqu; -aafqv; -aafqw; -aafqx; -aafqy; -aafqz; -aafra; -aafrb; -aafrc; -aafrd; -aafre; -aafrf; -aafrg; -aafrh; -aafri; -aafrj; -aafrk; -aafrl; -aafrm; -aafrn; -aafro; -aafrp; -aafrq; -aafrr; -aafrs; -aafrt; -aafru; -aafrv; -aafrw; -aafrx; -aafry; -aafrz; -aafsa; -aafsb; -aafsc; -aafsd; -aafse; -aafsf; -aafsg; -aafsh; -aafsi; -aafsj; -aafsk; -aafsl; -aafsm; -aafsn; -aafso; -aafsp; -aafsq; -aafsr; -aafss; -aafst; -aafsu; -aafsv; -aafsw; -aafsx; -aafsy; -aafsz; -aafta; -aaftb; -aaftc; -aaftd; -aafte; -aaftf; -aaftg; -aafth; -aafti; -aaftj; -aaftk; -aaftl; -aaftm; -aaftn; -aafto; -aaftp; -aaftq; -aaftr; -aafts; -aaftt; -aaftu; -aaftv; -aaftw; -aaftx; -aafty; -aaftz; -aafua; -aafub; -aafuc; -aafud; -aafue; -aafuf; -aafug; -aafuh; -aafui; -aafuj; -aafuk; -aaful; -aafum; -aafun; -aafuo; -aafup; -aafuq; -aafur; -aafus; -aafut; -aafuu; -aafuv; -aafuw; -aafux; -aafuy; -aafuz; -aafva; -aafvb; -aafvc; -aafvd; -aafve; -aafvf; -aafvg; -aafvh; -aafvi; -aafvj; -aafvk; -aafvl; -aafvm; -aafvn; -aafvo; -aafvp; -aafvq; -aafvr; -aafvs; -aafvt; -aafvu; -aafvv; -aafvw; -aafvx; -aafvy; -aafvz; -aafwa; -aafwb; -aafwc; -aafwd; -aafwe; -aafwf; -aafwg; -aafwh; -aafwi; -aafwj; -aafwk; -aafwl; -aafwm; -aafwn; -aafwo; -aafwp; -aafwq; -aafwr; -aafws; -aafwt; -aafwu; -aafwv; -aafww; -aafwx; -aafwy; -aafwz; -aafxa; -aafxb; -aafxc; -aafxd; -aafxe; -aafxf; -aafxg; -aafxh; -aafxi; -aafxj; -aafxk; -aafxl; -aafxm; -aafxn; -aafxo; -aafxp; -aafxq; -aafxr; -aafxs; -aafxt; -aafxu; -aafxv; -aafxw; -aafxx; -aafxy; -aafxz; -aafya; -aafyb; -aafyc; -aafyd; -aafye; -aafyf; -aafyg; -aafyh; -aafyi; -aafyj; -aafyk; -aafyl; -aafym; -aafyn; -aafyo; -aafyp; -aafyq; -aafyr; -aafys; -aafyt; -aafyu; -aafyv; -aafyw; -aafyx; -aafyy; -aafyz; -aafza; -aafzb; -aafzc; -aafzd; -aafze; -aafzf; -aafzg; -aafzh; -aafzi; -aafzj; -aafzk; -aafzl; -aafzm; -aafzn; -aafzo; -aafzp; -aafzq; -aafzr; -aafzs; -aafzt; -aafzu; -aafzv; -aafzw; -aafzx; -aafzy; -aafzz; -aagaa; -aagab; -aagac; -aagad; -aagae; -aagaf; -aagag; -aagah; -aagai; -aagaj; -aagak; -aagal; -aagam; -aagan; -aagao; -aagap; -aagaq; -aagar; -aagas; -aagat; -aagau; -aagav; -aagaw; -aagax; -aagay; -aagaz; -aagba; -aagbb; -aagbc; -aagbd; -aagbe; -aagbf; -aagbg; -aagbh; -aagbi; -aagbj; -aagbk; -aagbl; -aagbm; -aagbn; -aagbo; -aagbp; -aagbq; -aagbr; -aagbs; -aagbt; -aagbu; -aagbv; -aagbw; -aagbx; -aagby; -aagbz; -aagca; -aagcb; -aagcc; -aagcd; -aagce; -aagcf; -aagcg; -aagch; -aagci; -aagcj; -aagck; -aagcl; -aagcm; -aagcn; -aagco; -aagcp; -aagcq; -aagcr; -aagcs; -aagct; -aagcu; -aagcv; -aagcw; -aagcx; -aagcy; -aagcz; -aagda; -aagdb; -aagdc; -aagdd; -aagde; -aagdf; -aagdg; -aagdh; -aagdi; -aagdj; -aagdk; -aagdl; -aagdm; -aagdn; -aagdo; -aagdp; -aagdq; -aagdr; -aagds; -aagdt; -aagdu; -aagdv; -aagdw; -aagdx; -aagdy; -aagdz; -aagea; -aageb; -aagec; -aaged; -aagee; -aagef; -aageg; -aageh; -aagei; -aagej; -aagek; -aagel; -aagem; -aagen; -aageo; -aagep; -aageq; -aager; -aages; -aaget; -aageu; -aagev; -aagew; -aagex; -aagey; -aagez; -aagfa; -aagfb; -aagfc; -aagfd; -aagfe; -aagff; -aagfg; -aagfh; -aagfi; -aagfj; -aagfk; -aagfl; -aagfm; -aagfn; -aagfo; -aagfp; -aagfq; -aagfr; -aagfs; -aagft; -aagfu; -aagfv; -aagfw; -aagfx; -aagfy; -aagfz; -aagga; -aaggb; -aaggc; -aaggd; -aagge; -aaggf; -aaggg; -aaggh; -aaggi; -aaggj; -aaggk; -aaggl; -aaggm; -aaggn; -aaggo; -aaggp; -aaggq; -aaggr; -aaggs; -aaggt; -aaggu; -aaggv; -aaggw; -aaggx; -aaggy; -aaggz; -aagha; -aaghb; -aaghc; -aaghd; -aaghe; -aaghf; -aaghg; -aaghh; -aaghi; -aaghj; -aaghk; -aaghl; -aaghm; -aaghn; -aagho; -aaghp; -aaghq; -aaghr; -aaghs; -aaght; -aaghu; -aaghv; -aaghw; -aaghx; -aaghy; -aaghz; -aagia; -aagib; -aagic; -aagid; -aagie; -aagif; -aagig; -aagih; -aagii; -aagij; -aagik; -aagil; -aagim; -aagin; -aagio; -aagip; -aagiq; -aagir; -aagis; -aagit; -aagiu; -aagiv; -aagiw; -aagix; -aagiy; -aagiz; -aagja; -aagjb; -aagjc; -aagjd; -aagje; -aagjf; -aagjg; -aagjh; -aagji; -aagjj; -aagjk; -aagjl; -aagjm; -aagjn; -aagjo; -aagjp; -aagjq; -aagjr; -aagjs; -aagjt; -aagju; -aagjv; -aagjw; -aagjx; -aagjy; -aagjz; -aagka; -aagkb; -aagkc; -aagkd; -aagke; -aagkf; -aagkg; -aagkh; -aagki; -aagkj; -aagkk; -aagkl; -aagkm; -aagkn; -aagko; -aagkp; -aagkq; -aagkr; -aagks; -aagkt; -aagku; -aagkv; -aagkw; -aagkx; -aagky; -aagkz; -aagla; -aaglb; -aaglc; -aagld; -aagle; -aaglf; -aaglg; -aaglh; -aagli; -aaglj; -aaglk; -aagll; -aaglm; -aagln; -aaglo; -aaglp; -aaglq; -aaglr; -aagls; -aaglt; -aaglu; -aaglv; -aaglw; -aaglx; -aagly; -aaglz; -aagma; -aagmb; -aagmc; -aagmd; -aagme; -aagmf; -aagmg; -aagmh; -aagmi; -aagmj; -aagmk; -aagml; -aagmm; -aagmn; -aagmo; -aagmp; -aagmq; -aagmr; -aagms; -aagmt; -aagmu; -aagmv; -aagmw; -aagmx; -aagmy; -aagmz; -aagna; -aagnb; -aagnc; -aagnd; -aagne; -aagnf; -aagng; -aagnh; -aagni; -aagnj; -aagnk; -aagnl; -aagnm; -aagnn; -aagno; -aagnp; -aagnq; -aagnr; -aagns; -aagnt; -aagnu; -aagnv; -aagnw; -aagnx; -aagny; -aagnz; -aagoa; -aagob; -aagoc; -aagod; -aagoe; -aagof; -aagog; -aagoh; -aagoi; -aagoj; -aagok; -aagol; -aagom; -aagon; -aagoo; -aagop; -aagoq; -aagor; -aagos; -aagot; -aagou; -aagov; -aagow; -aagox; -aagoy; -aagoz; -aagpa; -aagpb; -aagpc; -aagpd; -aagpe; -aagpf; -aagpg; -aagph; -aagpi; -aagpj; -aagpk; -aagpl; -aagpm; -aagpn; -aagpo; -aagpp; -aagpq; -aagpr; -aagps; -aagpt; -aagpu; -aagpv; -aagpw; -aagpx; -aagpy; -aagpz; -aagqa; -aagqb; -aagqc; -aagqd; -aagqe; -aagqf; -aagqg; -aagqh; -aagqi; -aagqj; -aagqk; -aagql; -aagqm; -aagqn; -aagqo; -aagqp; -aagqq; -aagqr; -aagqs; -aagqt; -aagqu; -aagqv; -aagqw; -aagqx; -aagqy; -aagqz; -aagra; -aagrb; -aagrc; -aagrd; -aagre; -aagrf; -aagrg; -aagrh; -aagri; -aagrj; -aagrk; -aagrl; -aagrm; -aagrn; -aagro; -aagrp; -aagrq; -aagrr; -aagrs; -aagrt; -aagru; -aagrv; -aagrw; -aagrx; -aagry; -aagrz; -aagsa; -aagsb; -aagsc; -aagsd; -aagse; -aagsf; -aagsg; -aagsh; -aagsi; -aagsj; -aagsk; -aagsl; -aagsm; -aagsn; -aagso; -aagsp; -aagsq; -aagsr; -aagss; -aagst; -aagsu; -aagsv; -aagsw; -aagsx; -aagsy; -aagsz; -aagta; -aagtb; -aagtc; -aagtd; -aagte; -aagtf; -aagtg; -aagth; -aagti; -aagtj; -aagtk; -aagtl; -aagtm; -aagtn; -aagto; -aagtp; -aagtq; -aagtr; -aagts; -aagtt; -aagtu; -aagtv; -aagtw; -aagtx; -aagty; -aagtz; -aagua; -aagub; -aaguc; -aagud; -aague; -aaguf; -aagug; -aaguh; -aagui; -aaguj; -aaguk; -aagul; -aagum; -aagun; -aaguo; -aagup; -aaguq; -aagur; -aagus; -aagut; -aaguu; -aaguv; -aaguw; -aagux; -aaguy; -aaguz; -aagva; -aagvb; -aagvc; -aagvd; -aagve; -aagvf; -aagvg; -aagvh; -aagvi; -aagvj; -aagvk; -aagvl; -aagvm; -aagvn; -aagvo; -aagvp; -aagvq; -aagvr; -aagvs; -aagvt; -aagvu; -aagvv; -aagvw; -aagvx; -aagvy; -aagvz; -aagwa; -aagwb; -aagwc; -aagwd; -aagwe; -aagwf; -aagwg; -aagwh; -aagwi; -aagwj; -aagwk; -aagwl; -aagwm; -aagwn; -aagwo; -aagwp; -aagwq; -aagwr; -aagws; -aagwt; -aagwu; -aagwv; -aagww; -aagwx; -aagwy; -aagwz; -aagxa; -aagxb; -aagxc; -aagxd; -aagxe; -aagxf; -aagxg; -aagxh; -aagxi; -aagxj; -aagxk; -aagxl; -aagxm; -aagxn; -aagxo; -aagxp; -aagxq; -aagxr; -aagxs; -aagxt; -aagxu; -aagxv; -aagxw; -aagxx; -aagxy; -aagxz; -aagya; -aagyb; -aagyc; -aagyd; -aagye; -aagyf; -aagyg; -aagyh; -aagyi; -aagyj; -aagyk; -aagyl; -aagym; -aagyn; -aagyo; -aagyp; -aagyq; -aagyr; -aagys; -aagyt; -aagyu; -aagyv; -aagyw; -aagyx; -aagyy; -aagyz; -aagza; -aagzb; -aagzc; -aagzd; -aagze; -aagzf; -aagzg; -aagzh; -aagzi; -aagzj; -aagzk; -aagzl; -aagzm; -aagzn; -aagzo; -aagzp; -aagzq; -aagzr; -aagzs; -aagzt; -aagzu; -aagzv; -aagzw; -aagzx; -aagzy; -aagzz; -aahaa; -aahab; -aahac; -aahad; -aahae; -aahaf; -aahag; -aahah; -aahai; -aahaj; -aahak; -aahal; -aaham; -aahan; -aahao; -aahap; -aahaq; -aahar; -aahas; -aahat; -aahau; -aahav; -aahaw; -aahax; -aahay; -aahaz; -aahba; -aahbb; -aahbc; -aahbd; -aahbe; -aahbf; -aahbg; -aahbh; -aahbi; -aahbj; -aahbk; -aahbl; -aahbm; -aahbn; -aahbo; -aahbp; -aahbq; -aahbr; -aahbs; -aahbt; -aahbu; -aahbv; -aahbw; -aahbx; -aahby; -aahbz; -aahca; -aahcb; -aahcc; -aahcd; -aahce; -aahcf; -aahcg; -aahch; -aahci; -aahcj; -aahck; -aahcl; -aahcm; -aahcn; -aahco; -aahcp; -aahcq; -aahcr; -aahcs; -aahct; -aahcu; -aahcv; -aahcw; -aahcx; -aahcy; -aahcz; -aahda; -aahdb; -aahdc; -aahdd; -aahde; -aahdf; -aahdg; -aahdh; -aahdi; -aahdj; -aahdk; -aahdl; -aahdm; -aahdn; -aahdo; -aahdp; -aahdq; -aahdr; -aahds; -aahdt; -aahdu; -aahdv; -aahdw; -aahdx; -aahdy; -aahdz; -aahea; -aaheb; -aahec; -aahed; -aahee; -aahef; -aaheg; -aaheh; -aahei; -aahej; -aahek; -aahel; -aahem; -aahen; -aaheo; -aahep; -aaheq; -aaher; -aahes; -aahet; -aaheu; -aahev; -aahew; -aahex; -aahey; -aahez; -aahfa; -aahfb; -aahfc; -aahfd; -aahfe; -aahff; -aahfg; -aahfh; -aahfi; -aahfj; -aahfk; -aahfl; -aahfm; -aahfn; -aahfo; -aahfp; -aahfq; -aahfr; -aahfs; -aahft; -aahfu; -aahfv; -aahfw; -aahfx; -aahfy; -aahfz; -aahga; -aahgb; -aahgc; -aahgd; -aahge; -aahgf; -aahgg; -aahgh; -aahgi; -aahgj; -aahgk; -aahgl; -aahgm; -aahgn; -aahgo; -aahgp; -aahgq; -aahgr; -aahgs; -aahgt; -aahgu; -aahgv; -aahgw; -aahgx; -aahgy; -aahgz; -aahha; -aahhb; -aahhc; -aahhd; -aahhe; -aahhf; -aahhg; -aahhh; -aahhi; -aahhj; -aahhk; -aahhl; -aahhm; -aahhn; -aahho; -aahhp; -aahhq; -aahhr; -aahhs; -aahht; -aahhu; -aahhv; -aahhw; -aahhx; -aahhy; -aahhz; -aahia; -aahib; -aahic; -aahid; -aahie; -aahif; -aahig; -aahih; -aahii; -aahij; -aahik; -aahil; -aahim; -aahin; -aahio; -aahip; -aahiq; -aahir; -aahis; -aahit; -aahiu; -aahiv; -aahiw; -aahix; -aahiy; -aahiz; -aahja; -aahjb; -aahjc; -aahjd; -aahje; -aahjf; -aahjg; -aahjh; -aahji; -aahjj; -aahjk; -aahjl; -aahjm; -aahjn; -aahjo; -aahjp; -aahjq; -aahjr; -aahjs; -aahjt; -aahju; -aahjv; -aahjw; -aahjx; -aahjy; -aahjz; -aahka; -aahkb; -aahkc; -aahkd; -aahke; -aahkf; -aahkg; -aahkh; -aahki; -aahkj; -aahkk; -aahkl; -aahkm; -aahkn; -aahko; -aahkp; -aahkq; -aahkr; -aahks; -aahkt; -aahku; -aahkv; -aahkw; -aahkx; -aahky; -aahkz; -aahla; -aahlb; -aahlc; -aahld; -aahle; -aahlf; -aahlg; -aahlh; -aahli; -aahlj; -aahlk; -aahll; -aahlm; -aahln; -aahlo; -aahlp; -aahlq; -aahlr; -aahls; -aahlt; -aahlu; -aahlv; -aahlw; -aahlx; -aahly; -aahlz; -aahma; -aahmb; -aahmc; -aahmd; -aahme; -aahmf; -aahmg; -aahmh; -aahmi; -aahmj; -aahmk; -aahml; -aahmm; -aahmn; -aahmo; -aahmp; -aahmq; -aahmr; -aahms; -aahmt; -aahmu; -aahmv; -aahmw; -aahmx; -aahmy; -aahmz; -aahna; -aahnb; -aahnc; -aahnd; -aahne; -aahnf; -aahng; -aahnh; -aahni; -aahnj; -aahnk; -aahnl; -aahnm; -aahnn; -aahno; -aahnp; -aahnq; -aahnr; -aahns; -aahnt; -aahnu; -aahnv; -aahnw; -aahnx; -aahny; -aahnz; -aahoa; -aahob; -aahoc; -aahod; -aahoe; -aahof; -aahog; -aahoh; -aahoi; -aahoj; -aahok; -aahol; -aahom; -aahon; -aahoo; -aahop; -aahoq; -aahor; -aahos; -aahot; -aahou; -aahov; -aahow; -aahox; -aahoy; -aahoz; -aahpa; -aahpb; -aahpc; -aahpd; -aahpe; -aahpf; -aahpg; -aahph; -aahpi; -aahpj; -aahpk; -aahpl; -aahpm; -aahpn; -aahpo; -aahpp; -aahpq; -aahpr; -aahps; -aahpt; -aahpu; -aahpv; -aahpw; -aahpx; -aahpy; -aahpz; -aahqa; -aahqb; -aahqc; -aahqd; -aahqe; -aahqf; -aahqg; -aahqh; -aahqi; -aahqj; -aahqk; -aahql; -aahqm; -aahqn; -aahqo; -aahqp; -aahqq; -aahqr; -aahqs; -aahqt; -aahqu; -aahqv; -aahqw; -aahqx; -aahqy; -aahqz; -aahra; -aahrb; -aahrc; -aahrd; -aahre; -aahrf; -aahrg; -aahrh; -aahri; -aahrj; -aahrk; -aahrl; -aahrm; -aahrn; -aahro; -aahrp; -aahrq; -aahrr; -aahrs; -aahrt; -aahru; -aahrv; -aahrw; -aahrx; -aahry; -aahrz; -aahsa; -aahsb; -aahsc; -aahsd; -aahse; -aahsf; -aahsg; -aahsh; -aahsi; -aahsj; -aahsk; -aahsl; -aahsm; -aahsn; -aahso; -aahsp; -aahsq; -aahsr; -aahss; -aahst; -aahsu; -aahsv; -aahsw; -aahsx; -aahsy; -aahsz; -aahta; -aahtb; -aahtc; -aahtd; -aahte; -aahtf; -aahtg; -aahth; -aahti; -aahtj; -aahtk; -aahtl; -aahtm; -aahtn; -aahto; -aahtp; -aahtq; -aahtr; -aahts; -aahtt; -aahtu; -aahtv; -aahtw; -aahtx; -aahty; -aahtz; -aahua; -aahub; -aahuc; -aahud; -aahue; -aahuf; -aahug; -aahuh; -aahui; -aahuj; -aahuk; -aahul; -aahum; -aahun; -aahuo; -aahup; -aahuq; -aahur; -aahus; -aahut; -aahuu; -aahuv; -aahuw; -aahux; -aahuy; -aahuz; -aahva; -aahvb; -aahvc; -aahvd; -aahve; -aahvf; -aahvg; -aahvh; -aahvi; -aahvj; -aahvk; -aahvl; -aahvm; -aahvn; -aahvo; -aahvp; -aahvq; -aahvr; -aahvs; -aahvt; -aahvu; -aahvv; -aahvw; -aahvx; -aahvy; -aahvz; -aahwa; -aahwb; -aahwc; -aahwd; -aahwe; -aahwf; -aahwg; -aahwh; -aahwi; -aahwj; -aahwk; -aahwl; -aahwm; -aahwn; -aahwo; -aahwp; -aahwq; -aahwr; -aahws; -aahwt; -aahwu; -aahwv; -aahww; -aahwx; -aahwy; -aahwz; -aahxa; -aahxb; -aahxc; -aahxd; -aahxe; -aahxf; -aahxg; -aahxh; -aahxi; -aahxj; -aahxk; -aahxl; -aahxm; -aahxn; -aahxo; -aahxp; -aahxq; -aahxr; -aahxs; -aahxt; -aahxu; -aahxv; -aahxw; -aahxx; -aahxy; -aahxz; -aahya; -aahyb; -aahyc; -aahyd; -aahye; -aahyf; -aahyg; -aahyh; -aahyi; -aahyj; -aahyk; -aahyl; -aahym; -aahyn; -aahyo; -aahyp; -aahyq; -aahyr; -aahys; -aahyt; -aahyu; -aahyv; -aahyw; -aahyx; -aahyy; -aahyz; -aahza; -aahzb; -aahzc; -aahzd; -aahze; -aahzf; -aahzg; -aahzh; -aahzi; -aahzj; -aahzk; -aahzl; -aahzm; -aahzn; -aahzo; -aahzp; -aahzq; -aahzr; -aahzs; -aahzt; -aahzu; -aahzv; -aahzw; -aahzx; -aahzy; -aahzz; -aaiaa; -aaiab; -aaiac; -aaiad; -aaiae; -aaiaf; -aaiag; -aaiah; -aaiai; -aaiaj; -aaiak; -aaial; -aaiam; -aaian; -aaiao; -aaiap; -aaiaq; -aaiar; -aaias; -aaiat; -aaiau; -aaiav; -aaiaw; -aaiax; -aaiay; -aaiaz; -aaiba; -aaibb; -aaibc; -aaibd; -aaibe; -aaibf; -aaibg; -aaibh; -aaibi; -aaibj; -aaibk; -aaibl; -aaibm; -aaibn; -aaibo; -aaibp; -aaibq; -aaibr; -aaibs; -aaibt; -aaibu; -aaibv; -aaibw; -aaibx; -aaiby; -aaibz; -aaica; -aaicb; -aaicc; -aaicd; -aaice; -aaicf; -aaicg; -aaich; -aaici; -aaicj; -aaick; -aaicl; -aaicm; -aaicn; -aaico; -aaicp; -aaicq; -aaicr; -aaics; -aaict; -aaicu; -aaicv; -aaicw; -aaicx; -aaicy; -aaicz; -aaida; -aaidb; -aaidc; -aaidd; -aaide; -aaidf; -aaidg; -aaidh; -aaidi; -aaidj; -aaidk; -aaidl; -aaidm; -aaidn; -aaido; -aaidp; -aaidq; -aaidr; -aaids; -aaidt; -aaidu; -aaidv; -aaidw; -aaidx; -aaidy; -aaidz; -aaiea; -aaieb; -aaiec; -aaied; -aaiee; -aaief; -aaieg; -aaieh; -aaiei; -aaiej; -aaiek; -aaiel; -aaiem; -aaien; -aaieo; -aaiep; -aaieq; -aaier; -aaies; -aaiet; -aaieu; -aaiev; -aaiew; -aaiex; -aaiey; -aaiez; -aaifa; -aaifb; -aaifc; -aaifd; -aaife; -aaiff; -aaifg; -aaifh; -aaifi; -aaifj; -aaifk; -aaifl; -aaifm; -aaifn; -aaifo; -aaifp; -aaifq; -aaifr; -aaifs; -aaift; -aaifu; -aaifv; -aaifw; -aaifx; -aaify; -aaifz; -aaiga; -aaigb; -aaigc; -aaigd; -aaige; -aaigf; -aaigg; -aaigh; -aaigi; -aaigj; -aaigk; -aaigl; -aaigm; -aaign; -aaigo; -aaigp; -aaigq; -aaigr; -aaigs; -aaigt; -aaigu; -aaigv; -aaigw; -aaigx; -aaigy; -aaigz; -aaiha; -aaihb; -aaihc; -aaihd; -aaihe; -aaihf; -aaihg; -aaihh; -aaihi; -aaihj; -aaihk; -aaihl; -aaihm; -aaihn; -aaiho; -aaihp; -aaihq; -aaihr; -aaihs; -aaiht; -aaihu; -aaihv; -aaihw; -aaihx; -aaihy; -aaihz; -aaiia; -aaiib; -aaiic; -aaiid; -aaiie; -aaiif; -aaiig; -aaiih; -aaiii; -aaiij; -aaiik; -aaiil; -aaiim; -aaiin; -aaiio; -aaiip; -aaiiq; -aaiir; -aaiis; -aaiit; -aaiiu; -aaiiv; -aaiiw; -aaiix; -aaiiy; -aaiiz; -aaija; -aaijb; -aaijc; -aaijd; -aaije; -aaijf; -aaijg; -aaijh; -aaiji; -aaijj; -aaijk; -aaijl; -aaijm; -aaijn; -aaijo; -aaijp; -aaijq; -aaijr; -aaijs; -aaijt; -aaiju; -aaijv; -aaijw; -aaijx; -aaijy; -aaijz; -aaika; -aaikb; -aaikc; -aaikd; -aaike; -aaikf; -aaikg; -aaikh; -aaiki; -aaikj; -aaikk; -aaikl; -aaikm; -aaikn; -aaiko; -aaikp; -aaikq; -aaikr; -aaiks; -aaikt; -aaiku; -aaikv; -aaikw; -aaikx; -aaiky; -aaikz; -aaila; -aailb; -aailc; -aaild; -aaile; -aailf; -aailg; -aailh; -aaili; -aailj; -aailk; -aaill; -aailm; -aailn; -aailo; -aailp; -aailq; -aailr; -aails; -aailt; -aailu; -aailv; -aailw; -aailx; -aaily; -aailz; -aaima; -aaimb; -aaimc; -aaimd; -aaime; -aaimf; -aaimg; -aaimh; -aaimi; -aaimj; -aaimk; -aaiml; -aaimm; -aaimn; -aaimo; -aaimp; -aaimq; -aaimr; -aaims; -aaimt; -aaimu; -aaimv; -aaimw; -aaimx; -aaimy; -aaimz; -aaina; -aainb; -aainc; -aaind; -aaine; -aainf; -aaing; -aainh; -aaini; -aainj; -aaink; -aainl; -aainm; -aainn; -aaino; -aainp; -aainq; -aainr; -aains; -aaint; -aainu; -aainv; -aainw; -aainx; -aainy; -aainz; -aaioa; -aaiob; -aaioc; -aaiod; -aaioe; -aaiof; -aaiog; -aaioh; -aaioi; -aaioj; -aaiok; -aaiol; -aaiom; -aaion; -aaioo; -aaiop; -aaioq; -aaior; -aaios; -aaiot; -aaiou; -aaiov; -aaiow; -aaiox; -aaioy; -aaioz; -aaipa; -aaipb; -aaipc; -aaipd; -aaipe; -aaipf; -aaipg; -aaiph; -aaipi; -aaipj; -aaipk; -aaipl; -aaipm; -aaipn; -aaipo; -aaipp; -aaipq; -aaipr; -aaips; -aaipt; -aaipu; -aaipv; -aaipw; -aaipx; -aaipy; -aaipz; -aaiqa; -aaiqb; -aaiqc; -aaiqd; -aaiqe; -aaiqf; -aaiqg; -aaiqh; -aaiqi; -aaiqj; -aaiqk; -aaiql; -aaiqm; -aaiqn; -aaiqo; -aaiqp; -aaiqq; -aaiqr; -aaiqs; -aaiqt; -aaiqu; -aaiqv; -aaiqw; -aaiqx; -aaiqy; -aaiqz; -aaira; -aairb; -aairc; -aaird; -aaire; -aairf; -aairg; -aairh; -aairi; -aairj; -aairk; -aairl; -aairm; -aairn; -aairo; -aairp; -aairq; -aairr; -aairs; -aairt; -aairu; -aairv; -aairw; -aairx; -aairy; -aairz; -aaisa; -aaisb; -aaisc; -aaisd; -aaise; -aaisf; -aaisg; -aaish; -aaisi; -aaisj; -aaisk; -aaisl; -aaism; -aaisn; -aaiso; -aaisp; -aaisq; -aaisr; -aaiss; -aaist; -aaisu; -aaisv; -aaisw; -aaisx; -aaisy; -aaisz; -aaita; -aaitb; -aaitc; -aaitd; -aaite; -aaitf; -aaitg; -aaith; -aaiti; -aaitj; -aaitk; -aaitl; -aaitm; -aaitn; -aaito; -aaitp; -aaitq; -aaitr; -aaits; -aaitt; -aaitu; -aaitv; -aaitw; -aaitx; -aaity; -aaitz; -aaiua; -aaiub; -aaiuc; -aaiud; -aaiue; -aaiuf; -aaiug; -aaiuh; -aaiui; -aaiuj; -aaiuk; -aaiul; -aaium; -aaiun; -aaiuo; -aaiup; -aaiuq; -aaiur; -aaius; -aaiut; -aaiuu; -aaiuv; -aaiuw; -aaiux; -aaiuy; -aaiuz; -aaiva; -aaivb; -aaivc; -aaivd; -aaive; -aaivf; -aaivg; -aaivh; -aaivi; -aaivj; -aaivk; -aaivl; -aaivm; -aaivn; -aaivo; -aaivp; -aaivq; -aaivr; -aaivs; -aaivt; -aaivu; -aaivv; -aaivw; -aaivx; -aaivy; -aaivz; -aaiwa; -aaiwb; -aaiwc; -aaiwd; -aaiwe; -aaiwf; -aaiwg; -aaiwh; -aaiwi; -aaiwj; -aaiwk; -aaiwl; -aaiwm; -aaiwn; -aaiwo; -aaiwp; -aaiwq; -aaiwr; -aaiws; -aaiwt; -aaiwu; -aaiwv; -aaiww; -aaiwx; -aaiwy; -aaiwz; -aaixa; -aaixb; -aaixc; -aaixd; -aaixe; -aaixf; -aaixg; -aaixh; -aaixi; -aaixj; -aaixk; -aaixl; -aaixm; -aaixn; -aaixo; -aaixp; -aaixq; -aaixr; -aaixs; -aaixt; -aaixu; -aaixv; -aaixw; -aaixx; -aaixy; -aaixz; -aaiya; -aaiyb; -aaiyc; -aaiyd; -aaiye; -aaiyf; -aaiyg; -aaiyh; -aaiyi; -aaiyj; -aaiyk; -aaiyl; -aaiym; -aaiyn; -aaiyo; -aaiyp; -aaiyq; -aaiyr; -aaiys; -aaiyt; -aaiyu; -aaiyv; -aaiyw; -aaiyx; -aaiyy; -aaiyz; -aaiza; -aaizb; -aaizc; -aaizd; -aaize; -aaizf; -aaizg; -aaizh; -aaizi; -aaizj; -aaizk; -aaizl; -aaizm; -aaizn; -aaizo; -aaizp; -aaizq; -aaizr; -aaizs; -aaizt; -aaizu; -aaizv; -aaizw; -aaizx; -aaizy; -aaizz; -aajaa; -aajab; -aajac; -aajad; -aajae; -aajaf; -aajag; -aajah; -aajai; -aajaj; -aajak; -aajal; -aajam; -aajan; -aajao; -aajap; -aajaq; -aajar; -aajas; -aajat; -aajau; -aajav; -aajaw; -aajax; -aajay; -aajaz; -aajba; -aajbb; -aajbc; -aajbd; -aajbe; -aajbf; -aajbg; -aajbh; -aajbi; -aajbj; -aajbk; -aajbl; -aajbm; -aajbn; -aajbo; -aajbp; -aajbq; -aajbr; -aajbs; -aajbt; -aajbu; -aajbv; -aajbw; -aajbx; -aajby; -aajbz; -aajca; -aajcb; -aajcc; -aajcd; -aajce; -aajcf; -aajcg; -aajch; -aajci; -aajcj; -aajck; -aajcl; -aajcm; -aajcn; -aajco; -aajcp; -aajcq; -aajcr; -aajcs; -aajct; -aajcu; -aajcv; -aajcw; -aajcx; -aajcy; -aajcz; -aajda; -aajdb; -aajdc; -aajdd; -aajde; -aajdf; -aajdg; -aajdh; -aajdi; -aajdj; -aajdk; -aajdl; -aajdm; -aajdn; -aajdo; -aajdp; -aajdq; -aajdr; -aajds; -aajdt; -aajdu; -aajdv; -aajdw; -aajdx; -aajdy; -aajdz; -aajea; -aajeb; -aajec; -aajed; -aajee; -aajef; -aajeg; -aajeh; -aajei; -aajej; -aajek; -aajel; -aajem; -aajen; -aajeo; -aajep; -aajeq; -aajer; -aajes; -aajet; -aajeu; -aajev; -aajew; -aajex; -aajey; -aajez; -aajfa; -aajfb; -aajfc; -aajfd; -aajfe; -aajff; -aajfg; -aajfh; -aajfi; -aajfj; -aajfk; -aajfl; -aajfm; -aajfn; -aajfo; -aajfp; -aajfq; -aajfr; -aajfs; -aajft; -aajfu; -aajfv; -aajfw; -aajfx; -aajfy; -aajfz; -aajga; -aajgb; -aajgc; -aajgd; -aajge; -aajgf; -aajgg; -aajgh; -aajgi; -aajgj; -aajgk; -aajgl; -aajgm; -aajgn; -aajgo; -aajgp; -aajgq; -aajgr; -aajgs; -aajgt; -aajgu; -aajgv; -aajgw; -aajgx; -aajgy; -aajgz; -aajha; -aajhb; -aajhc; -aajhd; -aajhe; -aajhf; -aajhg; -aajhh; -aajhi; -aajhj; -aajhk; -aajhl; -aajhm; -aajhn; -aajho; -aajhp; -aajhq; -aajhr; -aajhs; -aajht; -aajhu; -aajhv; -aajhw; -aajhx; -aajhy; -aajhz; -aajia; -aajib; -aajic; -aajid; -aajie; -aajif; -aajig; -aajih; -aajii; -aajij; -aajik; -aajil; -aajim; -aajin; -aajio; -aajip; -aajiq; -aajir; -aajis; -aajit; -aajiu; -aajiv; -aajiw; -aajix; -aajiy; -aajiz; -aajja; -aajjb; -aajjc; -aajjd; -aajje; -aajjf; -aajjg; -aajjh; -aajji; -aajjj; -aajjk; -aajjl; -aajjm; -aajjn; -aajjo; -aajjp; -aajjq; -aajjr; -aajjs; -aajjt; -aajju; -aajjv; -aajjw; -aajjx; -aajjy; -aajjz; -aajka; -aajkb; -aajkc; -aajkd; -aajke; -aajkf; -aajkg; -aajkh; -aajki; -aajkj; -aajkk; -aajkl; -aajkm; -aajkn; -aajko; -aajkp; -aajkq; -aajkr; -aajks; -aajkt; -aajku; -aajkv; -aajkw; -aajkx; -aajky; -aajkz; -aajla; -aajlb; -aajlc; -aajld; -aajle; -aajlf; -aajlg; -aajlh; -aajli; -aajlj; -aajlk; -aajll; -aajlm; -aajln; -aajlo; -aajlp; -aajlq; -aajlr; -aajls; -aajlt; -aajlu; -aajlv; -aajlw; -aajlx; -aajly; -aajlz; -aajma; -aajmb; -aajmc; -aajmd; -aajme; -aajmf; -aajmg; -aajmh; -aajmi; -aajmj; -aajmk; -aajml; -aajmm; -aajmn; -aajmo; -aajmp; -aajmq; -aajmr; -aajms; -aajmt; -aajmu; -aajmv; -aajmw; -aajmx; -aajmy; -aajmz; -aajna; -aajnb; -aajnc; -aajnd; -aajne; -aajnf; -aajng; -aajnh; -aajni; -aajnj; -aajnk; -aajnl; -aajnm; -aajnn; -aajno; -aajnp; -aajnq; -aajnr; -aajns; -aajnt; -aajnu; -aajnv; -aajnw; -aajnx; -aajny; -aajnz; -aajoa; -aajob; -aajoc; -aajod; -aajoe; -aajof; -aajog; -aajoh; -aajoi; -aajoj; -aajok; -aajol; -aajom; -aajon; -aajoo; -aajop; -aajoq; -aajor; -aajos; -aajot; -aajou; -aajov; -aajow; -aajox; -aajoy; -aajoz; -aajpa; -aajpb; -aajpc; -aajpd; -aajpe; -aajpf; -aajpg; -aajph; -aajpi; -aajpj; -aajpk; -aajpl; -aajpm; -aajpn; -aajpo; -aajpp; -aajpq; -aajpr; -aajps; -aajpt; -aajpu; -aajpv; -aajpw; -aajpx; -aajpy; -aajpz; -aajqa; -aajqb; -aajqc; -aajqd; -aajqe; -aajqf; -aajqg; -aajqh; -aajqi; -aajqj; -aajqk; -aajql; -aajqm; -aajqn; -aajqo; -aajqp; -aajqq; -aajqr; -aajqs; -aajqt; -aajqu; -aajqv; -aajqw; -aajqx; -aajqy; -aajqz; -aajra; -aajrb; -aajrc; -aajrd; -aajre; -aajrf; -aajrg; -aajrh; -aajri; -aajrj; -aajrk; -aajrl; -aajrm; -aajrn; -aajro; -aajrp; -aajrq; -aajrr; -aajrs; -aajrt; -aajru; -aajrv; -aajrw; -aajrx; -aajry; -aajrz; -aajsa; -aajsb; -aajsc; -aajsd; -aajse; -aajsf; -aajsg; -aajsh; -aajsi; -aajsj; -aajsk; -aajsl; -aajsm; -aajsn; -aajso; -aajsp; -aajsq; -aajsr; -aajss; -aajst; -aajsu; -aajsv; -aajsw; -aajsx; -aajsy; -aajsz; -aajta; -aajtb; -aajtc; -aajtd; -aajte; -aajtf; -aajtg; -aajth; -aajti; -aajtj; -aajtk; -aajtl; -aajtm; -aajtn; -aajto; -aajtp; -aajtq; -aajtr; -aajts; -aajtt; -aajtu; -aajtv; -aajtw; -aajtx; -aajty; -aajtz; -aajua; -aajub; -aajuc; -aajud; -aajue; -aajuf; -aajug; -aajuh; -aajui; -aajuj; -aajuk; -aajul; -aajum; -aajun; -aajuo; -aajup; -aajuq; -aajur; -aajus; -aajut; -aajuu; -aajuv; -aajuw; -aajux; -aajuy; -aajuz; -aajva; -aajvb; -aajvc; -aajvd; -aajve; -aajvf; -aajvg; -aajvh; -aajvi; -aajvj; -aajvk; -aajvl; -aajvm; -aajvn; -aajvo; -aajvp; -aajvq; -aajvr; -aajvs; -aajvt; -aajvu; -aajvv; -aajvw; -aajvx; -aajvy; -aajvz; -aajwa; -aajwb; -aajwc; -aajwd; -aajwe; -aajwf; -aajwg; -aajwh; -aajwi; -aajwj; -aajwk; -aajwl; -aajwm; -aajwn; -aajwo; -aajwp; -aajwq; -aajwr; -aajws; -aajwt; -aajwu; -aajwv; -aajww; -aajwx; -aajwy; -aajwz; -aajxa; -aajxb; -aajxc; -aajxd; -aajxe; -aajxf; -aajxg; -aajxh; -aajxi; -aajxj; -aajxk; -aajxl; -aajxm; -aajxn; -aajxo; -aajxp; -aajxq; -aajxr; -aajxs; -aajxt; -aajxu; -aajxv; -aajxw; -aajxx; -aajxy; -aajxz; -aajya; -aajyb; -aajyc; -aajyd; -aajye; -aajyf; -aajyg; -aajyh; -aajyi; -aajyj; -aajyk; -aajyl; -aajym; -aajyn; -aajyo; -aajyp; -aajyq; -aajyr; -aajys; -aajyt; -aajyu; -aajyv; -aajyw; -aajyx; -aajyy; -aajyz; -aajza; -aajzb; -aajzc; -aajzd; -aajze; -aajzf; -aajzg; -aajzh; -aajzi; -aajzj; -aajzk; -aajzl; -aajzm; -aajzn; -aajzo; -aajzp; -aajzq; -aajzr; -aajzs; -aajzt; -aajzu; -aajzv; -aajzw; -aajzx; -aajzy; -aajzz; -aakaa; -aakab; -aakac; -aakad; -aakae; -aakaf; -aakag; -aakah; -aakai; -aakaj; -aakak; -aakal; -aakam; -aakan; -aakao; -aakap; -aakaq; -aakar; -aakas; -aakat; -aakau; -aakav; -aakaw; -aakax; -aakay; -aakaz; -aakba; -aakbb; -aakbc; -aakbd; -aakbe; -aakbf; -aakbg; -aakbh; -aakbi; -aakbj; -aakbk; -aakbl; -aakbm; -aakbn; -aakbo; -aakbp; -aakbq; -aakbr; -aakbs; -aakbt; -aakbu; -aakbv; -aakbw; -aakbx; -aakby; -aakbz; -aakca; -aakcb; -aakcc; -aakcd; -aakce; -aakcf; -aakcg; -aakch; -aakci; -aakcj; -aakck; -aakcl; -aakcm; -aakcn; -aakco; -aakcp; -aakcq; -aakcr; -aakcs; -aakct; -aakcu; -aakcv; -aakcw; -aakcx; -aakcy; -aakcz; -aakda; -aakdb; -aakdc; -aakdd; -aakde; -aakdf; -aakdg; -aakdh; -aakdi; -aakdj; -aakdk; -aakdl; -aakdm; -aakdn; -aakdo; -aakdp; -aakdq; -aakdr; -aakds; -aakdt; -aakdu; -aakdv; -aakdw; -aakdx; -aakdy; -aakdz; -aakea; -aakeb; -aakec; -aaked; -aakee; -aakef; -aakeg; -aakeh; -aakei; -aakej; -aakek; -aakel; -aakem; -aaken; -aakeo; -aakep; -aakeq; -aaker; -aakes; -aaket; -aakeu; -aakev; -aakew; -aakex; -aakey; -aakez; -aakfa; -aakfb; -aakfc; -aakfd; -aakfe; -aakff; -aakfg; -aakfh; -aakfi; -aakfj; -aakfk; -aakfl; -aakfm; -aakfn; -aakfo; -aakfp; -aakfq; -aakfr; -aakfs; -aakft; -aakfu; -aakfv; -aakfw; -aakfx; -aakfy; -aakfz; -aakga; -aakgb; -aakgc; -aakgd; -aakge; -aakgf; -aakgg; -aakgh; -aakgi; -aakgj; -aakgk; -aakgl; -aakgm; -aakgn; -aakgo; -aakgp; -aakgq; -aakgr; -aakgs; -aakgt; -aakgu; -aakgv; -aakgw; -aakgx; -aakgy; -aakgz; -aakha; -aakhb; -aakhc; -aakhd; -aakhe; -aakhf; -aakhg; -aakhh; -aakhi; -aakhj; -aakhk; -aakhl; -aakhm; -aakhn; -aakho; -aakhp; -aakhq; -aakhr; -aakhs; -aakht; -aakhu; -aakhv; -aakhw; -aakhx; -aakhy; -aakhz; -aakia; -aakib; -aakic; -aakid; -aakie; -aakif; -aakig; -aakih; -aakii; -aakij; -aakik; -aakil; -aakim; -aakin; -aakio; -aakip; -aakiq; -aakir; -aakis; -aakit; -aakiu; -aakiv; -aakiw; -aakix; -aakiy; -aakiz; -aakja; -aakjb; -aakjc; -aakjd; -aakje; -aakjf; -aakjg; -aakjh; -aakji; -aakjj; -aakjk; -aakjl; -aakjm; -aakjn; -aakjo; -aakjp; -aakjq; -aakjr; -aakjs; -aakjt; -aakju; -aakjv; -aakjw; -aakjx; -aakjy; -aakjz; -aakka; -aakkb; -aakkc; -aakkd; -aakke; -aakkf; -aakkg; -aakkh; -aakki; -aakkj; -aakkk; -aakkl; -aakkm; -aakkn; -aakko; -aakkp; -aakkq; -aakkr; -aakks; -aakkt; -aakku; -aakkv; -aakkw; -aakkx; -aakky; -aakkz; -aakla; -aaklb; -aaklc; -aakld; -aakle; -aaklf; -aaklg; -aaklh; -aakli; -aaklj; -aaklk; -aakll; -aaklm; -aakln; -aaklo; -aaklp; -aaklq; -aaklr; -aakls; -aaklt; -aaklu; -aaklv; -aaklw; -aaklx; -aakly; -aaklz; -aakma; -aakmb; -aakmc; -aakmd; -aakme; -aakmf; -aakmg; -aakmh; -aakmi; -aakmj; -aakmk; -aakml; -aakmm; -aakmn; -aakmo; -aakmp; -aakmq; -aakmr; -aakms; -aakmt; -aakmu; -aakmv; -aakmw; -aakmx; -aakmy; -aakmz; -aakna; -aaknb; -aaknc; -aaknd; -aakne; -aaknf; -aakng; -aaknh; -aakni; -aaknj; -aaknk; -aaknl; -aaknm; -aaknn; -aakno; -aaknp; -aaknq; -aaknr; -aakns; -aaknt; -aaknu; -aaknv; -aaknw; -aaknx; -aakny; -aaknz; -aakoa; -aakob; -aakoc; -aakod; -aakoe; -aakof; -aakog; -aakoh; -aakoi; -aakoj; -aakok; -aakol; -aakom; -aakon; -aakoo; -aakop; -aakoq; -aakor; -aakos; -aakot; -aakou; -aakov; -aakow; -aakox; -aakoy; -aakoz; -aakpa; -aakpb; -aakpc; -aakpd; -aakpe; -aakpf; -aakpg; -aakph; -aakpi; -aakpj; -aakpk; -aakpl; -aakpm; -aakpn; -aakpo; -aakpp; -aakpq; -aakpr; -aakps; -aakpt; -aakpu; -aakpv; -aakpw; -aakpx; -aakpy; -aakpz; -aakqa; -aakqb; -aakqc; -aakqd; -aakqe; -aakqf; -aakqg; -aakqh; -aakqi; -aakqj; -aakqk; -aakql; -aakqm; -aakqn; -aakqo; -aakqp; -aakqq; -aakqr; -aakqs; -aakqt; -aakqu; -aakqv; -aakqw; -aakqx; -aakqy; -aakqz; -aakra; -aakrb; -aakrc; -aakrd; -aakre; -aakrf; -aakrg; -aakrh; -aakri; -aakrj; -aakrk; -aakrl; -aakrm; -aakrn; -aakro; -aakrp; -aakrq; -aakrr; -aakrs; -aakrt; -aakru; -aakrv; -aakrw; -aakrx; -aakry; -aakrz; -aaksa; -aaksb; -aaksc; -aaksd; -aakse; -aaksf; -aaksg; -aaksh; -aaksi; -aaksj; -aaksk; -aaksl; -aaksm; -aaksn; -aakso; -aaksp; -aaksq; -aaksr; -aakss; -aakst; -aaksu; -aaksv; -aaksw; -aaksx; -aaksy; -aaksz; -aakta; -aaktb; -aaktc; -aaktd; -aakte; -aaktf; -aaktg; -aakth; -aakti; -aaktj; -aaktk; -aaktl; -aaktm; -aaktn; -aakto; -aaktp; -aaktq; -aaktr; -aakts; -aaktt; -aaktu; -aaktv; -aaktw; -aaktx; -aakty; -aaktz; -aakua; -aakub; -aakuc; -aakud; -aakue; -aakuf; -aakug; -aakuh; -aakui; -aakuj; -aakuk; -aakul; -aakum; -aakun; -aakuo; -aakup; -aakuq; -aakur; -aakus; -aakut; -aakuu; -aakuv; -aakuw; -aakux; -aakuy; -aakuz; -aakva; -aakvb; -aakvc; -aakvd; -aakve; -aakvf; -aakvg; -aakvh; -aakvi; -aakvj; -aakvk; -aakvl; -aakvm; -aakvn; -aakvo; -aakvp; -aakvq; -aakvr; -aakvs; -aakvt; -aakvu; -aakvv; -aakvw; -aakvx; -aakvy; -aakvz; -aakwa; -aakwb; -aakwc; -aakwd; -aakwe; -aakwf; -aakwg; -aakwh; -aakwi; -aakwj; -aakwk; -aakwl; -aakwm; -aakwn; -aakwo; -aakwp; -aakwq; -aakwr; -aakws; -aakwt; -aakwu; -aakwv; -aakww; -aakwx; -aakwy; -aakwz; -aakxa; -aakxb; -aakxc; -aakxd; -aakxe; -aakxf; -aakxg; -aakxh; -aakxi; -aakxj; -aakxk; -aakxl; -aakxm; -aakxn; -aakxo; -aakxp; -aakxq; -aakxr; -aakxs; -aakxt; -aakxu; -aakxv; -aakxw; -aakxx; -aakxy; -aakxz; -aakya; -aakyb; -aakyc; -aakyd; -aakye; -aakyf; -aakyg; -aakyh; -aakyi; -aakyj; -aakyk; -aakyl; -aakym; -aakyn; -aakyo; -aakyp; -aakyq; -aakyr; -aakys; -aakyt; -aakyu; -aakyv; -aakyw; -aakyx; -aakyy; -aakyz; -aakza; -aakzb; -aakzc; -aakzd; -aakze; -aakzf; -aakzg; -aakzh; -aakzi; -aakzj; -aakzk; -aakzl; -aakzm; -aakzn; -aakzo; -aakzp; -aakzq; -aakzr; -aakzs; -aakzt; -aakzu; -aakzv; -aakzw; -aakzx; -aakzy; -aakzz; -aalaa; -aalab; -aalac; -aalad; -aalae; -aalaf; -aalag; -aalah; -aalai; -aalaj; -aalak; -aalal; -aalam; -aalan; -aalao; -aalap; -aalaq; -aalar; -aalas; -aalat; -aalau; -aalav; -aalaw; -aalax; -aalay; -aalaz; -aalba; -aalbb; -aalbc; -aalbd; -aalbe; -aalbf; -aalbg; -aalbh; -aalbi; -aalbj; -aalbk; -aalbl; -aalbm; -aalbn; -aalbo; -aalbp; -aalbq; -aalbr; -aalbs; -aalbt; -aalbu; -aalbv; -aalbw; -aalbx; -aalby; -aalbz; -aalca; -aalcb; -aalcc; -aalcd; -aalce; -aalcf; -aalcg; -aalch; -aalci; -aalcj; -aalck; -aalcl; -aalcm; -aalcn; -aalco; -aalcp; -aalcq; -aalcr; -aalcs; -aalct; -aalcu; -aalcv; -aalcw; -aalcx; -aalcy; -aalcz; -aalda; -aaldb; -aaldc; -aaldd; -aalde; -aaldf; -aaldg; -aaldh; -aaldi; -aaldj; -aaldk; -aaldl; -aaldm; -aaldn; -aaldo; -aaldp; -aaldq; -aaldr; -aalds; -aaldt; -aaldu; -aaldv; -aaldw; -aaldx; -aaldy; -aaldz; -aalea; -aaleb; -aalec; -aaled; -aalee; -aalef; -aaleg; -aaleh; -aalei; -aalej; -aalek; -aalel; -aalem; -aalen; -aaleo; -aalep; -aaleq; -aaler; -aales; -aalet; -aaleu; -aalev; -aalew; -aalex; -aaley; -aalez; -aalfa; -aalfb; -aalfc; -aalfd; -aalfe; -aalff; -aalfg; -aalfh; -aalfi; -aalfj; -aalfk; -aalfl; -aalfm; -aalfn; -aalfo; -aalfp; -aalfq; -aalfr; -aalfs; -aalft; -aalfu; -aalfv; -aalfw; -aalfx; -aalfy; -aalfz; -aalga; -aalgb; -aalgc; -aalgd; -aalge; -aalgf; -aalgg; -aalgh; -aalgi; -aalgj; -aalgk; -aalgl; -aalgm; -aalgn; -aalgo; -aalgp; -aalgq; -aalgr; -aalgs; -aalgt; -aalgu; -aalgv; -aalgw; -aalgx; -aalgy; -aalgz; -aalha; -aalhb; -aalhc; -aalhd; -aalhe; -aalhf; -aalhg; -aalhh; -aalhi; -aalhj; -aalhk; -aalhl; -aalhm; -aalhn; -aalho; -aalhp; -aalhq; -aalhr; -aalhs; -aalht; -aalhu; -aalhv; -aalhw; -aalhx; -aalhy; -aalhz; -aalia; -aalib; -aalic; -aalid; -aalie; -aalif; -aalig; -aalih; -aalii; -aalij; -aalik; -aalil; -aalim; -aalin; -aalio; -aalip; -aaliq; -aalir; -aalis; -aalit; -aaliu; -aaliv; -aaliw; -aalix; -aaliy; -aaliz; -aalja; -aaljb; -aaljc; -aaljd; -aalje; -aaljf; -aaljg; -aaljh; -aalji; -aaljj; -aaljk; -aaljl; -aaljm; -aaljn; -aaljo; -aaljp; -aaljq; -aaljr; -aaljs; -aaljt; -aalju; -aaljv; -aaljw; -aaljx; -aaljy; -aaljz; -aalka; -aalkb; -aalkc; -aalkd; -aalke; -aalkf; -aalkg; -aalkh; -aalki; -aalkj; -aalkk; -aalkl; -aalkm; -aalkn; -aalko; -aalkp; -aalkq; -aalkr; -aalks; -aalkt; -aalku; -aalkv; -aalkw; -aalkx; -aalky; -aalkz; -aalla; -aallb; -aallc; -aalld; -aalle; -aallf; -aallg; -aallh; -aalli; -aallj; -aallk; -aalll; -aallm; -aalln; -aallo; -aallp; -aallq; -aallr; -aalls; -aallt; -aallu; -aallv; -aallw; -aallx; -aally; -aallz; -aalma; -aalmb; -aalmc; -aalmd; -aalme; -aalmf; -aalmg; -aalmh; -aalmi; -aalmj; -aalmk; -aalml; -aalmm; -aalmn; -aalmo; -aalmp; -aalmq; -aalmr; -aalms; -aalmt; -aalmu; -aalmv; -aalmw; -aalmx; -aalmy; -aalmz; -aalna; -aalnb; -aalnc; -aalnd; -aalne; -aalnf; -aalng; -aalnh; -aalni; -aalnj; -aalnk; -aalnl; -aalnm; -aalnn; -aalno; -aalnp; -aalnq; -aalnr; -aalns; -aalnt; -aalnu; -aalnv; -aalnw; -aalnx; -aalny; -aalnz; -aaloa; -aalob; -aaloc; -aalod; -aaloe; -aalof; -aalog; -aaloh; -aaloi; -aaloj; -aalok; -aalol; -aalom; -aalon; -aaloo; -aalop; -aaloq; -aalor; -aalos; -aalot; -aalou; -aalov; -aalow; -aalox; -aaloy; -aaloz; -aalpa; -aalpb; -aalpc; -aalpd; -aalpe; -aalpf; -aalpg; -aalph; -aalpi; -aalpj; -aalpk; -aalpl; -aalpm; -aalpn; -aalpo; -aalpp; -aalpq; -aalpr; -aalps; -aalpt; -aalpu; -aalpv; -aalpw; -aalpx; -aalpy; -aalpz; -aalqa; -aalqb; -aalqc; -aalqd; -aalqe; -aalqf; -aalqg; -aalqh; -aalqi; -aalqj; -aalqk; -aalql; -aalqm; -aalqn; -aalqo; -aalqp; -aalqq; -aalqr; -aalqs; -aalqt; -aalqu; -aalqv; -aalqw; -aalqx; -aalqy; -aalqz; -aalra; -aalrb; -aalrc; -aalrd; -aalre; -aalrf; -aalrg; -aalrh; -aalri; -aalrj; -aalrk; -aalrl; -aalrm; -aalrn; -aalro; -aalrp; -aalrq; -aalrr; -aalrs; -aalrt; -aalru; -aalrv; -aalrw; -aalrx; -aalry; -aalrz; -aalsa; -aalsb; -aalsc; -aalsd; -aalse; -aalsf; -aalsg; -aalsh; -aalsi; -aalsj; -aalsk; -aalsl; -aalsm; -aalsn; -aalso; -aalsp; -aalsq; -aalsr; -aalss; -aalst; -aalsu; -aalsv; -aalsw; -aalsx; -aalsy; -aalsz; -aalta; -aaltb; -aaltc; -aaltd; -aalte; -aaltf; -aaltg; -aalth; -aalti; -aaltj; -aaltk; -aaltl; -aaltm; -aaltn; -aalto; -aaltp; -aaltq; -aaltr; -aalts; -aaltt; -aaltu; -aaltv; -aaltw; -aaltx; -aalty; -aaltz; -aalua; -aalub; -aaluc; -aalud; -aalue; -aaluf; -aalug; -aaluh; -aalui; -aaluj; -aaluk; -aalul; -aalum; -aalun; -aaluo; -aalup; -aaluq; -aalur; -aalus; -aalut; -aaluu; -aaluv; -aaluw; -aalux; -aaluy; -aaluz; -aalva; -aalvb; -aalvc; -aalvd; -aalve; -aalvf; -aalvg; -aalvh; -aalvi; -aalvj; -aalvk; -aalvl; -aalvm; -aalvn; -aalvo; -aalvp; -aalvq; -aalvr; -aalvs; -aalvt; -aalvu; -aalvv; -aalvw; -aalvx; -aalvy; -aalvz; -aalwa; -aalwb; -aalwc; -aalwd; -aalwe; -aalwf; -aalwg; -aalwh; -aalwi; -aalwj; -aalwk; -aalwl; -aalwm; -aalwn; -aalwo; -aalwp; -aalwq; -aalwr; -aalws; -aalwt; -aalwu; -aalwv; -aalww; -aalwx; -aalwy; -aalwz; -aalxa; -aalxb; -aalxc; -aalxd; -aalxe; -aalxf; -aalxg; -aalxh; -aalxi; -aalxj; -aalxk; -aalxl; -aalxm; -aalxn; -aalxo; -aalxp; -aalxq; -aalxr; -aalxs; -aalxt; -aalxu; -aalxv; -aalxw; -aalxx; -aalxy; -aalxz; -aalya; -aalyb; -aalyc; -aalyd; -aalye; -aalyf; -aalyg; -aalyh; -aalyi; -aalyj; -aalyk; -aalyl; -aalym; -aalyn; -aalyo; -aalyp; -aalyq; -aalyr; -aalys; -aalyt; -aalyu; -aalyv; -aalyw; -aalyx; -aalyy; -aalyz; -aalza; -aalzb; -aalzc; -aalzd; -aalze; -aalzf; -aalzg; -aalzh; -aalzi; -aalzj; -aalzk; -aalzl; -aalzm; -aalzn; -aalzo; -aalzp; -aalzq; -aalzr; -aalzs; -aalzt; -aalzu; -aalzv; -aalzw; -aalzx; -aalzy; -aalzz; -aamaa; -aamab; -aamac; -aamad; -aamae; -aamaf; -aamag; -aamah; -aamai; -aamaj; -aamak; -aamal; -aamam; -aaman; -aamao; -aamap; -aamaq; -aamar; -aamas; -aamat; -aamau; -aamav; -aamaw; -aamax; -aamay; -aamaz; -aamba; -aambb; -aambc; -aambd; -aambe; -aambf; -aambg; -aambh; -aambi; -aambj; -aambk; -aambl; -aambm; -aambn; -aambo; -aambp; -aambq; -aambr; -aambs; -aambt; -aambu; -aambv; -aambw; -aambx; -aamby; -aambz; -aamca; -aamcb; -aamcc; -aamcd; -aamce; -aamcf; -aamcg; -aamch; -aamci; -aamcj; -aamck; -aamcl; -aamcm; -aamcn; -aamco; -aamcp; -aamcq; -aamcr; -aamcs; -aamct; -aamcu; -aamcv; -aamcw; -aamcx; -aamcy; -aamcz; -aamda; -aamdb; -aamdc; -aamdd; -aamde; -aamdf; -aamdg; -aamdh; -aamdi; -aamdj; -aamdk; -aamdl; -aamdm; -aamdn; -aamdo; -aamdp; -aamdq; -aamdr; -aamds; -aamdt; -aamdu; -aamdv; -aamdw; -aamdx; -aamdy; -aamdz; -aamea; -aameb; -aamec; -aamed; -aamee; -aamef; -aameg; -aameh; -aamei; -aamej; -aamek; -aamel; -aamem; -aamen; -aameo; -aamep; -aameq; -aamer; -aames; -aamet; -aameu; -aamev; -aamew; -aamex; -aamey; -aamez; -aamfa; -aamfb; -aamfc; -aamfd; -aamfe; -aamff; -aamfg; -aamfh; -aamfi; -aamfj; -aamfk; -aamfl; -aamfm; -aamfn; -aamfo; -aamfp; -aamfq; -aamfr; -aamfs; -aamft; -aamfu; -aamfv; -aamfw; -aamfx; -aamfy; -aamfz; -aamga; -aamgb; -aamgc; -aamgd; -aamge; -aamgf; -aamgg; -aamgh; -aamgi; -aamgj; -aamgk; -aamgl; -aamgm; -aamgn; -aamgo; -aamgp; -aamgq; -aamgr; -aamgs; -aamgt; -aamgu; -aamgv; -aamgw; -aamgx; -aamgy; -aamgz; -aamha; -aamhb; -aamhc; -aamhd; -aamhe; -aamhf; -aamhg; -aamhh; -aamhi; -aamhj; -aamhk; -aamhl; -aamhm; -aamhn; -aamho; -aamhp; -aamhq; -aamhr; -aamhs; -aamht; -aamhu; -aamhv; -aamhw; -aamhx; -aamhy; -aamhz; -aamia; -aamib; -aamic; -aamid; -aamie; -aamif; -aamig; -aamih; -aamii; -aamij; -aamik; -aamil; -aamim; -aamin; -aamio; -aamip; -aamiq; -aamir; -aamis; -aamit; -aamiu; -aamiv; -aamiw; -aamix; -aamiy; -aamiz; -aamja; -aamjb; -aamjc; -aamjd; -aamje; -aamjf; -aamjg; -aamjh; -aamji; -aamjj; -aamjk; -aamjl; -aamjm; -aamjn; -aamjo; -aamjp; -aamjq; -aamjr; -aamjs; -aamjt; -aamju; -aamjv; -aamjw; -aamjx; -aamjy; -aamjz; -aamka; -aamkb; -aamkc; -aamkd; -aamke; -aamkf; -aamkg; -aamkh; -aamki; -aamkj; -aamkk; -aamkl; -aamkm; -aamkn; -aamko; -aamkp; -aamkq; -aamkr; -aamks; -aamkt; -aamku; -aamkv; -aamkw; -aamkx; -aamky; -aamkz; -aamla; -aamlb; -aamlc; -aamld; -aamle; -aamlf; -aamlg; -aamlh; -aamli; -aamlj; -aamlk; -aamll; -aamlm; -aamln; -aamlo; -aamlp; -aamlq; -aamlr; -aamls; -aamlt; -aamlu; -aamlv; -aamlw; -aamlx; -aamly; -aamlz; -aamma; -aammb; -aammc; -aammd; -aamme; -aammf; -aammg; -aammh; -aammi; -aammj; -aammk; -aamml; -aammm; -aammn; -aammo; -aammp; -aammq; -aammr; -aamms; -aammt; -aammu; -aammv; -aammw; -aammx; -aammy; -aammz; -aamna; -aamnb; -aamnc; -aamnd; -aamne; -aamnf; -aamng; -aamnh; -aamni; -aamnj; -aamnk; -aamnl; -aamnm; -aamnn; -aamno; -aamnp; -aamnq; -aamnr; -aamns; -aamnt; -aamnu; -aamnv; -aamnw; -aamnx; -aamny; -aamnz; -aamoa; -aamob; -aamoc; -aamod; -aamoe; -aamof; -aamog; -aamoh; -aamoi; -aamoj; -aamok; -aamol; -aamom; -aamon; -aamoo; -aamop; -aamoq; -aamor; -aamos; -aamot; -aamou; -aamov; -aamow; -aamox; -aamoy; -aamoz; -aampa; -aampb; -aampc; -aampd; -aampe; -aampf; -aampg; -aamph; -aampi; -aampj; -aampk; -aampl; -aampm; -aampn; -aampo; -aampp; -aampq; -aampr; -aamps; -aampt; -aampu; -aampv; -aampw; -aampx; -aampy; -aampz; -aamqa; -aamqb; -aamqc; -aamqd; -aamqe; -aamqf; -aamqg; -aamqh; -aamqi; -aamqj; -aamqk; -aamql; -aamqm; -aamqn; -aamqo; -aamqp; -aamqq; -aamqr; -aamqs; -aamqt; -aamqu; -aamqv; -aamqw; -aamqx; -aamqy; -aamqz; -aamra; -aamrb; -aamrc; -aamrd; -aamre; -aamrf; -aamrg; -aamrh; -aamri; -aamrj; -aamrk; -aamrl; -aamrm; -aamrn; -aamro; -aamrp; -aamrq; -aamrr; -aamrs; -aamrt; -aamru; -aamrv; -aamrw; -aamrx; -aamry; -aamrz; -aamsa; -aamsb; -aamsc; -aamsd; -aamse; -aamsf; -aamsg; -aamsh; -aamsi; -aamsj; -aamsk; -aamsl; -aamsm; -aamsn; -aamso; -aamsp; -aamsq; -aamsr; -aamss; -aamst; -aamsu; -aamsv; -aamsw; -aamsx; -aamsy; -aamsz; -aamta; -aamtb; -aamtc; -aamtd; -aamte; -aamtf; -aamtg; -aamth; -aamti; -aamtj; -aamtk; -aamtl; -aamtm; -aamtn; -aamto; -aamtp; -aamtq; -aamtr; -aamts; -aamtt; -aamtu; -aamtv; -aamtw; -aamtx; -aamty; -aamtz; -aamua; -aamub; -aamuc; -aamud; -aamue; -aamuf; -aamug; -aamuh; -aamui; -aamuj; -aamuk; -aamul; -aamum; -aamun; -aamuo; -aamup; -aamuq; -aamur; -aamus; -aamut; -aamuu; -aamuv; -aamuw; -aamux; -aamuy; -aamuz; -aamva; -aamvb; -aamvc; -aamvd; -aamve; -aamvf; -aamvg; -aamvh; -aamvi; -aamvj; -aamvk; -aamvl; -aamvm; -aamvn; -aamvo; -aamvp; -aamvq; -aamvr; -aamvs; -aamvt; -aamvu; -aamvv; -aamvw; -aamvx; -aamvy; -aamvz; -aamwa; -aamwb; -aamwc; -aamwd; -aamwe; -aamwf; -aamwg; -aamwh; -aamwi; -aamwj; -aamwk; -aamwl; -aamwm; -aamwn; -aamwo; -aamwp; -aamwq; -aamwr; -aamws; -aamwt; -aamwu; -aamwv; -aamww; -aamwx; -aamwy; -aamwz; -aamxa; -aamxb; -aamxc; -aamxd; -aamxe; -aamxf; -aamxg; -aamxh; -aamxi; -aamxj; -aamxk; -aamxl; -aamxm; -aamxn; -aamxo; -aamxp; -aamxq; -aamxr; -aamxs; -aamxt; -aamxu; -aamxv; -aamxw; -aamxx; -aamxy; -aamxz; -aamya; -aamyb; -aamyc; -aamyd; -aamye; -aamyf; -aamyg; -aamyh; -aamyi; -aamyj; -aamyk; -aamyl; -aamym; -aamyn; -aamyo; -aamyp; -aamyq; -aamyr; -aamys; -aamyt; -aamyu; -aamyv; -aamyw; -aamyx; -aamyy; -aamyz; -aamza; -aamzb; -aamzc; -aamzd; -aamze; -aamzf; -aamzg; -aamzh; -aamzi; -aamzj; -aamzk; -aamzl; -aamzm; -aamzn; -aamzo; -aamzp; -aamzq; -aamzr; -aamzs; -aamzt; -aamzu; -aamzv; -aamzw; -aamzx; -aamzy; -aamzz; -aanaa; -aanab; -aanac; -aanad; -aanae; -aanaf; -aanag; -aanah; -aanai; -aanaj; -aanak; -aanal; -aanam; -aanan; -aanao; -aanap; -aanaq; -aanar; -aanas; -aanat; -aanau; -aanav; -aanaw; -aanax; -aanay; -aanaz; -aanba; -aanbb; -aanbc; -aanbd; -aanbe; -aanbf; -aanbg; -aanbh; -aanbi; -aanbj; -aanbk; -aanbl; -aanbm; -aanbn; -aanbo; -aanbp; -aanbq; -aanbr; -aanbs; -aanbt; -aanbu; -aanbv; -aanbw; -aanbx; -aanby; -aanbz; -aanca; -aancb; -aancc; -aancd; -aance; -aancf; -aancg; -aanch; -aanci; -aancj; -aanck; -aancl; -aancm; -aancn; -aanco; -aancp; -aancq; -aancr; -aancs; -aanct; -aancu; -aancv; -aancw; -aancx; -aancy; -aancz; -aanda; -aandb; -aandc; -aandd; -aande; -aandf; -aandg; -aandh; -aandi; -aandj; -aandk; -aandl; -aandm; -aandn; -aando; -aandp; -aandq; -aandr; -aands; -aandt; -aandu; -aandv; -aandw; -aandx; -aandy; -aandz; -aanea; -aaneb; -aanec; -aaned; -aanee; -aanef; -aaneg; -aaneh; -aanei; -aanej; -aanek; -aanel; -aanem; -aanen; -aaneo; -aanep; -aaneq; -aaner; -aanes; -aanet; -aaneu; -aanev; -aanew; -aanex; -aaney; -aanez; -aanfa; -aanfb; -aanfc; -aanfd; -aanfe; -aanff; -aanfg; -aanfh; -aanfi; -aanfj; -aanfk; -aanfl; -aanfm; -aanfn; -aanfo; -aanfp; -aanfq; -aanfr; -aanfs; -aanft; -aanfu; -aanfv; -aanfw; -aanfx; -aanfy; -aanfz; -aanga; -aangb; -aangc; -aangd; -aange; -aangf; -aangg; -aangh; -aangi; -aangj; -aangk; -aangl; -aangm; -aangn; -aango; -aangp; -aangq; -aangr; -aangs; -aangt; -aangu; -aangv; -aangw; -aangx; -aangy; -aangz; -aanha; -aanhb; -aanhc; -aanhd; -aanhe; -aanhf; -aanhg; -aanhh; -aanhi; -aanhj; -aanhk; -aanhl; -aanhm; -aanhn; -aanho; -aanhp; -aanhq; -aanhr; -aanhs; -aanht; -aanhu; -aanhv; -aanhw; -aanhx; -aanhy; -aanhz; -aania; -aanib; -aanic; -aanid; -aanie; -aanif; -aanig; -aanih; -aanii; -aanij; -aanik; -aanil; -aanim; -aanin; -aanio; -aanip; -aaniq; -aanir; -aanis; -aanit; -aaniu; -aaniv; -aaniw; -aanix; -aaniy; -aaniz; -aanja; -aanjb; -aanjc; -aanjd; -aanje; -aanjf; -aanjg; -aanjh; -aanji; -aanjj; -aanjk; -aanjl; -aanjm; -aanjn; -aanjo; -aanjp; -aanjq; -aanjr; -aanjs; -aanjt; -aanju; -aanjv; -aanjw; -aanjx; -aanjy; -aanjz; -aanka; -aankb; -aankc; -aankd; -aanke; -aankf; -aankg; -aankh; -aanki; -aankj; -aankk; -aankl; -aankm; -aankn; -aanko; -aankp; -aankq; -aankr; -aanks; -aankt; -aanku; -aankv; -aankw; -aankx; -aanky; -aankz; -aanla; -aanlb; -aanlc; -aanld; -aanle; -aanlf; -aanlg; -aanlh; -aanli; -aanlj; -aanlk; -aanll; -aanlm; -aanln; -aanlo; -aanlp; -aanlq; -aanlr; -aanls; -aanlt; -aanlu; -aanlv; -aanlw; -aanlx; -aanly; -aanlz; -aanma; -aanmb; -aanmc; -aanmd; -aanme; -aanmf; -aanmg; -aanmh; -aanmi; -aanmj; -aanmk; -aanml; -aanmm; -aanmn; -aanmo; -aanmp; -aanmq; -aanmr; -aanms; -aanmt; -aanmu; -aanmv; -aanmw; -aanmx; -aanmy; -aanmz; -aanna; -aannb; -aannc; -aannd; -aanne; -aannf; -aanng; -aannh; -aanni; -aannj; -aannk; -aannl; -aannm; -aannn; -aanno; -aannp; -aannq; -aannr; -aanns; -aannt; -aannu; -aannv; -aannw; -aannx; -aanny; -aannz; -aanoa; -aanob; -aanoc; -aanod; -aanoe; -aanof; -aanog; -aanoh; -aanoi; -aanoj; -aanok; -aanol; -aanom; -aanon; -aanoo; -aanop; -aanoq; -aanor; -aanos; -aanot; -aanou; -aanov; -aanow; -aanox; -aanoy; -aanoz; -aanpa; -aanpb; -aanpc; -aanpd; -aanpe; -aanpf; -aanpg; -aanph; -aanpi; -aanpj; -aanpk; -aanpl; -aanpm; -aanpn; -aanpo; -aanpp; -aanpq; -aanpr; -aanps; -aanpt; -aanpu; -aanpv; -aanpw; -aanpx; -aanpy; -aanpz; -aanqa; -aanqb; -aanqc; -aanqd; -aanqe; -aanqf; -aanqg; -aanqh; -aanqi; -aanqj; -aanqk; -aanql; -aanqm; -aanqn; -aanqo; -aanqp; -aanqq; -aanqr; -aanqs; -aanqt; -aanqu; -aanqv; -aanqw; -aanqx; -aanqy; -aanqz; -aanra; -aanrb; -aanrc; -aanrd; -aanre; -aanrf; -aanrg; -aanrh; -aanri; -aanrj; -aanrk; -aanrl; -aanrm; -aanrn; -aanro; -aanrp; -aanrq; -aanrr; -aanrs; -aanrt; -aanru; -aanrv; -aanrw; -aanrx; -aanry; -aanrz; -aansa; -aansb; -aansc; -aansd; -aanse; -aansf; -aansg; -aansh; -aansi; -aansj; -aansk; -aansl; -aansm; -aansn; -aanso; -aansp; -aansq; -aansr; -aanss; -aanst; -aansu; -aansv; -aansw; -aansx; -aansy; -aansz; -aanta; -aantb; -aantc; -aantd; -aante; -aantf; -aantg; -aanth; -aanti; -aantj; -aantk; -aantl; -aantm; -aantn; -aanto; -aantp; -aantq; -aantr; -aants; -aantt; -aantu; -aantv; -aantw; -aantx; -aanty; -aantz; -aanua; -aanub; -aanuc; -aanud; -aanue; -aanuf; -aanug; -aanuh; -aanui; -aanuj; -aanuk; -aanul; -aanum; -aanun; -aanuo; -aanup; -aanuq; -aanur; -aanus; -aanut; -aanuu; -aanuv; -aanuw; -aanux; -aanuy; -aanuz; -aanva; -aanvb; -aanvc; -aanvd; -aanve; -aanvf; -aanvg; -aanvh; -aanvi; -aanvj; -aanvk; -aanvl; -aanvm; -aanvn; -aanvo; -aanvp; -aanvq; -aanvr; -aanvs; -aanvt; -aanvu; -aanvv; -aanvw; -aanvx; -aanvy; -aanvz; -aanwa; -aanwb; -aanwc; -aanwd; -aanwe; -aanwf; -aanwg; -aanwh; -aanwi; -aanwj; -aanwk; -aanwl; -aanwm; -aanwn; -aanwo; -aanwp; -aanwq; -aanwr; -aanws; -aanwt; -aanwu; -aanwv; -aanww; -aanwx; -aanwy; -aanwz; -aanxa; -aanxb; -aanxc; -aanxd; -aanxe; -aanxf; -aanxg; -aanxh; -aanxi; -aanxj; -aanxk; -aanxl; -aanxm; -aanxn; -aanxo; -aanxp; -aanxq; -aanxr; -aanxs; -aanxt; -aanxu; -aanxv; -aanxw; -aanxx; -aanxy; -aanxz; -aanya; -aanyb; -aanyc; -aanyd; -aanye; -aanyf; -aanyg; -aanyh; -aanyi; -aanyj; -aanyk; -aanyl; -aanym; -aanyn; -aanyo; -aanyp; -aanyq; -aanyr; -aanys; -aanyt; -aanyu; -aanyv; -aanyw; -aanyx; -aanyy; -aanyz; -aanza; -aanzb; -aanzc; -aanzd; -aanze; -aanzf; -aanzg; -aanzh; -aanzi; -aanzj; -aanzk; -aanzl; -aanzm; -aanzn; -aanzo; -aanzp; -aanzq; -aanzr; -aanzs; -aanzt; -aanzu; -aanzv; -aanzw; -aanzx; -aanzy; -aanzz; -aaoaa; -aaoab; -aaoac; -aaoad; -aaoae; -aaoaf; -aaoag; -aaoah; -aaoai; -aaoaj; -aaoak; -aaoal; -aaoam; -aaoan; -aaoao; -aaoap; -aaoaq; -aaoar; -aaoas; -aaoat; -aaoau; -aaoav; -aaoaw; -aaoax; -aaoay; -aaoaz; -aaoba; -aaobb; -aaobc; -aaobd; -aaobe; -aaobf; -aaobg; -aaobh; -aaobi; -aaobj; -aaobk; -aaobl; -aaobm; -aaobn; -aaobo; -aaobp; -aaobq; -aaobr; -aaobs; -aaobt; -aaobu; -aaobv; -aaobw; -aaobx; -aaoby; -aaobz; -aaoca; -aaocb; -aaocc; -aaocd; -aaoce; -aaocf; -aaocg; -aaoch; -aaoci; -aaocj; -aaock; -aaocl; -aaocm; -aaocn; -aaoco; -aaocp; -aaocq; -aaocr; -aaocs; -aaoct; -aaocu; -aaocv; -aaocw; -aaocx; -aaocy; -aaocz; -aaoda; -aaodb; -aaodc; -aaodd; -aaode; -aaodf; -aaodg; -aaodh; -aaodi; -aaodj; -aaodk; -aaodl; -aaodm; -aaodn; -aaodo; -aaodp; -aaodq; -aaodr; -aaods; -aaodt; -aaodu; -aaodv; -aaodw; -aaodx; -aaody; -aaodz; -aaoea; -aaoeb; -aaoec; -aaoed; -aaoee; -aaoef; -aaoeg; -aaoeh; -aaoei; -aaoej; -aaoek; -aaoel; -aaoem; -aaoen; -aaoeo; -aaoep; -aaoeq; -aaoer; -aaoes; -aaoet; -aaoeu; -aaoev; -aaoew; -aaoex; -aaoey; -aaoez; -aaofa; -aaofb; -aaofc; -aaofd; -aaofe; -aaoff; -aaofg; -aaofh; -aaofi; -aaofj; -aaofk; -aaofl; -aaofm; -aaofn; -aaofo; -aaofp; -aaofq; -aaofr; -aaofs; -aaoft; -aaofu; -aaofv; -aaofw; -aaofx; -aaofy; -aaofz; -aaoga; -aaogb; -aaogc; -aaogd; -aaoge; -aaogf; -aaogg; -aaogh; -aaogi; -aaogj; -aaogk; -aaogl; -aaogm; -aaogn; -aaogo; -aaogp; -aaogq; -aaogr; -aaogs; -aaogt; -aaogu; -aaogv; -aaogw; -aaogx; -aaogy; -aaogz; -aaoha; -aaohb; -aaohc; -aaohd; -aaohe; -aaohf; -aaohg; -aaohh; -aaohi; -aaohj; -aaohk; -aaohl; -aaohm; -aaohn; -aaoho; -aaohp; -aaohq; -aaohr; -aaohs; -aaoht; -aaohu; -aaohv; -aaohw; -aaohx; -aaohy; -aaohz; -aaoia; -aaoib; -aaoic; -aaoid; -aaoie; -aaoif; -aaoig; -aaoih; -aaoii; -aaoij; -aaoik; -aaoil; -aaoim; -aaoin; -aaoio; -aaoip; -aaoiq; -aaoir; -aaois; -aaoit; -aaoiu; -aaoiv; -aaoiw; -aaoix; -aaoiy; -aaoiz; -aaoja; -aaojb; -aaojc; -aaojd; -aaoje; -aaojf; -aaojg; -aaojh; -aaoji; -aaojj; -aaojk; -aaojl; -aaojm; -aaojn; -aaojo; -aaojp; -aaojq; -aaojr; -aaojs; -aaojt; -aaoju; -aaojv; -aaojw; -aaojx; -aaojy; -aaojz; -aaoka; -aaokb; -aaokc; -aaokd; -aaoke; -aaokf; -aaokg; -aaokh; -aaoki; -aaokj; -aaokk; -aaokl; -aaokm; -aaokn; -aaoko; -aaokp; -aaokq; -aaokr; -aaoks; -aaokt; -aaoku; -aaokv; -aaokw; -aaokx; -aaoky; -aaokz; -aaola; -aaolb; -aaolc; -aaold; -aaole; -aaolf; -aaolg; -aaolh; -aaoli; -aaolj; -aaolk; -aaoll; -aaolm; -aaoln; -aaolo; -aaolp; -aaolq; -aaolr; -aaols; -aaolt; -aaolu; -aaolv; -aaolw; -aaolx; -aaoly; -aaolz; -aaoma; -aaomb; -aaomc; -aaomd; -aaome; -aaomf; -aaomg; -aaomh; -aaomi; -aaomj; -aaomk; -aaoml; -aaomm; -aaomn; -aaomo; -aaomp; -aaomq; -aaomr; -aaoms; -aaomt; -aaomu; -aaomv; -aaomw; -aaomx; -aaomy; -aaomz; -aaona; -aaonb; -aaonc; -aaond; -aaone; -aaonf; -aaong; -aaonh; -aaoni; -aaonj; -aaonk; -aaonl; -aaonm; -aaonn; -aaono; -aaonp; -aaonq; -aaonr; -aaons; -aaont; -aaonu; -aaonv; -aaonw; -aaonx; -aaony; -aaonz; -aaooa; -aaoob; -aaooc; -aaood; -aaooe; -aaoof; -aaoog; -aaooh; -aaooi; -aaooj; -aaook; -aaool; -aaoom; -aaoon; -aaooo; -aaoop; -aaooq; -aaoor; -aaoos; -aaoot; -aaoou; -aaoov; -aaoow; -aaoox; -aaooy; -aaooz; -aaopa; -aaopb; -aaopc; -aaopd; -aaope; -aaopf; -aaopg; -aaoph; -aaopi; -aaopj; -aaopk; -aaopl; -aaopm; -aaopn; -aaopo; -aaopp; -aaopq; -aaopr; -aaops; -aaopt; -aaopu; -aaopv; -aaopw; -aaopx; -aaopy; -aaopz; -aaoqa; -aaoqb; -aaoqc; -aaoqd; -aaoqe; -aaoqf; -aaoqg; -aaoqh; -aaoqi; -aaoqj; -aaoqk; -aaoql; -aaoqm; -aaoqn; -aaoqo; -aaoqp; -aaoqq; -aaoqr; -aaoqs; -aaoqt; -aaoqu; -aaoqv; -aaoqw; -aaoqx; -aaoqy; -aaoqz; -aaora; -aaorb; -aaorc; -aaord; -aaore; -aaorf; -aaorg; -aaorh; -aaori; -aaorj; -aaork; -aaorl; -aaorm; -aaorn; -aaoro; -aaorp; -aaorq; -aaorr; -aaors; -aaort; -aaoru; -aaorv; -aaorw; -aaorx; -aaory; -aaorz; -aaosa; -aaosb; -aaosc; -aaosd; -aaose; -aaosf; -aaosg; -aaosh; -aaosi; -aaosj; -aaosk; -aaosl; -aaosm; -aaosn; -aaoso; -aaosp; -aaosq; -aaosr; -aaoss; -aaost; -aaosu; -aaosv; -aaosw; -aaosx; -aaosy; -aaosz; -aaota; -aaotb; -aaotc; -aaotd; -aaote; -aaotf; -aaotg; -aaoth; -aaoti; -aaotj; -aaotk; -aaotl; -aaotm; -aaotn; -aaoto; -aaotp; -aaotq; -aaotr; -aaots; -aaott; -aaotu; -aaotv; -aaotw; -aaotx; -aaoty; -aaotz; -aaoua; -aaoub; -aaouc; -aaoud; -aaoue; -aaouf; -aaoug; -aaouh; -aaoui; -aaouj; -aaouk; -aaoul; -aaoum; -aaoun; -aaouo; -aaoup; -aaouq; -aaour; -aaous; -aaout; -aaouu; -aaouv; -aaouw; -aaoux; -aaouy; -aaouz; -aaova; -aaovb; -aaovc; -aaovd; -aaove; -aaovf; -aaovg; -aaovh; -aaovi; -aaovj; -aaovk; -aaovl; -aaovm; -aaovn; -aaovo; -aaovp; -aaovq; -aaovr; -aaovs; -aaovt; -aaovu; -aaovv; -aaovw; -aaovx; -aaovy; -aaovz; -aaowa; -aaowb; -aaowc; -aaowd; -aaowe; -aaowf; -aaowg; -aaowh; -aaowi; -aaowj; -aaowk; -aaowl; -aaowm; -aaown; -aaowo; -aaowp; -aaowq; -aaowr; -aaows; -aaowt; -aaowu; -aaowv; -aaoww; -aaowx; -aaowy; -aaowz; -aaoxa; -aaoxb; -aaoxc; -aaoxd; -aaoxe; -aaoxf; -aaoxg; -aaoxh; -aaoxi; -aaoxj; -aaoxk; -aaoxl; -aaoxm; -aaoxn; -aaoxo; -aaoxp; -aaoxq; -aaoxr; -aaoxs; -aaoxt; -aaoxu; -aaoxv; -aaoxw; -aaoxx; -aaoxy; -aaoxz; -aaoya; -aaoyb; -aaoyc; -aaoyd; -aaoye; -aaoyf; -aaoyg; -aaoyh; -aaoyi; -aaoyj; -aaoyk; -aaoyl; -aaoym; -aaoyn; -aaoyo; -aaoyp; -aaoyq; -aaoyr; -aaoys; -aaoyt; -aaoyu; -aaoyv; -aaoyw; -aaoyx; -aaoyy; -aaoyz; -aaoza; -aaozb; -aaozc; -aaozd; -aaoze; -aaozf; -aaozg; -aaozh; -aaozi; -aaozj; -aaozk; -aaozl; -aaozm; -aaozn; -aaozo; -aaozp; -aaozq; -aaozr; -aaozs; -aaozt; -aaozu; -aaozv; -aaozw; -aaozx; -aaozy; -aaozz; -aapaa; -aapab; -aapac; -aapad; -aapae; -aapaf; -aapag; -aapah; -aapai; -aapaj; -aapak; -aapal; -aapam; -aapan; -aapao; -aapap; -aapaq; -aapar; -aapas; -aapat; -aapau; -aapav; -aapaw; -aapax; -aapay; -aapaz; -aapba; -aapbb; -aapbc; -aapbd; -aapbe; -aapbf; -aapbg; -aapbh; -aapbi; -aapbj; -aapbk; -aapbl; -aapbm; -aapbn; -aapbo; -aapbp; -aapbq; -aapbr; -aapbs; -aapbt; -aapbu; -aapbv; -aapbw; -aapbx; -aapby; -aapbz; -aapca; -aapcb; -aapcc; -aapcd; -aapce; -aapcf; -aapcg; -aapch; -aapci; -aapcj; -aapck; -aapcl; -aapcm; -aapcn; -aapco; -aapcp; -aapcq; -aapcr; -aapcs; -aapct; -aapcu; -aapcv; -aapcw; -aapcx; -aapcy; -aapcz; -aapda; -aapdb; -aapdc; -aapdd; -aapde; -aapdf; -aapdg; -aapdh; -aapdi; -aapdj; -aapdk; -aapdl; -aapdm; -aapdn; -aapdo; -aapdp; -aapdq; -aapdr; -aapds; -aapdt; -aapdu; -aapdv; -aapdw; -aapdx; -aapdy; -aapdz; -aapea; -aapeb; -aapec; -aaped; -aapee; -aapef; -aapeg; -aapeh; -aapei; -aapej; -aapek; -aapel; -aapem; -aapen; -aapeo; -aapep; -aapeq; -aaper; -aapes; -aapet; -aapeu; -aapev; -aapew; -aapex; -aapey; -aapez; -aapfa; -aapfb; -aapfc; -aapfd; -aapfe; -aapff; -aapfg; -aapfh; -aapfi; -aapfj; -aapfk; -aapfl; -aapfm; -aapfn; -aapfo; -aapfp; -aapfq; -aapfr; -aapfs; -aapft; -aapfu; -aapfv; -aapfw; -aapfx; -aapfy; -aapfz; -aapga; -aapgb; -aapgc; -aapgd; -aapge; -aapgf; -aapgg; -aapgh; -aapgi; -aapgj; -aapgk; -aapgl; -aapgm; -aapgn; -aapgo; -aapgp; -aapgq; -aapgr; -aapgs; -aapgt; -aapgu; -aapgv; -aapgw; -aapgx; -aapgy; -aapgz; -aapha; -aaphb; -aaphc; -aaphd; -aaphe; -aaphf; -aaphg; -aaphh; -aaphi; -aaphj; -aaphk; -aaphl; -aaphm; -aaphn; -aapho; -aaphp; -aaphq; -aaphr; -aaphs; -aapht; -aaphu; -aaphv; -aaphw; -aaphx; -aaphy; -aaphz; -aapia; -aapib; -aapic; -aapid; -aapie; -aapif; -aapig; -aapih; -aapii; -aapij; -aapik; -aapil; -aapim; -aapin; -aapio; -aapip; -aapiq; -aapir; -aapis; -aapit; -aapiu; -aapiv; -aapiw; -aapix; -aapiy; -aapiz; -aapja; -aapjb; -aapjc; -aapjd; -aapje; -aapjf; -aapjg; -aapjh; -aapji; -aapjj; -aapjk; -aapjl; -aapjm; -aapjn; -aapjo; -aapjp; -aapjq; -aapjr; -aapjs; -aapjt; -aapju; -aapjv; -aapjw; -aapjx; -aapjy; -aapjz; -aapka; -aapkb; -aapkc; -aapkd; -aapke; -aapkf; -aapkg; -aapkh; -aapki; -aapkj; -aapkk; -aapkl; -aapkm; -aapkn; -aapko; -aapkp; -aapkq; -aapkr; -aapks; -aapkt; -aapku; -aapkv; -aapkw; -aapkx; -aapky; -aapkz; -aapla; -aaplb; -aaplc; -aapld; -aaple; -aaplf; -aaplg; -aaplh; -aapli; -aaplj; -aaplk; -aapll; -aaplm; -aapln; -aaplo; -aaplp; -aaplq; -aaplr; -aapls; -aaplt; -aaplu; -aaplv; -aaplw; -aaplx; -aaply; -aaplz; -aapma; -aapmb; -aapmc; -aapmd; -aapme; -aapmf; -aapmg; -aapmh; -aapmi; -aapmj; -aapmk; -aapml; -aapmm; -aapmn; -aapmo; -aapmp; -aapmq; -aapmr; -aapms; -aapmt; -aapmu; -aapmv; -aapmw; -aapmx; -aapmy; -aapmz; -aapna; -aapnb; -aapnc; -aapnd; -aapne; -aapnf; -aapng; -aapnh; -aapni; -aapnj; -aapnk; -aapnl; -aapnm; -aapnn; -aapno; -aapnp; -aapnq; -aapnr; -aapns; -aapnt; -aapnu; -aapnv; -aapnw; -aapnx; -aapny; -aapnz; -aapoa; -aapob; -aapoc; -aapod; -aapoe; -aapof; -aapog; -aapoh; -aapoi; -aapoj; -aapok; -aapol; -aapom; -aapon; -aapoo; -aapop; -aapoq; -aapor; -aapos; -aapot; -aapou; -aapov; -aapow; -aapox; -aapoy; -aapoz; -aappa; -aappb; -aappc; -aappd; -aappe; -aappf; -aappg; -aapph; -aappi; -aappj; -aappk; -aappl; -aappm; -aappn; -aappo; -aappp; -aappq; -aappr; -aapps; -aappt; -aappu; -aappv; -aappw; -aappx; -aappy; -aappz; -aapqa; -aapqb; -aapqc; -aapqd; -aapqe; -aapqf; -aapqg; -aapqh; -aapqi; -aapqj; -aapqk; -aapql; -aapqm; -aapqn; -aapqo; -aapqp; -aapqq; -aapqr; -aapqs; -aapqt; -aapqu; -aapqv; -aapqw; -aapqx; -aapqy; -aapqz; -aapra; -aaprb; -aaprc; -aaprd; -aapre; -aaprf; -aaprg; -aaprh; -aapri; -aaprj; -aaprk; -aaprl; -aaprm; -aaprn; -aapro; -aaprp; -aaprq; -aaprr; -aaprs; -aaprt; -aapru; -aaprv; -aaprw; -aaprx; -aapry; -aaprz; -aapsa; -aapsb; -aapsc; -aapsd; -aapse; -aapsf; -aapsg; -aapsh; -aapsi; -aapsj; -aapsk; -aapsl; -aapsm; -aapsn; -aapso; -aapsp; -aapsq; -aapsr; -aapss; -aapst; -aapsu; -aapsv; -aapsw; -aapsx; -aapsy; -aapsz; -aapta; -aaptb; -aaptc; -aaptd; -aapte; -aaptf; -aaptg; -aapth; -aapti; -aaptj; -aaptk; -aaptl; -aaptm; -aaptn; -aapto; -aaptp; -aaptq; -aaptr; -aapts; -aaptt; -aaptu; -aaptv; -aaptw; -aaptx; -aapty; -aaptz; -aapua; -aapub; -aapuc; -aapud; -aapue; -aapuf; -aapug; -aapuh; -aapui; -aapuj; -aapuk; -aapul; -aapum; -aapun; -aapuo; -aapup; -aapuq; -aapur; -aapus; -aaput; -aapuu; -aapuv; -aapuw; -aapux; -aapuy; -aapuz; -aapva; -aapvb; -aapvc; -aapvd; -aapve; -aapvf; -aapvg; -aapvh; -aapvi; -aapvj; -aapvk; -aapvl; -aapvm; -aapvn; -aapvo; -aapvp; -aapvq; -aapvr; -aapvs; -aapvt; -aapvu; -aapvv; -aapvw; -aapvx; -aapvy; -aapvz; -aapwa; -aapwb; -aapwc; -aapwd; -aapwe; -aapwf; -aapwg; -aapwh; -aapwi; -aapwj; -aapwk; -aapwl; -aapwm; -aapwn; -aapwo; -aapwp; -aapwq; -aapwr; -aapws; -aapwt; -aapwu; -aapwv; -aapww; -aapwx; -aapwy; -aapwz; -aapxa; -aapxb; -aapxc; -aapxd; -aapxe; -aapxf; -aapxg; -aapxh; -aapxi; -aapxj; -aapxk; -aapxl; -aapxm; -aapxn; -aapxo; -aapxp; -aapxq; -aapxr; -aapxs; -aapxt; -aapxu; -aapxv; -aapxw; -aapxx; -aapxy; -aapxz; -aapya; -aapyb; -aapyc; -aapyd; -aapye; -aapyf; -aapyg; -aapyh; -aapyi; -aapyj; -aapyk; -aapyl; -aapym; -aapyn; -aapyo; -aapyp; -aapyq; -aapyr; -aapys; -aapyt; -aapyu; -aapyv; -aapyw; -aapyx; -aapyy; -aapyz; -aapza; -aapzb; -aapzc; -aapzd; -aapze; -aapzf; -aapzg; -aapzh; -aapzi; -aapzj; -aapzk; -aapzl; -aapzm; -aapzn; -aapzo; -aapzp; -aapzq; -aapzr; -aapzs; -aapzt; -aapzu; -aapzv; -aapzw; -aapzx; -aapzy; -aapzz; -aaqaa; -aaqab; -aaqac; -aaqad; -aaqae; -aaqaf; -aaqag; -aaqah; -aaqai; -aaqaj; -aaqak; -aaqal; -aaqam; -aaqan; -aaqao; -aaqap; -aaqaq; -aaqar; -aaqas; -aaqat; -aaqau; -aaqav; -aaqaw; -aaqax; -aaqay; -aaqaz; -aaqba; -aaqbb; -aaqbc; -aaqbd; -aaqbe; -aaqbf; -aaqbg; -aaqbh; -aaqbi; -aaqbj; -aaqbk; -aaqbl; -aaqbm; -aaqbn; -aaqbo; -aaqbp; -aaqbq; -aaqbr; -aaqbs; -aaqbt; -aaqbu; -aaqbv; -aaqbw; -aaqbx; -aaqby; -aaqbz; -aaqca; -aaqcb; -aaqcc; -aaqcd; -aaqce; -aaqcf; -aaqcg; -aaqch; -aaqci; -aaqcj; -aaqck; -aaqcl; -aaqcm; -aaqcn; -aaqco; -aaqcp; -aaqcq; -aaqcr; -aaqcs; -aaqct; -aaqcu; -aaqcv; -aaqcw; -aaqcx; -aaqcy; -aaqcz; -aaqda; -aaqdb; -aaqdc; -aaqdd; -aaqde; -aaqdf; -aaqdg; -aaqdh; -aaqdi; -aaqdj; -aaqdk; -aaqdl; -aaqdm; -aaqdn; -aaqdo; -aaqdp; -aaqdq; -aaqdr; -aaqds; -aaqdt; -aaqdu; -aaqdv; -aaqdw; -aaqdx; -aaqdy; -aaqdz; -aaqea; -aaqeb; -aaqec; -aaqed; -aaqee; -aaqef; -aaqeg; -aaqeh; -aaqei; -aaqej; -aaqek; -aaqel; -aaqem; -aaqen; -aaqeo; -aaqep; -aaqeq; -aaqer; -aaqes; -aaqet; -aaqeu; -aaqev; -aaqew; -aaqex; -aaqey; -aaqez; -aaqfa; -aaqfb; -aaqfc; -aaqfd; -aaqfe; -aaqff; -aaqfg; -aaqfh; -aaqfi; -aaqfj; -aaqfk; -aaqfl; -aaqfm; -aaqfn; -aaqfo; -aaqfp; -aaqfq; -aaqfr; -aaqfs; -aaqft; -aaqfu; -aaqfv; -aaqfw; -aaqfx; -aaqfy; -aaqfz; -aaqga; -aaqgb; -aaqgc; -aaqgd; -aaqge; -aaqgf; -aaqgg; -aaqgh; -aaqgi; -aaqgj; -aaqgk; -aaqgl; -aaqgm; -aaqgn; -aaqgo; -aaqgp; -aaqgq; -aaqgr; -aaqgs; -aaqgt; -aaqgu; -aaqgv; -aaqgw; -aaqgx; -aaqgy; -aaqgz; -aaqha; -aaqhb; -aaqhc; -aaqhd; -aaqhe; -aaqhf; -aaqhg; -aaqhh; -aaqhi; -aaqhj; -aaqhk; -aaqhl; -aaqhm; -aaqhn; -aaqho; -aaqhp; -aaqhq; -aaqhr; -aaqhs; -aaqht; -aaqhu; -aaqhv; -aaqhw; -aaqhx; -aaqhy; -aaqhz; -aaqia; -aaqib; -aaqic; -aaqid; -aaqie; -aaqif; -aaqig; -aaqih; -aaqii; -aaqij; -aaqik; -aaqil; -aaqim; -aaqin; -aaqio; -aaqip; -aaqiq; -aaqir; -aaqis; -aaqit; -aaqiu; -aaqiv; -aaqiw; -aaqix; -aaqiy; -aaqiz; -aaqja; -aaqjb; -aaqjc; -aaqjd; -aaqje; -aaqjf; -aaqjg; -aaqjh; -aaqji; -aaqjj; -aaqjk; -aaqjl; -aaqjm; -aaqjn; -aaqjo; -aaqjp; -aaqjq; -aaqjr; -aaqjs; -aaqjt; -aaqju; -aaqjv; -aaqjw; -aaqjx; -aaqjy; -aaqjz; -aaqka; -aaqkb; -aaqkc; -aaqkd; -aaqke; -aaqkf; -aaqkg; -aaqkh; -aaqki; -aaqkj; -aaqkk; -aaqkl; -aaqkm; -aaqkn; -aaqko; -aaqkp; -aaqkq; -aaqkr; -aaqks; -aaqkt; -aaqku; -aaqkv; -aaqkw; -aaqkx; -aaqky; -aaqkz; -aaqla; -aaqlb; -aaqlc; -aaqld; -aaqle; -aaqlf; -aaqlg; -aaqlh; -aaqli; -aaqlj; -aaqlk; -aaqll; -aaqlm; -aaqln; -aaqlo; -aaqlp; -aaqlq; -aaqlr; -aaqls; -aaqlt; -aaqlu; -aaqlv; -aaqlw; -aaqlx; -aaqly; -aaqlz; -aaqma; -aaqmb; -aaqmc; -aaqmd; -aaqme; -aaqmf; -aaqmg; -aaqmh; -aaqmi; -aaqmj; -aaqmk; -aaqml; -aaqmm; -aaqmn; -aaqmo; -aaqmp; -aaqmq; -aaqmr; -aaqms; -aaqmt; -aaqmu; -aaqmv; -aaqmw; -aaqmx; -aaqmy; -aaqmz; -aaqna; -aaqnb; -aaqnc; -aaqnd; -aaqne; -aaqnf; -aaqng; -aaqnh; -aaqni; -aaqnj; -aaqnk; -aaqnl; -aaqnm; -aaqnn; -aaqno; -aaqnp; -aaqnq; -aaqnr; -aaqns; -aaqnt; -aaqnu; -aaqnv; -aaqnw; -aaqnx; -aaqny; -aaqnz; -aaqoa; -aaqob; -aaqoc; -aaqod; -aaqoe; -aaqof; -aaqog; -aaqoh; -aaqoi; -aaqoj; -aaqok; -aaqol; -aaqom; -aaqon; -aaqoo; -aaqop; -aaqoq; -aaqor; -aaqos; -aaqot; -aaqou; -aaqov; -aaqow; -aaqox; -aaqoy; -aaqoz; -aaqpa; -aaqpb; -aaqpc; -aaqpd; -aaqpe; -aaqpf; -aaqpg; -aaqph; -aaqpi; -aaqpj; -aaqpk; -aaqpl; -aaqpm; -aaqpn; -aaqpo; -aaqpp; -aaqpq; -aaqpr; -aaqps; -aaqpt; -aaqpu; -aaqpv; -aaqpw; -aaqpx; -aaqpy; -aaqpz; -aaqqa; -aaqqb; -aaqqc; -aaqqd; -aaqqe; -aaqqf; -aaqqg; -aaqqh; -aaqqi; -aaqqj; -aaqqk; -aaqql; -aaqqm; -aaqqn; -aaqqo; -aaqqp; -aaqqq; -aaqqr; -aaqqs; -aaqqt; -aaqqu; -aaqqv; -aaqqw; -aaqqx; -aaqqy; -aaqqz; -aaqra; -aaqrb; -aaqrc; -aaqrd; -aaqre; -aaqrf; -aaqrg; -aaqrh; -aaqri; -aaqrj; -aaqrk; -aaqrl; -aaqrm; -aaqrn; -aaqro; -aaqrp; -aaqrq; -aaqrr; -aaqrs; -aaqrt; -aaqru; -aaqrv; -aaqrw; -aaqrx; -aaqry; -aaqrz; -aaqsa; -aaqsb; -aaqsc; -aaqsd; -aaqse; -aaqsf; -aaqsg; -aaqsh; -aaqsi; -aaqsj; -aaqsk; -aaqsl; -aaqsm; -aaqsn; -aaqso; -aaqsp; -aaqsq; -aaqsr; -aaqss; -aaqst; -aaqsu; -aaqsv; -aaqsw; -aaqsx; -aaqsy; -aaqsz; -aaqta; -aaqtb; -aaqtc; -aaqtd; -aaqte; -aaqtf; -aaqtg; -aaqth; -aaqti; -aaqtj; -aaqtk; -aaqtl; -aaqtm; -aaqtn; -aaqto; -aaqtp; -aaqtq; -aaqtr; -aaqts; -aaqtt; -aaqtu; -aaqtv; -aaqtw; -aaqtx; -aaqty; -aaqtz; -aaqua; -aaqub; -aaquc; -aaqud; -aaque; -aaquf; -aaqug; -aaquh; -aaqui; -aaquj; -aaquk; -aaqul; -aaqum; -aaqun; -aaquo; -aaqup; -aaquq; -aaqur; -aaqus; -aaqut; -aaquu; -aaquv; -aaquw; -aaqux; -aaquy; -aaquz; -aaqva; -aaqvb; -aaqvc; -aaqvd; -aaqve; -aaqvf; -aaqvg; -aaqvh; -aaqvi; -aaqvj; -aaqvk; -aaqvl; -aaqvm; -aaqvn; -aaqvo; -aaqvp; -aaqvq; -aaqvr; -aaqvs; -aaqvt; -aaqvu; -aaqvv; -aaqvw; -aaqvx; -aaqvy; -aaqvz; -aaqwa; -aaqwb; -aaqwc; -aaqwd; -aaqwe; -aaqwf; -aaqwg; -aaqwh; -aaqwi; -aaqwj; -aaqwk; -aaqwl; -aaqwm; -aaqwn; -aaqwo; -aaqwp; -aaqwq; -aaqwr; -aaqws; -aaqwt; -aaqwu; -aaqwv; -aaqww; -aaqwx; -aaqwy; -aaqwz; -aaqxa; -aaqxb; -aaqxc; -aaqxd; -aaqxe; -aaqxf; -aaqxg; -aaqxh; -aaqxi; -aaqxj; -aaqxk; -aaqxl; -aaqxm; -aaqxn; -aaqxo; -aaqxp; -aaqxq; -aaqxr; -aaqxs; -aaqxt; -aaqxu; -aaqxv; -aaqxw; -aaqxx; -aaqxy; -aaqxz; -aaqya; -aaqyb; -aaqyc; -aaqyd; -aaqye; -aaqyf; -aaqyg; -aaqyh; -aaqyi; -aaqyj; -aaqyk; -aaqyl; -aaqym; -aaqyn; -aaqyo; -aaqyp; -aaqyq; -aaqyr; -aaqys; -aaqyt; -aaqyu; -aaqyv; -aaqyw; -aaqyx; -aaqyy; -aaqyz; -aaqza; -aaqzb; -aaqzc; -aaqzd; -aaqze; -aaqzf; -aaqzg; -aaqzh; -aaqzi; -aaqzj; -aaqzk; -aaqzl; -aaqzm; -aaqzn; -aaqzo; -aaqzp; -aaqzq; -aaqzr; -aaqzs; -aaqzt; -aaqzu; -aaqzv; -aaqzw; -aaqzx; -aaqzy; -aaqzz; -aaraa; -aarab; -aarac; -aarad; -aarae; -aaraf; -aarag; -aarah; -aarai; -aaraj; -aarak; -aaral; -aaram; -aaran; -aarao; -aarap; -aaraq; -aarar; -aaras; -aarat; -aarau; -aarav; -aaraw; -aarax; -aaray; -aaraz; -aarba; -aarbb; -aarbc; -aarbd; -aarbe; -aarbf; -aarbg; -aarbh; -aarbi; -aarbj; -aarbk; -aarbl; -aarbm; -aarbn; -aarbo; -aarbp; -aarbq; -aarbr; -aarbs; -aarbt; -aarbu; -aarbv; -aarbw; -aarbx; -aarby; -aarbz; -aarca; -aarcb; -aarcc; -aarcd; -aarce; -aarcf; -aarcg; -aarch; -aarci; -aarcj; -aarck; -aarcl; -aarcm; -aarcn; -aarco; -aarcp; -aarcq; -aarcr; -aarcs; -aarct; -aarcu; -aarcv; -aarcw; -aarcx; -aarcy; -aarcz; -aarda; -aardb; -aardc; -aardd; -aarde; -aardf; -aardg; -aardh; -aardi; -aardj; -aardk; -aardl; -aardm; -aardn; -aardo; -aardp; -aardq; -aardr; -aards; -aardt; -aardu; -aardv; -aardw; -aardx; -aardy; -aardz; -aarea; -aareb; -aarec; -aared; -aaree; -aaref; -aareg; -aareh; -aarei; -aarej; -aarek; -aarel; -aarem; -aaren; -aareo; -aarep; -aareq; -aarer; -aares; -aaret; -aareu; -aarev; -aarew; -aarex; -aarey; -aarez; -aarfa; -aarfb; -aarfc; -aarfd; -aarfe; -aarff; -aarfg; -aarfh; -aarfi; -aarfj; -aarfk; -aarfl; -aarfm; -aarfn; -aarfo; -aarfp; -aarfq; -aarfr; -aarfs; -aarft; -aarfu; -aarfv; -aarfw; -aarfx; -aarfy; -aarfz; -aarga; -aargb; -aargc; -aargd; -aarge; -aargf; -aargg; -aargh; -aargi; -aargj; -aargk; -aargl; -aargm; -aargn; -aargo; -aargp; -aargq; -aargr; -aargs; -aargt; -aargu; -aargv; -aargw; -aargx; -aargy; -aargz; -aarha; -aarhb; -aarhc; -aarhd; -aarhe; -aarhf; -aarhg; -aarhh; -aarhi; -aarhj; -aarhk; -aarhl; -aarhm; -aarhn; -aarho; -aarhp; -aarhq; -aarhr; -aarhs; -aarht; -aarhu; -aarhv; -aarhw; -aarhx; -aarhy; -aarhz; -aaria; -aarib; -aaric; -aarid; -aarie; -aarif; -aarig; -aarih; -aarii; -aarij; -aarik; -aaril; -aarim; -aarin; -aario; -aarip; -aariq; -aarir; -aaris; -aarit; -aariu; -aariv; -aariw; -aarix; -aariy; -aariz; -aarja; -aarjb; -aarjc; -aarjd; -aarje; -aarjf; -aarjg; -aarjh; -aarji; -aarjj; -aarjk; -aarjl; -aarjm; -aarjn; -aarjo; -aarjp; -aarjq; -aarjr; -aarjs; -aarjt; -aarju; -aarjv; -aarjw; -aarjx; -aarjy; -aarjz; -aarka; -aarkb; -aarkc; -aarkd; -aarke; -aarkf; -aarkg; -aarkh; -aarki; -aarkj; -aarkk; -aarkl; -aarkm; -aarkn; -aarko; -aarkp; -aarkq; -aarkr; -aarks; -aarkt; -aarku; -aarkv; -aarkw; -aarkx; -aarky; -aarkz; -aarla; -aarlb; -aarlc; -aarld; -aarle; -aarlf; -aarlg; -aarlh; -aarli; -aarlj; -aarlk; -aarll; -aarlm; -aarln; -aarlo; -aarlp; -aarlq; -aarlr; -aarls; -aarlt; -aarlu; -aarlv; -aarlw; -aarlx; -aarly; -aarlz; -aarma; -aarmb; -aarmc; -aarmd; -aarme; -aarmf; -aarmg; -aarmh; -aarmi; -aarmj; -aarmk; -aarml; -aarmm; -aarmn; -aarmo; -aarmp; -aarmq; -aarmr; -aarms; -aarmt; -aarmu; -aarmv; -aarmw; -aarmx; -aarmy; -aarmz; -aarna; -aarnb; -aarnc; -aarnd; -aarne; -aarnf; -aarng; -aarnh; -aarni; -aarnj; -aarnk; -aarnl; -aarnm; -aarnn; -aarno; -aarnp; -aarnq; -aarnr; -aarns; -aarnt; -aarnu; -aarnv; -aarnw; -aarnx; -aarny; -aarnz; -aaroa; -aarob; -aaroc; -aarod; -aaroe; -aarof; -aarog; -aaroh; -aaroi; -aaroj; -aarok; -aarol; -aarom; -aaron; -aaroo; -aarop; -aaroq; -aaror; -aaros; -aarot; -aarou; -aarov; -aarow; -aarox; -aaroy; -aaroz; -aarpa; -aarpb; -aarpc; -aarpd; -aarpe; -aarpf; -aarpg; -aarph; -aarpi; -aarpj; -aarpk; -aarpl; -aarpm; -aarpn; -aarpo; -aarpp; -aarpq; -aarpr; -aarps; -aarpt; -aarpu; -aarpv; -aarpw; -aarpx; -aarpy; -aarpz; -aarqa; -aarqb; -aarqc; -aarqd; -aarqe; -aarqf; -aarqg; -aarqh; -aarqi; -aarqj; -aarqk; -aarql; -aarqm; -aarqn; -aarqo; -aarqp; -aarqq; -aarqr; -aarqs; -aarqt; -aarqu; -aarqv; -aarqw; -aarqx; -aarqy; -aarqz; -aarra; -aarrb; -aarrc; -aarrd; -aarre; -aarrf; -aarrg; -aarrh; -aarri; -aarrj; -aarrk; -aarrl; -aarrm; -aarrn; -aarro; -aarrp; -aarrq; -aarrr; -aarrs; -aarrt; -aarru; -aarrv; -aarrw; -aarrx; -aarry; -aarrz; -aarsa; -aarsb; -aarsc; -aarsd; -aarse; -aarsf; -aarsg; -aarsh; -aarsi; -aarsj; -aarsk; -aarsl; -aarsm; -aarsn; -aarso; -aarsp; -aarsq; -aarsr; -aarss; -aarst; -aarsu; -aarsv; -aarsw; -aarsx; -aarsy; -aarsz; -aarta; -aartb; -aartc; -aartd; -aarte; -aartf; -aartg; -aarth; -aarti; -aartj; -aartk; -aartl; -aartm; -aartn; -aarto; -aartp; -aartq; -aartr; -aarts; -aartt; -aartu; -aartv; -aartw; -aartx; -aarty; -aartz; -aarua; -aarub; -aaruc; -aarud; -aarue; -aaruf; -aarug; -aaruh; -aarui; -aaruj; -aaruk; -aarul; -aarum; -aarun; -aaruo; -aarup; -aaruq; -aarur; -aarus; -aarut; -aaruu; -aaruv; -aaruw; -aarux; -aaruy; -aaruz; -aarva; -aarvb; -aarvc; -aarvd; -aarve; -aarvf; -aarvg; -aarvh; -aarvi; -aarvj; -aarvk; -aarvl; -aarvm; -aarvn; -aarvo; -aarvp; -aarvq; -aarvr; -aarvs; -aarvt; -aarvu; -aarvv; -aarvw; -aarvx; -aarvy; -aarvz; -aarwa; -aarwb; -aarwc; -aarwd; -aarwe; -aarwf; -aarwg; -aarwh; -aarwi; -aarwj; -aarwk; -aarwl; -aarwm; -aarwn; -aarwo; -aarwp; -aarwq; -aarwr; -aarws; -aarwt; -aarwu; -aarwv; -aarww; -aarwx; -aarwy; -aarwz; -aarxa; -aarxb; -aarxc; -aarxd; -aarxe; -aarxf; -aarxg; -aarxh; -aarxi; -aarxj; -aarxk; -aarxl; -aarxm; -aarxn; -aarxo; -aarxp; -aarxq; -aarxr; -aarxs; -aarxt; -aarxu; -aarxv; -aarxw; -aarxx; -aarxy; -aarxz; -aarya; -aaryb; -aaryc; -aaryd; -aarye; -aaryf; -aaryg; -aaryh; -aaryi; -aaryj; -aaryk; -aaryl; -aarym; -aaryn; -aaryo; -aaryp; -aaryq; -aaryr; -aarys; -aaryt; -aaryu; -aaryv; -aaryw; -aaryx; -aaryy; -aaryz; -aarza; -aarzb; -aarzc; -aarzd; -aarze; -aarzf; -aarzg; -aarzh; -aarzi; -aarzj; -aarzk; -aarzl; -aarzm; -aarzn; -aarzo; -aarzp; -aarzq; -aarzr; -aarzs; -aarzt; -aarzu; -aarzv; -aarzw; -aarzx; -aarzy; -aarzz; -aasaa; -aasab; -aasac; -aasad; -aasae; -aasaf; -aasag; -aasah; -aasai; -aasaj; -aasak; -aasal; -aasam; -aasan; -aasao; -aasap; -aasaq; -aasar; -aasas; -aasat; -aasau; -aasav; -aasaw; -aasax; -aasay; -aasaz; -aasba; -aasbb; -aasbc; -aasbd; -aasbe; -aasbf; -aasbg; -aasbh; -aasbi; -aasbj; -aasbk; -aasbl; -aasbm; -aasbn; -aasbo; -aasbp; -aasbq; -aasbr; -aasbs; -aasbt; -aasbu; -aasbv; -aasbw; -aasbx; -aasby; -aasbz; -aasca; -aascb; -aascc; -aascd; -aasce; -aascf; -aascg; -aasch; -aasci; -aascj; -aasck; -aascl; -aascm; -aascn; -aasco; -aascp; -aascq; -aascr; -aascs; -aasct; -aascu; -aascv; -aascw; -aascx; -aascy; -aascz; -aasda; -aasdb; -aasdc; -aasdd; -aasde; -aasdf; -aasdg; -aasdh; -aasdi; -aasdj; -aasdk; -aasdl; -aasdm; -aasdn; -aasdo; -aasdp; -aasdq; -aasdr; -aasds; -aasdt; -aasdu; -aasdv; -aasdw; -aasdx; -aasdy; -aasdz; -aasea; -aaseb; -aasec; -aased; -aasee; -aasef; -aaseg; -aaseh; -aasei; -aasej; -aasek; -aasel; -aasem; -aasen; -aaseo; -aasep; -aaseq; -aaser; -aases; -aaset; -aaseu; -aasev; -aasew; -aasex; -aasey; -aasez; -aasfa; -aasfb; -aasfc; -aasfd; -aasfe; -aasff; -aasfg; -aasfh; -aasfi; -aasfj; -aasfk; -aasfl; -aasfm; -aasfn; -aasfo; -aasfp; -aasfq; -aasfr; -aasfs; -aasft; -aasfu; -aasfv; -aasfw; -aasfx; -aasfy; -aasfz; -aasga; -aasgb; -aasgc; -aasgd; -aasge; -aasgf; -aasgg; -aasgh; -aasgi; -aasgj; -aasgk; -aasgl; -aasgm; -aasgn; -aasgo; -aasgp; -aasgq; -aasgr; -aasgs; -aasgt; -aasgu; -aasgv; -aasgw; -aasgx; -aasgy; -aasgz; -aasha; -aashb; -aashc; -aashd; -aashe; -aashf; -aashg; -aashh; -aashi; -aashj; -aashk; -aashl; -aashm; -aashn; -aasho; -aashp; -aashq; -aashr; -aashs; -aasht; -aashu; -aashv; -aashw; -aashx; -aashy; -aashz; -aasia; -aasib; -aasic; -aasid; -aasie; -aasif; -aasig; -aasih; -aasii; -aasij; -aasik; -aasil; -aasim; -aasin; -aasio; -aasip; -aasiq; -aasir; -aasis; -aasit; -aasiu; -aasiv; -aasiw; -aasix; -aasiy; -aasiz; -aasja; -aasjb; -aasjc; -aasjd; -aasje; -aasjf; -aasjg; -aasjh; -aasji; -aasjj; -aasjk; -aasjl; -aasjm; -aasjn; -aasjo; -aasjp; -aasjq; -aasjr; -aasjs; -aasjt; -aasju; -aasjv; -aasjw; -aasjx; -aasjy; -aasjz; -aaska; -aaskb; -aaskc; -aaskd; -aaske; -aaskf; -aaskg; -aaskh; -aaski; -aaskj; -aaskk; -aaskl; -aaskm; -aaskn; -aasko; -aaskp; -aaskq; -aaskr; -aasks; -aaskt; -aasku; -aaskv; -aaskw; -aaskx; -aasky; -aaskz; -aasla; -aaslb; -aaslc; -aasld; -aasle; -aaslf; -aaslg; -aaslh; -aasli; -aaslj; -aaslk; -aasll; -aaslm; -aasln; -aaslo; -aaslp; -aaslq; -aaslr; -aasls; -aaslt; -aaslu; -aaslv; -aaslw; -aaslx; -aasly; -aaslz; -aasma; -aasmb; -aasmc; -aasmd; -aasme; -aasmf; -aasmg; -aasmh; -aasmi; -aasmj; -aasmk; -aasml; -aasmm; -aasmn; -aasmo; -aasmp; -aasmq; -aasmr; -aasms; -aasmt; -aasmu; -aasmv; -aasmw; -aasmx; -aasmy; -aasmz; -aasna; -aasnb; -aasnc; -aasnd; -aasne; -aasnf; -aasng; -aasnh; -aasni; -aasnj; -aasnk; -aasnl; -aasnm; -aasnn; -aasno; -aasnp; -aasnq; -aasnr; -aasns; -aasnt; -aasnu; -aasnv; -aasnw; -aasnx; -aasny; -aasnz; -aasoa; -aasob; -aasoc; -aasod; -aasoe; -aasof; -aasog; -aasoh; -aasoi; -aasoj; -aasok; -aasol; -aasom; -aason; -aasoo; -aasop; -aasoq; -aasor; -aasos; -aasot; -aasou; -aasov; -aasow; -aasox; -aasoy; -aasoz; -aaspa; -aaspb; -aaspc; -aaspd; -aaspe; -aaspf; -aaspg; -aasph; -aaspi; -aaspj; -aaspk; -aaspl; -aaspm; -aaspn; -aaspo; -aaspp; -aaspq; -aaspr; -aasps; -aaspt; -aaspu; -aaspv; -aaspw; -aaspx; -aaspy; -aaspz; -aasqa; -aasqb; -aasqc; -aasqd; -aasqe; -aasqf; -aasqg; -aasqh; -aasqi; -aasqj; -aasqk; -aasql; -aasqm; -aasqn; -aasqo; -aasqp; -aasqq; -aasqr; -aasqs; -aasqt; -aasqu; -aasqv; -aasqw; -aasqx; -aasqy; -aasqz; -aasra; -aasrb; -aasrc; -aasrd; -aasre; -aasrf; -aasrg; -aasrh; -aasri; -aasrj; -aasrk; -aasrl; -aasrm; -aasrn; -aasro; -aasrp; -aasrq; -aasrr; -aasrs; -aasrt; -aasru; -aasrv; -aasrw; -aasrx; -aasry; -aasrz; -aassa; -aassb; -aassc; -aassd; -aasse; -aassf; -aassg; -aassh; -aassi; -aassj; -aassk; -aassl; -aassm; -aassn; -aasso; -aassp; -aassq; -aassr; -aasss; -aasst; -aassu; -aassv; -aassw; -aassx; -aassy; -aassz; -aasta; -aastb; -aastc; -aastd; -aaste; -aastf; -aastg; -aasth; -aasti; -aastj; -aastk; -aastl; -aastm; -aastn; -aasto; -aastp; -aastq; -aastr; -aasts; -aastt; -aastu; -aastv; -aastw; -aastx; -aasty; -aastz; -aasua; -aasub; -aasuc; -aasud; -aasue; -aasuf; -aasug; -aasuh; -aasui; -aasuj; -aasuk; -aasul; -aasum; -aasun; -aasuo; -aasup; -aasuq; -aasur; -aasus; -aasut; -aasuu; -aasuv; -aasuw; -aasux; -aasuy; -aasuz; -aasva; -aasvb; -aasvc; -aasvd; -aasve; -aasvf; -aasvg; -aasvh; -aasvi; -aasvj; -aasvk; -aasvl; -aasvm; -aasvn; -aasvo; -aasvp; -aasvq; -aasvr; -aasvs; -aasvt; -aasvu; -aasvv; -aasvw; -aasvx; -aasvy; -aasvz; -aaswa; -aaswb; -aaswc; -aaswd; -aaswe; -aaswf; -aaswg; -aaswh; -aaswi; -aaswj; -aaswk; -aaswl; -aaswm; -aaswn; -aaswo; -aaswp; -aaswq; -aaswr; -aasws; -aaswt; -aaswu; -aaswv; -aasww; -aaswx; -aaswy; -aaswz; -aasxa; -aasxb; -aasxc; -aasxd; -aasxe; -aasxf; -aasxg; -aasxh; -aasxi; -aasxj; -aasxk; -aasxl; -aasxm; -aasxn; -aasxo; -aasxp; -aasxq; -aasxr; -aasxs; -aasxt; -aasxu; -aasxv; -aasxw; -aasxx; -aasxy; -aasxz; -aasya; -aasyb; -aasyc; -aasyd; -aasye; -aasyf; -aasyg; -aasyh; -aasyi; -aasyj; -aasyk; -aasyl; -aasym; -aasyn; -aasyo; -aasyp; -aasyq; -aasyr; -aasys; -aasyt; -aasyu; -aasyv; -aasyw; -aasyx; -aasyy; -aasyz; -aasza; -aaszb; -aaszc; -aaszd; -aasze; -aaszf; -aaszg; -aaszh; -aaszi; -aaszj; -aaszk; -aaszl; -aaszm; -aaszn; -aaszo; -aaszp; -aaszq; -aaszr; -aaszs; -aaszt; -aaszu; -aaszv; -aaszw; -aaszx; -aaszy; -aaszz; -aataa; -aatab; -aatac; -aatad; -aatae; -aataf; -aatag; -aatah; -aatai; -aataj; -aatak; -aatal; -aatam; -aatan; -aatao; -aatap; -aataq; -aatar; -aatas; -aatat; -aatau; -aatav; -aataw; -aatax; -aatay; -aataz; -aatba; -aatbb; -aatbc; -aatbd; -aatbe; -aatbf; -aatbg; -aatbh; -aatbi; -aatbj; -aatbk; -aatbl; -aatbm; -aatbn; -aatbo; -aatbp; -aatbq; -aatbr; -aatbs; -aatbt; -aatbu; -aatbv; -aatbw; -aatbx; -aatby; -aatbz; -aatca; -aatcb; -aatcc; -aatcd; -aatce; -aatcf; -aatcg; -aatch; -aatci; -aatcj; -aatck; -aatcl; -aatcm; -aatcn; -aatco; -aatcp; -aatcq; -aatcr; -aatcs; -aatct; -aatcu; -aatcv; -aatcw; -aatcx; -aatcy; -aatcz; -aatda; -aatdb; -aatdc; -aatdd; -aatde; -aatdf; -aatdg; -aatdh; -aatdi; -aatdj; -aatdk; -aatdl; -aatdm; -aatdn; -aatdo; -aatdp; -aatdq; -aatdr; -aatds; -aatdt; -aatdu; -aatdv; -aatdw; -aatdx; -aatdy; -aatdz; -aatea; -aateb; -aatec; -aated; -aatee; -aatef; -aateg; -aateh; -aatei; -aatej; -aatek; -aatel; -aatem; -aaten; -aateo; -aatep; -aateq; -aater; -aates; -aatet; -aateu; -aatev; -aatew; -aatex; -aatey; -aatez; -aatfa; -aatfb; -aatfc; -aatfd; -aatfe; -aatff; -aatfg; -aatfh; -aatfi; -aatfj; -aatfk; -aatfl; -aatfm; -aatfn; -aatfo; -aatfp; -aatfq; -aatfr; -aatfs; -aatft; -aatfu; -aatfv; -aatfw; -aatfx; -aatfy; -aatfz; -aatga; -aatgb; -aatgc; -aatgd; -aatge; -aatgf; -aatgg; -aatgh; -aatgi; -aatgj; -aatgk; -aatgl; -aatgm; -aatgn; -aatgo; -aatgp; -aatgq; -aatgr; -aatgs; -aatgt; -aatgu; -aatgv; -aatgw; -aatgx; -aatgy; -aatgz; -aatha; -aathb; -aathc; -aathd; -aathe; -aathf; -aathg; -aathh; -aathi; -aathj; -aathk; -aathl; -aathm; -aathn; -aatho; -aathp; -aathq; -aathr; -aaths; -aatht; -aathu; -aathv; -aathw; -aathx; -aathy; -aathz; -aatia; -aatib; -aatic; -aatid; -aatie; -aatif; -aatig; -aatih; -aatii; -aatij; -aatik; -aatil; -aatim; -aatin; -aatio; -aatip; -aatiq; -aatir; -aatis; -aatit; -aatiu; -aativ; -aatiw; -aatix; -aatiy; -aatiz; -aatja; -aatjb; -aatjc; -aatjd; -aatje; -aatjf; -aatjg; -aatjh; -aatji; -aatjj; -aatjk; -aatjl; -aatjm; -aatjn; -aatjo; -aatjp; -aatjq; -aatjr; -aatjs; -aatjt; -aatju; -aatjv; -aatjw; -aatjx; -aatjy; -aatjz; -aatka; -aatkb; -aatkc; -aatkd; -aatke; -aatkf; -aatkg; -aatkh; -aatki; -aatkj; -aatkk; -aatkl; -aatkm; -aatkn; -aatko; -aatkp; -aatkq; -aatkr; -aatks; -aatkt; -aatku; -aatkv; -aatkw; -aatkx; -aatky; -aatkz; -aatla; -aatlb; -aatlc; -aatld; -aatle; -aatlf; -aatlg; -aatlh; -aatli; -aatlj; -aatlk; -aatll; -aatlm; -aatln; -aatlo; -aatlp; -aatlq; -aatlr; -aatls; -aatlt; -aatlu; -aatlv; -aatlw; -aatlx; -aatly; -aatlz; -aatma; -aatmb; -aatmc; -aatmd; -aatme; -aatmf; -aatmg; -aatmh; -aatmi; -aatmj; -aatmk; -aatml; -aatmm; -aatmn; -aatmo; -aatmp; -aatmq; -aatmr; -aatms; -aatmt; -aatmu; -aatmv; -aatmw; -aatmx; -aatmy; -aatmz; -aatna; -aatnb; -aatnc; -aatnd; -aatne; -aatnf; -aatng; -aatnh; -aatni; -aatnj; -aatnk; -aatnl; -aatnm; -aatnn; -aatno; -aatnp; -aatnq; -aatnr; -aatns; -aatnt; -aatnu; -aatnv; -aatnw; -aatnx; -aatny; -aatnz; -aatoa; -aatob; -aatoc; -aatod; -aatoe; -aatof; -aatog; -aatoh; -aatoi; -aatoj; -aatok; -aatol; -aatom; -aaton; -aatoo; -aatop; -aatoq; -aator; -aatos; -aatot; -aatou; -aatov; -aatow; -aatox; -aatoy; -aatoz; -aatpa; -aatpb; -aatpc; -aatpd; -aatpe; -aatpf; -aatpg; -aatph; -aatpi; -aatpj; -aatpk; -aatpl; -aatpm; -aatpn; -aatpo; -aatpp; -aatpq; -aatpr; -aatps; -aatpt; -aatpu; -aatpv; -aatpw; -aatpx; -aatpy; -aatpz; -aatqa; -aatqb; -aatqc; -aatqd; -aatqe; -aatqf; -aatqg; -aatqh; -aatqi; -aatqj; -aatqk; -aatql; -aatqm; -aatqn; -aatqo; -aatqp; -aatqq; -aatqr; -aatqs; -aatqt; -aatqu; -aatqv; -aatqw; -aatqx; -aatqy; -aatqz; -aatra; -aatrb; -aatrc; -aatrd; -aatre; -aatrf; -aatrg; -aatrh; -aatri; -aatrj; -aatrk; -aatrl; -aatrm; -aatrn; -aatro; -aatrp; -aatrq; -aatrr; -aatrs; -aatrt; -aatru; -aatrv; -aatrw; -aatrx; -aatry; -aatrz; -aatsa; -aatsb; -aatsc; -aatsd; -aatse; -aatsf; -aatsg; -aatsh; -aatsi; -aatsj; -aatsk; -aatsl; -aatsm; -aatsn; -aatso; -aatsp; -aatsq; -aatsr; -aatss; -aatst; -aatsu; -aatsv; -aatsw; -aatsx; -aatsy; -aatsz; -aatta; -aattb; -aattc; -aattd; -aatte; -aattf; -aattg; -aatth; -aatti; -aattj; -aattk; -aattl; -aattm; -aattn; -aatto; -aattp; -aattq; -aattr; -aatts; -aattt; -aattu; -aattv; -aattw; -aattx; -aatty; -aattz; -aatua; -aatub; -aatuc; -aatud; -aatue; -aatuf; -aatug; -aatuh; -aatui; -aatuj; -aatuk; -aatul; -aatum; -aatun; -aatuo; -aatup; -aatuq; -aatur; -aatus; -aatut; -aatuu; -aatuv; -aatuw; -aatux; -aatuy; -aatuz; -aatva; -aatvb; -aatvc; -aatvd; -aatve; -aatvf; -aatvg; -aatvh; -aatvi; -aatvj; -aatvk; -aatvl; -aatvm; -aatvn; -aatvo; -aatvp; -aatvq; -aatvr; -aatvs; -aatvt; -aatvu; -aatvv; -aatvw; -aatvx; -aatvy; -aatvz; -aatwa; -aatwb; -aatwc; -aatwd; -aatwe; -aatwf; -aatwg; -aatwh; -aatwi; -aatwj; -aatwk; -aatwl; -aatwm; -aatwn; -aatwo; -aatwp; -aatwq; -aatwr; -aatws; -aatwt; -aatwu; -aatwv; -aatww; -aatwx; -aatwy; -aatwz; -aatxa; -aatxb; -aatxc; -aatxd; -aatxe; -aatxf; -aatxg; -aatxh; -aatxi; -aatxj; -aatxk; -aatxl; -aatxm; -aatxn; -aatxo; -aatxp; -aatxq; -aatxr; -aatxs; -aatxt; -aatxu; -aatxv; -aatxw; -aatxx; -aatxy; -aatxz; -aatya; -aatyb; -aatyc; -aatyd; -aatye; -aatyf; -aatyg; -aatyh; -aatyi; -aatyj; -aatyk; -aatyl; -aatym; -aatyn; -aatyo; -aatyp; -aatyq; -aatyr; -aatys; -aatyt; -aatyu; -aatyv; -aatyw; -aatyx; -aatyy; -aatyz; -aatza; -aatzb; -aatzc; -aatzd; -aatze; -aatzf; -aatzg; -aatzh; -aatzi; -aatzj; -aatzk; -aatzl; -aatzm; -aatzn; -aatzo; -aatzp; -aatzq; -aatzr; -aatzs; -aatzt; -aatzu; -aatzv; -aatzw; -aatzx; -aatzy; -aatzz; -aauaa; -aauab; -aauac; -aauad; -aauae; -aauaf; -aauag; -aauah; -aauai; -aauaj; -aauak; -aaual; -aauam; -aauan; -aauao; -aauap; -aauaq; -aauar; -aauas; -aauat; -aauau; -aauav; -aauaw; -aauax; -aauay; -aauaz; -aauba; -aaubb; -aaubc; -aaubd; -aaube; -aaubf; -aaubg; -aaubh; -aaubi; -aaubj; -aaubk; -aaubl; -aaubm; -aaubn; -aaubo; -aaubp; -aaubq; -aaubr; -aaubs; -aaubt; -aaubu; -aaubv; -aaubw; -aaubx; -aauby; -aaubz; -aauca; -aaucb; -aaucc; -aaucd; -aauce; -aaucf; -aaucg; -aauch; -aauci; -aaucj; -aauck; -aaucl; -aaucm; -aaucn; -aauco; -aaucp; -aaucq; -aaucr; -aaucs; -aauct; -aaucu; -aaucv; -aaucw; -aaucx; -aaucy; -aaucz; -aauda; -aaudb; -aaudc; -aaudd; -aaude; -aaudf; -aaudg; -aaudh; -aaudi; -aaudj; -aaudk; -aaudl; -aaudm; -aaudn; -aaudo; -aaudp; -aaudq; -aaudr; -aauds; -aaudt; -aaudu; -aaudv; -aaudw; -aaudx; -aaudy; -aaudz; -aauea; -aaueb; -aauec; -aaued; -aauee; -aauef; -aaueg; -aaueh; -aauei; -aauej; -aauek; -aauel; -aauem; -aauen; -aaueo; -aauep; -aaueq; -aauer; -aaues; -aauet; -aaueu; -aauev; -aauew; -aauex; -aauey; -aauez; -aaufa; -aaufb; -aaufc; -aaufd; -aaufe; -aauff; -aaufg; -aaufh; -aaufi; -aaufj; -aaufk; -aaufl; -aaufm; -aaufn; -aaufo; -aaufp; -aaufq; -aaufr; -aaufs; -aauft; -aaufu; -aaufv; -aaufw; -aaufx; -aaufy; -aaufz; -aauga; -aaugb; -aaugc; -aaugd; -aauge; -aaugf; -aaugg; -aaugh; -aaugi; -aaugj; -aaugk; -aaugl; -aaugm; -aaugn; -aaugo; -aaugp; -aaugq; -aaugr; -aaugs; -aaugt; -aaugu; -aaugv; -aaugw; -aaugx; -aaugy; -aaugz; -aauha; -aauhb; -aauhc; -aauhd; -aauhe; -aauhf; -aauhg; -aauhh; -aauhi; -aauhj; -aauhk; -aauhl; -aauhm; -aauhn; -aauho; -aauhp; -aauhq; -aauhr; -aauhs; -aauht; -aauhu; -aauhv; -aauhw; -aauhx; -aauhy; -aauhz; -aauia; -aauib; -aauic; -aauid; -aauie; -aauif; -aauig; -aauih; -aauii; -aauij; -aauik; -aauil; -aauim; -aauin; -aauio; -aauip; -aauiq; -aauir; -aauis; -aauit; -aauiu; -aauiv; -aauiw; -aauix; -aauiy; -aauiz; -aauja; -aaujb; -aaujc; -aaujd; -aauje; -aaujf; -aaujg; -aaujh; -aauji; -aaujj; -aaujk; -aaujl; -aaujm; -aaujn; -aaujo; -aaujp; -aaujq; -aaujr; -aaujs; -aaujt; -aauju; -aaujv; -aaujw; -aaujx; -aaujy; -aaujz; -aauka; -aaukb; -aaukc; -aaukd; -aauke; -aaukf; -aaukg; -aaukh; -aauki; -aaukj; -aaukk; -aaukl; -aaukm; -aaukn; -aauko; -aaukp; -aaukq; -aaukr; -aauks; -aaukt; -aauku; -aaukv; -aaukw; -aaukx; -aauky; -aaukz; -aaula; -aaulb; -aaulc; -aauld; -aaule; -aaulf; -aaulg; -aaulh; -aauli; -aaulj; -aaulk; -aaull; -aaulm; -aauln; -aaulo; -aaulp; -aaulq; -aaulr; -aauls; -aault; -aaulu; -aaulv; -aaulw; -aaulx; -aauly; -aaulz; -aauma; -aaumb; -aaumc; -aaumd; -aaume; -aaumf; -aaumg; -aaumh; -aaumi; -aaumj; -aaumk; -aauml; -aaumm; -aaumn; -aaumo; -aaump; -aaumq; -aaumr; -aaums; -aaumt; -aaumu; -aaumv; -aaumw; -aaumx; -aaumy; -aaumz; -aauna; -aaunb; -aaunc; -aaund; -aaune; -aaunf; -aaung; -aaunh; -aauni; -aaunj; -aaunk; -aaunl; -aaunm; -aaunn; -aauno; -aaunp; -aaunq; -aaunr; -aauns; -aaunt; -aaunu; -aaunv; -aaunw; -aaunx; -aauny; -aaunz; -aauoa; -aauob; -aauoc; -aauod; -aauoe; -aauof; -aauog; -aauoh; -aauoi; -aauoj; -aauok; -aauol; -aauom; -aauon; -aauoo; -aauop; -aauoq; -aauor; -aauos; -aauot; -aauou; -aauov; -aauow; -aauox; -aauoy; -aauoz; -aaupa; -aaupb; -aaupc; -aaupd; -aaupe; -aaupf; -aaupg; -aauph; -aaupi; -aaupj; -aaupk; -aaupl; -aaupm; -aaupn; -aaupo; -aaupp; -aaupq; -aaupr; -aaups; -aaupt; -aaupu; -aaupv; -aaupw; -aaupx; -aaupy; -aaupz; -aauqa; -aauqb; -aauqc; -aauqd; -aauqe; -aauqf; -aauqg; -aauqh; -aauqi; -aauqj; -aauqk; -aauql; -aauqm; -aauqn; -aauqo; -aauqp; -aauqq; -aauqr; -aauqs; -aauqt; -aauqu; -aauqv; -aauqw; -aauqx; -aauqy; -aauqz; -aaura; -aaurb; -aaurc; -aaurd; -aaure; -aaurf; -aaurg; -aaurh; -aauri; -aaurj; -aaurk; -aaurl; -aaurm; -aaurn; -aauro; -aaurp; -aaurq; -aaurr; -aaurs; -aaurt; -aauru; -aaurv; -aaurw; -aaurx; -aaury; -aaurz; -aausa; -aausb; -aausc; -aausd; -aause; -aausf; -aausg; -aaush; -aausi; -aausj; -aausk; -aausl; -aausm; -aausn; -aauso; -aausp; -aausq; -aausr; -aauss; -aaust; -aausu; -aausv; -aausw; -aausx; -aausy; -aausz; -aauta; -aautb; -aautc; -aautd; -aaute; -aautf; -aautg; -aauth; -aauti; -aautj; -aautk; -aautl; -aautm; -aautn; -aauto; -aautp; -aautq; -aautr; -aauts; -aautt; -aautu; -aautv; -aautw; -aautx; -aauty; -aautz; -aauua; -aauub; -aauuc; -aauud; -aauue; -aauuf; -aauug; -aauuh; -aauui; -aauuj; -aauuk; -aauul; -aauum; -aauun; -aauuo; -aauup; -aauuq; -aauur; -aauus; -aauut; -aauuu; -aauuv; -aauuw; -aauux; -aauuy; -aauuz; -aauva; -aauvb; -aauvc; -aauvd; -aauve; -aauvf; -aauvg; -aauvh; -aauvi; -aauvj; -aauvk; -aauvl; -aauvm; -aauvn; -aauvo; -aauvp; -aauvq; -aauvr; -aauvs; -aauvt; -aauvu; -aauvv; -aauvw; -aauvx; -aauvy; -aauvz; -aauwa; -aauwb; -aauwc; -aauwd; -aauwe; -aauwf; -aauwg; -aauwh; -aauwi; -aauwj; -aauwk; -aauwl; -aauwm; -aauwn; -aauwo; -aauwp; -aauwq; -aauwr; -aauws; -aauwt; -aauwu; -aauwv; -aauww; -aauwx; -aauwy; -aauwz; -aauxa; -aauxb; -aauxc; -aauxd; -aauxe; -aauxf; -aauxg; -aauxh; -aauxi; -aauxj; -aauxk; -aauxl; -aauxm; -aauxn; -aauxo; -aauxp; -aauxq; -aauxr; -aauxs; -aauxt; -aauxu; -aauxv; -aauxw; -aauxx; -aauxy; -aauxz; -aauya; -aauyb; -aauyc; -aauyd; -aauye; -aauyf; -aauyg; -aauyh; -aauyi; -aauyj; -aauyk; -aauyl; -aauym; -aauyn; -aauyo; -aauyp; -aauyq; -aauyr; -aauys; -aauyt; -aauyu; -aauyv; -aauyw; -aauyx; -aauyy; -aauyz; -aauza; -aauzb; -aauzc; -aauzd; -aauze; -aauzf; -aauzg; -aauzh; -aauzi; -aauzj; -aauzk; -aauzl; -aauzm; -aauzn; -aauzo; -aauzp; -aauzq; -aauzr; -aauzs; -aauzt; -aauzu; -aauzv; -aauzw; -aauzx; -aauzy; -aauzz; -aavaa; -aavab; -aavac; -aavad; -aavae; -aavaf; -aavag; -aavah; -aavai; -aavaj; -aavak; -aaval; -aavam; -aavan; -aavao; -aavap; -aavaq; -aavar; -aavas; -aavat; -aavau; -aavav; -aavaw; -aavax; -aavay; -aavaz; -aavba; -aavbb; -aavbc; -aavbd; -aavbe; -aavbf; -aavbg; -aavbh; -aavbi; -aavbj; -aavbk; -aavbl; -aavbm; -aavbn; -aavbo; -aavbp; -aavbq; -aavbr; -aavbs; -aavbt; -aavbu; -aavbv; -aavbw; -aavbx; -aavby; -aavbz; -aavca; -aavcb; -aavcc; -aavcd; -aavce; -aavcf; -aavcg; -aavch; -aavci; -aavcj; -aavck; -aavcl; -aavcm; -aavcn; -aavco; -aavcp; -aavcq; -aavcr; -aavcs; -aavct; -aavcu; -aavcv; -aavcw; -aavcx; -aavcy; -aavcz; -aavda; -aavdb; -aavdc; -aavdd; -aavde; -aavdf; -aavdg; -aavdh; -aavdi; -aavdj; -aavdk; -aavdl; -aavdm; -aavdn; -aavdo; -aavdp; -aavdq; -aavdr; -aavds; -aavdt; -aavdu; -aavdv; -aavdw; -aavdx; -aavdy; -aavdz; -aavea; -aaveb; -aavec; -aaved; -aavee; -aavef; -aaveg; -aaveh; -aavei; -aavej; -aavek; -aavel; -aavem; -aaven; -aaveo; -aavep; -aaveq; -aaver; -aaves; -aavet; -aaveu; -aavev; -aavew; -aavex; -aavey; -aavez; -aavfa; -aavfb; -aavfc; -aavfd; -aavfe; -aavff; -aavfg; -aavfh; -aavfi; -aavfj; -aavfk; -aavfl; -aavfm; -aavfn; -aavfo; -aavfp; -aavfq; -aavfr; -aavfs; -aavft; -aavfu; -aavfv; -aavfw; -aavfx; -aavfy; -aavfz; -aavga; -aavgb; -aavgc; -aavgd; -aavge; -aavgf; -aavgg; -aavgh; -aavgi; -aavgj; -aavgk; -aavgl; -aavgm; -aavgn; -aavgo; -aavgp; -aavgq; -aavgr; -aavgs; -aavgt; -aavgu; -aavgv; -aavgw; -aavgx; -aavgy; -aavgz; -aavha; -aavhb; -aavhc; -aavhd; -aavhe; -aavhf; -aavhg; -aavhh; -aavhi; -aavhj; -aavhk; -aavhl; -aavhm; -aavhn; -aavho; -aavhp; -aavhq; -aavhr; -aavhs; -aavht; -aavhu; -aavhv; -aavhw; -aavhx; -aavhy; -aavhz; -aavia; -aavib; -aavic; -aavid; -aavie; -aavif; -aavig; -aavih; -aavii; -aavij; -aavik; -aavil; -aavim; -aavin; -aavio; -aavip; -aaviq; -aavir; -aavis; -aavit; -aaviu; -aaviv; -aaviw; -aavix; -aaviy; -aaviz; -aavja; -aavjb; -aavjc; -aavjd; -aavje; -aavjf; -aavjg; -aavjh; -aavji; -aavjj; -aavjk; -aavjl; -aavjm; -aavjn; -aavjo; -aavjp; -aavjq; -aavjr; -aavjs; -aavjt; -aavju; -aavjv; -aavjw; -aavjx; -aavjy; -aavjz; -aavka; -aavkb; -aavkc; -aavkd; -aavke; -aavkf; -aavkg; -aavkh; -aavki; -aavkj; -aavkk; -aavkl; -aavkm; -aavkn; -aavko; -aavkp; -aavkq; -aavkr; -aavks; -aavkt; -aavku; -aavkv; -aavkw; -aavkx; -aavky; -aavkz; -aavla; -aavlb; -aavlc; -aavld; -aavle; -aavlf; -aavlg; -aavlh; -aavli; -aavlj; -aavlk; -aavll; -aavlm; -aavln; -aavlo; -aavlp; -aavlq; -aavlr; -aavls; -aavlt; -aavlu; -aavlv; -aavlw; -aavlx; -aavly; -aavlz; -aavma; -aavmb; -aavmc; -aavmd; -aavme; -aavmf; -aavmg; -aavmh; -aavmi; -aavmj; -aavmk; -aavml; -aavmm; -aavmn; -aavmo; -aavmp; -aavmq; -aavmr; -aavms; -aavmt; -aavmu; -aavmv; -aavmw; -aavmx; -aavmy; -aavmz; -aavna; -aavnb; -aavnc; -aavnd; -aavne; -aavnf; -aavng; -aavnh; -aavni; -aavnj; -aavnk; -aavnl; -aavnm; -aavnn; -aavno; -aavnp; -aavnq; -aavnr; -aavns; -aavnt; -aavnu; -aavnv; -aavnw; -aavnx; -aavny; -aavnz; -aavoa; -aavob; -aavoc; -aavod; -aavoe; -aavof; -aavog; -aavoh; -aavoi; -aavoj; -aavok; -aavol; -aavom; -aavon; -aavoo; -aavop; -aavoq; -aavor; -aavos; -aavot; -aavou; -aavov; -aavow; -aavox; -aavoy; -aavoz; -aavpa; -aavpb; -aavpc; -aavpd; -aavpe; -aavpf; -aavpg; -aavph; -aavpi; -aavpj; -aavpk; -aavpl; -aavpm; -aavpn; -aavpo; -aavpp; -aavpq; -aavpr; -aavps; -aavpt; -aavpu; -aavpv; -aavpw; -aavpx; -aavpy; -aavpz; -aavqa; -aavqb; -aavqc; -aavqd; -aavqe; -aavqf; -aavqg; -aavqh; -aavqi; -aavqj; -aavqk; -aavql; -aavqm; -aavqn; -aavqo; -aavqp; -aavqq; -aavqr; -aavqs; -aavqt; -aavqu; -aavqv; -aavqw; -aavqx; -aavqy; -aavqz; -aavra; -aavrb; -aavrc; -aavrd; -aavre; -aavrf; -aavrg; -aavrh; -aavri; -aavrj; -aavrk; -aavrl; -aavrm; -aavrn; -aavro; -aavrp; -aavrq; -aavrr; -aavrs; -aavrt; -aavru; -aavrv; -aavrw; -aavrx; -aavry; -aavrz; -aavsa; -aavsb; -aavsc; -aavsd; -aavse; -aavsf; -aavsg; -aavsh; -aavsi; -aavsj; -aavsk; -aavsl; -aavsm; -aavsn; -aavso; -aavsp; -aavsq; -aavsr; -aavss; -aavst; -aavsu; -aavsv; -aavsw; -aavsx; -aavsy; -aavsz; -aavta; -aavtb; -aavtc; -aavtd; -aavte; -aavtf; -aavtg; -aavth; -aavti; -aavtj; -aavtk; -aavtl; -aavtm; -aavtn; -aavto; -aavtp; -aavtq; -aavtr; -aavts; -aavtt; -aavtu; -aavtv; -aavtw; -aavtx; -aavty; -aavtz; -aavua; -aavub; -aavuc; -aavud; -aavue; -aavuf; -aavug; -aavuh; -aavui; -aavuj; -aavuk; -aavul; -aavum; -aavun; -aavuo; -aavup; -aavuq; -aavur; -aavus; -aavut; -aavuu; -aavuv; -aavuw; -aavux; -aavuy; -aavuz; -aavva; -aavvb; -aavvc; -aavvd; -aavve; -aavvf; -aavvg; -aavvh; -aavvi; -aavvj; -aavvk; -aavvl; -aavvm; -aavvn; -aavvo; -aavvp; -aavvq; -aavvr; -aavvs; -aavvt; -aavvu; -aavvv; -aavvw; -aavvx; -aavvy; -aavvz; -aavwa; -aavwb; -aavwc; -aavwd; -aavwe; -aavwf; -aavwg; -aavwh; -aavwi; -aavwj; -aavwk; -aavwl; -aavwm; -aavwn; -aavwo; -aavwp; -aavwq; -aavwr; -aavws; -aavwt; -aavwu; -aavwv; -aavww; -aavwx; -aavwy; -aavwz; -aavxa; -aavxb; -aavxc; -aavxd; -aavxe; -aavxf; -aavxg; -aavxh; -aavxi; -aavxj; -aavxk; -aavxl; -aavxm; -aavxn; -aavxo; -aavxp; -aavxq; -aavxr; -aavxs; -aavxt; -aavxu; -aavxv; -aavxw; -aavxx; -aavxy; -aavxz; -aavya; -aavyb; -aavyc; -aavyd; -aavye; -aavyf; -aavyg; -aavyh; -aavyi; -aavyj; -aavyk; -aavyl; -aavym; -aavyn; -aavyo; -aavyp; -aavyq; -aavyr; -aavys; -aavyt; -aavyu; -aavyv; -aavyw; -aavyx; -aavyy; -aavyz; -aavza; -aavzb; -aavzc; -aavzd; -aavze; -aavzf; -aavzg; -aavzh; -aavzi; -aavzj; -aavzk; -aavzl; -aavzm; -aavzn; -aavzo; -aavzp; -aavzq; -aavzr; -aavzs; -aavzt; -aavzu; -aavzv; -aavzw; -aavzx; -aavzy; -aavzz; -aawaa; -aawab; -aawac; -aawad; -aawae; -aawaf; -aawag; -aawah; -aawai; -aawaj; -aawak; -aawal; -aawam; -aawan; -aawao; -aawap; -aawaq; -aawar; -aawas; -aawat; -aawau; -aawav; -aawaw; -aawax; -aaway; -aawaz; -aawba; -aawbb; -aawbc; -aawbd; -aawbe; -aawbf; -aawbg; -aawbh; -aawbi; -aawbj; -aawbk; -aawbl; -aawbm; -aawbn; -aawbo; -aawbp; -aawbq; -aawbr; -aawbs; -aawbt; -aawbu; -aawbv; -aawbw; -aawbx; -aawby; -aawbz; -aawca; -aawcb; -aawcc; -aawcd; -aawce; -aawcf; -aawcg; -aawch; -aawci; -aawcj; -aawck; -aawcl; -aawcm; -aawcn; -aawco; -aawcp; -aawcq; -aawcr; -aawcs; -aawct; -aawcu; -aawcv; -aawcw; -aawcx; -aawcy; -aawcz; -aawda; -aawdb; -aawdc; -aawdd; -aawde; -aawdf; -aawdg; -aawdh; -aawdi; -aawdj; -aawdk; -aawdl; -aawdm; -aawdn; -aawdo; -aawdp; -aawdq; -aawdr; -aawds; -aawdt; -aawdu; -aawdv; -aawdw; -aawdx; -aawdy; -aawdz; -aawea; -aaweb; -aawec; -aawed; -aawee; -aawef; -aaweg; -aaweh; -aawei; -aawej; -aawek; -aawel; -aawem; -aawen; -aaweo; -aawep; -aaweq; -aawer; -aawes; -aawet; -aaweu; -aawev; -aawew; -aawex; -aawey; -aawez; -aawfa; -aawfb; -aawfc; -aawfd; -aawfe; -aawff; -aawfg; -aawfh; -aawfi; -aawfj; -aawfk; -aawfl; -aawfm; -aawfn; -aawfo; -aawfp; -aawfq; -aawfr; -aawfs; -aawft; -aawfu; -aawfv; -aawfw; -aawfx; -aawfy; -aawfz; -aawga; -aawgb; -aawgc; -aawgd; -aawge; -aawgf; -aawgg; -aawgh; -aawgi; -aawgj; -aawgk; -aawgl; -aawgm; -aawgn; -aawgo; -aawgp; -aawgq; -aawgr; -aawgs; -aawgt; -aawgu; -aawgv; -aawgw; -aawgx; -aawgy; -aawgz; -aawha; -aawhb; -aawhc; -aawhd; -aawhe; -aawhf; -aawhg; -aawhh; -aawhi; -aawhj; -aawhk; -aawhl; -aawhm; -aawhn; -aawho; -aawhp; -aawhq; -aawhr; -aawhs; -aawht; -aawhu; -aawhv; -aawhw; -aawhx; -aawhy; -aawhz; -aawia; -aawib; -aawic; -aawid; -aawie; -aawif; -aawig; -aawih; -aawii; -aawij; -aawik; -aawil; -aawim; -aawin; -aawio; -aawip; -aawiq; -aawir; -aawis; -aawit; -aawiu; -aawiv; -aawiw; -aawix; -aawiy; -aawiz; -aawja; -aawjb; -aawjc; -aawjd; -aawje; -aawjf; -aawjg; -aawjh; -aawji; -aawjj; -aawjk; -aawjl; -aawjm; -aawjn; -aawjo; -aawjp; -aawjq; -aawjr; -aawjs; -aawjt; -aawju; -aawjv; -aawjw; -aawjx; -aawjy; -aawjz; -aawka; -aawkb; -aawkc; -aawkd; -aawke; -aawkf; -aawkg; -aawkh; -aawki; -aawkj; -aawkk; -aawkl; -aawkm; -aawkn; -aawko; -aawkp; -aawkq; -aawkr; -aawks; -aawkt; -aawku; -aawkv; -aawkw; -aawkx; -aawky; -aawkz; -aawla; -aawlb; -aawlc; -aawld; -aawle; -aawlf; -aawlg; -aawlh; -aawli; -aawlj; -aawlk; -aawll; -aawlm; -aawln; -aawlo; -aawlp; -aawlq; -aawlr; -aawls; -aawlt; -aawlu; -aawlv; -aawlw; -aawlx; -aawly; -aawlz; -aawma; -aawmb; -aawmc; -aawmd; -aawme; -aawmf; -aawmg; -aawmh; -aawmi; -aawmj; -aawmk; -aawml; -aawmm; -aawmn; -aawmo; -aawmp; -aawmq; -aawmr; -aawms; -aawmt; -aawmu; -aawmv; -aawmw; -aawmx; -aawmy; -aawmz; -aawna; -aawnb; -aawnc; -aawnd; -aawne; -aawnf; -aawng; -aawnh; -aawni; -aawnj; -aawnk; -aawnl; -aawnm; -aawnn; -aawno; -aawnp; -aawnq; -aawnr; -aawns; -aawnt; -aawnu; -aawnv; -aawnw; -aawnx; -aawny; -aawnz; -aawoa; -aawob; -aawoc; -aawod; -aawoe; -aawof; -aawog; -aawoh; -aawoi; -aawoj; -aawok; -aawol; -aawom; -aawon; -aawoo; -aawop; -aawoq; -aawor; -aawos; -aawot; -aawou; -aawov; -aawow; -aawox; -aawoy; -aawoz; -aawpa; -aawpb; -aawpc; -aawpd; -aawpe; -aawpf; -aawpg; -aawph; -aawpi; -aawpj; -aawpk; -aawpl; -aawpm; -aawpn; -aawpo; -aawpp; -aawpq; -aawpr; -aawps; -aawpt; -aawpu; -aawpv; -aawpw; -aawpx; -aawpy; -aawpz; -aawqa; -aawqb; -aawqc; -aawqd; -aawqe; -aawqf; -aawqg; -aawqh; -aawqi; -aawqj; -aawqk; -aawql; -aawqm; -aawqn; -aawqo; -aawqp; -aawqq; -aawqr; -aawqs; -aawqt; -aawqu; -aawqv; -aawqw; -aawqx; -aawqy; -aawqz; -aawra; -aawrb; -aawrc; -aawrd; -aawre; -aawrf; -aawrg; -aawrh; -aawri; -aawrj; -aawrk; -aawrl; -aawrm; -aawrn; -aawro; -aawrp; -aawrq; -aawrr; -aawrs; -aawrt; -aawru; -aawrv; -aawrw; -aawrx; -aawry; -aawrz; -aawsa; -aawsb; -aawsc; -aawsd; -aawse; -aawsf; -aawsg; -aawsh; -aawsi; -aawsj; -aawsk; -aawsl; -aawsm; -aawsn; -aawso; -aawsp; -aawsq; -aawsr; -aawss; -aawst; -aawsu; -aawsv; -aawsw; -aawsx; -aawsy; -aawsz; -aawta; -aawtb; -aawtc; -aawtd; -aawte; -aawtf; -aawtg; -aawth; -aawti; -aawtj; -aawtk; -aawtl; -aawtm; -aawtn; -aawto; -aawtp; -aawtq; -aawtr; -aawts; -aawtt; -aawtu; -aawtv; -aawtw; -aawtx; -aawty; -aawtz; -aawua; -aawub; -aawuc; -aawud; -aawue; -aawuf; -aawug; -aawuh; -aawui; -aawuj; -aawuk; -aawul; -aawum; -aawun; -aawuo; -aawup; -aawuq; -aawur; -aawus; -aawut; -aawuu; -aawuv; -aawuw; -aawux; -aawuy; -aawuz; -aawva; -aawvb; -aawvc; -aawvd; -aawve; -aawvf; -aawvg; -aawvh; -aawvi; -aawvj; -aawvk; -aawvl; -aawvm; -aawvn; -aawvo; -aawvp; -aawvq; -aawvr; -aawvs; -aawvt; -aawvu; -aawvv; -aawvw; -aawvx; -aawvy; -aawvz; -aawwa; -aawwb; -aawwc; -aawwd; -aawwe; -aawwf; -aawwg; -aawwh; -aawwi; -aawwj; -aawwk; -aawwl; -aawwm; -aawwn; -aawwo; -aawwp; -aawwq; -aawwr; -aawws; -aawwt; -aawwu; -aawwv; -aawww; -aawwx; -aawwy; -aawwz; -aawxa; -aawxb; -aawxc; -aawxd; -aawxe; -aawxf; -aawxg; -aawxh; -aawxi; -aawxj; -aawxk; -aawxl; -aawxm; -aawxn; -aawxo; -aawxp; -aawxq; -aawxr; -aawxs; -aawxt; -aawxu; -aawxv; -aawxw; -aawxx; -aawxy; -aawxz; -aawya; -aawyb; -aawyc; -aawyd; -aawye; -aawyf; -aawyg; -aawyh; -aawyi; -aawyj; -aawyk; -aawyl; -aawym; -aawyn; -aawyo; -aawyp; -aawyq; -aawyr; -aawys; -aawyt; -aawyu; -aawyv; -aawyw; -aawyx; -aawyy; -aawyz; -aawza; -aawzb; -aawzc; -aawzd; -aawze; -aawzf; -aawzg; -aawzh; -aawzi; -aawzj; -aawzk; -aawzl; -aawzm; -aawzn; -aawzo; -aawzp; -aawzq; -aawzr; -aawzs; -aawzt; -aawzu; -aawzv; -aawzw; -aawzx; -aawzy; -aawzz; -aaxaa; -aaxab; -aaxac; -aaxad; -aaxae; -aaxaf; -aaxag; -aaxah; -aaxai; -aaxaj; -aaxak; -aaxal; -aaxam; -aaxan; -aaxao; -aaxap; -aaxaq; -aaxar; -aaxas; -aaxat; -aaxau; -aaxav; -aaxaw; -aaxax; -aaxay; -aaxaz; -aaxba; -aaxbb; -aaxbc; -aaxbd; -aaxbe; -aaxbf; -aaxbg; -aaxbh; -aaxbi; -aaxbj; -aaxbk; -aaxbl; -aaxbm; -aaxbn; -aaxbo; -aaxbp; -aaxbq; -aaxbr; -aaxbs; -aaxbt; -aaxbu; -aaxbv; -aaxbw; -aaxbx; -aaxby; -aaxbz; -aaxca; -aaxcb; -aaxcc; -aaxcd; -aaxce; -aaxcf; -aaxcg; -aaxch; -aaxci; -aaxcj; -aaxck; -aaxcl; -aaxcm; -aaxcn; -aaxco; -aaxcp; -aaxcq; -aaxcr; -aaxcs; -aaxct; -aaxcu; -aaxcv; -aaxcw; -aaxcx; -aaxcy; -aaxcz; -aaxda; -aaxdb; -aaxdc; -aaxdd; -aaxde; -aaxdf; -aaxdg; -aaxdh; -aaxdi; -aaxdj; -aaxdk; -aaxdl; -aaxdm; -aaxdn; -aaxdo; -aaxdp; -aaxdq; -aaxdr; -aaxds; -aaxdt; -aaxdu; -aaxdv; -aaxdw; -aaxdx; -aaxdy; -aaxdz; -aaxea; -aaxeb; -aaxec; -aaxed; -aaxee; -aaxef; -aaxeg; -aaxeh; -aaxei; -aaxej; -aaxek; -aaxel; -aaxem; -aaxen; -aaxeo; -aaxep; -aaxeq; -aaxer; -aaxes; -aaxet; -aaxeu; -aaxev; -aaxew; -aaxex; -aaxey; -aaxez; -aaxfa; -aaxfb; -aaxfc; -aaxfd; -aaxfe; -aaxff; -aaxfg; -aaxfh; -aaxfi; -aaxfj; -aaxfk; -aaxfl; -aaxfm; -aaxfn; -aaxfo; -aaxfp; -aaxfq; -aaxfr; -aaxfs; -aaxft; -aaxfu; -aaxfv; -aaxfw; -aaxfx; -aaxfy; -aaxfz; -aaxga; -aaxgb; -aaxgc; -aaxgd; -aaxge; -aaxgf; -aaxgg; -aaxgh; -aaxgi; -aaxgj; -aaxgk; -aaxgl; -aaxgm; -aaxgn; -aaxgo; -aaxgp; -aaxgq; -aaxgr; -aaxgs; -aaxgt; -aaxgu; -aaxgv; -aaxgw; -aaxgx; -aaxgy; -aaxgz; -aaxha; -aaxhb; -aaxhc; -aaxhd; -aaxhe; -aaxhf; -aaxhg; -aaxhh; -aaxhi; -aaxhj; -aaxhk; -aaxhl; -aaxhm; -aaxhn; -aaxho; -aaxhp; -aaxhq; -aaxhr; -aaxhs; -aaxht; -aaxhu; -aaxhv; -aaxhw; -aaxhx; -aaxhy; -aaxhz; -aaxia; -aaxib; -aaxic; -aaxid; -aaxie; -aaxif; -aaxig; -aaxih; -aaxii; -aaxij; -aaxik; -aaxil; -aaxim; -aaxin; -aaxio; -aaxip; -aaxiq; -aaxir; -aaxis; -aaxit; -aaxiu; -aaxiv; -aaxiw; -aaxix; -aaxiy; -aaxiz; -aaxja; -aaxjb; -aaxjc; -aaxjd; -aaxje; -aaxjf; -aaxjg; -aaxjh; -aaxji; -aaxjj; -aaxjk; -aaxjl; -aaxjm; -aaxjn; -aaxjo; -aaxjp; -aaxjq; -aaxjr; -aaxjs; -aaxjt; -aaxju; -aaxjv; -aaxjw; -aaxjx; -aaxjy; -aaxjz; -aaxka; -aaxkb; -aaxkc; -aaxkd; -aaxke; -aaxkf; -aaxkg; -aaxkh; -aaxki; -aaxkj; -aaxkk; -aaxkl; -aaxkm; -aaxkn; -aaxko; -aaxkp; -aaxkq; -aaxkr; -aaxks; -aaxkt; -aaxku; -aaxkv; -aaxkw; -aaxkx; -aaxky; -aaxkz; -aaxla; -aaxlb; -aaxlc; -aaxld; -aaxle; -aaxlf; -aaxlg; -aaxlh; -aaxli; -aaxlj; -aaxlk; -aaxll; -aaxlm; -aaxln; -aaxlo; -aaxlp; -aaxlq; -aaxlr; -aaxls; -aaxlt; -aaxlu; -aaxlv; -aaxlw; -aaxlx; -aaxly; -aaxlz; -aaxma; -aaxmb; -aaxmc; -aaxmd; -aaxme; -aaxmf; -aaxmg; -aaxmh; -aaxmi; -aaxmj; -aaxmk; -aaxml; -aaxmm; -aaxmn; -aaxmo; -aaxmp; -aaxmq; -aaxmr; -aaxms; -aaxmt; -aaxmu; -aaxmv; -aaxmw; -aaxmx; -aaxmy; -aaxmz; -aaxna; -aaxnb; -aaxnc; -aaxnd; -aaxne; -aaxnf; -aaxng; -aaxnh; -aaxni; -aaxnj; -aaxnk; -aaxnl; -aaxnm; -aaxnn; -aaxno; -aaxnp; -aaxnq; -aaxnr; -aaxns; -aaxnt; -aaxnu; -aaxnv; -aaxnw; -aaxnx; -aaxny; -aaxnz; -aaxoa; -aaxob; -aaxoc; -aaxod; -aaxoe; -aaxof; -aaxog; -aaxoh; -aaxoi; -aaxoj; -aaxok; -aaxol; -aaxom; -aaxon; -aaxoo; -aaxop; -aaxoq; -aaxor; -aaxos; -aaxot; -aaxou; -aaxov; -aaxow; -aaxox; -aaxoy; -aaxoz; -aaxpa; -aaxpb; -aaxpc; -aaxpd; -aaxpe; -aaxpf; -aaxpg; -aaxph; -aaxpi; -aaxpj; -aaxpk; -aaxpl; -aaxpm; -aaxpn; -aaxpo; -aaxpp; -aaxpq; -aaxpr; -aaxps; -aaxpt; -aaxpu; -aaxpv; -aaxpw; -aaxpx; -aaxpy; -aaxpz; -aaxqa; -aaxqb; -aaxqc; -aaxqd; -aaxqe; -aaxqf; -aaxqg; -aaxqh; -aaxqi; -aaxqj; -aaxqk; -aaxql; -aaxqm; -aaxqn; -aaxqo; -aaxqp; -aaxqq; -aaxqr; -aaxqs; -aaxqt; -aaxqu; -aaxqv; -aaxqw; -aaxqx; -aaxqy; -aaxqz; -aaxra; -aaxrb; -aaxrc; -aaxrd; -aaxre; -aaxrf; -aaxrg; -aaxrh; -aaxri; -aaxrj; -aaxrk; -aaxrl; -aaxrm; -aaxrn; -aaxro; -aaxrp; -aaxrq; -aaxrr; -aaxrs; -aaxrt; -aaxru; -aaxrv; -aaxrw; -aaxrx; -aaxry; -aaxrz; -aaxsa; -aaxsb; -aaxsc; -aaxsd; -aaxse; -aaxsf; -aaxsg; -aaxsh; -aaxsi; -aaxsj; -aaxsk; -aaxsl; -aaxsm; -aaxsn; -aaxso; -aaxsp; -aaxsq; -aaxsr; -aaxss; -aaxst; -aaxsu; -aaxsv; -aaxsw; -aaxsx; -aaxsy; -aaxsz; -aaxta; -aaxtb; -aaxtc; -aaxtd; -aaxte; -aaxtf; -aaxtg; -aaxth; -aaxti; -aaxtj; -aaxtk; -aaxtl; -aaxtm; -aaxtn; -aaxto; -aaxtp; -aaxtq; -aaxtr; -aaxts; -aaxtt; -aaxtu; -aaxtv; -aaxtw; -aaxtx; -aaxty; -aaxtz; -aaxua; -aaxub; -aaxuc; -aaxud; -aaxue; -aaxuf; -aaxug; -aaxuh; -aaxui; -aaxuj; -aaxuk; -aaxul; -aaxum; -aaxun; -aaxuo; -aaxup; -aaxuq; -aaxur; -aaxus; -aaxut; -aaxuu; -aaxuv; -aaxuw; -aaxux; -aaxuy; -aaxuz; -aaxva; -aaxvb; -aaxvc; -aaxvd; -aaxve; -aaxvf; -aaxvg; -aaxvh; -aaxvi; -aaxvj; -aaxvk; -aaxvl; -aaxvm; -aaxvn; -aaxvo; -aaxvp; -aaxvq; -aaxvr; -aaxvs; -aaxvt; -aaxvu; -aaxvv; -aaxvw; -aaxvx; -aaxvy; -aaxvz; -aaxwa; -aaxwb; -aaxwc; -aaxwd; -aaxwe; -aaxwf; -aaxwg; -aaxwh; -aaxwi; -aaxwj; -aaxwk; -aaxwl; -aaxwm; -aaxwn; -aaxwo; -aaxwp; -aaxwq; -aaxwr; -aaxws; -aaxwt; -aaxwu; -aaxwv; -aaxww; -aaxwx; -aaxwy; -aaxwz; -aaxxa; -aaxxb; -aaxxc; -aaxxd; -aaxxe; -aaxxf; -aaxxg; -aaxxh; -aaxxi; -aaxxj; -aaxxk; -aaxxl; -aaxxm; -aaxxn; -aaxxo; -aaxxp; -aaxxq; -aaxxr; -aaxxs; -aaxxt; -aaxxu; -aaxxv; -aaxxw; -aaxxx; -aaxxy; -aaxxz; -aaxya; -aaxyb; -aaxyc; -aaxyd; -aaxye; -aaxyf; -aaxyg; -aaxyh; -aaxyi; -aaxyj; -aaxyk; -aaxyl; -aaxym; -aaxyn; -aaxyo; -aaxyp; -aaxyq; -aaxyr; -aaxys; -aaxyt; -aaxyu; -aaxyv; -aaxyw; -aaxyx; -aaxyy; -aaxyz; -aaxza; -aaxzb; -aaxzc; -aaxzd; -aaxze; -aaxzf; -aaxzg; -aaxzh; -aaxzi; -aaxzj; -aaxzk; -aaxzl; -aaxzm; -aaxzn; -aaxzo; -aaxzp; -aaxzq; -aaxzr; -aaxzs; -aaxzt; -aaxzu; -aaxzv; -aaxzw; -aaxzx; -aaxzy; -aaxzz; -aayaa; -aayab; -aayac; -aayad; -aayae; -aayaf; -aayag; -aayah; -aayai; -aayaj; -aayak; -aayal; -aayam; -aayan; -aayao; -aayap; -aayaq; -aayar; -aayas; -aayat; -aayau; -aayav; -aayaw; -aayax; -aayay; -aayaz; -aayba; -aaybb; -aaybc; -aaybd; -aaybe; -aaybf; -aaybg; -aaybh; -aaybi; -aaybj; -aaybk; -aaybl; -aaybm; -aaybn; -aaybo; -aaybp; -aaybq; -aaybr; -aaybs; -aaybt; -aaybu; -aaybv; -aaybw; -aaybx; -aayby; -aaybz; -aayca; -aaycb; -aaycc; -aaycd; -aayce; -aaycf; -aaycg; -aaych; -aayci; -aaycj; -aayck; -aaycl; -aaycm; -aaycn; -aayco; -aaycp; -aaycq; -aaycr; -aaycs; -aayct; -aaycu; -aaycv; -aaycw; -aaycx; -aaycy; -aaycz; -aayda; -aaydb; -aaydc; -aaydd; -aayde; -aaydf; -aaydg; -aaydh; -aaydi; -aaydj; -aaydk; -aaydl; -aaydm; -aaydn; -aaydo; -aaydp; -aaydq; -aaydr; -aayds; -aaydt; -aaydu; -aaydv; -aaydw; -aaydx; -aaydy; -aaydz; -aayea; -aayeb; -aayec; -aayed; -aayee; -aayef; -aayeg; -aayeh; -aayei; -aayej; -aayek; -aayel; -aayem; -aayen; -aayeo; -aayep; -aayeq; -aayer; -aayes; -aayet; -aayeu; -aayev; -aayew; -aayex; -aayey; -aayez; -aayfa; -aayfb; -aayfc; -aayfd; -aayfe; -aayff; -aayfg; -aayfh; -aayfi; -aayfj; -aayfk; -aayfl; -aayfm; -aayfn; -aayfo; -aayfp; -aayfq; -aayfr; -aayfs; -aayft; -aayfu; -aayfv; -aayfw; -aayfx; -aayfy; -aayfz; -aayga; -aaygb; -aaygc; -aaygd; -aayge; -aaygf; -aaygg; -aaygh; -aaygi; -aaygj; -aaygk; -aaygl; -aaygm; -aaygn; -aaygo; -aaygp; -aaygq; -aaygr; -aaygs; -aaygt; -aaygu; -aaygv; -aaygw; -aaygx; -aaygy; -aaygz; -aayha; -aayhb; -aayhc; -aayhd; -aayhe; -aayhf; -aayhg; -aayhh; -aayhi; -aayhj; -aayhk; -aayhl; -aayhm; -aayhn; -aayho; -aayhp; -aayhq; -aayhr; -aayhs; -aayht; -aayhu; -aayhv; -aayhw; -aayhx; -aayhy; -aayhz; -aayia; -aayib; -aayic; -aayid; -aayie; -aayif; -aayig; -aayih; -aayii; -aayij; -aayik; -aayil; -aayim; -aayin; -aayio; -aayip; -aayiq; -aayir; -aayis; -aayit; -aayiu; -aayiv; -aayiw; -aayix; -aayiy; -aayiz; -aayja; -aayjb; -aayjc; -aayjd; -aayje; -aayjf; -aayjg; -aayjh; -aayji; -aayjj; -aayjk; -aayjl; -aayjm; -aayjn; -aayjo; -aayjp; -aayjq; -aayjr; -aayjs; -aayjt; -aayju; -aayjv; -aayjw; -aayjx; -aayjy; -aayjz; -aayka; -aaykb; -aaykc; -aaykd; -aayke; -aaykf; -aaykg; -aaykh; -aayki; -aaykj; -aaykk; -aaykl; -aaykm; -aaykn; -aayko; -aaykp; -aaykq; -aaykr; -aayks; -aaykt; -aayku; -aaykv; -aaykw; -aaykx; -aayky; -aaykz; -aayla; -aaylb; -aaylc; -aayld; -aayle; -aaylf; -aaylg; -aaylh; -aayli; -aaylj; -aaylk; -aayll; -aaylm; -aayln; -aaylo; -aaylp; -aaylq; -aaylr; -aayls; -aaylt; -aaylu; -aaylv; -aaylw; -aaylx; -aayly; -aaylz; -aayma; -aaymb; -aaymc; -aaymd; -aayme; -aaymf; -aaymg; -aaymh; -aaymi; -aaymj; -aaymk; -aayml; -aaymm; -aaymn; -aaymo; -aaymp; -aaymq; -aaymr; -aayms; -aaymt; -aaymu; -aaymv; -aaymw; -aaymx; -aaymy; -aaymz; -aayna; -aaynb; -aaync; -aaynd; -aayne; -aaynf; -aayng; -aaynh; -aayni; -aaynj; -aaynk; -aaynl; -aaynm; -aaynn; -aayno; -aaynp; -aaynq; -aaynr; -aayns; -aaynt; -aaynu; -aaynv; -aaynw; -aaynx; -aayny; -aaynz; -aayoa; -aayob; -aayoc; -aayod; -aayoe; -aayof; -aayog; -aayoh; -aayoi; -aayoj; -aayok; -aayol; -aayom; -aayon; -aayoo; -aayop; -aayoq; -aayor; -aayos; -aayot; -aayou; -aayov; -aayow; -aayox; -aayoy; -aayoz; -aaypa; -aaypb; -aaypc; -aaypd; -aaype; -aaypf; -aaypg; -aayph; -aaypi; -aaypj; -aaypk; -aaypl; -aaypm; -aaypn; -aaypo; -aaypp; -aaypq; -aaypr; -aayps; -aaypt; -aaypu; -aaypv; -aaypw; -aaypx; -aaypy; -aaypz; -aayqa; -aayqb; -aayqc; -aayqd; -aayqe; -aayqf; -aayqg; -aayqh; -aayqi; -aayqj; -aayqk; -aayql; -aayqm; -aayqn; -aayqo; -aayqp; -aayqq; -aayqr; -aayqs; -aayqt; -aayqu; -aayqv; -aayqw; -aayqx; -aayqy; -aayqz; -aayra; -aayrb; -aayrc; -aayrd; -aayre; -aayrf; -aayrg; -aayrh; -aayri; -aayrj; -aayrk; -aayrl; -aayrm; -aayrn; -aayro; -aayrp; -aayrq; -aayrr; -aayrs; -aayrt; -aayru; -aayrv; -aayrw; -aayrx; -aayry; -aayrz; -aaysa; -aaysb; -aaysc; -aaysd; -aayse; -aaysf; -aaysg; -aaysh; -aaysi; -aaysj; -aaysk; -aaysl; -aaysm; -aaysn; -aayso; -aaysp; -aaysq; -aaysr; -aayss; -aayst; -aaysu; -aaysv; -aaysw; -aaysx; -aaysy; -aaysz; -aayta; -aaytb; -aaytc; -aaytd; -aayte; -aaytf; -aaytg; -aayth; -aayti; -aaytj; -aaytk; -aaytl; -aaytm; -aaytn; -aayto; -aaytp; -aaytq; -aaytr; -aayts; -aaytt; -aaytu; -aaytv; -aaytw; -aaytx; -aayty; -aaytz; -aayua; -aayub; -aayuc; -aayud; -aayue; -aayuf; -aayug; -aayuh; -aayui; -aayuj; -aayuk; -aayul; -aayum; -aayun; -aayuo; -aayup; -aayuq; -aayur; -aayus; -aayut; -aayuu; -aayuv; -aayuw; -aayux; -aayuy; -aayuz; -aayva; -aayvb; -aayvc; -aayvd; -aayve; -aayvf; -aayvg; -aayvh; -aayvi; -aayvj; -aayvk; -aayvl; -aayvm; -aayvn; -aayvo; -aayvp; -aayvq; -aayvr; -aayvs; -aayvt; -aayvu; -aayvv; -aayvw; -aayvx; -aayvy; -aayvz; -aaywa; -aaywb; -aaywc; -aaywd; -aaywe; -aaywf; -aaywg; -aaywh; -aaywi; -aaywj; -aaywk; -aaywl; -aaywm; -aaywn; -aaywo; -aaywp; -aaywq; -aaywr; -aayws; -aaywt; -aaywu; -aaywv; -aayww; -aaywx; -aaywy; -aaywz; -aayxa; -aayxb; -aayxc; -aayxd; -aayxe; -aayxf; -aayxg; -aayxh; -aayxi; -aayxj; -aayxk; -aayxl; -aayxm; -aayxn; -aayxo; -aayxp; -aayxq; -aayxr; -aayxs; -aayxt; -aayxu; -aayxv; -aayxw; -aayxx; -aayxy; -aayxz; -aayya; -aayyb; -aayyc; -aayyd; -aayye; -aayyf; -aayyg; -aayyh; -aayyi; -aayyj; -aayyk; -aayyl; -aayym; -aayyn; -aayyo; -aayyp; -aayyq; -aayyr; -aayys; -aayyt; -aayyu; -aayyv; -aayyw; -aayyx; -aayyy; -aayyz; -aayza; -aayzb; -aayzc; -aayzd; -aayze; -aayzf; -aayzg; -aayzh; -aayzi; -aayzj; -aayzk; -aayzl; -aayzm; -aayzn; -aayzo; -aayzp; -aayzq; -aayzr; -aayzs; -aayzt; -aayzu; -aayzv; -aayzw; -aayzx; -aayzy; -aayzz; -aazaa; -aazab; -aazac; -aazad; -aazae; -aazaf; -aazag; -aazah; -aazai; -aazaj; -aazak; -aazal; -aazam; -aazan; -aazao; -aazap; -aazaq; -aazar; -aazas; -aazat; -aazau; -aazav; -aazaw; -aazax; -aazay; -aazaz; -aazba; -aazbb; -aazbc; -aazbd; -aazbe; -aazbf; -aazbg; -aazbh; -aazbi; -aazbj; -aazbk; -aazbl; -aazbm; -aazbn; -aazbo; -aazbp; -aazbq; -aazbr; -aazbs; -aazbt; -aazbu; -aazbv; -aazbw; -aazbx; -aazby; -aazbz; -aazca; -aazcb; -aazcc; -aazcd; -aazce; -aazcf; -aazcg; -aazch; -aazci; -aazcj; -aazck; -aazcl; -aazcm; -aazcn; -aazco; -aazcp; -aazcq; -aazcr; -aazcs; -aazct; -aazcu; -aazcv; -aazcw; -aazcx; -aazcy; -aazcz; -aazda; -aazdb; -aazdc; -aazdd; -aazde; -aazdf; -aazdg; -aazdh; -aazdi; -aazdj; -aazdk; -aazdl; -aazdm; -aazdn; -aazdo; -aazdp; -aazdq; -aazdr; -aazds; -aazdt; -aazdu; -aazdv; -aazdw; -aazdx; -aazdy; -aazdz; -aazea; -aazeb; -aazec; -aazed; -aazee; -aazef; -aazeg; -aazeh; -aazei; -aazej; -aazek; -aazel; -aazem; -aazen; -aazeo; -aazep; -aazeq; -aazer; -aazes; -aazet; -aazeu; -aazev; -aazew; -aazex; -aazey; -aazez; -aazfa; -aazfb; -aazfc; -aazfd; -aazfe; -aazff; -aazfg; -aazfh; -aazfi; -aazfj; -aazfk; -aazfl; -aazfm; -aazfn; -aazfo; -aazfp; -aazfq; -aazfr; -aazfs; -aazft; -aazfu; -aazfv; -aazfw; -aazfx; -aazfy; -aazfz; -aazga; -aazgb; -aazgc; -aazgd; -aazge; -aazgf; -aazgg; -aazgh; -aazgi; -aazgj; -aazgk; -aazgl; -aazgm; -aazgn; -aazgo; -aazgp; -aazgq; -aazgr; -aazgs; -aazgt; -aazgu; -aazgv; -aazgw; -aazgx; -aazgy; -aazgz; -aazha; -aazhb; -aazhc; -aazhd; -aazhe; -aazhf; -aazhg; -aazhh; -aazhi; -aazhj; -aazhk; -aazhl; -aazhm; -aazhn; -aazho; -aazhp; -aazhq; -aazhr; -aazhs; -aazht; -aazhu; -aazhv; -aazhw; -aazhx; -aazhy; -aazhz; -aazia; -aazib; -aazic; -aazid; -aazie; -aazif; -aazig; -aazih; -aazii; -aazij; -aazik; -aazil; -aazim; -aazin; -aazio; -aazip; -aaziq; -aazir; -aazis; -aazit; -aaziu; -aaziv; -aaziw; -aazix; -aaziy; -aaziz; -aazja; -aazjb; -aazjc; -aazjd; -aazje; -aazjf; -aazjg; -aazjh; -aazji; -aazjj; -aazjk; -aazjl; -aazjm; -aazjn; -aazjo; -aazjp; -aazjq; -aazjr; -aazjs; -aazjt; -aazju; -aazjv; -aazjw; -aazjx; -aazjy; -aazjz; -aazka; -aazkb; -aazkc; -aazkd; -aazke; -aazkf; -aazkg; -aazkh; -aazki; -aazkj; -aazkk; -aazkl; -aazkm; -aazkn; -aazko; -aazkp; -aazkq; -aazkr; -aazks; -aazkt; -aazku; -aazkv; -aazkw; -aazkx; -aazky; -aazkz; -aazla; -aazlb; -aazlc; -aazld; -aazle; -aazlf; -aazlg; -aazlh; -aazli; -aazlj; -aazlk; -aazll; -aazlm; -aazln; -aazlo; -aazlp; -aazlq; -aazlr; -aazls; -aazlt; -aazlu; -aazlv; -aazlw; -aazlx; -aazly; -aazlz; -aazma; -aazmb; -aazmc; -aazmd; -aazme; -aazmf; -aazmg; -aazmh; -aazmi; -aazmj; -aazmk; -aazml; -aazmm; -aazmn; -aazmo; -aazmp; -aazmq; -aazmr; -aazms; -aazmt; -aazmu; -aazmv; -aazmw; -aazmx; -aazmy; -aazmz; -aazna; -aaznb; -aaznc; -aaznd; -aazne; -aaznf; -aazng; -aaznh; -aazni; -aaznj; -aaznk; -aaznl; -aaznm; -aaznn; -aazno; -aaznp; -aaznq; -aaznr; -aazns; -aaznt; -aaznu; -aaznv; -aaznw; -aaznx; -aazny; -aaznz; -aazoa; -aazob; -aazoc; -aazod; -aazoe; -aazof; -aazog; -aazoh; -aazoi; -aazoj; -aazok; -aazol; -aazom; -aazon; -aazoo; -aazop; -aazoq; -aazor; -aazos; -aazot; -aazou; -aazov; -aazow; -aazox; -aazoy; -aazoz; -aazpa; -aazpb; -aazpc; -aazpd; -aazpe; -aazpf; -aazpg; -aazph; -aazpi; -aazpj; -aazpk; -aazpl; -aazpm; -aazpn; -aazpo; -aazpp; -aazpq; -aazpr; -aazps; -aazpt; -aazpu; -aazpv; -aazpw; -aazpx; -aazpy; -aazpz; -aazqa; -aazqb; -aazqc; -aazqd; -aazqe; -aazqf; -aazqg; -aazqh; -aazqi; -aazqj; -aazqk; -aazql; -aazqm; -aazqn; -aazqo; -aazqp; -aazqq; -aazqr; -aazqs; -aazqt; -aazqu; -aazqv; -aazqw; -aazqx; -aazqy; -aazqz; -aazra; -aazrb; -aazrc; -aazrd; -aazre; -aazrf; -aazrg; -aazrh; -aazri; -aazrj; -aazrk; -aazrl; -aazrm; -aazrn; -aazro; -aazrp; -aazrq; -aazrr; -aazrs; -aazrt; -aazru; -aazrv; -aazrw; -aazrx; -aazry; -aazrz; -aazsa; -aazsb; -aazsc; -aazsd; -aazse; -aazsf; -aazsg; -aazsh; -aazsi; -aazsj; -aazsk; -aazsl; -aazsm; -aazsn; -aazso; -aazsp; -aazsq; -aazsr; -aazss; -aazst; -aazsu; -aazsv; -aazsw; -aazsx; -aazsy; -aazsz; -aazta; -aaztb; -aaztc; -aaztd; -aazte; -aaztf; -aaztg; -aazth; -aazti; -aaztj; -aaztk; -aaztl; -aaztm; -aaztn; -aazto; -aaztp; -aaztq; -aaztr; -aazts; -aaztt; -aaztu; -aaztv; -aaztw; -aaztx; -aazty; -aaztz; -aazua; -aazub; -aazuc; -aazud; -aazue; -aazuf; -aazug; -aazuh; -aazui; -aazuj; -aazuk; -aazul; -aazum; -aazun; -aazuo; -aazup; -aazuq; -aazur; -aazus; -aazut; -aazuu; -aazuv; -aazuw; -aazux; -aazuy; -aazuz; -aazva; -aazvb; -aazvc; -aazvd; -aazve; -aazvf; -aazvg; -aazvh; -aazvi; -aazvj; -aazvk; -aazvl; -aazvm; -aazvn; -aazvo; -aazvp; -aazvq; -aazvr; -aazvs; -aazvt; -aazvu; -aazvv; -aazvw; -aazvx; -aazvy; -aazvz; -aazwa; -aazwb; -aazwc; -aazwd; -aazwe; -aazwf; -aazwg; -aazwh; -aazwi; -aazwj; -aazwk; -aazwl; -aazwm; -aazwn; -aazwo; -aazwp; -aazwq; -aazwr; -aazws; -aazwt; -aazwu; -aazwv; -aazww; -aazwx; -aazwy; -aazwz; -aazxa; -aazxb; -aazxc; -aazxd; -aazxe; -aazxf; -aazxg; -aazxh; -aazxi; -aazxj; -aazxk; -aazxl; -aazxm; -aazxn; -aazxo; -aazxp; -aazxq; -aazxr; -aazxs; -aazxt; -aazxu; -aazxv; -aazxw; -aazxx; -aazxy; -aazxz; -aazya; -aazyb; -aazyc; -aazyd; -aazye; -aazyf; -aazyg; -aazyh; -aazyi; -aazyj; -aazyk; -aazyl; -aazym; -aazyn; -aazyo; -aazyp; -aazyq; -aazyr; -aazys; -aazyt; -aazyu; -aazyv; -aazyw; -aazyx; -aazyy; -aazyz; -aazza; -aazzb; -aazzc; -aazzd; -aazze; -aazzf; -aazzg; -aazzh; -aazzi; -aazzj; -aazzk; -aazzl; -aazzm; -aazzn; -aazzo; -aazzp; -aazzq; -aazzr; -aazzs; -aazzt; -aazzu; -aazzv; -aazzw; -aazzx; -aazzy; -aazzz; -abaaa; -abaab; -abaac; -abaad; -abaae; -abaaf; -abaag; -abaah; -abaai; -abaaj; -abaak; -abaal; -abaam; -abaan; -abaao; -abaap; -abaaq; -abaar; -abaas; -abaat; -abaau; -abaav; -abaaw; -abaax; -abaay; -abaaz; -ababa; -ababb; -ababc; -ababd; -ababe; -ababf; -ababg; -ababh; -ababi; -ababj; -ababk; -ababl; -ababm; -ababn; -ababo; -ababp; -ababq; -ababr; -ababs; -ababt; -ababu; -ababv; -ababw; -ababx; -ababy; -ababz; -abaca; -abacb; -abacc; -abacd; -abace; -abacf; -abacg; -abach; -abaci; -abacj; -aback; -abacl; -abacm; -abacn; -abaco; -abacp; -abacq; -abacr; -abacs; -abact; -abacu; -abacv; -abacw; -abacx; -abacy; -abacz; -abada; -abadb; -abadc; -abadd; -abade; -abadf; -abadg; -abadh; -abadi; -abadj; -abadk; -abadl; -abadm; -abadn; -abado; -abadp; -abadq; -abadr; -abads; -abadt; -abadu; -abadv; -abadw; -abadx; -abady; -abadz; -abaea; -abaeb; -abaec; -abaed; -abaee; -abaef; -abaeg; -abaeh; -abaei; -abaej; -abaek; -abael; -abaem; -abaen; -abaeo; -abaep; -abaeq; -abaer; -abaes; -abaet; -abaeu; -abaev; -abaew; -abaex; -abaey; -abaez; -abafa; -abafb; -abafc; -abafd; -abafe; -abaff; -abafg; -abafh; -abafi; -abafj; -abafk; -abafl; -abafm; -abafn; -abafo; -abafp; -abafq; -abafr; -abafs; -abaft; -abafu; -abafv; -abafw; -abafx; -abafy; -abafz; -abaga; -abagb; -abagc; -abagd; -abage; -abagf; -abagg; -abagh; -abagi; -abagj; -abagk; -abagl; -abagm; -abagn; -abago; -abagp; -abagq; -abagr; -abags; -abagt; -abagu; -abagv; -abagw; -abagx; -abagy; -abagz; -abaha; -abahb; -abahc; -abahd; -abahe; -abahf; -abahg; -abahh; -abahi; -abahj; -abahk; -abahl; -abahm; -abahn; -abaho; -abahp; -abahq; -abahr; -abahs; -abaht; -abahu; -abahv; -abahw; -abahx; -abahy; -abahz; -abaia; -abaib; -abaic; -abaid; -abaie; -abaif; -abaig; -abaih; -abaii; -abaij; -abaik; -abail; -abaim; -abain; -abaio; -abaip; -abaiq; -abair; -abais; -abait; -abaiu; -abaiv; -abaiw; -abaix; -abaiy; -abaiz; -abaja; -abajb; -abajc; -abajd; -abaje; -abajf; -abajg; -abajh; -abaji; -abajj; -abajk; -abajl; -abajm; -abajn; -abajo; -abajp; -abajq; -abajr; -abajs; -abajt; -abaju; -abajv; -abajw; -abajx; -abajy; -abajz; -abaka; -abakb; -abakc; -abakd; -abake; -abakf; -abakg; -abakh; -abaki; -abakj; -abakk; -abakl; -abakm; -abakn; -abako; -abakp; -abakq; -abakr; -abaks; -abakt; -abaku; -abakv; -abakw; -abakx; -abaky; -abakz; -abala; -abalb; -abalc; -abald; -abale; -abalf; -abalg; -abalh; -abali; -abalj; -abalk; -aball; -abalm; -abaln; -abalo; -abalp; -abalq; -abalr; -abals; -abalt; -abalu; -abalv; -abalw; -abalx; -abaly; -abalz; -abama; -abamb; -abamc; -abamd; -abame; -abamf; -abamg; -abamh; -abami; -abamj; -abamk; -abaml; -abamm; -abamn; -abamo; -abamp; -abamq; -abamr; -abams; -abamt; -abamu; -abamv; -abamw; -abamx; -abamy; -abamz; -abana; -abanb; -abanc; -aband; -abane; -abanf; -abang; -abanh; -abani; -abanj; -abank; -abanl; -abanm; -abann; -abano; -abanp; -abanq; -abanr; -abans; -abant; -abanu; -abanv; -abanw; -abanx; -abany; -abanz; -abaoa; -abaob; -abaoc; -abaod; -abaoe; -abaof; -abaog; -abaoh; -abaoi; -abaoj; -abaok; -abaol; -abaom; -abaon; -abaoo; -abaop; -abaoq; -abaor; -abaos; -abaot; -abaou; -abaov; -abaow; -abaox; -abaoy; -abaoz; -abapa; -abapb; -abapc; -abapd; -abape; -abapf; -abapg; -abaph; -abapi; -abapj; -abapk; -abapl; -abapm; -abapn; -abapo; -abapp; -abapq; -abapr; -abaps; -abapt; -abapu; -abapv; -abapw; -abapx; -abapy; -abapz; -abaqa; -abaqb; -abaqc; -abaqd; -abaqe; -abaqf; -abaqg; -abaqh; -abaqi; -abaqj; -abaqk; -abaql; -abaqm; -abaqn; -abaqo; -abaqp; -abaqq; -abaqr; -abaqs; -abaqt; -abaqu; -abaqv; -abaqw; -abaqx; -abaqy; -abaqz; -abara; -abarb; -abarc; -abard; -abare; -abarf; -abarg; -abarh; -abari; -abarj; -abark; -abarl; -abarm; -abarn; -abaro; -abarp; -abarq; -abarr; -abars; -abart; -abaru; -abarv; -abarw; -abarx; -abary; -abarz; -abasa; -abasb; -abasc; -abasd; -abase; -abasf; -abasg; -abash; -abasi; -abasj; -abask; -abasl; -abasm; -abasn; -abaso; -abasp; -abasq; -abasr; -abass; -abast; -abasu; -abasv; -abasw; -abasx; -abasy; -abasz; -abata; -abatb; -abatc; -abatd; -abate; -abatf; -abatg; -abath; -abati; -abatj; -abatk; -abatl; -abatm; -abatn; -abato; -abatp; -abatq; -abatr; -abats; -abatt; -abatu; -abatv; -abatw; -abatx; -abaty; -abatz; -abaua; -abaub; -abauc; -abaud; -abaue; -abauf; -abaug; -abauh; -abaui; -abauj; -abauk; -abaul; -abaum; -abaun; -abauo; -abaup; -abauq; -abaur; -abaus; -abaut; -abauu; -abauv; -abauw; -abaux; -abauy; -abauz; -abava; -abavb; -abavc; -abavd; -abave; -abavf; -abavg; -abavh; -abavi; -abavj; -abavk; -abavl; -abavm; -abavn; -abavo; -abavp; -abavq; -abavr; -abavs; -abavt; -abavu; -abavv; -abavw; -abavx; -abavy; -abavz; -abawa; -abawb; -abawc; -abawd; -abawe; -abawf; -abawg; -abawh; -abawi; -abawj; -abawk; -abawl; -abawm; -abawn; -abawo; -abawp; -abawq; -abawr; -abaws; -abawt; -abawu; -abawv; -abaww; -abawx; -abawy; -abawz; -abaxa; -abaxb; -abaxc; -abaxd; -abaxe; -abaxf; -abaxg; -abaxh; -abaxi; -abaxj; -abaxk; -abaxl; -abaxm; -abaxn; -abaxo; -abaxp; -abaxq; -abaxr; -abaxs; -abaxt; -abaxu; -abaxv; -abaxw; -abaxx; -abaxy; -abaxz; -abaya; -abayb; -abayc; -abayd; -abaye; -abayf; -abayg; -abayh; -abayi; -abayj; -abayk; -abayl; -abaym; -abayn; -abayo; -abayp; -abayq; -abayr; -abays; -abayt; -abayu; -abayv; -abayw; -abayx; -abayy; -abayz; -abaza; -abazb; -abazc; -abazd; -abaze; -abazf; -abazg; -abazh; -abazi; -abazj; -abazk; -abazl; -abazm; -abazn; -abazo; -abazp; -abazq; -abazr; -abazs; -abazt; -abazu; -abazv; -abazw; -abazx; -abazy; -abazz; -abbaa; -abbab; -abbac; -abbad; -abbae; -abbaf; -abbag; -abbah; -abbai; -abbaj; -abbak; -abbal; -abbam; -abban; -abbao; -abbap; -abbaq; -abbar; -abbas; -abbat; -abbau; -abbav; -abbaw; -abbax; -abbay; -abbaz; -abbba; -abbbb; -abbbc; -abbbd; -abbbe; -abbbf; -abbbg; -abbbh; -abbbi; -abbbj; -abbbk; -abbbl; -abbbm; -abbbn; -abbbo; -abbbp; -abbbq; -abbbr; -abbbs; -abbbt; -abbbu; -abbbv; -abbbw; -abbbx; -abbby; -abbbz; -abbca; -abbcb; -abbcc; -abbcd; -abbce; -abbcf; -abbcg; -abbch; -abbci; -abbcj; -abbck; -abbcl; -abbcm; -abbcn; -abbco; -abbcp; -abbcq; -abbcr; -abbcs; -abbct; -abbcu; -abbcv; -abbcw; -abbcx; -abbcy; -abbcz; -abbda; -abbdb; -abbdc; -abbdd; -abbde; -abbdf; -abbdg; -abbdh; -abbdi; -abbdj; -abbdk; -abbdl; -abbdm; -abbdn; -abbdo; -abbdp; -abbdq; -abbdr; -abbds; -abbdt; -abbdu; -abbdv; -abbdw; -abbdx; -abbdy; -abbdz; -abbea; -abbeb; -abbec; -abbed; -abbee; -abbef; -abbeg; -abbeh; -abbei; -abbej; -abbek; -abbel; -abbem; -abben; -abbeo; -abbep; -abbeq; -abber; -abbes; -abbet; -abbeu; -abbev; -abbew; -abbex; -abbey; -abbez; -abbfa; -abbfb; -abbfc; -abbfd; -abbfe; -abbff; -abbfg; -abbfh; -abbfi; -abbfj; -abbfk; -abbfl; -abbfm; -abbfn; -abbfo; -abbfp; -abbfq; -abbfr; -abbfs; -abbft; -abbfu; -abbfv; -abbfw; -abbfx; -abbfy; -abbfz; -abbga; -abbgb; -abbgc; -abbgd; -abbge; -abbgf; -abbgg; -abbgh; -abbgi; -abbgj; -abbgk; -abbgl; -abbgm; -abbgn; -abbgo; -abbgp; -abbgq; -abbgr; -abbgs; -abbgt; -abbgu; -abbgv; -abbgw; -abbgx; -abbgy; -abbgz; -abbha; -abbhb; -abbhc; -abbhd; -abbhe; -abbhf; -abbhg; -abbhh; -abbhi; -abbhj; -abbhk; -abbhl; -abbhm; -abbhn; -abbho; -abbhp; -abbhq; -abbhr; -abbhs; -abbht; -abbhu; -abbhv; -abbhw; -abbhx; -abbhy; -abbhz; -abbia; -abbib; -abbic; -abbid; -abbie; -abbif; -abbig; -abbih; -abbii; -abbij; -abbik; -abbil; -abbim; -abbin; -abbio; -abbip; -abbiq; -abbir; -abbis; -abbit; -abbiu; -abbiv; -abbiw; -abbix; -abbiy; -abbiz; -abbja; -abbjb; -abbjc; -abbjd; -abbje; -abbjf; -abbjg; -abbjh; -abbji; -abbjj; -abbjk; -abbjl; -abbjm; -abbjn; -abbjo; -abbjp; -abbjq; -abbjr; -abbjs; -abbjt; -abbju; -abbjv; -abbjw; -abbjx; -abbjy; -abbjz; -abbka; -abbkb; -abbkc; -abbkd; -abbke; -abbkf; -abbkg; -abbkh; -abbki; -abbkj; -abbkk; -abbkl; -abbkm; -abbkn; -abbko; -abbkp; -abbkq; -abbkr; -abbks; -abbkt; -abbku; -abbkv; -abbkw; -abbkx; -abbky; -abbkz; -abbla; -abblb; -abblc; -abbld; -abble; -abblf; -abblg; -abblh; -abbli; -abblj; -abblk; -abbll; -abblm; -abbln; -abblo; -abblp; -abblq; -abblr; -abbls; -abblt; -abblu; -abblv; -abblw; -abblx; -abbly; -abblz; -abbma; -abbmb; -abbmc; -abbmd; -abbme; -abbmf; -abbmg; -abbmh; -abbmi; -abbmj; -abbmk; -abbml; -abbmm; -abbmn; -abbmo; -abbmp; -abbmq; -abbmr; -abbms; -abbmt; -abbmu; -abbmv; -abbmw; -abbmx; -abbmy; -abbmz; -abbna; -abbnb; -abbnc; -abbnd; -abbne; -abbnf; -abbng; -abbnh; -abbni; -abbnj; -abbnk; -abbnl; -abbnm; -abbnn; -abbno; -abbnp; -abbnq; -abbnr; -abbns; -abbnt; -abbnu; -abbnv; -abbnw; -abbnx; -abbny; -abbnz; -abboa; -abbob; -abboc; -abbod; -abboe; -abbof; -abbog; -abboh; -abboi; -abboj; -abbok; -abbol; -abbom; -abbon; -abboo; -abbop; -abboq; -abbor; -abbos; -abbot; -abbou; -abbov; -abbow; -abbox; -abboy; -abboz; -abbpa; -abbpb; -abbpc; -abbpd; -abbpe; -abbpf; -abbpg; -abbph; -abbpi; -abbpj; -abbpk; -abbpl; -abbpm; -abbpn; -abbpo; -abbpp; -abbpq; -abbpr; -abbps; -abbpt; -abbpu; -abbpv; -abbpw; -abbpx; -abbpy; -abbpz; -abbqa; -abbqb; -abbqc; -abbqd; -abbqe; -abbqf; -abbqg; -abbqh; -abbqi; -abbqj; -abbqk; -abbql; -abbqm; -abbqn; -abbqo; -abbqp; -abbqq; -abbqr; -abbqs; -abbqt; -abbqu; -abbqv; -abbqw; -abbqx; -abbqy; -abbqz; -abbra; -abbrb; -abbrc; -abbrd; -abbre; -abbrf; -abbrg; -abbrh; -abbri; -abbrj; -abbrk; -abbrl; -abbrm; -abbrn; -abbro; -abbrp; -abbrq; -abbrr; -abbrs; -abbrt; -abbru; -abbrv; -abbrw; -abbrx; -abbry; -abbrz; -abbsa; -abbsb; -abbsc; -abbsd; -abbse; -abbsf; -abbsg; -abbsh; -abbsi; -abbsj; -abbsk; -abbsl; -abbsm; -abbsn; -abbso; -abbsp; -abbsq; -abbsr; -abbss; -abbst; -abbsu; -abbsv; -abbsw; -abbsx; -abbsy; -abbsz; -abbta; -abbtb; -abbtc; -abbtd; -abbte; -abbtf; -abbtg; -abbth; -abbti; -abbtj; -abbtk; -abbtl; -abbtm; -abbtn; -abbto; -abbtp; -abbtq; -abbtr; -abbts; -abbtt; -abbtu; -abbtv; -abbtw; -abbtx; -abbty; -abbtz; -abbua; -abbub; -abbuc; -abbud; -abbue; -abbuf; -abbug; -abbuh; -abbui; -abbuj; -abbuk; -abbul; -abbum; -abbun; -abbuo; -abbup; -abbuq; -abbur; -abbus; -abbut; -abbuu; -abbuv; -abbuw; -abbux; -abbuy; -abbuz; -abbva; -abbvb; -abbvc; -abbvd; -abbve; -abbvf; -abbvg; -abbvh; -abbvi; -abbvj; -abbvk; -abbvl; -abbvm; -abbvn; -abbvo; -abbvp; -abbvq; -abbvr; -abbvs; -abbvt; -abbvu; -abbvv; -abbvw; -abbvx; -abbvy; -abbvz; -abbwa; -abbwb; -abbwc; -abbwd; -abbwe; -abbwf; -abbwg; -abbwh; -abbwi; -abbwj; -abbwk; -abbwl; -abbwm; -abbwn; -abbwo; -abbwp; -abbwq; -abbwr; -abbws; -abbwt; -abbwu; -abbwv; -abbww; -abbwx; -abbwy; -abbwz; -abbxa; -abbxb; -abbxc; -abbxd; -abbxe; -abbxf; -abbxg; -abbxh; -abbxi; -abbxj; -abbxk; -abbxl; -abbxm; -abbxn; -abbxo; -abbxp; -abbxq; -abbxr; -abbxs; -abbxt; -abbxu; -abbxv; -abbxw; -abbxx; -abbxy; -abbxz; -abbya; -abbyb; -abbyc; -abbyd; -abbye; -abbyf; -abbyg; -abbyh; -abbyi; -abbyj; -abbyk; -abbyl; -abbym; -abbyn; -abbyo; -abbyp; -abbyq; -abbyr; -abbys; -abbyt; -abbyu; -abbyv; -abbyw; -abbyx; -abbyy; -abbyz; -abbza; -abbzb; -abbzc; -abbzd; -abbze; -abbzf; -abbzg; -abbzh; -abbzi; -abbzj; -abbzk; -abbzl; -abbzm; -abbzn; -abbzo; -abbzp; -abbzq; -abbzr; -abbzs; -abbzt; -abbzu; -abbzv; -abbzw; -abbzx; -abbzy; -abbzz; -abcaa; -abcab; -abcac; -abcad; -abcae; -abcaf; -abcag; -abcah; -abcai; -abcaj; -abcak; -abcal; -abcam; -abcan; -abcao; -abcap; -abcaq; -abcar; -abcas; -abcat; -abcau; -abcav; -abcaw; -abcax; -abcay; -abcaz; -abcba; -abcbb; -abcbc; -abcbd; -abcbe; -abcbf; -abcbg; -abcbh; -abcbi; -abcbj; -abcbk; -abcbl; -abcbm; -abcbn; -abcbo; -abcbp; -abcbq; -abcbr; -abcbs; -abcbt; -abcbu; -abcbv; -abcbw; -abcbx; -abcby; -abcbz; -abcca; -abccb; -abccc; -abccd; -abcce; -abccf; -abccg; -abcch; -abcci; -abccj; -abcck; -abccl; -abccm; -abccn; -abcco; -abccp; -abccq; -abccr; -abccs; -abcct; -abccu; -abccv; -abccw; -abccx; -abccy; -abccz; -abcda; -abcdb; -abcdc; -abcdd; -abcde; -abcdf; -abcdg; -abcdh; -abcdi; -abcdj; -abcdk; -abcdl; -abcdm; -abcdn; -abcdo; -abcdp; -abcdq; -abcdr; -abcds; -abcdt; -abcdu; -abcdv; -abcdw; -abcdx; -abcdy; -abcdz; -abcea; -abceb; -abcec; -abced; -abcee; -abcef; -abceg; -abceh; -abcei; -abcej; -abcek; -abcel; -abcem; -abcen; -abceo; -abcep; -abceq; -abcer; -abces; -abcet; -abceu; -abcev; -abcew; -abcex; -abcey; -abcez; -abcfa; -abcfb; -abcfc; -abcfd; -abcfe; -abcff; -abcfg; -abcfh; -abcfi; -abcfj; -abcfk; -abcfl; -abcfm; -abcfn; -abcfo; -abcfp; -abcfq; -abcfr; -abcfs; -abcft; -abcfu; -abcfv; -abcfw; -abcfx; -abcfy; -abcfz; -abcga; -abcgb; -abcgc; -abcgd; -abcge; -abcgf; -abcgg; -abcgh; -abcgi; -abcgj; -abcgk; -abcgl; -abcgm; -abcgn; -abcgo; -abcgp; -abcgq; -abcgr; -abcgs; -abcgt; -abcgu; -abcgv; -abcgw; -abcgx; -abcgy; -abcgz; -abcha; -abchb; -abchc; -abchd; -abche; -abchf; -abchg; -abchh; -abchi; -abchj; -abchk; -abchl; -abchm; -abchn; -abcho; -abchp; -abchq; -abchr; -abchs; -abcht; -abchu; -abchv; -abchw; -abchx; -abchy; -abchz; -abcia; -abcib; -abcic; -abcid; -abcie; -abcif; -abcig; -abcih; -abcii; -abcij; -abcik; -abcil; -abcim; -abcin; -abcio; -abcip; -abciq; -abcir; -abcis; -abcit; -abciu; -abciv; -abciw; -abcix; -abciy; -abciz; -abcja; -abcjb; -abcjc; -abcjd; -abcje; -abcjf; -abcjg; -abcjh; -abcji; -abcjj; -abcjk; -abcjl; -abcjm; -abcjn; -abcjo; -abcjp; -abcjq; -abcjr; -abcjs; -abcjt; -abcju; -abcjv; -abcjw; -abcjx; -abcjy; -abcjz; -abcka; -abckb; -abckc; -abckd; -abcke; -abckf; -abckg; -abckh; -abcki; -abckj; -abckk; -abckl; -abckm; -abckn; -abcko; -abckp; -abckq; -abckr; -abcks; -abckt; -abcku; -abckv; -abckw; -abckx; -abcky; -abckz; -abcla; -abclb; -abclc; -abcld; -abcle; -abclf; -abclg; -abclh; -abcli; -abclj; -abclk; -abcll; -abclm; -abcln; -abclo; -abclp; -abclq; -abclr; -abcls; -abclt; -abclu; -abclv; -abclw; -abclx; -abcly; -abclz; -abcma; -abcmb; -abcmc; -abcmd; -abcme; -abcmf; -abcmg; -abcmh; -abcmi; -abcmj; -abcmk; -abcml; -abcmm; -abcmn; -abcmo; -abcmp; -abcmq; -abcmr; -abcms; -abcmt; -abcmu; -abcmv; -abcmw; -abcmx; -abcmy; -abcmz; -abcna; -abcnb; -abcnc; -abcnd; -abcne; -abcnf; -abcng; -abcnh; -abcni; -abcnj; -abcnk; -abcnl; -abcnm; -abcnn; -abcno; -abcnp; -abcnq; -abcnr; -abcns; -abcnt; -abcnu; -abcnv; -abcnw; -abcnx; -abcny; -abcnz; -abcoa; -abcob; -abcoc; -abcod; -abcoe; -abcof; -abcog; -abcoh; -abcoi; -abcoj; -abcok; -abcol; -abcom; -abcon; -abcoo; -abcop; -abcoq; -abcor; -abcos; -abcot; -abcou; -abcov; -abcow; -abcox; -abcoy; -abcoz; -abcpa; -abcpb; -abcpc; -abcpd; -abcpe; -abcpf; -abcpg; -abcph; -abcpi; -abcpj; -abcpk; -abcpl; -abcpm; -abcpn; -abcpo; -abcpp; -abcpq; -abcpr; -abcps; -abcpt; -abcpu; -abcpv; -abcpw; -abcpx; -abcpy; -abcpz; -abcqa; -abcqb; -abcqc; -abcqd; -abcqe; -abcqf; -abcqg; -abcqh; -abcqi; -abcqj; -abcqk; -abcql; -abcqm; -abcqn; -abcqo; -abcqp; -abcqq; -abcqr; -abcqs; -abcqt; -abcqu; -abcqv; -abcqw; -abcqx; -abcqy; -abcqz; -abcra; -abcrb; -abcrc; -abcrd; -abcre; -abcrf; -abcrg; -abcrh; -abcri; -abcrj; -abcrk; -abcrl; -abcrm; -abcrn; -abcro; -abcrp; -abcrq; -abcrr; -abcrs; -abcrt; -abcru; -abcrv; -abcrw; -abcrx; -abcry; -abcrz; -abcsa; -abcsb; -abcsc; -abcsd; -abcse; -abcsf; -abcsg; -abcsh; -abcsi; -abcsj; -abcsk; -abcsl; -abcsm; -abcsn; -abcso; -abcsp; -abcsq; -abcsr; -abcss; -abcst; -abcsu; -abcsv; -abcsw; -abcsx; -abcsy; -abcsz; -abcta; -abctb; -abctc; -abctd; -abcte; -abctf; -abctg; -abcth; -abcti; -abctj; -abctk; -abctl; -abctm; -abctn; -abcto; -abctp; -abctq; -abctr; -abcts; -abctt; -abctu; -abctv; -abctw; -abctx; -abcty; -abctz; -abcua; -abcub; -abcuc; -abcud; -abcue; -abcuf; -abcug; -abcuh; -abcui; -abcuj; -abcuk; -abcul; -abcum; -abcun; -abcuo; -abcup; -abcuq; -abcur; -abcus; -abcut; -abcuu; -abcuv; -abcuw; -abcux; -abcuy; -abcuz; -abcva; -abcvb; -abcvc; -abcvd; -abcve; -abcvf; -abcvg; -abcvh; -abcvi; -abcvj; -abcvk; -abcvl; -abcvm; -abcvn; -abcvo; -abcvp; -abcvq; -abcvr; -abcvs; -abcvt; -abcvu; -abcvv; -abcvw; -abcvx; -abcvy; -abcvz; -abcwa; -abcwb; -abcwc; -abcwd; -abcwe; -abcwf; -abcwg; -abcwh; -abcwi; -abcwj; -abcwk; -abcwl; -abcwm; -abcwn; -abcwo; -abcwp; -abcwq; -abcwr; -abcws; -abcwt; -abcwu; -abcwv; -abcww; -abcwx; -abcwy; -abcwz; -abcxa; -abcxb; -abcxc; -abcxd; -abcxe; -abcxf; -abcxg; -abcxh; -abcxi; -abcxj; -abcxk; -abcxl; -abcxm; -abcxn; -abcxo; -abcxp; -abcxq; -abcxr; -abcxs; -abcxt; -abcxu; -abcxv; -abcxw; -abcxx; -abcxy; -abcxz; -abcya; -abcyb; -abcyc; -abcyd; -abcye; -abcyf; -abcyg; -abcyh; -abcyi; -abcyj; -abcyk; -abcyl; -abcym; -abcyn; -abcyo; -abcyp; -abcyq; -abcyr; -abcys; -abcyt; -abcyu; -abcyv; -abcyw; -abcyx; -abcyy; -abcyz; -abcza; -abczb; -abczc; -abczd; -abcze; -abczf; -abczg; -abczh; -abczi; -abczj; -abczk; -abczl; -abczm; -abczn; -abczo; -abczp; -abczq; -abczr; -abczs; -abczt; -abczu; -abczv; -abczw; -abczx; -abczy; -abczz; -abdaa; -abdab; -abdac; -abdad; -abdae; -abdaf; -abdag; -abdah; -abdai; -abdaj; -abdak; -abdal; -abdam; -abdan; -abdao; -abdap; -abdaq; -abdar; -abdas; -abdat; -abdau; -abdav; -abdaw; -abdax; -abday; -abdaz; -abdba; -abdbb; -abdbc; -abdbd; -abdbe; -abdbf; -abdbg; -abdbh; -abdbi; -abdbj; -abdbk; -abdbl; -abdbm; -abdbn; -abdbo; -abdbp; -abdbq; -abdbr; -abdbs; -abdbt; -abdbu; -abdbv; -abdbw; -abdbx; -abdby; -abdbz; -abdca; -abdcb; -abdcc; -abdcd; -abdce; -abdcf; -abdcg; -abdch; -abdci; -abdcj; -abdck; -abdcl; -abdcm; -abdcn; -abdco; -abdcp; -abdcq; -abdcr; -abdcs; -abdct; -abdcu; -abdcv; -abdcw; -abdcx; -abdcy; -abdcz; -abdda; -abddb; -abddc; -abddd; -abdde; -abddf; -abddg; -abddh; -abddi; -abddj; -abddk; -abddl; -abddm; -abddn; -abddo; -abddp; -abddq; -abddr; -abdds; -abddt; -abddu; -abddv; -abddw; -abddx; -abddy; -abddz; -abdea; -abdeb; -abdec; -abded; -abdee; -abdef; -abdeg; -abdeh; -abdei; -abdej; -abdek; -abdel; -abdem; -abden; -abdeo; -abdep; -abdeq; -abder; -abdes; -abdet; -abdeu; -abdev; -abdew; -abdex; -abdey; -abdez; -abdfa; -abdfb; -abdfc; -abdfd; -abdfe; -abdff; -abdfg; -abdfh; -abdfi; -abdfj; -abdfk; -abdfl; -abdfm; -abdfn; -abdfo; -abdfp; -abdfq; -abdfr; -abdfs; -abdft; -abdfu; -abdfv; -abdfw; -abdfx; -abdfy; -abdfz; -abdga; -abdgb; -abdgc; -abdgd; -abdge; -abdgf; -abdgg; -abdgh; -abdgi; -abdgj; -abdgk; -abdgl; -abdgm; -abdgn; -abdgo; -abdgp; -abdgq; -abdgr; -abdgs; -abdgt; -abdgu; -abdgv; -abdgw; -abdgx; -abdgy; -abdgz; -abdha; -abdhb; -abdhc; -abdhd; -abdhe; -abdhf; -abdhg; -abdhh; -abdhi; -abdhj; -abdhk; -abdhl; -abdhm; -abdhn; -abdho; -abdhp; -abdhq; -abdhr; -abdhs; -abdht; -abdhu; -abdhv; -abdhw; -abdhx; -abdhy; -abdhz; -abdia; -abdib; -abdic; -abdid; -abdie; -abdif; -abdig; -abdih; -abdii; -abdij; -abdik; -abdil; -abdim; -abdin; -abdio; -abdip; -abdiq; -abdir; -abdis; -abdit; -abdiu; -abdiv; -abdiw; -abdix; -abdiy; -abdiz; -abdja; -abdjb; -abdjc; -abdjd; -abdje; -abdjf; -abdjg; -abdjh; -abdji; -abdjj; -abdjk; -abdjl; -abdjm; -abdjn; -abdjo; -abdjp; -abdjq; -abdjr; -abdjs; -abdjt; -abdju; -abdjv; -abdjw; -abdjx; -abdjy; -abdjz; -abdka; -abdkb; -abdkc; -abdkd; -abdke; -abdkf; -abdkg; -abdkh; -abdki; -abdkj; -abdkk; -abdkl; -abdkm; -abdkn; -abdko; -abdkp; -abdkq; -abdkr; -abdks; -abdkt; -abdku; -abdkv; -abdkw; -abdkx; -abdky; -abdkz; -abdla; -abdlb; -abdlc; -abdld; -abdle; -abdlf; -abdlg; -abdlh; -abdli; -abdlj; -abdlk; -abdll; -abdlm; -abdln; -abdlo; -abdlp; -abdlq; -abdlr; -abdls; -abdlt; -abdlu; -abdlv; -abdlw; -abdlx; -abdly; -abdlz; -abdma; -abdmb; -abdmc; -abdmd; -abdme; -abdmf; -abdmg; -abdmh; -abdmi; -abdmj; -abdmk; -abdml; -abdmm; -abdmn; -abdmo; -abdmp; -abdmq; -abdmr; -abdms; -abdmt; -abdmu; -abdmv; -abdmw; -abdmx; -abdmy; -abdmz; -abdna; -abdnb; -abdnc; -abdnd; -abdne; -abdnf; -abdng; -abdnh; -abdni; -abdnj; -abdnk; -abdnl; -abdnm; -abdnn; -abdno; -abdnp; -abdnq; -abdnr; -abdns; -abdnt; -abdnu; -abdnv; -abdnw; -abdnx; -abdny; -abdnz; -abdoa; -abdob; -abdoc; -abdod; -abdoe; -abdof; -abdog; -abdoh; -abdoi; -abdoj; -abdok; -abdol; -abdom; -abdon; -abdoo; -abdop; -abdoq; -abdor; -abdos; -abdot; -abdou; -abdov; -abdow; -abdox; -abdoy; -abdoz; -abdpa; -abdpb; -abdpc; -abdpd; -aljwf -|]; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/bug-4058.ml ocaml-4.01.0/camlp4/test/fixtures/bug-4058.ml --- ocaml-3.12.1/camlp4/test/fixtures/bug-4058.ml 2006-07-17 14:05:28.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/bug-4058.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,4 +0,0 @@ -let _ = (fun x -> x), 1 -let _ = (x := 1), 2 -let _ = (x <- 1), 2 -let _ = (if true then 1 else 2), 1 diff -Nru ocaml-3.12.1/camlp4/test/fixtures/bug-4337.ml ocaml-4.01.0/camlp4/test/fixtures/bug-4337.ml --- ocaml-3.12.1/camlp4/test/fixtures/bug-4337.ml 2007-11-27 13:36:17.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/bug-4337.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -match [] with []°-> () | _ -> ();; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/bug-by-vincent-balat.ml ocaml-4.01.0/camlp4/test/fixtures/bug-by-vincent-balat.ml --- ocaml-3.12.1/camlp4/test/fixtures/bug-by-vincent-balat.ml 2006-07-17 14:05:28.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/bug-by-vincent-balat.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -fun a -> x <- !x + 1; x <- !x + 2 diff -Nru ocaml-3.12.1/camlp4/test/fixtures/bug-camlp4o-benjamin-monate.ml ocaml-4.01.0/camlp4/test/fixtures/bug-camlp4o-benjamin-monate.ml --- ocaml-3.12.1/camlp4/test/fixtures/bug-camlp4o-benjamin-monate.ml 2006-07-26 11:58:05.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/bug-camlp4o-benjamin-monate.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,15 +0,0 @@ -type t = A of t | B ;; -let f = function A A B -> B | B | A B | A (A _) -> B ;; - -exception True -let qexists f q = - try - Queue.iter (fun v -> if f v then raise True) q; - false - with True -> true - -type u = True | False -let g x = function | True -> () | False -> () - -type v = [`True | `False] -let h x = function | `True -> () | `False -> () diff -Nru ocaml-3.12.1/camlp4/test/fixtures/bug-camlp4o-constr-arity-expr.ml ocaml-4.01.0/camlp4/test/fixtures/bug-camlp4o-constr-arity-expr.ml --- ocaml-3.12.1/camlp4/test/fixtures/bug-camlp4o-constr-arity-expr.ml 2006-07-17 14:05:28.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/bug-camlp4o-constr-arity-expr.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,8 +0,0 @@ -(* Some Some Some None;; *) -(* ((Some None) None) None;; *) -((Some) None);; -(* ((Some Some) Some) None;; *) -type t = A of int * int * int;; -A (1, 2, 3);; -(A) (1, 2, 3);; -(A (1, 2)) 3;; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/bug-camlp4o-constr-arity.ml ocaml-4.01.0/camlp4/test/fixtures/bug-camlp4o-constr-arity.ml --- ocaml-3.12.1/camlp4/test/fixtures/bug-camlp4o-constr-arity.ml 2006-07-18 11:58:44.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/bug-camlp4o-constr-arity.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,75 +0,0 @@ -type t = A of t * t | B;; -type t2 = C of (t2 * t2) | D;; -type 'a t3 = S of 'a | T;; - -fun B B B -> ();; - -fun B (A (B, B)) B -> ();; - -fun D (D, D) -> ();; - -fun (C (D, D)) -> ();; - -let A (b, B) = A (B, B);; - -let f (A (B, B)) = ();; - -let f B (A (B, B)) = ();; - -let (D, d) = (D, D);; - -let (C (D, d)) = (C (D, D));; - -function S S T -> ();; - -function Some (A (B, B)) -> ();; - -function S (A (B, B)) -> ();; - -function S (D, D) -> ();; - -function (C (D, D)) -> ();; - -function -| Some Some Some x -> x -(* | None None None x -> x *) -| _ -> assert false;; - -fun None None None -> ();; - -fun (Some None) None None -> ();; - -let Some a = Some 42;; -let Some a :: y = [Some 42];; -let Some a, b = Some 42, 43;; -let (Some a), b = Some 42, 43;; -let Some a as b = let _ = b = 42 in Some 42;; -(* let Some (a as b) = let _ = b = None in Some 42;; *) -(* let Some (a as b) = let _ = b = 42 in Some 42;; *) -(* let (Some a) as b = let _ = b = 42 in Some 42;; *) -(* let (Some a) as b = let _ = b = None in Some 42;; *) -let Some a | Some a = Some 42;; -let x,y as r = 1,2 ;; -let ((x, y) as r) = (1, 2);; - -type top = Top of (int * int);; - -match Top (1,2) with Top min as t -> ();; - -match Top (1,2) with Top (min,max) as t -> ();; - -(* let Some 'a' .. 'b' = Some 'b';; *) - -let rec f x y = ();; - -fun x y -> ();; - -fun (x, y) -> ();; - -function x, y -> ();; - -let rec next line pos0 = () in ();; - -(* fun Some None None None -> ();; *) -(* fun x, y -> ();; |+ syntax error +| *) - diff -Nru ocaml-3.12.1/camlp4/test/fixtures/bug_escaping_quot.ml ocaml-4.01.0/camlp4/test/fixtures/bug_escaping_quot.ml --- ocaml-3.12.1/camlp4/test/fixtures/bug_escaping_quot.ml 2008-09-19 12:56:26.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/bug_escaping_quot.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,7 +0,0 @@ -open Camlp4.PreCast;; -Camlp4_config.antiquotations := true;; -let expand_my_quot_expr _loc _loc_name_opt quotation_contents = - Printf.eprintf "%S\n%!" quotation_contents; - <:expr< dummy >> -;; -Syntax.Quotation.add "my" Syntax.Quotation.DynAst.expr_tag expand_my_quot_expr;; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/chars.ml ocaml-4.01.0/camlp4/test/fixtures/chars.ml --- ocaml-3.12.1/camlp4/test/fixtures/chars.ml 2006-06-29 11:29:27.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/chars.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -'"' diff -Nru ocaml-3.12.1/camlp4/test/fixtures/class_expr_quot.ml ocaml-4.01.0/camlp4/test/fixtures/class_expr_quot.ml --- ocaml-3.12.1/camlp4/test/fixtures/class_expr_quot.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/class_expr_quot.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,27 +0,0 @@ -<:class_expr< a >>; -<:class_expr< A.a B.b >>; -<:class_expr< a [ t ] >>; -<:class_expr< virtual a >>; -<:class_expr< virtual $a$ >>; -<:class_expr< virtual $lid:a$ >>; -<:class_expr< virtual $lid:a$ [ 't ] >>; -(* <:class_expr< virtual a [ t ] >>; *) -<:class_expr< $opt:v$ a >>; -<:class_expr< $opt:v$ a [ t ] >>; -<:class_expr< $opt:v$ $a$ >>; -<:class_expr< $opt:v$ $id:a$ >>; -<:class_expr< $opt:v$ $a$ [ $t$ ] >>; -(* <:class_expr< $opt:v$ a [ $t$ ] >>; *) -(* <:class_expr< $opt:v$ a $opt:t$ >>; *) -(* <:class_expr< $opt:v$ $a$ $opt:t$ >>; *) - -<:class_type< a >>; -<:class_type< a [ t ] >>; -<:class_type< virtual a >>; -<:class_type< virtual $a$ >>; -<:class_type< virtual $lid:a$ >>; -<:class_type< virtual $lid:a$ [ 't ] >>; -<:class_type< $opt:v$ a >>; -<:class_type< $opt:v$ a [ t ] >>; -<:class_type< $opt:v$ $a$ >>; -<:class_type< $opt:v$ $a$ [ $t$ ] >>; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/comments.ml ocaml-4.01.0/camlp4/test/fixtures/comments.ml --- ocaml-3.12.1/camlp4/test/fixtures/comments.ml 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/comments.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,66 +0,0 @@ -(** The first special comment of the file is the comment associated - to the whole module.*) - -(** The comment for function f *) -let f x y = x + y - -(** This comment is not attached to any element since there is another - special comment just before the next element. *) - -(** Comment for exception My_exception, even with a simple comment - between the special comment and the exception.*) -(* A simple comment. *) -exception My_exception of (int -> int) * int - -(** Comment for type weather *) -type weather = -| Rain of int (** The comment for constructor Rain *) -| Sun (** The comment for constructor Sun *) - -(** The comment for type my_record *) -type my_record = { - foo : int ; (** Comment for field foo *) - bar : string ; (** Comment for field bar *) - } - -(** The comment for class my_class *) -class my_class = - object - (** A comment to describe inheritance from cl *) - inherit cl - - (** The comment for the instance variable tutu *) - val mutable tutu = "tutu" - (** The comment for toto *) - val toto = 1 - val titi = "titi" - (** Comment for method toto *) - method toto = tutu ^ "!" - (** Comment for method m *) - method m (f : float) = 1 - end - -(** The comment for class type my_class_type *) -class type my_class_type = - object - (** The comment for the instance variable x. *) - val mutable x : int - (** The commend for method m. *) - method m : int -> int - end - -(** The comment for module Foo *) -module Foo = - struct - (** The comment for x *) - let x = 42 - (** A special comment in the class, but not associated to any element. *) - end - -(** The comment for module type my_module_type. *) -module type MY_MODULE_TYPE = - sig - (* Comment for value x. *) - val x : int - (* ... *) - end diff -Nru ocaml-3.12.1/camlp4/test/fixtures/comments.mli ocaml-4.01.0/camlp4/test/fixtures/comments.mli --- ocaml-3.12.1/camlp4/test/fixtures/comments.mli 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/comments.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,106 +0,0 @@ -(** The first special comment of the file is the comment associated - with the whole module.*) - - -(** Special comments can be placed between elements and are kept - by the OCamldoc tool, but are not associated to any element. - @-tags in these comments are ignored.*) - -(*******************************************************************) -(** Comments like the one above, with more than two asterisks, - are ignored. *) - -(** The comment for function f. *) -val f : int -> int -> int -(** The continuation of the comment for function f. *) - -(** Comment for exception My_exception, even with a simple comment - between the special comment and the exception.*) -(* Hello, I'm a simple comment :-) *) -exception My_exception of (int -> int) * int - -(** Comment for type weather *) -type weather = -| Rain of int (** The comment for construtor Rain *) -| Sun (** The comment for constructor Sun *) - -(** Comment for type weather2 *) -type weather2 = -| Rain of int (** The comment for construtor Rain *) -| Sun (** The comment for constructor Sun *) -(** I can continue the comment for type weather2 here - because there is already a comment associated to the last constructor.*) - -(** The comment for type my_record *) -type my_record = { - foo : int ; (** Comment for field foo *) - bar : string ; (** Comment for field bar *) - } - (** Continuation of comment for type my_record *) - -(** Comment for foo *) -val foo : string -(** This comment is associated to foo and not to bar. *) -val bar : string -(** This comment is assciated to bar. *) - -(** The comment for class my_class *) -class my_class : - object - (** A comment to describe inheritance from cl *) - inherit cl - - (** The comment for attribute tutu *) - val mutable tutu : string - - (** The comment for attribute toto. *) - val toto : int - - (** This comment is not attached to titi since - there is a blank line before titi, but is kept - as a comment in the class. *) - - val titi : string - - (** Comment for method toto *) - method toto : string - - (** Comment for method m *) - method m : float -> int - end - -(** The comment for the class type my_class_type *) -class type my_class_type = - object - (** The comment for variable x. *) - val mutable x : int - - (** The commend for method m. *) - method m : int -> int -end - -(** The comment for module Foo *) -module Foo : - sig - (** The comment for x *) - val x : int - - (** A special comment that is kept but not associated to any element *) - end - -(** The comment for module type my_module_type. *) -module type MY_MODULE_TYPE = - sig - (** The comment for value x. *) - val x : int - - (** The comment for module M. *) - module M : - sig - (** The comment for value y. *) - val y : int - - (* ... *) - end - - end diff -Nru ocaml-3.12.1/camlp4/test/fixtures/comments2.ml ocaml-4.01.0/camlp4/test/fixtures/comments2.ml --- ocaml-3.12.1/camlp4/test/fixtures/comments2.ml 2006-06-29 11:29:27.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/comments2.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,70 +0,0 @@ -(** The first special comment of the file is the comment associated - to the whole module.*) - -(** The comment for function f *) -let f x y = x + y - -(** This comment is not attached to any element since there is another - special comment just before the next element. *) - -(** Comment for exception My_exception, even with a simple comment - between the special comment and the exception.*) -(* A simple comment. *) -exception My_exception of (int -> int) * int - -(** Comment for type weather *) -type weather = - (** The comment for constructor Rain *) -| Rain of int - (** The comment for constructor Sun *) -| Sun - -(** The comment for type my_record *) -type my_record = { - (** Comment for field foo *) - foo : int ; - (** Comment for field bar *) - bar : string ; - } - -(** The comment for class my_class *) -class my_class = - object - (** A comment to describe inheritance from cl *) - inherit cl - - (** The comment for the instance variable tutu *) - val mutable tutu = "tutu" - (** The comment for toto *) - val toto = 1 - val titi = "titi" - (** Comment for method toto *) - method toto = tutu ^ "!" - (** Comment for method m *) - method m (f : float) = 1 - end - -(** The comment for class type my_class_type *) -class type my_class_type = - object - (** The comment for the instance variable x. *) - val mutable x : int - (** The commend for method m. *) - method m : int -> int - end - -(** The comment for module Foo *) -module Foo = - struct - (** The comment for x *) - let x = 42 - (** A special comment in the class, but not associated to any element. *) - end - -(** The comment for module type my_module_type. *) -module type MY_MODULE_TYPE = - sig - (* Comment for value x. *) - val x : int - (* ... *) - end diff -Nru ocaml-3.12.1/camlp4/test/fixtures/constant-parser.ml ocaml-4.01.0/camlp4/test/fixtures/constant-parser.ml --- ocaml-3.12.1/camlp4/test/fixtures/constant-parser.ml 2008-10-27 14:03:57.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/constant-parser.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,90 +0,0 @@ -open Camlp4 - -module Id = struct - let name = "Camlp4Parsers.LoadCamlp4Ast" - let version = Sys.ocaml_version -end - -module Make (Ast : Camlp4.Sig.Camlp4Ast.S) = struct - module Ast = Ast - open Ast - - let _loc = Loc.ghost - - let parse_implem ?directive_handler:(_) _ _ = - let e = - Ast.ExApp (_loc, - Ast.ExApp (_loc, - Ast.ExId (_loc, - Ast.IdAcc (_loc, Ast.IdUid (_loc, "G"), Ast.IdLid (_loc, "extend"))), - Ast.ExTyc (_loc, Ast.ExId (_loc, Ast.IdLid (_loc, "expr")), - Ast.TyApp (_loc, - Ast.TyId (_loc, - Ast.IdAcc (_loc, Ast.IdUid (_loc, "G"), - Ast.IdAcc (_loc, Ast.IdUid (_loc, "Entry"), - Ast.IdLid (_loc, "t")))), - Ast.TyQuo (_loc, "expr")))), - Ast.ExTup (_loc, - Ast.ExCom (_loc, Ast.ExId (_loc, Ast.IdUid (_loc, "None")), - Ast.ExApp (_loc, - Ast.ExApp (_loc, Ast.ExId (_loc, Ast.IdUid (_loc, "::")), - Ast.ExTup (_loc, - Ast.ExCom (_loc, Ast.ExId (_loc, Ast.IdUid (_loc, "None")), - Ast.ExCom (_loc, Ast.ExId (_loc, Ast.IdUid (_loc, "None")), - Ast.ExApp (_loc, - Ast.ExApp (_loc, Ast.ExId (_loc, Ast.IdUid (_loc, "::")), - Ast.ExTup (_loc, - Ast.ExCom (_loc, - Ast.ExApp (_loc, - Ast.ExApp (_loc, - Ast.ExId (_loc, Ast.IdUid (_loc, "::")), - Ast.ExApp (_loc, - Ast.ExId (_loc, - Ast.IdAcc (_loc, Ast.IdUid (_loc, "G"), - Ast.IdUid (_loc, "Skeyword"))), - Ast.ExStr (_loc, "foo"))), - Ast.ExId (_loc, Ast.IdUid (_loc, "[]"))), - Ast.ExApp (_loc, - Ast.ExId (_loc, - Ast.IdAcc (_loc, Ast.IdUid (_loc, "G"), - Ast.IdAcc (_loc, Ast.IdUid (_loc, "Action"), - Ast.IdLid (_loc, "mk")))), - Ast.ExFun (_loc, - Ast.AsArr (_loc, Ast.PaAny _loc, Ast.ONone, - Ast.ExFun (_loc, - Ast.AsArr (_loc, - Ast.PaTyc (_loc, - Ast.PaId (_loc, - Ast.IdLid (_loc, "_loc")), - Ast.TyId (_loc, - Ast.IdAcc (_loc, - Ast.IdUid (_loc, "Loc"), - Ast.IdLid (_loc, "t")))), - Ast.ONone, - Ast.ExTyc (_loc, - Ast.ExApp (_loc, - Ast.ExApp (_loc, - Ast.ExId (_loc, - Ast.IdAcc (_loc, - Ast.IdUid (_loc, "Ast"), - Ast.IdUid (_loc, "ExId"))), - Ast.ExId (_loc, - Ast.IdLid (_loc, "_loc"))), - Ast.ExApp (_loc, - Ast.ExApp (_loc, - Ast.ExId (_loc, - Ast.IdAcc (_loc, - Ast.IdUid (_loc, "Ast"), - Ast.IdUid (_loc, "IdLid"))), - Ast.ExId (_loc, - Ast.IdLid (_loc, "_loc"))), - Ast.ExStr (_loc, "foo"))), - Ast.TyQuo (_loc, "expr")))))))))), - Ast.ExId (_loc, Ast.IdUid (_loc, "[]"))))))), - Ast.ExId (_loc, Ast.IdUid (_loc, "[]")))))) - in Ast.StExp (_loc, e) - let parse_interf ?directive_handler:(_) _ _ = assert false;; - -end;; - -let module M = Camlp4.Register.OCamlParser(Id)(Make) in () diff -Nru ocaml-3.12.1/camlp4/test/fixtures/curry-constr.ml ocaml-4.01.0/camlp4/test/fixtures/curry-constr.ml --- ocaml-3.12.1/camlp4/test/fixtures/curry-constr.ml 2008-09-19 12:54:10.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/curry-constr.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -type t = A of int -type u = B of t -let f = function B A x -> x diff -Nru ocaml-3.12.1/camlp4/test/fixtures/default_quotation.ml ocaml-4.01.0/camlp4/test/fixtures/default_quotation.ml --- ocaml-3.12.1/camlp4/test/fixtures/default_quotation.ml 2006-07-05 11:23:58.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/default_quotation.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,4 +0,0 @@ -#default_quotation "expr"; -open Camlp4.PreCast; -fun [ << $x$ - $y$ >> when x = y -> << 0 >> - | e -> e ]; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/exception-with-eqn-bug.ml ocaml-4.01.0/camlp4/test/fixtures/exception-with-eqn-bug.ml --- ocaml-3.12.1/camlp4/test/fixtures/exception-with-eqn-bug.ml 2008-09-19 12:54:10.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/exception-with-eqn-bug.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -exception Foo of string = Bar diff -Nru ocaml-3.12.1/camlp4/test/fixtures/external.ml ocaml-4.01.0/camlp4/test/fixtures/external.ml --- ocaml-3.12.1/camlp4/test/fixtures/external.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/external.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -external f : 'a -> 'b = "%identity"; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/fun.ml ocaml-4.01.0/camlp4/test/fixtures/fun.ml --- ocaml-3.12.1/camlp4/test/fixtures/fun.ml 2006-06-29 11:29:27.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/fun.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,7 +0,0 @@ -value f = fun []; -value f = fun [ [] -> fun [ 4 -> () ] ]; -value f = fun []; -value f = fun []; -value f = fun []; -value f = g x y; -value f = (g x) y; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/functor-perf.ml ocaml-4.01.0/camlp4/test/fixtures/functor-perf.ml --- ocaml-3.12.1/camlp4/test/fixtures/functor-perf.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/functor-perf.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,2019 +0,0 @@ -module type S = sig -(* <%- for i in 0 .. 1000 do -%> - val f<%= i %> : int -> int -> int -<%- end -%> *) - val f0 : int -> int -> int - val f1 : int -> int -> int - val f2 : int -> int -> int - val f3 : int -> int -> int - val f4 : int -> int -> int - val f5 : int -> int -> int - val f6 : int -> int -> int - val f7 : int -> int -> int - val f8 : int -> int -> int - val f9 : int -> int -> int - val f10 : int -> int -> int - val f11 : int -> int -> int - val f12 : int -> int -> int - val f13 : int -> int -> int - val f14 : int -> int -> int - val f15 : int -> int -> int - val f16 : int -> int -> int - val f17 : int -> int -> int - val f18 : int -> int -> int - val f19 : int -> int -> int - val f20 : int -> int -> int - val f21 : int -> int -> int - val f22 : int -> int -> int - val f23 : int -> int -> int - val f24 : int -> int -> int - val f25 : int -> int -> int - val f26 : int -> int -> int - val f27 : int -> int -> int - val f28 : int -> int -> int - val f29 : int -> int -> int - val f30 : int -> int -> int - val f31 : int -> int -> int - val f32 : int -> int -> int - val f33 : int -> int -> int - val f34 : int -> int -> int - val f35 : int -> int -> int - val f36 : int -> int -> int - val f37 : int -> int -> int - val f38 : int -> int -> int - val f39 : int -> int -> int - val f40 : int -> int -> int - val f41 : int -> int -> int - val f42 : int -> int -> int - val f43 : int -> int -> int - val f44 : int -> int -> int - val f45 : int -> int -> int - val f46 : int -> int -> int - val f47 : int -> int -> int - val f48 : int -> int -> int - val f49 : int -> int -> int - val f50 : int -> int -> int - val f51 : int -> int -> int - val f52 : int -> int -> int - val f53 : int -> int -> int - val f54 : int -> int -> int - val f55 : int -> int -> int - val f56 : int -> int -> int - val f57 : int -> int -> int - val f58 : int -> int -> int - val f59 : int -> int -> int - val f60 : int -> int -> int - val f61 : int -> int -> int - val f62 : int -> int -> int - val f63 : int -> int -> int - val f64 : int -> int -> int - val f65 : int -> int -> int - val f66 : int -> int -> int - val f67 : int -> int -> int - val f68 : int -> int -> int - val f69 : int -> int -> int - val f70 : int -> int -> int - val f71 : int -> int -> int - val f72 : int -> int -> int - val f73 : int -> int -> int - val f74 : int -> int -> int - val f75 : int -> int -> int - val f76 : int -> int -> int - val f77 : int -> int -> int - val f78 : int -> int -> int - val f79 : int -> int -> int - val f80 : int -> int -> int - val f81 : int -> int -> int - val f82 : int -> int -> int - val f83 : int -> int -> int - val f84 : int -> int -> int - val f85 : int -> int -> int - val f86 : int -> int -> int - val f87 : int -> int -> int - val f88 : int -> int -> int - val f89 : int -> int -> int - val f90 : int -> int -> int - val f91 : int -> int -> int - val f92 : int -> int -> int - val f93 : int -> int -> int - val f94 : int -> int -> int - val f95 : int -> int -> int - val f96 : int -> int -> int - val f97 : int -> int -> int - val f98 : int -> int -> int - val f99 : int -> int -> int - val f100 : int -> int -> int - val f101 : int -> int -> int - val f102 : int -> int -> int - val f103 : int -> int -> int - val f104 : int -> int -> int - val f105 : int -> int -> int - val f106 : int -> int -> int - val f107 : int -> int -> int - val f108 : int -> int -> int - val f109 : int -> int -> int - val f110 : int -> int -> int - val f111 : int -> int -> int - val f112 : int -> int -> int - val f113 : int -> int -> int - val f114 : int -> int -> int - val f115 : int -> int -> int - val f116 : int -> int -> int - val f117 : int -> int -> int - val f118 : int -> int -> int - val f119 : int -> int -> int - val f120 : int -> int -> int - val f121 : int -> int -> int - val f122 : int -> int -> int - val f123 : int -> int -> int - val f124 : int -> int -> int - val f125 : int -> int -> int - val f126 : int -> int -> int - val f127 : int -> int -> int - val f128 : int -> int -> int - val f129 : int -> int -> int - val f130 : int -> int -> int - val f131 : int -> int -> int - val f132 : int -> int -> int - val f133 : int -> int -> int - val f134 : int -> int -> int - val f135 : int -> int -> int - val f136 : int -> int -> int - val f137 : int -> int -> int - val f138 : int -> int -> int - val f139 : int -> int -> int - val f140 : int -> int -> int - val f141 : int -> int -> int - val f142 : int -> int -> int - val f143 : int -> int -> int - val f144 : int -> int -> int - val f145 : int -> int -> int - val f146 : int -> int -> int - val f147 : int -> int -> int - val f148 : int -> int -> int - val f149 : int -> int -> int - val f150 : int -> int -> int - val f151 : int -> int -> int - val f152 : int -> int -> int - val f153 : int -> int -> int - val f154 : int -> int -> int - val f155 : int -> int -> int - val f156 : int -> int -> int - val f157 : int -> int -> int - val f158 : int -> int -> int - val f159 : int -> int -> int - val f160 : int -> int -> int - val f161 : int -> int -> int - val f162 : int -> int -> int - val f163 : int -> int -> int - val f164 : int -> int -> int - val f165 : int -> int -> int - val f166 : int -> int -> int - val f167 : int -> int -> int - val f168 : int -> int -> int - val f169 : int -> int -> int - val f170 : int -> int -> int - val f171 : int -> int -> int - val f172 : int -> int -> int - val f173 : int -> int -> int - val f174 : int -> int -> int - val f175 : int -> int -> int - val f176 : int -> int -> int - val f177 : int -> int -> int - val f178 : int -> int -> int - val f179 : int -> int -> int - val f180 : int -> int -> int - val f181 : int -> int -> int - val f182 : int -> int -> int - val f183 : int -> int -> int - val f184 : int -> int -> int - val f185 : int -> int -> int - val f186 : int -> int -> int - val f187 : int -> int -> int - val f188 : int -> int -> int - val f189 : int -> int -> int - val f190 : int -> int -> int - val f191 : int -> int -> int - val f192 : int -> int -> int - val f193 : int -> int -> int - val f194 : int -> int -> int - val f195 : int -> int -> int - val f196 : int -> int -> int - val f197 : int -> int -> int - val f198 : int -> int -> int - val f199 : int -> int -> int - val f200 : int -> int -> int - val f201 : int -> int -> int - val f202 : int -> int -> int - val f203 : int -> int -> int - val f204 : int -> int -> int - val f205 : int -> int -> int - val f206 : int -> int -> int - val f207 : int -> int -> int - val f208 : int -> int -> int - val f209 : int -> int -> int - val f210 : int -> int -> int - val f211 : int -> int -> int - val f212 : int -> int -> int - val f213 : int -> int -> int - val f214 : int -> int -> int - val f215 : int -> int -> int - val f216 : int -> int -> int - val f217 : int -> int -> int - val f218 : int -> int -> int - val f219 : int -> int -> int - val f220 : int -> int -> int - val f221 : int -> int -> int - val f222 : int -> int -> int - val f223 : int -> int -> int - val f224 : int -> int -> int - val f225 : int -> int -> int - val f226 : int -> int -> int - val f227 : int -> int -> int - val f228 : int -> int -> int - val f229 : int -> int -> int - val f230 : int -> int -> int - val f231 : int -> int -> int - val f232 : int -> int -> int - val f233 : int -> int -> int - val f234 : int -> int -> int - val f235 : int -> int -> int - val f236 : int -> int -> int - val f237 : int -> int -> int - val f238 : int -> int -> int - val f239 : int -> int -> int - val f240 : int -> int -> int - val f241 : int -> int -> int - val f242 : int -> int -> int - val f243 : int -> int -> int - val f244 : int -> int -> int - val f245 : int -> int -> int - val f246 : int -> int -> int - val f247 : int -> int -> int - val f248 : int -> int -> int - val f249 : int -> int -> int - val f250 : int -> int -> int - val f251 : int -> int -> int - val f252 : int -> int -> int - val f253 : int -> int -> int - val f254 : int -> int -> int - val f255 : int -> int -> int - val f256 : int -> int -> int - val f257 : int -> int -> int - val f258 : int -> int -> int - val f259 : int -> int -> int - val f260 : int -> int -> int - val f261 : int -> int -> int - val f262 : int -> int -> int - val f263 : int -> int -> int - val f264 : int -> int -> int - val f265 : int -> int -> int - val f266 : int -> int -> int - val f267 : int -> int -> int - val f268 : int -> int -> int - val f269 : int -> int -> int - val f270 : int -> int -> int - val f271 : int -> int -> int - val f272 : int -> int -> int - val f273 : int -> int -> int - val f274 : int -> int -> int - val f275 : int -> int -> int - val f276 : int -> int -> int - val f277 : int -> int -> int - val f278 : int -> int -> int - val f279 : int -> int -> int - val f280 : int -> int -> int - val f281 : int -> int -> int - val f282 : int -> int -> int - val f283 : int -> int -> int - val f284 : int -> int -> int - val f285 : int -> int -> int - val f286 : int -> int -> int - val f287 : int -> int -> int - val f288 : int -> int -> int - val f289 : int -> int -> int - val f290 : int -> int -> int - val f291 : int -> int -> int - val f292 : int -> int -> int - val f293 : int -> int -> int - val f294 : int -> int -> int - val f295 : int -> int -> int - val f296 : int -> int -> int - val f297 : int -> int -> int - val f298 : int -> int -> int - val f299 : int -> int -> int - val f300 : int -> int -> int - val f301 : int -> int -> int - val f302 : int -> int -> int - val f303 : int -> int -> int - val f304 : int -> int -> int - val f305 : int -> int -> int - val f306 : int -> int -> int - val f307 : int -> int -> int - val f308 : int -> int -> int - val f309 : int -> int -> int - val f310 : int -> int -> int - val f311 : int -> int -> int - val f312 : int -> int -> int - val f313 : int -> int -> int - val f314 : int -> int -> int - val f315 : int -> int -> int - val f316 : int -> int -> int - val f317 : int -> int -> int - val f318 : int -> int -> int - val f319 : int -> int -> int - val f320 : int -> int -> int - val f321 : int -> int -> int - val f322 : int -> int -> int - val f323 : int -> int -> int - val f324 : int -> int -> int - val f325 : int -> int -> int - val f326 : int -> int -> int - val f327 : int -> int -> int - val f328 : int -> int -> int - val f329 : int -> int -> int - val f330 : int -> int -> int - val f331 : int -> int -> int - val f332 : int -> int -> int - val f333 : int -> int -> int - val f334 : int -> int -> int - val f335 : int -> int -> int - val f336 : int -> int -> int - val f337 : int -> int -> int - val f338 : int -> int -> int - val f339 : int -> int -> int - val f340 : int -> int -> int - val f341 : int -> int -> int - val f342 : int -> int -> int - val f343 : int -> int -> int - val f344 : int -> int -> int - val f345 : int -> int -> int - val f346 : int -> int -> int - val f347 : int -> int -> int - val f348 : int -> int -> int - val f349 : int -> int -> int - val f350 : int -> int -> int - val f351 : int -> int -> int - val f352 : int -> int -> int - val f353 : int -> int -> int - val f354 : int -> int -> int - val f355 : int -> int -> int - val f356 : int -> int -> int - val f357 : int -> int -> int - val f358 : int -> int -> int - val f359 : int -> int -> int - val f360 : int -> int -> int - val f361 : int -> int -> int - val f362 : int -> int -> int - val f363 : int -> int -> int - val f364 : int -> int -> int - val f365 : int -> int -> int - val f366 : int -> int -> int - val f367 : int -> int -> int - val f368 : int -> int -> int - val f369 : int -> int -> int - val f370 : int -> int -> int - val f371 : int -> int -> int - val f372 : int -> int -> int - val f373 : int -> int -> int - val f374 : int -> int -> int - val f375 : int -> int -> int - val f376 : int -> int -> int - val f377 : int -> int -> int - val f378 : int -> int -> int - val f379 : int -> int -> int - val f380 : int -> int -> int - val f381 : int -> int -> int - val f382 : int -> int -> int - val f383 : int -> int -> int - val f384 : int -> int -> int - val f385 : int -> int -> int - val f386 : int -> int -> int - val f387 : int -> int -> int - val f388 : int -> int -> int - val f389 : int -> int -> int - val f390 : int -> int -> int - val f391 : int -> int -> int - val f392 : int -> int -> int - val f393 : int -> int -> int - val f394 : int -> int -> int - val f395 : int -> int -> int - val f396 : int -> int -> int - val f397 : int -> int -> int - val f398 : int -> int -> int - val f399 : int -> int -> int - val f400 : int -> int -> int - val f401 : int -> int -> int - val f402 : int -> int -> int - val f403 : int -> int -> int - val f404 : int -> int -> int - val f405 : int -> int -> int - val f406 : int -> int -> int - val f407 : int -> int -> int - val f408 : int -> int -> int - val f409 : int -> int -> int - val f410 : int -> int -> int - val f411 : int -> int -> int - val f412 : int -> int -> int - val f413 : int -> int -> int - val f414 : int -> int -> int - val f415 : int -> int -> int - val f416 : int -> int -> int - val f417 : int -> int -> int - val f418 : int -> int -> int - val f419 : int -> int -> int - val f420 : int -> int -> int - val f421 : int -> int -> int - val f422 : int -> int -> int - val f423 : int -> int -> int - val f424 : int -> int -> int - val f425 : int -> int -> int - val f426 : int -> int -> int - val f427 : int -> int -> int - val f428 : int -> int -> int - val f429 : int -> int -> int - val f430 : int -> int -> int - val f431 : int -> int -> int - val f432 : int -> int -> int - val f433 : int -> int -> int - val f434 : int -> int -> int - val f435 : int -> int -> int - val f436 : int -> int -> int - val f437 : int -> int -> int - val f438 : int -> int -> int - val f439 : int -> int -> int - val f440 : int -> int -> int - val f441 : int -> int -> int - val f442 : int -> int -> int - val f443 : int -> int -> int - val f444 : int -> int -> int - val f445 : int -> int -> int - val f446 : int -> int -> int - val f447 : int -> int -> int - val f448 : int -> int -> int - val f449 : int -> int -> int - val f450 : int -> int -> int - val f451 : int -> int -> int - val f452 : int -> int -> int - val f453 : int -> int -> int - val f454 : int -> int -> int - val f455 : int -> int -> int - val f456 : int -> int -> int - val f457 : int -> int -> int - val f458 : int -> int -> int - val f459 : int -> int -> int - val f460 : int -> int -> int - val f461 : int -> int -> int - val f462 : int -> int -> int - val f463 : int -> int -> int - val f464 : int -> int -> int - val f465 : int -> int -> int - val f466 : int -> int -> int - val f467 : int -> int -> int - val f468 : int -> int -> int - val f469 : int -> int -> int - val f470 : int -> int -> int - val f471 : int -> int -> int - val f472 : int -> int -> int - val f473 : int -> int -> int - val f474 : int -> int -> int - val f475 : int -> int -> int - val f476 : int -> int -> int - val f477 : int -> int -> int - val f478 : int -> int -> int - val f479 : int -> int -> int - val f480 : int -> int -> int - val f481 : int -> int -> int - val f482 : int -> int -> int - val f483 : int -> int -> int - val f484 : int -> int -> int - val f485 : int -> int -> int - val f486 : int -> int -> int - val f487 : int -> int -> int - val f488 : int -> int -> int - val f489 : int -> int -> int - val f490 : int -> int -> int - val f491 : int -> int -> int - val f492 : int -> int -> int - val f493 : int -> int -> int - val f494 : int -> int -> int - val f495 : int -> int -> int - val f496 : int -> int -> int - val f497 : int -> int -> int - val f498 : int -> int -> int - val f499 : int -> int -> int - val f500 : int -> int -> int - val f501 : int -> int -> int - val f502 : int -> int -> int - val f503 : int -> int -> int - val f504 : int -> int -> int - val f505 : int -> int -> int - val f506 : int -> int -> int - val f507 : int -> int -> int - val f508 : int -> int -> int - val f509 : int -> int -> int - val f510 : int -> int -> int - val f511 : int -> int -> int - val f512 : int -> int -> int - val f513 : int -> int -> int - val f514 : int -> int -> int - val f515 : int -> int -> int - val f516 : int -> int -> int - val f517 : int -> int -> int - val f518 : int -> int -> int - val f519 : int -> int -> int - val f520 : int -> int -> int - val f521 : int -> int -> int - val f522 : int -> int -> int - val f523 : int -> int -> int - val f524 : int -> int -> int - val f525 : int -> int -> int - val f526 : int -> int -> int - val f527 : int -> int -> int - val f528 : int -> int -> int - val f529 : int -> int -> int - val f530 : int -> int -> int - val f531 : int -> int -> int - val f532 : int -> int -> int - val f533 : int -> int -> int - val f534 : int -> int -> int - val f535 : int -> int -> int - val f536 : int -> int -> int - val f537 : int -> int -> int - val f538 : int -> int -> int - val f539 : int -> int -> int - val f540 : int -> int -> int - val f541 : int -> int -> int - val f542 : int -> int -> int - val f543 : int -> int -> int - val f544 : int -> int -> int - val f545 : int -> int -> int - val f546 : int -> int -> int - val f547 : int -> int -> int - val f548 : int -> int -> int - val f549 : int -> int -> int - val f550 : int -> int -> int - val f551 : int -> int -> int - val f552 : int -> int -> int - val f553 : int -> int -> int - val f554 : int -> int -> int - val f555 : int -> int -> int - val f556 : int -> int -> int - val f557 : int -> int -> int - val f558 : int -> int -> int - val f559 : int -> int -> int - val f560 : int -> int -> int - val f561 : int -> int -> int - val f562 : int -> int -> int - val f563 : int -> int -> int - val f564 : int -> int -> int - val f565 : int -> int -> int - val f566 : int -> int -> int - val f567 : int -> int -> int - val f568 : int -> int -> int - val f569 : int -> int -> int - val f570 : int -> int -> int - val f571 : int -> int -> int - val f572 : int -> int -> int - val f573 : int -> int -> int - val f574 : int -> int -> int - val f575 : int -> int -> int - val f576 : int -> int -> int - val f577 : int -> int -> int - val f578 : int -> int -> int - val f579 : int -> int -> int - val f580 : int -> int -> int - val f581 : int -> int -> int - val f582 : int -> int -> int - val f583 : int -> int -> int - val f584 : int -> int -> int - val f585 : int -> int -> int - val f586 : int -> int -> int - val f587 : int -> int -> int - val f588 : int -> int -> int - val f589 : int -> int -> int - val f590 : int -> int -> int - val f591 : int -> int -> int - val f592 : int -> int -> int - val f593 : int -> int -> int - val f594 : int -> int -> int - val f595 : int -> int -> int - val f596 : int -> int -> int - val f597 : int -> int -> int - val f598 : int -> int -> int - val f599 : int -> int -> int - val f600 : int -> int -> int - val f601 : int -> int -> int - val f602 : int -> int -> int - val f603 : int -> int -> int - val f604 : int -> int -> int - val f605 : int -> int -> int - val f606 : int -> int -> int - val f607 : int -> int -> int - val f608 : int -> int -> int - val f609 : int -> int -> int - val f610 : int -> int -> int - val f611 : int -> int -> int - val f612 : int -> int -> int - val f613 : int -> int -> int - val f614 : int -> int -> int - val f615 : int -> int -> int - val f616 : int -> int -> int - val f617 : int -> int -> int - val f618 : int -> int -> int - val f619 : int -> int -> int - val f620 : int -> int -> int - val f621 : int -> int -> int - val f622 : int -> int -> int - val f623 : int -> int -> int - val f624 : int -> int -> int - val f625 : int -> int -> int - val f626 : int -> int -> int - val f627 : int -> int -> int - val f628 : int -> int -> int - val f629 : int -> int -> int - val f630 : int -> int -> int - val f631 : int -> int -> int - val f632 : int -> int -> int - val f633 : int -> int -> int - val f634 : int -> int -> int - val f635 : int -> int -> int - val f636 : int -> int -> int - val f637 : int -> int -> int - val f638 : int -> int -> int - val f639 : int -> int -> int - val f640 : int -> int -> int - val f641 : int -> int -> int - val f642 : int -> int -> int - val f643 : int -> int -> int - val f644 : int -> int -> int - val f645 : int -> int -> int - val f646 : int -> int -> int - val f647 : int -> int -> int - val f648 : int -> int -> int - val f649 : int -> int -> int - val f650 : int -> int -> int - val f651 : int -> int -> int - val f652 : int -> int -> int - val f653 : int -> int -> int - val f654 : int -> int -> int - val f655 : int -> int -> int - val f656 : int -> int -> int - val f657 : int -> int -> int - val f658 : int -> int -> int - val f659 : int -> int -> int - val f660 : int -> int -> int - val f661 : int -> int -> int - val f662 : int -> int -> int - val f663 : int -> int -> int - val f664 : int -> int -> int - val f665 : int -> int -> int - val f666 : int -> int -> int - val f667 : int -> int -> int - val f668 : int -> int -> int - val f669 : int -> int -> int - val f670 : int -> int -> int - val f671 : int -> int -> int - val f672 : int -> int -> int - val f673 : int -> int -> int - val f674 : int -> int -> int - val f675 : int -> int -> int - val f676 : int -> int -> int - val f677 : int -> int -> int - val f678 : int -> int -> int - val f679 : int -> int -> int - val f680 : int -> int -> int - val f681 : int -> int -> int - val f682 : int -> int -> int - val f683 : int -> int -> int - val f684 : int -> int -> int - val f685 : int -> int -> int - val f686 : int -> int -> int - val f687 : int -> int -> int - val f688 : int -> int -> int - val f689 : int -> int -> int - val f690 : int -> int -> int - val f691 : int -> int -> int - val f692 : int -> int -> int - val f693 : int -> int -> int - val f694 : int -> int -> int - val f695 : int -> int -> int - val f696 : int -> int -> int - val f697 : int -> int -> int - val f698 : int -> int -> int - val f699 : int -> int -> int - val f700 : int -> int -> int - val f701 : int -> int -> int - val f702 : int -> int -> int - val f703 : int -> int -> int - val f704 : int -> int -> int - val f705 : int -> int -> int - val f706 : int -> int -> int - val f707 : int -> int -> int - val f708 : int -> int -> int - val f709 : int -> int -> int - val f710 : int -> int -> int - val f711 : int -> int -> int - val f712 : int -> int -> int - val f713 : int -> int -> int - val f714 : int -> int -> int - val f715 : int -> int -> int - val f716 : int -> int -> int - val f717 : int -> int -> int - val f718 : int -> int -> int - val f719 : int -> int -> int - val f720 : int -> int -> int - val f721 : int -> int -> int - val f722 : int -> int -> int - val f723 : int -> int -> int - val f724 : int -> int -> int - val f725 : int -> int -> int - val f726 : int -> int -> int - val f727 : int -> int -> int - val f728 : int -> int -> int - val f729 : int -> int -> int - val f730 : int -> int -> int - val f731 : int -> int -> int - val f732 : int -> int -> int - val f733 : int -> int -> int - val f734 : int -> int -> int - val f735 : int -> int -> int - val f736 : int -> int -> int - val f737 : int -> int -> int - val f738 : int -> int -> int - val f739 : int -> int -> int - val f740 : int -> int -> int - val f741 : int -> int -> int - val f742 : int -> int -> int - val f743 : int -> int -> int - val f744 : int -> int -> int - val f745 : int -> int -> int - val f746 : int -> int -> int - val f747 : int -> int -> int - val f748 : int -> int -> int - val f749 : int -> int -> int - val f750 : int -> int -> int - val f751 : int -> int -> int - val f752 : int -> int -> int - val f753 : int -> int -> int - val f754 : int -> int -> int - val f755 : int -> int -> int - val f756 : int -> int -> int - val f757 : int -> int -> int - val f758 : int -> int -> int - val f759 : int -> int -> int - val f760 : int -> int -> int - val f761 : int -> int -> int - val f762 : int -> int -> int - val f763 : int -> int -> int - val f764 : int -> int -> int - val f765 : int -> int -> int - val f766 : int -> int -> int - val f767 : int -> int -> int - val f768 : int -> int -> int - val f769 : int -> int -> int - val f770 : int -> int -> int - val f771 : int -> int -> int - val f772 : int -> int -> int - val f773 : int -> int -> int - val f774 : int -> int -> int - val f775 : int -> int -> int - val f776 : int -> int -> int - val f777 : int -> int -> int - val f778 : int -> int -> int - val f779 : int -> int -> int - val f780 : int -> int -> int - val f781 : int -> int -> int - val f782 : int -> int -> int - val f783 : int -> int -> int - val f784 : int -> int -> int - val f785 : int -> int -> int - val f786 : int -> int -> int - val f787 : int -> int -> int - val f788 : int -> int -> int - val f789 : int -> int -> int - val f790 : int -> int -> int - val f791 : int -> int -> int - val f792 : int -> int -> int - val f793 : int -> int -> int - val f794 : int -> int -> int - val f795 : int -> int -> int - val f796 : int -> int -> int - val f797 : int -> int -> int - val f798 : int -> int -> int - val f799 : int -> int -> int - val f800 : int -> int -> int - val f801 : int -> int -> int - val f802 : int -> int -> int - val f803 : int -> int -> int - val f804 : int -> int -> int - val f805 : int -> int -> int - val f806 : int -> int -> int - val f807 : int -> int -> int - val f808 : int -> int -> int - val f809 : int -> int -> int - val f810 : int -> int -> int - val f811 : int -> int -> int - val f812 : int -> int -> int - val f813 : int -> int -> int - val f814 : int -> int -> int - val f815 : int -> int -> int - val f816 : int -> int -> int - val f817 : int -> int -> int - val f818 : int -> int -> int - val f819 : int -> int -> int - val f820 : int -> int -> int - val f821 : int -> int -> int - val f822 : int -> int -> int - val f823 : int -> int -> int - val f824 : int -> int -> int - val f825 : int -> int -> int - val f826 : int -> int -> int - val f827 : int -> int -> int - val f828 : int -> int -> int - val f829 : int -> int -> int - val f830 : int -> int -> int - val f831 : int -> int -> int - val f832 : int -> int -> int - val f833 : int -> int -> int - val f834 : int -> int -> int - val f835 : int -> int -> int - val f836 : int -> int -> int - val f837 : int -> int -> int - val f838 : int -> int -> int - val f839 : int -> int -> int - val f840 : int -> int -> int - val f841 : int -> int -> int - val f842 : int -> int -> int - val f843 : int -> int -> int - val f844 : int -> int -> int - val f845 : int -> int -> int - val f846 : int -> int -> int - val f847 : int -> int -> int - val f848 : int -> int -> int - val f849 : int -> int -> int - val f850 : int -> int -> int - val f851 : int -> int -> int - val f852 : int -> int -> int - val f853 : int -> int -> int - val f854 : int -> int -> int - val f855 : int -> int -> int - val f856 : int -> int -> int - val f857 : int -> int -> int - val f858 : int -> int -> int - val f859 : int -> int -> int - val f860 : int -> int -> int - val f861 : int -> int -> int - val f862 : int -> int -> int - val f863 : int -> int -> int - val f864 : int -> int -> int - val f865 : int -> int -> int - val f866 : int -> int -> int - val f867 : int -> int -> int - val f868 : int -> int -> int - val f869 : int -> int -> int - val f870 : int -> int -> int - val f871 : int -> int -> int - val f872 : int -> int -> int - val f873 : int -> int -> int - val f874 : int -> int -> int - val f875 : int -> int -> int - val f876 : int -> int -> int - val f877 : int -> int -> int - val f878 : int -> int -> int - val f879 : int -> int -> int - val f880 : int -> int -> int - val f881 : int -> int -> int - val f882 : int -> int -> int - val f883 : int -> int -> int - val f884 : int -> int -> int - val f885 : int -> int -> int - val f886 : int -> int -> int - val f887 : int -> int -> int - val f888 : int -> int -> int - val f889 : int -> int -> int - val f890 : int -> int -> int - val f891 : int -> int -> int - val f892 : int -> int -> int - val f893 : int -> int -> int - val f894 : int -> int -> int - val f895 : int -> int -> int - val f896 : int -> int -> int - val f897 : int -> int -> int - val f898 : int -> int -> int - val f899 : int -> int -> int - val f900 : int -> int -> int - val f901 : int -> int -> int - val f902 : int -> int -> int - val f903 : int -> int -> int - val f904 : int -> int -> int - val f905 : int -> int -> int - val f906 : int -> int -> int - val f907 : int -> int -> int - val f908 : int -> int -> int - val f909 : int -> int -> int - val f910 : int -> int -> int - val f911 : int -> int -> int - val f912 : int -> int -> int - val f913 : int -> int -> int - val f914 : int -> int -> int - val f915 : int -> int -> int - val f916 : int -> int -> int - val f917 : int -> int -> int - val f918 : int -> int -> int - val f919 : int -> int -> int - val f920 : int -> int -> int - val f921 : int -> int -> int - val f922 : int -> int -> int - val f923 : int -> int -> int - val f924 : int -> int -> int - val f925 : int -> int -> int - val f926 : int -> int -> int - val f927 : int -> int -> int - val f928 : int -> int -> int - val f929 : int -> int -> int - val f930 : int -> int -> int - val f931 : int -> int -> int - val f932 : int -> int -> int - val f933 : int -> int -> int - val f934 : int -> int -> int - val f935 : int -> int -> int - val f936 : int -> int -> int - val f937 : int -> int -> int - val f938 : int -> int -> int - val f939 : int -> int -> int - val f940 : int -> int -> int - val f941 : int -> int -> int - val f942 : int -> int -> int - val f943 : int -> int -> int - val f944 : int -> int -> int - val f945 : int -> int -> int - val f946 : int -> int -> int - val f947 : int -> int -> int - val f948 : int -> int -> int - val f949 : int -> int -> int - val f950 : int -> int -> int - val f951 : int -> int -> int - val f952 : int -> int -> int - val f953 : int -> int -> int - val f954 : int -> int -> int - val f955 : int -> int -> int - val f956 : int -> int -> int - val f957 : int -> int -> int - val f958 : int -> int -> int - val f959 : int -> int -> int - val f960 : int -> int -> int - val f961 : int -> int -> int - val f962 : int -> int -> int - val f963 : int -> int -> int - val f964 : int -> int -> int - val f965 : int -> int -> int - val f966 : int -> int -> int - val f967 : int -> int -> int - val f968 : int -> int -> int - val f969 : int -> int -> int - val f970 : int -> int -> int - val f971 : int -> int -> int - val f972 : int -> int -> int - val f973 : int -> int -> int - val f974 : int -> int -> int - val f975 : int -> int -> int - val f976 : int -> int -> int - val f977 : int -> int -> int - val f978 : int -> int -> int - val f979 : int -> int -> int - val f980 : int -> int -> int - val f981 : int -> int -> int - val f982 : int -> int -> int - val f983 : int -> int -> int - val f984 : int -> int -> int - val f985 : int -> int -> int - val f986 : int -> int -> int - val f987 : int -> int -> int - val f988 : int -> int -> int - val f989 : int -> int -> int - val f990 : int -> int -> int - val f991 : int -> int -> int - val f992 : int -> int -> int - val f993 : int -> int -> int - val f994 : int -> int -> int - val f995 : int -> int -> int - val f996 : int -> int -> int - val f997 : int -> int -> int - val f998 : int -> int -> int - val f999 : int -> int -> int - val f1000 : int -> int -> int -end - -module Make (M : S) = struct - include M -end - -module M = struct -(* <%- for i in 0 .. 1000 do -%> - let f<%= i %> = ( + ) -<%- end -%> *) - let f0 = ( + ) - let f1 = ( + ) - let f2 = ( + ) - let f3 = ( + ) - let f4 = ( + ) - let f5 = ( + ) - let f6 = ( + ) - let f7 = ( + ) - let f8 = ( + ) - let f9 = ( + ) - let f10 = ( + ) - let f11 = ( + ) - let f12 = ( + ) - let f13 = ( + ) - let f14 = ( + ) - let f15 = ( + ) - let f16 = ( + ) - let f17 = ( + ) - let f18 = ( + ) - let f19 = ( + ) - let f20 = ( + ) - let f21 = ( + ) - let f22 = ( + ) - let f23 = ( + ) - let f24 = ( + ) - let f25 = ( + ) - let f26 = ( + ) - let f27 = ( + ) - let f28 = ( + ) - let f29 = ( + ) - let f30 = ( + ) - let f31 = ( + ) - let f32 = ( + ) - let f33 = ( + ) - let f34 = ( + ) - let f35 = ( + ) - let f36 = ( + ) - let f37 = ( + ) - let f38 = ( + ) - let f39 = ( + ) - let f40 = ( + ) - let f41 = ( + ) - let f42 = ( + ) - let f43 = ( + ) - let f44 = ( + ) - let f45 = ( + ) - let f46 = ( + ) - let f47 = ( + ) - let f48 = ( + ) - let f49 = ( + ) - let f50 = ( + ) - let f51 = ( + ) - let f52 = ( + ) - let f53 = ( + ) - let f54 = ( + ) - let f55 = ( + ) - let f56 = ( + ) - let f57 = ( + ) - let f58 = ( + ) - let f59 = ( + ) - let f60 = ( + ) - let f61 = ( + ) - let f62 = ( + ) - let f63 = ( + ) - let f64 = ( + ) - let f65 = ( + ) - let f66 = ( + ) - let f67 = ( + ) - let f68 = ( + ) - let f69 = ( + ) - let f70 = ( + ) - let f71 = ( + ) - let f72 = ( + ) - let f73 = ( + ) - let f74 = ( + ) - let f75 = ( + ) - let f76 = ( + ) - let f77 = ( + ) - let f78 = ( + ) - let f79 = ( + ) - let f80 = ( + ) - let f81 = ( + ) - let f82 = ( + ) - let f83 = ( + ) - let f84 = ( + ) - let f85 = ( + ) - let f86 = ( + ) - let f87 = ( + ) - let f88 = ( + ) - let f89 = ( + ) - let f90 = ( + ) - let f91 = ( + ) - let f92 = ( + ) - let f93 = ( + ) - let f94 = ( + ) - let f95 = ( + ) - let f96 = ( + ) - let f97 = ( + ) - let f98 = ( + ) - let f99 = ( + ) - let f100 = ( + ) - let f101 = ( + ) - let f102 = ( + ) - let f103 = ( + ) - let f104 = ( + ) - let f105 = ( + ) - let f106 = ( + ) - let f107 = ( + ) - let f108 = ( + ) - let f109 = ( + ) - let f110 = ( + ) - let f111 = ( + ) - let f112 = ( + ) - let f113 = ( + ) - let f114 = ( + ) - let f115 = ( + ) - let f116 = ( + ) - let f117 = ( + ) - let f118 = ( + ) - let f119 = ( + ) - let f120 = ( + ) - let f121 = ( + ) - let f122 = ( + ) - let f123 = ( + ) - let f124 = ( + ) - let f125 = ( + ) - let f126 = ( + ) - let f127 = ( + ) - let f128 = ( + ) - let f129 = ( + ) - let f130 = ( + ) - let f131 = ( + ) - let f132 = ( + ) - let f133 = ( + ) - let f134 = ( + ) - let f135 = ( + ) - let f136 = ( + ) - let f137 = ( + ) - let f138 = ( + ) - let f139 = ( + ) - let f140 = ( + ) - let f141 = ( + ) - let f142 = ( + ) - let f143 = ( + ) - let f144 = ( + ) - let f145 = ( + ) - let f146 = ( + ) - let f147 = ( + ) - let f148 = ( + ) - let f149 = ( + ) - let f150 = ( + ) - let f151 = ( + ) - let f152 = ( + ) - let f153 = ( + ) - let f154 = ( + ) - let f155 = ( + ) - let f156 = ( + ) - let f157 = ( + ) - let f158 = ( + ) - let f159 = ( + ) - let f160 = ( + ) - let f161 = ( + ) - let f162 = ( + ) - let f163 = ( + ) - let f164 = ( + ) - let f165 = ( + ) - let f166 = ( + ) - let f167 = ( + ) - let f168 = ( + ) - let f169 = ( + ) - let f170 = ( + ) - let f171 = ( + ) - let f172 = ( + ) - let f173 = ( + ) - let f174 = ( + ) - let f175 = ( + ) - let f176 = ( + ) - let f177 = ( + ) - let f178 = ( + ) - let f179 = ( + ) - let f180 = ( + ) - let f181 = ( + ) - let f182 = ( + ) - let f183 = ( + ) - let f184 = ( + ) - let f185 = ( + ) - let f186 = ( + ) - let f187 = ( + ) - let f188 = ( + ) - let f189 = ( + ) - let f190 = ( + ) - let f191 = ( + ) - let f192 = ( + ) - let f193 = ( + ) - let f194 = ( + ) - let f195 = ( + ) - let f196 = ( + ) - let f197 = ( + ) - let f198 = ( + ) - let f199 = ( + ) - let f200 = ( + ) - let f201 = ( + ) - let f202 = ( + ) - let f203 = ( + ) - let f204 = ( + ) - let f205 = ( + ) - let f206 = ( + ) - let f207 = ( + ) - let f208 = ( + ) - let f209 = ( + ) - let f210 = ( + ) - let f211 = ( + ) - let f212 = ( + ) - let f213 = ( + ) - let f214 = ( + ) - let f215 = ( + ) - let f216 = ( + ) - let f217 = ( + ) - let f218 = ( + ) - let f219 = ( + ) - let f220 = ( + ) - let f221 = ( + ) - let f222 = ( + ) - let f223 = ( + ) - let f224 = ( + ) - let f225 = ( + ) - let f226 = ( + ) - let f227 = ( + ) - let f228 = ( + ) - let f229 = ( + ) - let f230 = ( + ) - let f231 = ( + ) - let f232 = ( + ) - let f233 = ( + ) - let f234 = ( + ) - let f235 = ( + ) - let f236 = ( + ) - let f237 = ( + ) - let f238 = ( + ) - let f239 = ( + ) - let f240 = ( + ) - let f241 = ( + ) - let f242 = ( + ) - let f243 = ( + ) - let f244 = ( + ) - let f245 = ( + ) - let f246 = ( + ) - let f247 = ( + ) - let f248 = ( + ) - let f249 = ( + ) - let f250 = ( + ) - let f251 = ( + ) - let f252 = ( + ) - let f253 = ( + ) - let f254 = ( + ) - let f255 = ( + ) - let f256 = ( + ) - let f257 = ( + ) - let f258 = ( + ) - let f259 = ( + ) - let f260 = ( + ) - let f261 = ( + ) - let f262 = ( + ) - let f263 = ( + ) - let f264 = ( + ) - let f265 = ( + ) - let f266 = ( + ) - let f267 = ( + ) - let f268 = ( + ) - let f269 = ( + ) - let f270 = ( + ) - let f271 = ( + ) - let f272 = ( + ) - let f273 = ( + ) - let f274 = ( + ) - let f275 = ( + ) - let f276 = ( + ) - let f277 = ( + ) - let f278 = ( + ) - let f279 = ( + ) - let f280 = ( + ) - let f281 = ( + ) - let f282 = ( + ) - let f283 = ( + ) - let f284 = ( + ) - let f285 = ( + ) - let f286 = ( + ) - let f287 = ( + ) - let f288 = ( + ) - let f289 = ( + ) - let f290 = ( + ) - let f291 = ( + ) - let f292 = ( + ) - let f293 = ( + ) - let f294 = ( + ) - let f295 = ( + ) - let f296 = ( + ) - let f297 = ( + ) - let f298 = ( + ) - let f299 = ( + ) - let f300 = ( + ) - let f301 = ( + ) - let f302 = ( + ) - let f303 = ( + ) - let f304 = ( + ) - let f305 = ( + ) - let f306 = ( + ) - let f307 = ( + ) - let f308 = ( + ) - let f309 = ( + ) - let f310 = ( + ) - let f311 = ( + ) - let f312 = ( + ) - let f313 = ( + ) - let f314 = ( + ) - let f315 = ( + ) - let f316 = ( + ) - let f317 = ( + ) - let f318 = ( + ) - let f319 = ( + ) - let f320 = ( + ) - let f321 = ( + ) - let f322 = ( + ) - let f323 = ( + ) - let f324 = ( + ) - let f325 = ( + ) - let f326 = ( + ) - let f327 = ( + ) - let f328 = ( + ) - let f329 = ( + ) - let f330 = ( + ) - let f331 = ( + ) - let f332 = ( + ) - let f333 = ( + ) - let f334 = ( + ) - let f335 = ( + ) - let f336 = ( + ) - let f337 = ( + ) - let f338 = ( + ) - let f339 = ( + ) - let f340 = ( + ) - let f341 = ( + ) - let f342 = ( + ) - let f343 = ( + ) - let f344 = ( + ) - let f345 = ( + ) - let f346 = ( + ) - let f347 = ( + ) - let f348 = ( + ) - let f349 = ( + ) - let f350 = ( + ) - let f351 = ( + ) - let f352 = ( + ) - let f353 = ( + ) - let f354 = ( + ) - let f355 = ( + ) - let f356 = ( + ) - let f357 = ( + ) - let f358 = ( + ) - let f359 = ( + ) - let f360 = ( + ) - let f361 = ( + ) - let f362 = ( + ) - let f363 = ( + ) - let f364 = ( + ) - let f365 = ( + ) - let f366 = ( + ) - let f367 = ( + ) - let f368 = ( + ) - let f369 = ( + ) - let f370 = ( + ) - let f371 = ( + ) - let f372 = ( + ) - let f373 = ( + ) - let f374 = ( + ) - let f375 = ( + ) - let f376 = ( + ) - let f377 = ( + ) - let f378 = ( + ) - let f379 = ( + ) - let f380 = ( + ) - let f381 = ( + ) - let f382 = ( + ) - let f383 = ( + ) - let f384 = ( + ) - let f385 = ( + ) - let f386 = ( + ) - let f387 = ( + ) - let f388 = ( + ) - let f389 = ( + ) - let f390 = ( + ) - let f391 = ( + ) - let f392 = ( + ) - let f393 = ( + ) - let f394 = ( + ) - let f395 = ( + ) - let f396 = ( + ) - let f397 = ( + ) - let f398 = ( + ) - let f399 = ( + ) - let f400 = ( + ) - let f401 = ( + ) - let f402 = ( + ) - let f403 = ( + ) - let f404 = ( + ) - let f405 = ( + ) - let f406 = ( + ) - let f407 = ( + ) - let f408 = ( + ) - let f409 = ( + ) - let f410 = ( + ) - let f411 = ( + ) - let f412 = ( + ) - let f413 = ( + ) - let f414 = ( + ) - let f415 = ( + ) - let f416 = ( + ) - let f417 = ( + ) - let f418 = ( + ) - let f419 = ( + ) - let f420 = ( + ) - let f421 = ( + ) - let f422 = ( + ) - let f423 = ( + ) - let f424 = ( + ) - let f425 = ( + ) - let f426 = ( + ) - let f427 = ( + ) - let f428 = ( + ) - let f429 = ( + ) - let f430 = ( + ) - let f431 = ( + ) - let f432 = ( + ) - let f433 = ( + ) - let f434 = ( + ) - let f435 = ( + ) - let f436 = ( + ) - let f437 = ( + ) - let f438 = ( + ) - let f439 = ( + ) - let f440 = ( + ) - let f441 = ( + ) - let f442 = ( + ) - let f443 = ( + ) - let f444 = ( + ) - let f445 = ( + ) - let f446 = ( + ) - let f447 = ( + ) - let f448 = ( + ) - let f449 = ( + ) - let f450 = ( + ) - let f451 = ( + ) - let f452 = ( + ) - let f453 = ( + ) - let f454 = ( + ) - let f455 = ( + ) - let f456 = ( + ) - let f457 = ( + ) - let f458 = ( + ) - let f459 = ( + ) - let f460 = ( + ) - let f461 = ( + ) - let f462 = ( + ) - let f463 = ( + ) - let f464 = ( + ) - let f465 = ( + ) - let f466 = ( + ) - let f467 = ( + ) - let f468 = ( + ) - let f469 = ( + ) - let f470 = ( + ) - let f471 = ( + ) - let f472 = ( + ) - let f473 = ( + ) - let f474 = ( + ) - let f475 = ( + ) - let f476 = ( + ) - let f477 = ( + ) - let f478 = ( + ) - let f479 = ( + ) - let f480 = ( + ) - let f481 = ( + ) - let f482 = ( + ) - let f483 = ( + ) - let f484 = ( + ) - let f485 = ( + ) - let f486 = ( + ) - let f487 = ( + ) - let f488 = ( + ) - let f489 = ( + ) - let f490 = ( + ) - let f491 = ( + ) - let f492 = ( + ) - let f493 = ( + ) - let f494 = ( + ) - let f495 = ( + ) - let f496 = ( + ) - let f497 = ( + ) - let f498 = ( + ) - let f499 = ( + ) - let f500 = ( + ) - let f501 = ( + ) - let f502 = ( + ) - let f503 = ( + ) - let f504 = ( + ) - let f505 = ( + ) - let f506 = ( + ) - let f507 = ( + ) - let f508 = ( + ) - let f509 = ( + ) - let f510 = ( + ) - let f511 = ( + ) - let f512 = ( + ) - let f513 = ( + ) - let f514 = ( + ) - let f515 = ( + ) - let f516 = ( + ) - let f517 = ( + ) - let f518 = ( + ) - let f519 = ( + ) - let f520 = ( + ) - let f521 = ( + ) - let f522 = ( + ) - let f523 = ( + ) - let f524 = ( + ) - let f525 = ( + ) - let f526 = ( + ) - let f527 = ( + ) - let f528 = ( + ) - let f529 = ( + ) - let f530 = ( + ) - let f531 = ( + ) - let f532 = ( + ) - let f533 = ( + ) - let f534 = ( + ) - let f535 = ( + ) - let f536 = ( + ) - let f537 = ( + ) - let f538 = ( + ) - let f539 = ( + ) - let f540 = ( + ) - let f541 = ( + ) - let f542 = ( + ) - let f543 = ( + ) - let f544 = ( + ) - let f545 = ( + ) - let f546 = ( + ) - let f547 = ( + ) - let f548 = ( + ) - let f549 = ( + ) - let f550 = ( + ) - let f551 = ( + ) - let f552 = ( + ) - let f553 = ( + ) - let f554 = ( + ) - let f555 = ( + ) - let f556 = ( + ) - let f557 = ( + ) - let f558 = ( + ) - let f559 = ( + ) - let f560 = ( + ) - let f561 = ( + ) - let f562 = ( + ) - let f563 = ( + ) - let f564 = ( + ) - let f565 = ( + ) - let f566 = ( + ) - let f567 = ( + ) - let f568 = ( + ) - let f569 = ( + ) - let f570 = ( + ) - let f571 = ( + ) - let f572 = ( + ) - let f573 = ( + ) - let f574 = ( + ) - let f575 = ( + ) - let f576 = ( + ) - let f577 = ( + ) - let f578 = ( + ) - let f579 = ( + ) - let f580 = ( + ) - let f581 = ( + ) - let f582 = ( + ) - let f583 = ( + ) - let f584 = ( + ) - let f585 = ( + ) - let f586 = ( + ) - let f587 = ( + ) - let f588 = ( + ) - let f589 = ( + ) - let f590 = ( + ) - let f591 = ( + ) - let f592 = ( + ) - let f593 = ( + ) - let f594 = ( + ) - let f595 = ( + ) - let f596 = ( + ) - let f597 = ( + ) - let f598 = ( + ) - let f599 = ( + ) - let f600 = ( + ) - let f601 = ( + ) - let f602 = ( + ) - let f603 = ( + ) - let f604 = ( + ) - let f605 = ( + ) - let f606 = ( + ) - let f607 = ( + ) - let f608 = ( + ) - let f609 = ( + ) - let f610 = ( + ) - let f611 = ( + ) - let f612 = ( + ) - let f613 = ( + ) - let f614 = ( + ) - let f615 = ( + ) - let f616 = ( + ) - let f617 = ( + ) - let f618 = ( + ) - let f619 = ( + ) - let f620 = ( + ) - let f621 = ( + ) - let f622 = ( + ) - let f623 = ( + ) - let f624 = ( + ) - let f625 = ( + ) - let f626 = ( + ) - let f627 = ( + ) - let f628 = ( + ) - let f629 = ( + ) - let f630 = ( + ) - let f631 = ( + ) - let f632 = ( + ) - let f633 = ( + ) - let f634 = ( + ) - let f635 = ( + ) - let f636 = ( + ) - let f637 = ( + ) - let f638 = ( + ) - let f639 = ( + ) - let f640 = ( + ) - let f641 = ( + ) - let f642 = ( + ) - let f643 = ( + ) - let f644 = ( + ) - let f645 = ( + ) - let f646 = ( + ) - let f647 = ( + ) - let f648 = ( + ) - let f649 = ( + ) - let f650 = ( + ) - let f651 = ( + ) - let f652 = ( + ) - let f653 = ( + ) - let f654 = ( + ) - let f655 = ( + ) - let f656 = ( + ) - let f657 = ( + ) - let f658 = ( + ) - let f659 = ( + ) - let f660 = ( + ) - let f661 = ( + ) - let f662 = ( + ) - let f663 = ( + ) - let f664 = ( + ) - let f665 = ( + ) - let f666 = ( + ) - let f667 = ( + ) - let f668 = ( + ) - let f669 = ( + ) - let f670 = ( + ) - let f671 = ( + ) - let f672 = ( + ) - let f673 = ( + ) - let f674 = ( + ) - let f675 = ( + ) - let f676 = ( + ) - let f677 = ( + ) - let f678 = ( + ) - let f679 = ( + ) - let f680 = ( + ) - let f681 = ( + ) - let f682 = ( + ) - let f683 = ( + ) - let f684 = ( + ) - let f685 = ( + ) - let f686 = ( + ) - let f687 = ( + ) - let f688 = ( + ) - let f689 = ( + ) - let f690 = ( + ) - let f691 = ( + ) - let f692 = ( + ) - let f693 = ( + ) - let f694 = ( + ) - let f695 = ( + ) - let f696 = ( + ) - let f697 = ( + ) - let f698 = ( + ) - let f699 = ( + ) - let f700 = ( + ) - let f701 = ( + ) - let f702 = ( + ) - let f703 = ( + ) - let f704 = ( + ) - let f705 = ( + ) - let f706 = ( + ) - let f707 = ( + ) - let f708 = ( + ) - let f709 = ( + ) - let f710 = ( + ) - let f711 = ( + ) - let f712 = ( + ) - let f713 = ( + ) - let f714 = ( + ) - let f715 = ( + ) - let f716 = ( + ) - let f717 = ( + ) - let f718 = ( + ) - let f719 = ( + ) - let f720 = ( + ) - let f721 = ( + ) - let f722 = ( + ) - let f723 = ( + ) - let f724 = ( + ) - let f725 = ( + ) - let f726 = ( + ) - let f727 = ( + ) - let f728 = ( + ) - let f729 = ( + ) - let f730 = ( + ) - let f731 = ( + ) - let f732 = ( + ) - let f733 = ( + ) - let f734 = ( + ) - let f735 = ( + ) - let f736 = ( + ) - let f737 = ( + ) - let f738 = ( + ) - let f739 = ( + ) - let f740 = ( + ) - let f741 = ( + ) - let f742 = ( + ) - let f743 = ( + ) - let f744 = ( + ) - let f745 = ( + ) - let f746 = ( + ) - let f747 = ( + ) - let f748 = ( + ) - let f749 = ( + ) - let f750 = ( + ) - let f751 = ( + ) - let f752 = ( + ) - let f753 = ( + ) - let f754 = ( + ) - let f755 = ( + ) - let f756 = ( + ) - let f757 = ( + ) - let f758 = ( + ) - let f759 = ( + ) - let f760 = ( + ) - let f761 = ( + ) - let f762 = ( + ) - let f763 = ( + ) - let f764 = ( + ) - let f765 = ( + ) - let f766 = ( + ) - let f767 = ( + ) - let f768 = ( + ) - let f769 = ( + ) - let f770 = ( + ) - let f771 = ( + ) - let f772 = ( + ) - let f773 = ( + ) - let f774 = ( + ) - let f775 = ( + ) - let f776 = ( + ) - let f777 = ( + ) - let f778 = ( + ) - let f779 = ( + ) - let f780 = ( + ) - let f781 = ( + ) - let f782 = ( + ) - let f783 = ( + ) - let f784 = ( + ) - let f785 = ( + ) - let f786 = ( + ) - let f787 = ( + ) - let f788 = ( + ) - let f789 = ( + ) - let f790 = ( + ) - let f791 = ( + ) - let f792 = ( + ) - let f793 = ( + ) - let f794 = ( + ) - let f795 = ( + ) - let f796 = ( + ) - let f797 = ( + ) - let f798 = ( + ) - let f799 = ( + ) - let f800 = ( + ) - let f801 = ( + ) - let f802 = ( + ) - let f803 = ( + ) - let f804 = ( + ) - let f805 = ( + ) - let f806 = ( + ) - let f807 = ( + ) - let f808 = ( + ) - let f809 = ( + ) - let f810 = ( + ) - let f811 = ( + ) - let f812 = ( + ) - let f813 = ( + ) - let f814 = ( + ) - let f815 = ( + ) - let f816 = ( + ) - let f817 = ( + ) - let f818 = ( + ) - let f819 = ( + ) - let f820 = ( + ) - let f821 = ( + ) - let f822 = ( + ) - let f823 = ( + ) - let f824 = ( + ) - let f825 = ( + ) - let f826 = ( + ) - let f827 = ( + ) - let f828 = ( + ) - let f829 = ( + ) - let f830 = ( + ) - let f831 = ( + ) - let f832 = ( + ) - let f833 = ( + ) - let f834 = ( + ) - let f835 = ( + ) - let f836 = ( + ) - let f837 = ( + ) - let f838 = ( + ) - let f839 = ( + ) - let f840 = ( + ) - let f841 = ( + ) - let f842 = ( + ) - let f843 = ( + ) - let f844 = ( + ) - let f845 = ( + ) - let f846 = ( + ) - let f847 = ( + ) - let f848 = ( + ) - let f849 = ( + ) - let f850 = ( + ) - let f851 = ( + ) - let f852 = ( + ) - let f853 = ( + ) - let f854 = ( + ) - let f855 = ( + ) - let f856 = ( + ) - let f857 = ( + ) - let f858 = ( + ) - let f859 = ( + ) - let f860 = ( + ) - let f861 = ( + ) - let f862 = ( + ) - let f863 = ( + ) - let f864 = ( + ) - let f865 = ( + ) - let f866 = ( + ) - let f867 = ( + ) - let f868 = ( + ) - let f869 = ( + ) - let f870 = ( + ) - let f871 = ( + ) - let f872 = ( + ) - let f873 = ( + ) - let f874 = ( + ) - let f875 = ( + ) - let f876 = ( + ) - let f877 = ( + ) - let f878 = ( + ) - let f879 = ( + ) - let f880 = ( + ) - let f881 = ( + ) - let f882 = ( + ) - let f883 = ( + ) - let f884 = ( + ) - let f885 = ( + ) - let f886 = ( + ) - let f887 = ( + ) - let f888 = ( + ) - let f889 = ( + ) - let f890 = ( + ) - let f891 = ( + ) - let f892 = ( + ) - let f893 = ( + ) - let f894 = ( + ) - let f895 = ( + ) - let f896 = ( + ) - let f897 = ( + ) - let f898 = ( + ) - let f899 = ( + ) - let f900 = ( + ) - let f901 = ( + ) - let f902 = ( + ) - let f903 = ( + ) - let f904 = ( + ) - let f905 = ( + ) - let f906 = ( + ) - let f907 = ( + ) - let f908 = ( + ) - let f909 = ( + ) - let f910 = ( + ) - let f911 = ( + ) - let f912 = ( + ) - let f913 = ( + ) - let f914 = ( + ) - let f915 = ( + ) - let f916 = ( + ) - let f917 = ( + ) - let f918 = ( + ) - let f919 = ( + ) - let f920 = ( + ) - let f921 = ( + ) - let f922 = ( + ) - let f923 = ( + ) - let f924 = ( + ) - let f925 = ( + ) - let f926 = ( + ) - let f927 = ( + ) - let f928 = ( + ) - let f929 = ( + ) - let f930 = ( + ) - let f931 = ( + ) - let f932 = ( + ) - let f933 = ( + ) - let f934 = ( + ) - let f935 = ( + ) - let f936 = ( + ) - let f937 = ( + ) - let f938 = ( + ) - let f939 = ( + ) - let f940 = ( + ) - let f941 = ( + ) - let f942 = ( + ) - let f943 = ( + ) - let f944 = ( + ) - let f945 = ( + ) - let f946 = ( + ) - let f947 = ( + ) - let f948 = ( + ) - let f949 = ( + ) - let f950 = ( + ) - let f951 = ( + ) - let f952 = ( + ) - let f953 = ( + ) - let f954 = ( + ) - let f955 = ( + ) - let f956 = ( + ) - let f957 = ( + ) - let f958 = ( + ) - let f959 = ( + ) - let f960 = ( + ) - let f961 = ( + ) - let f962 = ( + ) - let f963 = ( + ) - let f964 = ( + ) - let f965 = ( + ) - let f966 = ( + ) - let f967 = ( + ) - let f968 = ( + ) - let f969 = ( + ) - let f970 = ( + ) - let f971 = ( + ) - let f972 = ( + ) - let f973 = ( + ) - let f974 = ( + ) - let f975 = ( + ) - let f976 = ( + ) - let f977 = ( + ) - let f978 = ( + ) - let f979 = ( + ) - let f980 = ( + ) - let f981 = ( + ) - let f982 = ( + ) - let f983 = ( + ) - let f984 = ( + ) - let f985 = ( + ) - let f986 = ( + ) - let f987 = ( + ) - let f988 = ( + ) - let f989 = ( + ) - let f990 = ( + ) - let f991 = ( + ) - let f992 = ( + ) - let f993 = ( + ) - let f994 = ( + ) - let f995 = ( + ) - let f996 = ( + ) - let f997 = ( + ) - let f998 = ( + ) - let f999 = ( + ) - let f1000 = ( + ) -end - -module X = Make(Make(Make(M))) diff -Nru ocaml-3.12.1/camlp4/test/fixtures/functor-perf2.gen.ml ocaml-4.01.0/camlp4/test/fixtures/functor-perf2.gen.ml --- ocaml-3.12.1/camlp4/test/fixtures/functor-perf2.gen.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/functor-perf2.gen.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,3029 +0,0 @@ - - -module type S = sig - type t0 - type t1 - type t2 - type t3 - type t4 - type t5 - type t6 - type t7 - type t8 - type t9 - type t10 - type t11 - type t12 - type t13 - type t14 - type t15 - type t16 - type t17 - type t18 - type t19 - type t20 - type t21 - type t22 - type t23 - type t24 - type t25 - type t26 - type t27 - type t28 - type t29 - type t30 - type t31 - type t32 - type t33 - type t34 - type t35 - type t36 - type t37 - type t38 - type t39 - type t40 - type t41 - type t42 - type t43 - type t44 - type t45 - type t46 - type t47 - type t48 - type t49 - type t50 - type t51 - type t52 - type t53 - type t54 - type t55 - type t56 - type t57 - type t58 - type t59 - type t60 - type t61 - type t62 - type t63 - type t64 - type t65 - type t66 - type t67 - type t68 - type t69 - type t70 - type t71 - type t72 - type t73 - type t74 - type t75 - type t76 - type t77 - type t78 - type t79 - type t80 - type t81 - type t82 - type t83 - type t84 - type t85 - type t86 - type t87 - type t88 - type t89 - type t90 - type t91 - type t92 - type t93 - type t94 - type t95 - type t96 - type t97 - type t98 - type t99 - type t100 - type t101 - type t102 - type t103 - type t104 - type t105 - type t106 - type t107 - type t108 - type t109 - type t110 - type t111 - type t112 - type t113 - type t114 - type t115 - type t116 - type t117 - type t118 - type t119 - type t120 - type t121 - type t122 - type t123 - type t124 - type t125 - type t126 - type t127 - type t128 - type t129 - type t130 - type t131 - type t132 - type t133 - type t134 - type t135 - type t136 - type t137 - type t138 - type t139 - type t140 - type t141 - type t142 - type t143 - type t144 - type t145 - type t146 - type t147 - type t148 - type t149 - type t150 - type t151 - type t152 - type t153 - type t154 - type t155 - type t156 - type t157 - type t158 - type t159 - type t160 - type t161 - type t162 - type t163 - type t164 - type t165 - type t166 - type t167 - type t168 - type t169 - type t170 - type t171 - type t172 - type t173 - type t174 - type t175 - type t176 - type t177 - type t178 - type t179 - type t180 - type t181 - type t182 - type t183 - type t184 - type t185 - type t186 - type t187 - type t188 - type t189 - type t190 - type t191 - type t192 - type t193 - type t194 - type t195 - type t196 - type t197 - type t198 - type t199 - type t200 - type t201 - type t202 - type t203 - type t204 - type t205 - type t206 - type t207 - type t208 - type t209 - type t210 - type t211 - type t212 - type t213 - type t214 - type t215 - type t216 - type t217 - type t218 - type t219 - type t220 - type t221 - type t222 - type t223 - type t224 - type t225 - type t226 - type t227 - type t228 - type t229 - type t230 - type t231 - type t232 - type t233 - type t234 - type t235 - type t236 - type t237 - type t238 - type t239 - type t240 - type t241 - type t242 - type t243 - type t244 - type t245 - type t246 - type t247 - type t248 - type t249 - type t250 - type t251 - type t252 - type t253 - type t254 - type t255 - type t256 - type t257 - type t258 - type t259 - type t260 - type t261 - type t262 - type t263 - type t264 - type t265 - type t266 - type t267 - type t268 - type t269 - type t270 - type t271 - type t272 - type t273 - type t274 - type t275 - type t276 - type t277 - type t278 - type t279 - type t280 - type t281 - type t282 - type t283 - type t284 - type t285 - type t286 - type t287 - type t288 - type t289 - type t290 - type t291 - type t292 - type t293 - type t294 - type t295 - type t296 - type t297 - type t298 - type t299 - type t300 - type t301 - type t302 - type t303 - type t304 - type t305 - type t306 - type t307 - type t308 - type t309 - type t310 - type t311 - type t312 - type t313 - type t314 - type t315 - type t316 - type t317 - type t318 - type t319 - type t320 - type t321 - type t322 - type t323 - type t324 - type t325 - type t326 - type t327 - type t328 - type t329 - type t330 - type t331 - type t332 - type t333 - type t334 - type t335 - type t336 - type t337 - type t338 - type t339 - type t340 - type t341 - type t342 - type t343 - type t344 - type t345 - type t346 - type t347 - type t348 - type t349 - type t350 - type t351 - type t352 - type t353 - type t354 - type t355 - type t356 - type t357 - type t358 - type t359 - type t360 - type t361 - type t362 - type t363 - type t364 - type t365 - type t366 - type t367 - type t368 - type t369 - type t370 - type t371 - type t372 - type t373 - type t374 - type t375 - type t376 - type t377 - type t378 - type t379 - type t380 - type t381 - type t382 - type t383 - type t384 - type t385 - type t386 - type t387 - type t388 - type t389 - type t390 - type t391 - type t392 - type t393 - type t394 - type t395 - type t396 - type t397 - type t398 - type t399 - type t400 - type t401 - type t402 - type t403 - type t404 - type t405 - type t406 - type t407 - type t408 - type t409 - type t410 - type t411 - type t412 - type t413 - type t414 - type t415 - type t416 - type t417 - type t418 - type t419 - type t420 - type t421 - type t422 - type t423 - type t424 - type t425 - type t426 - type t427 - type t428 - type t429 - type t430 - type t431 - type t432 - type t433 - type t434 - type t435 - type t436 - type t437 - type t438 - type t439 - type t440 - type t441 - type t442 - type t443 - type t444 - type t445 - type t446 - type t447 - type t448 - type t449 - type t450 - type t451 - type t452 - type t453 - type t454 - type t455 - type t456 - type t457 - type t458 - type t459 - type t460 - type t461 - type t462 - type t463 - type t464 - type t465 - type t466 - type t467 - type t468 - type t469 - type t470 - type t471 - type t472 - type t473 - type t474 - type t475 - type t476 - type t477 - type t478 - type t479 - type t480 - type t481 - type t482 - type t483 - type t484 - type t485 - type t486 - type t487 - type t488 - type t489 - type t490 - type t491 - type t492 - type t493 - type t494 - type t495 - type t496 - type t497 - type t498 - type t499 - type t500 - type t501 - type t502 - type t503 - type t504 - type t505 - type t506 - type t507 - type t508 - type t509 - type t510 - type t511 - type t512 - type t513 - type t514 - type t515 - type t516 - type t517 - type t518 - type t519 - type t520 - type t521 - type t522 - type t523 - type t524 - type t525 - type t526 - type t527 - type t528 - type t529 - type t530 - type t531 - type t532 - type t533 - type t534 - type t535 - type t536 - type t537 - type t538 - type t539 - type t540 - type t541 - type t542 - type t543 - type t544 - type t545 - type t546 - type t547 - type t548 - type t549 - type t550 - type t551 - type t552 - type t553 - type t554 - type t555 - type t556 - type t557 - type t558 - type t559 - type t560 - type t561 - type t562 - type t563 - type t564 - type t565 - type t566 - type t567 - type t568 - type t569 - type t570 - type t571 - type t572 - type t573 - type t574 - type t575 - type t576 - type t577 - type t578 - type t579 - type t580 - type t581 - type t582 - type t583 - type t584 - type t585 - type t586 - type t587 - type t588 - type t589 - type t590 - type t591 - type t592 - type t593 - type t594 - type t595 - type t596 - type t597 - type t598 - type t599 - type t600 - type t601 - type t602 - type t603 - type t604 - type t605 - type t606 - type t607 - type t608 - type t609 - type t610 - type t611 - type t612 - type t613 - type t614 - type t615 - type t616 - type t617 - type t618 - type t619 - type t620 - type t621 - type t622 - type t623 - type t624 - type t625 - type t626 - type t627 - type t628 - type t629 - type t630 - type t631 - type t632 - type t633 - type t634 - type t635 - type t636 - type t637 - type t638 - type t639 - type t640 - type t641 - type t642 - type t643 - type t644 - type t645 - type t646 - type t647 - type t648 - type t649 - type t650 - type t651 - type t652 - type t653 - type t654 - type t655 - type t656 - type t657 - type t658 - type t659 - type t660 - type t661 - type t662 - type t663 - type t664 - type t665 - type t666 - type t667 - type t668 - type t669 - type t670 - type t671 - type t672 - type t673 - type t674 - type t675 - type t676 - type t677 - type t678 - type t679 - type t680 - type t681 - type t682 - type t683 - type t684 - type t685 - type t686 - type t687 - type t688 - type t689 - type t690 - type t691 - type t692 - type t693 - type t694 - type t695 - type t696 - type t697 - type t698 - type t699 - type t700 - type t701 - type t702 - type t703 - type t704 - type t705 - type t706 - type t707 - type t708 - type t709 - type t710 - type t711 - type t712 - type t713 - type t714 - type t715 - type t716 - type t717 - type t718 - type t719 - type t720 - type t721 - type t722 - type t723 - type t724 - type t725 - type t726 - type t727 - type t728 - type t729 - type t730 - type t731 - type t732 - type t733 - type t734 - type t735 - type t736 - type t737 - type t738 - type t739 - type t740 - type t741 - type t742 - type t743 - type t744 - type t745 - type t746 - type t747 - type t748 - type t749 - type t750 - type t751 - type t752 - type t753 - type t754 - type t755 - type t756 - type t757 - type t758 - type t759 - type t760 - type t761 - type t762 - type t763 - type t764 - type t765 - type t766 - type t767 - type t768 - type t769 - type t770 - type t771 - type t772 - type t773 - type t774 - type t775 - type t776 - type t777 - type t778 - type t779 - type t780 - type t781 - type t782 - type t783 - type t784 - type t785 - type t786 - type t787 - type t788 - type t789 - type t790 - type t791 - type t792 - type t793 - type t794 - type t795 - type t796 - type t797 - type t798 - type t799 - type t800 - type t801 - type t802 - type t803 - type t804 - type t805 - type t806 - type t807 - type t808 - type t809 - type t810 - type t811 - type t812 - type t813 - type t814 - type t815 - type t816 - type t817 - type t818 - type t819 - type t820 - type t821 - type t822 - type t823 - type t824 - type t825 - type t826 - type t827 - type t828 - type t829 - type t830 - type t831 - type t832 - type t833 - type t834 - type t835 - type t836 - type t837 - type t838 - type t839 - type t840 - type t841 - type t842 - type t843 - type t844 - type t845 - type t846 - type t847 - type t848 - type t849 - type t850 - type t851 - type t852 - type t853 - type t854 - type t855 - type t856 - type t857 - type t858 - type t859 - type t860 - type t861 - type t862 - type t863 - type t864 - type t865 - type t866 - type t867 - type t868 - type t869 - type t870 - type t871 - type t872 - type t873 - type t874 - type t875 - type t876 - type t877 - type t878 - type t879 - type t880 - type t881 - type t882 - type t883 - type t884 - type t885 - type t886 - type t887 - type t888 - type t889 - type t890 - type t891 - type t892 - type t893 - type t894 - type t895 - type t896 - type t897 - type t898 - type t899 - type t900 - type t901 - type t902 - type t903 - type t904 - type t905 - type t906 - type t907 - type t908 - type t909 - type t910 - type t911 - type t912 - type t913 - type t914 - type t915 - type t916 - type t917 - type t918 - type t919 - type t920 - type t921 - type t922 - type t923 - type t924 - type t925 - type t926 - type t927 - type t928 - type t929 - type t930 - type t931 - type t932 - type t933 - type t934 - type t935 - type t936 - type t937 - type t938 - type t939 - type t940 - type t941 - type t942 - type t943 - type t944 - type t945 - type t946 - type t947 - type t948 - type t949 - type t950 - type t951 - type t952 - type t953 - type t954 - type t955 - type t956 - type t957 - type t958 - type t959 - type t960 - type t961 - type t962 - type t963 - type t964 - type t965 - type t966 - type t967 - type t968 - type t969 - type t970 - type t971 - type t972 - type t973 - type t974 - type t975 - type t976 - type t977 - type t978 - type t979 - type t980 - type t981 - type t982 - type t983 - type t984 - type t985 - type t986 - type t987 - type t988 - type t989 - type t990 - type t991 - type t992 - type t993 - type t994 - type t995 - type t996 - type t997 - type t998 - type t999 - type t1000 -end - -module Make (M : S) -: S with type t0 = M.t0 - and type t1 = M.t1 - and type t2 = M.t2 - and type t3 = M.t3 - and type t4 = M.t4 - and type t5 = M.t5 - and type t6 = M.t6 - and type t7 = M.t7 - and type t8 = M.t8 - and type t9 = M.t9 - and type t10 = M.t10 - and type t11 = M.t11 - and type t12 = M.t12 - and type t13 = M.t13 - and type t14 = M.t14 - and type t15 = M.t15 - and type t16 = M.t16 - and type t17 = M.t17 - and type t18 = M.t18 - and type t19 = M.t19 - and type t20 = M.t20 - and type t21 = M.t21 - and type t22 = M.t22 - and type t23 = M.t23 - and type t24 = M.t24 - and type t25 = M.t25 - and type t26 = M.t26 - and type t27 = M.t27 - and type t28 = M.t28 - and type t29 = M.t29 - and type t30 = M.t30 - and type t31 = M.t31 - and type t32 = M.t32 - and type t33 = M.t33 - and type t34 = M.t34 - and type t35 = M.t35 - and type t36 = M.t36 - and type t37 = M.t37 - and type t38 = M.t38 - and type t39 = M.t39 - and type t40 = M.t40 - and type t41 = M.t41 - and type t42 = M.t42 - and type t43 = M.t43 - and type t44 = M.t44 - and type t45 = M.t45 - and type t46 = M.t46 - and type t47 = M.t47 - and type t48 = M.t48 - and type t49 = M.t49 - and type t50 = M.t50 - and type t51 = M.t51 - and type t52 = M.t52 - and type t53 = M.t53 - and type t54 = M.t54 - and type t55 = M.t55 - and type t56 = M.t56 - and type t57 = M.t57 - and type t58 = M.t58 - and type t59 = M.t59 - and type t60 = M.t60 - and type t61 = M.t61 - and type t62 = M.t62 - and type t63 = M.t63 - and type t64 = M.t64 - and type t65 = M.t65 - and type t66 = M.t66 - and type t67 = M.t67 - and type t68 = M.t68 - and type t69 = M.t69 - and type t70 = M.t70 - and type t71 = M.t71 - and type t72 = M.t72 - and type t73 = M.t73 - and type t74 = M.t74 - and type t75 = M.t75 - and type t76 = M.t76 - and type t77 = M.t77 - and type t78 = M.t78 - and type t79 = M.t79 - and type t80 = M.t80 - and type t81 = M.t81 - and type t82 = M.t82 - and type t83 = M.t83 - and type t84 = M.t84 - and type t85 = M.t85 - and type t86 = M.t86 - and type t87 = M.t87 - and type t88 = M.t88 - and type t89 = M.t89 - and type t90 = M.t90 - and type t91 = M.t91 - and type t92 = M.t92 - and type t93 = M.t93 - and type t94 = M.t94 - and type t95 = M.t95 - and type t96 = M.t96 - and type t97 = M.t97 - and type t98 = M.t98 - and type t99 = M.t99 - and type t100 = M.t100 - and type t101 = M.t101 - and type t102 = M.t102 - and type t103 = M.t103 - and type t104 = M.t104 - and type t105 = M.t105 - and type t106 = M.t106 - and type t107 = M.t107 - and type t108 = M.t108 - and type t109 = M.t109 - and type t110 = M.t110 - and type t111 = M.t111 - and type t112 = M.t112 - and type t113 = M.t113 - and type t114 = M.t114 - and type t115 = M.t115 - and type t116 = M.t116 - and type t117 = M.t117 - and type t118 = M.t118 - and type t119 = M.t119 - and type t120 = M.t120 - and type t121 = M.t121 - and type t122 = M.t122 - and type t123 = M.t123 - and type t124 = M.t124 - and type t125 = M.t125 - and type t126 = M.t126 - and type t127 = M.t127 - and type t128 = M.t128 - and type t129 = M.t129 - and type t130 = M.t130 - and type t131 = M.t131 - and type t132 = M.t132 - and type t133 = M.t133 - and type t134 = M.t134 - and type t135 = M.t135 - and type t136 = M.t136 - and type t137 = M.t137 - and type t138 = M.t138 - and type t139 = M.t139 - and type t140 = M.t140 - and type t141 = M.t141 - and type t142 = M.t142 - and type t143 = M.t143 - and type t144 = M.t144 - and type t145 = M.t145 - and type t146 = M.t146 - and type t147 = M.t147 - and type t148 = M.t148 - and type t149 = M.t149 - and type t150 = M.t150 - and type t151 = M.t151 - and type t152 = M.t152 - and type t153 = M.t153 - and type t154 = M.t154 - and type t155 = M.t155 - and type t156 = M.t156 - and type t157 = M.t157 - and type t158 = M.t158 - and type t159 = M.t159 - and type t160 = M.t160 - and type t161 = M.t161 - and type t162 = M.t162 - and type t163 = M.t163 - and type t164 = M.t164 - and type t165 = M.t165 - and type t166 = M.t166 - and type t167 = M.t167 - and type t168 = M.t168 - and type t169 = M.t169 - and type t170 = M.t170 - and type t171 = M.t171 - and type t172 = M.t172 - and type t173 = M.t173 - and type t174 = M.t174 - and type t175 = M.t175 - and type t176 = M.t176 - and type t177 = M.t177 - and type t178 = M.t178 - and type t179 = M.t179 - and type t180 = M.t180 - and type t181 = M.t181 - and type t182 = M.t182 - and type t183 = M.t183 - and type t184 = M.t184 - and type t185 = M.t185 - and type t186 = M.t186 - and type t187 = M.t187 - and type t188 = M.t188 - and type t189 = M.t189 - and type t190 = M.t190 - and type t191 = M.t191 - and type t192 = M.t192 - and type t193 = M.t193 - and type t194 = M.t194 - and type t195 = M.t195 - and type t196 = M.t196 - and type t197 = M.t197 - and type t198 = M.t198 - and type t199 = M.t199 - and type t200 = M.t200 - and type t201 = M.t201 - and type t202 = M.t202 - and type t203 = M.t203 - and type t204 = M.t204 - and type t205 = M.t205 - and type t206 = M.t206 - and type t207 = M.t207 - and type t208 = M.t208 - and type t209 = M.t209 - and type t210 = M.t210 - and type t211 = M.t211 - and type t212 = M.t212 - and type t213 = M.t213 - and type t214 = M.t214 - and type t215 = M.t215 - and type t216 = M.t216 - and type t217 = M.t217 - and type t218 = M.t218 - and type t219 = M.t219 - and type t220 = M.t220 - and type t221 = M.t221 - and type t222 = M.t222 - and type t223 = M.t223 - and type t224 = M.t224 - and type t225 = M.t225 - and type t226 = M.t226 - and type t227 = M.t227 - and type t228 = M.t228 - and type t229 = M.t229 - and type t230 = M.t230 - and type t231 = M.t231 - and type t232 = M.t232 - and type t233 = M.t233 - and type t234 = M.t234 - and type t235 = M.t235 - and type t236 = M.t236 - and type t237 = M.t237 - and type t238 = M.t238 - and type t239 = M.t239 - and type t240 = M.t240 - and type t241 = M.t241 - and type t242 = M.t242 - and type t243 = M.t243 - and type t244 = M.t244 - and type t245 = M.t245 - and type t246 = M.t246 - and type t247 = M.t247 - and type t248 = M.t248 - and type t249 = M.t249 - and type t250 = M.t250 - and type t251 = M.t251 - and type t252 = M.t252 - and type t253 = M.t253 - and type t254 = M.t254 - and type t255 = M.t255 - and type t256 = M.t256 - and type t257 = M.t257 - and type t258 = M.t258 - and type t259 = M.t259 - and type t260 = M.t260 - and type t261 = M.t261 - and type t262 = M.t262 - and type t263 = M.t263 - and type t264 = M.t264 - and type t265 = M.t265 - and type t266 = M.t266 - and type t267 = M.t267 - and type t268 = M.t268 - and type t269 = M.t269 - and type t270 = M.t270 - and type t271 = M.t271 - and type t272 = M.t272 - and type t273 = M.t273 - and type t274 = M.t274 - and type t275 = M.t275 - and type t276 = M.t276 - and type t277 = M.t277 - and type t278 = M.t278 - and type t279 = M.t279 - and type t280 = M.t280 - and type t281 = M.t281 - and type t282 = M.t282 - and type t283 = M.t283 - and type t284 = M.t284 - and type t285 = M.t285 - and type t286 = M.t286 - and type t287 = M.t287 - and type t288 = M.t288 - and type t289 = M.t289 - and type t290 = M.t290 - and type t291 = M.t291 - and type t292 = M.t292 - and type t293 = M.t293 - and type t294 = M.t294 - and type t295 = M.t295 - and type t296 = M.t296 - and type t297 = M.t297 - and type t298 = M.t298 - and type t299 = M.t299 - and type t300 = M.t300 - and type t301 = M.t301 - and type t302 = M.t302 - and type t303 = M.t303 - and type t304 = M.t304 - and type t305 = M.t305 - and type t306 = M.t306 - and type t307 = M.t307 - and type t308 = M.t308 - and type t309 = M.t309 - and type t310 = M.t310 - and type t311 = M.t311 - and type t312 = M.t312 - and type t313 = M.t313 - and type t314 = M.t314 - and type t315 = M.t315 - and type t316 = M.t316 - and type t317 = M.t317 - and type t318 = M.t318 - and type t319 = M.t319 - and type t320 = M.t320 - and type t321 = M.t321 - and type t322 = M.t322 - and type t323 = M.t323 - and type t324 = M.t324 - and type t325 = M.t325 - and type t326 = M.t326 - and type t327 = M.t327 - and type t328 = M.t328 - and type t329 = M.t329 - and type t330 = M.t330 - and type t331 = M.t331 - and type t332 = M.t332 - and type t333 = M.t333 - and type t334 = M.t334 - and type t335 = M.t335 - and type t336 = M.t336 - and type t337 = M.t337 - and type t338 = M.t338 - and type t339 = M.t339 - and type t340 = M.t340 - and type t341 = M.t341 - and type t342 = M.t342 - and type t343 = M.t343 - and type t344 = M.t344 - and type t345 = M.t345 - and type t346 = M.t346 - and type t347 = M.t347 - and type t348 = M.t348 - and type t349 = M.t349 - and type t350 = M.t350 - and type t351 = M.t351 - and type t352 = M.t352 - and type t353 = M.t353 - and type t354 = M.t354 - and type t355 = M.t355 - and type t356 = M.t356 - and type t357 = M.t357 - and type t358 = M.t358 - and type t359 = M.t359 - and type t360 = M.t360 - and type t361 = M.t361 - and type t362 = M.t362 - and type t363 = M.t363 - and type t364 = M.t364 - and type t365 = M.t365 - and type t366 = M.t366 - and type t367 = M.t367 - and type t368 = M.t368 - and type t369 = M.t369 - and type t370 = M.t370 - and type t371 = M.t371 - and type t372 = M.t372 - and type t373 = M.t373 - and type t374 = M.t374 - and type t375 = M.t375 - and type t376 = M.t376 - and type t377 = M.t377 - and type t378 = M.t378 - and type t379 = M.t379 - and type t380 = M.t380 - and type t381 = M.t381 - and type t382 = M.t382 - and type t383 = M.t383 - and type t384 = M.t384 - and type t385 = M.t385 - and type t386 = M.t386 - and type t387 = M.t387 - and type t388 = M.t388 - and type t389 = M.t389 - and type t390 = M.t390 - and type t391 = M.t391 - and type t392 = M.t392 - and type t393 = M.t393 - and type t394 = M.t394 - and type t395 = M.t395 - and type t396 = M.t396 - and type t397 = M.t397 - and type t398 = M.t398 - and type t399 = M.t399 - and type t400 = M.t400 - and type t401 = M.t401 - and type t402 = M.t402 - and type t403 = M.t403 - and type t404 = M.t404 - and type t405 = M.t405 - and type t406 = M.t406 - and type t407 = M.t407 - and type t408 = M.t408 - and type t409 = M.t409 - and type t410 = M.t410 - and type t411 = M.t411 - and type t412 = M.t412 - and type t413 = M.t413 - and type t414 = M.t414 - and type t415 = M.t415 - and type t416 = M.t416 - and type t417 = M.t417 - and type t418 = M.t418 - and type t419 = M.t419 - and type t420 = M.t420 - and type t421 = M.t421 - and type t422 = M.t422 - and type t423 = M.t423 - and type t424 = M.t424 - and type t425 = M.t425 - and type t426 = M.t426 - and type t427 = M.t427 - and type t428 = M.t428 - and type t429 = M.t429 - and type t430 = M.t430 - and type t431 = M.t431 - and type t432 = M.t432 - and type t433 = M.t433 - and type t434 = M.t434 - and type t435 = M.t435 - and type t436 = M.t436 - and type t437 = M.t437 - and type t438 = M.t438 - and type t439 = M.t439 - and type t440 = M.t440 - and type t441 = M.t441 - and type t442 = M.t442 - and type t443 = M.t443 - and type t444 = M.t444 - and type t445 = M.t445 - and type t446 = M.t446 - and type t447 = M.t447 - and type t448 = M.t448 - and type t449 = M.t449 - and type t450 = M.t450 - and type t451 = M.t451 - and type t452 = M.t452 - and type t453 = M.t453 - and type t454 = M.t454 - and type t455 = M.t455 - and type t456 = M.t456 - and type t457 = M.t457 - and type t458 = M.t458 - and type t459 = M.t459 - and type t460 = M.t460 - and type t461 = M.t461 - and type t462 = M.t462 - and type t463 = M.t463 - and type t464 = M.t464 - and type t465 = M.t465 - and type t466 = M.t466 - and type t467 = M.t467 - and type t468 = M.t468 - and type t469 = M.t469 - and type t470 = M.t470 - and type t471 = M.t471 - and type t472 = M.t472 - and type t473 = M.t473 - and type t474 = M.t474 - and type t475 = M.t475 - and type t476 = M.t476 - and type t477 = M.t477 - and type t478 = M.t478 - and type t479 = M.t479 - and type t480 = M.t480 - and type t481 = M.t481 - and type t482 = M.t482 - and type t483 = M.t483 - and type t484 = M.t484 - and type t485 = M.t485 - and type t486 = M.t486 - and type t487 = M.t487 - and type t488 = M.t488 - and type t489 = M.t489 - and type t490 = M.t490 - and type t491 = M.t491 - and type t492 = M.t492 - and type t493 = M.t493 - and type t494 = M.t494 - and type t495 = M.t495 - and type t496 = M.t496 - and type t497 = M.t497 - and type t498 = M.t498 - and type t499 = M.t499 - and type t500 = M.t500 - and type t501 = M.t501 - and type t502 = M.t502 - and type t503 = M.t503 - and type t504 = M.t504 - and type t505 = M.t505 - and type t506 = M.t506 - and type t507 = M.t507 - and type t508 = M.t508 - and type t509 = M.t509 - and type t510 = M.t510 - and type t511 = M.t511 - and type t512 = M.t512 - and type t513 = M.t513 - and type t514 = M.t514 - and type t515 = M.t515 - and type t516 = M.t516 - and type t517 = M.t517 - and type t518 = M.t518 - and type t519 = M.t519 - and type t520 = M.t520 - and type t521 = M.t521 - and type t522 = M.t522 - and type t523 = M.t523 - and type t524 = M.t524 - and type t525 = M.t525 - and type t526 = M.t526 - and type t527 = M.t527 - and type t528 = M.t528 - and type t529 = M.t529 - and type t530 = M.t530 - and type t531 = M.t531 - and type t532 = M.t532 - and type t533 = M.t533 - and type t534 = M.t534 - and type t535 = M.t535 - and type t536 = M.t536 - and type t537 = M.t537 - and type t538 = M.t538 - and type t539 = M.t539 - and type t540 = M.t540 - and type t541 = M.t541 - and type t542 = M.t542 - and type t543 = M.t543 - and type t544 = M.t544 - and type t545 = M.t545 - and type t546 = M.t546 - and type t547 = M.t547 - and type t548 = M.t548 - and type t549 = M.t549 - and type t550 = M.t550 - and type t551 = M.t551 - and type t552 = M.t552 - and type t553 = M.t553 - and type t554 = M.t554 - and type t555 = M.t555 - and type t556 = M.t556 - and type t557 = M.t557 - and type t558 = M.t558 - and type t559 = M.t559 - and type t560 = M.t560 - and type t561 = M.t561 - and type t562 = M.t562 - and type t563 = M.t563 - and type t564 = M.t564 - and type t565 = M.t565 - and type t566 = M.t566 - and type t567 = M.t567 - and type t568 = M.t568 - and type t569 = M.t569 - and type t570 = M.t570 - and type t571 = M.t571 - and type t572 = M.t572 - and type t573 = M.t573 - and type t574 = M.t574 - and type t575 = M.t575 - and type t576 = M.t576 - and type t577 = M.t577 - and type t578 = M.t578 - and type t579 = M.t579 - and type t580 = M.t580 - and type t581 = M.t581 - and type t582 = M.t582 - and type t583 = M.t583 - and type t584 = M.t584 - and type t585 = M.t585 - and type t586 = M.t586 - and type t587 = M.t587 - and type t588 = M.t588 - and type t589 = M.t589 - and type t590 = M.t590 - and type t591 = M.t591 - and type t592 = M.t592 - and type t593 = M.t593 - and type t594 = M.t594 - and type t595 = M.t595 - and type t596 = M.t596 - and type t597 = M.t597 - and type t598 = M.t598 - and type t599 = M.t599 - and type t600 = M.t600 - and type t601 = M.t601 - and type t602 = M.t602 - and type t603 = M.t603 - and type t604 = M.t604 - and type t605 = M.t605 - and type t606 = M.t606 - and type t607 = M.t607 - and type t608 = M.t608 - and type t609 = M.t609 - and type t610 = M.t610 - and type t611 = M.t611 - and type t612 = M.t612 - and type t613 = M.t613 - and type t614 = M.t614 - and type t615 = M.t615 - and type t616 = M.t616 - and type t617 = M.t617 - and type t618 = M.t618 - and type t619 = M.t619 - and type t620 = M.t620 - and type t621 = M.t621 - and type t622 = M.t622 - and type t623 = M.t623 - and type t624 = M.t624 - and type t625 = M.t625 - and type t626 = M.t626 - and type t627 = M.t627 - and type t628 = M.t628 - and type t629 = M.t629 - and type t630 = M.t630 - and type t631 = M.t631 - and type t632 = M.t632 - and type t633 = M.t633 - and type t634 = M.t634 - and type t635 = M.t635 - and type t636 = M.t636 - and type t637 = M.t637 - and type t638 = M.t638 - and type t639 = M.t639 - and type t640 = M.t640 - and type t641 = M.t641 - and type t642 = M.t642 - and type t643 = M.t643 - and type t644 = M.t644 - and type t645 = M.t645 - and type t646 = M.t646 - and type t647 = M.t647 - and type t648 = M.t648 - and type t649 = M.t649 - and type t650 = M.t650 - and type t651 = M.t651 - and type t652 = M.t652 - and type t653 = M.t653 - and type t654 = M.t654 - and type t655 = M.t655 - and type t656 = M.t656 - and type t657 = M.t657 - and type t658 = M.t658 - and type t659 = M.t659 - and type t660 = M.t660 - and type t661 = M.t661 - and type t662 = M.t662 - and type t663 = M.t663 - and type t664 = M.t664 - and type t665 = M.t665 - and type t666 = M.t666 - and type t667 = M.t667 - and type t668 = M.t668 - and type t669 = M.t669 - and type t670 = M.t670 - and type t671 = M.t671 - and type t672 = M.t672 - and type t673 = M.t673 - and type t674 = M.t674 - and type t675 = M.t675 - and type t676 = M.t676 - and type t677 = M.t677 - and type t678 = M.t678 - and type t679 = M.t679 - and type t680 = M.t680 - and type t681 = M.t681 - and type t682 = M.t682 - and type t683 = M.t683 - and type t684 = M.t684 - and type t685 = M.t685 - and type t686 = M.t686 - and type t687 = M.t687 - and type t688 = M.t688 - and type t689 = M.t689 - and type t690 = M.t690 - and type t691 = M.t691 - and type t692 = M.t692 - and type t693 = M.t693 - and type t694 = M.t694 - and type t695 = M.t695 - and type t696 = M.t696 - and type t697 = M.t697 - and type t698 = M.t698 - and type t699 = M.t699 - and type t700 = M.t700 - and type t701 = M.t701 - and type t702 = M.t702 - and type t703 = M.t703 - and type t704 = M.t704 - and type t705 = M.t705 - and type t706 = M.t706 - and type t707 = M.t707 - and type t708 = M.t708 - and type t709 = M.t709 - and type t710 = M.t710 - and type t711 = M.t711 - and type t712 = M.t712 - and type t713 = M.t713 - and type t714 = M.t714 - and type t715 = M.t715 - and type t716 = M.t716 - and type t717 = M.t717 - and type t718 = M.t718 - and type t719 = M.t719 - and type t720 = M.t720 - and type t721 = M.t721 - and type t722 = M.t722 - and type t723 = M.t723 - and type t724 = M.t724 - and type t725 = M.t725 - and type t726 = M.t726 - and type t727 = M.t727 - and type t728 = M.t728 - and type t729 = M.t729 - and type t730 = M.t730 - and type t731 = M.t731 - and type t732 = M.t732 - and type t733 = M.t733 - and type t734 = M.t734 - and type t735 = M.t735 - and type t736 = M.t736 - and type t737 = M.t737 - and type t738 = M.t738 - and type t739 = M.t739 - and type t740 = M.t740 - and type t741 = M.t741 - and type t742 = M.t742 - and type t743 = M.t743 - and type t744 = M.t744 - and type t745 = M.t745 - and type t746 = M.t746 - and type t747 = M.t747 - and type t748 = M.t748 - and type t749 = M.t749 - and type t750 = M.t750 - and type t751 = M.t751 - and type t752 = M.t752 - and type t753 = M.t753 - and type t754 = M.t754 - and type t755 = M.t755 - and type t756 = M.t756 - and type t757 = M.t757 - and type t758 = M.t758 - and type t759 = M.t759 - and type t760 = M.t760 - and type t761 = M.t761 - and type t762 = M.t762 - and type t763 = M.t763 - and type t764 = M.t764 - and type t765 = M.t765 - and type t766 = M.t766 - and type t767 = M.t767 - and type t768 = M.t768 - and type t769 = M.t769 - and type t770 = M.t770 - and type t771 = M.t771 - and type t772 = M.t772 - and type t773 = M.t773 - and type t774 = M.t774 - and type t775 = M.t775 - and type t776 = M.t776 - and type t777 = M.t777 - and type t778 = M.t778 - and type t779 = M.t779 - and type t780 = M.t780 - and type t781 = M.t781 - and type t782 = M.t782 - and type t783 = M.t783 - and type t784 = M.t784 - and type t785 = M.t785 - and type t786 = M.t786 - and type t787 = M.t787 - and type t788 = M.t788 - and type t789 = M.t789 - and type t790 = M.t790 - and type t791 = M.t791 - and type t792 = M.t792 - and type t793 = M.t793 - and type t794 = M.t794 - and type t795 = M.t795 - and type t796 = M.t796 - and type t797 = M.t797 - and type t798 = M.t798 - and type t799 = M.t799 - and type t800 = M.t800 - and type t801 = M.t801 - and type t802 = M.t802 - and type t803 = M.t803 - and type t804 = M.t804 - and type t805 = M.t805 - and type t806 = M.t806 - and type t807 = M.t807 - and type t808 = M.t808 - and type t809 = M.t809 - and type t810 = M.t810 - and type t811 = M.t811 - and type t812 = M.t812 - and type t813 = M.t813 - and type t814 = M.t814 - and type t815 = M.t815 - and type t816 = M.t816 - and type t817 = M.t817 - and type t818 = M.t818 - and type t819 = M.t819 - and type t820 = M.t820 - and type t821 = M.t821 - and type t822 = M.t822 - and type t823 = M.t823 - and type t824 = M.t824 - and type t825 = M.t825 - and type t826 = M.t826 - and type t827 = M.t827 - and type t828 = M.t828 - and type t829 = M.t829 - and type t830 = M.t830 - and type t831 = M.t831 - and type t832 = M.t832 - and type t833 = M.t833 - and type t834 = M.t834 - and type t835 = M.t835 - and type t836 = M.t836 - and type t837 = M.t837 - and type t838 = M.t838 - and type t839 = M.t839 - and type t840 = M.t840 - and type t841 = M.t841 - and type t842 = M.t842 - and type t843 = M.t843 - and type t844 = M.t844 - and type t845 = M.t845 - and type t846 = M.t846 - and type t847 = M.t847 - and type t848 = M.t848 - and type t849 = M.t849 - and type t850 = M.t850 - and type t851 = M.t851 - and type t852 = M.t852 - and type t853 = M.t853 - and type t854 = M.t854 - and type t855 = M.t855 - and type t856 = M.t856 - and type t857 = M.t857 - and type t858 = M.t858 - and type t859 = M.t859 - and type t860 = M.t860 - and type t861 = M.t861 - and type t862 = M.t862 - and type t863 = M.t863 - and type t864 = M.t864 - and type t865 = M.t865 - and type t866 = M.t866 - and type t867 = M.t867 - and type t868 = M.t868 - and type t869 = M.t869 - and type t870 = M.t870 - and type t871 = M.t871 - and type t872 = M.t872 - and type t873 = M.t873 - and type t874 = M.t874 - and type t875 = M.t875 - and type t876 = M.t876 - and type t877 = M.t877 - and type t878 = M.t878 - and type t879 = M.t879 - and type t880 = M.t880 - and type t881 = M.t881 - and type t882 = M.t882 - and type t883 = M.t883 - and type t884 = M.t884 - and type t885 = M.t885 - and type t886 = M.t886 - and type t887 = M.t887 - and type t888 = M.t888 - and type t889 = M.t889 - and type t890 = M.t890 - and type t891 = M.t891 - and type t892 = M.t892 - and type t893 = M.t893 - and type t894 = M.t894 - and type t895 = M.t895 - and type t896 = M.t896 - and type t897 = M.t897 - and type t898 = M.t898 - and type t899 = M.t899 - and type t900 = M.t900 - and type t901 = M.t901 - and type t902 = M.t902 - and type t903 = M.t903 - and type t904 = M.t904 - and type t905 = M.t905 - and type t906 = M.t906 - and type t907 = M.t907 - and type t908 = M.t908 - and type t909 = M.t909 - and type t910 = M.t910 - and type t911 = M.t911 - and type t912 = M.t912 - and type t913 = M.t913 - and type t914 = M.t914 - and type t915 = M.t915 - and type t916 = M.t916 - and type t917 = M.t917 - and type t918 = M.t918 - and type t919 = M.t919 - and type t920 = M.t920 - and type t921 = M.t921 - and type t922 = M.t922 - and type t923 = M.t923 - and type t924 = M.t924 - and type t925 = M.t925 - and type t926 = M.t926 - and type t927 = M.t927 - and type t928 = M.t928 - and type t929 = M.t929 - and type t930 = M.t930 - and type t931 = M.t931 - and type t932 = M.t932 - and type t933 = M.t933 - and type t934 = M.t934 - and type t935 = M.t935 - and type t936 = M.t936 - and type t937 = M.t937 - and type t938 = M.t938 - and type t939 = M.t939 - and type t940 = M.t940 - and type t941 = M.t941 - and type t942 = M.t942 - and type t943 = M.t943 - and type t944 = M.t944 - and type t945 = M.t945 - and type t946 = M.t946 - and type t947 = M.t947 - and type t948 = M.t948 - and type t949 = M.t949 - and type t950 = M.t950 - and type t951 = M.t951 - and type t952 = M.t952 - and type t953 = M.t953 - and type t954 = M.t954 - and type t955 = M.t955 - and type t956 = M.t956 - and type t957 = M.t957 - and type t958 = M.t958 - and type t959 = M.t959 - and type t960 = M.t960 - and type t961 = M.t961 - and type t962 = M.t962 - and type t963 = M.t963 - and type t964 = M.t964 - and type t965 = M.t965 - and type t966 = M.t966 - and type t967 = M.t967 - and type t968 = M.t968 - and type t969 = M.t969 - and type t970 = M.t970 - and type t971 = M.t971 - and type t972 = M.t972 - and type t973 = M.t973 - and type t974 = M.t974 - and type t975 = M.t975 - and type t976 = M.t976 - and type t977 = M.t977 - and type t978 = M.t978 - and type t979 = M.t979 - and type t980 = M.t980 - and type t981 = M.t981 - and type t982 = M.t982 - and type t983 = M.t983 - and type t984 = M.t984 - and type t985 = M.t985 - and type t986 = M.t986 - and type t987 = M.t987 - and type t988 = M.t988 - and type t989 = M.t989 - and type t990 = M.t990 - and type t991 = M.t991 - and type t992 = M.t992 - and type t993 = M.t993 - and type t994 = M.t994 - and type t995 = M.t995 - and type t996 = M.t996 - and type t997 = M.t997 - and type t998 = M.t998 - and type t999 = M.t999 - and type t1000 = M.t1000 -= struct - include M -end - -module M = struct - type t0 = int -> int -> int - type t1 = int -> int -> int - type t2 = int -> int -> int - type t3 = int -> int -> int - type t4 = int -> int -> int - type t5 = int -> int -> int - type t6 = int -> int -> int - type t7 = int -> int -> int - type t8 = int -> int -> int - type t9 = int -> int -> int - type t10 = int -> int -> int - type t11 = int -> int -> int - type t12 = int -> int -> int - type t13 = int -> int -> int - type t14 = int -> int -> int - type t15 = int -> int -> int - type t16 = int -> int -> int - type t17 = int -> int -> int - type t18 = int -> int -> int - type t19 = int -> int -> int - type t20 = int -> int -> int - type t21 = int -> int -> int - type t22 = int -> int -> int - type t23 = int -> int -> int - type t24 = int -> int -> int - type t25 = int -> int -> int - type t26 = int -> int -> int - type t27 = int -> int -> int - type t28 = int -> int -> int - type t29 = int -> int -> int - type t30 = int -> int -> int - type t31 = int -> int -> int - type t32 = int -> int -> int - type t33 = int -> int -> int - type t34 = int -> int -> int - type t35 = int -> int -> int - type t36 = int -> int -> int - type t37 = int -> int -> int - type t38 = int -> int -> int - type t39 = int -> int -> int - type t40 = int -> int -> int - type t41 = int -> int -> int - type t42 = int -> int -> int - type t43 = int -> int -> int - type t44 = int -> int -> int - type t45 = int -> int -> int - type t46 = int -> int -> int - type t47 = int -> int -> int - type t48 = int -> int -> int - type t49 = int -> int -> int - type t50 = int -> int -> int - type t51 = int -> int -> int - type t52 = int -> int -> int - type t53 = int -> int -> int - type t54 = int -> int -> int - type t55 = int -> int -> int - type t56 = int -> int -> int - type t57 = int -> int -> int - type t58 = int -> int -> int - type t59 = int -> int -> int - type t60 = int -> int -> int - type t61 = int -> int -> int - type t62 = int -> int -> int - type t63 = int -> int -> int - type t64 = int -> int -> int - type t65 = int -> int -> int - type t66 = int -> int -> int - type t67 = int -> int -> int - type t68 = int -> int -> int - type t69 = int -> int -> int - type t70 = int -> int -> int - type t71 = int -> int -> int - type t72 = int -> int -> int - type t73 = int -> int -> int - type t74 = int -> int -> int - type t75 = int -> int -> int - type t76 = int -> int -> int - type t77 = int -> int -> int - type t78 = int -> int -> int - type t79 = int -> int -> int - type t80 = int -> int -> int - type t81 = int -> int -> int - type t82 = int -> int -> int - type t83 = int -> int -> int - type t84 = int -> int -> int - type t85 = int -> int -> int - type t86 = int -> int -> int - type t87 = int -> int -> int - type t88 = int -> int -> int - type t89 = int -> int -> int - type t90 = int -> int -> int - type t91 = int -> int -> int - type t92 = int -> int -> int - type t93 = int -> int -> int - type t94 = int -> int -> int - type t95 = int -> int -> int - type t96 = int -> int -> int - type t97 = int -> int -> int - type t98 = int -> int -> int - type t99 = int -> int -> int - type t100 = int -> int -> int - type t101 = int -> int -> int - type t102 = int -> int -> int - type t103 = int -> int -> int - type t104 = int -> int -> int - type t105 = int -> int -> int - type t106 = int -> int -> int - type t107 = int -> int -> int - type t108 = int -> int -> int - type t109 = int -> int -> int - type t110 = int -> int -> int - type t111 = int -> int -> int - type t112 = int -> int -> int - type t113 = int -> int -> int - type t114 = int -> int -> int - type t115 = int -> int -> int - type t116 = int -> int -> int - type t117 = int -> int -> int - type t118 = int -> int -> int - type t119 = int -> int -> int - type t120 = int -> int -> int - type t121 = int -> int -> int - type t122 = int -> int -> int - type t123 = int -> int -> int - type t124 = int -> int -> int - type t125 = int -> int -> int - type t126 = int -> int -> int - type t127 = int -> int -> int - type t128 = int -> int -> int - type t129 = int -> int -> int - type t130 = int -> int -> int - type t131 = int -> int -> int - type t132 = int -> int -> int - type t133 = int -> int -> int - type t134 = int -> int -> int - type t135 = int -> int -> int - type t136 = int -> int -> int - type t137 = int -> int -> int - type t138 = int -> int -> int - type t139 = int -> int -> int - type t140 = int -> int -> int - type t141 = int -> int -> int - type t142 = int -> int -> int - type t143 = int -> int -> int - type t144 = int -> int -> int - type t145 = int -> int -> int - type t146 = int -> int -> int - type t147 = int -> int -> int - type t148 = int -> int -> int - type t149 = int -> int -> int - type t150 = int -> int -> int - type t151 = int -> int -> int - type t152 = int -> int -> int - type t153 = int -> int -> int - type t154 = int -> int -> int - type t155 = int -> int -> int - type t156 = int -> int -> int - type t157 = int -> int -> int - type t158 = int -> int -> int - type t159 = int -> int -> int - type t160 = int -> int -> int - type t161 = int -> int -> int - type t162 = int -> int -> int - type t163 = int -> int -> int - type t164 = int -> int -> int - type t165 = int -> int -> int - type t166 = int -> int -> int - type t167 = int -> int -> int - type t168 = int -> int -> int - type t169 = int -> int -> int - type t170 = int -> int -> int - type t171 = int -> int -> int - type t172 = int -> int -> int - type t173 = int -> int -> int - type t174 = int -> int -> int - type t175 = int -> int -> int - type t176 = int -> int -> int - type t177 = int -> int -> int - type t178 = int -> int -> int - type t179 = int -> int -> int - type t180 = int -> int -> int - type t181 = int -> int -> int - type t182 = int -> int -> int - type t183 = int -> int -> int - type t184 = int -> int -> int - type t185 = int -> int -> int - type t186 = int -> int -> int - type t187 = int -> int -> int - type t188 = int -> int -> int - type t189 = int -> int -> int - type t190 = int -> int -> int - type t191 = int -> int -> int - type t192 = int -> int -> int - type t193 = int -> int -> int - type t194 = int -> int -> int - type t195 = int -> int -> int - type t196 = int -> int -> int - type t197 = int -> int -> int - type t198 = int -> int -> int - type t199 = int -> int -> int - type t200 = int -> int -> int - type t201 = int -> int -> int - type t202 = int -> int -> int - type t203 = int -> int -> int - type t204 = int -> int -> int - type t205 = int -> int -> int - type t206 = int -> int -> int - type t207 = int -> int -> int - type t208 = int -> int -> int - type t209 = int -> int -> int - type t210 = int -> int -> int - type t211 = int -> int -> int - type t212 = int -> int -> int - type t213 = int -> int -> int - type t214 = int -> int -> int - type t215 = int -> int -> int - type t216 = int -> int -> int - type t217 = int -> int -> int - type t218 = int -> int -> int - type t219 = int -> int -> int - type t220 = int -> int -> int - type t221 = int -> int -> int - type t222 = int -> int -> int - type t223 = int -> int -> int - type t224 = int -> int -> int - type t225 = int -> int -> int - type t226 = int -> int -> int - type t227 = int -> int -> int - type t228 = int -> int -> int - type t229 = int -> int -> int - type t230 = int -> int -> int - type t231 = int -> int -> int - type t232 = int -> int -> int - type t233 = int -> int -> int - type t234 = int -> int -> int - type t235 = int -> int -> int - type t236 = int -> int -> int - type t237 = int -> int -> int - type t238 = int -> int -> int - type t239 = int -> int -> int - type t240 = int -> int -> int - type t241 = int -> int -> int - type t242 = int -> int -> int - type t243 = int -> int -> int - type t244 = int -> int -> int - type t245 = int -> int -> int - type t246 = int -> int -> int - type t247 = int -> int -> int - type t248 = int -> int -> int - type t249 = int -> int -> int - type t250 = int -> int -> int - type t251 = int -> int -> int - type t252 = int -> int -> int - type t253 = int -> int -> int - type t254 = int -> int -> int - type t255 = int -> int -> int - type t256 = int -> int -> int - type t257 = int -> int -> int - type t258 = int -> int -> int - type t259 = int -> int -> int - type t260 = int -> int -> int - type t261 = int -> int -> int - type t262 = int -> int -> int - type t263 = int -> int -> int - type t264 = int -> int -> int - type t265 = int -> int -> int - type t266 = int -> int -> int - type t267 = int -> int -> int - type t268 = int -> int -> int - type t269 = int -> int -> int - type t270 = int -> int -> int - type t271 = int -> int -> int - type t272 = int -> int -> int - type t273 = int -> int -> int - type t274 = int -> int -> int - type t275 = int -> int -> int - type t276 = int -> int -> int - type t277 = int -> int -> int - type t278 = int -> int -> int - type t279 = int -> int -> int - type t280 = int -> int -> int - type t281 = int -> int -> int - type t282 = int -> int -> int - type t283 = int -> int -> int - type t284 = int -> int -> int - type t285 = int -> int -> int - type t286 = int -> int -> int - type t287 = int -> int -> int - type t288 = int -> int -> int - type t289 = int -> int -> int - type t290 = int -> int -> int - type t291 = int -> int -> int - type t292 = int -> int -> int - type t293 = int -> int -> int - type t294 = int -> int -> int - type t295 = int -> int -> int - type t296 = int -> int -> int - type t297 = int -> int -> int - type t298 = int -> int -> int - type t299 = int -> int -> int - type t300 = int -> int -> int - type t301 = int -> int -> int - type t302 = int -> int -> int - type t303 = int -> int -> int - type t304 = int -> int -> int - type t305 = int -> int -> int - type t306 = int -> int -> int - type t307 = int -> int -> int - type t308 = int -> int -> int - type t309 = int -> int -> int - type t310 = int -> int -> int - type t311 = int -> int -> int - type t312 = int -> int -> int - type t313 = int -> int -> int - type t314 = int -> int -> int - type t315 = int -> int -> int - type t316 = int -> int -> int - type t317 = int -> int -> int - type t318 = int -> int -> int - type t319 = int -> int -> int - type t320 = int -> int -> int - type t321 = int -> int -> int - type t322 = int -> int -> int - type t323 = int -> int -> int - type t324 = int -> int -> int - type t325 = int -> int -> int - type t326 = int -> int -> int - type t327 = int -> int -> int - type t328 = int -> int -> int - type t329 = int -> int -> int - type t330 = int -> int -> int - type t331 = int -> int -> int - type t332 = int -> int -> int - type t333 = int -> int -> int - type t334 = int -> int -> int - type t335 = int -> int -> int - type t336 = int -> int -> int - type t337 = int -> int -> int - type t338 = int -> int -> int - type t339 = int -> int -> int - type t340 = int -> int -> int - type t341 = int -> int -> int - type t342 = int -> int -> int - type t343 = int -> int -> int - type t344 = int -> int -> int - type t345 = int -> int -> int - type t346 = int -> int -> int - type t347 = int -> int -> int - type t348 = int -> int -> int - type t349 = int -> int -> int - type t350 = int -> int -> int - type t351 = int -> int -> int - type t352 = int -> int -> int - type t353 = int -> int -> int - type t354 = int -> int -> int - type t355 = int -> int -> int - type t356 = int -> int -> int - type t357 = int -> int -> int - type t358 = int -> int -> int - type t359 = int -> int -> int - type t360 = int -> int -> int - type t361 = int -> int -> int - type t362 = int -> int -> int - type t363 = int -> int -> int - type t364 = int -> int -> int - type t365 = int -> int -> int - type t366 = int -> int -> int - type t367 = int -> int -> int - type t368 = int -> int -> int - type t369 = int -> int -> int - type t370 = int -> int -> int - type t371 = int -> int -> int - type t372 = int -> int -> int - type t373 = int -> int -> int - type t374 = int -> int -> int - type t375 = int -> int -> int - type t376 = int -> int -> int - type t377 = int -> int -> int - type t378 = int -> int -> int - type t379 = int -> int -> int - type t380 = int -> int -> int - type t381 = int -> int -> int - type t382 = int -> int -> int - type t383 = int -> int -> int - type t384 = int -> int -> int - type t385 = int -> int -> int - type t386 = int -> int -> int - type t387 = int -> int -> int - type t388 = int -> int -> int - type t389 = int -> int -> int - type t390 = int -> int -> int - type t391 = int -> int -> int - type t392 = int -> int -> int - type t393 = int -> int -> int - type t394 = int -> int -> int - type t395 = int -> int -> int - type t396 = int -> int -> int - type t397 = int -> int -> int - type t398 = int -> int -> int - type t399 = int -> int -> int - type t400 = int -> int -> int - type t401 = int -> int -> int - type t402 = int -> int -> int - type t403 = int -> int -> int - type t404 = int -> int -> int - type t405 = int -> int -> int - type t406 = int -> int -> int - type t407 = int -> int -> int - type t408 = int -> int -> int - type t409 = int -> int -> int - type t410 = int -> int -> int - type t411 = int -> int -> int - type t412 = int -> int -> int - type t413 = int -> int -> int - type t414 = int -> int -> int - type t415 = int -> int -> int - type t416 = int -> int -> int - type t417 = int -> int -> int - type t418 = int -> int -> int - type t419 = int -> int -> int - type t420 = int -> int -> int - type t421 = int -> int -> int - type t422 = int -> int -> int - type t423 = int -> int -> int - type t424 = int -> int -> int - type t425 = int -> int -> int - type t426 = int -> int -> int - type t427 = int -> int -> int - type t428 = int -> int -> int - type t429 = int -> int -> int - type t430 = int -> int -> int - type t431 = int -> int -> int - type t432 = int -> int -> int - type t433 = int -> int -> int - type t434 = int -> int -> int - type t435 = int -> int -> int - type t436 = int -> int -> int - type t437 = int -> int -> int - type t438 = int -> int -> int - type t439 = int -> int -> int - type t440 = int -> int -> int - type t441 = int -> int -> int - type t442 = int -> int -> int - type t443 = int -> int -> int - type t444 = int -> int -> int - type t445 = int -> int -> int - type t446 = int -> int -> int - type t447 = int -> int -> int - type t448 = int -> int -> int - type t449 = int -> int -> int - type t450 = int -> int -> int - type t451 = int -> int -> int - type t452 = int -> int -> int - type t453 = int -> int -> int - type t454 = int -> int -> int - type t455 = int -> int -> int - type t456 = int -> int -> int - type t457 = int -> int -> int - type t458 = int -> int -> int - type t459 = int -> int -> int - type t460 = int -> int -> int - type t461 = int -> int -> int - type t462 = int -> int -> int - type t463 = int -> int -> int - type t464 = int -> int -> int - type t465 = int -> int -> int - type t466 = int -> int -> int - type t467 = int -> int -> int - type t468 = int -> int -> int - type t469 = int -> int -> int - type t470 = int -> int -> int - type t471 = int -> int -> int - type t472 = int -> int -> int - type t473 = int -> int -> int - type t474 = int -> int -> int - type t475 = int -> int -> int - type t476 = int -> int -> int - type t477 = int -> int -> int - type t478 = int -> int -> int - type t479 = int -> int -> int - type t480 = int -> int -> int - type t481 = int -> int -> int - type t482 = int -> int -> int - type t483 = int -> int -> int - type t484 = int -> int -> int - type t485 = int -> int -> int - type t486 = int -> int -> int - type t487 = int -> int -> int - type t488 = int -> int -> int - type t489 = int -> int -> int - type t490 = int -> int -> int - type t491 = int -> int -> int - type t492 = int -> int -> int - type t493 = int -> int -> int - type t494 = int -> int -> int - type t495 = int -> int -> int - type t496 = int -> int -> int - type t497 = int -> int -> int - type t498 = int -> int -> int - type t499 = int -> int -> int - type t500 = int -> int -> int - type t501 = int -> int -> int - type t502 = int -> int -> int - type t503 = int -> int -> int - type t504 = int -> int -> int - type t505 = int -> int -> int - type t506 = int -> int -> int - type t507 = int -> int -> int - type t508 = int -> int -> int - type t509 = int -> int -> int - type t510 = int -> int -> int - type t511 = int -> int -> int - type t512 = int -> int -> int - type t513 = int -> int -> int - type t514 = int -> int -> int - type t515 = int -> int -> int - type t516 = int -> int -> int - type t517 = int -> int -> int - type t518 = int -> int -> int - type t519 = int -> int -> int - type t520 = int -> int -> int - type t521 = int -> int -> int - type t522 = int -> int -> int - type t523 = int -> int -> int - type t524 = int -> int -> int - type t525 = int -> int -> int - type t526 = int -> int -> int - type t527 = int -> int -> int - type t528 = int -> int -> int - type t529 = int -> int -> int - type t530 = int -> int -> int - type t531 = int -> int -> int - type t532 = int -> int -> int - type t533 = int -> int -> int - type t534 = int -> int -> int - type t535 = int -> int -> int - type t536 = int -> int -> int - type t537 = int -> int -> int - type t538 = int -> int -> int - type t539 = int -> int -> int - type t540 = int -> int -> int - type t541 = int -> int -> int - type t542 = int -> int -> int - type t543 = int -> int -> int - type t544 = int -> int -> int - type t545 = int -> int -> int - type t546 = int -> int -> int - type t547 = int -> int -> int - type t548 = int -> int -> int - type t549 = int -> int -> int - type t550 = int -> int -> int - type t551 = int -> int -> int - type t552 = int -> int -> int - type t553 = int -> int -> int - type t554 = int -> int -> int - type t555 = int -> int -> int - type t556 = int -> int -> int - type t557 = int -> int -> int - type t558 = int -> int -> int - type t559 = int -> int -> int - type t560 = int -> int -> int - type t561 = int -> int -> int - type t562 = int -> int -> int - type t563 = int -> int -> int - type t564 = int -> int -> int - type t565 = int -> int -> int - type t566 = int -> int -> int - type t567 = int -> int -> int - type t568 = int -> int -> int - type t569 = int -> int -> int - type t570 = int -> int -> int - type t571 = int -> int -> int - type t572 = int -> int -> int - type t573 = int -> int -> int - type t574 = int -> int -> int - type t575 = int -> int -> int - type t576 = int -> int -> int - type t577 = int -> int -> int - type t578 = int -> int -> int - type t579 = int -> int -> int - type t580 = int -> int -> int - type t581 = int -> int -> int - type t582 = int -> int -> int - type t583 = int -> int -> int - type t584 = int -> int -> int - type t585 = int -> int -> int - type t586 = int -> int -> int - type t587 = int -> int -> int - type t588 = int -> int -> int - type t589 = int -> int -> int - type t590 = int -> int -> int - type t591 = int -> int -> int - type t592 = int -> int -> int - type t593 = int -> int -> int - type t594 = int -> int -> int - type t595 = int -> int -> int - type t596 = int -> int -> int - type t597 = int -> int -> int - type t598 = int -> int -> int - type t599 = int -> int -> int - type t600 = int -> int -> int - type t601 = int -> int -> int - type t602 = int -> int -> int - type t603 = int -> int -> int - type t604 = int -> int -> int - type t605 = int -> int -> int - type t606 = int -> int -> int - type t607 = int -> int -> int - type t608 = int -> int -> int - type t609 = int -> int -> int - type t610 = int -> int -> int - type t611 = int -> int -> int - type t612 = int -> int -> int - type t613 = int -> int -> int - type t614 = int -> int -> int - type t615 = int -> int -> int - type t616 = int -> int -> int - type t617 = int -> int -> int - type t618 = int -> int -> int - type t619 = int -> int -> int - type t620 = int -> int -> int - type t621 = int -> int -> int - type t622 = int -> int -> int - type t623 = int -> int -> int - type t624 = int -> int -> int - type t625 = int -> int -> int - type t626 = int -> int -> int - type t627 = int -> int -> int - type t628 = int -> int -> int - type t629 = int -> int -> int - type t630 = int -> int -> int - type t631 = int -> int -> int - type t632 = int -> int -> int - type t633 = int -> int -> int - type t634 = int -> int -> int - type t635 = int -> int -> int - type t636 = int -> int -> int - type t637 = int -> int -> int - type t638 = int -> int -> int - type t639 = int -> int -> int - type t640 = int -> int -> int - type t641 = int -> int -> int - type t642 = int -> int -> int - type t643 = int -> int -> int - type t644 = int -> int -> int - type t645 = int -> int -> int - type t646 = int -> int -> int - type t647 = int -> int -> int - type t648 = int -> int -> int - type t649 = int -> int -> int - type t650 = int -> int -> int - type t651 = int -> int -> int - type t652 = int -> int -> int - type t653 = int -> int -> int - type t654 = int -> int -> int - type t655 = int -> int -> int - type t656 = int -> int -> int - type t657 = int -> int -> int - type t658 = int -> int -> int - type t659 = int -> int -> int - type t660 = int -> int -> int - type t661 = int -> int -> int - type t662 = int -> int -> int - type t663 = int -> int -> int - type t664 = int -> int -> int - type t665 = int -> int -> int - type t666 = int -> int -> int - type t667 = int -> int -> int - type t668 = int -> int -> int - type t669 = int -> int -> int - type t670 = int -> int -> int - type t671 = int -> int -> int - type t672 = int -> int -> int - type t673 = int -> int -> int - type t674 = int -> int -> int - type t675 = int -> int -> int - type t676 = int -> int -> int - type t677 = int -> int -> int - type t678 = int -> int -> int - type t679 = int -> int -> int - type t680 = int -> int -> int - type t681 = int -> int -> int - type t682 = int -> int -> int - type t683 = int -> int -> int - type t684 = int -> int -> int - type t685 = int -> int -> int - type t686 = int -> int -> int - type t687 = int -> int -> int - type t688 = int -> int -> int - type t689 = int -> int -> int - type t690 = int -> int -> int - type t691 = int -> int -> int - type t692 = int -> int -> int - type t693 = int -> int -> int - type t694 = int -> int -> int - type t695 = int -> int -> int - type t696 = int -> int -> int - type t697 = int -> int -> int - type t698 = int -> int -> int - type t699 = int -> int -> int - type t700 = int -> int -> int - type t701 = int -> int -> int - type t702 = int -> int -> int - type t703 = int -> int -> int - type t704 = int -> int -> int - type t705 = int -> int -> int - type t706 = int -> int -> int - type t707 = int -> int -> int - type t708 = int -> int -> int - type t709 = int -> int -> int - type t710 = int -> int -> int - type t711 = int -> int -> int - type t712 = int -> int -> int - type t713 = int -> int -> int - type t714 = int -> int -> int - type t715 = int -> int -> int - type t716 = int -> int -> int - type t717 = int -> int -> int - type t718 = int -> int -> int - type t719 = int -> int -> int - type t720 = int -> int -> int - type t721 = int -> int -> int - type t722 = int -> int -> int - type t723 = int -> int -> int - type t724 = int -> int -> int - type t725 = int -> int -> int - type t726 = int -> int -> int - type t727 = int -> int -> int - type t728 = int -> int -> int - type t729 = int -> int -> int - type t730 = int -> int -> int - type t731 = int -> int -> int - type t732 = int -> int -> int - type t733 = int -> int -> int - type t734 = int -> int -> int - type t735 = int -> int -> int - type t736 = int -> int -> int - type t737 = int -> int -> int - type t738 = int -> int -> int - type t739 = int -> int -> int - type t740 = int -> int -> int - type t741 = int -> int -> int - type t742 = int -> int -> int - type t743 = int -> int -> int - type t744 = int -> int -> int - type t745 = int -> int -> int - type t746 = int -> int -> int - type t747 = int -> int -> int - type t748 = int -> int -> int - type t749 = int -> int -> int - type t750 = int -> int -> int - type t751 = int -> int -> int - type t752 = int -> int -> int - type t753 = int -> int -> int - type t754 = int -> int -> int - type t755 = int -> int -> int - type t756 = int -> int -> int - type t757 = int -> int -> int - type t758 = int -> int -> int - type t759 = int -> int -> int - type t760 = int -> int -> int - type t761 = int -> int -> int - type t762 = int -> int -> int - type t763 = int -> int -> int - type t764 = int -> int -> int - type t765 = int -> int -> int - type t766 = int -> int -> int - type t767 = int -> int -> int - type t768 = int -> int -> int - type t769 = int -> int -> int - type t770 = int -> int -> int - type t771 = int -> int -> int - type t772 = int -> int -> int - type t773 = int -> int -> int - type t774 = int -> int -> int - type t775 = int -> int -> int - type t776 = int -> int -> int - type t777 = int -> int -> int - type t778 = int -> int -> int - type t779 = int -> int -> int - type t780 = int -> int -> int - type t781 = int -> int -> int - type t782 = int -> int -> int - type t783 = int -> int -> int - type t784 = int -> int -> int - type t785 = int -> int -> int - type t786 = int -> int -> int - type t787 = int -> int -> int - type t788 = int -> int -> int - type t789 = int -> int -> int - type t790 = int -> int -> int - type t791 = int -> int -> int - type t792 = int -> int -> int - type t793 = int -> int -> int - type t794 = int -> int -> int - type t795 = int -> int -> int - type t796 = int -> int -> int - type t797 = int -> int -> int - type t798 = int -> int -> int - type t799 = int -> int -> int - type t800 = int -> int -> int - type t801 = int -> int -> int - type t802 = int -> int -> int - type t803 = int -> int -> int - type t804 = int -> int -> int - type t805 = int -> int -> int - type t806 = int -> int -> int - type t807 = int -> int -> int - type t808 = int -> int -> int - type t809 = int -> int -> int - type t810 = int -> int -> int - type t811 = int -> int -> int - type t812 = int -> int -> int - type t813 = int -> int -> int - type t814 = int -> int -> int - type t815 = int -> int -> int - type t816 = int -> int -> int - type t817 = int -> int -> int - type t818 = int -> int -> int - type t819 = int -> int -> int - type t820 = int -> int -> int - type t821 = int -> int -> int - type t822 = int -> int -> int - type t823 = int -> int -> int - type t824 = int -> int -> int - type t825 = int -> int -> int - type t826 = int -> int -> int - type t827 = int -> int -> int - type t828 = int -> int -> int - type t829 = int -> int -> int - type t830 = int -> int -> int - type t831 = int -> int -> int - type t832 = int -> int -> int - type t833 = int -> int -> int - type t834 = int -> int -> int - type t835 = int -> int -> int - type t836 = int -> int -> int - type t837 = int -> int -> int - type t838 = int -> int -> int - type t839 = int -> int -> int - type t840 = int -> int -> int - type t841 = int -> int -> int - type t842 = int -> int -> int - type t843 = int -> int -> int - type t844 = int -> int -> int - type t845 = int -> int -> int - type t846 = int -> int -> int - type t847 = int -> int -> int - type t848 = int -> int -> int - type t849 = int -> int -> int - type t850 = int -> int -> int - type t851 = int -> int -> int - type t852 = int -> int -> int - type t853 = int -> int -> int - type t854 = int -> int -> int - type t855 = int -> int -> int - type t856 = int -> int -> int - type t857 = int -> int -> int - type t858 = int -> int -> int - type t859 = int -> int -> int - type t860 = int -> int -> int - type t861 = int -> int -> int - type t862 = int -> int -> int - type t863 = int -> int -> int - type t864 = int -> int -> int - type t865 = int -> int -> int - type t866 = int -> int -> int - type t867 = int -> int -> int - type t868 = int -> int -> int - type t869 = int -> int -> int - type t870 = int -> int -> int - type t871 = int -> int -> int - type t872 = int -> int -> int - type t873 = int -> int -> int - type t874 = int -> int -> int - type t875 = int -> int -> int - type t876 = int -> int -> int - type t877 = int -> int -> int - type t878 = int -> int -> int - type t879 = int -> int -> int - type t880 = int -> int -> int - type t881 = int -> int -> int - type t882 = int -> int -> int - type t883 = int -> int -> int - type t884 = int -> int -> int - type t885 = int -> int -> int - type t886 = int -> int -> int - type t887 = int -> int -> int - type t888 = int -> int -> int - type t889 = int -> int -> int - type t890 = int -> int -> int - type t891 = int -> int -> int - type t892 = int -> int -> int - type t893 = int -> int -> int - type t894 = int -> int -> int - type t895 = int -> int -> int - type t896 = int -> int -> int - type t897 = int -> int -> int - type t898 = int -> int -> int - type t899 = int -> int -> int - type t900 = int -> int -> int - type t901 = int -> int -> int - type t902 = int -> int -> int - type t903 = int -> int -> int - type t904 = int -> int -> int - type t905 = int -> int -> int - type t906 = int -> int -> int - type t907 = int -> int -> int - type t908 = int -> int -> int - type t909 = int -> int -> int - type t910 = int -> int -> int - type t911 = int -> int -> int - type t912 = int -> int -> int - type t913 = int -> int -> int - type t914 = int -> int -> int - type t915 = int -> int -> int - type t916 = int -> int -> int - type t917 = int -> int -> int - type t918 = int -> int -> int - type t919 = int -> int -> int - type t920 = int -> int -> int - type t921 = int -> int -> int - type t922 = int -> int -> int - type t923 = int -> int -> int - type t924 = int -> int -> int - type t925 = int -> int -> int - type t926 = int -> int -> int - type t927 = int -> int -> int - type t928 = int -> int -> int - type t929 = int -> int -> int - type t930 = int -> int -> int - type t931 = int -> int -> int - type t932 = int -> int -> int - type t933 = int -> int -> int - type t934 = int -> int -> int - type t935 = int -> int -> int - type t936 = int -> int -> int - type t937 = int -> int -> int - type t938 = int -> int -> int - type t939 = int -> int -> int - type t940 = int -> int -> int - type t941 = int -> int -> int - type t942 = int -> int -> int - type t943 = int -> int -> int - type t944 = int -> int -> int - type t945 = int -> int -> int - type t946 = int -> int -> int - type t947 = int -> int -> int - type t948 = int -> int -> int - type t949 = int -> int -> int - type t950 = int -> int -> int - type t951 = int -> int -> int - type t952 = int -> int -> int - type t953 = int -> int -> int - type t954 = int -> int -> int - type t955 = int -> int -> int - type t956 = int -> int -> int - type t957 = int -> int -> int - type t958 = int -> int -> int - type t959 = int -> int -> int - type t960 = int -> int -> int - type t961 = int -> int -> int - type t962 = int -> int -> int - type t963 = int -> int -> int - type t964 = int -> int -> int - type t965 = int -> int -> int - type t966 = int -> int -> int - type t967 = int -> int -> int - type t968 = int -> int -> int - type t969 = int -> int -> int - type t970 = int -> int -> int - type t971 = int -> int -> int - type t972 = int -> int -> int - type t973 = int -> int -> int - type t974 = int -> int -> int - type t975 = int -> int -> int - type t976 = int -> int -> int - type t977 = int -> int -> int - type t978 = int -> int -> int - type t979 = int -> int -> int - type t980 = int -> int -> int - type t981 = int -> int -> int - type t982 = int -> int -> int - type t983 = int -> int -> int - type t984 = int -> int -> int - type t985 = int -> int -> int - type t986 = int -> int -> int - type t987 = int -> int -> int - type t988 = int -> int -> int - type t989 = int -> int -> int - type t990 = int -> int -> int - type t991 = int -> int -> int - type t992 = int -> int -> int - type t993 = int -> int -> int - type t994 = int -> int -> int - type t995 = int -> int -> int - type t996 = int -> int -> int - type t997 = int -> int -> int - type t998 = int -> int -> int - type t999 = int -> int -> int - type t1000 = int -> int -> int -end - -module X = - Make - (Make - (Make - (Make - (Make - (Make - (Make - (Make - (Make - (Make - (Make - (M))))))))))) diff -Nru ocaml-3.12.1/camlp4/test/fixtures/functor-perf2.ml ocaml-4.01.0/camlp4/test/fixtures/functor-perf2.ml --- ocaml-3.12.1/camlp4/test/fixtures/functor-perf2.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/functor-perf2.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,29 +0,0 @@ -<% types, with_constrs, module_application = ARGV.map { |x| x.to_i } %> - -module type S = sig -<%- for i in 0 .. types do -%> - type t<%= i %> -<%- end -%> -end - -module Make (M : S) -: S with type t0 = M.t0 - <%- for i in 1 .. with_constrs do -%> - and type t<%= i %> = M.t<%= i %> - <%- end -%> -= struct - include M -end - -module M = struct -<%- for i in 0 .. types do -%> - type t<%= i %> = int -> int -> int -<%- end -%> -end - -module X = - Make -<%- module_application.times do -%> - (Make -<%- end -%> - (M)<%= ')' * module_application %> diff -Nru ocaml-3.12.1/camlp4/test/fixtures/functor-perf3.ml ocaml-4.01.0/camlp4/test/fixtures/functor-perf3.ml --- ocaml-3.12.1/camlp4/test/fixtures/functor-perf3.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/functor-perf3.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,50 +0,0 @@ -<% types, with_constrs, make, make2 = ARGV.map { |x| x.to_i } %> - -module type S = sig -<%- for i in 0 .. types do -%> - type t<%= i %> -<%- end -%> -end - -module Make (M : S) -: S with type t0 = M.t0 - <%- for i in 1 .. with_constrs do -%> - and type t<%= i %> = M.t<%= i %> - <%- end -%> -= struct - include M -end - -module type S2 = sig - module M : S -end - -module Make2 (M2 : S2) -: S2 with module M = M2.M -= struct - include M2 -end - -module M = struct -<%- for i in 0 .. types do -%> - type t<%= i %> = int -> int -> int -<%- end -%> -end - -module M1 = - Make -<%- make.times do -%> - (Make -<%- end -%> - (M)<%= ')' * make %> - -module M2 = struct - module M = M1 -end - -module X = - Make2 -<%- make2.times do -%> - (Make2 -<%- end -%> - (M2)<%= ')' * make2 %> diff -Nru ocaml-3.12.1/camlp4/test/fixtures/gen_map.ml ocaml-4.01.0/camlp4/test/fixtures/gen_map.ml --- ocaml-3.12.1/camlp4/test/fixtures/gen_map.ml 2006-06-29 11:29:27.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/gen_map.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,8 +0,0 @@ -type t = - A of int * t * t -| B of int list -| C of option t - -module Map = struct - module T = Camlp4Filters.GenerateMap.Generated -end diff -Nru ocaml-3.12.1/camlp4/test/fixtures/gram-fold.ml ocaml-4.01.0/camlp4/test/fixtures/gram-fold.ml --- ocaml-3.12.1/camlp4/test/fixtures/gram-fold.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/gram-fold.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,21 +0,0 @@ -open Camlp4.PreCast; -module G = MakeGram Lexer; -type t = [ A of t and t | B of string | C ]; -value main = G.Entry.mk "main"; -value rec length x acc = - match x with - [ A x y -> length x (length y acc) - | B _ -> succ acc - | C -> acc ]; -EXTEND G - GLOBAL: main; - main: - [ [ - l = FOLD1 (fun a b -> A (B a) b) (C) ident -> l - ] ]; - ident: - [ [ `LIDENT s -> s ] ]; -END; -let f = Sys.argv.(1) in -Format.printf "%d@." - (length (G.parse main (Loc.mk f) (Stream.of_channel (open_in f))) 0); diff -Nru ocaml-3.12.1/camlp4/test/fixtures/gram-list.ml ocaml-4.01.0/camlp4/test/fixtures/gram-list.ml --- ocaml-3.12.1/camlp4/test/fixtures/gram-list.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/gram-list.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,13 +0,0 @@ -open Camlp4.PreCast; -module G = MakeGram Lexer; -value main = G.Entry.mk "main"; -EXTEND G - GLOBAL: main; - main: - [ [ l = LIST1 ident -> l ] ]; - ident: - [ [ `LIDENT s -> s ] ]; -END; -let f = Sys.argv.(1) in -Format.printf "%d@." - (List.length (G.parse main (Loc.mk f) (Stream.of_channel (open_in f)))); diff -Nru ocaml-3.12.1/camlp4/test/fixtures/gram-loc-lost.ml ocaml-4.01.0/camlp4/test/fixtures/gram-loc-lost.ml --- ocaml-3.12.1/camlp4/test/fixtures/gram-loc-lost.ml 2006-09-26 09:03:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/gram-loc-lost.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,30 +0,0 @@ -open Camlp4.PreCast; -module G = MakeGram Lexer; -(* type t = [ A of Loc.t and t and t | B of Loc.t and string ]; *) -value main = G.Entry.mk "main"; -(* value rec length x acc = - match x with - [ A x y -> length x (length y acc) - | B _ -> succ acc ]; -value length _ _ = -1; *) -EXTEND G - GLOBAL: main; - main: - [ RIGHTA - [ x = SELF; y = SELF -> - let l = Loc.merge x y in - if l = _loc then _loc - else do { - Format.eprintf "bad loc: %a <> %a + %a@." - Loc.dump _loc Loc.dump x Loc.dump y; - _loc - } - | i = ident -> i ] ]; - ident: - [ [ `LIDENT _ -> _loc ] ]; -END; -try - let f = Sys.argv.(1) in - Format.printf "%a@." - Loc.dump (G.parse main (Loc.mk f) (Stream.of_channel (open_in f))) -with e -> Format.eprintf "error: %a@." Camlp4.ErrorHandler.print e; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/gram-sub-rule.ml ocaml-4.01.0/camlp4/test/fixtures/gram-sub-rule.ml --- ocaml-3.12.1/camlp4/test/fixtures/gram-sub-rule.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/gram-sub-rule.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,33 +0,0 @@ -open Camlp4.PreCast.Syntax; - -value mo _loc = - fun - [ None -> <:expr< None >> - | Some e -> <:expr< Some $e$ >> ]; - -EXTEND Gram -GLOBAL: expr; -expr: - [ [ "testbegin"; - lb = [ "("; l = LIST0 a_LIDENT SEP ","; ")" -> l | "()" -> [] ]; - b = bar; - "testend" -> - let e = - List.fold_right (fun i acc -> <:expr< [ $lid:i$ :: $acc$ ] >>) lb <:expr< [] >> - in <:expr< ($e$, $b$) >> - ] ]; -bar: - [ [ x = OPT [ o = OPT [ x = "testb" -> - <:expr< $str:Token.extract_string x$ >> ]; "testc"; b = baz -> - <:expr< ($mo _loc o$, $b$) >> ] -> mo _loc x - ] ]; -(* bar: - [ [ o = OPT [ o = OPT [ "bar" -> <:expr< bar >> ]; b = baz -> <:expr< ($mo _loc o$, $b$) >> ] -> - mo _loc o - ] ]; *) -(* bar: - [ [ o = OPT [ "bar" -> <:expr< bar >> ]; b = baz -> <:expr< ($mo _loc o$, $b$) >> - ] ]; *) -baz: - [ [ "baz" -> <:expr< baz >> ] ]; -END; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/gram-tree.ml ocaml-4.01.0/camlp4/test/fixtures/gram-tree.ml --- ocaml-3.12.1/camlp4/test/fixtures/gram-tree.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/gram-tree.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,22 +0,0 @@ -open Camlp4.PreCast; -module G = MakeGram Lexer; -type t = [ A of t and t | B of string ]; -value main = G.Entry.mk "main"; -(* value rec length x acc = - match x with - [ A x y -> length x (length y acc) - | B _ -> succ acc ]; *) -value length _ _ = -1; -EXTEND G - GLOBAL: main; - main: - [ [ x = SELF; y = SELF -> A x y - | i = ident -> B i ] ]; - ident: - [ [ `LIDENT s -> s ] ]; -END; -try - let f = Sys.argv.(1) in - Format.printf "%d@." - (length (G.parse main (Loc.mk f) (Stream.of_channel (open_in f))) 0) -with e -> Format.eprintf "error: %a@." Camlp4.ErrorHandler.print e; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/gram-tree2.ml ocaml-4.01.0/camlp4/test/fixtures/gram-tree2.ml --- ocaml-3.12.1/camlp4/test/fixtures/gram-tree2.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/gram-tree2.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,22 +0,0 @@ -open Camlp4.PreCast; -module G = MakeGram Lexer; -type t = [ A of t and t | B of string ]; -value main = G.Entry.mk "main"; -(* value rec length x acc = - match x with - [ A x y -> length x (length y acc) - | B _ -> succ acc ]; *) -value length _ _ = -1; -EXTEND G - GLOBAL: main; - main: - [ [ i = ident; x = SELF -> A (B i) x - | i = ident -> B i ] ]; - ident: - [ [ `LIDENT s -> s ] ]; -END; -try - let f = Sys.argv.(1) in - Format.printf "%d@." - (length (G.parse main (Loc.mk f) (Stream.of_channel (open_in f))) 0) -with e -> Format.eprintf "error: %a@." Camlp4.ErrorHandler.print e; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/gram-tree3.ml ocaml-4.01.0/camlp4/test/fixtures/gram-tree3.ml --- ocaml-3.12.1/camlp4/test/fixtures/gram-tree3.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/gram-tree3.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,23 +0,0 @@ -open Camlp4.PreCast; -module G = MakeGram Lexer; -type t = [ A of t and t | B of string ]; -value main = G.Entry.mk "main"; -(* value rec length x acc = - match x with - [ A x y -> length x (length y acc) - | B _ -> succ acc ]; *) -value length _ _ = -1; -EXTEND G - GLOBAL: main; - main: - [ RIGHTA - [ x = SELF; y = SELF -> A x y - | i = ident -> B i ] ]; - ident: - [ [ `LIDENT s -> s ] ]; -END; -try - let f = Sys.argv.(1) in - Format.printf "%d@." - (length (G.parse main (Loc.mk f) (Stream.of_channel (open_in f))) 0) -with e -> Format.eprintf "error: %a@." Camlp4.ErrorHandler.print e; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/gram.ml ocaml-4.01.0/camlp4/test/fixtures/gram.ml --- ocaml-3.12.1/camlp4/test/fixtures/gram.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/gram.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -EXTEND G expr: [[ l = LIST0 STRING -> l ]]; END; -EXTEND G expr: [[ l = LIST0 [ x = STRING -> x ] -> l ]]; END; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/idents ocaml-4.01.0/camlp4/test/fixtures/idents --- ocaml-3.12.1/camlp4/test/fixtures/idents 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/idents 1970-01-01 00:00:00.000000000 +0000 @@ -1,38 +0,0 @@ -aaa aab aac aad aae aaf aag aah aai aaj aak aal aam aan aao aap aaq aar aas -aat aau aav aaw aax aay aaz aba abb abc abd abe abf abg abh abi abj abk abl -abm abn abo abp abq abr abs abt abu abv abw abx aby abz aca acb acc acd ace -acf acg ach aci acj ack acl acm acn aco acp acq acr acs act acu acv acw acx -acy acz ada adb adc add ade adf adg adh adi adj adk adl adm adn ado adp adq -adr ads adt adu adv adw adx ady adz aea aeb aec aed aee aef aeg aeh aei aej -aek ael aem aen aeo aep aeq aer aes aet aeu aev aew aex aey aez afa afb afc -afd afe aff afg afh afi afj afk afl afm afn afo afp afq afr afs aft afu afv -afw afx afy afz aga agb agc agd age agf agg agh agi agj agk agl agm agn ago -agp agq agr ags agt agu agv agw agx agy agz aha ahb ahc ahd ahe ahf ahg ahh -ahi ahj ahk ahl ahm ahn aho ahp ahq ahr ahs aht ahu ahv ahw ahx ahy ahz aia -aib aic aid aie aif aig aih aii aij aik ail aim ain aio aip aiq air ais ait -aiu aiv aiw aix aiy aiz aja ajb ajc ajd aje ajf ajg ajh aji ajj ajk ajl ajm -ajn ajo ajp ajq ajr ajs ajt aju ajv ajw ajx ajy ajz aka akb akc akd ake akf -akg akh aki akj akk akl akm akn ako akp akq akr aks akt aku akv akw akx aky -akz ala alb alc ald ale alf alg alh ali alj alk all alm aln alo alp alq alr -als alt alu alv alw alx aly alz ama amb amc amd ame amf amg amh ami amj amk -aml amm amn amo amp amq amr ams amt amu amv amw amx amy amz ana anb anc and -ane anf ang anh ani anj ank anl anm ann ano anp anq anr ans ant anu anv anw -anx any anz aoa aob aoc aod aoe aof aog aoh aoi aoj aok aol aom aon aoo aop -aoq aor aos aot aou aov aow aox aoy aoz apa apb apc apd ape apf apg aph api -apj apk apl apm apn apo app apq apr aps apt apu apv apw apx apy apz aqa aqb -aqc aqd aqe aqf aqg aqh aqi aqj aqk aql aqm aqn aqo aqp aqq aqr aqs aqt aqu -aqv aqw aqx aqy aqz ara arb arc ard are arf arg arh ari arj ark arl arm arn -aro arp arq arr ars art aru arv arw arx ary arz asa asb asc asd ase asf asg -ash asi asj ask asl asm asn aso asp asq asr ass ast asu asv asw asx asy asz -ata atb atc atd ate atf atg ath ati atj atk atl atm atn ato atp atq atr ats -att atu atv atw atx aty atz aua aub auc aud aue auf aug auh aui auj auk aul -aum aun auo aup auq aur aus aut auu auv auw aux auy auz ava avb avc avd ave -avf avg avh avi avj avk avl avm avn avo avp avq avr avs avt avu avv avw avx -avy avz awa awb awc awd awe awf awg awh awi awj awk awl awm awn awo awp awq -awr aws awt awu awv aww awx awy awz axa axb axc axd axe axf axg axh axi axj -axk axl axm axn axo axp axq axr axs axt axu axv axw axx axy axz aya ayb ayc -ayd aye ayf ayg ayh ayi ayj ayk ayl aym ayn ayo ayp ayq ayr ays ayt ayu ayv -ayw ayx ayy ayz aza azb azc azd aze azf azg azh azi azj azk azl azm azn azo -azp azq azr azs azt azu azv azw azx azy azz baa bab bac bad bae baf bag bah -bai baj bak bal bam ban bao bap baq bar bas bat bau bav baw bax bay baz bba -bbb diff -Nru ocaml-3.12.1/camlp4/test/fixtures/idents1 ocaml-4.01.0/camlp4/test/fixtures/idents1 --- ocaml-3.12.1/camlp4/test/fixtures/idents1 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/idents1 1970-01-01 00:00:00.000000000 +0000 @@ -1,499 +0,0 @@ -aaaa aaab aaac aaad aaae aaaf aaag aaah aaai aaaj aaak aaal aaam aaan aaao -aaap aaaq aaar aaas aaat aaau aaav aaaw aaax aaay aaaz aaba aabb aabc aabd -aabe aabf aabg aabh aabi aabj aabk aabl aabm aabn aabo aabp aabq aabr aabs -aabt aabu aabv aabw aabx aaby aabz aaca aacb aacc aacd aace aacf aacg aach -aaci aacj aack aacl aacm aacn aaco aacp aacq aacr aacs aact aacu aacv aacw -aacx aacy aacz aada aadb aadc aadd aade aadf aadg aadh aadi aadj aadk aadl -aadm aadn aado aadp aadq aadr aads aadt aadu aadv aadw aadx aady aadz aaea -aaeb aaec aaed aaee aaef aaeg aaeh aaei aaej aaek aael aaem aaen aaeo aaep -aaeq aaer aaes aaet aaeu aaev aaew aaex aaey aaez aafa aafb aafc aafd aafe -aaff aafg aafh aafi aafj aafk aafl aafm aafn aafo aafp aafq aafr aafs aaft -aafu aafv aafw aafx aafy aafz aaga aagb aagc aagd aage aagf aagg aagh aagi -aagj aagk aagl aagm aagn aago aagp aagq aagr aags aagt aagu aagv aagw aagx -aagy aagz aaha aahb aahc aahd aahe aahf aahg aahh aahi aahj aahk aahl aahm -aahn aaho aahp aahq aahr aahs aaht aahu aahv aahw aahx aahy aahz aaia aaib -aaic aaid aaie aaif aaig aaih aaii aaij aaik aail aaim aain aaio aaip aaiq -aair aais aait aaiu aaiv aaiw aaix aaiy aaiz aaja aajb aajc aajd aaje aajf -aajg aajh aaji aajj aajk aajl aajm aajn aajo aajp aajq aajr aajs aajt aaju -aajv aajw aajx aajy aajz aaka aakb aakc aakd aake aakf aakg aakh aaki aakj -aakk aakl aakm aakn aako aakp aakq aakr aaks aakt aaku aakv aakw aakx aaky -aakz aala aalb aalc aald aale aalf aalg aalh aali aalj aalk aall aalm aaln -aalo aalp aalq aalr aals aalt aalu aalv aalw aalx aaly aalz aama aamb aamc -aamd aame aamf aamg aamh aami aamj aamk aaml aamm aamn aamo aamp aamq aamr -aams aamt aamu aamv aamw aamx aamy aamz aana aanb aanc aand aane aanf aang -aanh aani aanj aank aanl aanm aann aano aanp aanq aanr aans aant aanu aanv -aanw aanx aany aanz aaoa aaob aaoc aaod aaoe aaof aaog aaoh aaoi aaoj aaok -aaol aaom aaon aaoo aaop aaoq aaor aaos aaot aaou aaov aaow aaox aaoy aaoz -aapa aapb aapc aapd aape aapf aapg aaph aapi aapj aapk aapl aapm aapn aapo -aapp aapq aapr aaps aapt aapu aapv aapw aapx aapy aapz aaqa aaqb aaqc aaqd -aaqe aaqf aaqg aaqh aaqi aaqj aaqk aaql aaqm aaqn aaqo aaqp aaqq aaqr aaqs -aaqt aaqu aaqv aaqw aaqx aaqy aaqz aara aarb aarc aard aare aarf aarg aarh -aari aarj aark aarl aarm aarn aaro aarp aarq aarr aars aart aaru aarv aarw -aarx aary aarz aasa aasb aasc aasd aase aasf aasg aash aasi aasj aask aasl -aasm aasn aaso aasp aasq aasr aass aast aasu aasv aasw aasx aasy aasz aata -aatb aatc aatd aate aatf aatg aath aati aatj aatk aatl aatm aatn aato aatp -aatq aatr aats aatt aatu aatv aatw aatx aaty aatz aaua aaub aauc aaud aaue -aauf aaug aauh aaui aauj aauk aaul aaum aaun aauo aaup aauq aaur aaus aaut -aauu aauv aauw aaux aauy aauz aava aavb aavc aavd aave aavf aavg aavh aavi -aavj aavk aavl aavm aavn aavo aavp aavq aavr aavs aavt aavu aavv aavw aavx -aavy aavz aawa aawb aawc aawd aawe aawf aawg aawh aawi aawj aawk aawl aawm -aawn aawo aawp aawq aawr aaws aawt aawu aawv aaww aawx aawy aawz aaxa aaxb -aaxc aaxd aaxe aaxf aaxg aaxh aaxi aaxj aaxk aaxl aaxm aaxn aaxo aaxp aaxq -aaxr aaxs aaxt aaxu aaxv aaxw aaxx aaxy aaxz aaya aayb aayc aayd aaye aayf -aayg aayh aayi aayj aayk aayl aaym aayn aayo aayp aayq aayr aays aayt aayu -aayv aayw aayx aayy aayz aaza aazb aazc aazd aaze aazf aazg aazh aazi aazj -aazk aazl aazm aazn aazo aazp aazq aazr aazs aazt aazu aazv aazw aazx aazy -aazz abaa abab abac abad abae abaf abag abah abai abaj abak abal abam aban -abao abap abaq abar abas abat abau abav abaw abax abay abaz abba abbb abbc -abbd abbe abbf abbg abbh abbi abbj abbk abbl abbm abbn abbo abbp abbq abbr -abbs abbt abbu abbv abbw abbx abby abbz abca abcb abcc abcd abce abcf abcg -abch abci abcj abck abcl abcm abcn abco abcp abcq abcr abcs abct abcu abcv -abcw abcx abcy abcz abda abdb abdc abdd abde abdf abdg abdh abdi abdj abdk -abdl abdm abdn abdo abdp abdq abdr abds abdt abdu abdv abdw abdx abdy abdz -abea abeb abec abed abee abef abeg abeh abei abej abek abel abem aben abeo -abep abeq aber abes abet abeu abev abew abex abey abez abfa abfb abfc abfd -abfe abff abfg abfh abfi abfj abfk abfl abfm abfn abfo abfp abfq abfr abfs -abft abfu abfv abfw abfx abfy abfz abga abgb abgc abgd abge abgf abgg abgh -abgi abgj abgk abgl abgm abgn abgo abgp abgq abgr abgs abgt abgu abgv abgw -abgx abgy abgz abha abhb abhc abhd abhe abhf abhg abhh abhi abhj abhk abhl -abhm abhn abho abhp abhq abhr abhs abht abhu abhv abhw abhx abhy abhz abia -abib abic abid abie abif abig abih abii abij abik abil abim abin abio abip -abiq abir abis abit abiu abiv abiw abix abiy abiz abja abjb abjc abjd abje -abjf abjg abjh abji abjj abjk abjl abjm abjn abjo abjp abjq abjr abjs abjt -abju abjv abjw abjx abjy abjz abka abkb abkc abkd abke abkf abkg abkh abki -abkj abkk abkl abkm abkn abko abkp abkq abkr abks abkt abku abkv abkw abkx -abky abkz abla ablb ablc abld able ablf ablg ablh abli ablj ablk abll ablm -abln ablo ablp ablq ablr abls ablt ablu ablv ablw ablx ably ablz abma abmb -abmc abmd abme abmf abmg abmh abmi abmj abmk abml abmm abmn abmo abmp abmq -abmr abms abmt abmu abmv abmw abmx abmy abmz abna abnb abnc abnd abne abnf -abng abnh abni abnj abnk abnl abnm abnn abno abnp abnq abnr abns abnt abnu -abnv abnw abnx abny abnz aboa abob aboc abod aboe abof abog aboh aboi aboj -abok abol abom abon aboo abop aboq abor abos abot abou abov abow abox aboy -aboz abpa abpb abpc abpd abpe abpf abpg abph abpi abpj abpk abpl abpm abpn -abpo abpp abpq abpr abps abpt abpu abpv abpw abpx abpy abpz abqa abqb abqc -abqd abqe abqf abqg abqh abqi abqj abqk abql abqm abqn abqo abqp abqq abqr -abqs abqt abqu abqv abqw abqx abqy abqz abra abrb abrc abrd abre abrf abrg -abrh abri abrj abrk abrl abrm abrn abro abrp abrq abrr abrs abrt abru abrv -abrw abrx abry abrz absa absb absc absd abse absf absg absh absi absj absk -absl absm absn abso absp absq absr abss abst absu absv absw absx absy absz -abta abtb abtc abtd abte abtf abtg abth abti abtj abtk abtl abtm abtn abto -abtp abtq abtr abts abtt abtu abtv abtw abtx abty abtz abua abub abuc abud -abue abuf abug abuh abui abuj abuk abul abum abun abuo abup abuq abur abus -abut abuu abuv abuw abux abuy abuz abva abvb abvc abvd abve abvf abvg abvh -abvi abvj abvk abvl abvm abvn abvo abvp abvq abvr abvs abvt abvu abvv abvw -abvx abvy abvz abwa abwb abwc abwd abwe abwf abwg abwh abwi abwj abwk abwl -abwm abwn abwo abwp abwq abwr abws abwt abwu abwv abww abwx abwy abwz abxa -abxb abxc abxd abxe abxf abxg abxh abxi abxj abxk abxl abxm abxn abxo abxp -abxq abxr abxs abxt abxu abxv abxw abxx abxy abxz abya abyb abyc abyd abye -abyf abyg abyh abyi abyj abyk abyl abym abyn abyo abyp abyq abyr abys abyt -abyu abyv abyw abyx abyy abyz abza abzb abzc abzd abze abzf abzg abzh abzi -abzj abzk abzl abzm abzn abzo abzp abzq abzr abzs abzt abzu abzv abzw abzx -abzy abzz acaa acab acac acad acae acaf acag acah acai acaj acak acal acam -acan acao acap acaq acar acas acat acau acav acaw acax acay acaz acba acbb -acbc acbd acbe acbf acbg acbh acbi acbj acbk acbl acbm acbn acbo acbp acbq -acbr acbs acbt acbu acbv acbw acbx acby acbz acca accb accc accd acce accf -accg acch acci accj acck accl accm accn acco accp accq accr accs acct accu -accv accw accx accy accz acda acdb acdc acdd acde acdf acdg acdh acdi acdj -acdk acdl acdm acdn acdo acdp acdq acdr acds acdt acdu acdv acdw acdx acdy -acdz acea aceb acec aced acee acef aceg aceh acei acej acek acel acem acen -aceo acep aceq acer aces acet aceu acev acew acex acey acez acfa acfb acfc -acfd acfe acff acfg acfh acfi acfj acfk acfl acfm acfn acfo acfp acfq acfr -acfs acft acfu acfv acfw acfx acfy acfz acga acgb acgc acgd acge acgf acgg -acgh acgi acgj acgk acgl acgm acgn acgo acgp acgq acgr acgs acgt acgu acgv -acgw acgx acgy acgz acha achb achc achd ache achf achg achh achi achj achk -achl achm achn acho achp achq achr achs acht achu achv achw achx achy achz -acia acib acic acid acie acif acig acih acii acij acik acil acim acin acio -acip aciq acir acis acit aciu aciv aciw acix aciy aciz acja acjb acjc acjd -acje acjf acjg acjh acji acjj acjk acjl acjm acjn acjo acjp acjq acjr acjs -acjt acju acjv acjw acjx acjy acjz acka ackb ackc ackd acke ackf ackg ackh -acki ackj ackk ackl ackm ackn acko ackp ackq ackr acks ackt acku ackv ackw -ackx acky ackz acla aclb aclc acld acle aclf aclg aclh acli aclj aclk acll -aclm acln aclo aclp aclq aclr acls aclt aclu aclv aclw aclx acly aclz acma -acmb acmc acmd acme acmf acmg acmh acmi acmj acmk acml acmm acmn acmo acmp -acmq acmr acms acmt acmu acmv acmw acmx acmy acmz acna acnb acnc acnd acne -acnf acng acnh acni acnj acnk acnl acnm acnn acno acnp acnq acnr acns acnt -acnu acnv acnw acnx acny acnz acoa acob acoc acod acoe acof acog acoh acoi -acoj acok acol acom acon acoo acop acoq acor acos acot acou acov acow acox -acoy acoz acpa acpb acpc acpd acpe acpf acpg acph acpi acpj acpk acpl acpm -acpn acpo acpp acpq acpr acps acpt acpu acpv acpw acpx acpy acpz acqa acqb -acqc acqd acqe acqf acqg acqh acqi acqj acqk acql acqm acqn acqo acqp acqq -acqr acqs acqt acqu acqv acqw acqx acqy acqz acra acrb acrc acrd acre acrf -acrg acrh acri acrj acrk acrl acrm acrn acro acrp acrq acrr acrs acrt acru -acrv acrw acrx acry acrz acsa acsb acsc acsd acse acsf acsg acsh acsi acsj -acsk acsl acsm acsn acso acsp acsq acsr acss acst acsu acsv acsw acsx acsy -acsz acta actb actc actd acte actf actg acth acti actj actk actl actm actn -acto actp actq actr acts actt actu actv actw actx acty actz acua acub acuc -acud acue acuf acug acuh acui acuj acuk acul acum acun acuo acup acuq acur -acus acut acuu acuv acuw acux acuy acuz acva acvb acvc acvd acve acvf acvg -acvh acvi acvj acvk acvl acvm acvn acvo acvp acvq acvr acvs acvt acvu acvv -acvw acvx acvy acvz acwa acwb acwc acwd acwe acwf acwg acwh acwi acwj acwk -acwl acwm acwn acwo acwp acwq acwr acws acwt acwu acwv acww acwx acwy acwz -acxa acxb acxc acxd acxe acxf acxg acxh acxi acxj acxk acxl acxm acxn acxo -acxp acxq acxr acxs acxt acxu acxv acxw acxx acxy acxz acya acyb acyc acyd -acye acyf acyg acyh acyi acyj acyk acyl acym acyn acyo acyp acyq acyr acys -acyt acyu acyv acyw acyx acyy acyz acza aczb aczc aczd acze aczf aczg aczh -aczi aczj aczk aczl aczm aczn aczo aczp aczq aczr aczs aczt aczu aczv aczw -aczx aczy aczz adaa adab adac adad adae adaf adag adah adai adaj adak adal -adam adan adao adap adaq adar adas adat adau adav adaw adax aday adaz adba -adbb adbc adbd adbe adbf adbg adbh adbi adbj adbk adbl adbm adbn adbo adbp -adbq adbr adbs adbt adbu adbv adbw adbx adby adbz adca adcb adcc adcd adce -adcf adcg adch adci adcj adck adcl adcm adcn adco adcp adcq adcr adcs adct -adcu adcv adcw adcx adcy adcz adda addb addc addd adde addf addg addh addi -addj addk addl addm addn addo addp addq addr adds addt addu addv addw addx -addy addz adea adeb adec aded adee adef adeg adeh adei adej adek adel adem -aden adeo adep adeq ader ades adet adeu adev adew adex adey adez adfa adfb -adfc adfd adfe adff adfg adfh adfi adfj adfk adfl adfm adfn adfo adfp adfq -adfr adfs adft adfu adfv adfw adfx adfy adfz adga adgb adgc adgd adge adgf -adgg adgh adgi adgj adgk adgl adgm adgn adgo adgp adgq adgr adgs adgt adgu -adgv adgw adgx adgy adgz adha adhb adhc adhd adhe adhf adhg adhh adhi adhj -adhk adhl adhm adhn adho adhp adhq adhr adhs adht adhu adhv adhw adhx adhy -adhz adia adib adic adid adie adif adig adih adii adij adik adil adim adin -adio adip adiq adir adis adit adiu adiv adiw adix adiy adiz adja adjb adjc -adjd adje adjf adjg adjh adji adjj adjk adjl adjm adjn adjo adjp adjq adjr -adjs adjt adju adjv adjw adjx adjy adjz adka adkb adkc adkd adke adkf adkg -adkh adki adkj adkk adkl adkm adkn adko adkp adkq adkr adks adkt adku adkv -adkw adkx adky adkz adla adlb adlc adld adle adlf adlg adlh adli adlj adlk -adll adlm adln adlo adlp adlq adlr adls adlt adlu adlv adlw adlx adly adlz -adma admb admc admd adme admf admg admh admi admj admk adml admm admn admo -admp admq admr adms admt admu admv admw admx admy admz adna adnb adnc adnd -adne adnf adng adnh adni adnj adnk adnl adnm adnn adno adnp adnq adnr adns -adnt adnu adnv adnw adnx adny adnz adoa adob adoc adod adoe adof adog adoh -adoi adoj adok adol adom adon adoo adop adoq ador ados adot adou adov adow -adox adoy adoz adpa adpb adpc adpd adpe adpf adpg adph adpi adpj adpk adpl -adpm adpn adpo adpp adpq adpr adps adpt adpu adpv adpw adpx adpy adpz adqa -adqb adqc adqd adqe adqf adqg adqh adqi adqj adqk adql adqm adqn adqo adqp -adqq adqr adqs adqt adqu adqv adqw adqx adqy adqz adra adrb adrc adrd adre -adrf adrg adrh adri adrj adrk adrl adrm adrn adro adrp adrq adrr adrs adrt -adru adrv adrw adrx adry adrz adsa adsb adsc adsd adse adsf adsg adsh adsi -adsj adsk adsl adsm adsn adso adsp adsq adsr adss adst adsu adsv adsw adsx -adsy adsz adta adtb adtc adtd adte adtf adtg adth adti adtj adtk adtl adtm -adtn adto adtp adtq adtr adts adtt adtu adtv adtw adtx adty adtz adua adub -aduc adud adue aduf adug aduh adui aduj aduk adul adum adun aduo adup aduq -adur adus adut aduu aduv aduw adux aduy aduz adva advb advc advd adve advf -advg advh advi advj advk advl advm advn advo advp advq advr advs advt advu -advv advw advx advy advz adwa adwb adwc adwd adwe adwf adwg adwh adwi adwj -adwk adwl adwm adwn adwo adwp adwq adwr adws adwt adwu adwv adww adwx adwy -adwz adxa adxb adxc adxd adxe adxf adxg adxh adxi adxj adxk adxl adxm adxn -adxo adxp adxq adxr adxs adxt adxu adxv adxw adxx adxy adxz adya adyb adyc -adyd adye adyf adyg adyh adyi adyj adyk adyl adym adyn adyo adyp adyq adyr -adys adyt adyu adyv adyw adyx adyy adyz adza adzb adzc adzd adze adzf adzg -adzh adzi adzj adzk adzl adzm adzn adzo adzp adzq adzr adzs adzt adzu adzv -adzw adzx adzy adzz aeaa aeab aeac aead aeae aeaf aeag aeah aeai aeaj aeak -aeal aeam aean aeao aeap aeaq aear aeas aeat aeau aeav aeaw aeax aeay aeaz -aeba aebb aebc aebd aebe aebf aebg aebh aebi aebj aebk aebl aebm aebn aebo -aebp aebq aebr aebs aebt aebu aebv aebw aebx aeby aebz aeca aecb aecc aecd -aece aecf aecg aech aeci aecj aeck aecl aecm aecn aeco aecp aecq aecr aecs -aect aecu aecv aecw aecx aecy aecz aeda aedb aedc aedd aede aedf aedg aedh -aedi aedj aedk aedl aedm aedn aedo aedp aedq aedr aeds aedt aedu aedv aedw -aedx aedy aedz aeea aeeb aeec aeed aeee aeef aeeg aeeh aeei aeej aeek aeel -aeem aeen aeeo aeep aeeq aeer aees aeet aeeu aeev aeew aeex aeey aeez aefa -aefb aefc aefd aefe aeff aefg aefh aefi aefj aefk aefl aefm aefn aefo aefp -aefq aefr aefs aeft aefu aefv aefw aefx aefy aefz aega aegb aegc aegd aege -aegf aegg aegh aegi aegj aegk aegl aegm aegn aego aegp aegq aegr aegs aegt -aegu aegv aegw aegx aegy aegz aeha aehb aehc aehd aehe aehf aehg aehh aehi -aehj aehk aehl aehm aehn aeho aehp aehq aehr aehs aeht aehu aehv aehw aehx -aehy aehz aeia aeib aeic aeid aeie aeif aeig aeih aeii aeij aeik aeil aeim -aein aeio aeip aeiq aeir aeis aeit aeiu aeiv aeiw aeix aeiy aeiz aeja aejb -aejc aejd aeje aejf aejg aejh aeji aejj aejk aejl aejm aejn aejo aejp aejq -aejr aejs aejt aeju aejv aejw aejx aejy aejz aeka aekb aekc aekd aeke aekf -aekg aekh aeki aekj aekk aekl aekm aekn aeko aekp aekq aekr aeks aekt aeku -aekv aekw aekx aeky aekz aela aelb aelc aeld aele aelf aelg aelh aeli aelj -aelk aell aelm aeln aelo aelp aelq aelr aels aelt aelu aelv aelw aelx aely -aelz aema aemb aemc aemd aeme aemf aemg aemh aemi aemj aemk aeml aemm aemn -aemo aemp aemq aemr aems aemt aemu aemv aemw aemx aemy aemz aena aenb aenc -aend aene aenf aeng aenh aeni aenj aenk aenl aenm aenn aeno aenp aenq aenr -aens aent aenu aenv aenw aenx aeny aenz aeoa aeob aeoc aeod aeoe aeof aeog -aeoh aeoi aeoj aeok aeol aeom aeon aeoo aeop aeoq aeor aeos aeot aeou aeov -aeow aeox aeoy aeoz aepa aepb aepc aepd aepe aepf aepg aeph aepi aepj aepk -aepl aepm aepn aepo aepp aepq aepr aeps aept aepu aepv aepw aepx aepy aepz -aeqa aeqb aeqc aeqd aeqe aeqf aeqg aeqh aeqi aeqj aeqk aeql aeqm aeqn aeqo -aeqp aeqq aeqr aeqs aeqt aequ aeqv aeqw aeqx aeqy aeqz aera aerb aerc aerd -aere aerf aerg aerh aeri aerj aerk aerl aerm aern aero aerp aerq aerr aers -aert aeru aerv aerw aerx aery aerz aesa aesb aesc aesd aese aesf aesg aesh -aesi aesj aesk aesl aesm aesn aeso aesp aesq aesr aess aest aesu aesv aesw -aesx aesy aesz aeta aetb aetc aetd aete aetf aetg aeth aeti aetj aetk aetl -aetm aetn aeto aetp aetq aetr aets aett aetu aetv aetw aetx aety aetz aeua -aeub aeuc aeud aeue aeuf aeug aeuh aeui aeuj aeuk aeul aeum aeun aeuo aeup -aeuq aeur aeus aeut aeuu aeuv aeuw aeux aeuy aeuz aeva aevb aevc aevd aeve -aevf aevg aevh aevi aevj aevk aevl aevm aevn aevo aevp aevq aevr aevs aevt -aevu aevv aevw aevx aevy aevz aewa aewb aewc aewd aewe aewf aewg aewh aewi -aewj aewk aewl aewm aewn aewo aewp aewq aewr aews aewt aewu aewv aeww aewx -aewy aewz aexa aexb aexc aexd aexe aexf aexg aexh aexi aexj aexk aexl aexm -aexn aexo aexp aexq aexr aexs aext aexu aexv aexw aexx aexy aexz aeya aeyb -aeyc aeyd aeye aeyf aeyg aeyh aeyi aeyj aeyk aeyl aeym aeyn aeyo aeyp aeyq -aeyr aeys aeyt aeyu aeyv aeyw aeyx aeyy aeyz aeza aezb aezc aezd aeze aezf -aezg aezh aezi aezj aezk aezl aezm aezn aezo aezp aezq aezr aezs aezt aezu -aezv aezw aezx aezy aezz afaa afab afac afad afae afaf afag afah afai afaj -afak afal afam afan afao afap afaq afar afas afat afau afav afaw afax afay -afaz afba afbb afbc afbd afbe afbf afbg afbh afbi afbj afbk afbl afbm afbn -afbo afbp afbq afbr afbs afbt afbu afbv afbw afbx afby afbz afca afcb afcc -afcd afce afcf afcg afch afci afcj afck afcl afcm afcn afco afcp afcq afcr -afcs afct afcu afcv afcw afcx afcy afcz afda afdb afdc afdd afde afdf afdg -afdh afdi afdj afdk afdl afdm afdn afdo afdp afdq afdr afds afdt afdu afdv -afdw afdx afdy afdz afea afeb afec afed afee afef afeg afeh afei afej afek -afel afem afen afeo afep afeq afer afes afet afeu afev afew afex afey afez -affa affb affc affd affe afff affg affh affi affj affk affl affm affn affo -affp affq affr affs afft affu affv affw affx affy affz afga afgb afgc afgd -afge afgf afgg afgh afgi afgj afgk afgl afgm afgn afgo afgp afgq afgr afgs -afgt afgu afgv afgw afgx afgy afgz afha afhb afhc afhd afhe afhf afhg afhh -afhi afhj afhk afhl afhm afhn afho afhp afhq afhr afhs afht afhu afhv afhw -afhx afhy afhz afia afib afic afid afie afif afig afih afii afij afik afil -afim afin afio afip afiq afir afis afit afiu afiv afiw afix afiy afiz afja -afjb afjc afjd afje afjf afjg afjh afji afjj afjk afjl afjm afjn afjo afjp -afjq afjr afjs afjt afju afjv afjw afjx afjy afjz afka afkb afkc afkd afke -afkf afkg afkh afki afkj afkk afkl afkm afkn afko afkp afkq afkr afks afkt -afku afkv afkw afkx afky afkz afla aflb aflc afld afle aflf aflg aflh afli -aflj aflk afll aflm afln aflo aflp aflq aflr afls aflt aflu aflv aflw aflx -afly aflz afma afmb afmc afmd afme afmf afmg afmh afmi afmj afmk afml afmm -afmn afmo afmp afmq afmr afms afmt afmu afmv afmw afmx afmy afmz afna afnb -afnc afnd afne afnf afng afnh afni afnj afnk afnl afnm afnn afno afnp afnq -afnr afns afnt afnu afnv afnw afnx afny afnz afoa afob afoc afod afoe afof -afog afoh afoi afoj afok afol afom afon afoo afop afoq afor afos afot afou -afov afow afox afoy afoz afpa afpb afpc afpd afpe afpf afpg afph afpi afpj -afpk afpl afpm afpn afpo afpp afpq afpr afps afpt afpu afpv afpw afpx afpy -afpz afqa afqb afqc afqd afqe afqf afqg afqh afqi afqj afqk afql afqm afqn -afqo afqp afqq afqr afqs afqt afqu afqv afqw afqx afqy afqz afra afrb afrc -afrd afre afrf afrg afrh afri afrj afrk afrl afrm afrn afro afrp afrq afrr -afrs afrt afru afrv afrw afrx afry afrz afsa afsb afsc afsd afse afsf afsg -afsh afsi afsj afsk afsl afsm afsn afso afsp afsq afsr afss afst afsu afsv -afsw afsx afsy afsz afta aftb aftc aftd afte aftf aftg afth afti aftj aftk -aftl aftm aftn afto aftp aftq aftr afts aftt aftu aftv aftw aftx afty aftz -afua afub afuc afud afue afuf afug afuh afui afuj afuk aful afum afun afuo -afup afuq afur afus afut afuu afuv afuw afux afuy afuz afva afvb afvc afvd -afve afvf afvg afvh afvi afvj afvk afvl afvm afvn afvo afvp afvq afvr afvs -afvt afvu afvv afvw afvx afvy afvz afwa afwb afwc afwd afwe afwf afwg afwh -afwi afwj afwk afwl afwm afwn afwo afwp afwq afwr afws afwt afwu afwv afww -afwx afwy afwz afxa afxb afxc afxd afxe afxf afxg afxh afxi afxj afxk afxl -afxm afxn afxo afxp afxq afxr afxs afxt afxu afxv afxw afxx afxy afxz afya -afyb afyc afyd afye afyf afyg afyh afyi afyj afyk afyl afym afyn afyo afyp -afyq afyr afys afyt afyu afyv afyw afyx afyy afyz afza afzb afzc afzd afze -afzf afzg afzh afzi afzj afzk afzl afzm afzn afzo afzp afzq afzr afzs afzt -afzu afzv afzw afzx afzy afzz agaa agab agac agad agae agaf agag agah agai -agaj agak agal agam agan agao agap agaq agar agas agat agau agav agaw agax -agay agaz agba agbb agbc agbd agbe agbf agbg agbh agbi agbj agbk agbl agbm -agbn agbo agbp agbq agbr agbs agbt agbu agbv agbw agbx agby agbz agca agcb -agcc agcd agce agcf agcg agch agci agcj agck agcl agcm agcn agco agcp agcq -agcr agcs agct agcu agcv agcw agcx agcy agcz agda agdb agdc agdd agde agdf -agdg agdh agdi agdj agdk agdl agdm agdn agdo agdp agdq agdr agds agdt agdu -agdv agdw agdx agdy agdz agea ageb agec aged agee agef ageg ageh agei agej -agek agel agem agen ageo agep ageq ager ages aget ageu agev agew agex agey -agez agfa agfb agfc agfd agfe agff agfg agfh agfi agfj agfk agfl agfm agfn -agfo agfp agfq agfr agfs agft agfu agfv agfw agfx agfy agfz agga aggb aggc -aggd agge aggf aggg aggh aggi aggj aggk aggl aggm aggn aggo aggp aggq aggr -aggs aggt aggu aggv aggw aggx aggy aggz agha aghb aghc aghd aghe aghf aghg -aghh aghi aghj aghk aghl aghm aghn agho aghp aghq aghr aghs aght aghu aghv -aghw aghx aghy aghz agia agib agic agid agie agif agig agih agii agij agik -agil agim agin agio agip agiq agir agis agit agiu agiv agiw agix agiy agiz -agja agjb agjc agjd agje agjf agjg agjh agji agjj agjk agjl agjm agjn agjo -agjp agjq agjr agjs agjt agju agjv agjw agjx agjy agjz agka agkb agkc agkd -agke agkf agkg agkh agki agkj agkk agkl agkm agkn agko agkp agkq agkr agks -agkt agku agkv agkw agkx agky agkz agla aglb aglc agld agle aglf aglg aglh -agli aglj aglk agll aglm agln aglo aglp aglq aglr agls aglt aglu aglv aglw -aglx agly aglz agma agmb agmc agmd agme agmf agmg agmh agmi agmj agmk agml -agmm agmn agmo agmp agmq agmr agms agmt agmu agmv agmw agmx agmy agmz agna -agnb agnc agnd agne agnf agng agnh agni agnj agnk agnl agnm agnn agno agnp -agnq agnr agns agnt agnu agnv agnw agnx agny agnz agoa agob agoc agod agoe -agof agog agoh agoi agoj agok agol agom agon agoo agop agoq agor agos agot -agou agov agow agox agoy agoz agpa agpb agpc agpd agpe agpf agpg agph agpi -agpj agpk agpl agpm agpn agpo agpp agpq agpr agps agpt agpu agpv agpw agpx -agpy agpz agqa agqb agqc agqd agqe agqf agqg agqh agqi agqj agqk agql agqm -agqn agqo agqp agqq agqr agqs agqt agqu agqv agqw agqx agqy agqz agra agrb -agrc agrd agre agrf agrg agrh agri agrj agrk agrl agrm agrn agro agrp agrq -agrr agrs agrt agru agrv agrw agrx agry agrz agsa agsb agsc agsd agse agsf -agsg agsh agsi agsj agsk agsl agsm agsn agso agsp agsq agsr agss agst agsu -agsv agsw agsx agsy agsz agta agtb agtc agtd agte agtf agtg agth agti agtj -agtk agtl agtm agtn agto agtp agtq agtr agts agtt agtu agtv agtw agtx agty -agtz agua agub aguc agud ague aguf agug aguh agui aguj aguk agul agum agun -aguo agup aguq agur agus agut aguu aguv aguw agux aguy aguz agva agvb agvc -agvd agve agvf agvg agvh agvi agvj agvk agvl agvm agvn agvo agvp agvq agvr -agvs agvt agvu agvv agvw agvx agvy agvz agwa agwb agwc agwd agwe agwf agwg -agwh agwi agwj agwk agwl agwm agwn agwo agwp agwq agwr agws agwt agwu agwv -agww agwx agwy agwz agxa agxb agxc agxd agxe agxf agxg agxh agxi agxj agxk -agxl agxm agxn agxo agxp agxq agxr agxs agxt agxu agxv agxw agxx agxy agxz -agya agyb agyc agyd agye agyf agyg agyh agyi agyj agyk agyl agym agyn agyo -agyp agyq agyr agys agyt agyu agyv agyw agyx agyy agyz agza agzb agzc agzd -agze agzf agzg agzh agzi agzj agzk agzl agzm agzn agzo agzp agzq agzr agzs -agzt agzu agzv agzw agzx agzy agzz ahaa ahab ahac ahad ahae ahaf ahag ahah -ahai ahaj ahak ahal aham ahan ahao ahap ahaq ahar ahas ahat ahau ahav ahaw -ahax ahay ahaz ahba ahbb ahbc ahbd ahbe ahbf ahbg ahbh ahbi ahbj ahbk ahbl -ahbm ahbn ahbo ahbp ahbq ahbr ahbs ahbt ahbu ahbv ahbw ahbx ahby ahbz ahca -ahcb ahcc ahcd ahce ahcf ahcg ahch ahci ahcj ahck ahcl ahcm ahcn ahco ahcp -ahcq ahcr ahcs ahct ahcu ahcv ahcw ahcx ahcy ahcz ahda ahdb ahdc ahdd ahde -ahdf ahdg ahdh ahdi ahdj ahdk ahdl ahdm ahdn ahdo ahdp ahdq ahdr ahds ahdt -ahdu ahdv ahdw ahdx ahdy ahdz ahea aheb ahec ahed ahee ahef aheg aheh ahei -ahej ahek ahel ahem ahen aheo ahep aheq aher ahes ahet aheu ahev ahew ahex -ahey ahez ahfa ahfb ahfc ahfd ahfe ahff ahfg ahfh ahfi ahfj ahfk ahfl ahfm -ahfn ahfo ahfp ahfq ahfr ahfs ahft ahfu ahfv ahfw ahfx ahfy ahfz ahga ahgb -ahgc ahgd ahge ahgf ahgg ahgh ahgi ahgj ahgk ahgl ahgm ahgn ahgo ahgp ahgq -ahgr ahgs ahgt ahgu ahgv ahgw ahgx ahgy ahgz ahha ahhb ahhc ahhd ahhe ahhf -ahhg ahhh ahhi ahhj ahhk ahhl ahhm ahhn ahho ahhp ahhq ahhr ahhs ahht ahhu -ahhv ahhw ahhx ahhy ahhz ahia ahib ahic ahid ahie ahif ahig ahih ahii ahij -ahik ahil ahim ahin ahio ahip ahiq ahir ahis ahit ahiu ahiv ahiw ahix ahiy -ahiz ahja ahjb ahjc ahjd ahje ahjf ahjg ahjh ahji ahjj ahjk ahjl ahjm ahjn -ahjo ahjp ahjq ahjr ahjs ahjt ahju ahjv ahjw ahjx ahjy ahjz ahka ahkb ahkc -ahkd ahke ahkf ahkg ahkh ahki ahkj ahkk ahkl ahkm ahkn ahko ahkp ahkq ahkr -ahks ahkt ahku ahkv ahkw ahkx ahky ahkz ahla ahlb ahlc ahld ahle ahlf ahlg -ahlh ahli ahlj ahlk ahll ahlm ahln ahlo ahlp ahlq ahlr ahls ahlt ahlu ahlv -ahlw ahlx ahly ahlz ahma ahmb ahmc ahmd ahme ahmf ahmg ahmh ahmi ahmj ahmk -ahml ahmm ahmn ahmo ahmp ahmq ahmr ahms ahmt ahmu ahmv ahmw ahmx ahmy ahmz -ahna ahnb ahnc ahnd ahne ahnf ahng ahnh ahni ahnj ahnk ahnl ahnm ahnn ahno -ahnp ahnq ahnr ahns ahnt ahnu ahnv ahnw ahnx ahny ahnz ahoa ahob ahoc ahod -ahoe ahof ahog ahoh ahoi ahoj ahok ahol ahom ahon ahoo ahop ahoq ahor ahos -ahot ahou ahov ahow ahox ahoy ahoz ahpa ahpb ahpc ahpd ahpe ahpf ahpg ahph -ahpi ahpj ahpk ahpl ahpm ahpn ahpo ahpp ahpq ahpr ahps ahpt ahpu ahpv ahpw -ahpx ahpy ahpz ahqa ahqb ahqc ahqd ahqe ahqf ahqg ahqh ahqi ahqj ahqk ahql -ahqm ahqn ahqo ahqp ahqq ahqr ahqs ahqt ahqu ahqv ahqw ahqx ahqy ahqz ahra -ahrb ahrc ahrd ahre ahrf ahrg ahrh ahri ahrj ahrk ahrl ahrm ahrn ahro ahrp -ahrq ahrr ahrs ahrt ahru ahrv ahrw ahrx ahry ahrz ahsa ahsb ahsc ahsd ahse -ahsf ahsg ahsh ahsi ahsj ahsk ahsl ahsm ahsn ahso ahsp ahsq ahsr ahss ahst -ahsu ahsv ahsw ahsx ahsy ahsz ahta ahtb ahtc ahtd ahte ahtf ahtg ahth ahti -ahtj ahtk ahtl ahtm ahtn ahto ahtp ahtq ahtr ahts ahtt ahtu ahtv ahtw ahtx -ahty ahtz ahua ahub ahuc ahud ahue ahuf ahug ahuh ahui ahuj ahuk ahul ahum -ahun ahuo ahup ahuq ahur ahus ahut ahuu ahuv ahuw ahux ahuy ahuz ahva ahvb -ahvc ahvd ahve ahvf ahvg ahvh ahvi ahvj ahvk ahvl ahvm ahvn ahvo ahvp ahvq -ahvr ahvs ahvt ahvu ahvv ahvw ahvx ahvy ahvz ahwa ahwb ahwc ahwd ahwe ahwf -ahwg ahwh ahwi ahwj ahwk ahwl ahwm ahwn ahwo ahwp ahwq ahwr ahws ahwt ahwu -ahwv ahww ahwx ahwy ahwz ahxa ahxb ahxc ahxd ahxe ahxf ahxg ahxh ahxi ahxj -ahxk ahxl ahxm ahxn ahxo ahxp ahxq ahxr ahxs ahxt ahxu ahxv ahxw ahxx ahxy -ahxz ahya ahyb ahyc ahyd ahye ahyf ahyg ahyh ahyi ahyj ahyk ahyl ahym ahyn -ahyo ahyp ahyq ahyr ahys ahyt ahyu ahyv ahyw ahyx ahyy ahyz ahza ahzb ahzc -ahzd ahze ahzf ahzg ahzh ahzi ahzj ahzk ahzl ahzm ahzn ahzo ahzp ahzq ahzr -ahzs ahzt ahzu ahzv ahzw ahzx ahzy ahzz aiaa aiab aiac aiad aiae aiaf aiag -aiah aiai aiaj aiak aial aiam aian aiao aiap aiaq aiar aias aiat aiau aiav -aiaw aiax aiay aiaz aiba aibb aibc aibd aibe aibf aibg aibh aibi aibj aibk -aibl aibm aibn aibo aibp aibq aibr aibs aibt aibu aibv aibw aibx aiby aibz -aica aicb aicc aicd aice aicf aicg aich aici aicj aick aicl aicm aicn aico -aicp aicq aicr aics aict aicu aicv aicw aicx aicy aicz aida aidb aidc aidd -aide aidf aidg aidh aidi aidj aidk aidl aidm aidn aido aidp aidq aidr aids -aidt aidu aidv aidw aidx aidy aidz aiea aieb aiec aied aiee aief aieg aieh -aiei aiej aiek aiel aiem aien aieo aiep aieq aier aies aiet aieu aiev aiew -aiex aiey aiez aifa aifb aifc aifd aife aiff aifg aifh aifi aifj aifk aifl -aifm aifn aifo aifp aifq aifr aifs aift aifu aifv aifw aifx aify aifz aiga -aigb aigc aigd aige aigf aigg aigh aigi aigj aigk aigl aigm aign aigo aigp -aigq aigr aigs aigt aigu aigv aigw aigx aigy aigz aiha aihb aihc aihd aihe -aihf aihg aihh aihi aihj aihk aihl aihm aihn aiho aihp aihq aihr aihs aiht -aihu aihv aihw aihx aihy aihz aiia aiib aiic aiid aiie aiif aiig aiih aiii -aiij aiik aiil aiim aiin aiio aiip aiiq aiir aiis aiit aiiu aiiv aiiw aiix -aiiy aiiz aija aijb aijc aijd aije aijf aijg aijh aiji aijj aijk aijl aijm -aijn aijo aijp aijq aijr aijs aijt aiju aijv aijw aijx aijy aijz aika aikb -aikc aikd aike aikf aikg aikh aiki aikj aikk aikl aikm aikn aiko aikp aikq -aikr aiks aikt aiku aikv aikw aikx aiky aikz aila ailb ailc aild aile ailf -ailg ailh aili ailj ailk aill ailm ailn ailo ailp ailq ailr ails ailt ailu -ailv ailw ailx aily ailz aima aimb aimc aimd aime aimf aimg aimh aimi aimj -aimk aiml aimm aimn aimo aimp aimq aimr aims aimt aimu aimv aimw aimx aimy -aimz aina ainb ainc aind aine ainf aing ainh aini ainj aink ainl ainm ainn -aino ainp ainq ainr ains aint ainu ainv ainw ainx ainy ainz aioa aiob aioc -aiod aioe aiof aiog aioh aioi aioj aiok aiol aiom aion aioo aiop aioq aior -aios aiot aiou aiov aiow aiox aioy aioz aipa aipb aipc aipd aipe aipf aipg -aiph aipi aipj aipk aipl aipm aipn aipo aipp aipq aipr aips aipt aipu aipv -aipw aipx aipy aipz aiqa aiqb aiqc aiqd aiqe aiqf aiqg aiqh aiqi aiqj aiqk -aiql aiqm aiqn aiqo aiqp aiqq aiqr aiqs aiqt aiqu aiqv aiqw aiqx aiqy aiqz -aira airb airc aird aire airf airg airh airi airj airk airl airm airn airo -airp airq airr airs airt airu airv airw airx airy airz aisa aisb aisc aisd -aise aisf aisg aish aisi aisj aisk aisl aism aisn aiso aisp aisq aisr aiss -aist aisu aisv aisw aisx aisy aisz aita aitb aitc aitd aite aitf aitg aith -aiti aitj aitk aitl aitm aitn aito aitp aitq aitr aits aitt aitu aitv aitw -aitx aity aitz aiua aiub aiuc aiud aiue aiuf aiug aiuh aiui aiuj aiuk aiul -aium aiun aiuo aiup aiuq aiur aius aiut aiuu aiuv aiuw aiux aiuy aiuz aiva -aivb aivc aivd aive aivf aivg aivh aivi aivj aivk aivl aivm aivn aivo aivp -aivq aivr aivs aivt aivu aivv aivw aivx aivy aivz aiwa aiwb aiwc aiwd aiwe -aiwf aiwg aiwh aiwi aiwj aiwk aiwl aiwm aiwn aiwo aiwp aiwq aiwr aiws aiwt -aiwu aiwv aiww aiwx aiwy aiwz aixa aixb aixc aixd aixe aixf aixg aixh aixi -aixj aixk aixl aixm aixn aixo aixp aixq aixr aixs aixt aixu aixv aixw aixx -aixy aixz aiya aiyb aiyc aiyd aiye aiyf aiyg aiyh aiyi aiyj aiyk aiyl aiym -aiyn aiyo aiyp aiyq aiyr aiys aiyt aiyu aiyv aiyw aiyx aiyy aiyz aiza aizb -aizc aizd aize aizf aizg aizh aizi aizj aizk aizl aizm aizn aizo aizp aizq -aizr aizs aizt aizu aizv aizw aizx aizy aizz ajaa ajab ajac ajad ajae ajaf -ajag ajah ajai ajaj ajak ajal ajam ajan ajao ajap ajaq ajar ajas ajat ajau -ajav ajaw ajax ajay ajaz ajba ajbb ajbc ajbd ajbe ajbf ajbg ajbh ajbi ajbj -ajbk ajbl ajbm ajbn ajbo ajbp ajbq ajbr ajbs ajbt ajbu ajbv ajbw ajbx ajby -ajbz ajca ajcb ajcc ajcd ajce ajcf ajcg ajch ajci ajcj ajck ajcl ajcm ajcn -ajco ajcp ajcq ajcr ajcs ajct ajcu ajcv ajcw ajcx ajcy ajcz ajda ajdb ajdc -ajdd ajde ajdf ajdg ajdh ajdi ajdj ajdk ajdl ajdm ajdn ajdo ajdp ajdq ajdr -ajds ajdt ajdu ajdv ajdw ajdx ajdy ajdz ajea ajeb ajec ajed ajee ajef ajeg -ajeh ajei ajej ajek ajel ajem ajen ajeo ajep ajeq ajer ajes ajet ajeu ajev -ajew ajex ajey ajez ajfa ajfb ajfc ajfd ajfe ajff ajfg ajfh ajfi ajfj ajfk -ajfl ajfm ajfn ajfo ajfp ajfq ajfr ajfs ajft ajfu ajfv ajfw ajfx ajfy ajfz -ajga ajgb ajgc ajgd ajge ajgf ajgg ajgh ajgi ajgj ajgk ajgl ajgm ajgn ajgo -ajgp ajgq ajgr ajgs ajgt ajgu ajgv ajgw ajgx ajgy ajgz ajha ajhb ajhc ajhd -ajhe ajhf ajhg ajhh ajhi ajhj ajhk ajhl ajhm ajhn ajho ajhp ajhq ajhr ajhs -ajht ajhu ajhv ajhw ajhx ajhy ajhz ajia ajib ajic ajid ajie ajif ajig ajih -ajii ajij ajik ajil ajim ajin ajio ajip ajiq ajir ajis ajit ajiu ajiv ajiw -ajix ajiy ajiz ajja ajjb ajjc ajjd ajje ajjf ajjg ajjh ajji ajjj ajjk ajjl -ajjm ajjn ajjo ajjp ajjq ajjr ajjs ajjt ajju ajjv ajjw ajjx ajjy ajjz ajka -ajkb ajkc ajkd ajke ajkf ajkg ajkh ajki ajkj ajkk ajkl ajkm ajkn ajko ajkp -ajkq ajkr ajks ajkt ajku ajkv ajkw ajkx ajky ajkz ajla ajlb ajlc ajld ajle -ajlf ajlg ajlh ajli ajlj ajlk ajll ajlm ajln ajlo ajlp ajlq ajlr ajls ajlt -ajlu ajlv ajlw ajlx ajly ajlz ajma ajmb ajmc ajmd ajme ajmf ajmg ajmh ajmi -ajmj ajmk ajml ajmm ajmn ajmo ajmp ajmq ajmr ajms ajmt ajmu ajmv ajmw ajmx -ajmy ajmz ajna ajnb ajnc ajnd ajne ajnf ajng ajnh ajni ajnj ajnk ajnl ajnm -ajnn ajno ajnp ajnq ajnr ajns ajnt ajnu ajnv ajnw ajnx ajny ajnz ajoa ajob -ajoc ajod ajoe ajof ajog ajoh ajoi ajoj ajok ajol ajom ajon ajoo ajop ajoq -ajor ajos ajot ajou ajov ajow ajox ajoy ajoz ajpa ajpb ajpc ajpd ajpe ajpf -ajpg ajph ajpi ajpj ajpk ajpl ajpm ajpn ajpo ajpp ajpq ajpr ajps ajpt ajpu -ajpv ajpw ajpx ajpy ajpz ajqa ajqb ajqc ajqd ajqe ajqf ajqg ajqh ajqi ajqj -ajqk ajql ajqm ajqn ajqo ajqp ajqq ajqr ajqs ajqt ajqu ajqv ajqw ajqx ajqy -ajqz ajra ajrb ajrc ajrd ajre ajrf ajrg ajrh ajri ajrj ajrk ajrl ajrm ajrn -ajro ajrp ajrq ajrr ajrs ajrt ajru ajrv ajrw ajrx ajry ajrz ajsa ajsb ajsc -ajsd ajse ajsf ajsg ajsh ajsi ajsj ajsk ajsl ajsm ajsn ajso ajsp ajsq ajsr -ajss ajst ajsu ajsv ajsw ajsx ajsy ajsz ajta ajtb ajtc ajtd ajte ajtf ajtg -ajth ajti ajtj ajtk ajtl ajtm ajtn ajto ajtp ajtq ajtr ajts ajtt ajtu ajtv -ajtw ajtx ajty ajtz ajua ajub ajuc ajud ajue ajuf ajug ajuh ajui ajuj ajuk -ajul ajum ajun ajuo ajup ajuq ajur ajus ajut ajuu ajuv ajuw ajux ajuy ajuz -ajva ajvb ajvc ajvd ajve ajvf ajvg ajvh ajvi ajvj ajvk ajvl ajvm ajvn ajvo -ajvp ajvq ajvr ajvs ajvt ajvu ajvv ajvw ajvx ajvy ajvz ajwa ajwb ajwc ajwd -ajwe ajwf ajwg ajwh ajwi ajwj ajwk ajwl ajwm ajwn ajwo ajwp ajwq ajwr ajws -ajwt ajwu ajwv ajww ajwx ajwy ajwz ajxa ajxb ajxc ajxd ajxe ajxf ajxg ajxh -ajxi ajxj ajxk ajxl ajxm ajxn ajxo ajxp ajxq ajxr ajxs ajxt ajxu ajxv ajxw -ajxx ajxy ajxz ajya ajyb ajyc ajyd ajye ajyf ajyg ajyh ajyi ajyj ajyk ajyl -ajym ajyn ajyo ajyp ajyq ajyr ajys ajyt ajyu ajyv ajyw ajyx ajyy ajyz ajza -ajzb ajzc ajzd ajze ajzf ajzg ajzh ajzi ajzj ajzk ajzl ajzm ajzn ajzo ajzp -ajzq ajzr ajzs ajzt ajzu ajzv ajzw ajzx ajzy ajzz akaa akab akac akad akae -akaf akag akah akai akaj akak akal akam akan akao akap akaq akar akas akat -akau akav akaw akax akay akaz akba akbb akbc akbd akbe akbf akbg akbh akbi -akbj akbk akbl akbm akbn akbo akbp akbq akbr akbs akbt akbu akbv akbw akbx -akby akbz akca akcb akcc akcd akce akcf akcg akch akci akcj akck akcl akcm -akcn akco akcp akcq akcr akcs akct akcu akcv akcw akcx akcy akcz akda akdb -akdc akdd akde akdf akdg akdh akdi akdj akdk akdl akdm akdn akdo akdp akdq -akdr akds akdt akdu akdv akdw akdx akdy akdz akea akeb akec aked akee akef -akeg akeh akei akej akek akel akem aken akeo akep akeq aker akes aket akeu -akev akew akex akey akez akfa akfb akfc akfd akfe akff akfg akfh akfi akfj -akfk akfl akfm akfn akfo akfp akfq akfr akfs akft akfu akfv akfw akfx akfy -akfz akga akgb akgc akgd akge akgf akgg akgh akgi akgj akgk akgl akgm akgn -akgo akgp akgq akgr akgs akgt akgu akgv akgw akgx akgy akgz akha akhb akhc -akhd akhe akhf akhg akhh akhi akhj akhk akhl akhm akhn akho akhp akhq akhr -akhs akht akhu akhv akhw akhx akhy akhz akia akib akic akid akie akif akig -akih akii akij akik akil akim akin akio akip akiq akir akis akit akiu akiv -akiw akix akiy akiz akja akjb akjc akjd akje akjf akjg akjh akji akjj akjk -akjl akjm akjn akjo akjp akjq akjr akjs akjt akju akjv akjw akjx akjy akjz -akka akkb akkc akkd akke akkf akkg akkh akki akkj akkk akkl akkm akkn akko -akkp akkq akkr akks akkt akku akkv akkw akkx akky akkz akla aklb aklc akld -akle aklf aklg aklh akli aklj aklk akll aklm akln aklo aklp aklq aklr akls -aklt aklu aklv aklw aklx akly aklz akma akmb akmc akmd akme akmf akmg akmh -akmi akmj akmk akml akmm akmn akmo akmp akmq akmr akms akmt akmu akmv akmw -akmx akmy akmz akna aknb aknc aknd akne aknf akng aknh akni aknj aknk aknl -aknm aknn akno aknp aknq aknr akns aknt aknu aknv aknw aknx akny aknz akoa -akob akoc akod akoe akof akog akoh akoi akoj akok akol akom akon akoo akop -akoq akor akos akot akou akov akow akox akoy akoz akpa akpb akpc akpd akpe -akpf akpg akph akpi akpj akpk akpl akpm akpn akpo akpp akpq akpr akps akpt -akpu akpv akpw akpx akpy akpz akqa akqb akqc akqd akqe akqf akqg akqh akqi -akqj akqk akql akqm akqn akqo akqp akqq akqr akqs akqt akqu akqv akqw akqx -akqy akqz akra akrb akrc akrd akre akrf akrg akrh akri akrj akrk akrl akrm -akrn akro akrp akrq akrr akrs akrt akru akrv akrw akrx akry akrz aksa aksb -aksc aksd akse aksf aksg aksh aksi aksj aksk aksl aksm aksn akso aksp aksq -aksr akss akst aksu aksv aksw aksx aksy aksz akta aktb aktc aktd akte aktf -aktg akth akti aktj aktk aktl aktm aktn akto aktp aktq aktr akts aktt aktu -aktv aktw aktx akty aktz akua akub akuc akud akue akuf akug akuh akui akuj -akuk akul akum akun akuo akup akuq akur akus akut akuu akuv akuw akux akuy -akuz akva akvb akvc akvd akve akvf akvg akvh akvi akvj akvk akvl akvm akvn -akvo akvp akvq akvr akvs akvt akvu akvv akvw akvx akvy akvz akwa akwb akwc -akwd akwe akwf akwg akwh akwi akwj akwk akwl akwm akwn akwo akwp akwq akwr -akws akwt akwu akwv akww akwx akwy akwz akxa akxb akxc akxd akxe akxf akxg -akxh akxi akxj akxk akxl akxm akxn akxo akxp akxq akxr akxs akxt akxu akxv -akxw akxx akxy akxz akya akyb akyc akyd akye akyf akyg akyh akyi akyj akyk -akyl akym akyn akyo akyp akyq akyr akys akyt akyu akyv akyw akyx akyy akyz -akza akzb akzc akzd akze akzf akzg akzh akzi akzj akzk akzl akzm akzn akzo -akzp akzq akzr akzs akzt akzu akzv akzw akzx akzy akzz alaa alab alac alad -alae alaf alag alah alai alaj alak alal alam alan alao alap alaq alar alas -alat alau alav alaw alax alay alaz alba albb albc albd albe albf albg albh -albi albj albk albl albm albn albo albp albq albr albs albt albu albv albw diff -Nru ocaml-3.12.1/camlp4/test/fixtures/idents2 ocaml-4.01.0/camlp4/test/fixtures/idents2 --- ocaml-3.12.1/camlp4/test/fixtures/idents2 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/idents2 1970-01-01 00:00:00.000000000 +0000 @@ -1,1219 +0,0 @@ -aaaa aaab aaac aaad aaae aaaf aaag aaah aaai aaaj aaak aaal aaam aaan aaao -aaap aaaq aaar aaas aaat aaau aaav aaaw aaax aaay aaaz aaba aabb aabc aabd -aabe aabf aabg aabh aabi aabj aabk aabl aabm aabn aabo aabp aabq aabr aabs -aabt aabu aabv aabw aabx aaby aabz aaca aacb aacc aacd aace aacf aacg aach -aaci aacj aack aacl aacm aacn aaco aacp aacq aacr aacs aact aacu aacv aacw -aacx aacy aacz aada aadb aadc aadd aade aadf aadg aadh aadi aadj aadk aadl -aadm aadn aado aadp aadq aadr aads aadt aadu aadv aadw aadx aady aadz aaea -aaeb aaec aaed aaee aaef aaeg aaeh aaei aaej aaek aael aaem aaen aaeo aaep -aaeq aaer aaes aaet aaeu aaev aaew aaex aaey aaez aafa aafb aafc aafd aafe -aaff aafg aafh aafi aafj aafk aafl aafm aafn aafo aafp aafq aafr aafs aaft -aafu aafv aafw aafx aafy aafz aaga aagb aagc aagd aage aagf aagg aagh aagi -aagj aagk aagl aagm aagn aago aagp aagq aagr aags aagt aagu aagv aagw aagx -aagy aagz aaha aahb aahc aahd aahe aahf aahg aahh aahi aahj aahk aahl aahm -aahn aaho aahp aahq aahr aahs aaht aahu aahv aahw aahx aahy aahz aaia aaib -aaic aaid aaie aaif aaig aaih aaii aaij aaik aail aaim aain aaio aaip aaiq -aair aais aait aaiu aaiv aaiw aaix aaiy aaiz aaja aajb aajc aajd aaje aajf -aajg aajh aaji aajj aajk aajl aajm aajn aajo aajp aajq aajr aajs aajt aaju -aajv aajw aajx aajy aajz aaka aakb aakc aakd aake aakf aakg aakh aaki aakj -aakk aakl aakm aakn aako aakp aakq aakr aaks aakt aaku aakv aakw aakx aaky -aakz aala aalb aalc aald aale aalf aalg aalh aali aalj aalk aall aalm aaln -aalo aalp aalq aalr aals aalt aalu aalv aalw aalx aaly aalz aama aamb aamc -aamd aame aamf aamg aamh aami aamj aamk aaml aamm aamn aamo aamp aamq aamr -aams aamt aamu aamv aamw aamx aamy aamz aana aanb aanc aand aane aanf aang -aanh aani aanj aank aanl aanm aann aano aanp aanq aanr aans aant aanu aanv -aanw aanx aany aanz aaoa aaob aaoc aaod aaoe aaof aaog aaoh aaoi aaoj aaok -aaol aaom aaon aaoo aaop aaoq aaor aaos aaot aaou aaov aaow aaox aaoy aaoz -aapa aapb aapc aapd aape aapf aapg aaph aapi aapj aapk aapl aapm aapn aapo -aapp aapq aapr aaps aapt aapu aapv aapw aapx aapy aapz aaqa aaqb aaqc aaqd -aaqe aaqf aaqg aaqh aaqi aaqj aaqk aaql aaqm aaqn aaqo aaqp aaqq aaqr aaqs -aaqt aaqu aaqv aaqw aaqx aaqy aaqz aara aarb aarc aard aare aarf aarg aarh -aari aarj aark aarl aarm aarn aaro aarp aarq aarr aars aart aaru aarv aarw -aarx aary aarz aasa aasb aasc aasd aase aasf aasg aash aasi aasj aask aasl -aasm aasn aaso aasp aasq aasr aass aast aasu aasv aasw aasx aasy aasz aata -aatb aatc aatd aate aatf aatg aath aati aatj aatk aatl aatm aatn aato aatp -aatq aatr aats aatt aatu aatv aatw aatx aaty aatz aaua aaub aauc aaud aaue -aauf aaug aauh aaui aauj aauk aaul aaum aaun aauo aaup aauq aaur aaus aaut -aauu aauv aauw aaux aauy aauz aava aavb aavc aavd aave aavf aavg aavh aavi -aavj aavk aavl aavm aavn aavo aavp aavq aavr aavs aavt aavu aavv aavw aavx -aavy aavz aawa aawb aawc aawd aawe aawf aawg aawh aawi aawj aawk aawl aawm -aawn aawo aawp aawq aawr aaws aawt aawu aawv aaww aawx aawy aawz aaxa aaxb -aaxc aaxd aaxe aaxf aaxg aaxh aaxi aaxj aaxk aaxl aaxm aaxn aaxo aaxp aaxq -aaxr aaxs aaxt aaxu aaxv aaxw aaxx aaxy aaxz aaya aayb aayc aayd aaye aayf -aayg aayh aayi aayj aayk aayl aaym aayn aayo aayp aayq aayr aays aayt aayu -aayv aayw aayx aayy aayz aaza aazb aazc aazd aaze aazf aazg aazh aazi aazj -aazk aazl aazm aazn aazo aazp aazq aazr aazs aazt aazu aazv aazw aazx aazy -aazz abaa abab abac abad abae abaf abag abah abai abaj abak abal abam aban -abao abap abaq abar abas abat abau abav abaw abax abay abaz abba abbb abbc -abbd abbe abbf abbg abbh abbi abbj abbk abbl abbm abbn abbo abbp abbq abbr -abbs abbt abbu abbv abbw abbx abby abbz abca abcb abcc abcd abce abcf abcg -abch abci abcj abck abcl abcm abcn abco abcp abcq abcr abcs abct abcu abcv -abcw abcx abcy abcz abda abdb abdc abdd abde abdf abdg abdh abdi abdj abdk -abdl abdm abdn abdo abdp abdq abdr abds abdt abdu abdv abdw abdx abdy abdz -abea abeb abec abed abee abef abeg abeh abei abej abek abel abem aben abeo -abep abeq aber abes abet abeu abev abew abex abey abez abfa abfb abfc abfd -abfe abff abfg abfh abfi abfj abfk abfl abfm abfn abfo abfp abfq abfr abfs -abft abfu abfv abfw abfx abfy abfz abga abgb abgc abgd abge abgf abgg abgh -abgi abgj abgk abgl abgm abgn abgo abgp abgq abgr abgs abgt abgu abgv abgw -abgx abgy abgz abha abhb abhc abhd abhe abhf abhg abhh abhi abhj abhk abhl -abhm abhn abho abhp abhq abhr abhs abht abhu abhv abhw abhx abhy abhz abia -abib abic abid abie abif abig abih abii abij abik abil abim abin abio abip -abiq abir abis abit abiu abiv abiw abix abiy abiz abja abjb abjc abjd abje -abjf abjg abjh abji abjj abjk abjl abjm abjn abjo abjp abjq abjr abjs abjt -abju abjv abjw abjx abjy abjz abka abkb abkc abkd abke abkf abkg abkh abki -abkj abkk abkl abkm abkn abko abkp abkq abkr abks abkt abku abkv abkw abkx -abky abkz abla ablb ablc abld able ablf ablg ablh abli ablj ablk abll ablm -abln ablo ablp ablq ablr abls ablt ablu ablv ablw ablx ably ablz abma abmb -abmc abmd abme abmf abmg abmh abmi abmj abmk abml abmm abmn abmo abmp abmq -abmr abms abmt abmu abmv abmw abmx abmy abmz abna abnb abnc abnd abne abnf -abng abnh abni abnj abnk abnl abnm abnn abno abnp abnq abnr abns abnt abnu -abnv abnw abnx abny abnz aboa abob aboc abod aboe abof abog aboh aboi aboj -abok abol abom abon aboo abop aboq abor abos abot abou abov abow abox aboy -aboz abpa abpb abpc abpd abpe abpf abpg abph abpi abpj abpk abpl abpm abpn -abpo abpp abpq abpr abps abpt abpu abpv abpw abpx abpy abpz abqa abqb abqc -abqd abqe abqf abqg abqh abqi abqj abqk abql abqm abqn abqo abqp abqq abqr -abqs abqt abqu abqv abqw abqx abqy abqz abra abrb abrc abrd abre abrf abrg -abrh abri abrj abrk abrl abrm abrn abro abrp abrq abrr abrs abrt abru abrv -abrw abrx abry abrz absa absb absc absd abse absf absg absh absi absj absk -absl absm absn abso absp absq absr abss abst absu absv absw absx absy absz -abta abtb abtc abtd abte abtf abtg abth abti abtj abtk abtl abtm abtn abto -abtp abtq abtr abts abtt abtu abtv abtw abtx abty abtz abua abub abuc abud -abue abuf abug abuh abui abuj abuk abul abum abun abuo abup abuq abur abus -abut abuu abuv abuw abux abuy abuz abva abvb abvc abvd abve abvf abvg abvh -abvi abvj abvk abvl abvm abvn abvo abvp abvq abvr abvs abvt abvu abvv abvw -abvx abvy abvz abwa abwb abwc abwd abwe abwf abwg abwh abwi abwj abwk abwl -abwm abwn abwo abwp abwq abwr abws abwt abwu abwv abww abwx abwy abwz abxa -abxb abxc abxd abxe abxf abxg abxh abxi abxj abxk abxl abxm abxn abxo abxp -abxq abxr abxs abxt abxu abxv abxw abxx abxy abxz abya abyb abyc abyd abye -abyf abyg abyh abyi abyj abyk abyl abym abyn abyo abyp abyq abyr abys abyt -abyu abyv abyw abyx abyy abyz abza abzb abzc abzd abze abzf abzg abzh abzi -abzj abzk abzl abzm abzn abzo abzp abzq abzr abzs abzt abzu abzv abzw abzx -abzy abzz acaa acab acac acad acae acaf acag acah acai acaj acak acal acam -acan acao acap acaq acar acas acat acau acav acaw acax acay acaz acba acbb -acbc acbd acbe acbf acbg acbh acbi acbj acbk acbl acbm acbn acbo acbp acbq -acbr acbs acbt acbu acbv acbw acbx acby acbz acca accb accc accd acce accf -accg acch acci accj acck accl accm accn acco accp accq accr accs acct accu -accv accw accx accy accz acda acdb acdc acdd acde acdf acdg acdh acdi acdj -acdk acdl acdm acdn acdo acdp acdq acdr acds acdt acdu acdv acdw acdx acdy -acdz acea aceb acec aced acee acef aceg aceh acei acej acek acel acem acen -aceo acep aceq acer aces acet aceu acev acew acex acey acez acfa acfb acfc -acfd acfe acff acfg acfh acfi acfj acfk acfl acfm acfn acfo acfp acfq acfr -acfs acft acfu acfv acfw acfx acfy acfz acga acgb acgc acgd acge acgf acgg -acgh acgi acgj acgk acgl acgm acgn acgo acgp acgq acgr acgs acgt acgu acgv -acgw acgx acgy acgz acha achb achc achd ache achf achg achh achi achj achk -achl achm achn acho achp achq achr achs acht achu achv achw achx achy achz -acia acib acic acid acie acif acig acih acii acij acik acil acim acin acio -acip aciq acir acis acit aciu aciv aciw acix aciy aciz acja acjb acjc acjd -acje acjf acjg acjh acji acjj acjk acjl acjm acjn acjo acjp acjq acjr acjs -acjt acju acjv acjw acjx acjy acjz acka ackb ackc ackd acke ackf ackg ackh -acki ackj ackk ackl ackm ackn acko ackp ackq ackr acks ackt acku ackv ackw -ackx acky ackz acla aclb aclc acld acle aclf aclg aclh acli aclj aclk acll -aclm acln aclo aclp aclq aclr acls aclt aclu aclv aclw aclx acly aclz acma -acmb acmc acmd acme acmf acmg acmh acmi acmj acmk acml acmm acmn acmo acmp -acmq acmr acms acmt acmu acmv acmw acmx acmy acmz acna acnb acnc acnd acne -acnf acng acnh acni acnj acnk acnl acnm acnn acno acnp acnq acnr acns acnt -acnu acnv acnw acnx acny acnz acoa acob acoc acod acoe acof acog acoh acoi -acoj acok acol acom acon acoo acop acoq acor acos acot acou acov acow acox -acoy acoz acpa acpb acpc acpd acpe acpf acpg acph acpi acpj acpk acpl acpm -acpn acpo acpp acpq acpr acps acpt acpu acpv acpw acpx acpy acpz acqa acqb -acqc acqd acqe acqf acqg acqh acqi acqj acqk acql acqm acqn acqo acqp acqq -acqr acqs acqt acqu acqv acqw acqx acqy acqz acra acrb acrc acrd acre acrf -acrg acrh acri acrj acrk acrl acrm acrn acro acrp acrq acrr acrs acrt acru -acrv acrw acrx acry acrz acsa acsb acsc acsd acse acsf acsg acsh acsi acsj -acsk acsl acsm acsn acso acsp acsq acsr acss acst acsu acsv acsw acsx acsy -acsz acta actb actc actd acte actf actg acth acti actj actk actl actm actn -acto actp actq actr acts actt actu actv actw actx acty actz acua acub acuc -acud acue acuf acug acuh acui acuj acuk acul acum acun acuo acup acuq acur -acus acut acuu acuv acuw acux acuy acuz acva acvb acvc acvd acve acvf acvg -acvh acvi acvj acvk acvl acvm acvn acvo acvp acvq acvr acvs acvt acvu acvv -acvw acvx acvy acvz acwa acwb acwc acwd acwe acwf acwg acwh acwi acwj acwk -acwl acwm acwn acwo acwp acwq acwr acws acwt acwu acwv acww acwx acwy acwz -acxa acxb acxc acxd acxe acxf acxg acxh acxi acxj acxk acxl acxm acxn acxo -acxp acxq acxr acxs acxt acxu acxv acxw acxx acxy acxz acya acyb acyc acyd -acye acyf acyg acyh acyi acyj acyk acyl acym acyn acyo acyp acyq acyr acys -acyt acyu acyv acyw acyx acyy acyz acza aczb aczc aczd acze aczf aczg aczh -aczi aczj aczk aczl aczm aczn aczo aczp aczq aczr aczs aczt aczu aczv aczw -aczx aczy aczz adaa adab adac adad adae adaf adag adah adai adaj adak adal -adam adan adao adap adaq adar adas adat adau adav adaw adax aday adaz adba -adbb adbc adbd adbe adbf adbg adbh adbi adbj adbk adbl adbm adbn adbo adbp -adbq adbr adbs adbt adbu adbv adbw adbx adby adbz adca adcb adcc adcd adce -adcf adcg adch adci adcj adck adcl adcm adcn adco adcp adcq adcr adcs adct -adcu adcv adcw adcx adcy adcz adda addb addc addd adde addf addg addh addi -addj addk addl addm addn addo addp addq addr adds addt addu addv addw addx -addy addz adea adeb adec aded adee adef adeg adeh adei adej adek adel adem -aden adeo adep adeq ader ades adet adeu adev adew adex adey adez adfa adfb -adfc adfd adfe adff adfg adfh adfi adfj adfk adfl adfm adfn adfo adfp adfq -adfr adfs adft adfu adfv adfw adfx adfy adfz adga adgb adgc adgd adge adgf -adgg adgh adgi adgj adgk adgl adgm adgn adgo adgp adgq adgr adgs adgt adgu -adgv adgw adgx adgy adgz adha adhb adhc adhd adhe adhf adhg adhh adhi adhj -adhk adhl adhm adhn adho adhp adhq adhr adhs adht adhu adhv adhw adhx adhy -adhz adia adib adic adid adie adif adig adih adii adij adik adil adim adin -adio adip adiq adir adis adit adiu adiv adiw adix adiy adiz adja adjb adjc -adjd adje adjf adjg adjh adji adjj adjk adjl adjm adjn adjo adjp adjq adjr -adjs adjt adju adjv adjw adjx adjy adjz adka adkb adkc adkd adke adkf adkg -adkh adki adkj adkk adkl adkm adkn adko adkp adkq adkr adks adkt adku adkv -adkw adkx adky adkz adla adlb adlc adld adle adlf adlg adlh adli adlj adlk -adll adlm adln adlo adlp adlq adlr adls adlt adlu adlv adlw adlx adly adlz -adma admb admc admd adme admf admg admh admi admj admk adml admm admn admo -admp admq admr adms admt admu admv admw admx admy admz adna adnb adnc adnd -adne adnf adng adnh adni adnj adnk adnl adnm adnn adno adnp adnq adnr adns -adnt adnu adnv adnw adnx adny adnz adoa adob adoc adod adoe adof adog adoh -adoi adoj adok adol adom adon adoo adop adoq ador ados adot adou adov adow -adox adoy adoz adpa adpb adpc adpd adpe adpf adpg adph adpi adpj adpk adpl -adpm adpn adpo adpp adpq adpr adps adpt adpu adpv adpw adpx adpy adpz adqa -adqb adqc adqd adqe adqf adqg adqh adqi adqj adqk adql adqm adqn adqo adqp -adqq adqr adqs adqt adqu adqv adqw adqx adqy adqz adra adrb adrc adrd adre -adrf adrg adrh adri adrj adrk adrl adrm adrn adro adrp adrq adrr adrs adrt -adru adrv adrw adrx adry adrz adsa adsb adsc adsd adse adsf adsg adsh adsi -adsj adsk adsl adsm adsn adso adsp adsq adsr adss adst adsu adsv adsw adsx -adsy adsz adta adtb adtc adtd adte adtf adtg adth adti adtj adtk adtl adtm -adtn adto adtp adtq adtr adts adtt adtu adtv adtw adtx adty adtz adua adub -aduc adud adue aduf adug aduh adui aduj aduk adul adum adun aduo adup aduq -adur adus adut aduu aduv aduw adux aduy aduz adva advb advc advd adve advf -advg advh advi advj advk advl advm advn advo advp advq advr advs advt advu -advv advw advx advy advz adwa adwb adwc adwd adwe adwf adwg adwh adwi adwj -adwk adwl adwm adwn adwo adwp adwq adwr adws adwt adwu adwv adww adwx adwy -adwz adxa adxb adxc adxd adxe adxf adxg adxh adxi adxj adxk adxl adxm adxn -adxo adxp adxq adxr adxs adxt adxu adxv adxw adxx adxy adxz adya adyb adyc -adyd adye adyf adyg adyh adyi adyj adyk adyl adym adyn adyo adyp adyq adyr -adys adyt adyu adyv adyw adyx adyy adyz adza adzb adzc adzd adze adzf adzg -adzh adzi adzj adzk adzl adzm adzn adzo adzp adzq adzr adzs adzt adzu adzv -adzw adzx adzy adzz aeaa aeab aeac aead aeae aeaf aeag aeah aeai aeaj aeak -aeal aeam aean aeao aeap aeaq aear aeas aeat aeau aeav aeaw aeax aeay aeaz -aeba aebb aebc aebd aebe aebf aebg aebh aebi aebj aebk aebl aebm aebn aebo -aebp aebq aebr aebs aebt aebu aebv aebw aebx aeby aebz aeca aecb aecc aecd -aece aecf aecg aech aeci aecj aeck aecl aecm aecn aeco aecp aecq aecr aecs -aect aecu aecv aecw aecx aecy aecz aeda aedb aedc aedd aede aedf aedg aedh -aedi aedj aedk aedl aedm aedn aedo aedp aedq aedr aeds aedt aedu aedv aedw -aedx aedy aedz aeea aeeb aeec aeed aeee aeef aeeg aeeh aeei aeej aeek aeel -aeem aeen aeeo aeep aeeq aeer aees aeet aeeu aeev aeew aeex aeey aeez aefa -aefb aefc aefd aefe aeff aefg aefh aefi aefj aefk aefl aefm aefn aefo aefp -aefq aefr aefs aeft aefu aefv aefw aefx aefy aefz aega aegb aegc aegd aege -aegf aegg aegh aegi aegj aegk aegl aegm aegn aego aegp aegq aegr aegs aegt -aegu aegv aegw aegx aegy aegz aeha aehb aehc aehd aehe aehf aehg aehh aehi -aehj aehk aehl aehm aehn aeho aehp aehq aehr aehs aeht aehu aehv aehw aehx -aehy aehz aeia aeib aeic aeid aeie aeif aeig aeih aeii aeij aeik aeil aeim -aein aeio aeip aeiq aeir aeis aeit aeiu aeiv aeiw aeix aeiy aeiz aeja aejb -aejc aejd aeje aejf aejg aejh aeji aejj aejk aejl aejm aejn aejo aejp aejq -aejr aejs aejt aeju aejv aejw aejx aejy aejz aeka aekb aekc aekd aeke aekf -aekg aekh aeki aekj aekk aekl aekm aekn aeko aekp aekq aekr aeks aekt aeku -aekv aekw aekx aeky aekz aela aelb aelc aeld aele aelf aelg aelh aeli aelj -aelk aell aelm aeln aelo aelp aelq aelr aels aelt aelu aelv aelw aelx aely -aelz aema aemb aemc aemd aeme aemf aemg aemh aemi aemj aemk aeml aemm aemn -aemo aemp aemq aemr aems aemt aemu aemv aemw aemx aemy aemz aena aenb aenc -aend aene aenf aeng aenh aeni aenj aenk aenl aenm aenn aeno aenp aenq aenr -aens aent aenu aenv aenw aenx aeny aenz aeoa aeob aeoc aeod aeoe aeof aeog -aeoh aeoi aeoj aeok aeol aeom aeon aeoo aeop aeoq aeor aeos aeot aeou aeov -aeow aeox aeoy aeoz aepa aepb aepc aepd aepe aepf aepg aeph aepi aepj aepk -aepl aepm aepn aepo aepp aepq aepr aeps aept aepu aepv aepw aepx aepy aepz -aeqa aeqb aeqc aeqd aeqe aeqf aeqg aeqh aeqi aeqj aeqk aeql aeqm aeqn aeqo -aeqp aeqq aeqr aeqs aeqt aequ aeqv aeqw aeqx aeqy aeqz aera aerb aerc aerd -aere aerf aerg aerh aeri aerj aerk aerl aerm aern aero aerp aerq aerr aers -aert aeru aerv aerw aerx aery aerz aesa aesb aesc aesd aese aesf aesg aesh -aesi aesj aesk aesl aesm aesn aeso aesp aesq aesr aess aest aesu aesv aesw -aesx aesy aesz aeta aetb aetc aetd aete aetf aetg aeth aeti aetj aetk aetl -aetm aetn aeto aetp aetq aetr aets aett aetu aetv aetw aetx aety aetz aeua -aeub aeuc aeud aeue aeuf aeug aeuh aeui aeuj aeuk aeul aeum aeun aeuo aeup -aeuq aeur aeus aeut aeuu aeuv aeuw aeux aeuy aeuz aeva aevb aevc aevd aeve -aevf aevg aevh aevi aevj aevk aevl aevm aevn aevo aevp aevq aevr aevs aevt -aevu aevv aevw aevx aevy aevz aewa aewb aewc aewd aewe aewf aewg aewh aewi -aewj aewk aewl aewm aewn aewo aewp aewq aewr aews aewt aewu aewv aeww aewx -aewy aewz aexa aexb aexc aexd aexe aexf aexg aexh aexi aexj aexk aexl aexm -aexn aexo aexp aexq aexr aexs aext aexu aexv aexw aexx aexy aexz aeya aeyb -aeyc aeyd aeye aeyf aeyg aeyh aeyi aeyj aeyk aeyl aeym aeyn aeyo aeyp aeyq -aeyr aeys aeyt aeyu aeyv aeyw aeyx aeyy aeyz aeza aezb aezc aezd aeze aezf -aezg aezh aezi aezj aezk aezl aezm aezn aezo aezp aezq aezr aezs aezt aezu -aezv aezw aezx aezy aezz afaa afab afac afad afae afaf afag afah afai afaj -afak afal afam afan afao afap afaq afar afas afat afau afav afaw afax afay -afaz afba afbb afbc afbd afbe afbf afbg afbh afbi afbj afbk afbl afbm afbn -afbo afbp afbq afbr afbs afbt afbu afbv afbw afbx afby afbz afca afcb afcc -afcd afce afcf afcg afch afci afcj afck afcl afcm afcn afco afcp afcq afcr -afcs afct afcu afcv afcw afcx afcy afcz afda afdb afdc afdd afde afdf afdg -afdh afdi afdj afdk afdl afdm afdn afdo afdp afdq afdr afds afdt afdu afdv -afdw afdx afdy afdz afea afeb afec afed afee afef afeg afeh afei afej afek -afel afem afen afeo afep afeq afer afes afet afeu afev afew afex afey afez -affa affb affc affd affe afff affg affh affi affj affk affl affm affn affo -affp affq affr affs afft affu affv affw affx affy affz afga afgb afgc afgd -afge afgf afgg afgh afgi afgj afgk afgl afgm afgn afgo afgp afgq afgr afgs -afgt afgu afgv afgw afgx afgy afgz afha afhb afhc afhd afhe afhf afhg afhh -afhi afhj afhk afhl afhm afhn afho afhp afhq afhr afhs afht afhu afhv afhw -afhx afhy afhz afia afib afic afid afie afif afig afih afii afij afik afil -afim afin afio afip afiq afir afis afit afiu afiv afiw afix afiy afiz afja -afjb afjc afjd afje afjf afjg afjh afji afjj afjk afjl afjm afjn afjo afjp -afjq afjr afjs afjt afju afjv afjw afjx afjy afjz afka afkb afkc afkd afke -afkf afkg afkh afki afkj afkk afkl afkm afkn afko afkp afkq afkr afks afkt -afku afkv afkw afkx afky afkz afla aflb aflc afld afle aflf aflg aflh afli -aflj aflk afll aflm afln aflo aflp aflq aflr afls aflt aflu aflv aflw aflx -afly aflz afma afmb afmc afmd afme afmf afmg afmh afmi afmj afmk afml afmm -afmn afmo afmp afmq afmr afms afmt afmu afmv afmw afmx afmy afmz afna afnb -afnc afnd afne afnf afng afnh afni afnj afnk afnl afnm afnn afno afnp afnq -afnr afns afnt afnu afnv afnw afnx afny afnz afoa afob afoc afod afoe afof -afog afoh afoi afoj afok afol afom afon afoo afop afoq afor afos afot afou -afov afow afox afoy afoz afpa afpb afpc afpd afpe afpf afpg afph afpi afpj -afpk afpl afpm afpn afpo afpp afpq afpr afps afpt afpu afpv afpw afpx afpy -afpz afqa afqb afqc afqd afqe afqf afqg afqh afqi afqj afqk afql afqm afqn -afqo afqp afqq afqr afqs afqt afqu afqv afqw afqx afqy afqz afra afrb afrc -afrd afre afrf afrg afrh afri afrj afrk afrl afrm afrn afro afrp afrq afrr -afrs afrt afru afrv afrw afrx afry afrz afsa afsb afsc afsd afse afsf afsg -afsh afsi afsj afsk afsl afsm afsn afso afsp afsq afsr afss afst afsu afsv -afsw afsx afsy afsz afta aftb aftc aftd afte aftf aftg afth afti aftj aftk -aftl aftm aftn afto aftp aftq aftr afts aftt aftu aftv aftw aftx afty aftz -afua afub afuc afud afue afuf afug afuh afui afuj afuk aful afum afun afuo -afup afuq afur afus afut afuu afuv afuw afux afuy afuz afva afvb afvc afvd -afve afvf afvg afvh afvi afvj afvk afvl afvm afvn afvo afvp afvq afvr afvs -afvt afvu afvv afvw afvx afvy afvz afwa afwb afwc afwd afwe afwf afwg afwh -afwi afwj afwk afwl afwm afwn afwo afwp afwq afwr afws afwt afwu afwv afww -afwx afwy afwz afxa afxb afxc afxd afxe afxf afxg afxh afxi afxj afxk afxl -afxm afxn afxo afxp afxq afxr afxs afxt afxu afxv afxw afxx afxy afxz afya -afyb afyc afyd afye afyf afyg afyh afyi afyj afyk afyl afym afyn afyo afyp -afyq afyr afys afyt afyu afyv afyw afyx afyy afyz afza afzb afzc afzd afze -afzf afzg afzh afzi afzj afzk afzl afzm afzn afzo afzp afzq afzr afzs afzt -afzu afzv afzw afzx afzy afzz agaa agab agac agad agae agaf agag agah agai -agaj agak agal agam agan agao agap agaq agar agas agat agau agav agaw agax -agay agaz agba agbb agbc agbd agbe agbf agbg agbh agbi agbj agbk agbl agbm -agbn agbo agbp agbq agbr agbs agbt agbu agbv agbw agbx agby agbz agca agcb -agcc agcd agce agcf agcg agch agci agcj agck agcl agcm agcn agco agcp agcq -agcr agcs agct agcu agcv agcw agcx agcy agcz agda agdb agdc agdd agde agdf -agdg agdh agdi agdj agdk agdl agdm agdn agdo agdp agdq agdr agds agdt agdu -agdv agdw agdx agdy agdz agea ageb agec aged agee agef ageg ageh agei agej -agek agel agem agen ageo agep ageq ager ages aget ageu agev agew agex agey -agez agfa agfb agfc agfd agfe agff agfg agfh agfi agfj agfk agfl agfm agfn -agfo agfp agfq agfr agfs agft agfu agfv agfw agfx agfy agfz agga aggb aggc -aggd agge aggf aggg aggh aggi aggj aggk aggl aggm aggn aggo aggp aggq aggr -aggs aggt aggu aggv aggw aggx aggy aggz agha aghb aghc aghd aghe aghf aghg -aghh aghi aghj aghk aghl aghm aghn agho aghp aghq aghr aghs aght aghu aghv -aghw aghx aghy aghz agia agib agic agid agie agif agig agih agii agij agik -agil agim agin agio agip agiq agir agis agit agiu agiv agiw agix agiy agiz -agja agjb agjc agjd agje agjf agjg agjh agji agjj agjk agjl agjm agjn agjo -agjp agjq agjr agjs agjt agju agjv agjw agjx agjy agjz agka agkb agkc agkd -agke agkf agkg agkh agki agkj agkk agkl agkm agkn agko agkp agkq agkr agks -agkt agku agkv agkw agkx agky agkz agla aglb aglc agld agle aglf aglg aglh -agli aglj aglk agll aglm agln aglo aglp aglq aglr agls aglt aglu aglv aglw -aglx agly aglz agma agmb agmc agmd agme agmf agmg agmh agmi agmj agmk agml -agmm agmn agmo agmp agmq agmr agms agmt agmu agmv agmw agmx agmy agmz agna -agnb agnc agnd agne agnf agng agnh agni agnj agnk agnl agnm agnn agno agnp -agnq agnr agns agnt agnu agnv agnw agnx agny agnz agoa agob agoc agod agoe -agof agog agoh agoi agoj agok agol agom agon agoo agop agoq agor agos agot -agou agov agow agox agoy agoz agpa agpb agpc agpd agpe agpf agpg agph agpi -agpj agpk agpl agpm agpn agpo agpp agpq agpr agps agpt agpu agpv agpw agpx -agpy agpz agqa agqb agqc agqd agqe agqf agqg agqh agqi agqj agqk agql agqm -agqn agqo agqp agqq agqr agqs agqt agqu agqv agqw agqx agqy agqz agra agrb -agrc agrd agre agrf agrg agrh agri agrj agrk agrl agrm agrn agro agrp agrq -agrr agrs agrt agru agrv agrw agrx agry agrz agsa agsb agsc agsd agse agsf -agsg agsh agsi agsj agsk agsl agsm agsn agso agsp agsq agsr agss agst agsu -agsv agsw agsx agsy agsz agta agtb agtc agtd agte agtf agtg agth agti agtj -agtk agtl agtm agtn agto agtp agtq agtr agts agtt agtu agtv agtw agtx agty -agtz agua agub aguc agud ague aguf agug aguh agui aguj aguk agul agum agun -aguo agup aguq agur agus agut aguu aguv aguw agux aguy aguz agva agvb agvc -agvd agve agvf agvg agvh agvi agvj agvk agvl agvm agvn agvo agvp agvq agvr -agvs agvt agvu agvv agvw agvx agvy agvz agwa agwb agwc agwd agwe agwf agwg -agwh agwi agwj agwk agwl agwm agwn agwo agwp agwq agwr agws agwt agwu agwv -agww agwx agwy agwz agxa agxb agxc agxd agxe agxf agxg agxh agxi agxj agxk -agxl agxm agxn agxo agxp agxq agxr agxs agxt agxu agxv agxw agxx agxy agxz -agya agyb agyc agyd agye agyf agyg agyh agyi agyj agyk agyl agym agyn agyo -agyp agyq agyr agys agyt agyu agyv agyw agyx agyy agyz agza agzb agzc agzd -agze agzf agzg agzh agzi agzj agzk agzl agzm agzn agzo agzp agzq agzr agzs -agzt agzu agzv agzw agzx agzy agzz ahaa ahab ahac ahad ahae ahaf ahag ahah -ahai ahaj ahak ahal aham ahan ahao ahap ahaq ahar ahas ahat ahau ahav ahaw -ahax ahay ahaz ahba ahbb ahbc ahbd ahbe ahbf ahbg ahbh ahbi ahbj ahbk ahbl -ahbm ahbn ahbo ahbp ahbq ahbr ahbs ahbt ahbu ahbv ahbw ahbx ahby ahbz ahca -ahcb ahcc ahcd ahce ahcf ahcg ahch ahci ahcj ahck ahcl ahcm ahcn ahco ahcp -ahcq ahcr ahcs ahct ahcu ahcv ahcw ahcx ahcy ahcz ahda ahdb ahdc ahdd ahde -ahdf ahdg ahdh ahdi ahdj ahdk ahdl ahdm ahdn ahdo ahdp ahdq ahdr ahds ahdt -ahdu ahdv ahdw ahdx ahdy ahdz ahea aheb ahec ahed ahee ahef aheg aheh ahei -ahej ahek ahel ahem ahen aheo ahep aheq aher ahes ahet aheu ahev ahew ahex -ahey ahez ahfa ahfb ahfc ahfd ahfe ahff ahfg ahfh ahfi ahfj ahfk ahfl ahfm -ahfn ahfo ahfp ahfq ahfr ahfs ahft ahfu ahfv ahfw ahfx ahfy ahfz ahga ahgb -ahgc ahgd ahge ahgf ahgg ahgh ahgi ahgj ahgk ahgl ahgm ahgn ahgo ahgp ahgq -ahgr ahgs ahgt ahgu ahgv ahgw ahgx ahgy ahgz ahha ahhb ahhc ahhd ahhe ahhf -ahhg ahhh ahhi ahhj ahhk ahhl ahhm ahhn ahho ahhp ahhq ahhr ahhs ahht ahhu -ahhv ahhw ahhx ahhy ahhz ahia ahib ahic ahid ahie ahif ahig ahih ahii ahij -ahik ahil ahim ahin ahio ahip ahiq ahir ahis ahit ahiu ahiv ahiw ahix ahiy -ahiz ahja ahjb ahjc ahjd ahje ahjf ahjg ahjh ahji ahjj ahjk ahjl ahjm ahjn -ahjo ahjp ahjq ahjr ahjs ahjt ahju ahjv ahjw ahjx ahjy ahjz ahka ahkb ahkc -ahkd ahke ahkf ahkg ahkh ahki ahkj ahkk ahkl ahkm ahkn ahko ahkp ahkq ahkr -ahks ahkt ahku ahkv ahkw ahkx ahky ahkz ahla ahlb ahlc ahld ahle ahlf ahlg -ahlh ahli ahlj ahlk ahll ahlm ahln ahlo ahlp ahlq ahlr ahls ahlt ahlu ahlv -ahlw ahlx ahly ahlz ahma ahmb ahmc ahmd ahme ahmf ahmg ahmh ahmi ahmj ahmk -ahml ahmm ahmn ahmo ahmp ahmq ahmr ahms ahmt ahmu ahmv ahmw ahmx ahmy ahmz -ahna ahnb ahnc ahnd ahne ahnf ahng ahnh ahni ahnj ahnk ahnl ahnm ahnn ahno -ahnp ahnq ahnr ahns ahnt ahnu ahnv ahnw ahnx ahny ahnz ahoa ahob ahoc ahod -ahoe ahof ahog ahoh ahoi ahoj ahok ahol ahom ahon ahoo ahop ahoq ahor ahos -ahot ahou ahov ahow ahox ahoy ahoz ahpa ahpb ahpc ahpd ahpe ahpf ahpg ahph -ahpi ahpj ahpk ahpl ahpm ahpn ahpo ahpp ahpq ahpr ahps ahpt ahpu ahpv ahpw -ahpx ahpy ahpz ahqa ahqb ahqc ahqd ahqe ahqf ahqg ahqh ahqi ahqj ahqk ahql -ahqm ahqn ahqo ahqp ahqq ahqr ahqs ahqt ahqu ahqv ahqw ahqx ahqy ahqz ahra -ahrb ahrc ahrd ahre ahrf ahrg ahrh ahri ahrj ahrk ahrl ahrm ahrn ahro ahrp -ahrq ahrr ahrs ahrt ahru ahrv ahrw ahrx ahry ahrz ahsa ahsb ahsc ahsd ahse -ahsf ahsg ahsh ahsi ahsj ahsk ahsl ahsm ahsn ahso ahsp ahsq ahsr ahss ahst -ahsu ahsv ahsw ahsx ahsy ahsz ahta ahtb ahtc ahtd ahte ahtf ahtg ahth ahti -ahtj ahtk ahtl ahtm ahtn ahto ahtp ahtq ahtr ahts ahtt ahtu ahtv ahtw ahtx -ahty ahtz ahua ahub ahuc ahud ahue ahuf ahug ahuh ahui ahuj ahuk ahul ahum -ahun ahuo ahup ahuq ahur ahus ahut ahuu ahuv ahuw ahux ahuy ahuz ahva ahvb -ahvc ahvd ahve ahvf ahvg ahvh ahvi ahvj ahvk ahvl ahvm ahvn ahvo ahvp ahvq -ahvr ahvs ahvt ahvu ahvv ahvw ahvx ahvy ahvz ahwa ahwb ahwc ahwd ahwe ahwf -ahwg ahwh ahwi ahwj ahwk ahwl ahwm ahwn ahwo ahwp ahwq ahwr ahws ahwt ahwu -ahwv ahww ahwx ahwy ahwz ahxa ahxb ahxc ahxd ahxe ahxf ahxg ahxh ahxi ahxj -ahxk ahxl ahxm ahxn ahxo ahxp ahxq ahxr ahxs ahxt ahxu ahxv ahxw ahxx ahxy -ahxz ahya ahyb ahyc ahyd ahye ahyf ahyg ahyh ahyi ahyj ahyk ahyl ahym ahyn -ahyo ahyp ahyq ahyr ahys ahyt ahyu ahyv ahyw ahyx ahyy ahyz ahza ahzb ahzc -ahzd ahze ahzf ahzg ahzh ahzi ahzj ahzk ahzl ahzm ahzn ahzo ahzp ahzq ahzr -ahzs ahzt ahzu ahzv ahzw ahzx ahzy ahzz aiaa aiab aiac aiad aiae aiaf aiag -aiah aiai aiaj aiak aial aiam aian aiao aiap aiaq aiar aias aiat aiau aiav -aiaw aiax aiay aiaz aiba aibb aibc aibd aibe aibf aibg aibh aibi aibj aibk -aibl aibm aibn aibo aibp aibq aibr aibs aibt aibu aibv aibw aibx aiby aibz -aica aicb aicc aicd aice aicf aicg aich aici aicj aick aicl aicm aicn aico -aicp aicq aicr aics aict aicu aicv aicw aicx aicy aicz aida aidb aidc aidd -aide aidf aidg aidh aidi aidj aidk aidl aidm aidn aido aidp aidq aidr aids -aidt aidu aidv aidw aidx aidy aidz aiea aieb aiec aied aiee aief aieg aieh -aiei aiej aiek aiel aiem aien aieo aiep aieq aier aies aiet aieu aiev aiew -aiex aiey aiez aifa aifb aifc aifd aife aiff aifg aifh aifi aifj aifk aifl -aifm aifn aifo aifp aifq aifr aifs aift aifu aifv aifw aifx aify aifz aiga -aigb aigc aigd aige aigf aigg aigh aigi aigj aigk aigl aigm aign aigo aigp -aigq aigr aigs aigt aigu aigv aigw aigx aigy aigz aiha aihb aihc aihd aihe -aihf aihg aihh aihi aihj aihk aihl aihm aihn aiho aihp aihq aihr aihs aiht -aihu aihv aihw aihx aihy aihz aiia aiib aiic aiid aiie aiif aiig aiih aiii -aiij aiik aiil aiim aiin aiio aiip aiiq aiir aiis aiit aiiu aiiv aiiw aiix -aiiy aiiz aija aijb aijc aijd aije aijf aijg aijh aiji aijj aijk aijl aijm -aijn aijo aijp aijq aijr aijs aijt aiju aijv aijw aijx aijy aijz aika aikb -aikc aikd aike aikf aikg aikh aiki aikj aikk aikl aikm aikn aiko aikp aikq -aikr aiks aikt aiku aikv aikw aikx aiky aikz aila ailb ailc aild aile ailf -ailg ailh aili ailj ailk aill ailm ailn ailo ailp ailq ailr ails ailt ailu -ailv ailw ailx aily ailz aima aimb aimc aimd aime aimf aimg aimh aimi aimj -aimk aiml aimm aimn aimo aimp aimq aimr aims aimt aimu aimv aimw aimx aimy -aimz aina ainb ainc aind aine ainf aing ainh aini ainj aink ainl ainm ainn -aino ainp ainq ainr ains aint ainu ainv ainw ainx ainy ainz aioa aiob aioc -aiod aioe aiof aiog aioh aioi aioj aiok aiol aiom aion aioo aiop aioq aior -aios aiot aiou aiov aiow aiox aioy aioz aipa aipb aipc aipd aipe aipf aipg -aiph aipi aipj aipk aipl aipm aipn aipo aipp aipq aipr aips aipt aipu aipv -aipw aipx aipy aipz aiqa aiqb aiqc aiqd aiqe aiqf aiqg aiqh aiqi aiqj aiqk -aiql aiqm aiqn aiqo aiqp aiqq aiqr aiqs aiqt aiqu aiqv aiqw aiqx aiqy aiqz -aira airb airc aird aire airf airg airh airi airj airk airl airm airn airo -airp airq airr airs airt airu airv airw airx airy airz aisa aisb aisc aisd -aise aisf aisg aish aisi aisj aisk aisl aism aisn aiso aisp aisq aisr aiss -aist aisu aisv aisw aisx aisy aisz aita aitb aitc aitd aite aitf aitg aith -aiti aitj aitk aitl aitm aitn aito aitp aitq aitr aits aitt aitu aitv aitw -aitx aity aitz aiua aiub aiuc aiud aiue aiuf aiug aiuh aiui aiuj aiuk aiul -aium aiun aiuo aiup aiuq aiur aius aiut aiuu aiuv aiuw aiux aiuy aiuz aiva -aivb aivc aivd aive aivf aivg aivh aivi aivj aivk aivl aivm aivn aivo aivp -aivq aivr aivs aivt aivu aivv aivw aivx aivy aivz aiwa aiwb aiwc aiwd aiwe -aiwf aiwg aiwh aiwi aiwj aiwk aiwl aiwm aiwn aiwo aiwp aiwq aiwr aiws aiwt -aiwu aiwv aiww aiwx aiwy aiwz aixa aixb aixc aixd aixe aixf aixg aixh aixi -aixj aixk aixl aixm aixn aixo aixp aixq aixr aixs aixt aixu aixv aixw aixx -aixy aixz aiya aiyb aiyc aiyd aiye aiyf aiyg aiyh aiyi aiyj aiyk aiyl aiym -aiyn aiyo aiyp aiyq aiyr aiys aiyt aiyu aiyv aiyw aiyx aiyy aiyz aiza aizb -aizc aizd aize aizf aizg aizh aizi aizj aizk aizl aizm aizn aizo aizp aizq -aizr aizs aizt aizu aizv aizw aizx aizy aizz ajaa ajab ajac ajad ajae ajaf -ajag ajah ajai ajaj ajak ajal ajam ajan ajao ajap ajaq ajar ajas ajat ajau -ajav ajaw ajax ajay ajaz ajba ajbb ajbc ajbd ajbe ajbf ajbg ajbh ajbi ajbj -ajbk ajbl ajbm ajbn ajbo ajbp ajbq ajbr ajbs ajbt ajbu ajbv ajbw ajbx ajby -ajbz ajca ajcb ajcc ajcd ajce ajcf ajcg ajch ajci ajcj ajck ajcl ajcm ajcn -ajco ajcp ajcq ajcr ajcs ajct ajcu ajcv ajcw ajcx ajcy ajcz ajda ajdb ajdc -ajdd ajde ajdf ajdg ajdh ajdi ajdj ajdk ajdl ajdm ajdn ajdo ajdp ajdq ajdr -ajds ajdt ajdu ajdv ajdw ajdx ajdy ajdz ajea ajeb ajec ajed ajee ajef ajeg -ajeh ajei ajej ajek ajel ajem ajen ajeo ajep ajeq ajer ajes ajet ajeu ajev -ajew ajex ajey ajez ajfa ajfb ajfc ajfd ajfe ajff ajfg ajfh ajfi ajfj ajfk -ajfl ajfm ajfn ajfo ajfp ajfq ajfr ajfs ajft ajfu ajfv ajfw ajfx ajfy ajfz -ajga ajgb ajgc ajgd ajge ajgf ajgg ajgh ajgi ajgj ajgk ajgl ajgm ajgn ajgo -ajgp ajgq ajgr ajgs ajgt ajgu ajgv ajgw ajgx ajgy ajgz ajha ajhb ajhc ajhd -ajhe ajhf ajhg ajhh ajhi ajhj ajhk ajhl ajhm ajhn ajho ajhp ajhq ajhr ajhs -ajht ajhu ajhv ajhw ajhx ajhy ajhz ajia ajib ajic ajid ajie ajif ajig ajih -ajii ajij ajik ajil ajim ajin ajio ajip ajiq ajir ajis ajit ajiu ajiv ajiw -ajix ajiy ajiz ajja ajjb ajjc ajjd ajje ajjf ajjg ajjh ajji ajjj ajjk ajjl -ajjm ajjn ajjo ajjp ajjq ajjr ajjs ajjt ajju ajjv ajjw ajjx ajjy ajjz ajka -ajkb ajkc ajkd ajke ajkf ajkg ajkh ajki ajkj ajkk ajkl ajkm ajkn ajko ajkp -ajkq ajkr ajks ajkt ajku ajkv ajkw ajkx ajky ajkz ajla ajlb ajlc ajld ajle -ajlf ajlg ajlh ajli ajlj ajlk ajll ajlm ajln ajlo ajlp ajlq ajlr ajls ajlt -ajlu ajlv ajlw ajlx ajly ajlz ajma ajmb ajmc ajmd ajme ajmf ajmg ajmh ajmi -ajmj ajmk ajml ajmm ajmn ajmo ajmp ajmq ajmr ajms ajmt ajmu ajmv ajmw ajmx -ajmy ajmz ajna ajnb ajnc ajnd ajne ajnf ajng ajnh ajni ajnj ajnk ajnl ajnm -ajnn ajno ajnp ajnq ajnr ajns ajnt ajnu ajnv ajnw ajnx ajny ajnz ajoa ajob -ajoc ajod ajoe ajof ajog ajoh ajoi ajoj ajok ajol ajom ajon ajoo ajop ajoq -ajor ajos ajot ajou ajov ajow ajox ajoy ajoz ajpa ajpb ajpc ajpd ajpe ajpf -ajpg ajph ajpi ajpj ajpk ajpl ajpm ajpn ajpo ajpp ajpq ajpr ajps ajpt ajpu -ajpv ajpw ajpx ajpy ajpz ajqa ajqb ajqc ajqd ajqe ajqf ajqg ajqh ajqi ajqj -ajqk ajql ajqm ajqn ajqo ajqp ajqq ajqr ajqs ajqt ajqu ajqv ajqw ajqx ajqy -ajqz ajra ajrb ajrc ajrd ajre ajrf ajrg ajrh ajri ajrj ajrk ajrl ajrm ajrn -ajro ajrp ajrq ajrr ajrs ajrt ajru ajrv ajrw ajrx ajry ajrz ajsa ajsb ajsc -ajsd ajse ajsf ajsg ajsh ajsi ajsj ajsk ajsl ajsm ajsn ajso ajsp ajsq ajsr -ajss ajst ajsu ajsv ajsw ajsx ajsy ajsz ajta ajtb ajtc ajtd ajte ajtf ajtg -ajth ajti ajtj ajtk ajtl ajtm ajtn ajto ajtp ajtq ajtr ajts ajtt ajtu ajtv -ajtw ajtx ajty ajtz ajua ajub ajuc ajud ajue ajuf ajug ajuh ajui ajuj ajuk -ajul ajum ajun ajuo ajup ajuq ajur ajus ajut ajuu ajuv ajuw ajux ajuy ajuz -ajva ajvb ajvc ajvd ajve ajvf ajvg ajvh ajvi ajvj ajvk ajvl ajvm ajvn ajvo -ajvp ajvq ajvr ajvs ajvt ajvu ajvv ajvw ajvx ajvy ajvz ajwa ajwb ajwc ajwd -ajwe ajwf ajwg ajwh ajwi ajwj ajwk ajwl ajwm ajwn ajwo ajwp ajwq ajwr ajws -ajwt ajwu ajwv ajww ajwx ajwy ajwz ajxa ajxb ajxc ajxd ajxe ajxf ajxg ajxh -ajxi ajxj ajxk ajxl ajxm ajxn ajxo ajxp ajxq ajxr ajxs ajxt ajxu ajxv ajxw -ajxx ajxy ajxz ajya ajyb ajyc ajyd ajye ajyf ajyg ajyh ajyi ajyj ajyk ajyl -ajym ajyn ajyo ajyp ajyq ajyr ajys ajyt ajyu ajyv ajyw ajyx ajyy ajyz ajza -ajzb ajzc ajzd ajze ajzf ajzg ajzh ajzi ajzj ajzk ajzl ajzm ajzn ajzo ajzp -ajzq ajzr ajzs ajzt ajzu ajzv ajzw ajzx ajzy ajzz akaa akab akac akad akae -akaf akag akah akai akaj akak akal akam akan akao akap akaq akar akas akat -akau akav akaw akax akay akaz akba akbb akbc akbd akbe akbf akbg akbh akbi -akbj akbk akbl akbm akbn akbo akbp akbq akbr akbs akbt akbu akbv akbw akbx -akby akbz akca akcb akcc akcd akce akcf akcg akch akci akcj akck akcl akcm -akcn akco akcp akcq akcr akcs akct akcu akcv akcw akcx akcy akcz akda akdb -akdc akdd akde akdf akdg akdh akdi akdj akdk akdl akdm akdn akdo akdp akdq -akdr akds akdt akdu akdv akdw akdx akdy akdz akea akeb akec aked akee akef -akeg akeh akei akej akek akel akem aken akeo akep akeq aker akes aket akeu -akev akew akex akey akez akfa akfb akfc akfd akfe akff akfg akfh akfi akfj -akfk akfl akfm akfn akfo akfp akfq akfr akfs akft akfu akfv akfw akfx akfy -akfz akga akgb akgc akgd akge akgf akgg akgh akgi akgj akgk akgl akgm akgn -akgo akgp akgq akgr akgs akgt akgu akgv akgw akgx akgy akgz akha akhb akhc -akhd akhe akhf akhg akhh akhi akhj akhk akhl akhm akhn akho akhp akhq akhr -akhs akht akhu akhv akhw akhx akhy akhz akia akib akic akid akie akif akig -akih akii akij akik akil akim akin akio akip akiq akir akis akit akiu akiv -akiw akix akiy akiz akja akjb akjc akjd akje akjf akjg akjh akji akjj akjk -akjl akjm akjn akjo akjp akjq akjr akjs akjt akju akjv akjw akjx akjy akjz -akka akkb akkc akkd akke akkf akkg akkh akki akkj akkk akkl akkm akkn akko -akkp akkq akkr akks akkt akku akkv akkw akkx akky akkz akla aklb aklc akld -akle aklf aklg aklh akli aklj aklk akll aklm akln aklo aklp aklq aklr akls -aklt aklu aklv aklw aklx akly aklz akma akmb akmc akmd akme akmf akmg akmh -akmi akmj akmk akml akmm akmn akmo akmp akmq akmr akms akmt akmu akmv akmw -akmx akmy akmz akna aknb aknc aknd akne aknf akng aknh akni aknj aknk aknl -aknm aknn akno aknp aknq aknr akns aknt aknu aknv aknw aknx akny aknz akoa -akob akoc akod akoe akof akog akoh akoi akoj akok akol akom akon akoo akop -akoq akor akos akot akou akov akow akox akoy akoz akpa akpb akpc akpd akpe -akpf akpg akph akpi akpj akpk akpl akpm akpn akpo akpp akpq akpr akps akpt -akpu akpv akpw akpx akpy akpz akqa akqb akqc akqd akqe akqf akqg akqh akqi -akqj akqk akql akqm akqn akqo akqp akqq akqr akqs akqt akqu akqv akqw akqx -akqy akqz akra akrb akrc akrd akre akrf akrg akrh akri akrj akrk akrl akrm -akrn akro akrp akrq akrr akrs akrt akru akrv akrw akrx akry akrz aksa aksb -aksc aksd akse aksf aksg aksh aksi aksj aksk aksl aksm aksn akso aksp aksq -aksr akss akst aksu aksv aksw aksx aksy aksz akta aktb aktc aktd akte aktf -aktg akth akti aktj aktk aktl aktm aktn akto aktp aktq aktr akts aktt aktu -aktv aktw aktx akty aktz akua akub akuc akud akue akuf akug akuh akui akuj -akuk akul akum akun akuo akup akuq akur akus akut akuu akuv akuw akux akuy -akuz akva akvb akvc akvd akve akvf akvg akvh akvi akvj akvk akvl akvm akvn -akvo akvp akvq akvr akvs akvt akvu akvv akvw akvx akvy akvz akwa akwb akwc -akwd akwe akwf akwg akwh akwi akwj akwk akwl akwm akwn akwo akwp akwq akwr -akws akwt akwu akwv akww akwx akwy akwz akxa akxb akxc akxd akxe akxf akxg -akxh akxi akxj akxk akxl akxm akxn akxo akxp akxq akxr akxs akxt akxu akxv -akxw akxx akxy akxz akya akyb akyc akyd akye akyf akyg akyh akyi akyj akyk -akyl akym akyn akyo akyp akyq akyr akys akyt akyu akyv akyw akyx akyy akyz -akza akzb akzc akzd akze akzf akzg akzh akzi akzj akzk akzl akzm akzn akzo -akzp akzq akzr akzs akzt akzu akzv akzw akzx akzy akzz alaa alab alac alad -alae alaf alag alah alai alaj alak alal alam alan alao alap alaq alar alas -alat alau alav alaw alax alay alaz alba albb albc albd albe albf albg albh -albi albj albk albl albm albn albo albp albq albr albs albt albu albv albw -albx alby albz alca alcb alcc alcd alce alcf alcg alch alci alcj alck alcl -alcm alcn alco alcp alcq alcr alcs alct alcu alcv alcw alcx alcy alcz alda -aldb aldc aldd alde aldf aldg aldh aldi aldj aldk aldl aldm aldn aldo aldp -aldq aldr alds aldt aldu aldv aldw aldx aldy aldz alea aleb alec aled alee -alef aleg aleh alei alej alek alel alem alen aleo alep aleq aler ales alet -aleu alev alew alex aley alez alfa alfb alfc alfd alfe alff alfg alfh alfi -alfj alfk alfl alfm alfn alfo alfp alfq alfr alfs alft alfu alfv alfw alfx -alfy alfz alga algb algc algd alge algf algg algh algi algj algk algl algm -algn algo algp algq algr algs algt algu algv algw algx algy algz alha alhb -alhc alhd alhe alhf alhg alhh alhi alhj alhk alhl alhm alhn alho alhp alhq -alhr alhs alht alhu alhv alhw alhx alhy alhz alia alib alic alid alie alif -alig alih alii alij alik alil alim alin alio alip aliq alir alis alit aliu -aliv aliw alix aliy aliz alja aljb aljc aljd alje aljf aljg aljh alji aljj -aljk aljl aljm aljn aljo aljp aljq aljr aljs aljt alju aljv aljw aljx aljy -aljz alka alkb alkc alkd alke alkf alkg alkh alki alkj alkk alkl alkm alkn -alko alkp alkq alkr alks alkt alku alkv alkw alkx alky alkz alla allb allc -alld alle allf allg allh alli allj allk alll allm alln allo allp allq allr -alls allt allu allv allw allx ally allz alma almb almc almd alme almf almg -almh almi almj almk alml almm almn almo almp almq almr alms almt almu almv -almw almx almy almz alna alnb alnc alnd alne alnf alng alnh alni alnj alnk -alnl alnm alnn alno alnp alnq alnr alns alnt alnu alnv alnw alnx alny alnz -aloa alob aloc alod aloe alof alog aloh aloi aloj alok alol alom alon aloo -alop aloq alor alos alot alou alov alow alox aloy aloz alpa alpb alpc alpd -alpe alpf alpg alph alpi alpj alpk alpl alpm alpn alpo alpp alpq alpr alps -alpt alpu alpv alpw alpx alpy alpz alqa alqb alqc alqd alqe alqf alqg alqh -alqi alqj alqk alql alqm alqn alqo alqp alqq alqr alqs alqt alqu alqv alqw -alqx alqy alqz alra alrb alrc alrd alre alrf alrg alrh alri alrj alrk alrl -alrm alrn alro alrp alrq alrr alrs alrt alru alrv alrw alrx alry alrz alsa -alsb alsc alsd alse alsf alsg alsh alsi alsj alsk alsl alsm alsn also alsp -alsq alsr alss alst alsu alsv alsw alsx alsy alsz alta altb altc altd alte -altf altg alth alti altj altk altl altm altn alto altp altq altr alts altt -altu altv altw altx alty altz alua alub aluc alud alue aluf alug aluh alui -aluj aluk alul alum alun aluo alup aluq alur alus alut aluu aluv aluw alux -aluy aluz alva alvb alvc alvd alve alvf alvg alvh alvi alvj alvk alvl alvm -alvn alvo alvp alvq alvr alvs alvt alvu alvv alvw alvx alvy alvz alwa alwb -alwc alwd alwe alwf alwg alwh alwi alwj alwk alwl alwm alwn alwo alwp alwq -alwr alws alwt alwu alwv alww alwx alwy alwz alxa alxb alxc alxd alxe alxf -alxg alxh alxi alxj alxk alxl alxm alxn alxo alxp alxq alxr alxs alxt alxu -alxv alxw alxx alxy alxz alya alyb alyc alyd alye alyf alyg alyh alyi alyj -alyk alyl alym alyn alyo alyp alyq alyr alys alyt alyu alyv alyw alyx alyy -alyz alza alzb alzc alzd alze alzf alzg alzh alzi alzj alzk alzl alzm alzn -alzo alzp alzq alzr alzs alzt alzu alzv alzw alzx alzy alzz amaa amab amac -amad amae amaf amag amah amai amaj amak amal amam aman amao amap amaq amar -amas amat amau amav amaw amax amay amaz amba ambb ambc ambd ambe ambf ambg -ambh ambi ambj ambk ambl ambm ambn ambo ambp ambq ambr ambs ambt ambu ambv -ambw ambx amby ambz amca amcb amcc amcd amce amcf amcg amch amci amcj amck -amcl amcm amcn amco amcp amcq amcr amcs amct amcu amcv amcw amcx amcy amcz -amda amdb amdc amdd amde amdf amdg amdh amdi amdj amdk amdl amdm amdn amdo -amdp amdq amdr amds amdt amdu amdv amdw amdx amdy amdz amea ameb amec amed -amee amef ameg ameh amei amej amek amel amem amen ameo amep ameq amer ames -amet ameu amev amew amex amey amez amfa amfb amfc amfd amfe amff amfg amfh -amfi amfj amfk amfl amfm amfn amfo amfp amfq amfr amfs amft amfu amfv amfw -amfx amfy amfz amga amgb amgc amgd amge amgf amgg amgh amgi amgj amgk amgl -amgm amgn amgo amgp amgq amgr amgs amgt amgu amgv amgw amgx amgy amgz amha -amhb amhc amhd amhe amhf amhg amhh amhi amhj amhk amhl amhm amhn amho amhp -amhq amhr amhs amht amhu amhv amhw amhx amhy amhz amia amib amic amid amie -amif amig amih amii amij amik amil amim amin amio amip amiq amir amis amit -amiu amiv amiw amix amiy amiz amja amjb amjc amjd amje amjf amjg amjh amji -amjj amjk amjl amjm amjn amjo amjp amjq amjr amjs amjt amju amjv amjw amjx -amjy amjz amka amkb amkc amkd amke amkf amkg amkh amki amkj amkk amkl amkm -amkn amko amkp amkq amkr amks amkt amku amkv amkw amkx amky amkz amla amlb -amlc amld amle amlf amlg amlh amli amlj amlk amll amlm amln amlo amlp amlq -amlr amls amlt amlu amlv amlw amlx amly amlz amma ammb ammc ammd amme ammf -ammg ammh ammi ammj ammk amml ammm ammn ammo ammp ammq ammr amms ammt ammu -ammv ammw ammx ammy ammz amna amnb amnc amnd amne amnf amng amnh amni amnj -amnk amnl amnm amnn amno amnp amnq amnr amns amnt amnu amnv amnw amnx amny -amnz amoa amob amoc amod amoe amof amog amoh amoi amoj amok amol amom amon -amoo amop amoq amor amos amot amou amov amow amox amoy amoz ampa ampb ampc -ampd ampe ampf ampg amph ampi ampj ampk ampl ampm ampn ampo ampp ampq ampr -amps ampt ampu ampv ampw ampx ampy ampz amqa amqb amqc amqd amqe amqf amqg -amqh amqi amqj amqk amql amqm amqn amqo amqp amqq amqr amqs amqt amqu amqv -amqw amqx amqy amqz amra amrb amrc amrd amre amrf amrg amrh amri amrj amrk -amrl amrm amrn amro amrp amrq amrr amrs amrt amru amrv amrw amrx amry amrz -amsa amsb amsc amsd amse amsf amsg amsh amsi amsj amsk amsl amsm amsn amso -amsp amsq amsr amss amst amsu amsv amsw amsx amsy amsz amta amtb amtc amtd -amte amtf amtg amth amti amtj amtk amtl amtm amtn amto amtp amtq amtr amts -amtt amtu amtv amtw amtx amty amtz amua amub amuc amud amue amuf amug amuh -amui amuj amuk amul amum amun amuo amup amuq amur amus amut amuu amuv amuw -amux amuy amuz amva amvb amvc amvd amve amvf amvg amvh amvi amvj amvk amvl -amvm amvn amvo amvp amvq amvr amvs amvt amvu amvv amvw amvx amvy amvz amwa -amwb amwc amwd amwe amwf amwg amwh amwi amwj amwk amwl amwm amwn amwo amwp -amwq amwr amws amwt amwu amwv amww amwx amwy amwz amxa amxb amxc amxd amxe -amxf amxg amxh amxi amxj amxk amxl amxm amxn amxo amxp amxq amxr amxs amxt -amxu amxv amxw amxx amxy amxz amya amyb amyc amyd amye amyf amyg amyh amyi -amyj amyk amyl amym amyn amyo amyp amyq amyr amys amyt amyu amyv amyw amyx -amyy amyz amza amzb amzc amzd amze amzf amzg amzh amzi amzj amzk amzl amzm -amzn amzo amzp amzq amzr amzs amzt amzu amzv amzw amzx amzy amzz anaa anab -anac anad anae anaf anag anah anai anaj anak anal anam anan anao anap anaq -anar anas anat anau anav anaw anax anay anaz anba anbb anbc anbd anbe anbf -anbg anbh anbi anbj anbk anbl anbm anbn anbo anbp anbq anbr anbs anbt anbu -anbv anbw anbx anby anbz anca ancb ancc ancd ance ancf ancg anch anci ancj -anck ancl ancm ancn anco ancp ancq ancr ancs anct ancu ancv ancw ancx ancy -ancz anda andb andc andd ande andf andg andh andi andj andk andl andm andn -ando andp andq andr ands andt andu andv andw andx andy andz anea aneb anec -aned anee anef aneg aneh anei anej anek anel anem anen aneo anep aneq aner -anes anet aneu anev anew anex aney anez anfa anfb anfc anfd anfe anff anfg -anfh anfi anfj anfk anfl anfm anfn anfo anfp anfq anfr anfs anft anfu anfv -anfw anfx anfy anfz anga angb angc angd ange angf angg angh angi angj angk -angl angm angn ango angp angq angr angs angt angu angv angw angx angy angz -anha anhb anhc anhd anhe anhf anhg anhh anhi anhj anhk anhl anhm anhn anho -anhp anhq anhr anhs anht anhu anhv anhw anhx anhy anhz ania anib anic anid -anie anif anig anih anii anij anik anil anim anin anio anip aniq anir anis -anit aniu aniv aniw anix aniy aniz anja anjb anjc anjd anje anjf anjg anjh -anji anjj anjk anjl anjm anjn anjo anjp anjq anjr anjs anjt anju anjv anjw -anjx anjy anjz anka ankb ankc ankd anke ankf ankg ankh anki ankj ankk ankl -ankm ankn anko ankp ankq ankr anks ankt anku ankv ankw ankx anky ankz anla -anlb anlc anld anle anlf anlg anlh anli anlj anlk anll anlm anln anlo anlp -anlq anlr anls anlt anlu anlv anlw anlx anly anlz anma anmb anmc anmd anme -anmf anmg anmh anmi anmj anmk anml anmm anmn anmo anmp anmq anmr anms anmt -anmu anmv anmw anmx anmy anmz anna annb annc annd anne annf anng annh anni -annj annk annl annm annn anno annp annq annr anns annt annu annv annw annx -anny annz anoa anob anoc anod anoe anof anog anoh anoi anoj anok anol anom -anon anoo anop anoq anor anos anot anou anov anow anox anoy anoz anpa anpb -anpc anpd anpe anpf anpg anph anpi anpj anpk anpl anpm anpn anpo anpp anpq -anpr anps anpt anpu anpv anpw anpx anpy anpz anqa anqb anqc anqd anqe anqf -anqg anqh anqi anqj anqk anql anqm anqn anqo anqp anqq anqr anqs anqt anqu -anqv anqw anqx anqy anqz anra anrb anrc anrd anre anrf anrg anrh anri anrj -anrk anrl anrm anrn anro anrp anrq anrr anrs anrt anru anrv anrw anrx anry -anrz ansa ansb ansc ansd anse ansf ansg ansh ansi ansj ansk ansl ansm ansn -anso ansp ansq ansr anss anst ansu ansv answ ansx ansy ansz anta antb antc -antd ante antf antg anth anti antj antk antl antm antn anto antp antq antr -ants antt antu antv antw antx anty antz anua anub anuc anud anue anuf anug -anuh anui anuj anuk anul anum anun anuo anup anuq anur anus anut anuu anuv -anuw anux anuy anuz anva anvb anvc anvd anve anvf anvg anvh anvi anvj anvk -anvl anvm anvn anvo anvp anvq anvr anvs anvt anvu anvv anvw anvx anvy anvz -anwa anwb anwc anwd anwe anwf anwg anwh anwi anwj anwk anwl anwm anwn anwo -anwp anwq anwr anws anwt anwu anwv anww anwx anwy anwz anxa anxb anxc anxd -anxe anxf anxg anxh anxi anxj anxk anxl anxm anxn anxo anxp anxq anxr anxs -anxt anxu anxv anxw anxx anxy anxz anya anyb anyc anyd anye anyf anyg anyh -anyi anyj anyk anyl anym anyn anyo anyp anyq anyr anys anyt anyu anyv anyw -anyx anyy anyz anza anzb anzc anzd anze anzf anzg anzh anzi anzj anzk anzl -anzm anzn anzo anzp anzq anzr anzs anzt anzu anzv anzw anzx anzy anzz aoaa -aoab aoac aoad aoae aoaf aoag aoah aoai aoaj aoak aoal aoam aoan aoao aoap -aoaq aoar aoas aoat aoau aoav aoaw aoax aoay aoaz aoba aobb aobc aobd aobe -aobf aobg aobh aobi aobj aobk aobl aobm aobn aobo aobp aobq aobr aobs aobt -aobu aobv aobw aobx aoby aobz aoca aocb aocc aocd aoce aocf aocg aoch aoci -aocj aock aocl aocm aocn aoco aocp aocq aocr aocs aoct aocu aocv aocw aocx -aocy aocz aoda aodb aodc aodd aode aodf aodg aodh aodi aodj aodk aodl aodm -aodn aodo aodp aodq aodr aods aodt aodu aodv aodw aodx aody aodz aoea aoeb -aoec aoed aoee aoef aoeg aoeh aoei aoej aoek aoel aoem aoen aoeo aoep aoeq -aoer aoes aoet aoeu aoev aoew aoex aoey aoez aofa aofb aofc aofd aofe aoff -aofg aofh aofi aofj aofk aofl aofm aofn aofo aofp aofq aofr aofs aoft aofu -aofv aofw aofx aofy aofz aoga aogb aogc aogd aoge aogf aogg aogh aogi aogj -aogk aogl aogm aogn aogo aogp aogq aogr aogs aogt aogu aogv aogw aogx aogy -aogz aoha aohb aohc aohd aohe aohf aohg aohh aohi aohj aohk aohl aohm aohn -aoho aohp aohq aohr aohs aoht aohu aohv aohw aohx aohy aohz aoia aoib aoic -aoid aoie aoif aoig aoih aoii aoij aoik aoil aoim aoin aoio aoip aoiq aoir -aois aoit aoiu aoiv aoiw aoix aoiy aoiz aoja aojb aojc aojd aoje aojf aojg -aojh aoji aojj aojk aojl aojm aojn aojo aojp aojq aojr aojs aojt aoju aojv -aojw aojx aojy aojz aoka aokb aokc aokd aoke aokf aokg aokh aoki aokj aokk -aokl aokm aokn aoko aokp aokq aokr aoks aokt aoku aokv aokw aokx aoky aokz -aola aolb aolc aold aole aolf aolg aolh aoli aolj aolk aoll aolm aoln aolo -aolp aolq aolr aols aolt aolu aolv aolw aolx aoly aolz aoma aomb aomc aomd -aome aomf aomg aomh aomi aomj aomk aoml aomm aomn aomo aomp aomq aomr aoms -aomt aomu aomv aomw aomx aomy aomz aona aonb aonc aond aone aonf aong aonh -aoni aonj aonk aonl aonm aonn aono aonp aonq aonr aons aont aonu aonv aonw -aonx aony aonz aooa aoob aooc aood aooe aoof aoog aooh aooi aooj aook aool -aoom aoon aooo aoop aooq aoor aoos aoot aoou aoov aoow aoox aooy aooz aopa -aopb aopc aopd aope aopf aopg aoph aopi aopj aopk aopl aopm aopn aopo aopp -aopq aopr aops aopt aopu aopv aopw aopx aopy aopz aoqa aoqb aoqc aoqd aoqe -aoqf aoqg aoqh aoqi aoqj aoqk aoql aoqm aoqn aoqo aoqp aoqq aoqr aoqs aoqt -aoqu aoqv aoqw aoqx aoqy aoqz aora aorb aorc aord aore aorf aorg aorh aori -aorj aork aorl aorm aorn aoro aorp aorq aorr aors aort aoru aorv aorw aorx -aory aorz aosa aosb aosc aosd aose aosf aosg aosh aosi aosj aosk aosl aosm -aosn aoso aosp aosq aosr aoss aost aosu aosv aosw aosx aosy aosz aota aotb -aotc aotd aote aotf aotg aoth aoti aotj aotk aotl aotm aotn aoto aotp aotq -aotr aots aott aotu aotv aotw aotx aoty aotz aoua aoub aouc aoud aoue aouf -aoug aouh aoui aouj aouk aoul aoum aoun aouo aoup aouq aour aous aout aouu -aouv aouw aoux aouy aouz aova aovb aovc aovd aove aovf aovg aovh aovi aovj -aovk aovl aovm aovn aovo aovp aovq aovr aovs aovt aovu aovv aovw aovx aovy -aovz aowa aowb aowc aowd aowe aowf aowg aowh aowi aowj aowk aowl aowm aown -aowo aowp aowq aowr aows aowt aowu aowv aoww aowx aowy aowz aoxa aoxb aoxc -aoxd aoxe aoxf aoxg aoxh aoxi aoxj aoxk aoxl aoxm aoxn aoxo aoxp aoxq aoxr -aoxs aoxt aoxu aoxv aoxw aoxx aoxy aoxz aoya aoyb aoyc aoyd aoye aoyf aoyg -aoyh aoyi aoyj aoyk aoyl aoym aoyn aoyo aoyp aoyq aoyr aoys aoyt aoyu aoyv -aoyw aoyx aoyy aoyz aoza aozb aozc aozd aoze aozf aozg aozh aozi aozj aozk -aozl aozm aozn aozo aozp aozq aozr aozs aozt aozu aozv aozw aozx aozy aozz -apaa apab apac apad apae apaf apag apah apai apaj apak apal apam apan apao -apap apaq apar apas apat apau apav apaw apax apay apaz apba apbb apbc apbd -apbe apbf apbg apbh apbi apbj apbk apbl apbm apbn apbo apbp apbq apbr apbs -apbt apbu apbv apbw apbx apby apbz apca apcb apcc apcd apce apcf apcg apch -apci apcj apck apcl apcm apcn apco apcp apcq apcr apcs apct apcu apcv apcw -apcx apcy apcz apda apdb apdc apdd apde apdf apdg apdh apdi apdj apdk apdl -apdm apdn apdo apdp apdq apdr apds apdt apdu apdv apdw apdx apdy apdz apea -apeb apec aped apee apef apeg apeh apei apej apek apel apem apen apeo apep -apeq aper apes apet apeu apev apew apex apey apez apfa apfb apfc apfd apfe -apff apfg apfh apfi apfj apfk apfl apfm apfn apfo apfp apfq apfr apfs apft -apfu apfv apfw apfx apfy apfz apga apgb apgc apgd apge apgf apgg apgh apgi -apgj apgk apgl apgm apgn apgo apgp apgq apgr apgs apgt apgu apgv apgw apgx -apgy apgz apha aphb aphc aphd aphe aphf aphg aphh aphi aphj aphk aphl aphm -aphn apho aphp aphq aphr aphs apht aphu aphv aphw aphx aphy aphz apia apib -apic apid apie apif apig apih apii apij apik apil apim apin apio apip apiq -apir apis apit apiu apiv apiw apix apiy apiz apja apjb apjc apjd apje apjf -apjg apjh apji apjj apjk apjl apjm apjn apjo apjp apjq apjr apjs apjt apju -apjv apjw apjx apjy apjz apka apkb apkc apkd apke apkf apkg apkh apki apkj -apkk apkl apkm apkn apko apkp apkq apkr apks apkt apku apkv apkw apkx apky -apkz apla aplb aplc apld aple aplf aplg aplh apli aplj aplk apll aplm apln -aplo aplp aplq aplr apls aplt aplu aplv aplw aplx aply aplz apma apmb apmc -apmd apme apmf apmg apmh apmi apmj apmk apml apmm apmn apmo apmp apmq apmr -apms apmt apmu apmv apmw apmx apmy apmz apna apnb apnc apnd apne apnf apng -apnh apni apnj apnk apnl apnm apnn apno apnp apnq apnr apns apnt apnu apnv -apnw apnx apny apnz apoa apob apoc apod apoe apof apog apoh apoi apoj apok -apol apom apon apoo apop apoq apor apos apot apou apov apow apox apoy apoz -appa appb appc appd appe appf appg apph appi appj appk appl appm appn appo -appp appq appr apps appt appu appv appw appx appy appz apqa apqb apqc apqd -apqe apqf apqg apqh apqi apqj apqk apql apqm apqn apqo apqp apqq apqr apqs -apqt apqu apqv apqw apqx apqy apqz apra aprb aprc aprd apre aprf aprg aprh -apri aprj aprk aprl aprm aprn apro aprp aprq aprr aprs aprt apru aprv aprw -aprx apry aprz apsa apsb apsc apsd apse apsf apsg apsh apsi apsj apsk apsl -apsm apsn apso apsp apsq apsr apss apst apsu apsv apsw apsx apsy apsz apta -aptb aptc aptd apte aptf aptg apth apti aptj aptk aptl aptm aptn apto aptp -aptq aptr apts aptt aptu aptv aptw aptx apty aptz apua apub apuc apud apue -apuf apug apuh apui apuj apuk apul apum apun apuo apup apuq apur apus aput -apuu apuv apuw apux apuy apuz apva apvb apvc apvd apve apvf apvg apvh apvi -apvj apvk apvl apvm apvn apvo apvp apvq apvr apvs apvt apvu apvv apvw apvx -apvy apvz apwa apwb apwc apwd apwe apwf apwg apwh apwi apwj apwk apwl apwm -apwn apwo apwp apwq apwr apws apwt apwu apwv apww apwx apwy apwz apxa apxb -apxc apxd apxe apxf apxg apxh apxi apxj apxk apxl apxm apxn apxo apxp apxq -apxr apxs apxt apxu apxv apxw apxx apxy apxz apya apyb apyc apyd apye apyf -apyg apyh apyi apyj apyk apyl apym apyn apyo apyp apyq apyr apys apyt apyu -apyv apyw apyx apyy apyz apza apzb apzc apzd apze apzf apzg apzh apzi apzj -apzk apzl apzm apzn apzo apzp apzq apzr apzs apzt apzu apzv apzw apzx apzy -apzz aqaa aqab aqac aqad aqae aqaf aqag aqah aqai aqaj aqak aqal aqam aqan -aqao aqap aqaq aqar aqas aqat aqau aqav aqaw aqax aqay aqaz aqba aqbb aqbc -aqbd aqbe aqbf aqbg aqbh aqbi aqbj aqbk aqbl aqbm aqbn aqbo aqbp aqbq aqbr -aqbs aqbt aqbu aqbv aqbw aqbx aqby aqbz aqca aqcb aqcc aqcd aqce aqcf aqcg -aqch aqci aqcj aqck aqcl aqcm aqcn aqco aqcp aqcq aqcr aqcs aqct aqcu aqcv -aqcw aqcx aqcy aqcz aqda aqdb aqdc aqdd aqde aqdf aqdg aqdh aqdi aqdj aqdk -aqdl aqdm aqdn aqdo aqdp aqdq aqdr aqds aqdt aqdu aqdv aqdw aqdx aqdy aqdz -aqea aqeb aqec aqed aqee aqef aqeg aqeh aqei aqej aqek aqel aqem aqen aqeo -aqep aqeq aqer aqes aqet aqeu aqev aqew aqex aqey aqez aqfa aqfb aqfc aqfd -aqfe aqff aqfg aqfh aqfi aqfj aqfk aqfl aqfm aqfn aqfo aqfp aqfq aqfr aqfs -aqft aqfu aqfv aqfw aqfx aqfy aqfz aqga aqgb aqgc aqgd aqge aqgf aqgg aqgh -aqgi aqgj aqgk aqgl aqgm aqgn aqgo aqgp aqgq aqgr aqgs aqgt aqgu aqgv aqgw -aqgx aqgy aqgz aqha aqhb aqhc aqhd aqhe aqhf aqhg aqhh aqhi aqhj aqhk aqhl -aqhm aqhn aqho aqhp aqhq aqhr aqhs aqht aqhu aqhv aqhw aqhx aqhy aqhz aqia -aqib aqic aqid aqie aqif aqig aqih aqii aqij aqik aqil aqim aqin aqio aqip -aqiq aqir aqis aqit aqiu aqiv aqiw aqix aqiy aqiz aqja aqjb aqjc aqjd aqje -aqjf aqjg aqjh aqji aqjj aqjk aqjl aqjm aqjn aqjo aqjp aqjq aqjr aqjs aqjt -aqju aqjv aqjw aqjx aqjy aqjz aqka aqkb aqkc aqkd aqke aqkf aqkg aqkh aqki -aqkj aqkk aqkl aqkm aqkn aqko aqkp aqkq aqkr aqks aqkt aqku aqkv aqkw aqkx -aqky aqkz aqla aqlb aqlc aqld aqle aqlf aqlg aqlh aqli aqlj aqlk aqll aqlm -aqln aqlo aqlp aqlq aqlr aqls aqlt aqlu aqlv aqlw aqlx aqly aqlz aqma aqmb -aqmc aqmd aqme aqmf aqmg aqmh aqmi aqmj aqmk aqml aqmm aqmn aqmo aqmp aqmq -aqmr aqms aqmt aqmu aqmv aqmw aqmx aqmy aqmz aqna aqnb aqnc aqnd aqne aqnf -aqng aqnh aqni aqnj aqnk aqnl aqnm aqnn aqno aqnp aqnq aqnr aqns aqnt aqnu -aqnv aqnw aqnx aqny aqnz aqoa aqob aqoc aqod aqoe aqof aqog aqoh aqoi aqoj -aqok aqol aqom aqon aqoo aqop aqoq aqor aqos aqot aqou aqov aqow aqox aqoy -aqoz aqpa aqpb aqpc aqpd aqpe aqpf aqpg aqph aqpi aqpj aqpk aqpl aqpm aqpn -aqpo aqpp aqpq aqpr aqps aqpt aqpu aqpv aqpw aqpx aqpy aqpz aqqa aqqb aqqc -aqqd aqqe aqqf aqqg aqqh aqqi aqqj aqqk aqql aqqm aqqn aqqo aqqp aqqq aqqr -aqqs aqqt aqqu aqqv aqqw aqqx aqqy aqqz aqra aqrb aqrc aqrd aqre aqrf aqrg -aqrh aqri aqrj aqrk aqrl aqrm aqrn aqro aqrp aqrq aqrr aqrs aqrt aqru aqrv -aqrw aqrx aqry aqrz aqsa aqsb aqsc aqsd aqse aqsf aqsg aqsh aqsi aqsj aqsk -aqsl aqsm aqsn aqso aqsp aqsq aqsr aqss aqst aqsu aqsv aqsw aqsx aqsy aqsz -aqta aqtb aqtc aqtd aqte aqtf aqtg aqth aqti aqtj aqtk aqtl aqtm aqtn aqto -aqtp aqtq aqtr aqts aqtt aqtu aqtv aqtw aqtx aqty aqtz aqua aqub aquc aqud -aque aquf aqug aquh aqui aquj aquk aqul aqum aqun aquo aqup aquq aqur aqus -aqut aquu aquv aquw aqux aquy aquz aqva aqvb aqvc aqvd aqve aqvf aqvg aqvh -aqvi aqvj aqvk aqvl aqvm aqvn aqvo aqvp aqvq aqvr aqvs aqvt aqvu aqvv aqvw -aqvx aqvy aqvz aqwa aqwb aqwc aqwd aqwe aqwf aqwg aqwh aqwi aqwj aqwk aqwl -aqwm aqwn aqwo aqwp aqwq aqwr aqws aqwt aqwu aqwv aqww aqwx aqwy aqwz aqxa -aqxb aqxc aqxd aqxe aqxf aqxg aqxh aqxi aqxj aqxk aqxl aqxm aqxn aqxo aqxp -aqxq aqxr aqxs aqxt aqxu aqxv aqxw aqxx aqxy aqxz aqya aqyb aqyc aqyd aqye -aqyf aqyg aqyh aqyi aqyj aqyk aqyl aqym aqyn aqyo aqyp aqyq aqyr aqys aqyt -aqyu aqyv aqyw aqyx aqyy aqyz aqza aqzb aqzc aqzd aqze aqzf aqzg aqzh aqzi -aqzj aqzk aqzl aqzm aqzn aqzo aqzp aqzq aqzr aqzs aqzt aqzu aqzv aqzw aqzx -aqzy aqzz araa arab arac arad arae araf arag arah arai araj arak aral aram -aran arao arap araq arar aras arat arau arav araw arax aray araz arba arbb -arbc arbd arbe arbf arbg arbh arbi arbj arbk arbl arbm arbn arbo arbp arbq -arbr arbs arbt arbu arbv arbw arbx arby arbz arca arcb arcc arcd arce arcf -arcg arch arci arcj arck arcl arcm arcn arco arcp arcq arcr arcs arct arcu -arcv arcw arcx arcy arcz arda ardb ardc ardd arde ardf ardg ardh ardi ardj -ardk ardl ardm ardn ardo ardp ardq ardr ards ardt ardu ardv ardw ardx ardy -ardz area areb arec ared aree aref areg areh arei arej arek arel arem aren -areo arep areq arer ares aret areu arev arew arex arey arez arfa arfb arfc -arfd arfe arff arfg arfh arfi arfj arfk arfl arfm arfn arfo arfp arfq arfr -arfs arft arfu arfv arfw arfx arfy arfz arga argb argc argd arge argf argg -argh argi argj argk argl argm argn argo argp argq argr args argt argu argv -argw argx argy argz arha arhb arhc arhd arhe arhf arhg arhh arhi arhj arhk -arhl arhm arhn arho arhp arhq arhr arhs arht arhu arhv arhw arhx arhy arhz -aria arib aric arid arie arif arig arih arii arij arik aril arim arin ario -arip ariq arir aris arit ariu ariv ariw arix ariy ariz arja arjb arjc arjd -arje arjf arjg arjh arji arjj arjk arjl arjm arjn arjo arjp arjq arjr arjs -arjt arju arjv arjw arjx arjy arjz arka arkb arkc arkd arke arkf arkg arkh -arki arkj arkk arkl arkm arkn arko arkp arkq arkr arks arkt arku arkv arkw -arkx arky arkz arla arlb arlc arld arle arlf arlg arlh arli arlj arlk arll -arlm arln arlo arlp arlq arlr arls arlt arlu arlv arlw arlx arly arlz arma -armb armc armd arme armf armg armh armi armj armk arml armm armn armo armp -armq armr arms armt armu armv armw armx army armz arna arnb arnc arnd arne -arnf arng arnh arni arnj arnk arnl arnm arnn arno arnp arnq arnr arns arnt -arnu arnv arnw arnx arny arnz aroa arob aroc arod aroe arof arog aroh aroi -aroj arok arol arom aron aroo arop aroq aror aros arot arou arov arow arox -aroy aroz arpa arpb arpc arpd arpe arpf arpg arph arpi arpj arpk arpl arpm -arpn arpo arpp arpq arpr arps arpt arpu arpv arpw arpx arpy arpz arqa arqb -arqc arqd arqe arqf arqg arqh arqi arqj arqk arql arqm arqn arqo arqp arqq -arqr arqs arqt arqu arqv arqw arqx arqy arqz arra arrb arrc arrd arre arrf -arrg arrh arri arrj arrk arrl arrm arrn arro arrp arrq arrr arrs arrt arru -arrv arrw arrx arry arrz arsa arsb arsc arsd arse arsf arsg arsh arsi arsj -arsk arsl arsm arsn arso arsp arsq arsr arss arst arsu arsv arsw arsx arsy -arsz arta artb artc artd arte artf artg arth arti artj artk artl artm artn -arto artp artq artr arts artt artu artv artw artx arty artz arua arub aruc -arud arue aruf arug aruh arui aruj aruk arul arum arun aruo arup aruq arur -arus arut aruu aruv aruw arux aruy aruz arva arvb arvc arvd arve arvf arvg -arvh arvi arvj arvk arvl arvm arvn arvo arvp arvq arvr arvs arvt arvu arvv -arvw arvx arvy arvz arwa arwb arwc arwd arwe arwf arwg arwh arwi arwj arwk -arwl arwm arwn arwo arwp arwq arwr arws arwt arwu arwv arww arwx arwy arwz -arxa arxb arxc arxd arxe arxf arxg arxh arxi arxj arxk arxl arxm arxn arxo -arxp arxq arxr arxs arxt arxu arxv arxw arxx arxy arxz arya aryb aryc aryd -arye aryf aryg aryh aryi aryj aryk aryl arym aryn aryo aryp aryq aryr arys -aryt aryu aryv aryw aryx aryy aryz arza arzb arzc arzd arze arzf arzg arzh -arzi arzj arzk arzl arzm arzn arzo arzp arzq arzr arzs arzt arzu arzv arzw -arzx arzy arzz asaa asab asac asad asae asaf asag asah asai asaj asak asal -asam asan asao asap asaq asar asas asat asau asav asaw asax asay asaz asba -asbb asbc asbd asbe asbf asbg asbh asbi asbj asbk asbl asbm asbn asbo asbp -asbq asbr asbs asbt asbu asbv asbw asbx asby asbz asca ascb ascc ascd asce -ascf ascg asch asci ascj asck ascl ascm ascn asco ascp ascq ascr ascs asct -ascu ascv ascw ascx ascy ascz asda asdb asdc asdd asde asdf asdg asdh asdi -asdj asdk asdl asdm asdn asdo asdp asdq asdr asds asdt asdu asdv asdw asdx -asdy asdz asea aseb asec ased asee asef aseg aseh asei asej asek asel asem -asen aseo asep aseq aser ases aset aseu asev asew asex asey asez asfa asfb -asfc asfd asfe asff asfg asfh asfi asfj asfk asfl asfm asfn asfo asfp asfq -asfr asfs asft asfu asfv asfw asfx asfy asfz asga asgb asgc asgd asge asgf -asgg asgh asgi asgj asgk asgl asgm asgn asgo asgp asgq asgr asgs asgt asgu -asgv asgw asgx asgy asgz asha ashb ashc ashd ashe ashf ashg ashh ashi ashj -ashk ashl ashm ashn asho ashp ashq ashr ashs asht ashu ashv ashw ashx ashy -ashz asia asib asic asid asie asif asig asih asii asij asik asil asim asin -asio asip asiq asir asis asit asiu asiv asiw asix asiy asiz asja asjb asjc -asjd asje asjf asjg asjh asji asjj asjk asjl asjm asjn asjo asjp asjq asjr -asjs asjt asju asjv asjw asjx asjy asjz aska askb askc askd aske askf askg -askh aski askj askk askl askm askn asko askp askq askr asks askt asku askv -askw askx asky askz asla aslb aslc asld asle aslf aslg aslh asli aslj aslk -asll aslm asln aslo aslp aslq aslr asls aslt aslu aslv aslw aslx asly aslz -asma asmb asmc asmd asme asmf asmg asmh asmi asmj asmk asml asmm asmn asmo -asmp asmq asmr asms asmt asmu asmv asmw asmx asmy asmz asna asnb asnc asnd -asne asnf asng asnh asni asnj asnk asnl asnm asnn asno asnp asnq asnr asns -asnt asnu asnv asnw asnx asny asnz asoa asob asoc asod asoe asof asog asoh -asoi asoj asok asol asom ason asoo asop asoq asor asos asot asou asov asow -asox asoy asoz aspa aspb aspc aspd aspe aspf aspg asph aspi aspj aspk aspl -aspm aspn aspo aspp aspq aspr asps aspt aspu aspv aspw aspx aspy aspz asqa -asqb asqc asqd asqe asqf asqg asqh asqi asqj asqk asql asqm asqn asqo asqp -asqq asqr asqs asqt asqu asqv asqw asqx asqy asqz asra asrb asrc asrd asre -asrf asrg asrh asri asrj asrk asrl asrm asrn asro asrp asrq asrr asrs asrt -asru asrv asrw asrx asry asrz assa assb assc assd asse assf assg assh assi -assj assk assl assm assn asso assp assq assr asss asst assu assv assw assx -assy assz asta astb astc astd aste astf astg asth asti astj astk astl astm -astn asto astp astq astr asts astt astu astv astw astx asty astz asua asub -asuc asud asue asuf asug asuh asui asuj asuk asul asum asun asuo asup asuq -asur asus asut asuu asuv asuw asux asuy asuz asva asvb asvc asvd asve asvf -asvg asvh asvi asvj asvk asvl asvm asvn asvo asvp asvq asvr asvs asvt asvu -asvv asvw asvx asvy asvz aswa aswb aswc aswd aswe aswf aswg aswh aswi aswj -aswk aswl aswm aswn aswo aswp aswq aswr asws aswt aswu aswv asww aswx aswy -aswz asxa asxb asxc asxd asxe asxf asxg asxh asxi asxj asxk asxl asxm asxn -asxo asxp asxq asxr asxs asxt asxu asxv asxw asxx asxy asxz asya asyb asyc -asyd asye asyf asyg asyh asyi asyj asyk asyl asym asyn asyo asyp asyq asyr -asys asyt asyu asyv asyw asyx asyy asyz asza aszb aszc aszd asze aszf aszg -aszh aszi aszj aszk aszl aszm aszn aszo aszp aszq aszr aszs aszt aszu aszv -aszw aszx aszy aszz ataa atab atac atad atae ataf atag atah atai ataj atak -atal atam atan atao atap ataq atar atas atat atau atav ataw atax atay ataz -atba atbb atbc atbd atbe atbf atbg atbh atbi atbj atbk atbl atbm atbn atbo -atbp atbq atbr atbs atbt atbu atbv atbw atbx atby atbz atca atcb atcc atcd -atce atcf atcg atch atci atcj atck atcl atcm atcn atco atcp atcq atcr atcs -atct atcu atcv atcw atcx atcy atcz atda atdb atdc atdd atde atdf atdg atdh -atdi atdj atdk atdl atdm atdn atdo atdp atdq atdr atds atdt atdu atdv atdw -atdx atdy atdz atea ateb atec ated atee atef ateg ateh atei atej atek atel -atem aten ateo atep ateq ater ates atet ateu atev atew atex atey atez atfa -atfb atfc atfd atfe atff atfg atfh atfi atfj atfk atfl atfm atfn atfo atfp -atfq atfr atfs atft atfu atfv atfw atfx atfy atfz atga atgb atgc atgd atge -atgf atgg atgh atgi atgj atgk atgl atgm atgn atgo atgp atgq atgr atgs atgt -atgu atgv atgw atgx atgy atgz atha athb athc athd athe athf athg athh athi -athj athk athl athm athn atho athp athq athr aths atht athu athv athw athx -athy athz atia atib atic atid atie atif atig atih atii atij atik atil atim -atin atio atip atiq atir atis atit atiu ativ atiw atix atiy atiz atja atjb -atjc atjd atje atjf atjg atjh atji atjj atjk atjl atjm atjn atjo atjp atjq -atjr atjs atjt atju atjv atjw atjx atjy atjz atka atkb atkc atkd atke atkf -atkg atkh atki atkj atkk atkl atkm atkn atko atkp atkq atkr atks atkt atku -atkv atkw atkx atky atkz atla atlb atlc atld atle atlf atlg atlh atli atlj -atlk atll atlm atln atlo atlp atlq atlr atls atlt atlu atlv atlw atlx atly -atlz atma atmb atmc atmd atme atmf atmg atmh atmi atmj atmk atml atmm atmn -atmo atmp atmq atmr atms atmt atmu atmv atmw atmx atmy atmz atna atnb atnc -atnd atne atnf atng atnh atni atnj atnk atnl atnm atnn atno atnp atnq atnr -atns atnt atnu atnv atnw atnx atny atnz atoa atob atoc atod atoe atof atog -atoh atoi atoj atok atol atom aton atoo atop atoq ator atos atot atou atov -atow atox atoy atoz atpa atpb atpc atpd atpe atpf atpg atph atpi atpj atpk -atpl atpm atpn atpo atpp atpq atpr atps atpt atpu atpv atpw atpx atpy atpz -atqa atqb atqc atqd atqe atqf atqg atqh atqi atqj atqk atql atqm atqn atqo -atqp atqq atqr atqs atqt atqu atqv atqw atqx atqy atqz atra atrb atrc atrd -atre atrf atrg atrh atri atrj atrk atrl atrm atrn atro atrp atrq atrr atrs -atrt atru atrv atrw atrx atry atrz atsa atsb atsc atsd atse atsf atsg atsh -atsi atsj atsk atsl atsm atsn atso atsp atsq atsr atss atst atsu atsv atsw -atsx atsy atsz atta attb attc attd atte attf attg atth atti attj attk attl -attm attn atto attp attq attr atts attt attu attv attw attx atty attz atua -atub atuc atud atue atuf atug atuh atui atuj atuk atul atum atun atuo atup -atuq atur atus atut atuu atuv atuw atux atuy atuz atva atvb atvc atvd atve -atvf atvg atvh atvi atvj atvk atvl atvm atvn atvo atvp atvq atvr atvs atvt -atvu atvv atvw atvx atvy atvz atwa atwb atwc atwd atwe atwf atwg atwh atwi -atwj atwk atwl atwm atwn atwo atwp atwq atwr atws atwt atwu atwv atww atwx -atwy atwz atxa atxb atxc atxd atxe atxf atxg atxh atxi atxj atxk atxl atxm -atxn atxo atxp atxq atxr atxs atxt atxu atxv atxw atxx atxy atxz atya atyb -atyc atyd atye atyf atyg atyh atyi atyj atyk atyl atym atyn atyo atyp atyq -atyr atys atyt atyu atyv atyw atyx atyy atyz atza atzb atzc atzd atze atzf -atzg atzh atzi atzj atzk atzl atzm atzn atzo atzp atzq atzr atzs atzt atzu -atzv atzw atzx atzy atzz auaa auab auac auad auae auaf auag auah auai auaj -auak aual auam auan auao auap auaq auar auas auat auau auav auaw auax auay -auaz auba aubb aubc aubd aube aubf aubg aubh aubi aubj aubk aubl aubm aubn -aubo aubp aubq aubr aubs aubt aubu aubv aubw aubx auby aubz auca aucb aucc -aucd auce aucf aucg auch auci aucj auck aucl aucm aucn auco aucp aucq aucr -aucs auct aucu aucv aucw aucx aucy aucz auda audb audc audd aude audf audg -audh audi audj audk audl audm audn audo audp audq audr auds audt audu audv -audw audx audy audz auea aueb auec aued auee auef aueg aueh auei auej auek -auel auem auen aueo auep aueq auer aues auet aueu auev auew auex auey auez -aufa aufb aufc aufd aufe auff aufg aufh aufi aufj aufk aufl aufm aufn aufo -aufp aufq aufr aufs auft aufu aufv aufw aufx aufy aufz auga augb augc augd -auge augf augg augh augi augj augk augl augm augn augo augp augq augr augs -augt augu augv augw augx augy augz auha auhb auhc auhd auhe auhf auhg auhh -auhi auhj auhk auhl auhm auhn auho auhp auhq auhr auhs auht auhu auhv auhw -auhx auhy auhz auia auib auic auid auie auif auig auih auii auij auik auil -auim auin auio auip auiq auir auis auit auiu auiv auiw auix auiy auiz auja -aujb aujc aujd auje aujf aujg aujh auji aujj aujk aujl aujm aujn aujo aujp -aujq aujr aujs aujt auju aujv aujw aujx aujy aujz auka aukb aukc aukd auke -aukf aukg aukh auki aukj aukk aukl aukm aukn auko aukp aukq aukr auks aukt -auku aukv aukw aukx auky aukz aula aulb aulc auld aule aulf aulg aulh auli -aulj aulk aull aulm auln aulo aulp aulq aulr auls ault aulu aulv aulw aulx -auly aulz auma aumb aumc aumd aume aumf aumg aumh aumi aumj aumk auml aumm -aumn aumo aump aumq aumr aums aumt aumu aumv aumw aumx aumy aumz auna aunb -aunc aund aune aunf aung aunh auni aunj aunk aunl aunm aunn auno aunp aunq -aunr auns aunt aunu aunv aunw aunx auny aunz auoa auob auoc auod auoe auof -auog auoh auoi auoj auok auol auom auon auoo auop auoq auor auos auot auou -auov auow auox auoy auoz aupa aupb aupc aupd aupe aupf aupg auph aupi aupj -aupk aupl aupm aupn aupo aupp aupq aupr aups aupt aupu aupv aupw aupx aupy -aupz auqa auqb auqc auqd auqe auqf auqg auqh auqi auqj auqk auql auqm auqn -auqo auqp auqq auqr auqs auqt auqu auqv auqw auqx auqy auqz aura aurb aurc -aurd aure aurf aurg aurh auri aurj aurk aurl aurm aurn auro aurp aurq aurr -aurs aurt auru aurv aurw aurx aury aurz ausa ausb ausc ausd ause ausf ausg -aush ausi ausj ausk ausl ausm ausn auso ausp ausq ausr auss aust ausu ausv -ausw ausx ausy ausz auta autb autc autd aute autf autg auth auti autj autk -autl autm autn auto autp autq autr auts autt autu autv autw autx auty autz -auua auub auuc auud auue auuf auug auuh auui auuj auuk auul auum auun auuo -auup auuq auur auus auut auuu auuv auuw auux auuy auuz auva auvb auvc auvd -auve auvf auvg auvh auvi auvj auvk auvl auvm auvn auvo auvp auvq auvr auvs -auvt auvu auvv auvw auvx auvy auvz auwa auwb auwc auwd auwe auwf auwg auwh -auwi auwj auwk auwl auwm auwn auwo auwp auwq auwr auws auwt auwu auwv auww -auwx auwy auwz auxa auxb auxc auxd auxe auxf auxg auxh auxi auxj auxk auxl -auxm auxn auxo auxp auxq auxr auxs auxt auxu auxv auxw auxx auxy auxz auya -auyb auyc auyd auye auyf auyg auyh auyi auyj auyk auyl auym auyn auyo auyp -auyq auyr auys auyt auyu auyv auyw auyx auyy auyz auza auzb auzc auzd auze -auzf auzg auzh auzi auzj auzk auzl auzm auzn auzo auzp auzq auzr auzs auzt -auzu auzv auzw auzx auzy auzz avaa avab avac avad avae avaf avag avah avai -avaj avak aval avam avan avao avap avaq avar avas avat avau avav avaw avax -avay avaz avba avbb avbc avbd avbe avbf avbg avbh avbi avbj avbk avbl avbm -avbn avbo avbp avbq avbr avbs avbt avbu avbv avbw avbx avby avbz avca avcb -avcc avcd avce avcf avcg avch avci avcj avck avcl avcm avcn avco avcp avcq -avcr avcs avct avcu avcv avcw avcx avcy avcz avda avdb avdc avdd avde avdf -avdg avdh avdi avdj avdk avdl avdm avdn avdo avdp avdq avdr avds avdt avdu -avdv avdw avdx avdy avdz avea aveb avec aved avee avef aveg aveh avei avej -avek avel avem aven aveo avep aveq aver aves avet aveu avev avew avex avey -avez avfa avfb avfc avfd avfe avff avfg avfh avfi avfj avfk avfl avfm avfn -avfo avfp avfq avfr avfs avft avfu avfv avfw avfx avfy avfz avga avgb avgc -avgd avge avgf avgg avgh avgi avgj avgk avgl avgm avgn avgo avgp avgq avgr -avgs avgt avgu avgv avgw avgx avgy avgz avha avhb avhc avhd avhe avhf avhg -avhh avhi avhj avhk avhl avhm avhn avho avhp avhq avhr avhs avht avhu avhv -avhw avhx avhy avhz avia avib avic avid avie avif avig avih avii avij avik -avil avim avin avio avip aviq avir avis avit aviu aviv aviw avix aviy aviz -avja avjb avjc avjd avje avjf avjg avjh avji avjj avjk avjl avjm avjn avjo -avjp avjq avjr avjs avjt avju avjv avjw avjx avjy avjz avka avkb avkc avkd -avke avkf avkg avkh avki avkj avkk avkl avkm avkn avko avkp avkq avkr avks -avkt avku avkv avkw avkx avky avkz avla avlb avlc avld avle avlf avlg avlh -avli avlj avlk avll avlm avln avlo avlp avlq avlr avls avlt avlu avlv avlw -avlx avly avlz avma avmb avmc avmd avme avmf avmg avmh avmi avmj avmk avml -avmm avmn avmo avmp avmq avmr avms avmt avmu avmv avmw avmx avmy avmz avna -avnb avnc avnd avne avnf avng avnh avni avnj avnk avnl avnm avnn avno avnp -avnq avnr avns avnt avnu avnv avnw avnx avny avnz avoa avob avoc avod avoe -avof avog avoh avoi avoj avok avol avom avon avoo avop avoq avor avos avot -avou avov avow avox avoy avoz avpa avpb avpc avpd avpe avpf avpg avph avpi -avpj avpk avpl avpm avpn avpo avpp avpq avpr avps avpt avpu avpv avpw avpx -avpy avpz avqa avqb avqc avqd avqe avqf avqg avqh avqi avqj avqk avql avqm -avqn avqo avqp avqq avqr avqs avqt avqu avqv avqw avqx avqy avqz avra avrb -avrc avrd avre avrf avrg avrh avri avrj avrk avrl avrm avrn avro avrp avrq -avrr avrs avrt avru avrv avrw avrx avry avrz avsa avsb avsc avsd avse avsf -avsg avsh avsi avsj avsk avsl avsm avsn avso avsp avsq avsr avss avst avsu -avsv avsw avsx avsy avsz avta avtb avtc avtd avte avtf avtg avth avti avtj -avtk avtl avtm avtn avto avtp avtq avtr avts avtt avtu avtv avtw avtx avty -avtz avua avub avuc avud avue avuf avug avuh avui avuj avuk avul avum avun -avuo avup avuq avur avus avut avuu avuv avuw avux avuy avuz avva avvb avvc -avvd avve avvf avvg avvh avvi avvj avvk avvl avvm avvn avvo avvp avvq avvr -avvs avvt avvu avvv avvw avvx avvy avvz avwa avwb avwc avwd avwe avwf avwg -avwh avwi avwj avwk avwl avwm avwn avwo avwp avwq avwr avws avwt avwu avwv -avww avwx avwy avwz avxa avxb avxc avxd avxe avxf avxg avxh avxi avxj avxk -avxl avxm avxn avxo avxp avxq avxr avxs avxt avxu avxv avxw avxx avxy avxz -avya avyb avyc avyd avye avyf avyg avyh avyi avyj avyk avyl avym avyn avyo -avyp avyq avyr avys avyt avyu avyv avyw avyx avyy avyz avza avzb avzc avzd -avze avzf avzg avzh avzi avzj avzk avzl avzm avzn avzo avzp avzq avzr avzs -avzt avzu avzv avzw avzx avzy avzz awaa awab awac awad awae awaf awag awah -awai awaj awak awal awam awan awao awap awaq awar awas awat awau awav awaw -awax away awaz awba awbb awbc awbd awbe awbf awbg awbh awbi awbj awbk awbl -awbm awbn awbo awbp awbq awbr awbs awbt awbu awbv awbw awbx awby awbz awca -awcb awcc awcd awce awcf awcg awch awci awcj awck awcl awcm awcn awco awcp -awcq awcr awcs awct awcu awcv awcw awcx awcy awcz awda awdb awdc awdd awde -awdf awdg awdh awdi awdj awdk awdl awdm awdn awdo awdp awdq awdr awds awdt -awdu awdv awdw awdx awdy awdz awea aweb awec awed awee awef aweg aweh awei -awej awek awel awem awen aweo awep aweq awer awes awet aweu awev awew awex -awey awez awfa awfb awfc awfd awfe awff awfg awfh awfi awfj awfk awfl awfm -awfn awfo awfp awfq awfr awfs awft awfu awfv awfw awfx awfy awfz awga awgb -awgc awgd awge awgf awgg awgh awgi awgj awgk awgl awgm awgn awgo awgp awgq -awgr awgs awgt awgu awgv awgw awgx awgy awgz awha awhb awhc awhd awhe awhf -awhg awhh awhi awhj awhk awhl awhm awhn awho awhp awhq awhr awhs awht awhu -awhv awhw awhx awhy awhz awia awib awic awid awie awif awig awih awii awij -awik awil awim awin awio awip awiq awir awis awit awiu awiv awiw awix awiy -awiz awja awjb awjc awjd awje awjf awjg awjh awji awjj awjk awjl awjm awjn -awjo awjp awjq awjr awjs awjt awju awjv awjw awjx awjy awjz awka awkb awkc -awkd awke awkf awkg awkh awki awkj awkk awkl awkm awkn awko awkp awkq awkr -awks awkt awku awkv awkw awkx awky awkz awla awlb awlc awld awle awlf awlg -awlh awli awlj awlk awll awlm awln awlo awlp awlq awlr awls awlt awlu awlv -awlw awlx awly awlz awma awmb awmc awmd awme awmf awmg awmh awmi awmj awmk -awml awmm awmn awmo awmp awmq awmr awms awmt awmu awmv awmw awmx awmy awmz -awna awnb awnc awnd awne awnf awng awnh awni awnj awnk awnl awnm awnn awno -awnp awnq awnr awns awnt awnu awnv awnw awnx awny awnz awoa awob awoc awod -awoe awof awog awoh awoi awoj awok awol awom awon awoo awop awoq awor awos -awot awou awov awow awox awoy awoz awpa awpb awpc awpd awpe awpf awpg awph -awpi awpj awpk awpl awpm awpn awpo awpp awpq awpr awps awpt awpu awpv awpw -awpx awpy awpz awqa awqb awqc awqd awqe awqf awqg awqh awqi awqj awqk awql -awqm awqn awqo awqp awqq awqr awqs awqt awqu awqv awqw awqx awqy awqz awra -awrb awrc awrd awre awrf awrg awrh awri awrj awrk awrl awrm awrn awro awrp -awrq awrr awrs awrt awru awrv awrw awrx awry awrz awsa awsb awsc awsd awse -awsf awsg awsh awsi awsj awsk awsl awsm awsn awso awsp awsq awsr awss awst -awsu awsv awsw awsx awsy awsz awta awtb awtc awtd awte awtf awtg awth awti -awtj awtk awtl awtm awtn awto awtp awtq awtr awts awtt awtu awtv awtw awtx -awty awtz awua awub awuc awud awue awuf awug awuh awui awuj awuk awul awum -awun awuo awup awuq awur awus awut awuu awuv awuw awux awuy awuz awva awvb -awvc awvd awve awvf awvg awvh awvi awvj awvk awvl awvm awvn awvo awvp awvq -awvr awvs awvt awvu awvv awvw awvx awvy awvz awwa awwb awwc awwd awwe awwf -awwg awwh awwi awwj awwk awwl awwm awwn awwo awwp awwq awwr awws awwt awwu -awwv awww awwx awwy awwz awxa awxb awxc awxd awxe awxf awxg awxh awxi awxj -awxk awxl awxm awxn awxo awxp awxq awxr awxs awxt awxu awxv awxw awxx awxy -awxz awya awyb awyc awyd awye awyf awyg awyh awyi awyj awyk awyl awym awyn -awyo awyp awyq awyr awys awyt awyu awyv awyw awyx awyy awyz awza awzb awzc -awzd awze awzf awzg awzh awzi awzj awzk awzl awzm awzn awzo awzp awzq awzr -awzs awzt awzu awzv awzw awzx awzy awzz axaa axab axac axad axae axaf axag -axah axai axaj axak axal axam axan axao axap axaq axar axas axat axau axav -axaw axax axay axaz axba axbb axbc axbd axbe axbf axbg axbh axbi axbj axbk -axbl axbm axbn axbo axbp axbq axbr axbs axbt axbu axbv axbw axbx axby axbz -axca axcb axcc axcd axce axcf axcg axch axci axcj axck axcl axcm axcn axco -axcp axcq axcr axcs axct axcu axcv axcw axcx axcy axcz axda axdb axdc axdd -axde axdf axdg axdh axdi axdj axdk axdl axdm axdn axdo axdp axdq axdr axds -axdt axdu axdv axdw axdx axdy axdz axea axeb axec axed axee axef axeg axeh -axei axej axek axel axem axen axeo axep axeq axer axes axet axeu axev axew -axex axey axez axfa axfb axfc axfd axfe axff axfg axfh axfi axfj axfk axfl -axfm axfn axfo axfp axfq axfr axfs axft axfu axfv axfw axfx axfy axfz axga -axgb axgc axgd axge axgf axgg axgh axgi axgj axgk axgl axgm axgn axgo axgp -axgq axgr axgs axgt axgu axgv axgw axgx axgy axgz axha axhb axhc axhd axhe -axhf axhg axhh axhi axhj axhk axhl axhm axhn axho axhp axhq axhr axhs axht -axhu axhv axhw axhx axhy axhz axia axib axic axid axie axif axig axih axii -axij axik axil axim axin axio axip axiq axir axis axit axiu axiv axiw axix -axiy axiz axja axjb axjc axjd axje axjf axjg axjh axji axjj axjk axjl axjm -axjn axjo axjp axjq axjr axjs axjt axju axjv axjw axjx axjy axjz axka axkb -axkc axkd axke axkf axkg axkh axki axkj axkk axkl axkm axkn axko axkp axkq -axkr axks axkt axku axkv axkw axkx axky axkz axla axlb axlc axld axle axlf -axlg axlh axli axlj axlk axll axlm axln axlo axlp axlq axlr axls axlt axlu -axlv axlw axlx axly axlz axma axmb axmc axmd axme axmf axmg axmh axmi axmj -axmk axml axmm axmn axmo axmp axmq axmr axms axmt axmu axmv axmw axmx axmy -axmz axna axnb axnc axnd axne axnf axng axnh axni axnj axnk axnl axnm axnn -axno axnp axnq axnr axns axnt axnu axnv axnw axnx axny axnz axoa axob axoc -axod axoe axof axog axoh axoi axoj axok axol axom axon axoo axop axoq axor -axos axot axou axov axow axox axoy axoz axpa axpb axpc axpd axpe axpf axpg -axph axpi axpj axpk axpl axpm axpn axpo axpp axpq axpr axps axpt axpu axpv -axpw axpx axpy axpz axqa axqb axqc axqd axqe axqf axqg axqh axqi axqj axqk -axql axqm axqn axqo axqp axqq axqr axqs axqt axqu axqv axqw axqx axqy axqz -axra axrb axrc axrd axre axrf axrg axrh axri axrj axrk axrl axrm axrn axro -axrp axrq axrr axrs axrt axru axrv axrw axrx axry axrz axsa axsb axsc axsd -axse axsf axsg axsh axsi axsj axsk axsl axsm axsn axso axsp axsq axsr axss -axst axsu axsv axsw axsx axsy axsz axta axtb axtc axtd axte axtf axtg axth -axti axtj axtk axtl axtm axtn axto axtp axtq axtr axts axtt axtu axtv axtw -axtx axty axtz axua axub axuc axud axue axuf axug axuh axui axuj axuk axul -axum axun axuo axup axuq axur axus axut axuu axuv axuw axux axuy axuz axva -axvb axvc axvd axve axvf axvg axvh axvi axvj axvk axvl axvm axvn axvo axvp -axvq axvr axvs axvt axvu axvv axvw axvx axvy axvz axwa axwb axwc axwd axwe -axwf axwg axwh axwi axwj axwk axwl axwm axwn axwo axwp axwq axwr axws axwt -axwu axwv axww axwx axwy axwz axxa axxb axxc axxd axxe axxf axxg axxh axxi -axxj axxk axxl axxm axxn axxo axxp axxq axxr axxs axxt axxu axxv axxw axxx -axxy axxz axya axyb axyc axyd axye axyf axyg axyh axyi axyj axyk axyl axym -axyn axyo axyp axyq axyr axys axyt axyu axyv axyw axyx axyy axyz axza axzb -axzc axzd axze axzf axzg axzh axzi axzj axzk axzl axzm axzn axzo axzp axzq -axzr axzs axzt axzu axzv axzw axzx axzy axzz ayaa ayab ayac ayad ayae ayaf -ayag ayah ayai ayaj ayak ayal ayam ayan ayao ayap ayaq ayar ayas ayat ayau -ayav ayaw ayax ayay ayaz ayba aybb aybc aybd aybe aybf aybg aybh aybi aybj -aybk aybl aybm aybn aybo aybp aybq aybr aybs aybt aybu aybv aybw aybx ayby -aybz ayca aycb aycc aycd ayce aycf aycg aych ayci aycj ayck aycl aycm aycn -ayco aycp aycq aycr aycs ayct aycu aycv aycw aycx aycy aycz ayda aydb aydc -aydd ayde aydf aydg aydh aydi aydj aydk aydl aydm aydn aydo aydp aydq aydr -ayds aydt aydu aydv aydw aydx aydy aydz ayea ayeb ayec ayed ayee ayef ayeg -ayeh ayei ayej ayek ayel ayem ayen ayeo ayep ayeq ayer ayes ayet ayeu ayev -ayew ayex ayey ayez ayfa ayfb ayfc ayfd ayfe ayff ayfg ayfh ayfi ayfj ayfk -ayfl ayfm ayfn ayfo ayfp ayfq ayfr ayfs ayft ayfu ayfv ayfw ayfx ayfy ayfz -ayga aygb aygc aygd ayge aygf aygg aygh aygi aygj aygk aygl aygm aygn aygo -aygp aygq aygr aygs aygt aygu aygv aygw aygx aygy aygz ayha ayhb ayhc ayhd -ayhe ayhf ayhg ayhh ayhi ayhj ayhk ayhl ayhm ayhn ayho ayhp ayhq ayhr ayhs -ayht ayhu ayhv ayhw ayhx ayhy ayhz ayia ayib ayic ayid ayie ayif ayig ayih -ayii ayij ayik ayil ayim ayin ayio ayip ayiq ayir ayis ayit ayiu ayiv ayiw -ayix ayiy ayiz ayja ayjb ayjc ayjd ayje ayjf ayjg ayjh ayji ayjj ayjk ayjl -ayjm ayjn ayjo ayjp ayjq ayjr ayjs ayjt ayju ayjv ayjw ayjx ayjy ayjz ayka -aykb aykc aykd ayke aykf aykg aykh ayki aykj aykk aykl aykm aykn ayko aykp -aykq aykr ayks aykt ayku aykv aykw aykx ayky aykz ayla aylb aylc ayld ayle -aylf aylg aylh ayli aylj aylk ayll aylm ayln aylo aylp aylq aylr ayls aylt -aylu aylv aylw aylx ayly aylz ayma aymb aymc aymd ayme aymf aymg aymh aymi -aymj aymk ayml aymm aymn aymo aymp aymq aymr ayms aymt aymu aymv aymw aymx -aymy aymz ayna aynb aync aynd ayne aynf ayng aynh ayni aynj aynk aynl aynm -aynn ayno aynp aynq aynr ayns aynt aynu aynv aynw aynx ayny aynz ayoa ayob -ayoc ayod ayoe ayof ayog ayoh ayoi ayoj ayok ayol ayom ayon ayoo ayop ayoq -ayor ayos ayot ayou ayov ayow ayox ayoy ayoz aypa aypb aypc aypd aype aypf -aypg ayph aypi aypj aypk aypl aypm aypn aypo aypp aypq aypr ayps aypt aypu -aypv aypw aypx aypy aypz ayqa ayqb ayqc ayqd ayqe ayqf ayqg ayqh ayqi ayqj -ayqk ayql ayqm ayqn ayqo ayqp ayqq ayqr ayqs ayqt ayqu ayqv ayqw ayqx ayqy -ayqz ayra ayrb ayrc ayrd ayre ayrf ayrg ayrh ayri ayrj ayrk ayrl ayrm ayrn -ayro ayrp ayrq ayrr ayrs ayrt ayru ayrv ayrw ayrx ayry ayrz aysa aysb aysc -aysd ayse aysf aysg aysh aysi aysj aysk aysl aysm aysn ayso aysp aysq aysr -ayss ayst aysu aysv aysw aysx aysy aysz ayta aytb aytc aytd ayte aytf aytg -ayth ayti aytj aytk aytl aytm aytn ayto aytp aytq aytr ayts aytt aytu aytv -aytw aytx ayty aytz ayua ayub ayuc ayud ayue ayuf ayug ayuh ayui ayuj ayuk -ayul ayum ayun ayuo ayup ayuq ayur ayus ayut ayuu ayuv ayuw ayux ayuy ayuz -ayva ayvb ayvc ayvd ayve ayvf ayvg ayvh ayvi ayvj ayvk ayvl ayvm ayvn ayvo -ayvp ayvq ayvr ayvs ayvt ayvu ayvv ayvw ayvx ayvy ayvz aywa aywb aywc aywd -aywe aywf aywg aywh aywi aywj aywk aywl aywm aywn aywo aywp aywq aywr ayws -aywt aywu aywv ayww aywx aywy aywz ayxa ayxb ayxc ayxd ayxe ayxf ayxg ayxh -ayxi ayxj ayxk ayxl ayxm ayxn ayxo ayxp ayxq ayxr ayxs ayxt ayxu ayxv ayxw -ayxx ayxy ayxz ayya ayyb ayyc ayyd ayye ayyf ayyg ayyh ayyi ayyj ayyk ayyl -ayym ayyn ayyo ayyp ayyq ayyr ayys ayyt ayyu ayyv ayyw ayyx ayyy ayyz ayza -ayzb ayzc ayzd ayze ayzf ayzg ayzh ayzi ayzj ayzk ayzl ayzm ayzn ayzo ayzp -ayzq ayzr ayzs ayzt ayzu ayzv ayzw ayzx ayzy ayzz azaa azab azac azad azae -azaf azag azah azai azaj azak azal azam azan azao azap azaq azar azas azat -azau azav azaw azax azay azaz azba azbb azbc azbd azbe azbf azbg azbh azbi -azbj azbk azbl azbm azbn azbo azbp azbq azbr azbs azbt azbu azbv azbw azbx -azby azbz azca azcb azcc azcd azce azcf azcg azch azci azcj azck azcl azcm -azcn azco azcp azcq azcr azcs azct azcu azcv azcw azcx azcy azcz azda azdb -azdc azdd azde azdf azdg azdh azdi azdj azdk azdl azdm azdn azdo azdp azdq -azdr azds azdt azdu azdv azdw azdx azdy azdz azea azeb azec azed azee azef -azeg azeh azei azej azek azel azem azen azeo azep azeq azer azes azet azeu -azev azew azex azey azez azfa azfb azfc azfd azfe azff azfg azfh azfi azfj -azfk azfl azfm azfn azfo azfp azfq azfr azfs azft azfu azfv azfw azfx azfy -azfz azga azgb azgc azgd azge azgf azgg azgh azgi azgj azgk azgl azgm azgn -azgo azgp azgq azgr azgs azgt azgu azgv azgw azgx azgy azgz azha azhb azhc -azhd azhe azhf azhg azhh azhi azhj azhk azhl azhm azhn azho azhp azhq azhr -azhs azht azhu azhv azhw azhx azhy azhz azia azib azic azid azie azif azig -azih azii azij azik azil azim azin azio azip aziq azir azis azit aziu aziv -aziw azix aziy aziz azja azjb azjc azjd azje azjf azjg azjh azji azjj azjk -azjl azjm azjn azjo azjp azjq azjr azjs azjt azju azjv azjw azjx azjy azjz -azka azkb azkc azkd azke azkf azkg azkh azki azkj azkk azkl azkm azkn azko -azkp azkq azkr azks azkt azku azkv azkw azkx azky azkz azla azlb azlc azld -azle azlf azlg azlh azli azlj azlk azll azlm azln azlo azlp azlq azlr azls -azlt azlu azlv azlw azlx azly azlz azma azmb azmc azmd azme azmf azmg azmh -azmi azmj azmk azml azmm azmn azmo azmp azmq azmr azms azmt azmu azmv azmw -azmx azmy azmz azna aznb aznc aznd azne aznf azng aznh azni aznj aznk aznl -aznm aznn azno aznp aznq aznr azns aznt aznu aznv aznw aznx azny aznz azoa -azob azoc azod azoe azof azog azoh azoi azoj azok azol azom azon azoo azop -azoq azor azos azot azou azov azow azox azoy azoz azpa azpb azpc azpd azpe -azpf azpg azph azpi azpj azpk azpl azpm azpn azpo azpp azpq azpr azps azpt -azpu azpv azpw azpx azpy azpz azqa azqb azqc azqd azqe azqf azqg azqh azqi -azqj azqk azql azqm azqn azqo azqp azqq azqr azqs azqt azqu azqv azqw azqx -azqy azqz azra azrb azrc azrd azre azrf azrg azrh azri azrj azrk azrl azrm -azrn azro azrp azrq azrr azrs azrt azru azrv azrw azrx azry azrz azsa azsb -azsc azsd azse azsf azsg azsh azsi azsj azsk azsl azsm azsn azso azsp azsq -azsr azss azst azsu azsv azsw azsx azsy azsz azta aztb aztc aztd azte aztf -aztg azth azti aztj aztk aztl aztm aztn azto aztp aztq aztr azts aztt aztu -aztv aztw aztx azty aztz azua azub azuc azud azue azuf azug azuh azui azuj -azuk azul azum azun azuo azup azuq azur azus azut azuu azuv azuw azux azuy -azuz azva azvb azvc azvd azve azvf azvg azvh azvi azvj azvk azvl azvm azvn -azvo azvp azvq azvr azvs azvt azvu azvv azvw azvx azvy azvz azwa azwb azwc -azwd azwe azwf azwg azwh azwi azwj azwk azwl azwm azwn azwo azwp azwq azwr -azws azwt azwu azwv azww azwx azwy azwz azxa azxb azxc azxd azxe azxf azxg -azxh azxi azxj azxk azxl azxm azxn azxo azxp azxq azxr azxs azxt azxu azxv -azxw azxx azxy azxz azya azyb azyc azyd azye azyf azyg azyh azyi azyj azyk -azyl azym azyn azyo azyp azyq azyr azys azyt azyu azyv azyw azyx azyy azyz -azza azzb azzc azzd azze azzf azzg azzh azzi azzj azzk azzl azzm azzn azzo -azzp azzq azzr azzs azzt azzu azzv azzw azzx azzy azzz baaa baab baac baad -baae baaf baag baah baai baaj baak baal baam baan baao baap baaq baar baas -baat baau baav baaw baax baay baaz baba babb babc babd babe babf babg babh -babi babj babk babl babm babn babo babp babq babr babs babt babu babv babw -babx baby babz baca bacb bacc bacd bace bacf bacg bach baci bacj back bacl -bacm bacn baco bacp bacq bacr bacs bact bacu bacv bacw bacx bacy bacz bada -badb badc badd bade badf badg badh badi badj badk badl badm badn bado badp -badq badr bads badt badu badv badw badx bady badz baea baeb baec baed baee -baef baeg baeh baei baej baek bael baem baen baeo baep baeq baer baes baet -baeu baev baew baex baey baez bafa bafb bafc bafd bafe baff bafg bafh bafi -bafj bafk bafl bafm bafn bafo bafp bafq bafr bafs baft bafu bafv bafw bafx -bafy bafz baga bagb bagc bagd bage bagf bagg bagh bagi bagj bagk bagl bagm -bagn bago bagp bagq bagr bags bagt bagu bagv bagw bagx bagy bagz baha bahb -bahc bahd bahe bahf bahg bahh bahi bahj bahk bahl bahm bahn baho bahp bahq -bahr bahs baht bahu bahv bahw bahx bahy bahz baia baib baic baid baie baif -baig baih baii baij baik bail baim bain baio baip baiq bair bais bait baiu -baiv baiw baix baiy baiz baja bajb bajc bajd baje bajf bajg bajh baji bajj -bajk bajl bajm bajn bajo bajp bajq bajr bajs bajt baju bajv bajw bajx bajy -bajz baka bakb bakc bakd bake bakf bakg bakh baki bakj bakk bakl bakm bakn -bako bakp bakq bakr baks bakt baku bakv bakw bakx baky bakz bala balb balc -bald bale balf balg balh bali balj balk ball balm baln balo balp balq balr -bals balt balu balv balw balx baly balz bama bamb bamc bamd bame bamf bamg -bamh bami bamj bamk baml bamm bamn bamo bamp bamq bamr bams bamt bamu bamv -bamw bamx bamy bamz bana banb banc band bane banf bang banh bani banj bank -banl banm bann bano banp banq banr bans bant banu banv banw banx bany banz -baoa baob baoc baod baoe baof baog baoh baoi baoj baok baol baom baon baoo -baop baoq baor baos baot baou baov baow baox baoy baoz bapa bapb bapc bapd -bape bapf bapg baph bapi bapj bapk bapl bapm bapn bapo bapp bapq bapr baps -bapt bapu bapv bapw bapx bapy bapz baqa baqb baqc baqd baqe baqf baqg baqh -baqi baqj baqk baql baqm baqn baqo baqp baqq baqr baqs baqt baqu baqv baqw -baqx baqy baqz bara barb barc bard bare barf barg barh bari barj bark barl -barm barn baro barp barq barr bars bart baru barv barw barx bary barz basa -basb basc basd base basf basg bash basi basj bask basl basm basn baso basp -basq basr bass bast basu basv basw basx basy basz bata batb batc batd bate -batf batg bath bati batj batk batl batm batn bato batp batq batr bats batt -batu batv batw batx baty batz baua baub bauc baud baue bauf baug bauh baui -bauj bauk baul baum baun bauo baup bauq baur baus baut bauu bauv bauw baux -bauy bauz bava bavb bavc bavd bave bavf bavg bavh bavi bavj bavk bavl bavm -bavn bavo bavp bavq bavr bavs bavt bavu bavv bavw bavx bavy bavz bawa bawb -bawc bawd bawe bawf bawg bawh bawi bawj bawk bawl bawm bawn bawo bawp bawq -bawr baws bawt bawu bawv baww bawx bawy bawz baxa baxb baxc baxd baxe baxf -baxg baxh baxi baxj baxk baxl baxm baxn baxo baxp baxq baxr baxs baxt baxu -baxv baxw baxx baxy baxz baya bayb bayc bayd baye bayf bayg bayh bayi bayj -bayk bayl baym bayn bayo bayp bayq bayr bays bayt bayu bayv bayw bayx bayy -bayz baza bazb bazc bazd baze bazf bazg bazh bazi bazj bazk bazl bazm bazn -bazo bazp bazq bazr bazs bazt bazu bazv bazw bazx bazy bazz bbaa bbab bbac -bbad bbae bbaf bbag bbah bbai bbaj bbak bbal bbam bban bbao bbap bbaq bbar -bbas bbat bbau bbav bbaw bbax bbay bbaz bbba bbbb diff -Nru ocaml-3.12.1/camlp4/test/fixtures/if.ml ocaml-4.01.0/camlp4/test/fixtures/if.ml --- ocaml-3.12.1/camlp4/test/fixtures/if.ml 2006-06-29 11:29:27.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/if.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,8 +0,0 @@ -let x = if x then a else b in x - -let x = if StringSet.mem "*" sections then a else b in x - -let x = -if StringSet.mem "*" sections then fun _ -> true else - fun x -> StringSet.mem x sections -in x diff -Nru ocaml-3.12.1/camlp4/test/fixtures/label.ml ocaml-4.01.0/camlp4/test/fixtures/label.ml --- ocaml-3.12.1/camlp4/test/fixtures/label.ml 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/label.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -value f ~a:_ ?b:_ = (); diff -Nru ocaml-3.12.1/camlp4/test/fixtures/lambda_free.ml ocaml-4.01.0/camlp4/test/fixtures/lambda_free.ml --- ocaml-3.12.1/camlp4/test/fixtures/lambda_free.ml 2006-07-17 14:05:28.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/lambda_free.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,68 +0,0 @@ -open Format; - -module S = Set.Make String; - -type term = - [ Lambda of string and term - | Atom of string - | App of term and term - | Opt of term and option term and term - ]; - -value free_vars = - let rec fv t env free = - match t with - [ Lambda x t -> fv t (S.add x env) free - | Atom x -> if S.mem x env then free else S.add x free - | App t1 t2 -> fv t1 env (fv t2 env free) - | Opt _ _ _ -> assert False ] - in fun t -> fv t S.empty S.empty; - -value print_set f s = do { - fprintf f "@[<2>{ "; - S.iter (fprintf f "%s@ ") s; - fprintf f "}@]"; -}; - -value t1 = Lambda "x" (App (Lambda "y" (App (Atom "y") (Atom "x"))) (Lambda "x" (Atom "x"))); -value t2 = Lambda "x" (App (Lambda "y" (App (Atom "y") (Atom "x"))) (Lambda "z" (Atom "z"))); -value t3 = Lambda "x" (App (Lambda "y" (App (Atom "y") (Atom "x"))) (Lambda "x" (Atom "z"))); -value t4 = Lambda "a" (App (Lambda "y" (App (Atom "y") (Atom "x"))) (Lambda "x" (Atom "z"))); - -printf "t1: %a@." print_set (free_vars t1); -printf "t2: %a@." print_set (free_vars t2); -printf "t3: %a@." print_set (free_vars t3); -printf "t4: %a@." print_set (free_vars t4); - -class fold ['accu] init = - object (o : 'self_type) - value accu : 'accu = init; - method accu = accu; - method term t = - match t with - [ Lambda x t -> (o#string x)#term t - | Atom x -> o#string x - | App t1 t2 -> (o#term t1)#term t2 - | Opt t1 ot t2 -> ((o#term t1)#option (fun o -> o#term) ot)#term t2 ]; - method string : string -> 'self_type = fun _ -> o; - method option : ! 'a. ('self_type -> 'a -> 'self_type) -> option 'a -> 'self_type = - fun f opt -> - match opt with - [ None -> o - | Some x -> f o x ]; - end; - -class fold_atoms ['accu] f init = - object (o : 'self_type) - inherit fold ['accu] init as super; - method term t = - match t with - [ Atom x -> {< accu = f x accu >} - | _ -> super#term t ]; - end; - -value t5 = Opt (Atom "a") (Some (Atom "b")) (Atom "c"); - -value atoms = ((new fold_atoms S.add S.empty)#term t5)#accu; - -printf "atoms: %a@." print_set atoms; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/loc-bug.ml ocaml-4.01.0/camlp4/test/fixtures/loc-bug.ml --- ocaml-3.12.1/camlp4/test/fixtures/loc-bug.ml 2008-09-19 12:54:10.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/loc-bug.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -#default_quotation "expr";; -Lwt.return - << 3 + >> diff -Nru ocaml-3.12.1/camlp4/test/fixtures/macrotest.ml ocaml-4.01.0/camlp4/test/fixtures/macrotest.ml --- ocaml-3.12.1/camlp4/test/fixtures/macrotest.ml 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/macrotest.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,70 +0,0 @@ -DEFINE A = 42; -DEFINE B = 51; - -IFDEF A THEN - value a_should_be_present = B + 2; - print_int (a_should_be_present + 1); -ENDIF; - -print_int (a_should_be_present + 2); - -IFNDEF C THEN - print_int (a_should_be_present + 3); -ENDIF; - -IFNDEF C THEN - print_int (a_should_be_present + 4); -ELSE - print_int (c_should_not_be_present + 1); -ENDIF; - -IFDEF C THEN - print_int (c_should_not_be_present + 2); -ELSIF - print_int (A * a_should_be_present + 5); -ENDIF; - -IFDEF DNE THEN - print_int (c_should_not_be_present + 2); -ELSIF - print_int (A * a_should_be_present + 5); -ENDIF; - -IFDEF OPT THEN - print_int (c_should_not_be_present + 2); -ELSIF - print_int (A * a_should_be_present + 5); -ENDIF; - -value e = - IFDEF DNE THEN - print_int (c_should_not_be_present + 2) - ELSE - print_int (A * a_should_be_present + 5) - ENDIF; - -value f = - fun _ -> - IFDEF DNE THEN - print_int (c_should_not_be_present + 2) - ELSE - print_int (A * a_should_be_present + 5) - ENDIF; - -IFDEF A THEN - DEFINE Z = "ok"; -ELSE - DEFINE Z = "ko"; -ENDIF; - -Z; - -IFDEF DNE THEN - DEFINE Z = "ko2"; -ELSE - DEFINE Z = "ok2"; -ENDIF; - -Z; - -pouet; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/macrotest.mli ocaml-4.01.0/camlp4/test/fixtures/macrotest.mli --- ocaml-3.12.1/camlp4/test/fixtures/macrotest.mli 2008-09-19 12:54:10.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/macrotest.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,25 +0,0 @@ -DEFINE A; -DEFINE B; - -IFDEF A THEN - value a_should_be_present : int; -ENDIF; - -IFNDEF C THEN - value b_should_be_present : int; -ENDIF; - -IFNDEF C THEN - value c_should_be_present : int; -ELSE - value a_should_NOT_be_present : int; -END; - -IFDEF C THEN - value b_should_NOT_be_present : int; -ELSE - value d_should_be_present : int; - value e_should_be_present : int; -ENDIF; - -value f_should_be_present : int; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/macrotest2.ml ocaml-4.01.0/camlp4/test/fixtures/macrotest2.ml --- ocaml-3.12.1/camlp4/test/fixtures/macrotest2.ml 2008-10-03 14:16:05.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/macrotest2.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -IFNDEF UNDEFINED_VARIABLE THEN - DEFINE SQUARE (x) = x * x ;; - DEFINE DOUBLE_SQUARE (x) = (SQUARE x) * 2 ;; -END;; - -Printf.printf "%d\n" (DOUBLE_SQUARE(42)) ;; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/macrotest3.ml ocaml-4.01.0/camlp4/test/fixtures/macrotest3.ml --- ocaml-3.12.1/camlp4/test/fixtures/macrotest3.ml 2008-10-03 14:16:05.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/macrotest3.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,11 +0,0 @@ -IFNDEF UNDEFINED_VARIABLE THEN - DEFINE UNDEFINED_VARIABLE - - IFDEF UNDEFINED_VARIABLE THEN - DEFINE SQUARE (x) = x * x ;; - DEFINE DOUBLE_SQUARE (x) = (SQUARE x) * 2 ;; - END -END;; - -Printf.printf "%d\n" (DOUBLE_SQUARE(42)) ;; - diff -Nru ocaml-3.12.1/camlp4/test/fixtures/make_extend.ml ocaml-4.01.0/camlp4/test/fixtures/make_extend.ml --- ocaml-3.12.1/camlp4/test/fixtures/make_extend.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/make_extend.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -<:expr< EXTEND G expr: [[ "foo" -> <:expr< foo >> ]]; END >>; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/match.ml ocaml-4.01.0/camlp4/test/fixtures/match.ml --- ocaml-3.12.1/camlp4/test/fixtures/match.ml 2006-06-29 11:29:27.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/match.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,9 +0,0 @@ -let x = - match y with - | A z -> z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z z - | B l -> - (match l with - | [] -> () - | x::xs -> p x; self xs) - | C -> () -in x diff -Nru ocaml-3.12.1/camlp4/test/fixtures/match_parser.ml ocaml-4.01.0/camlp4/test/fixtures/match_parser.ml --- ocaml-3.12.1/camlp4/test/fixtures/match_parser.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/match_parser.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,10 +0,0 @@ -open Camlp4.PreCast; - -let _loc = Loc.ghost in -let e = <:expr< parser [: `"a" :] -> t >> in -let a = - match e with - [ <:expr< parser [: `$str:x$ :] -> t >> -> x - | _ -> assert False ] -in Format.printf "a: %S@." a; - diff -Nru ocaml-3.12.1/camlp4/test/fixtures/meta_multi_term.ml ocaml-4.01.0/camlp4/test/fixtures/meta_multi_term.ml --- ocaml-3.12.1/camlp4/test/fixtures/meta_multi_term.ml 2006-10-04 16:23:53.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/meta_multi_term.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,16 +0,0 @@ -open Camlp4.PreCast; -value _loc = Loc.ghost; - -module Term = struct - type patt = - [ PApp of patt and patt - | PAny - | PVar of string - | POlb of string and expr ] - and expr = - [ EApp of expr and expr - | EVar of string - | ELam of patt and expr ]; -end; - -module MetaTerm = MetaGenerator Term; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/metalib.ml ocaml-4.01.0/camlp4/test/fixtures/metalib.ml --- ocaml-3.12.1/camlp4/test/fixtures/metalib.ml 2008-09-19 12:56:26.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/metalib.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,5 +0,0 @@ -#load "camlp4of.cma";; -open Camlp4.PreCast;; -module M = Ast.Meta.Make(Ast.Meta.MetaGhostLoc);; -let ghost = Loc.ghost;; -M.Expr.meta_ctyp ghost <:ctyp@ghost< int >>;; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/method_private_virtual.ml ocaml-4.01.0/camlp4/test/fixtures/method_private_virtual.ml --- ocaml-3.12.1/camlp4/test/fixtures/method_private_virtual.ml 2008-09-19 12:54:10.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/method_private_virtual.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,9 +0,0 @@ -class virtual c1 = object method virtual private f : unit end;; -class virtual c2 = object method private virtual f : unit end;; - -<:str_item< class virtual c1 = object method virtual private f : unit; end >>;; -<:str_item< class virtual c2 = object method private virtual f : unit; end >>;; -<:str_item< class virtual c2 = object method $private:p$ virtual f : unit; end >>;; -<:str_item< class virtual c2 = object method virtual $private:p$ f : unit; end >>;; -<:str_item< class $virtual:v$ c2 [$t1$] = - object ($pat:self$) method virtual $private:p$ $lid:f$ : $t2$; end >>;; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/mod.ml ocaml-4.01.0/camlp4/test/fixtures/mod.ml --- ocaml-3.12.1/camlp4/test/fixtures/mod.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/mod.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,15 +0,0 @@ -module type S = sig type t end -module F (A : S) = struct - type t2 = A.t - module A = A -end - -module A = struct type t = int end - -module type S3 = sig - module M : S -end - -module type S2 = S with type t = F(A).t2 - -module type S4 = S3 with module M = F(A).A diff -Nru ocaml-3.12.1/camlp4/test/fixtures/mod2.ml ocaml-4.01.0/camlp4/test/fixtures/mod2.ml --- ocaml-3.12.1/camlp4/test/fixtures/mod2.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/mod2.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,8 +0,0 @@ -module type S = sig type t = 'a; end; -module F (A : S) = struct - type t2 = A.t; -end; - -module A = struct type t = int; end; - -module type S2 = S with type t = (F A).t2; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/operators.ml ocaml-4.01.0/camlp4/test/fixtures/operators.ml --- ocaml-3.12.1/camlp4/test/fixtures/operators.ml 2007-11-27 13:29:57.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/operators.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,7 +0,0 @@ -let _ : int = 42 -let (+) = M.(+) -let (+) = M.(+) in 42 -let (+) : int -> int -> int = (+) -let (+) : int -> int -> int = (+) in 42 -let None = None -let None : int option = None diff -Nru ocaml-3.12.1/camlp4/test/fixtures/operators.mli ocaml-4.01.0/camlp4/test/fixtures/operators.mli --- ocaml-3.12.1/camlp4/test/fixtures/operators.mli 2007-11-27 13:29:57.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/operators.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -val (+) : int -> int -> int diff -Nru ocaml-3.12.1/camlp4/test/fixtures/original_syntax.ml ocaml-4.01.0/camlp4/test/fixtures/original_syntax.ml --- ocaml-3.12.1/camlp4/test/fixtures/original_syntax.ml 2007-11-27 14:33:31.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/original_syntax.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,17 +0,0 @@ -fun x when x <> 0 -> x / 42 -;; -object val virtual mutable x : int val mutable virtual y : int end -;; -- !r -;; -! -r -;; --32 -;; -- - 32 -;; -!(r.b) -;; -(!r).b = !r.b -;; -let l : (unit -> int) list = [(fun _ -> 42); (fun _ -> 42)] diff -Nru ocaml-3.12.1/camlp4/test/fixtures/outside-scope.ml ocaml-4.01.0/camlp4/test/fixtures/outside-scope.ml --- ocaml-3.12.1/camlp4/test/fixtures/outside-scope.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/outside-scope.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,21 +0,0 @@ -type t 'a = [ Nil | Cons of 'a and t 'a ]; - -module A : sig - value app_hd : t 'a -> ('a -> 'a) -> option 'a; -end = struct - value app_hd x f = - match x with - [ Nil -> None - | Cons x _ -> Some (f x) ]; -end; -open A; - -module M = struct - external mk_nil : unit -> t 'a = "%identity"; - value nil = mk_nil (); - (* value is_nil x = x = nil; *) -end; - -(* M.app_hd succ (M.Cons 1 M.Nil); *) -(* M.hd (M.Cons 1 M.Nil); *) -app_hd (M.nil : t 'a) (fun (x : int) -> (x : 'a)); diff -Nru ocaml-3.12.1/camlp4/test/fixtures/parser.ml ocaml-4.01.0/camlp4/test/fixtures/parser.ml --- ocaml-3.12.1/camlp4/test/fixtures/parser.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/parser.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,61 +0,0 @@ -open Camlp4.PreCast; -type t = [ A of t and t | B of string ]; -value lex = Lexer.mk (); - - (* value list0 symb = - let rec loop al = - parser - [ [: a = symb; s :] -> loop [a :: al] s - | [: :] -> al ] - in - parser [: a = loop [] :] -> List.rev a - ; - value list0sep symb sep = - let rec kont al = - parser - [ [: v = sep; a = symb; s :] -> kont [a :: al] s - | [: :] -> al ] - in - parser - [ [: a = symb; s :] -> List.rev (kont [a] s) - | [: :] -> [] ] - ; - value list1 symb = - let rec loop al = - parser - [ [: a = symb; s :] -> loop [a :: al] s - | [: :] -> al ] - in - parser [: a = symb; s :] -> List.rev (loop [a] s) - ; - value list1sep symb sep = - let rec kont al = - parser - [ [: v = sep; a = symb; s :] -> kont [a :: al] s - | [: :] -> al ] - in - parser [: a = symb; s :] -> List.rev (kont [a] s) - ; *) - -value list1 = - let rec self stream acc = - match stream with parser - [ [: `(EOI, _) :] -> acc - | [: `(LIDENT x, _); xs :] -> self xs (A acc (B x)) - | [: `(BLANKS _ | NEWLINE, _); xs :] -> self xs acc ] - in - parser [: `(LIDENT x, _); xs :] -> self xs (B x); -value rec length x acc = - match x with - [ A x y -> length x (length y acc) - | B _ -> succ acc ]; -(* value length _ _ = -1; *) -open Format; -try - let f = Sys.argv.(1) in - let () = printf "parsing...@." in - let a = list1 (lex (Loc.mk f) (Stream.of_channel (open_in f))) in - let () = printf "counting...@." in - let n = length a 0 in - printf "%d@." n -with e -> eprintf "error: %a@." Camlp4.ErrorHandler.print e; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/pp_let_in.ml ocaml-4.01.0/camlp4/test/fixtures/pp_let_in.ml --- ocaml-3.12.1/camlp4/test/fixtures/pp_let_in.ml 2006-07-17 14:05:28.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/pp_let_in.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,10 +0,0 @@ -let i = "toto" in do { (let i = 42 in print_int i); print_string i }; -let i = "toto" in do { print_string i; let i = 42 in print_int i; print_int i }; -let i = "toto" in do { - (let i = 42 in print_int i); - let i = i ^ i; - let i = i ^ i; - print_string i; - print_string i; - let i = i ^ i; - print_string i }; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/pp_let_in2.ml ocaml-4.01.0/camlp4/test/fixtures/pp_let_in2.ml --- ocaml-3.12.1/camlp4/test/fixtures/pp_let_in2.ml 2006-07-17 14:05:28.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/pp_let_in2.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -let i = "toto" in ((let i = 42 in print_int i); print_string i) diff -Nru ocaml-3.12.1/camlp4/test/fixtures/pp_xml.ml ocaml-4.01.0/camlp4/test/fixtures/pp_xml.ml --- ocaml-3.12.1/camlp4/test/fixtures/pp_xml.ml 2006-07-17 14:05:28.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/pp_xml.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,31 +0,0 @@ - -type xml = Elt of string * xml list | Pcdata of string - -let pp = Format.fprintf - -let rec print_elt f = - function - | Elt (tag, contents) -> - pp f "@[@[<%s>@,%a@]@,@]" - tag print_list_elts contents tag - | Pcdata s -> - Format.pp_print_string f s - -and print_list_elts f = - let rec loop = - function - | [] -> () - | x::xs -> (pp f "@,"; print_elt f x; loop xs) in - function - | [] -> () - | [x] -> print_elt f x - | x::xs -> (print_elt f x; loop xs) - -let tree = - Elt ("div", [ - Elt ("p", [Pcdata "a short text"]); - Elt ("p", [Pcdata "a looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong text"]) - ]) - -let () = Format.printf "%a@." print_elt tree - diff -Nru ocaml-3.12.1/camlp4/test/fixtures/pprecordtyp.ml ocaml-4.01.0/camlp4/test/fixtures/pprecordtyp.ml --- ocaml-3.12.1/camlp4/test/fixtures/pprecordtyp.ml 2008-09-19 12:50:41.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/pprecordtyp.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,26 +0,0 @@ -open Camlp4.PreCast - -let _loc = Loc.mk "?" - -let base base fields ty = - let fields = List.fold_right (fun field acc -> - let c = <:ctyp< $lid:field$ : $uid:field$.record >> in - <:ctyp< $c$ ; $acc$ >>) fields <:ctyp< >> - in - <:module_binding< $uid:base$ : - sig type record = { - key : $ty$; - $fields$ - } end = struct - type record = { - key : $ty$; - $fields$ - } end - >> - -module CleanAst = Camlp4.Struct.CleanAst.Make(Ast) -let _ = - let b = base "b" ["f1"; "f2"] <:ctyp< int >> in - Camlp4.PreCast.Printers.OCaml.print_implem - ((new CleanAst.clean_ast)#str_item - <:str_item< module rec $b$ >>) diff -Nru ocaml-3.12.1/camlp4/test/fixtures/pr4314.ml ocaml-4.01.0/camlp4/test/fixtures/pr4314.ml --- ocaml-3.12.1/camlp4/test/fixtures/pr4314.ml 2008-09-19 12:50:41.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/pr4314.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -(int_of_string "1" : unit); diff -Nru ocaml-3.12.1/camlp4/test/fixtures/pr4314gram1.ml ocaml-4.01.0/camlp4/test/fixtures/pr4314gram1.ml --- ocaml-3.12.1/camlp4/test/fixtures/pr4314gram1.ml 2008-09-19 12:50:41.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/pr4314gram1.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,36 +0,0 @@ -open Camlp4.PreCast ; -module G = Camlp4.PreCast.Gram ; - -value exp = G.Entry.mk "exp" ; -value prog = G.Entry.mk "prog" ; - -EXTEND G -exp: -[ "apply" - [ e1 = SELF; e2 = SELF -> - let p = Loc.dump in - let () = - Format.eprintf "e1: %a,@.e2: %a,@.e1-e2: %a,@._loc: %a@." - p e1 p e2 p (Loc.merge e1 e2) p _loc - in - _loc - ] -| "simple" - [ _ = LIDENT -> _loc ] -]; -prog: [[ e = exp; `EOI -> e ]]; -END ; - -(* and the following function: *) - -value parse_string entry s = -try - G.parse_string entry (Loc.mk "") s -with [ Loc.Exc_located loc exn -> -begin - print_endline (Loc.to_string loc); - print_endline (Printexc.to_string exn); - failwith "Syntax Error" -end ] ; - -parse_string prog "f x"; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/pr4314gram2.ml ocaml-4.01.0/camlp4/test/fixtures/pr4314gram2.ml --- ocaml-3.12.1/camlp4/test/fixtures/pr4314gram2.ml 2008-09-19 12:50:41.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/pr4314gram2.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,36 +0,0 @@ -open Camlp4.PreCast ; -module G = Camlp4.PreCast.Gram ; - -value exp = G.Entry.mk "exp" ; -value prog = G.Entry.mk "prog" ; - -EXTEND G -exp: -[ "apply" - [ e1 = exp LEVEL "simple"; e2 = SELF -> - let p = Loc.dump in - let () = - Format.eprintf "e1: %a,@.e2: %a,@.e1-e2: %a,@._loc: %a@." - p e1 p e2 p (Loc.merge e1 e2) p _loc - in - _loc - ] -| "simple" - [ _ = LIDENT -> _loc ] -]; -prog: [[ e = exp; `EOI -> e ]]; -END ; - -(* and the following function: *) - -value parse_string entry s = -try - G.parse_string entry (Loc.mk "") s -with [ Loc.Exc_located loc exn -> -begin - print_endline (Loc.to_string loc); - print_endline (Printexc.to_string exn); - failwith "Syntax Error" -end ] ; - -parse_string prog "f x"; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/pr4314gram3.ml ocaml-4.01.0/camlp4/test/fixtures/pr4314gram3.ml --- ocaml-3.12.1/camlp4/test/fixtures/pr4314gram3.ml 2008-09-19 12:50:41.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/pr4314gram3.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,36 +0,0 @@ -open Camlp4.PreCast ; -module G = Camlp4.PreCast.Gram ; - -value exp = G.Entry.mk "exp" ; -value prog = G.Entry.mk "prog" ; - -EXTEND G -exp: -[ "apply" - [ e1 = SELF; e2 = exp LEVEL "simple" -> - let p = Loc.dump in - let () = - Format.eprintf "e1: %a,@.e2: %a,@.e1-e2: %a,@._loc: %a@." - p e1 p e2 p (Loc.merge e1 e2) p _loc - in - _loc - ] -| "simple" - [ _ = LIDENT -> _loc ] -]; -prog: [[ e = exp; `EOI -> e ]]; -END ; - -(* and the following function: *) - -value parse_string entry s = -try - G.parse_string entry (Loc.mk "") s -with [ Loc.Exc_located loc exn -> -begin - print_endline (Loc.to_string loc); - print_endline (Printexc.to_string exn); - failwith "Syntax Error" -end ] ; - -parse_string prog "f x"; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/pr4314gram4.ml ocaml-4.01.0/camlp4/test/fixtures/pr4314gram4.ml --- ocaml-3.12.1/camlp4/test/fixtures/pr4314gram4.ml 2008-09-19 12:50:41.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/pr4314gram4.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,36 +0,0 @@ -open Camlp4.PreCast ; -module G = Camlp4.PreCast.Gram ; - -value exp = G.Entry.mk "exp" ; -value prog = G.Entry.mk "prog" ; - -EXTEND G -exp: -[ "apply" - [ e1 = SELF; e2 = exp LEVEL "simple"; e3 = exp LEVEL "simple" -> - let p = Loc.dump in - let () = - Format.eprintf "e1: %a,@.e2: %a,@.e3: %a,@._loc: %a@." - p e1 p e2 p e3 p _loc - in - _loc - ] -| "simple" - [ _ = LIDENT -> _loc ] -]; -prog: [[ e = exp; `EOI -> e ]]; -END ; - -(* and the following function: *) - -value parse_string entry s = -try - G.parse_string entry (Loc.mk "") s -with [ Loc.Exc_located loc exn -> -begin - print_endline (Loc.to_string loc); - print_endline (Printexc.to_string exn); - failwith "Syntax Error" -end ] ; - -parse_string prog "f x y"; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/pr4314gram5.ml ocaml-4.01.0/camlp4/test/fixtures/pr4314gram5.ml --- ocaml-3.12.1/camlp4/test/fixtures/pr4314gram5.ml 2008-09-19 12:50:41.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/pr4314gram5.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,38 +0,0 @@ -open Camlp4.PreCast ; -module G = Camlp4.PreCast.Gram ; - -value exp = G.Entry.mk "exp" ; -value prog = G.Entry.mk "prog" ; - -EXTEND G -exp: -[ "apply" -[ e1 = SELF; e2 = exp LEVEL "simple"; e3 = SELF -> - let p = Loc.dump in - let () = - Format.eprintf "e1: %a,@.e2: %a,@.e3: %a,@._loc: %a@." - p e1 p e2 p e3 p _loc - in - _loc - ] -| "simple" -[ x = LIDENT; y = LIDENT -> - let () = Format.eprintf "reduce expr simple (%S, %S) at %a@." x y Loc.dump _loc in _loc ] -]; -prog: [[ e = exp; `EOI -> e ]]; -END ; - -(* and the following function: *) - -value parse_string entry s = -try - print_endline s; - G.parse_string entry (Loc.mk "") s -with [ Loc.Exc_located loc exn -> -begin - print_endline (Loc.to_string loc); - print_endline (Printexc.to_string exn); - failwith "Syntax Error" -end ] ; - -parse_string prog "f1 f2 x1 x2 y1 y2"; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/pr4329.ml ocaml-4.01.0/camlp4/test/fixtures/pr4329.ml --- ocaml-3.12.1/camlp4/test/fixtures/pr4329.ml 2008-09-19 12:50:41.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/pr4329.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,50 +0,0 @@ -open Camlp4.PreCast ; -module G = Camlp4.PreCast.Gram; - -value ab_eoi = G.Entry.mk "ab_eoi" ; -value a_or_ab = G.Entry.mk "a_or_ab" ; -value a_or_ab_eoi = G.Entry.mk "a_or_ab_eoi" ; -value c_a_or_ab_eoi = G.Entry.mk "c_a_or_ab_eoi" ; - -EXTEND G -ab_eoi: [[ "a"; "b"; `EOI -> () ]]; -a_or_ab: [[ "a" -> () | "a"; "b" -> () ]]; -a_or_ab_eoi: [[ a_or_ab; `EOI -> () ]]; -c_a_or_ab_eoi: [[ "c"; a_or_ab; `EOI -> () ]]; -END ; - -value parse_string entry s = -try - G.parse_string entry (Loc.mk "") s -with [ Loc.Exc_located loc exn -> -begin - print_endline (Loc.to_string loc); - print_endline (Printexc.to_string exn); - (* failwith "Syntax Error" *) -end ] ; - -(* Consider the following syntax errors: *) -parse_string ab_eoi "a c" ; -(* File "", line 1, characters 2-3 -Stream.Error("illegal begin of ab_eoi") -Exception: Failure "Syntax Error". ---> "Illegal begin": at least the first symbol was correct ---> nevertheless, the reported position is correct ---> The message used to be: "b" then EOI expected after "a" in [ab_eoi] *) - -parse_string a_or_ab_eoi "a c" ; -(* File "", line 1, characters 0-1 -Stream.Error("illegal begin of a_or_ab_eoi") -Exception: Failure "Syntax Error". ---> "Illegal begin": at least the first non-terminal was correct ---> the reported position is weird ---> I think the message used to be either: "b" expected after "a" in -[a_or_ab] -or: EOI expected after [a_or_ab] in [a_or_ab_eoi] *) - -parse_string c_a_or_ab_eoi "c a c" ; -(* File "", line 1, characters 2-3 -Stream.Error("[a_or_ab] expected after \"c\" (in [c_a_or_ab_eoi])") -Exception: Failure "Syntax Error". ---> "[a_or_ab] expected": this is very confusing: there is a valid a_or_ab -there, namely "a" *) diff -Nru ocaml-3.12.1/camlp4/test/fixtures/pr4330.ml ocaml-4.01.0/camlp4/test/fixtures/pr4330.ml --- ocaml-3.12.1/camlp4/test/fixtures/pr4330.ml 2008-10-03 15:18:22.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/pr4330.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,57 +0,0 @@ -open Camlp4.PreCast ; -module G = Camlp4.PreCast.Gram ; - -value a = G.Entry.mk "a" ; -value a_eoi = G.Entry.mk "a_eoi" ; - -EXTEND G -a: [[ "one" -> 1 | x = a; "plus"; y = a -> x+y ]]; -a_eoi: [[ x = a; `EOI -> x ]]; -END ; - -(* and the following function: *) - -value parse_string entry s o = -try - Printf.eprintf "Parsing %S\n%!" s; - assert (o = Some (G.parse_string entry (Loc.mk "") s)) -with [ Loc.Exc_located loc exn when o <> None -> -begin - print_endline (Loc.to_string loc); - print_endline (Printexc.to_string exn); - assert (o = None) -end -| exn when o = None -> Printf.eprintf "Fail as expected\n%!" -| exn -> begin - Printf.eprintf "Unexpected exception: \n%!"; - print_endline (Printexc.to_string exn); - assert (o = None) -end ] ; - -(* The following is correct: *) - -parse_string a_eoi "one plus one" (Some 2); - -(* While all of the following inputs should be rejected because they are not *) -(* legal according to the grammar: *) - -parse_string a_eoi "one plus" None; -(* - : int = 1 *) -parse_string a_eoi "one plus plus" None; -(* - : int = 1 *) -parse_string a_eoi "one plus one plus" None; -(* - : int = 2 *) -parse_string a_eoi "one plus one plus plus" None; -(* - : int = 2 *) - -(* Curiously, you may only repeat the operator twice. If you specify it three -times, gramlib complains. *) - -parse_string a_eoi "one plus plus plus" None ; -(* File "", line 1, characters 9-13 *) -(* Stream.Error("EOI expected after [a] (in [a_eoi])") *) -(* Exception: Failure "Syntax Error". *) -parse_string a_eoi "one plus one plus plus plus" None ; -(* File "", line 1, characters 18-22 *) -(* Stream.Error("EOI expected after [a] (in [a_eoi])") *) -(* Exception: Failure "Syntax Error". *) diff -Nru ocaml-3.12.1/camlp4/test/fixtures/pr4357.ml ocaml-4.01.0/camlp4/test/fixtures/pr4357.ml --- ocaml-3.12.1/camlp4/test/fixtures/pr4357.ml 2007-11-27 14:38:21.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/pr4357.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,16 +0,0 @@ -open Camlp4.PreCast - -let sample_expr _loc _loc_name s = - Printf.eprintf "file=%s line=%d offset=%d bol=%d\n%!" - (Loc.file_name _loc) - (Loc.start_line _loc) - (Loc.start_off _loc) - (Loc.start_bol _loc); - <:expr< $lid:s$ >> -;; - -Quotation.add - "sample" - Syntax.Quotation.DynAst.expr_tag - sample_expr -;; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/pr4357sample.ml ocaml-4.01.0/camlp4/test/fixtures/pr4357sample.ml --- ocaml-3.12.1/camlp4/test/fixtures/pr4357sample.ml 2007-11-27 14:38:21.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/pr4357sample.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -let u = "Hello";; -let s = <:sample>;; -print_string s diff -Nru ocaml-3.12.1/camlp4/test/fixtures/pr4357sample2.ml ocaml-4.01.0/camlp4/test/fixtures/pr4357sample2.ml --- ocaml-3.12.1/camlp4/test/fixtures/pr4357sample2.ml 2007-11-27 14:38:21.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/pr4357sample2.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,5 +0,0 @@ -#default_quotation "sample";; -let u = "Hello";; -let s = <>;; -let s = <:sample>;; -print_string s diff -Nru ocaml-3.12.1/camlp4/test/fixtures/pr4452.ml ocaml-4.01.0/camlp4/test/fixtures/pr4452.ml --- ocaml-3.12.1/camlp4/test/fixtures/pr4452.ml 2008-09-19 12:56:26.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/pr4452.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,24 +0,0 @@ -open Camlp4.PreCast - -let _loc = Loc.mk "?" - -let base base fields ty = - let fields = List.fold_right (fun field acc -> - let c = <:ctyp< $lid:field$ : $uid:field$.record >> in - <:ctyp< $c$ ; $acc$ >>) fields <:ctyp< >> - in - <:module_binding< $uid:base$ : - sig type record = { - key : $ty$; - $fields$ - } end = struct - type record = { - key : $ty$; - $fields$ - } end - >> - -let _ = - let b = base "b" ["f1"; "f2"] <:ctyp< int >> in - Camlp4.PreCast.Printers.OCaml.print_implem - <:str_item< module rec $b$ >> diff -Nru ocaml-3.12.1/camlp4/test/fixtures/private_row.ml ocaml-4.01.0/camlp4/test/fixtures/private_row.ml --- ocaml-3.12.1/camlp4/test/fixtures/private_row.ml 2006-09-26 09:03:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/private_row.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,27 +0,0 @@ - - -module type Ops = sig - type expr - val eval : expr -> int - end - ;; - - -module Plus = struct - type 'a expr0 = [`Num of int | `Plus of 'a * 'a ] - module F(X : Ops with type expr = private ([> 'a expr0] as 'a)) = - struct - type expr = X.expr expr0 - let eval : expr -> int = function - `Num n -> n - |`Plus(e1,e2) -> X.eval e1 + X.eval e2 - end - module rec L : (Ops with type expr = L.expr expr0) = F(L) - end - ;; - - -open Printf -;; - -let _ = Printf.printf "%d\n%!" (Plus.L.eval (`Plus ((`Num 5),(`Num 2))));; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/rec.ml ocaml-4.01.0/camlp4/test/fixtures/rec.ml --- ocaml-3.12.1/camlp4/test/fixtures/rec.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/rec.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -(* rec.ml *) -value rec x = 42; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/seq.ml ocaml-4.01.0/camlp4/test/fixtures/seq.ml --- ocaml-3.12.1/camlp4/test/fixtures/seq.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/seq.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,1003 +0,0 @@ -module M = struct - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; -end; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/seq2.ml ocaml-4.01.0/camlp4/test/fixtures/seq2.ml --- ocaml-3.12.1/camlp4/test/fixtures/seq2.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/seq2.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,3003 +0,0 @@ -module M = struct - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; - foo bar; -end; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/simplify.ml ocaml-4.01.0/camlp4/test/fixtures/simplify.ml --- ocaml-3.12.1/camlp4/test/fixtures/simplify.ml 2007-11-21 17:49:56.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/simplify.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,11 +0,0 @@ -open Camlp4.PreCast - -let simplify = - object - inherit Ast.map as super - method expr e = - match super#expr e with - | <:expr< $x$ + 0 >> | <:expr< 0 + $x$ >> -> x - | x -> x - end -in AstFilters.register_str_item_filter simplify#str_item diff -Nru ocaml-3.12.1/camlp4/test/fixtures/simplify_r.ml ocaml-4.01.0/camlp4/test/fixtures/simplify_r.ml --- ocaml-3.12.1/camlp4/test/fixtures/simplify_r.ml 2007-11-21 17:49:56.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/simplify_r.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,11 +0,0 @@ -open Camlp4.PreCast; - -let simplify = - object - inherit Ast.map as super; - method expr e = - match super#expr e with - [ <:expr< $x$ + 0 >> | <:expr< 0 + $x$ >> -> x - | x -> x ]; - end -in AstFilters.register_str_item_filter simplify#str_item; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/stream-parser-bug.ml ocaml-4.01.0/camlp4/test/fixtures/stream-parser-bug.ml --- ocaml-3.12.1/camlp4/test/fixtures/stream-parser-bug.ml 2008-09-19 12:54:10.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/stream-parser-bug.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -let foo = parser - | [< '42; ps >] -> - let ps = ps + 42 in - type_phrases ps - | [< >] -> [< >] - diff -Nru ocaml-3.12.1/camlp4/test/fixtures/string.ml ocaml-4.01.0/camlp4/test/fixtures/string.ml --- ocaml-3.12.1/camlp4/test/fixtures/string.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/string.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -"abc"; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/superfluous.ml ocaml-4.01.0/camlp4/test/fixtures/superfluous.ml --- ocaml-3.12.1/camlp4/test/fixtures/superfluous.ml 2008-09-19 12:54:10.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/superfluous.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,12 +0,0 @@ -open Camlp4.PreCast;; -open Syntax;; - -let _loc = Loc.ghost;; -let st = <:str_item< >>;; -let e = <:expr< 1 >> -let bi = <:binding< x = 0 >>;; - -(* none of these holds due to superfluous StSem and StNil *) -assert (Ast.StSem (_loc, st, st) = <:str_item< $st$ $st$ >>);; -assert (Ast.StExp (_loc, e) = <:str_item< $exp:e$ >>);; -assert (Ast.StVal (_loc, bi) = <:str_item< let $bi$ >>);; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/transform-examples.ml ocaml-4.01.0/camlp4/test/fixtures/transform-examples.ml --- ocaml-3.12.1/camlp4/test/fixtures/transform-examples.ml 2006-07-17 14:05:28.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/transform-examples.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -<:expr< $x$ + $y$ - $z$ >> -> <:expr< plus_minus $x$ $y$ $z$ >> - -<< List.rev (List.rev $l$) >> -> l diff -Nru ocaml-3.12.1/camlp4/test/fixtures/try.ml ocaml-4.01.0/camlp4/test/fixtures/try.ml --- ocaml-3.12.1/camlp4/test/fixtures/try.ml 2006-06-29 11:29:27.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/try.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -try - let f = Sys.getenv "CAMLP4_DEBUG_FILE" - in - foo bar foo bar foo bar foo bar foo bar foo bar foo bar foo bar foo bar foo bar foo bar foo bar -with Not_found -> stderr - diff -Nru ocaml-3.12.1/camlp4/test/fixtures/tuple_as_retval.ml ocaml-4.01.0/camlp4/test/fixtures/tuple_as_retval.ml --- ocaml-3.12.1/camlp4/test/fixtures/tuple_as_retval.ml 2006-09-26 09:03:34.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/tuple_as_retval.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -EXTEND Gram - abc: [ [ (x,y) = foo -> x+y ] ]; -END; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/type.ml ocaml-4.01.0/camlp4/test/fixtures/type.ml --- ocaml-3.12.1/camlp4/test/fixtures/type.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/type.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -type t = [ A of int | B of t ]; -type t2 = [ A of int | B of t ]; -type t3 = [ A of int | B of t ]; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/type_decl.ml ocaml-4.01.0/camlp4/test/fixtures/type_decl.ml --- ocaml-3.12.1/camlp4/test/fixtures/type_decl.ml 2006-06-29 11:29:27.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/type_decl.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,22 +0,0 @@ -module M = struct - type t = A of int * int * int * int * int * int * int * int * int * int - | B | B | B | B | B | B | B | B - and t2 = - | B | B | B | B | B | B | B | B - and t3 = - | B | B | B of a * a * a * a * a * a * a * a * a * a * a | B | B | B | B | B - and t4 = - | B | B | B | B | B | B | B | B - and t5 = - | B | B | B | B | B | B | B | B - and t6 = - | B | B | B | A of int * int * int * int * int * int * int * int * int * int * int * int * int * int * int * int * int * int * int | B | B | B | B | B - and t7 = - | B | B | B | B | B | B | B | B - and t8 = - | B | B | B | B | B | B | B | B - and t9 = - | B | B | B | B | B | B | B | B - and t10 = - | A of (a * a) -end diff -Nru ocaml-3.12.1/camlp4/test/fixtures/unit.ml ocaml-4.01.0/camlp4/test/fixtures/unit.ml --- ocaml-3.12.1/camlp4/test/fixtures/unit.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/unit.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,4 +0,0 @@ -type t1 = ();; -type t2 = unit;; -let x : t1 = ();; -let y : t2 = ();; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/use.ml ocaml-4.01.0/camlp4/test/fixtures/use.ml --- ocaml-3.12.1/camlp4/test/fixtures/use.ml 2006-06-29 21:55:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/use.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,4 +0,0 @@ -(* use.ml *) -#use "test/fixtures/rec.ml"; -(* value use *) -value use = 3; diff -Nru ocaml-3.12.1/camlp4/test/fixtures/where.o.ml ocaml-4.01.0/camlp4/test/fixtures/where.o.ml --- ocaml-3.12.1/camlp4/test/fixtures/where.o.ml 2006-07-17 14:05:28.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/where.o.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -let where = 42 diff -Nru ocaml-3.12.1/camlp4/test/fixtures/where.r.ml ocaml-4.01.0/camlp4/test/fixtures/where.r.ml --- ocaml-3.12.1/camlp4/test/fixtures/where.r.ml 2006-07-17 14:05:28.000000000 +0000 +++ ocaml-4.01.0/camlp4/test/fixtures/where.r.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -x where x = 42; diff -Nru ocaml-3.12.1/camlp4/unmaintained/Makefile ocaml-4.01.0/camlp4/unmaintained/Makefile --- ocaml-3.12.1/camlp4/unmaintained/Makefile 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/Makefile 1970-01-01 00:00:00.000000000 +0000 @@ -1,20 +0,0 @@ -######################################################################### -# # -# Objective Caml # -# # -# Camlp4 # -# # -# Copyright 2004 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### -# -# The unmaintained directory -# - -include ../config/Makefile.cnf - -DIRS=format lefteval ocamllex olabl scheme sml - -include ../config/Makefile.base diff -Nru ocaml-3.12.1/camlp4/unmaintained/compile/.cvsignore ocaml-4.01.0/camlp4/unmaintained/compile/.cvsignore --- ocaml-3.12.1/camlp4/unmaintained/compile/.cvsignore 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/compile/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,4 +0,0 @@ -*.fast -*.fast.opt -o_fast.ml -pa_o_fast.ml diff -Nru ocaml-3.12.1/camlp4/unmaintained/compile/Makefile ocaml-4.01.0/camlp4/unmaintained/compile/Makefile --- ocaml-3.12.1/camlp4/unmaintained/compile/Makefile 2008-10-27 14:03:31.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/compile/Makefile 1970-01-01 00:00:00.000000000 +0000 @@ -1,37 +0,0 @@ - - -include ../config/Makefile.cnf - -INCLUDES=-I ../camlp4 -I ../lib -SRC=../etc/pa_o.ml ../etc/pa_op.ml # FIXME and why not pa_$D.ml? -D=o -COMP_OPT=-strict_parsing -e "Grammar.Entry.obj Pcaml.interf" -e "Grammar.Entry.obj Pcaml.implem" -e "Grammar.Entry.obj Pcaml.top_phrase" -e "Grammar.Entry.obj Pcaml.use_file" -CLEANFILES=pa_*_fast.ml *_fast.ml - -# FIXME -EXECUTABLES=#camlp4$D.fast - -include ../config/Makefile.base - -WARNINGS=Ay - -camlp4$D.fast: pa_$D_fast.cmo - rm -f camlp4$D.fast - cd ../camlp4; $(MAKE) CAMLP4=../compile/camlp4$D.fast CAMLP4M="../compile/pa_$D_fast.cmo ../meta/pr_dump.cmo" - -camlp4$D.fast.opt: pa_$D_fast.cmx - rm -f camlp4$D.fast.opt - cd ../camlp4; $(MAKE) ../compile/camlp4$D.fast.opt CAMLP4OPT=../compile/camlp4$D.fast.opt CAMLP4M="../compile/pa_$D_fast.cmx ../meta/pr_dump.cmx" - -pa_$D_fast.ml: comp_head.ml $D_fast.ml comp_trail.ml - cat $(SRC) | sed -e "s/Plexer.make_lexer *()/P.lexer_pos/" -e "/EXTEND/,/END/d" -e "/Grammar.Entry.of_parser/d" -e "/Grammar.Entry.gcreate/d" | cat comp_head.ml - $D_fast.ml comp_trail.ml > pa_$D_fast.ml - -$D_fast.ml: compile.cmo $(SRC) - echo '(* camlp4r *)' >$D_fast.ml - OTOP=$(OTOP) EXE=$(EXE) ./compile.sh $(COMP_OPT) $(SRC) >> $D_fast.ml - -install-local: - if test -f camlp4$D.fast.opt; then cp camlp4$D.fast.opt $(BINDIR)/camlp4$D.opt$(EXE); fi - for TARG in pa_$D_fast.cmi pa_$D_fast.cmo pa_$D_fast.cmx ; do if test -f $$TARG; then cp $$TARG "$(LIBDIR)/camlp4/."; fi; done - -include .depend diff -Nru ocaml-3.12.1/camlp4/unmaintained/compile/comp_head.ml ocaml-4.01.0/camlp4/unmaintained/compile/comp_head.ml --- ocaml-3.12.1/camlp4/unmaintained/compile/comp_head.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/compile/comp_head.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,70 +0,0 @@ -(* camlp4r q_MLast.cmo pa_extend.cmo *) - - -module P = - struct - value gloc bp strm = Grammar.loc_of_token_interval bp (Stream.count strm); - value list0 symb = - let rec loop al = - parser - [ [: a = symb; s :] -> loop [a :: al] s - | [: :] -> al ] - in - parser [: a = loop [] :] -> List.rev a - ; - value list0sep symb sep = - let rec kont al = - parser - [ [: v = sep; a = symb; s :] -> kont [a :: al] s - | [: :] -> al ] - in - parser - [ [: a = symb; s :] -> List.rev (kont [a] s) - | [: :] -> [] ] - ; - value list1 symb = - let rec loop al = - parser - [ [: a = symb; s :] -> loop [a :: al] s - | [: :] -> al ] - in - parser [: a = symb; s :] -> List.rev (loop [a] s) - ; - value list1sep symb sep = - let rec kont al = - parser - [ [: v = sep; a = symb; s :] -> kont [a :: al] s - | [: :] -> al ] - in - parser [: a = symb; s :] -> List.rev (kont [a] s) - ; - value option f = - parser - [ [: x = f :] -> Some x - | [: :] -> None ] - ; - value token (p_con, p_prm) = - if p_prm = "" then parser [: `(con, prm) when con = p_con :] -> prm - else parser [: `(con, prm) when con = p_con && prm = p_prm :] -> prm - ; - value orzero f f0 = - parser bp - [ [: x = f :] -> x - | [: x = f0 :] ep -> -(* -let (loc1, loc2) = Grammar.loc_of_token_interval bp ep in -let _ = do { Printf.eprintf "recovered or_zero at loc (%d, %d)\n" loc1 loc2; flush stderr } in -*) - x ] - ; - value error entry prev_symb symb = - symb ^ " expected" ^ - (if prev_symb = "" then "" else " after " ^ prev_symb) ^ - " (in [" ^ entry ^ "])" - ; - value lexer = Plexer.gmake(); - end -; - -(****************************************) - diff -Nru ocaml-3.12.1/camlp4/unmaintained/compile/comp_trail.ml ocaml-4.01.0/camlp4/unmaintained/compile/comp_trail.ml --- ocaml-3.12.1/camlp4/unmaintained/compile/comp_trail.ml 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/compile/comp_trail.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,33 +0,0 @@ -(* camlp4r pa_extend.cmo *) -(****************************************) - -value interf_p = - Grammar.Entry.of_parser Pcaml.gram "interf" interf_0 -; - -value implem_p = - Grammar.Entry.of_parser Pcaml.gram "implem" implem_0 -; - -value top_phrase_p = - Grammar.Entry.of_parser Pcaml.gram "top_phrase" top_phrase_0 -; - -value use_file_p = - Grammar.Entry.of_parser Pcaml.gram "use_file" use_file_0 -; - -EXTEND - interf: - [ [ x = interf_p -> x ] ] - ; - implem: - [ [ x = implem_p -> x ] ] - ; - top_phrase: - [ [ x = top_phrase_p -> x ] ] - ; - use_file: - [ [ x = use_file_p -> x ] ] - ; -END; diff -Nru ocaml-3.12.1/camlp4/unmaintained/compile/compile.ml ocaml-4.01.0/camlp4/unmaintained/compile/compile.ml --- ocaml-3.12.1/camlp4/unmaintained/compile/compile.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/compile/compile.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,574 +0,0 @@ -(* camlp4r *) - - -open Gramext; - -value strict_parsing = ref False; -value keywords = ref []; - -value _loc = Loc.ghost; - -(* Watch the segmentation faults here! the compiled file must have been - loaded in camlp4 with the option pa_extend.cmo -meta_action. *) -value magic_act (act : Obj.t) : MLast.expr = Obj.magic act; - -(* Names of symbols for error messages; code borrowed to grammar.ml *) - -value rec name_of_symbol entry = - fun - [ Snterm e -> "[" ^ e.ename ^ "]" - | Snterml e l -> "[" ^ e.ename ^ " level " ^ l ^ "]" - | Sself | Snext -> "[" ^ entry.ename ^ "]" - | Stoken tok -> entry.egram.glexer.Token.tok_text tok - | _ -> "???" ] -; - -value rec name_of_symbol_failed entry = - fun - [ Slist0 s -> name_of_symbol_failed entry s - | Slist0sep s _ -> name_of_symbol_failed entry s - | Slist1 s -> name_of_symbol_failed entry s - | Slist1sep s _ -> name_of_symbol_failed entry s - | Sopt s -> name_of_symbol_failed entry s - | Stree t -> name_of_tree_failed entry t - | s -> name_of_symbol entry s ] -and name_of_tree_failed entry = - fun - [ Node {node = s; brother = bro; son = son} -> - let txt = name_of_symbol_failed entry s in - let txt = - match (s, son) with - [ (Sopt _, Node _) -> txt ^ " or " ^ name_of_tree_failed entry son - | _ -> txt ] - in - let txt = - match bro with - [ DeadEnd | LocAct _ _ -> txt - | _ -> txt ^ " or " ^ name_of_tree_failed entry bro ] - in - txt - | DeadEnd | LocAct _ _ -> "???" ] -; - -value tree_failed entry prev_symb tree = - let (s2, s3) = - let txt = name_of_tree_failed entry tree in - match prev_symb with - [ Slist0 s -> - let txt1 = name_of_symbol_failed entry s in - ("", txt1 ^ " or " ^ txt) - | Slist1 s -> - let txt1 = name_of_symbol_failed entry s in - ("", txt1 ^ " or " ^ txt) - | Slist0sep s sep -> - let txt1 = name_of_symbol_failed entry s in - ("", txt1 ^ " or " ^ txt) - | Slist1sep s sep -> - let txt1 = name_of_symbol_failed entry s in - ("", txt1 ^ " or " ^ txt) - | Sopt _ | Stree _ -> ("", txt) - | _ -> (name_of_symbol entry prev_symb, txt) ] - in - <:expr< - P.error $str:entry.ename$ $`str:s2$ $`str:s3$ - >> -; - -(* Compilation *) - -value rec find_act = - fun - [ DeadEnd -> failwith "find_act" - | LocAct act _ -> (magic_act act, 0) - | Node {son = son; brother = bro} -> - let (act, n) = try find_act son with [ Failure _ -> find_act bro ] in - (act, n + 1) ] -; - -value level_number e l = - match e.edesc with - [ Dlevels elevs -> - loop 0 elevs where rec loop n = - fun - [ [lev :: levs] -> if lev.lname = Some l then n else loop (n + 1) levs - | [] -> failwith ("level " ^ l ^ " not found in entry " ^ e.ename) ] - | Dparser _ -> 0 ] -; - -value nth_patt_of_act (e, n) = - let patt_list = - loop e where rec loop = - fun - [ <:expr< fun (_loc : Locaction.t) -> $_$ >> -> - [] - | <:expr< fun ($p$ : $_$) -> $e$ >> -> [p :: loop e] - | <:expr< fun $p$ -> $e$ >> -> [p :: loop e] - | _ -> failwith "nth_patt_of_act" ] - in - List.nth patt_list n -; - -value rec last_patt_of_act = - fun - [ <:expr< fun ($p$ : $_$) (_loc : Locaction.t) -> - $_$ >> -> p - | <:expr< fun $_$ -> $e$ >> -> last_patt_of_act e - | _ -> failwith "last_patt_of_act" ] -; - -#load "pr_r.cmo"; -value rec final_action = - fun - [ - <:expr< fun (_loc : Loc.t) -> ($e$ : $_$) >> -> e - | <:expr< fun $_$ -> $e$ >> -> final_action e - | ast -> do { - print_endline "final_action failed"; - Pcaml.print_implem.val [(MLast.StExp _loc ast, _loc)]; - failwith "final_action"; - } ] -; - -value parse_standard_symbol e rkont fkont ending_act = - <:expr< - match try Some ($e$ __strm) with [ Stream.Failure -> None ] with - [ Some $nth_patt_of_act ending_act$ -> $rkont$ - | _ -> $fkont$ ] - >> -; - -value parse_symbol_no_failure e rkont fkont ending_act = - <:expr< - let $nth_patt_of_act ending_act$ = - try $e$ __strm with [ Stream.Failure -> raise (Stream.Error "") ] - in - $rkont$ - >> -; - -value rec contain_loc = - fun - [ <:expr< $lid:s$ >> -> (s = "loc") || (s = "_loc") - | <:expr< $uid:_$ >> -> False - | <:expr< $str:_$ >> -> False - | <:expr< ($list:el$) >> -> List.exists contain_loc el - | <:expr< $e1$ $e2$ >> -> contain_loc e1 || contain_loc e2 - | _ -> True ] -; - -value gen_let_loc _loc e = - if contain_loc e then <:expr< let _loc = P.gloc bp __strm in $e$ >> else e -; - -value phony_entry = Grammar.Entry.obj Pcaml.implem; - -value rec parse_tree entry nlevn alevn (tree, fst_symb) act_kont kont = - match tree with - [ DeadEnd -> kont - | LocAct act _ -> - let act = magic_act act in - act_kont False act - | Node {node = Sself; son = LocAct act _; brother = bro} -> - let act = magic_act act in - let n = entry.ename ^ "_" ^ string_of_int alevn in - let e = - if strict_parsing.val || alevn = 0 || fst_symb then <:expr< $lid:n$ >> - else <:expr< P.orzero $lid:n$ $lid:entry.ename ^ "_0"$ >> - in - let p2 = - match bro with - [ DeadEnd -> kont - | _ -> parse_tree entry nlevn alevn (bro, fst_symb) act_kont kont ] - in - let p1 = act_kont True act in - parse_standard_symbol e p1 p2 (act, 0) - | Node {node = s; son = LocAct act _; brother = bro} -> - let act = magic_act act in - let p2 = parse_tree entry nlevn alevn (bro, fst_symb) act_kont kont in - let p1 = act_kont False act in - parse_symbol entry nlevn s p1 p2 (act, 0) - | Node {node = s; son = son; brother = bro} -> - let p2 = parse_tree entry nlevn alevn (bro, fst_symb) act_kont kont in - let p1 = - let err = - let txt = tree_failed entry s son in - <:expr< raise (Stream.Error $txt$) >> - in - match son with - [ Node {brother = DeadEnd} -> - parse_tree entry nlevn alevn (son, False) act_kont err - | _ -> - let p1 = - parse_tree entry nlevn alevn (son, True) act_kont - <:expr< raise Stream.Failure >> - in - <:expr< try $p1$ with [ Stream.Failure -> $err$ ] >> ] - in - parse_symbol entry nlevn s p1 p2 (find_act son) ] -and parse_symbol entry nlevn s rkont fkont ending_act = - match s with - [ Slist0 s -> - let e = <:expr< P.list0 $symbol_parser entry nlevn s$ >> in - parse_symbol_no_failure e rkont fkont ending_act - | Slist1 s -> - let e = <:expr< P.list1 $symbol_parser entry nlevn s$ >> in - parse_standard_symbol e rkont fkont ending_act - | Slist0sep s sep -> - let e = - <:expr< - P.list0sep $symbol_parser entry nlevn s$ - $symbol_parser entry nlevn sep$ >> - in - parse_symbol_no_failure e rkont fkont ending_act - | Slist1sep s sep -> - let e = - <:expr< - P.list1sep $symbol_parser entry nlevn s$ - $symbol_parser entry nlevn sep$ >> - in - parse_standard_symbol e rkont fkont ending_act - | Sopt s -> - let e = <:expr< P.option $symbol_parser entry nlevn s$ >> in - parse_symbol_no_failure e rkont fkont ending_act - | Stree tree -> - let kont = <:expr< raise Stream.Failure >> in - let act_kont _ act = gen_let_loc _loc (final_action act) in - let e = parse_tree phony_entry 0 0 (tree, True) act_kont kont in - parse_standard_symbol <:expr< fun __strm -> $e$ >> rkont fkont ending_act - | Snterm e -> - let n = - match e.edesc with - [ Dparser _ -> e.ename - | Dlevels _ -> e.ename ^ "_0" ] - in - parse_standard_symbol <:expr< $lid:n$ >> rkont fkont ending_act - | Snterml e l -> - let n = e.ename ^ "_" ^ string_of_int (level_number e l) in - parse_standard_symbol <:expr< $lid:n$ >> rkont fkont ending_act - | Sself -> - let n = entry.ename ^ "_0" in - parse_standard_symbol <:expr< $lid:n$ >> rkont fkont ending_act - | Snext -> - let n = entry.ename ^ "_" ^ string_of_int nlevn in - parse_standard_symbol <:expr< $lid:n$ >> rkont fkont ending_act - | Stoken tok -> - let _ = - do { - if fst tok = "" && not (List.mem (snd tok) keywords.val) then - keywords.val := [snd tok :: keywords.val] - else () - } - in - let p = - let patt = nth_patt_of_act ending_act in - let p_con = fst tok in - let p_prm = snd tok in - if snd tok = "" then - if fst tok = "ANY" then <:patt< (_, $patt$) >> - else <:patt< ($`str:p_con$, $patt$) >> - else - match patt with - [ <:patt< _ >> -> <:patt< ($`str:p_con$, $`str:p_prm$) >> - | _ -> <:patt< ($`str:p_con$, ($`str:p_prm$ as $patt$)) >> ] - in - <:expr< - match Stream.peek __strm with - [ Some $p$ -> do { Stream.junk __strm; $rkont$ } - | _ -> $fkont$ ] - >> - | _ -> - parse_standard_symbol <:expr< not_impl >> rkont fkont ending_act ] -and symbol_parser entry nlevn = - fun - [ Snterm e -> - let n = e.ename ^ "_0" in - <:expr< $lid:n$ >> - | Snterml e l -> - let n = e.ename ^ "_" ^ string_of_int (level_number e l) in - <:expr< $lid:n$ >> - | Snext -> - let n = entry.ename ^ "_" ^ string_of_int nlevn in - if strict_parsing.val then <:expr< $lid:n$ >> - else - let n0 = entry.ename ^ "_0" in - <:expr< P.orzero $lid:n$ $lid:n0$ >> - | Stoken tok -> - let _ = - do { - if fst tok = "" && not (List.mem (snd tok) keywords.val) then - keywords.val := [snd tok :: keywords.val] - else () - } - in - <:expr< P.token ($`str:fst tok$, $`str:snd tok$) >> - | Stree tree -> - let kont = <:expr< raise Stream.Failure >> in - let act_kont _ act = final_action act in - <:expr< - fun __strm -> - $parse_tree phony_entry 0 0 (tree, True) act_kont kont$ - >> - | _ -> - <:expr< aaa >> ] -; - -value rec start_parser_of_levels entry clevn levs = - let n = entry.ename ^ "_" ^ string_of_int clevn in - let next = entry.ename ^ "_" ^ string_of_int (clevn + 1) in - let p = <:patt< $lid:n$ >> in - match levs with - [ [] -> [Some (p, <:expr< fun __strm -> raise Stream.Failure >>)] - | [lev :: levs] -> - let pel = start_parser_of_levels entry (succ clevn) levs in - match lev.lprefix with - [ DeadEnd -> - let ncont = - if not strict_parsing.val && clevn = 0 then - entry.ename ^ "_gen_cont" - else entry.ename ^ "_" ^ string_of_int clevn ^ "_cont" - in - let curr = - <:expr< let a = $lid:next$ __strm in $lid:ncont$ bp a __strm >> - in - let curr = <:expr< let bp = Stream.count __strm in $curr$ >> in - let e = <:expr< fun __strm -> $curr$ >> in - let pel = if levs = [] then [] else pel in - [Some (p, e) :: pel] - | tree -> - let alevn = clevn in - let (kont, pel) = - match levs with - [ [] -> (<:expr< raise Stream.Failure >>, []) - | _ -> - let e = - match (lev.assoc, lev.lsuffix) with - [ (NonA, _) | (_, DeadEnd) -> <:expr< $lid:next$ __strm >> - | _ -> - let ncont = - entry.ename ^ "_" ^ string_of_int clevn ^ "_cont" - in - <:expr< - let a = $lid:next$ __strm in - $lid:ncont$ bp a __strm - >> ] - in - (e, pel) ] - in - let act_kont end_with_self act = - if lev.lsuffix = DeadEnd then gen_let_loc _loc (final_action act) - else - let ncont = entry.ename ^ "_" ^ string_of_int clevn ^ "_cont" in - gen_let_loc _loc - <:expr< $lid:ncont$ bp $final_action act$ __strm >> - in - let curr = - parse_tree entry (succ clevn) alevn (tree, True) act_kont kont - in - let curr = <:expr< let bp = Stream.count __strm in $curr$ >> in - let e = <:expr< fun __strm -> $curr$ >> in - [Some (p, e) :: pel] ] ] -; - -value rec continue_parser_of_levels entry clevn levs = - let n = entry.ename ^ "_" ^ string_of_int clevn ^ "_cont" in - let p = <:patt< $lid:n$ >> in - match levs with - [ [] -> [None] - | [lev :: levs] -> - let pel = continue_parser_of_levels entry (succ clevn) levs in - match lev.lsuffix with - [ DeadEnd -> - [None :: pel] - | tree -> - let alevn = - match lev.assoc with - [ LeftA | NonA -> succ clevn - | RightA -> clevn ] - in - let (kont, pel) = - match levs with - [ [] -> (<:expr< a__ >>, []) - | _ -> (<:expr< a__ >>, pel) ] - in - let act_kont end_with_self act = - let p = last_patt_of_act act in - match lev.assoc with - [ RightA | NonA -> - <:expr< - let $p$ = a__ in - $gen_let_loc _loc (final_action act)$ - >> - | LeftA -> - let ncont = - entry.ename ^ "_" ^ string_of_int clevn ^ "_cont" - in - gen_let_loc _loc - <:expr< - let $p$ = a__ in - $lid:ncont$ bp $final_action act$ __strm - >> ] - in - let curr = - parse_tree entry (succ clevn) alevn (tree, True) act_kont kont - in - let e = <:expr< fun bp a__ __strm -> $curr$ >> in - [Some (p, e) :: pel] ] ] -; - -value continue_parser_of_levels_again entry levs = - let n = entry.ename ^ "_gen_cont" in - let e = - loop <:expr< a__ >> 0 levs where rec loop var levn = - fun - [ [] -> <:expr< if x == a__ then x else $lid:n$ bp x __strm >> - | [lev :: levs] -> - match lev.lsuffix with - [ DeadEnd -> loop var (levn + 1) levs - | _ -> - let n = entry.ename ^ "_" ^ string_of_int levn ^ "_cont" in - let rest = loop <:expr< x >> (levn + 1) levs in - <:expr< let x = $lid:n$ bp $var$ __strm in $rest$ >> ] ] - in - (<:patt< $lid:n$ >>, <:expr< fun bp a__ __strm -> $e$ >>) -; - -value empty_entry ename = - let p = <:patt< $lid:ename$ >> in - let e = - <:expr< - fun __strm -> - raise (Stream.Error $str:"entry [" ^ ename ^ "] is empty"$) >> - in - [Some (p, e)] -; - -value start_parser_of_entry entry = - match entry.edesc with - [ Dlevels [] -> empty_entry entry.ename - | Dlevels elev -> start_parser_of_levels entry 0 elev - | Dparser p -> [] ] -; - -value continue_parser_of_entry entry = - match entry.edesc with - [ Dlevels elev -> continue_parser_of_levels entry 0 elev - | Dparser p -> [] ] -; - -value continue_parser_of_entry_again entry = - if strict_parsing.val then [] - else - match entry.edesc with - [ Dlevels ([_; _ :: _] as levs) -> - [continue_parser_of_levels_again entry levs] - | _ -> [] ] -; - -value rec list_alternate l1 l2 = - match (l1, l2) with - [ ([x1 :: l1], [x2 :: l2]) -> [x1; x2 :: list_alternate l1 l2] - | ([], l2) -> l2 - | (l1, []) -> l1 ] -; - -value compile_entry entry = - let pel1 = start_parser_of_entry entry in - let pel2 = continue_parser_of_entry entry in - let pel = list_alternate pel1 pel2 in - List.fold_right - (fun pe list -> - match pe with - [ Some pe -> [pe :: list] - | None -> list ]) - pel (continue_parser_of_entry_again entry) -; - -(* get all entries connected together *) - -value rec scan_tree list = - fun - [ Node {node = n; son = son; brother = bro} -> - let list = scan_symbol list n in - let list = scan_tree list son in - let list = scan_tree list bro in - list - | LocAct _ _ | DeadEnd -> list ] -and scan_symbol list = - fun - [ Snterm e -> scan_entry list e - | Snterml e l -> scan_entry list e - | Slist0 s -> scan_symbol list s - | Slist0sep s sep -> scan_symbol (scan_symbol list s) sep - | Slist1 s -> scan_symbol list s - | Slist1sep s sep -> scan_symbol (scan_symbol list s) sep - | Sopt s -> scan_symbol list s - | Stree t -> scan_tree list t - | Smeta _ _ _ | Sself | Snext | Stoken _ -> list ] -and scan_level list lev = - let list = scan_tree list lev.lsuffix in - let list = scan_tree list lev.lprefix in - list -and scan_levels list levs = List.fold_left scan_level list levs -and scan_entry list entry = - if List.memq entry list then list - else - match entry.edesc with - [ Dlevels levs -> scan_levels [entry :: list] levs - | Dparser _ -> list ] -; - -value all_entries_in_graph list entry = - List.rev (scan_entry list entry) -; - -(* main *) - -value entries = ref []; - -value rec list_mem_right_assoc x = - fun - [ [] -> False - | [(a, b) :: l] -> x = b || list_mem_right_assoc x l ] -; - -value rec expr_list = - fun - [ [] -> <:expr< [] >> - | [x :: l] -> <:expr< [$`str:x$ :: $expr_list l$] >> ] -; - -value compile () = - let _ = do { keywords.val := []; } in - let list = List.fold_left all_entries_in_graph [] entries.val in - let list = - List.filter (fun e -> List.memq e list) entries.val @ - List.filter (fun e -> not (List.memq e entries.val)) list - in - let list = - let set = ref [] in - List.fold_right - (fun entry list -> - if List.mem entry.ename set.val then - list - else do { set.val := [entry.ename :: set.val]; [entry :: list] }) - list [] - in - let pell = List.map compile_entry list in - let pel = List.flatten pell in - let si1 = <:str_item< value rec $list:pel$ >> in - let si2 = - let list = List.sort compare keywords.val in - <:str_item< - List.iter (fun kw -> P.lexer.Token.tok_using ("", kw)) - $expr_list list$ - >> - in - let loc = Loc.ghost in - ([(si1, loc); (si2, loc)], False) -; - -Pcaml.parse_implem.val := fun _ _ -> compile (); - -Pcaml.add_option "-strict_parsing" (Arg.Set strict_parsing) - "Don't generate error recovering by trying continuations or first levels" -; diff -Nru ocaml-3.12.1/camlp4/unmaintained/compile/compile.sh ocaml-4.01.0/camlp4/unmaintained/compile/compile.sh --- ocaml-3.12.1/camlp4/unmaintained/compile/compile.sh 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/compile/compile.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,27 +0,0 @@ -#!/bin/sh -e - -ARGS= -FILES= -ENTRIES= -while test "" != "$1"; do - case $1 in - -e) - shift; - if test "$ENTRIES" != ""; then ENTRIES="$ENTRIES; "; fi - ENTRIES="$ENTRIES$1";; - *.ml*) FILES="$FILES $1";; - *) ARGS="$ARGS $1";; - esac - shift -done - -cat $FILES | sed -e 's/Pcaml.parse_i.*$//' > tmp.ml -echo "Compile.entries.val := [$ENTRIES];" >> tmp.ml -> tmp.mli -set -x -$OTOP/boot/ocamlrun$EXE $OTOP/boot/ocamlc -I $OTOP/boot -c tmp.mli -$OTOP/boot/ocamlrun$EXE ../boot/camlp4boot$EXE -meta_action tmp.ml -o tmp.ppo -$OTOP/boot/ocamlrun$EXE $OTOP/boot/ocamlc -I $OTOP/boot -I ../lib -I ../camlp4 -c -impl tmp.ppo -rm tmp.ppo -> tmp.null -$OTOP/boot/ocamlrun$EXE ../camlp4/camlp4$EXE ./compile.cmo ./tmp.cmo ../etc/pr_r.cmo ../etc/pr_rp.cmo $ARGS -sep "\n\n" -impl tmp.null && rm tmp.* diff -Nru ocaml-3.12.1/camlp4/unmaintained/etc/.cvsignore ocaml-4.01.0/camlp4/unmaintained/etc/.cvsignore --- ocaml-3.12.1/camlp4/unmaintained/etc/.cvsignore 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/etc/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,7 +0,0 @@ -*.cm[oia] -camlp4o -camlp4sch -camlp4o.opt -version.sh -mkcamlp4.sh -mkcamlp4.mpw diff -Nru ocaml-3.12.1/camlp4/unmaintained/etc/.depend ocaml-4.01.0/camlp4/unmaintained/etc/.depend --- ocaml-3.12.1/camlp4/unmaintained/etc/.depend 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/etc/.depend 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -parserify.cmo: parserify.cmi -parserify.cmx: parserify.cmi -pr_op_main.cmo: parserify.cmi -pr_op_main.cmx: parserify.cmx -pr_rp_main.cmo: parserify.cmi -pr_rp_main.cmx: parserify.cmx diff -Nru ocaml-3.12.1/camlp4/unmaintained/etc/Makefile ocaml-4.01.0/camlp4/unmaintained/etc/Makefile --- ocaml-3.12.1/camlp4/unmaintained/etc/Makefile 2010-05-21 11:28:21.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/etc/Makefile 1970-01-01 00:00:00.000000000 +0000 @@ -1,62 +0,0 @@ - - -include ../config/Makefile.cnf - -INCLUDES=-I ../camlp4 -I ../lib -I ../meta -I $(OTOP)/lex -I $(OTOP)/parsing -OBJS=q_phony.cmo pa_o.cmo pa_op.cmo pa_oop.cmo pa_ru.cmo pa_extfun.cmo pa_fstream.cmo pa_ifdef.cmo pr_r.cmo pr_rp.cmo pr_o.cmo pr_op.cmo pr_extend.cmo pr_extfun.cmo pr_null.cmo pr_depend.cmo genTraversal.cmo fi_exc_tracer.cmo -INTF=pa_o.cmi -CAMLP4OM=pa_o.cmo pa_op.cmo ../meta/pr_dump.cmo -CAMLP4OMX=$(CAMLP4OM:.cmo=.cmx) -EXECUTABLES=camlp4o - -include ../config/Makefile.base - -all-local: mkcamlp4.sh - -pr_rp.cmo: parserify.cmo pr_rp_main.cmo - $(OCAMLC) parserify.cmo pr_rp_main.cmo -a -o $@ - -pr_op.cmo: parserify.cmo pr_op_main.cmo - $(OCAMLC) parserify.cmo pr_op_main.cmo -a -o $@ - -pr_rp.cmx: parserify.cmx pr_rp_main.cmx - $(OCAMLOPT) parserify.cmx pr_rp_main.cmx -a -o pr_rp.cmxa - mv pr_rp.cmxa pr_rp.cmx - mv pr_rp.$(A) pr_rp.$(O) - -pr_op.cmx: parserify.cmx pr_op_main.cmx - $(OCAMLOPT) parserify.cmx pr_op_main.cmx -a -o pr_op.cmxa - mv pr_op.cmxa pr_op.cmx - mv pr_op.$(A) pr_op.$(O) - -camlp4o$(EXE): ../camlp4/camlp4$(EXE) $(CAMLP4OM) - rm -f camlp4o$(EXE) - cd ../camlp4; $(MAKE) CAMLP4=../etc/camlp4o$(EXE) CAMLP4M="-I ../etc $(CAMLP4OM)" - -camlp4o.opt: $(CAMLP4OMX) - rm -f camlp4o.opt - cd ../camlp4; $(MAKE) ../etc/camlp4o.opt CAMLP4OPT=../etc/camlp4o.opt CAMLP4M="-I ../etc $(CAMLP4OMX)" - -mkcamlp4.sh: mkcamlp4.sh.tpl version.sh - sed -e "s!LIBDIR!$(LIBDIR)!g" -e "/define VERSION/r version.sh" \ - mkcamlp4.sh.tpl > mkcamlp4.sh - -version.sh : $(OTOP)/VERSION - echo "VERSION=\"`sed -e 1q ../VERSION`\"" >version.sh - -install-local: - -$(MKDIR) "$(LIBDIR)/camlp4" "$(BINDIR)" - cp $(OBJS) "$(LIBDIR)/camlp4/." - cp $(INTF) "$(LIBDIR)/camlp4/." - cp camlp4o$(EXE) "$(BINDIR)/." - if test -f camlp4o.opt; then \ - cp camlp4o.opt "$(BINDIR)/camlp4o.opt$(EXE)"; \ - cp $(OBJSX) "$(LIBDIR)/camlp4/."; \ - for file in $(OBJSX); do \ - cp "`echo $$file | sed -e 's/\.cmx$$/.$(O)/'`" "$(LIBDIR)/camlp4/."; \ - done ; \ - fi - cp mkcamlp4.sh "$(BINDIR)/mkcamlp4" - chmod a+x "$(BINDIR)/mkcamlp4" - -include .depend diff -Nru ocaml-3.12.1/camlp4/unmaintained/etc/pa_fstream.ml ocaml-4.01.0/camlp4/unmaintained/etc/pa_fstream.ml --- ocaml-3.12.1/camlp4/unmaintained/etc/pa_fstream.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/etc/pa_fstream.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,163 +0,0 @@ -(* camlp4r pa_extend.cmo q_MLast.cmo *) - - -open Pcaml; - -type spat_comp = - [ SpTrm of Loc.t and MLast.patt and option MLast.expr - | SpNtr of Loc.t and MLast.patt and MLast.expr - | SpStr of Loc.t and MLast.patt ] -; -type sexp_comp = - [ SeTrm of Loc.t and MLast.expr - | SeNtr of Loc.t and MLast.expr ] -; - -(* parsers *) - -value strm_n = "__strm"; -value next_fun _loc = <:expr< Fstream.next >>; - -value rec pattern_eq_expression p e = - match (p, e) with - [ (<:patt< $lid:a$ >>, <:expr< $lid:b$ >>) -> a = b - | (<:patt< $uid:a$ >>, <:expr< $uid:b$ >>) -> a = b - | (<:patt< $p1$ $p2$ >>, <:expr< $e1$ $e2$ >>) -> - pattern_eq_expression p1 e1 && pattern_eq_expression p2 e2 - | (<:patt< ($list:pl$) >>, <:expr< ($list:el$) >>) -> - loop pl el where rec loop pl el = - match (pl, el) with - [ ([p :: pl], [e :: el]) -> - pattern_eq_expression p e && loop pl el - | ([], []) -> True - | _ -> False ] - | _ -> False ] -; - -value stream_pattern_component skont = - fun - [ SpTrm _loc p wo -> - let p = <:patt< Some ($p$, $lid:strm_n$) >> in - if wo = None && pattern_eq_expression p skont then - <:expr< $next_fun _loc$ $lid:strm_n$ >> - else - <:expr< match $next_fun _loc$ $lid:strm_n$ with - [ $p$ $when:wo$ -> $skont$ - | _ -> None ] >> - | SpNtr _loc p e -> - let p = <:patt< Some ($p$, $lid:strm_n$) >> in - if pattern_eq_expression p skont then <:expr< $e$ $lid:strm_n$ >> - else - <:expr< match $e$ $lid:strm_n$ with - [ $p$ -> $skont$ - | _ -> None ] >> - | SpStr _loc p -> - <:expr< let $p$ = $lid:strm_n$ in $skont$ >> ] -; - -value rec stream_pattern _loc epo e = - fun - [ [] -> - let e = - match epo with - [ Some ep -> <:expr< let $ep$ = Fstream.count $lid:strm_n$ in $e$ >> - | None -> e ] - in - <:expr< Some ($e$, $lid:strm_n$) >> - | [spc :: spcl] -> - let skont = stream_pattern _loc epo e spcl in - stream_pattern_component skont spc ] -; - -value rec parser_cases _loc = - fun - [ [] -> <:expr< None >> - | [(spcl, epo, e) :: spel] -> - match parser_cases _loc spel with - [ <:expr< None >> -> stream_pattern _loc epo e spcl - | pc -> - <:expr< match $stream_pattern _loc epo e spcl$ with - [ Some _ as x -> x - | None -> $pc$ ] >> ] ] -; - -value cparser_match _loc me bpo pc = - let pc = parser_cases _loc pc in - let e = - match bpo with - [ Some bp -> <:expr< let $bp$ = Stream.count $lid:strm_n$ in $pc$ >> - | None -> pc ] - in - <:expr< let ($lid:strm_n$ : Stream.t _) = $me$ in $e$ >> -; - -value cparser _loc bpo pc = - let e = parser_cases _loc pc in - let e = - match bpo with - [ Some bp -> <:expr< let $bp$ = Fstream.count $lid:strm_n$ in $e$ >> - | None -> e ] - in - let p = <:patt< ($lid:strm_n$ : Fstream.t _) >> in <:expr< fun $p$ -> $e$ >> -; - -(* streams *) - -value slazy _loc x = <:expr< fun () -> $x$ >>; - -value rec cstream _loc = - fun - [ [] -> <:expr< Fstream.nil >> - | [SeTrm _loc e :: sel] -> - let e2 = cstream _loc sel in - let x = <:expr< Fstream.cons $e$ $e2$ >> in - <:expr< Fstream.flazy $slazy _loc x$ >> - | [SeNtr _loc e] -> - e - | [SeNtr _loc e :: sel] -> - let e2 = cstream _loc sel in - let x = <:expr< Fstream.app $e$ $e2$ >> in - <:expr< Fstream.flazy $slazy _loc x$ >> ] -; - -EXTEND - GLOBAL: expr; - expr: LEVEL "top" - [ [ "fparser"; po = OPT ipatt; "["; pcl = LIST0 parser_case SEP "|"; "]" -> - <:expr< $cparser _loc po pcl$ >> - | "fparser"; po = OPT ipatt; pc = parser_case -> - <:expr< $cparser _loc po [pc]$ >> - | "match"; e = SELF; "with"; "parser"; po = OPT ipatt; "["; - pcl = LIST0 parser_case SEP "|"; "]" -> - <:expr< $cparser_match _loc e po pcl$ >> - | "match"; e = SELF; "with"; "parser"; po = OPT ipatt; - pc = parser_case -> - <:expr< $cparser_match _loc e po [pc]$ >> ] ] - ; - parser_case: - [ [ "[:"; sp = stream_patt; ":]"; po = OPT ipatt; "->"; e = expr -> - (sp, po, e) ] ] - ; - stream_patt: - [ [ spc = stream_patt_comp -> [spc] - | spc = stream_patt_comp; ";"; sp = LIST1 stream_patt_comp SEP ";" -> - [spc :: sp] - | -> [] ] ] - ; - stream_patt_comp: - [ [ "`"; p = patt; eo = OPT [ "when"; e = expr -> e ] -> SpTrm _loc p eo - | p = patt; "="; e = expr -> SpNtr _loc p e - | p = patt -> SpStr _loc p ] ] - ; - ipatt: - [ [ i = LIDENT -> <:patt< $lid:i$ >> ] ] - ; - expr: LEVEL "simple" - [ [ "fstream"; "[:"; se = LIST0 stream_expr_comp SEP ";"; ":]" -> - <:expr< $cstream _loc se$ >> ] ] - ; - stream_expr_comp: - [ [ "`"; e = expr -> SeTrm _loc e - | e = expr -> SeNtr _loc e ] ] - ; -END; diff -Nru ocaml-3.12.1/camlp4/unmaintained/etc/pa_ifdef.ml ocaml-4.01.0/camlp4/unmaintained/etc/pa_ifdef.ml --- ocaml-3.12.1/camlp4/unmaintained/etc/pa_ifdef.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/etc/pa_ifdef.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,91 +0,0 @@ -(* camlp4r pa_extend.cmo q_MLast.cmo *) - - -(* This module is deprecated since version 3.07; use pa_macro.ml instead *) - -value _ = - prerr_endline "Warning: pa_ifdef is deprecated since OCaml 3.07. Use pa_macro instead." -; - -type item_or_def 'a = - [ SdStr of 'a | SdDef of string | SdUnd of string | SdNop ] -; - -value list_remove x l = - List.fold_right (fun e l -> if e = x then l else [e :: l]) l [] -; - -value defined = ref ["OCAML_308"; "OCAML_307"; "OCAML_305"; "CAMLP4_300"; "NEWSEQ"]; -value define x = defined.val := [x :: defined.val]; -value undef x = defined.val := list_remove x defined.val; - -EXTEND - GLOBAL: Pcaml.expr Pcaml.str_item Pcaml.sig_item; - Pcaml.expr: LEVEL "top" - [ [ "ifdef"; c = UIDENT; "then"; e1 = Pcaml.expr; "else"; - e2 = Pcaml.expr -> - if List.mem c defined.val then e1 else e2 - | "ifndef"; c = UIDENT; "then"; e1 = Pcaml.expr; "else"; - e2 = Pcaml.expr -> - if List.mem c defined.val then e2 else e1 ] ] - ; - Pcaml.str_item: FIRST - [ [ x = def_undef_str -> - match x with - [ SdStr si -> si - | SdDef x -> do { define x; <:str_item< declare end >> } - | SdUnd x -> do { undef x; <:str_item< declare end >> } - | SdNop -> <:str_item< declare end >> ] ] ] - ; - def_undef_str: - [ [ "ifdef"; c = UIDENT; "then"; e1 = str_item_def_undef; - "else"; e2 = str_item_def_undef -> - if List.mem c defined.val then e1 else e2 - | "ifdef"; c = UIDENT; "then"; e1 = str_item_def_undef -> - if List.mem c defined.val then e1 else SdNop - | "ifndef"; c = UIDENT; "then"; e1 = str_item_def_undef; - "else"; e2 = str_item_def_undef -> - if List.mem c defined.val then e2 else e1 - | "ifndef"; c = UIDENT; "then"; e1 = str_item_def_undef -> - if List.mem c defined.val then SdNop else e1 - | "define"; c = UIDENT -> SdDef c - | "undef"; c = UIDENT -> SdUnd c ] ] - ; - str_item_def_undef: - [ [ d = def_undef_str -> d - | si = Pcaml.str_item -> SdStr si ] ] - ; - Pcaml.sig_item: FIRST - [ [ x = def_undef_sig -> - match x with - [ SdStr si -> si - | SdDef x -> do { define x; <:sig_item< declare end >> } - | SdUnd x -> do { undef x; <:sig_item< declare end >> } - | SdNop -> <:sig_item< declare end >> ] ] ] - ; - def_undef_sig: - [ [ "ifdef"; c = UIDENT; "then"; e1 = sig_item_def_undef; - "else"; e2 = sig_item_def_undef -> - if List.mem c defined.val then e1 else e2 - | "ifdef"; c = UIDENT; "then"; e1 = sig_item_def_undef -> - if List.mem c defined.val then e1 else SdNop - | "ifndef"; c = UIDENT; "then"; e1 = sig_item_def_undef; - "else"; e2 = sig_item_def_undef -> - if List.mem c defined.val then e2 else e1 - | "ifndef"; c = UIDENT; "then"; e1 = sig_item_def_undef -> - if List.mem c defined.val then SdNop else e1 - | "define"; c = UIDENT -> SdDef c - | "undef"; c = UIDENT -> SdUnd c ] ] - ; - sig_item_def_undef: - [ [ d = def_undef_sig -> d - | si = Pcaml.sig_item -> SdStr si ] ] - ; -END; - -Pcaml.add_option "-D" (Arg.String define) - " Define for ifdef instruction." -; -Pcaml.add_option "-U" (Arg.String undef) - " Undefine for ifdef instruction." -; diff -Nru ocaml-3.12.1/camlp4/unmaintained/etc/pa_oop.ml ocaml-4.01.0/camlp4/unmaintained/etc/pa_oop.ml --- ocaml-3.12.1/camlp4/unmaintained/etc/pa_oop.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/etc/pa_oop.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,155 +0,0 @@ -(* camlp4r pa_extend.cmo q_MLast.cmo *) -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1998 Institut National de Recherche en Informatique et *) -(* Automatique. Distributed only by permission. *) -(* *) -(***********************************************************************) - - - -open Pcaml; - -type spat_comp = - [ SpTrm of Loc.t and MLast.patt and option MLast.expr - | SpNtr of Loc.t and MLast.patt and MLast.expr - | SpStr of Loc.t and MLast.patt ] -; -type sexp_comp = - [ SeTrm of Loc.t and MLast.expr | SeNtr of Loc.t and MLast.expr ] -; - -value strm_n = "__strm"; -value peek_fun _loc = <:expr< Stream.peek >>; -value junk_fun _loc = <:expr< Stream.junk >>; - -(* Parsers. *) - -value stream_pattern_component skont = - fun - [ SpTrm _loc p wo -> - (<:expr< $peek_fun _loc$ $lid:strm_n$ >>, p, wo, - <:expr< do { $junk_fun _loc$ $lid:strm_n$; $skont$ } >>) - | SpNtr _loc p e -> - (<:expr< try Some ($e$ $lid:strm_n$) with - [ Stream.Failure -> None ] >>, - p, None, skont) - | SpStr _loc p -> - (<:expr< Some $lid:strm_n$ >>, p, None, skont) ] -; - -value rec stream_pattern _loc epo e ekont = - fun - [ [] -> - match epo with - [ Some ep -> <:expr< let $ep$ = Stream.count $lid:strm_n$ in $e$ >> - | _ -> e ] - | [(spc, err) :: spcl] -> - let skont = - let ekont err = - let str = - match err with - [ Some estr -> estr - | _ -> <:expr< "" >> ] - in - <:expr< raise (Stream.Error $str$) >> - in - stream_pattern _loc epo e ekont spcl - in - let (tst, p, wo, e) = stream_pattern_component skont spc in - let ckont = ekont err in - <:expr< match $tst$ with - [ Some $p$ $when:wo$ -> $e$ | _ -> $ckont$ ] >> ] -; - -value rec parser_cases _loc = - fun - [ [] -> <:expr< raise Stream.Failure >> - | [(spcl, epo, e) :: spel] -> - stream_pattern _loc epo e (fun _ -> parser_cases _loc spel) spcl ] -; - -value cparser _loc bpo pc = - let e = parser_cases _loc pc in - let e = - match bpo with - [ Some bp -> <:expr< let $bp$ = Stream.count $lid:strm_n$ in $e$ >> - | None -> e ] - in - let p = <:patt< ($lid:strm_n$ : Stream.t _) >> in - <:expr< fun $p$ -> $e$ >> -; - -value cparser_match _loc me bpo pc = - let pc = parser_cases _loc pc in - let e = - match bpo with - [ Some bp -> <:expr< let $bp$ = Stream.count $lid:strm_n$ in $pc$ >> - | None -> pc ] - in - <:expr< let $lid:strm_n$ = $me$ in $e$ >> -; - -(* streams *) - -value slazy _loc e = <:expr< fun _ -> $e$ >>; - -value rec cstream gloc = - fun - [ [] -> let _loc = gloc in <:expr< Stream.sempty >> - | [SeTrm _loc e :: secl] -> - <:expr< Stream.lcons $slazy _loc e$ $cstream gloc secl$ >> - | [SeNtr _loc e :: secl] -> - <:expr< Stream.lapp $slazy _loc e$ $cstream gloc secl$ >> ] -; - -(* Syntax extensions in Ocaml grammar *) - - -EXTEND - GLOBAL: expr; - expr: LEVEL "expr1" - [ [ "parser"; po = OPT ipatt; OPT "|"; pcl = LIST1 parser_case SEP "|" -> - <:expr< $cparser _loc po pcl$ >> - | "match"; e = expr; "with"; "parser"; po = OPT ipatt; OPT "|"; - pcl = LIST1 parser_case SEP "|" -> - <:expr< $cparser_match _loc e po pcl$ >> ] ] - ; - parser_case: - [ [ "[<"; sp = stream_patt; ">]"; po = OPT ipatt; "->"; e = expr -> - (sp, po, e) ] ] - ; - stream_patt: - [ [ spc = stream_patt_comp -> [(spc, None)] - | spc = stream_patt_comp; ";"; sp = LIST1 stream_patt_comp_err SEP ";" -> - [(spc, None) :: sp] - | (* empty *) -> [] ] ] - ; - stream_patt_comp_err: - [ [ spc = stream_patt_comp; - eo = OPT [ "??"; e = expr LEVEL "expr1" -> e ] -> - (spc, eo) ] ] - ; - stream_patt_comp: - [ [ "'"; p = patt; eo = OPT [ "when"; e = (expr LEVEL "expr1") -> e ] -> - SpTrm _loc p eo - | p = patt; "="; e = (expr LEVEL "expr1") -> SpNtr _loc p e - | p = patt -> SpStr _loc p ] ] - ; - ipatt: - [ [ i = LIDENT -> <:patt< $lid:i$ >> ] ] - ; - - expr: LEVEL "simple" - [ [ "[<"; se = LIST0 stream_expr_comp SEP ";"; ">]" -> - <:expr< $cstream _loc se$ >> ] ] - ; - stream_expr_comp: - [ [ "'"; e = expr LEVEL "expr1" -> SeTrm _loc e - | e = expr LEVEL "expr1" -> SeNtr _loc e ] ] - ; -END; diff -Nru ocaml-3.12.1/camlp4/unmaintained/etc/pa_ru.ml ocaml-4.01.0/camlp4/unmaintained/etc/pa_ru.ml --- ocaml-3.12.1/camlp4/unmaintained/etc/pa_ru.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/etc/pa_ru.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,46 +0,0 @@ -(* camlp4r pa_extend.cmo q_MLast.cmo *) -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1998 Institut National de Recherche en Informatique et *) -(* Automatique. Distributed only by permission. *) -(* *) -(***********************************************************************) - - - -open Pcaml; - -value o2b = - fun - [ Some _ -> True - | None -> False ] -; - -EXTEND - GLOBAL: expr; - expr: LEVEL "top" - [ [ "do"; "{"; seq = sequence; "}" -> - match seq with - [ [e] -> e - | _ -> <:expr< do { $list:seq$ } >> ] ] ] - ; - sequence: - [ [ "let"; o = OPT "rec"; l = LIST1 let_binding SEP "and"; [ "in" | ";" ]; - el = SELF -> - let e = - match el with - [ [e] -> e - | _ -> <:expr< do { $list:el$ } >> ] - in - [ <:expr< let $opt:o2b o$ $list:l$ in $e$ >> ] - | e = expr; ";"; el = SELF -> - let e = let _loc = MLast.loc_of_expr e in <:expr< ($e$ : unit) >> in - [e :: el] - | e = expr; ";" -> [e] - | e = expr -> [e] ] ] - ; -END; diff -Nru ocaml-3.12.1/camlp4/unmaintained/etc/parserify.ml ocaml-4.01.0/camlp4/unmaintained/etc/parserify.ml --- ocaml-3.12.1/camlp4/unmaintained/etc/parserify.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/etc/parserify.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,305 +0,0 @@ -(* camlp4r q_MLast.cmo *) - - -(* FIXME FIXME *) -value _loc = Loc.mk "FIXME parserify.ml"; - -type spc = - [ SPCterm of (MLast.patt * option MLast.expr) - | SPCnterm of MLast.patt and MLast.expr - | SPCsterm of MLast.patt ] -; - -exception NotImpl; - -value rec subst v = - MLast.Map.Expr.expr (fun [ <:expr@_loc< __strm >> -> <:expr< $lid:v$ >> - | e -> e ]) -(* FIXME FIXME *) - (* match e with - [ <:expr< $lid:x$ >> -> if x = "__strm" then <:expr< $lid:v$ >> else e - | <:expr< $uid:_$ >> -> e - | <:expr< $int:_$ >> -> e - | <:expr< $chr:_$ >> -> e - | <:expr< $str:_$ >> -> e - | <:expr@_loc< $e1$ . $lab$ >> -> <:expr< $subst v e1$ . $lab$ >> - | <:expr@_loc< $x$ $y$ >> -> <:expr< $subst v x$ $subst v y$ >> - | <:expr@_loc< let $lid:s1$ = $e1$ in $e2$ >> -> - if s1 = v then <:expr< let $lid:s1$ = $subst v e1$ in $e2$ >> - else <:expr< let $lid:s1$ = $subst v e1$ in $subst v e2$ >> - | <:expr@_loc< let _ = $e1$ in $e2$ >> -> - <:expr< let _ = $subst v e1$ in $subst v e2$ >> - | <:expr@_loc< ($list:el$) >> -> <:expr< ($list:List.map (subst v) el$) >> - | _ -> raise NotImpl ] *) -; - -value rec is_free v = - fun - [ <:expr< $lid:x$ >> -> x <> v - | <:expr< $uid:_$ >> -> True - | <:expr< $int:_$ >> -> True - | <:expr< $chr:_$ >> -> True - | <:expr< $str:_$ >> -> True - | <:expr< $e$ . $_$ >> -> is_free v e - | <:expr< $x$ $y$ >> -> is_free v x && is_free v y - | <:expr< let $lid:s1$ = $e1$ in $e2$ >> -> - is_free v e1 && (s1 = v || is_free v e2) - | <:expr< let _ = $e1$ in $e2$ >> -> is_free v e1 && is_free v e2 - | <:expr< ($list:el$) >> -> List.for_all (is_free v) el - | _ -> raise NotImpl ] -; - -value gensym = - let cnt = ref 0 in - fun () -> - do { incr cnt; "pr_rp_symb_" ^ string_of_int cnt.val } -; - -value free_var_in_expr c e = - let rec loop_alpha v = - let x = String.make 1 v in - if is_free x e then Some x - else if v = 'z' then None - else loop_alpha (Char.chr (Char.code v + 1)) - in - let rec loop_count cnt = - let x = String.make 1 c ^ string_of_int cnt in - if is_free x e then x else loop_count (succ cnt) - in - try - match loop_alpha c with - [ Some v -> v - | None -> loop_count 1 ] - with - [ NotImpl -> gensym () ] -; - -value parserify _loc = - fun - [ <:expr< $e$ __strm >> -> e - | e -> <:expr< fun __strm -> $e$ >> ] -; - -value is_raise_failure = - fun - [ <:expr< raise Stream.Failure >> -> True - | _ -> False ] -; - -value is_raise_error = - fun - [ <:expr< raise (Stream.Error $_$) >> -> True - | _ -> False ] -; - -value semantic _loc e = - try - if is_free "__strm" e then e - else - let v = free_var_in_expr 's' e in - <:expr< let $lid:v$ = __strm in $subst v e$ >> - with - [ NotImpl -> e ] -; - -value rewrite_parser = - rewrite True where rec rewrite top ge = - match ge with - [ <:expr@_loc< let $p$ = try $e$ with [ Stream.Failure -> raise $exc$ ] in - $sp_kont$ >> -> - let f = parserify _loc e in - <:expr< - match try Some ($f$ __strm) with [ Stream.Failure -> None ] with - [ Some $p$ -> $rewrite False sp_kont$ - | _ -> raise $exc$ ] - >> - | <:expr@_loc< let $p$ = Stream.count __strm in $f$ >> -> - try - if is_free "__strm" f then ge - else - let v = free_var_in_expr 's' f in - <:expr< - let $lid:v$ = __strm in - let $p$ = Stream.count __strm in $subst v f$ - >> - with - [ NotImpl -> ge ] - | <:expr@_loc< let $p$ = __strm in $e$ >> -> - <:expr< let $p$ = __strm in $rewrite False e$ >> - | <:expr@_loc< let $p$ = $f$ __strm in $sp_kont$ >> when top -> - <:expr< - match try Some ($f$ __strm) with [ Stream.Failure -> None ] with - [ Some $p$ -> $rewrite False sp_kont$ - | _ -> raise Stream.Failure ] - >> - | <:expr@_loc< let $p$ = $e$ in $sp_kont$ >> -> - if match e with - [ <:expr< match try Some $_$ with [ Stream.Failure -> None ] with - [ $list:_$ ] >> - | <:expr< match Stream.peek __strm with [ $list:_$ ] >> - | <:expr< try $_$ with [ Stream.Failure -> $_$ ] >> - | <:expr< let $_$ = Stream.count __strm in $_$ >> -> True - | _ -> False ] - then - let f = rewrite True <:expr< fun __strm -> $e$ >> in - let exc = - if top then <:expr< Stream.Failure >> - else <:expr< Stream.Error "" >> - in - <:expr< - match try Some ($f$ __strm) with [ Stream.Failure -> None ] with - [ Some $p$ -> $rewrite False sp_kont$ - | _ -> raise $exc$ ] - >> - else semantic _loc ge - | <:expr@_loc< match try Some $e$ with [ Stream.Failure -> None ] with - [ Some $p$ -> $sp_kont$ - | _ -> $p_kont$ ] >> -> - let f = parserify _loc e in - if not top && is_raise_failure p_kont then semantic _loc ge - else - let (p, f, sp_kont, p_kont) = - if top || is_raise_error p_kont then - (p, f, rewrite False sp_kont, rewrite top p_kont) - else - let f = - <:expr< - fun __strm -> - match - try Some ($f$ __strm) with [ Stream.Failure -> None ] - with - [ Some $p$ -> $rewrite False sp_kont$ - | _ -> $rewrite top p_kont$ ] - >> - in - (<:patt< a >>, f, <:expr< a >>, - <:expr< raise (Stream.Error "") >>) - in - <:expr< - match try Some ($f$ __strm) with [ Stream.Failure -> None ] with - [ Some $p$ -> $sp_kont$ - | _ -> $p_kont$ ] - >> - | <:expr< match Stream.peek __strm with [ $list:pel$ ] >> -> - let rec iter pel = - match pel with - [ [(<:patt< Some $p$ >>, eo, - <:expr< do { Stream.junk __strm; $sp_kont$ } >>); - (<:patt< _ >>, None, p_kont) :: _] -> - <:expr< - match Stream.peek __strm with - [ Some $p$ $when:eo$ -> - do { Stream.junk __strm; $rewrite False sp_kont$ } - | _ -> $rewrite top p_kont$ ] - >> - | [(<:patt< Some $p$ >>, eo, - <:expr< do { Stream.junk __strm; $sp_kont$ } >>) :: pel] -> - let p_kont = iter pel in - <:expr< - match Stream.peek __strm with - [ Some $p$ $when:eo$ -> - do { Stream.junk __strm; $rewrite False sp_kont$ } - | _ -> $p_kont$ ] - >> - | _ -> - <:expr< match Stream.peek __strm with [ $list:pel$ ] >> ] - in - iter pel - | <:expr@_loc< try Some $e$ with [ Stream.Failure -> $p_kont$ ] >> -> - let f = parserify _loc e in - let e = - <:expr< - match try Some ($f$ __strm) with [ Stream.Failure -> None ] with - [ Some a -> Some a - | _ -> $p_kont$ ] - >> - in - rewrite top e - | <:expr@_loc< try $e$ with [ Stream.Failure -> $p_kont$ ] >> -> - let f = parserify _loc e in - let e = - <:expr< - match try Some ($f$ __strm) with [ Stream.Failure -> None ] with - [ Some a -> a - | _ -> $rewrite top p_kont$ ] - >> - in - rewrite top e - | <:expr< $f$ __strm >> -> - if top then - <:expr< - match try Some ($f$ __strm) with [ Stream.Failure -> None ] with - [ Some a -> a - | _ -> raise Stream.Failure ] - >> - else - let v = free_var_in_expr 's' f in - <:expr< let $lid:v$ = __strm in $subst v f$ $lid:v$ >> - | e -> let loc = MLast.loc_of_expr e in semantic loc e ] -; - -value spc_of_parser = - let rec parser_cases e = - match e with - [ <:expr< - match try Some ($f$ __strm) with [ Stream.Failure -> None ] with - [ Some $p$ -> $sp_kont$ - | _ -> $p_kont$ ] - >> -> - let spc = (SPCnterm p f, None) in - let (sp, epo, e) = kont sp_kont in - [([spc :: sp], epo, e) :: parser_cases p_kont] - | <:expr< - match Stream.peek __strm with - [ Some $p$ $when:wo$ -> do { Stream.junk __strm; $sp_kont$ } - | _ -> $p_kont$ ] - >> -> - let spc = (SPCterm (p, wo), None) in - let (sp, epo, e) = kont sp_kont in - [([spc :: sp], epo, e) :: parser_cases p_kont] - | <:expr< let $p$ = __strm in $sp_kont$ >> -> - let spc = (SPCsterm p, None) in - let (sp, epo, e) = kont sp_kont in - [([spc :: sp], epo, e)] - | <:expr< let $p$ = Stream.count __strm in $e$ >> -> [([], Some p, e)] - | <:expr< raise Stream.Failure >> -> [] - | _ -> [([], None, e)] ] - and kont e = - match e with - [ <:expr< - match try Some ($f$ __strm) with [ Stream.Failure -> None ] with - [ Some $p$ -> $sp_kont$ - | _ -> raise (Stream.Error $err$) ] - >> -> - let err = - match err with - [ <:expr< "" >> -> None - | _ -> Some err ] - in - let spc = (SPCnterm p f, err) in - let (sp, epo, e) = kont sp_kont in - ([spc :: sp], epo, e) - | <:expr< - match Stream.peek __strm with - [ Some $p$ $when:wo$ -> do { Stream.junk __strm; $sp_kont$ } - | _ -> raise (Stream.Error $err$) ] - >> -> - let err = - match err with - [ <:expr< "" >> -> None - | _ -> Some err ] - in - let spc = (SPCterm (p, wo), err) in - let (sp, epo, e) = kont sp_kont in - ([spc :: sp], epo, e) - | <:expr< let $p$ = __strm in $sp_kont$ >> -> - let spc = (SPCsterm p, None) in - let (sp, epo, e) = kont sp_kont in - ([spc :: sp], epo, e) - | <:expr< let $p$ = Stream.count __strm in $e$ >> -> ([], Some p, e) - | _ -> ([], None, e) ] - in - parser_cases -; - -value parser_of_expr e = spc_of_parser (rewrite_parser e); diff -Nru ocaml-3.12.1/camlp4/unmaintained/etc/parserify.mli ocaml-4.01.0/camlp4/unmaintained/etc/parserify.mli --- ocaml-3.12.1/camlp4/unmaintained/etc/parserify.mli 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/etc/parserify.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,12 +0,0 @@ -(* camlp4r *) - - -type spc = - [ SPCterm of (MLast.patt * option MLast.expr) - | SPCnterm of MLast.patt and MLast.expr - | SPCsterm of MLast.patt ] -; - -value parser_of_expr : - MLast.expr -> - list (list (spc * option MLast.expr) * option MLast.patt * MLast.expr); diff -Nru ocaml-3.12.1/camlp4/unmaintained/etc/pr_depend.ml ocaml-4.01.0/camlp4/unmaintained/etc/pr_depend.ml --- ocaml-3.12.1/camlp4/unmaintained/etc/pr_depend.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/etc/pr_depend.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,321 +0,0 @@ -(* camlp4r *) - - -open MLast; - -value not_impl name x = - Format.eprintf "pr_depend: not impl: %s; %a@." name ObjTools.print (Obj.repr x) -; - -module StrSet = - Set.Make (struct type t = string; value compare = compare; end) -; - -value fset = ref StrSet.empty; -value addmodule s = fset.val := StrSet.add s fset.val; - -value list = List.iter; - -value option f = - fun - [ Some x -> f x - | None -> () ] -; - -value longident = - fun - [ [s; _ :: _] -> addmodule s - | _ -> () ] -; - -value rec ctyp = - fun - [ TyAcc _ t _ -> ctyp_module t - | TyAli _ t1 t2 -> do { ctyp t1; ctyp t2; } - | TyApp _ t1 t2 -> do { ctyp t1; ctyp t2; } - | TyAny _ -> () - | TyArr _ t1 t2 -> do { ctyp t1; ctyp t2; } - | TyCls _ li -> longident li - | TyLab _ _ t -> ctyp t - | TyLid _ _ -> () - | TyMan _ t1 t2 -> do { ctyp t1; ctyp t2; } - | TyOlb _ _ t -> ctyp t - | TyQuo _ _ -> () - | TyRec _ ldl -> list label_decl ldl - | TySum _ cdl -> list constr_decl cdl - | TyPrv _ t -> ctyp t - | TyTup _ tl -> list ctyp tl - | TyVrn _ sbtll _ -> list variant sbtll - | x -> not_impl "ctyp" x ] -and constr_decl (_, _, tl) = list ctyp tl -and label_decl (_, _, _, t) = ctyp t -and variant = - fun - [ RfTag _ _ tl -> list ctyp tl - | RfInh t -> ctyp t ] -and ctyp_module = - fun - [ TyAcc _ t _ -> ctyp_module t - | TyApp _ t1 t2 -> do { ctyp t1; ctyp t2; } - | TyUid _ m -> addmodule m - | x -> not_impl "ctyp_module" x ] -; - -value rec patt = - fun - [ PaAcc _ p _ -> patt_module p - | PaAli _ p1 p2 -> do { patt p1; patt p2; } - | PaAny _ -> () - | PaApp _ p1 p2 -> do { patt p1; patt p2; } - | PaArr _ pl -> list patt pl - | PaChr _ _ -> () - | PaInt _ _ -> () - | PaLab _ _ po -> option patt po - | PaLid _ _ -> () - | PaOlb _ _ peoo -> - option (fun (p, eo) -> do { patt p; option expr eo }) peoo - | PaOrp _ p1 p2 -> do { patt p1; patt p2; } - | PaRec _ lpl -> list label_patt lpl - | PaRng _ p1 p2 -> do { patt p1; patt p2; } - | PaStr _ _ -> () - | PaTup _ pl -> list patt pl - | PaTyc _ p t -> do { patt p; ctyp t; } - | PaUid _ _ -> () - | PaVrn _ _ -> () - | x -> not_impl "patt" x ] -and patt_module = - fun - [ PaUid _ m -> addmodule m - | PaAcc _ p _ -> patt_module p - | x -> not_impl "patt_module" x ] -and label_patt (p1, p2) = do { patt p1; patt p2; } -and expr = - fun - [ ExAcc _ e1 e2 -> do { expr_module e1; expr e2; } - | ExApp _ e1 e2 -> do { expr e1; expr e2; } - | ExAre _ e1 e2 -> do { expr e1; expr e2; } - | ExArr _ el -> list expr el - | ExAsf _ -> () - | ExAsr _ e -> do { expr e; } - | ExAss _ e1 e2 -> do { expr e1; expr e2; } - | ExChr _ _ -> () - | ExCoe _ e t1 t2 -> do { expr e; option ctyp t1; ctyp t2 } - | ExFor _ _ e1 e2 _ el -> do { expr e1; expr e2; list expr el; } - | ExFun _ pwel -> list match_case pwel - | ExIfe _ e1 e2 e3 -> do { expr e1; expr e2; expr e3; } - | ExInt _ _ -> () - | ExInt32 _ _ -> () - | ExInt64 _ _ -> () - | ExNativeInt _ _ -> () - | ExFlo _ _ -> () - | ExLab _ _ eo -> option expr eo - | ExLaz _ e -> expr e - | ExLet _ _ pel e -> do { list let_binding pel; expr e; } - | ExLid _ _ -> () - | ExLmd _ _ me e -> do { module_expr me; expr e; } - | ExMat _ e pwel -> do { expr e; list match_case pwel; } - | ExNew _ li -> longident li - | ExOlb _ _ eo -> option expr eo - | ExRec _ lel w -> do { list label_expr lel; option expr w; } - | ExSeq _ el -> list expr el - | ExSnd _ e _ -> expr e - | ExSte _ e1 e2 -> do { expr e1; expr e2; } - | ExStr _ _ -> () - | ExTry _ e pwel -> do { expr e; list match_case pwel; } - | ExTup _ el -> list expr el - | ExTyc _ e t -> do { expr e; ctyp t; } - | ExUid _ _ -> () - | ExVrn _ _ -> () - | ExWhi _ e el -> do { expr e; list expr el; } - | x -> not_impl "expr" x ] -and expr_module = - fun - [ ExUid _ m -> addmodule m - | e -> expr e ] -and let_binding (p, e) = do { patt p; expr e } -and label_expr (p, e) = do { patt p; expr e } -and match_case (p, w, e) = do { patt p; option expr w; expr e; } -and module_type = - fun - [ MtAcc _ (MtUid _ m) _ -> addmodule m - | MtFun _ _ mt1 mt2 -> do { module_type mt1; module_type mt2; } - | MtSig _ sil -> list sig_item sil - | MtUid _ _ -> () - | MtWit _ mt wc -> do { module_type mt; list with_constr wc; } - | x -> not_impl "module_type" x ] -and with_constr = - fun - [ WcTyp _ _ _ t -> ctyp t - | x -> not_impl "with_constr" x ] -and sig_item = - fun - [ SgDcl _ sil -> list sig_item sil - | SgExc _ _ tl -> list ctyp tl - | SgExt _ _ t _ -> ctyp t - | SgMod _ _ mt -> module_type mt - | SgRecMod _ mts -> list (fun (_, mt) -> module_type mt) mts - | SgMty _ _ mt -> module_type mt - | SgOpn _ [s :: _] -> addmodule s - | SgTyp _ tdl -> list type_decl tdl - | SgVal _ _ t -> ctyp t - | x -> not_impl "sig_item" x ] -and module_expr = - fun - [ MeAcc _ (MeUid _ m) _ -> addmodule m - | MeApp _ me1 me2 -> do { module_expr me1; module_expr me2; } - | MeFun _ _ mt me -> do { module_type mt; module_expr me; } - | MeStr _ sil -> list str_item sil - | MeTyc _ me mt -> do { module_expr me; module_type mt; } - | MeUid _ _ -> () - | x -> not_impl "module_expr" x ] -and str_item = - fun - [ StCls _ cil -> list (fun ci -> class_expr ci.ciExp) cil - | StDcl _ sil -> list str_item sil - | StDir _ _ _ -> () - | StExc _ _ tl _ -> list ctyp tl - | StExp _ e -> expr e - | StExt _ _ t _ -> ctyp t - | StMod _ _ me -> module_expr me - | StRecMod _ nmtmes -> list (fun (_, mt, me) -> do { module_expr me; module_type mt; }) nmtmes - | StMty _ _ mt -> module_type mt - | StOpn _ [s :: _] -> addmodule s - | StTyp _ tdl -> list type_decl tdl - | StVal _ _ pel -> list let_binding pel - | x -> not_impl "str_item" x ] -and type_decl (_, _, t, _) = ctyp t -and class_expr = - fun - [ CeApp _ ce e -> do { class_expr ce; expr e; } - | CeCon _ li tl -> do { longident li; list ctyp tl; } - | CeFun _ p ce -> do { patt p; class_expr ce; } - | CeLet _ _ pel ce -> do { list let_binding pel; class_expr ce; } - | CeStr _ po csil -> do { option patt po; list class_str_item csil; } - | x -> not_impl "class_expr" x ] -and class_str_item = - fun - [ CrInh _ ce _ -> class_expr ce - | CrIni _ e -> expr e - | CrMth _ _ _ e None -> expr e - | CrMth _ _ _ e (Some t) -> do { expr e; ctyp t } - | CrVal _ _ _ e -> expr e - | CrVir _ _ _ t -> ctyp t - | x -> not_impl "class_str_item" x ] -; - -(* Print dependencies *) - -value load_path = ref [""]; - -value find_in_path path name = - if not (Filename.is_implicit name) then - if Sys.file_exists name then name else raise Not_found - else - let rec try_dir = - fun - [ [] -> raise Not_found - | [dir :: rem] -> - let fullname = Filename.concat dir name in - if Sys.file_exists fullname then fullname else try_dir rem ] - in - try_dir path -; - -value find_depend modname (byt_deps, opt_deps) = - let name = String.uncapitalize modname in - try - let filename = find_in_path load_path.val (name ^ ".mli") in - let basename = Filename.chop_suffix filename ".mli" in - let byt_dep = basename ^ ".cmi" in - let opt_dep = - if Sys.file_exists (basename ^ ".ml") then basename ^ ".cmx" - else basename ^ ".cmi" - in - ([byt_dep :: byt_deps], [opt_dep :: opt_deps]) - with - [ Not_found -> - try - let filename = find_in_path load_path.val (name ^ ".ml") in - let basename = Filename.chop_suffix filename ".ml" in - ([basename ^ ".cmo" :: byt_deps], [basename ^ ".cmx" :: opt_deps]) - with - [ Not_found -> (byt_deps, opt_deps) ] ] -; - -value (depends_on, escaped_eol) = - match Sys.os_type with - [ "Unix" | "Win32" | "Cygwin" -> (": ", "\\\n ") - | "MacOS" -> ("\196 ", "\182\n ") - | _ -> assert False ] -; - -value print_depend target_file deps = - match deps with - [ [] -> () - | _ -> - do { - print_string target_file; - print_string depends_on; - let rec print_items pos = - fun - [ [] -> print_string "\n" - | [dep :: rem] -> - if pos + String.length dep <= 77 then do { - print_string dep; - print_string " "; - print_items (pos + String.length dep + 1) rem - } - else do { - print_string escaped_eol; - print_string dep; - print_string " "; - print_items (String.length dep + 5) rem - } ] - in - print_items (String.length target_file + 2) deps - } ] -; - -(* Main *) - -value depend_sig ast = - do { - fset.val := StrSet.empty; - List.iter (fun (si, _) -> sig_item si) ast; - let basename = Filename.chop_suffix Pcaml.input_file.val ".mli" in - let (byt_deps, _) = StrSet.fold find_depend fset.val ([], []) in - print_depend (basename ^ ".cmi") byt_deps; - } -; - -value depend_str ast = - do { - fset.val := StrSet.empty; - List.iter (fun (si, _) -> str_item si) ast; - let basename = - if Filename.check_suffix Pcaml.input_file.val ".ml" then - Filename.chop_suffix Pcaml.input_file.val ".ml" - else - try - let len = String.rindex Pcaml.input_file.val '.' in - String.sub Pcaml.input_file.val 0 len - with - [ Failure _ | Not_found -> Pcaml.input_file.val ] - in - let init_deps = - if Sys.file_exists (basename ^ ".mli") then - let cmi_name = basename ^ ".cmi" in ([cmi_name], [cmi_name]) - else ([], []) - in - let (byt_deps, opt_deps) = StrSet.fold find_depend fset.val init_deps in - print_depend (basename ^ ".cmo") byt_deps; - print_depend (basename ^ ".cmx") opt_deps; - } -; - -Pcaml.print_interf.val := depend_sig; -Pcaml.print_implem.val := depend_str; - -Pcaml.add_option "-I" - (Arg.String (fun dir -> load_path.val := load_path.val @ [dir])) - " Add to the list of include directories."; diff -Nru ocaml-3.12.1/camlp4/unmaintained/etc/pr_extend.ml ocaml-4.01.0/camlp4/unmaintained/etc/pr_extend.ml --- ocaml-3.12.1/camlp4/unmaintained/etc/pr_extend.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/etc/pr_extend.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,518 +0,0 @@ -(* camlp4r q_MLast.cmo ./pa_extfun.cmo *) -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2002 Institut National de Recherche en Informatique et *) -(* Automatique. Distributed only by permission. *) -(* *) -(***********************************************************************) - - - -open Pcaml; -open Spretty; - -value no_slist = ref False; - -value expr e dg k = pr_expr.pr_fun "top" e dg k; -value patt e dg k = pr_patt.pr_fun "top" e dg k; - -(* Utilities *) - -value rec list elem el k = - match el with - [ [] -> k - | [x] -> [: `elem x k :] - | [x :: l] -> [: `elem x [: :]; list elem l k :] ] -; - -value rec listws elem sep el k = - match el with - [ [] -> k - | [x] -> [: `elem x k :] - | [x :: l] -> [: `elem x [: `sep :]; listws elem sep l k :] ] -; - -value rec listwbws elem b sep el dg k = - match el with - [ [] -> [: b; k :] - | [x] -> [: `elem b x dg k :] - | [x :: l] -> - let sdg = - match sep with - [ S _ x -> x - | _ -> "" ] - in - [: `elem b x sdg [: :]; listwbws elem [: `sep :] sep l dg k :] ] -; - -(* Extracting *) - -value rec get_globals = - fun - [ [(<:patt< _ >>, <:expr< ($e$ : $uid:gmod1$.Entry.e '$_$) >>) :: pel] -> - let (gmod, gl) = get_globals pel in - if gmod = "" || gmod = gmod1 then (gmod1, [e :: gl]) - else raise Not_found - | [] -> ("", []) - | _ -> raise Not_found ] -; - -value rec get_locals = - fun - [ [(<:patt< $_$ >>, - <:expr< (grammar_entry_create $_$ : $_$) >>) :: pel] -> - get_locals pel - | [] -> () - | _ -> raise Not_found ] -; - -value unposition = - fun - [ <:expr< None >> -> None - | <:expr< Some Gramext.First >> -> Some Gramext.First - | <:expr< Some Gramext.Last >> -> Some Gramext.Last - | <:expr< Some (Gramext.Before $str:s$) >> -> Some (Gramext.Before s) - | <:expr< Some (Gramext.After $str:s$) >> -> Some (Gramext.After s) - | <:expr< Some (Gramext.Level $str:s$) >> -> Some (Gramext.Level s) - | _ -> raise Not_found ] -; - -value unlabel = - fun - [ <:expr< None >> -> None - | <:expr< Some $str:s$ >> -> Some s - | _ -> raise Not_found ] -; - -value unassoc = - fun - [ <:expr< None >> -> None - | <:expr< Some Gramext.NonA >> -> Some Gramext.NonA - | <:expr< Some Gramext.LeftA >> -> Some Gramext.LeftA - | <:expr< Some Gramext.RightA >> -> Some Gramext.RightA - | _ -> raise Not_found ] -; - -value rec unaction = - fun - [ <:expr< fun ($lid:locp$ : Loc.t) -> ($a$ : $_$) >> - when locp = Stdpp.loc_name.val -> - let ao = - match a with - [ <:expr< () >> -> None - | _ -> Some a ] - in - ([], ao) - | <:expr< fun ($p$ : $_$) -> $e$ >> -> - let (pl, a) = unaction e in ([p :: pl], a) - | <:expr@_loc< fun _ -> $e$ >> -> - let (pl, a) = unaction e in ([ <:patt< _ >> :: pl ], a) - | _ -> raise Not_found ] -; - -value untoken = - fun - [ <:expr< ($str:x$, $str:y$) >> -> (x, y) - | _ -> raise Not_found ] -; - -type symbol = - [ Snterm of MLast.expr - | Snterml of MLast.expr and string - | Slist0 of symbol - | Slist0sep of symbol and symbol - | Slist1 of symbol - | Slist1sep of symbol and symbol - | Sopt of symbol - | Sself - | Snext - | Stoken of Token.pattern - | Srules of list (list (option MLast.patt * symbol) * option MLast.expr) ] -; - -value rec unsymbol = - fun - [ <:expr< Gramext.Snterm ($uid:_$.Entry.obj ($e$ : $_$)) >> -> Snterm e - | <:expr< Gramext.Snterml ($uid:_$.Entry.obj ($e$ : $_$)) $str:s$ >> -> - Snterml e s - | <:expr< Gramext.Snterml ($uid:_$.Entry.obj ($e$ : $_$), $str:s$) >> -> - Snterml e s - | <:expr< Gramext.Slist0 $e$ >> -> Slist0 (unsymbol e) - | <:expr< Gramext.Slist0sep $e1$ $e2$ >> -> - Slist0sep (unsymbol e1) (unsymbol e2) - | <:expr< Gramext.Slist0sep ($e1$, $e2$) >> -> - Slist0sep (unsymbol e1) (unsymbol e2) - | <:expr< Gramext.Slist1 $e$ >> -> Slist1 (unsymbol e) - | <:expr< Gramext.Slist1sep $e1$ $e2$ >> -> - Slist1sep (unsymbol e1) (unsymbol e2) - | <:expr< Gramext.Slist1sep ($e1$, $e2$) >> -> - Slist1sep (unsymbol e1) (unsymbol e2) - | <:expr< Gramext.Sopt $e$ >> -> Sopt (unsymbol e) - | <:expr< Gramext.Sself >> -> Sself - | <:expr< Gramext.Snext >> -> Snext - | <:expr< Gramext.Stoken $e$ >> -> Stoken (untoken e) - | <:expr< Gramext.srules $e$ >> -> Srules (unrule_list [] e) - | _ -> raise Not_found ] -and unpsymbol_list pl e = - match (pl, e) with - [ ([], <:expr< [] >>) -> [] - | ([p :: pl], <:expr< [$e$ :: $el$] >>) -> - let op = - match p with - [ <:patt< _ >> -> None - | _ -> Some p ] - in - [(op, unsymbol e) :: unpsymbol_list pl el] - | _ -> raise Not_found ] -and unrule = - fun - [ <:expr@_loc< ($e1$, Gramext.action $e2$) >> -> - let (pl, a) = - match unaction e2 with - [ ([], None) -> ([], Some <:expr< () >>) - | x -> x ] - in - let sl = unpsymbol_list (List.rev pl) e1 in - (sl, a) - | _ -> raise Not_found ] -and unrule_list rl = - fun - [ <:expr< [$e$ :: $el$] >> -> unrule_list [unrule e :: rl] el - | <:expr< [] >> -> rl - | _ -> raise Not_found ] -; - -value unlevel = - fun - [ <:expr< ($e1$, $e2$, $e3$) >> -> - (unlabel e1, unassoc e2, unrule_list [] e3) - | _ -> raise Not_found ] -; - -value rec unlevel_list = - fun - [ <:expr< [$e$ :: $el$] >> -> [unlevel e :: unlevel_list el] - | <:expr< [] >> -> [] - | _ -> raise Not_found ] -; - -value unentry = - fun - [ <:expr< (Grammar.Entry.obj ($e$ : Grammar.Entry.e '$_$), $pos$, $ll$) >> -> - (e, unposition pos, unlevel_list ll) - | _ -> raise Not_found ] -; - -value rec unentry_list = - fun - [ <:expr< [$e$ :: $el$] >> -> [unentry e :: unentry_list el] - | <:expr< [] >> -> [] - | _ -> raise Not_found ] -; - -value unextend_body e = - let ((_, globals), e) = - match e with - [ <:expr< let $list:pel$ in $e1$ >> -> - try (get_globals pel, e1) with - [ Not_found -> (("", []), e) ] - | _ -> (("", []), e) ] - in - let e = - match e with - [ <:expr< - let grammar_entry_create s = - Grammar.Entry.create (Grammar.of_entry $_$) s - in - $e$ >> -> - let e = - match e with - [ <:expr< let $list:pel$ in $e1$ >> -> - try let _ = get_locals pel in e1 with - [ Not_found -> e ] - | _ -> e ] - in - e - | _ -> e ] - in - let el = unentry_list e in - (globals, el) -; - -value ungextend_body e = - let e = - match e with - [ <:expr< - let grammar_entry_create = Gram.Entry.create in - let $list:ll$ in $e$ - >> -> - let _ = get_locals ll in e - | _ -> e ] - in - match e with - [ <:expr< do { $list:el$ } >> -> - List.map - (fun - [ <:expr< $uid:_$.extend ($e$ : $uid:_$.Entry.e '$_$) $pos$ $ll$ >> -> - (e, unposition pos, unlevel_list ll) - | _ -> raise Not_found ]) - el - | _ -> raise Not_found ] -; - -(* Printing *) - -value ident s k = HVbox [: `S LR s; k :]; -value string s k = HVbox [: `S LR ("\"" ^ s ^ "\""); k :]; - -value position = - fun - [ None -> [: :] - | Some Gramext.First -> [: `S LR "FIRST" :] - | Some Gramext.Last -> [: `S LR "LAST" :] - | Some (Gramext.Before s) -> [: `S LR "BEFORE"; `string s [: :] :] - | Some (Gramext.After s) -> [: `S LR "AFTER"; `string s [: :] :] - | Some (Gramext.Level s) -> [: `S LR "LEVEL"; `string s [: :] :] ] -; - -value action expr a dg k = - expr a dg k -; - -value token (con, prm) k = - if con = "" then string prm k - else if prm = "" then HVbox [: `S LR con; k :] - else HVbox [: `S LR con; `string prm k :] -; - -value simplify_rules rl = - try - List.map - (fun - [ ([(Some <:patt< $lid:x$ >>, s)], Some <:expr< $lid:y$ >>) -> - if x = y then ([(None, s)], None) else raise Exit - | ([], _) as r -> r - | _ -> raise Exit ]) - rl - with - [ Exit -> rl ] -; - -value rec symbol s k = - match s with - [ Snterm e -> expr e "" k - | Snterml e s -> HVbox [: `expr e "" [: :]; `S LR "LEVEL"; `string s k :] - | Slist0 s -> HVbox [: `S LR "LIST0"; `symbol s k :] - | Slist0sep s sep -> - HVbox - [: `S LR "LIST0"; `symbol s [: :]; `S LR "SEP"; - `symbol sep k :] - | Slist1 s -> HVbox [: `S LR "LIST1"; `symbol s k :] - | Slist1sep s sep -> - HVbox - [: `S LR "LIST1"; `symbol s [: :]; `S LR "SEP"; - `symbol sep k :] - | Sopt s -> HVbox [: `S LR "OPT"; `symbol s k :] - | Sself -> HVbox [: `S LR "SELF"; k :] - | Snext -> HVbox [: `S LR "NEXT"; k :] - | Stoken tok -> token tok k - | Srules - [([(Some <:patt< a >>, Snterm <:expr< a_list >>)], Some <:expr< a >>); - ([(Some <:patt< a >>, - ((Slist0 _ | Slist1 _ | Slist0sep _ _ | Slist1sep _ _) as s))], - Some <:expr< Qast.List a >>)] - when not no_slist.val - -> - match s with - [ Slist0 s -> HVbox [: `S LR "SLIST0"; `simple_symbol s k :] - | Slist1 s -> HVbox [: `S LR "SLIST1"; `simple_symbol s k :] - | Slist0sep s sep -> - HVbox - [: `S LR "SLIST0"; `simple_symbol s [: :]; `S LR "SEP"; - `symbol sep k :] - | Slist1sep s sep -> - HVbox - [: `S LR "SLIST1"; `simple_symbol s [: :]; `S LR "SEP"; - `simple_symbol sep k :] - | _ -> assert False ] - | Srules - [([(Some <:patt< a >>, Snterm <:expr< a_opt >>)], Some <:expr< a >>); - ([(Some <:patt< a >>, Sopt s)], Some <:expr< Qast.Option a >>)] - when not no_slist.val - -> - let s = - match s with - [ Srules - [([(Some <:patt< x >>, Stoken ("", str))], - Some <:expr< Qast.Str x >>)] -> - Stoken ("", str) - | s -> s ] - in - HVbox [: `S LR "SOPT"; `simple_symbol s k :] - | Srules rl -> - let rl = simplify_rules rl in - HVbox [: `HVbox [: :]; rule_list rl k :] ] -and simple_symbol s k = - match s with - [ Snterml _ _ -> HVbox [: `S LO "("; `symbol s [: `S RO ")"; k :] :] - | s -> symbol s k ] -and psymbol (p, s) k = - match p with - [ None -> symbol s k - | Some p -> HVbox [: `patt p "" [: `S LR "=" :]; `symbol s k :] ] -and psymbol_list sl k = - listws psymbol (S RO ";") sl k -and rule b (sl, a) dg k = - match a with - [ None -> HVbox [: b; `HOVbox [: psymbol_list sl k :] :] - | Some a -> - HVbox - [: b; - `HOVbox - [: `HOVbox - [: `HVbox [: :]; - psymbol_list sl [: `S LR "->" :] :]; - `action expr a dg k :] :] ] -and rule_list ll k = - listwbws rule [: `S LR "[" :] (S LR "|") ll "" - [: `S LR "]"; k :] -; - -value label = - fun - [ Some s -> [: `S LR ("\"" ^ s ^ "\"") :] - | None -> [: :] ] -; - -value intloc loc = ((Loc.start_off loc), (Loc.stop_off loc)); - -value intloc2 (bp, ep) = (bp.Lexing.pos_cnum, ep.Lexing.pos_cnum); - - -value assoc = - fun - [ Some Gramext.NonA -> [: `S LR "NONA" :] - | Some Gramext.LeftA -> [: `S LR "LEFTA" :] - | Some Gramext.RightA -> [: `S LR "RIGHTA" :] - | None -> [: :] ] -; - -value level b (lab, ass, rl) _ k = - let s = - if rl = [] then [: `S LR "[ ]"; k :] - else [: `Vbox [: `HVbox [: :]; rule_list rl k :] :] - in - match (lab, ass) with - [ (None, None) -> HVbox [: b; s :] - | _ -> - Vbox - [: `HVbox [: b; label lab; assoc ass :]; - `HVbox [: `HVbox [: :]; s :] :] ] -; - -value level_list ll k = - Vbox - [: `HVbox [: :]; - listwbws level [: `S LR "[" :] (S LR "|") ll "" - [: `S LR "]"; k :] :] -; - -value entry (e, pos, ll) k = - BEbox - [: `LocInfo (intloc(MLast.loc_of_expr e)) - (HVbox [: `expr e "" [: `S RO ":" :]; position pos :]); - `level_list ll [: :]; - `HVbox [: `S RO ";"; k :] :] -; - -value entry_list el k = - Vbox [: `HVbox [: :]; list entry el k :] -; - -value extend_body (globals, e) k = - let s = entry_list e k in - match globals with - [ [] -> s - | sl -> - HVbox - [: `HVbox [: :]; - `HOVbox - [: `S LR "GLOBAL"; `S RO ":"; - list (fun e k -> HVbox [: `expr e "" k :]) sl - [: `S RO ";" :] :]; - `s :] ] -; - -value extend e _ k = - match e with - [ <:expr< Grammar.extend $e$ >> -> - try - let ex = unextend_body e in - BEbox - [: `S LR "EXTEND"; `extend_body ex [: :]; - `HVbox [: `S LR "END"; k :] :] - with - [ Not_found -> - HVbox - [: `S LR "Grammar.extend"; - `HOVbox - [: `S LO "("; - `expr e "" [: `HVbox [: `S RO ")"; k :] :] :] :] ] - | _ -> expr e "" k ] -; - -value get_gextend = - fun - [ <:expr< let $list:gl$ in $e$ >> -> - try - let (gmod, gl) = get_globals gl in - let el = ungextend_body e in - Some (gmod, gl, el) - with - [ Not_found -> None ] - | _ -> None ] -; - -value gextend e _ k = - match get_gextend e with - [ Some (gmod, gl, el) -> - BEbox - [: `HVbox [: `S LR "GEXTEND"; `S LR gmod :]; - `extend_body (gl, el) [: :]; - `HVbox [: `S LR "END"; k :] :] - | None -> expr e "" k ] -; - -value is_gextend e = get_gextend e <> None; - -(* Printer extensions *) - -let lev = - try find_pr_level "expr1" pr_expr.pr_levels with - [ Failure _ -> find_pr_level "top" pr_expr.pr_levels ] -in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< let $list:_$ in $_$ >> as e when is_gextend e -> - fun _ next _ k -> [: `next e "" k :] ]; - -let lev = find_pr_level "apply" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< Grammar.extend $_$ >> as e -> - fun _ next _ k -> [: `next e "" k :] ]; - -let lev = find_pr_level "simple" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< Grammar.extend $_$ >> as e -> - fun _ _ _ k -> [: `extend e "" k :] - | <:expr< let $list:_$ in $_$ >> as e when is_gextend e -> - fun _ _ _ k -> [: `gextend e "" k :] ]; - -Pcaml.add_option "-no_slist" (Arg.Set no_slist) - "Don't reconstruct SLIST and SOPT"; diff -Nru ocaml-3.12.1/camlp4/unmaintained/etc/pr_extfun.ml ocaml-4.01.0/camlp4/unmaintained/etc/pr_extfun.ml --- ocaml-3.12.1/camlp4/unmaintained/etc/pr_extfun.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/etc/pr_extfun.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,92 +0,0 @@ -(* camlp4r q_MLast.cmo ./pa_extfun.cmo *) - - -open Pcaml; -open Spretty; - -value _loc = Loc.mk "FIXME pr_extfun.ml"; - -value expr e dg k = pr_expr.pr_fun "top" e dg k; -value patt e dg k = pr_patt.pr_fun "top" e dg k; - -value rec un_extfun rpel = - fun - [ <:expr< [ ($_$, $_$, fun [ $list:pel$ ]) :: $el$ ] >> -> - let (p, wo, e) = - match pel with - [ [(p, wo, <:expr< Some $e$ >>); - (<:patt< _ >>, None, <:expr< None >>)] -> - (p, wo, e) - | [(p, wo, <:expr< Some $e$ >>)] -> (p, wo, e) - | _ -> raise Not_found ] - in - let rpel = - match rpel with - [ [(p1, wo1, e1) :: pel] -> - if wo1 = wo && e1 = e then - let p = - match (p1, p) with - [ (<:patt< ($x1$ as $x2$) >>, <:patt< ($y1$ as $y2$) >>) -> - if x2 = y2 then <:patt< ($x1$ | $y1$ as $x2$) >> - else <:patt< $p1$ | $p$ >> - | _ -> <:patt< $p1$ | $p$ >> ] - in - [(p, wo, e) :: pel] - else [(p, wo, e) :: rpel] - | [] -> [(p, wo, e)] ] - in - un_extfun rpel el - | <:expr< [] >> -> List.rev rpel - | _ -> raise Not_found ] -; - -value rec listwbws elem b sep el k = - match el with - [ [] -> [: b; k :] - | [x] -> [: `elem b x k :] - | [x :: l] -> [: `elem b x [: :]; listwbws elem [: `sep :] sep l k :] ] -; - -value rec match_assoc_list pwel k = - match pwel with - [ [pwe] -> match_assoc [: `S LR "[" :] pwe [: `S LR "]"; k :] - | pel -> - Vbox - [: `HVbox [: :]; - listwbws match_assoc [: `S LR "[" :] (S LR "|") pel - [: `S LR "]"; k :] :] ] -and match_assoc b (p, w, e) k = - let s = - let (p, k) = - match p with - [ <:patt< ($p$ as $p2$) >> -> (p, [: `S LR "as"; `patt p2 "" [: :] :]) - | _ -> (p, [: :]) ] - in - match w with - [ Some e1 -> - [: `HVbox - [: `HVbox [: :]; `patt p "" k; - `HVbox [: `S LR "when"; `expr e1 "" [: `S LR "->" :] :] :] :] - | _ -> [: `patt p "" [: k; `S LR "->" :] :] ] - in - HVbox [: b; `HVbox [: `HVbox s; `expr e "" k :] :] -; - -let lev = find_pr_level "top" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< Extfun.extend $e$ $list$ >> as ge -> - fun _ next dg k -> - try - let pel = un_extfun [] list in - [: `HVbox [: :]; - `BEbox [: `S LR "extfun"; `expr e "" [: :]; `S LR "with" :]; - `match_assoc_list pel k :] - with - [ Not_found -> [: `next ge dg k :] ] ]; - -let lev = find_pr_level "apply" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< Extfun.extend $_$ $_$ >> as ge -> - fun _ next dg k -> [: `next ge dg k :] ]; diff -Nru ocaml-3.12.1/camlp4/unmaintained/etc/pr_null.ml ocaml-4.01.0/camlp4/unmaintained/etc/pr_null.ml --- ocaml-3.12.1/camlp4/unmaintained/etc/pr_null.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/etc/pr_null.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,16 +0,0 @@ -(* camlp4r *) -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1998 Institut National de Recherche en Informatique et *) -(* Automatique. Distributed only by permission. *) -(* *) -(***********************************************************************) - - - -Pcaml.print_interf.val := fun _ -> (); -Pcaml.print_implem.val := fun _ -> (); diff -Nru ocaml-3.12.1/camlp4/unmaintained/etc/pr_op.ml ocaml-4.01.0/camlp4/unmaintained/etc/pr_op.ml --- ocaml-3.12.1/camlp4/unmaintained/etc/pr_op.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/etc/pr_op.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,210 +0,0 @@ -(* camlp4r q_MLast.cmo ./pa_extfun.cmo *) -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1998 Institut National de Recherche en Informatique et *) -(* Automatique. Distributed only by permission. *) -(* *) -(***********************************************************************) - - - -open Pcaml; -open Spretty; - -value expr e dg k = pr_expr.pr_fun "top" e dg k; -value patt e dg k = pr_patt.pr_fun "top" e dg k; - -value spatt p dg k = - match p with - [ <:patt< $lid:s$ >> -> - if String.length s >= 2 && s.[1] == ''' then - HVbox [: `S LR (" " ^ s); k :] - else patt p dg k - | _ -> patt p dg k ] -; - -(* Streams *) - -value stream e _ k = - let rec get = - fun - [ <:expr< Stream.iapp $x$ $y$ >> -> [(False, x) :: get y] - | <:expr< Stream.icons $x$ $y$ >> -> [(True, x) :: get y] - | <:expr< Stream.ising $x$ >> -> [(True, x)] - | <:expr< Stream.lapp (fun _ -> $x$) $y$ >> -> [(False, x) :: get y] - | <:expr< Stream.lcons (fun _ -> $x$) $y$ >> -> [(True, x) :: get y] - | <:expr< Stream.lsing (fun _ -> $x$) >> -> [(True, x)] - | <:expr< Stream.sempty >> -> [] - | <:expr< Stream.slazy (fun _ -> $x$) >> -> [(False, x)] - | <:expr< Stream.slazy $x$ >> -> [(False, <:expr< $x$ () >>)] - | e -> [(False, e)] ] - in - let elem e dg k = - match e with - [ (True, e) -> [: `HOVbox [: `S LO "'"; `expr e dg k :] :] - | (False, e) -> [: `expr e dg k :] ] - in - let rec glop e k = - match e with - [ [] -> k - | [e] -> [: elem e "" k :] - | [e :: el] -> [: elem e ";" [: `S RO ";" :]; glop el k :] ] - in - HOVbox [: `S LR "[<"; glop (get e) [: `S LR ">]"; k :] :] -; - -(* Parsers *) - -value parser_cases b spel dg k = - let rec parser_cases b spel dg k = - match spel with - [ [] -> [: `HVbox [: b; k :] :] - | [(sp, epo, e)] -> [: `parser_case b sp epo e dg k :] - | [(sp, epo, e) :: spel] -> - [: `parser_case b sp epo e "|" [: :]; - parser_cases [: `S LR "|" :] spel dg k :] ] - and parser_case b sp epo e dg k = - let epo = - match epo with - [ Some p -> [: `patt p "" [: `S LR "->" :] :] - | _ -> [: `S LR "->" :] ] - in - HVbox - [: b; - `HOVbox - [: `HOVbox - [: `S LR "[<"; - stream_patt [: :] sp [: `S LR ">]"; epo :] :]; - `expr e dg k :] :] - and stream_patt b sp k = - match sp with - [ [] -> [: `HVbox [: b; k :] :] - | [(spc, None)] -> [: `stream_patt_comp b spc "" k :] - | [(spc, Some e)] -> - [: `HVbox - [: `stream_patt_comp b spc "" [: :]; - `HVbox [: `S LR "??"; `expr e "" k :] :] :] - | [(spc, None) :: spcl] -> - [: `stream_patt_comp b spc ";" [: `S RO ";" :]; - stream_patt [: :] spcl k :] - | [(spc, Some e) :: spcl] -> - [: `HVbox - [: `stream_patt_comp b spc "" [: :]; - `HVbox [: `S LR "??"; `expr e ";" [: `S RO ";" :] :] :]; - stream_patt [: :] spcl k :] ] - and stream_patt_comp b spc dg k = - match spc with - [ SPCterm (p, w) -> - HVbox [: b; `S LO "'"; `spatt p "" (when_opt w k) :] - | SPCnterm p e -> - HVbox [: b; `HVbox [: `patt p "" [: `S LR "=" :]; `expr e dg k :] :] - | SPCsterm p -> HVbox [: b; `patt p "" k :] ] - and when_opt wo k = - match wo with - [ Some e -> [: `S LR "when"; `expr e "" k :] - | _ -> k ] - in - parser_cases b spel dg k -; - -value parser_body e dg k = - let (bp, e) = - match e with - [ <:expr< let $bp$ = Stream.count __strm in $e$ >> -> (Some bp, e) - | e -> (None, e) ] - in - match Parserify.parser_of_expr e with - [ [] -> - let spe = ([], None, <:expr< raise Stream.Failure >>) in - HVbox - [: `HVbox - [: `S LR "parser"; - match bp with - [ Some p -> [: `patt p "" [: :] :] - | _ -> [: :] ] :]; - parser_cases [: :] [spe] dg k :] - | spel -> - BEVbox - [: `HVbox - [: `S LR "parser"; - match bp with - [ Some p -> [: `patt p "" [: :] :] - | _ -> [: :] ] :]; - parser_cases [: :] spel dg k :] ] -; - -value pmatch e dg k = - let (me, e) = - match e with - [ <:expr< let (__strm : Stream.t _) = $me$ in $e$ >> -> (me, e) - | _ -> failwith "Pr_op.pmatch" ] - in - let (bp, e) = - match e with - [ <:expr< let $bp$ = Stream.count __strm in $e$ >> -> (Some bp, e) - | e -> (None, e) ] - in - let spel = Parser_of_expr.parser_of_expr e in - Vbox - [: `HVbox [: :]; - `HVbox - [: `S LR "match"; `expr me "" [: `S LR "with" :]; `S LR "parser"; - match bp with - [ Some p -> [: `patt p "" [: :] :] - | _ -> [: :] ] :]; - `BEbox [: `HVbox [: :]; parser_cases [: :] spel dg k :] :] -; - -(* Printer extensions *) - -pr_expr_fun_args.val := - extfun pr_expr_fun_args.val with - [ <:expr< fun __strm -> $_$ >> as ge -> ([], ge) - | <:expr< fun [(__strm : $_$) -> $_$] >> as ge -> ([], ge) ]; - -let lev = find_pr_level "expr1" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< let (__strm : Stream.t _) = $_$ in $_$ >> as e -> - fun curr next dg k -> - if not (List.mem dg ["|"; ";"]) then [: `pmatch e dg k :] - else [: `S LO "("; `pmatch e "" [: `S RO ")"; k :] :] - | <:expr< fun __strm -> $x$ >> -> - fun curr next dg k -> - if not (List.mem dg ["|"; ";"]) then [: `parser_body x dg k :] - else [: `S LO "("; `parser_body x "" [: `S RO ")"; k :] :] - | <:expr< fun [ (__strm : $_$) -> $x$ ] >> -> - fun curr next dg k -> - if not (List.mem dg ["|"; ";"]) then [: `parser_body x dg k :] - else [: `S LO "("; `parser_body x "" [: `S RO ")"; k :] :] ]; - -let lev = find_pr_level "apply" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< Stream.iapp $_$ $_$ >> | <:expr< Stream.icons $_$ $_$ >> | - <:expr< Stream.ising $_$ >> | <:expr< Stream.lapp (fun _ -> $_$) $_$ >> | - <:expr< Stream.lcons (fun _ -> $_$) $_$ >> | - <:expr< Stream.lsing (fun _ -> $_$) >> | <:expr< Stream.sempty >> | - <:expr< Stream.slazy $_$ >> as e -> - fun curr next dg k -> [: `next e "" k :] ]; - -let lev = find_pr_level "dot" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< Stream.sempty >> as e -> - fun curr next dg k -> [: `next e "" k :] ]; - -let lev = find_pr_level "simple" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< Stream.iapp $_$ $_$ >> | <:expr< Stream.icons $_$ $_$ >> | - <:expr< Stream.ising $_$ >> | <:expr< Stream.lapp (fun _ -> $_$) $_$ >> | - <:expr< Stream.lcons (fun _ -> $_$) $_$ >> | - <:expr< Stream.lsing (fun _ -> $_$) >> | <:expr< Stream.sempty >> | - <:expr< Stream.slazy $_$ >> as e -> - fun curr next dg k -> - [: `stream e "" k :] ]; diff -Nru ocaml-3.12.1/camlp4/unmaintained/etc/pr_op_main.ml ocaml-4.01.0/camlp4/unmaintained/etc/pr_op_main.ml --- ocaml-3.12.1/camlp4/unmaintained/etc/pr_op_main.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/etc/pr_op_main.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,214 +0,0 @@ -(* camlp4r q_MLast.cmo ./pa_extfun.cmo *) -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1998 Institut National de Recherche en Informatique et *) -(* Automatique. Distributed only by permission. *) -(* *) -(***********************************************************************) - - - -open Pcaml; -open Spretty; - -value _loc = Loc.mk "FIXME pr_op_main.ml"; - -value expr e dg k = pr_expr.pr_fun "top" e dg k; -value patt e dg k = pr_patt.pr_fun "top" e dg k; - -value spatt p dg k = - match p with - [ <:patt< $lid:s$ >> -> - if String.length s >= 2 && s.[1] == ''' then - HVbox [: `S LR (" " ^ s); k :] - else patt p dg k - | _ -> patt p dg k ] -; - -(* Streams *) - -value stream e _ k = - let rec get = - fun - [ <:expr< Stream.iapp $x$ $y$ >> -> [(False, x) :: get y] - | <:expr< Stream.icons $x$ $y$ >> -> [(True, x) :: get y] - | <:expr< Stream.ising $x$ >> -> [(True, x)] - | <:expr< Stream.lapp (fun _ -> $x$) $y$ >> -> [(False, x) :: get y] - | <:expr< Stream.lcons (fun _ -> $x$) $y$ >> -> [(True, x) :: get y] - | <:expr< Stream.lsing (fun _ -> $x$) >> -> [(True, x)] - | <:expr< Stream.sempty >> -> [] - | <:expr< Stream.slazy (fun _ -> $x$) >> -> [(False, x)] - | <:expr< Stream.slazy $x$ >> -> [(False, <:expr< $x$ () >>)] - | e -> [(False, e)] ] - in - let elem e dg k = - match e with - [ (True, e) -> [: `HOVbox [: `S LO "'"; `expr e dg k :] :] - | (False, e) -> [: `expr e dg k :] ] - in - let rec glop e k = - match e with - [ [] -> k - | [e] -> [: elem e "" k :] - | [e :: el] -> [: elem e ";" [: `S RO ";" :]; glop el k :] ] - in - HOVbox [: `S LR "[<"; glop (get e) [: `S LR ">]"; k :] :] -; - -(* Parsers *) - -open Parserify; - -value parser_cases b spel dg k = - let rec parser_cases b spel dg k = - match spel with - [ [] -> [: `HVbox [: b; k :] :] - | [(sp, epo, e)] -> [: `parser_case b sp epo e dg k :] - | [(sp, epo, e) :: spel] -> - [: `parser_case b sp epo e "|" [: :]; - parser_cases [: `S LR "|" :] spel dg k :] ] - and parser_case b sp epo e dg k = - let epo = - match epo with - [ Some p -> [: `patt p "" [: `S LR "->" :] :] - | _ -> [: `S LR "->" :] ] - in - HVbox - [: b; - `HOVbox - [: `HOVbox - [: `S LR "[<"; - stream_patt [: :] sp [: `S LR ">]"; epo :] :]; - `expr e dg k :] :] - and stream_patt b sp k = - match sp with - [ [] -> [: `HVbox [: b; k :] :] - | [(spc, None)] -> [: `stream_patt_comp b spc "" k :] - | [(spc, Some e)] -> - [: `HVbox - [: `stream_patt_comp b spc "" [: :]; - `HVbox [: `S LR "??"; `expr e "" k :] :] :] - | [(spc, None) :: spcl] -> - [: `stream_patt_comp b spc ";" [: `S RO ";" :]; - stream_patt [: :] spcl k :] - | [(spc, Some e) :: spcl] -> - [: `HVbox - [: `stream_patt_comp b spc "" [: :]; - `HVbox [: `S LR "??"; `expr e ";" [: `S RO ";" :] :] :]; - stream_patt [: :] spcl k :] ] - and stream_patt_comp b spc dg k = - match spc with - [ SPCterm (p, w) -> - HVbox [: b; `S LO "'"; `spatt p "" (when_opt w k) :] - | SPCnterm p e -> - HVbox [: b; `HVbox [: `patt p "" [: `S LR "=" :]; `expr e dg k :] :] - | SPCsterm p -> HVbox [: b; `patt p "" k :] ] - and when_opt wo k = - match wo with - [ Some e -> [: `S LR "when"; `expr e "" k :] - | _ -> k ] - in - parser_cases b spel dg k -; - -value parser_body e dg k = - let (bp, e) = - match e with - [ <:expr< let $bp$ = Stream.count __strm in $e$ >> -> (Some bp, e) - | e -> (None, e) ] - in - match parser_of_expr e with - [ [] -> - let spe = ([], None, <:expr< raise Stream.Failure >>) in - HVbox - [: `HVbox - [: `S LR "parser"; - match bp with - [ Some p -> [: `patt p "" [: :] :] - | _ -> [: :] ] :]; - parser_cases [: :] [spe] dg k :] - | spel -> - BEVbox - [: `HVbox - [: `S LR "parser"; - match bp with - [ Some p -> [: `patt p "" [: :] :] - | _ -> [: :] ] :]; - parser_cases [: :] spel dg k :] ] -; - -value pmatch e dg k = - let (me, e) = - match e with - [ <:expr< let (__strm : Stream.t _) = $me$ in $e$ >> -> (me, e) - | _ -> failwith "Pr_op.pmatch" ] - in - let (bp, e) = - match e with - [ <:expr< let $bp$ = Stream.count __strm in $e$ >> -> (Some bp, e) - | e -> (None, e) ] - in - let spel = parser_of_expr e in - Vbox - [: `HVbox [: :]; - `HVbox - [: `S LR "match"; `expr me "" [: `S LR "with" :]; `S LR "parser"; - match bp with - [ Some p -> [: `patt p "" [: :] :] - | _ -> [: :] ] :]; - `BEbox [: `HVbox [: :]; parser_cases [: :] spel dg k :] :] -; - -(* Printer extensions *) - -pr_expr_fun_args.val := - extfun pr_expr_fun_args.val with - [ <:expr< fun __strm -> $_$ >> as ge -> ([], ge) - | <:expr< fun [(__strm : $_$) -> $_$] >> as ge -> ([], ge) ]; - -let lev = find_pr_level "expr1" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< let (__strm : Stream.t _) = $_$ in $_$ >> as e -> - fun _ _ dg k -> - if not (List.mem dg ["|"; ";"]) then [: `pmatch e dg k :] - else [: `S LO "("; `pmatch e "" [: `S RO ")"; k :] :] - | <:expr< fun __strm -> $x$ >> -> - fun _ _ dg k -> - if not (List.mem dg ["|"; ";"]) then [: `parser_body x dg k :] - else [: `S LO "("; `parser_body x "" [: `S RO ")"; k :] :] - | <:expr< fun [ (__strm : $_$) -> $x$ ] >> -> - fun _ _ dg k -> - if not (List.mem dg ["|"; ";"]) then [: `parser_body x dg k :] - else [: `S LO "("; `parser_body x "" [: `S RO ")"; k :] :] ]; - -let lev = find_pr_level "apply" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< Stream.iapp $_$ $_$ >> | <:expr< Stream.icons $_$ $_$ >> | - <:expr< Stream.ising $_$ >> | <:expr< Stream.lapp (fun _ -> $_$) $_$ >> | - <:expr< Stream.lcons (fun _ -> $_$) $_$ >> | - <:expr< Stream.lsing (fun _ -> $_$) >> | <:expr< Stream.sempty >> | - <:expr< Stream.slazy $_$ >> as e -> - fun _ next _ k -> [: `next e "" k :] ]; - -let lev = find_pr_level "dot" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< Stream.sempty >> as e -> - fun _ next _ k -> [: `next e "" k :] ]; - -let lev = find_pr_level "simple" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< Stream.iapp $_$ $_$ >> | <:expr< Stream.icons $_$ $_$ >> | - <:expr< Stream.ising $_$ >> | <:expr< Stream.lapp (fun _ -> $_$) $_$ >> | - <:expr< Stream.lcons (fun _ -> $_$) $_$ >> | - <:expr< Stream.lsing (fun _ -> $_$) >> | <:expr< Stream.sempty >> | - <:expr< Stream.slazy $_$ >> as e -> - fun _ _ _ k -> - [: `stream e "" k :] ]; diff -Nru ocaml-3.12.1/camlp4/unmaintained/etc/pr_rp.ml ocaml-4.01.0/camlp4/unmaintained/etc/pr_rp.ml --- ocaml-3.12.1/camlp4/unmaintained/etc/pr_rp.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/etc/pr_rp.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,207 +0,0 @@ -(* camlp4r q_MLast.cmo ./pa_extfun.cmo *) -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1998 Institut National de Recherche en Informatique et *) -(* Automatique. Distributed only by permission. *) -(* *) -(***********************************************************************) - - - -open Pcaml; -open Spretty; - -value _loc = (Token.nowhere, Token.nowhere); - -value expr e dg k = pr_expr.pr_fun "top" e dg k; -value patt e dg k = pr_patt.pr_fun "top" e dg k; - -(* Streams *) - -value stream e dg k = - let rec get = - fun - [ <:expr< Stream.iapp $x$ $y$ >> -> [(False, x) :: get y] - | <:expr< Stream.icons $x$ $y$ >> -> [(True, x) :: get y] - | <:expr< Stream.ising $x$ >> -> [(True, x)] - | <:expr< Stream.lapp (fun _ -> $x$) $y$ >> -> [(False, x) :: get y] - | <:expr< Stream.lcons (fun _ -> $x$) $y$ >> -> [(True, x) :: get y] - | <:expr< Stream.lsing (fun _ -> $x$) >> -> [(True, x)] - | <:expr< Stream.sempty >> -> [] - | <:expr< Stream.slazy (fun _ -> $x$) >> -> [(False, x)] - | <:expr< Stream.slazy $x$ >> -> [(False, <:expr< $x$ () >>)] - | e -> [(False, e)] ] - in - let elem e k = - match e with - [ (True, e) -> [: `HOVbox [: `S LO "`"; `expr e "" k :] :] - | (False, e) -> [: `expr e "" k :] ] - in - let rec glop e k = - match e with - [ [] -> k - | [e] -> [: elem e k :] - | [e :: el] -> [: elem e [: `S RO ";" :]; glop el k :] ] - in - HOVbox [: `S LR "[:"; glop (get e) [: `S LR ":]"; k :] :] -; - -(* Parsers *) - -value parser_cases b spel k = - let rec parser_cases b spel k = - match spel with - [ [] -> [: `HVbox [: b; k :] :] - | [(sp, epo, e)] -> [: `parser_case b sp epo e k :] - | [(sp, epo, e) :: spel] -> - [: `parser_case b sp epo e [: :]; - parser_cases [: `S LR "|" :] spel k :] ] - and parser_case b sp epo e k = - let epo = - match epo with - [ Some p -> [: `patt p "" [: `S LR "->" :] :] - | _ -> [: `S LR "->" :] ] - in - HVbox - [: b; - `HOVbox - [: `HOVbox - [: `S LR "[:"; - stream_patt [: :] sp [: `S LR ":]"; epo :] :]; - `expr e "" k :] :] - and stream_patt b sp k = - match sp with - [ [] -> [: `HVbox [: b; k :] :] - | [(spc, None)] -> [: `stream_patt_comp b spc k :] - | [(spc, Some e)] -> - [: `HVbox - [: `stream_patt_comp b spc [: :]; - `HVbox [: `S LR "?"; `expr e "" k :] :] :] - | [(spc, None) :: spcl] -> - [: `stream_patt_comp b spc [: `S RO ";" :]; - stream_patt [: :] spcl k :] - | [(spc, Some e) :: spcl] -> - [: `HVbox - [: `stream_patt_comp b spc [: :]; - `HVbox [: `S LR "?"; `expr e "" [: `S RO ";" :] :] :]; - stream_patt [: :] spcl k :] ] - and stream_patt_comp b spc k = - match spc with - [ SPCterm (p, w) -> - HVbox [: b; `S LO "`"; `patt p "" [: :]; `HVbox [: when_opt w k :] :] - | SPCnterm p e -> - HVbox [: b; `HVbox [: `patt p "" [: `S LR "=" :]; `expr e "" k :] :] - | SPCsterm p -> HVbox [: b; `patt p "" k :] ] - and when_opt wo k = - match wo with - [ Some e -> [: `S LR "when"; `expr e "" k :] - | _ -> k ] - in - parser_cases b spel k -; - -value parser_body e dg k = - let (bp, e) = - match e with - [ <:expr< let $bp$ = Stream.count __strm in $e$ >> -> (Some bp, e) - | e -> (None, e) ] - in - match Parserify.parser_of_expr e with - [ [] -> - HVbox - [: `HVbox - [: `S LR "parser"; - match bp with - [ Some p -> [: `patt p "" [: :] :] - | _ -> [: :] ] :]; - `HVbox [: `S LR "[]"; k :] :] - | [spe] -> - HVbox - [: `HVbox - [: `S LR "parser"; - match bp with - [ Some p -> [: `patt p "" [: :] :] - | _ -> [: :] ] :]; - parser_cases [: :] [spe] k :] - | spel -> - Vbox - [: `HVbox [: :]; - `HVbox - [: `S LR "parser"; - match bp with - [ Some p -> [: `patt p "" [: :] :] - | _ -> [: :] ] :]; - parser_cases [: `S LR "[" :] spel [: `S LR "]"; k :] :] ] -; - -value pmatch e dg k = - let (me, e) = - match e with - [ <:expr< let (__strm : Stream.t _) = $me$ in $e$ >> -> (me, e) - | <:expr< match $_$ __strm with [ $list:_$ ] >> -> (<:expr< __strm >>, e) - | _ -> failwith "Pr_rp.pmatch" ] - in - let (bp, e) = - match e with - [ <:expr< let $bp$ = Stream.count __strm in $e$ >> -> (Some bp, e) - | e -> (None, e) ] - in - let spel = Parserify.parser_of_expr e in - Vbox - [: `HVbox [: :]; - `HVbox - [: `S LR "match"; `expr me "" [: `S LR "with" :]; `S LR "parser"; - match bp with - [ Some p -> [: `patt p "" [: :] :] - | _ -> [: :] ] :]; - parser_cases [: `S LR "[" :] spel [: `S LR "]"; k :] :] -; - -(* Printer extensions *) - -pr_expr_fun_args.val := - extfun pr_expr_fun_args.val with - [ <:expr< fun __strm -> $_$ >> as ge -> ([], ge) - | <:expr< fun [(__strm : $_$) -> $_$] >> as ge -> ([], ge) ]; - -let lev = find_pr_level "top" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< let (__strm : Stream.t _) = $_$ in $_$ >> as e -> - fun curr next _ k -> [: `pmatch e "" k :] - | <:expr< match $_$ __strm with [ $list:_$ ] >> as e -> - fun curr next _ k -> [: `pmatch e "" k :] - | <:expr< fun __strm -> $x$ >> -> - fun curr next _ k -> [: `parser_body x "" k :] - | <:expr< fun (__strm : $_$) -> $x$ >> -> - fun curr next _ k -> [: `parser_body x "" k :] ]; - -let lev = find_pr_level "apply" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< Stream.iapp $_$ $_$ >> | <:expr< Stream.icons $_$ $_$ >> | - <:expr< Stream.ising $_$ >> | <:expr< Stream.lapp (fun _ -> $_$) $_$ >> | - <:expr< Stream.lcons (fun _ -> $_$) $_$ >> | - <:expr< Stream.lsing (fun _ -> $_$) >> | <:expr< Stream.sempty >> | - <:expr< Stream.slazy $_$ >> as e -> - fun curr next _ k -> [: `next e "" k :] ]; - -let lev = find_pr_level "dot" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< Stream.sempty >> as e -> - fun curr next _ k -> [: `next e "" k :] ]; - -let lev = find_pr_level "simple" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< Stream.iapp $_$ $_$ >> | <:expr< Stream.icons $_$ $_$ >> | - <:expr< Stream.ising $_$ >> | <:expr< Stream.lapp (fun _ -> $_$) $_$ >> | - <:expr< Stream.lcons (fun _ -> $_$) $_$ >> | - <:expr< Stream.lsing (fun _ -> $_$) >> | <:expr< Stream.sempty >> | - <:expr< Stream.slazy $_$ >> as e -> - fun curr next _ k -> [: `stream e "" k :] ]; diff -Nru ocaml-3.12.1/camlp4/unmaintained/etc/pr_rp_main.ml ocaml-4.01.0/camlp4/unmaintained/etc/pr_rp_main.ml --- ocaml-3.12.1/camlp4/unmaintained/etc/pr_rp_main.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/etc/pr_rp_main.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,206 +0,0 @@ -(* camlp4r q_MLast.cmo ./pa_extfun.cmo *) -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1998 Institut National de Recherche en Informatique et *) -(* Automatique. Distributed only by permission. *) -(* *) -(***********************************************************************) - - - -open Pcaml; -open Spretty; - -value _loc = Loc.mk "FIXME pr_rp_main.ml"; - -value expr e dg k = pr_expr.pr_fun "top" e dg k; -value patt e dg k = pr_patt.pr_fun "top" e dg k; - -(* Streams *) - -value stream e _ k = - let rec get = - fun - [ <:expr< Stream.iapp $x$ $y$ >> -> [(False, x) :: get y] - | <:expr< Stream.icons $x$ $y$ >> -> [(True, x) :: get y] - | <:expr< Stream.ising $x$ >> -> [(True, x)] - | <:expr< Stream.lapp (fun _ -> $x$) $y$ >> -> [(False, x) :: get y] - | <:expr< Stream.lcons (fun _ -> $x$) $y$ >> -> [(True, x) :: get y] - | <:expr< Stream.lsing (fun _ -> $x$) >> -> [(True, x)] - | <:expr< Stream.sempty >> -> [] - | <:expr< Stream.slazy (fun _ -> $x$) >> -> [(False, x)] - | <:expr< Stream.slazy $x$ >> -> [(False, <:expr< $x$ () >>)] - | e -> [(False, e)] ] - in - let elem e k = - match e with - [ (True, e) -> [: `HOVbox [: `S LO "`"; `expr e "" k :] :] - | (False, e) -> [: `expr e "" k :] ] - in - let rec glop e k = - match e with - [ [] -> k - | [e] -> [: elem e k :] - | [e :: el] -> [: elem e [: `S RO ";" :]; glop el k :] ] - in - HOVbox [: `S LR "[:"; glop (get e) [: `S LR ":]"; k :] :] -; - -(* Parsers *) - -open Parserify; - -value parser_cases b spel k = - let rec parser_cases b spel k = - match spel with - [ [] -> [: `HVbox [: b; k :] :] - | [(sp, epo, e)] -> [: `parser_case b sp epo e k :] - | [(sp, epo, e) :: spel] -> - [: `parser_case b sp epo e [: :]; - parser_cases [: `S LR "|" :] spel k :] ] - and parser_case b sp epo e k = - let epo = - match epo with - [ Some p -> [: `patt p "" [: `S LR "->" :] :] - | _ -> [: `S LR "->" :] ] - in - HVbox - [: b; - `HOVbox - [: `HOVbox - [: `S LR "[:"; - stream_patt [: :] sp [: `S LR ":]"; epo :] :]; - `expr e "" k :] :] - and stream_patt b sp k = - match sp with - [ [] -> [: `HVbox [: b; k :] :] - | [(spc, None)] -> [: `stream_patt_comp b spc k :] - | [(spc, Some e)] -> - [: `HVbox - [: `stream_patt_comp b spc [: :]; - `HVbox [: `S LR "?"; `expr e "" k :] :] :] - | [(spc, None) :: spcl] -> - [: `stream_patt_comp b spc [: `S RO ";" :]; - stream_patt [: :] spcl k :] - | [(spc, Some e) :: spcl] -> - [: `HVbox - [: `stream_patt_comp b spc [: :]; - `HVbox [: `S LR "?"; `expr e "" [: `S RO ";" :] :] :]; - stream_patt [: :] spcl k :] ] - and stream_patt_comp b spc k = - match spc with - [ SPCterm (p, w) -> - HVbox [: b; `S LO "`"; `patt p "" [: :]; `HVbox [: when_opt w k :] :] - | SPCnterm p e -> - HVbox [: b; `HVbox [: `patt p "" [: `S LR "=" :]; `expr e "" k :] :] - | SPCsterm p -> HVbox [: b; `patt p "" k :] ] - and when_opt wo k = - match wo with - [ Some e -> [: `S LR "when"; `expr e "" k :] - | _ -> k ] - in - parser_cases b spel k -; - -value parser_body e _ k = - let (bp, e) = - match e with - [ <:expr< let $bp$ = Stream.count __strm in $e$ >> -> (Some bp, e) - | e -> (None, e) ] - in - match parser_of_expr e with - [ [] -> - HVbox - [: `HVbox - [: `S LR "parser"; - match bp with - [ Some p -> [: `patt p "" [: :] :] - | _ -> [: :] ] :]; - `HVbox [: `S LR "[]"; k :] :] - | [spe] -> - HVbox - [: `HVbox - [: `S LR "parser"; - match bp with - [ Some p -> [: `patt p "" [: :] :] - | _ -> [: :] ] :]; - parser_cases [: :] [spe] k :] - | spel -> - Vbox - [: `HVbox [: :]; - `HVbox - [: `S LR "parser"; - match bp with - [ Some p -> [: `patt p "" [: :] :] - | _ -> [: :] ] :]; - parser_cases [: `S LR "[" :] spel [: `S LR "]"; k :] :] ] -; - -value pmatch e _ k = - let (me, e) = - match e with - [ <:expr< let (__strm : Stream.t _) = $me$ in $e$ >> -> (me, e) - | _ -> failwith "Pr_rp.pmatch" ] - in - let (bp, e) = - match e with - [ <:expr< let $bp$ = Stream.count __strm in $e$ >> -> (Some bp, e) - | e -> (None, e) ] - in - let spel = parser_of_expr e in - Vbox - [: `HVbox [: :]; - `HVbox - [: `S LR "match"; `expr me "" [: `S LR "with" :]; `S LR "parser"; - match bp with - [ Some p -> [: `patt p "" [: :] :] - | _ -> [: :] ] :]; - parser_cases [: `S LR "[" :] spel [: `S LR "]"; k :] :] -; - -(* Printer extensions *) - -pr_expr_fun_args.val := - extfun pr_expr_fun_args.val with - [ <:expr< fun __strm -> $_$ >> as ge -> ([], ge) - | <:expr< fun [(__strm : $_$) -> $_$] >> as ge -> ([], ge) ]; - -let lev = find_pr_level "top" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< let (__strm : Stream.t _) = $_$ in $_$ >> as e -> - fun _ _ _ k -> [: `pmatch e "" k :] - | <:expr< fun __strm -> $x$ >> -> - fun _ _ _ k -> [: `parser_body x "" k :] - | <:expr< fun (__strm : $_$) -> $x$ >> -> - fun _ _ _ k -> [: `parser_body x "" k :] ]; - -let lev = find_pr_level "apply" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< Stream.iapp $_$ $_$ >> | <:expr< Stream.icons $_$ $_$ >> | - <:expr< Stream.ising $_$ >> | <:expr< Stream.lapp (fun _ -> $_$) $_$ >> | - <:expr< Stream.lcons (fun _ -> $_$) $_$ >> | - <:expr< Stream.lsing (fun _ -> $_$) >> | <:expr< Stream.sempty >> | - <:expr< Stream.slazy $_$ >> as e -> - fun _ next _ k -> [: `next e "" k :] ]; - -let lev = find_pr_level "dot" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< Stream.sempty >> as e -> - fun _ next _ k -> [: `next e "" k :] ]; - -let lev = find_pr_level "simple" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< Stream.iapp $_$ $_$ >> | <:expr< Stream.icons $_$ $_$ >> | - <:expr< Stream.ising $_$ >> | <:expr< Stream.lapp (fun _ -> $_$) $_$ >> | - <:expr< Stream.lcons (fun _ -> $_$) $_$ >> | - <:expr< Stream.lsing (fun _ -> $_$) >> | <:expr< Stream.sempty >> | - <:expr< Stream.slazy $_$ >> as e -> - fun _ _ _ k -> [: `stream e "" k :] ]; diff -Nru ocaml-3.12.1/camlp4/unmaintained/etc/q_phony.ml ocaml-4.01.0/camlp4/unmaintained/etc/q_phony.ml --- ocaml-3.12.1/camlp4/unmaintained/etc/q_phony.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/etc/q_phony.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,38 +0,0 @@ -(* camlp4r pa_extend.cmo q_MLast.cmo *) -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2001 Institut National de Recherche en Informatique et *) -(* Automatique. Distributed only by permission. *) -(* *) -(***********************************************************************) - - - -open Pcaml; - -value t = ref ""; - -Quotation.add "" - (Quotation.ExAst - (fun c s -> - let _loc = c.Quotation.loc in - let t = - if t.val = "" then "<<" ^ s ^ ">>" - else "<:" ^ t.val ^ "<" ^ s ^ ">>" - in - <:expr< $uid:t$ >>, - fun c s -> - let _loc = c.Quotation.loc in - let t = - if t.val = "" then "<<" ^ s ^ ">>" - else "<:" ^ t.val ^ "<" ^ s ^ ">>" - in - <:patt< $uid:t$ >>)) -; - -Quotation.default.val := ""; -Quotation.translate.val := fun s -> do { t.val := s; "" }; diff -Nru ocaml-3.12.1/camlp4/unmaintained/extfold/README ocaml-4.01.0/camlp4/unmaintained/extfold/README --- ocaml-3.12.1/camlp4/unmaintained/extfold/README 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/extfold/README 1970-01-01 00:00:00.000000000 +0000 @@ -1,15 +0,0 @@ -This is an application of or an extension for Camlp4. Although it is -currently distributed with OCaml/Camlp4, it may or may not be -actively maintained. - -It probably won't be part of future OCaml/Camlp4 distributions but be -accessible from the Camlp4 hump. If you are interested in developing -this package further and/or actively maintain it, please let us know -(caml@inria.fr) - -This package is distributed under the same license as the Objective -Caml Library (that is, LGPL with a special exception allowing both -static and dynamic link). - --- Michel Mauny - Nicolas Pouillard diff -Nru ocaml-3.12.1/camlp4/unmaintained/extfold/pa_extfold.ml ocaml-4.01.0/camlp4/unmaintained/extfold/pa_extfold.ml --- ocaml-3.12.1/camlp4/unmaintained/extfold/pa_extfold.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/extfold/pa_extfold.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,42 +0,0 @@ -(* camlp4r pa_extend.cmo q_MLast.cmo *) - - -open Pcaml; -open Pa_extend; - -value sfold _loc n foldfun f e s = - let styp = STquo _loc (new_type_var ()) in - let e = <:expr< Extfold.$lid:foldfun$ $f$ $e$ >> in - let t = STapp _loc (STapp _loc (STtyp <:ctyp< Extfold.t _ >>) s.styp) styp in - {used = s.used; text = TXmeta _loc n [s.text] e t; styp = styp} -; - -value sfoldsep _loc n foldfun f e s sep = - let styp = STquo _loc (new_type_var ()) in - let e = <:expr< Extfold.$lid:foldfun$ $f$ $e$ >> in - let t = - STapp _loc (STapp _loc (STtyp <:ctyp< Extfold.tsep _ >>) s.styp) styp - in - {used = s.used @ sep.used; text = TXmeta _loc n [s.text; sep.text] e t; - styp = styp} -; - -EXTEND - GLOBAL: symbol; - symbol: LEVEL "top" - [ [ UIDENT "FOLD0"; f = simple_expr; e = simple_expr; s = SELF -> - sfold _loc "FOLD0" "sfold0" f e s - | UIDENT "FOLD1"; f = simple_expr; e = simple_expr; s = SELF -> - sfold _loc "FOLD1" "sfold1" f e s - | UIDENT "FOLD0"; f = simple_expr; e = simple_expr; s = SELF; - UIDENT "SEP"; sep = symbol -> - sfoldsep _loc "FOLD0 SEP" "sfold0sep" f e s sep - | UIDENT "FOLD1"; f = simple_expr; e = simple_expr; s = SELF; - UIDENT "SEP"; sep = symbol -> - sfoldsep _loc "FOLD1 SEP" "sfold1sep" f e s sep ] ] - ; - simple_expr: - [ [ i = LIDENT -> <:expr< $lid:i$ >> - | "("; e = expr; ")" -> e ] ] - ; -END; diff -Nru ocaml-3.12.1/camlp4/unmaintained/format/Makefile ocaml-4.01.0/camlp4/unmaintained/format/Makefile --- ocaml-3.12.1/camlp4/unmaintained/format/Makefile 2004-11-30 18:57:04.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/format/Makefile 1970-01-01 00:00:00.000000000 +0000 @@ -1,61 +0,0 @@ -######################################################################### -# # -# Objective Caml # -# # -# Camlp4 # -# # -# Copyright 2004 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### -# -# Makefile for pa_format -# M.Mauny -# - -include ../../config/Makefile.cnf - -OCAMLTOP=../../.. -CAMLP4=../../camlp4/camlp4$(EXE) - -OCAMLC=$(OCAMLTOP)/ocamlc$(EXE) -OCAMLOPT=$(OCAMLTOP)/ocamlopt$(EXE) - -P4INCLUDES= -nolib -I ../../lib -I ../../meta -I ../../etc -OCAMLINCLUDES= -nostdlib -I $(OCAMLTOP)/stdlib -I ../../lib -I ../../camlp4 -OCAMLCFLAGS=-warn-error A $(OCAMLINCLUDES) - -SRC=pa_format.ml -OBJS=$(SRC:.ml=.cmo) -OBJSX=$(SRC:.ml=.cmx) - -all: $(OBJS) - -opt: $(OBJSX) - -depend: - cp .depend .depend.bak - > .depend - for file in $(SRC); do \ - $(CAMLP4) $(P4INCLUDES) `awk 'NR == 1 { ORS=" "; for (i=2; i < NF; i++) print $$i; } ' $$file` pr_depend.cmo $$i | \ - sed -e 's| \.\./\.\./\.\.| $$(OCAMLTOP)|g' >> .depend; \ - done - -clean: - rm -f *.cm* *.$(O) *.bak .*.bak - - -.SUFFIXES: .cmx .cmo .cmi .ml .mli - -.mli.cmi: - $(OCAMLC) $(OCAMLCFLAGS) -c $< - - -.ml.cmo: - $(OCAMLC) $(OCAMLCFLAGS) -pp "$(CAMLP4) $(P4INCLUDES) `awk 'NR == 1 { ORS=" "; for (i=2; i < NF; i++) print $$i; } ' $<`" -c $< - -.ml.cmx: - $(OCAMLOPT) $(OCAMLCFLAGS) -pp "$(CAMLP4) $(P4INCLUDES) `awk 'NR == 1 { ORS=" "; for (i=2; i < NF; i++) print $$i; } ' $<`" -c $< - -include .depend diff -Nru ocaml-3.12.1/camlp4/unmaintained/format/README ocaml-4.01.0/camlp4/unmaintained/format/README --- ocaml-3.12.1/camlp4/unmaintained/format/README 2004-07-13 12:25:21.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/format/README 1970-01-01 00:00:00.000000000 +0000 @@ -1,15 +0,0 @@ -This is an application of or an extension for Camlp4. Although it is -currently distributed with OCaml/Camlp4, it may or may not be -actively maintained. - -It probably won't be part of future OCaml/Camlp4 distributions but be -accessible from the Camlp4 hump. If you are interested in developing -this package further and/or actively maintain it, please let us know -(caml@inria.fr) - -This package is distributed under the same license as the Objective -Caml Library (that is, LGPL with a special exception allowing both -static and dynamic link). - --- Michel Mauny - diff -Nru ocaml-3.12.1/camlp4/unmaintained/format/pa_format.ml ocaml-4.01.0/camlp4/unmaintained/format/pa_format.ml --- ocaml-3.12.1/camlp4/unmaintained/format/pa_format.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/format/pa_format.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,52 +0,0 @@ -(* pa_r.cmo pa_extend.cmo q_MLast.cmo pr_dump.cmo *) -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2002 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file *) -(* ../../../LICENSE. *) -(* *) -(***********************************************************************) - - -open Pcaml; - -EXTEND - GLOBAL: expr; - expr: LEVEL "top" - [ [ n = box_type; d = SELF; "begin"; - el = LIST0 [ e = box_expr; ";" -> e ]; "end" -> - let el = [<:expr< Format.$lid:"open_" ^ n$ $d$ >> :: el] in - let el = el @ [<:expr< Format.close_box () >>] in - <:expr< do { $list:el$ } >> - | "hbox"; "begin"; el = LIST0 [ e = box_expr; ";" -> e ]; "end" -> - let el = [<:expr< Format.open_hbox () >> :: el] in - let el = el @ [<:expr< Format.close_box () >>] in - <:expr< do { $list:el$ } >> - | "nobox"; "begin"; el = LIST0 [ e = box_expr; ";" -> e ]; "end" -> - match el with - [ [e] -> e - | _ -> <:expr< do { $list:el$ } >> ] ] ] - ; - box_type: - [ [ n = "hovbox" -> n - | n = "hvbox" -> n - | n = "vbox" -> n - | n = "box" -> n ] ] - ; - box_expr: - [ [ s = STRING -> <:expr< Format.print_string $str:s$ >> - | UIDENT "STRING"; e = expr -> <:expr< Format.print_string $e$ >> - | UIDENT "INT"; e = expr -> <:expr< Format.print_int $e$ >> - | "/-" -> <:expr< Format.print_space () >> - | "//" -> <:expr< Format.print_cut () >> - | "!/" -> <:expr< Format.force_newline () >> - | "?/" -> <:expr< Format.print_if_newline () >> - | e = expr -> e ] ] - ; -END; diff -Nru ocaml-3.12.1/camlp4/unmaintained/lefteval/Makefile ocaml-4.01.0/camlp4/unmaintained/lefteval/Makefile --- ocaml-3.12.1/camlp4/unmaintained/lefteval/Makefile 2004-11-30 18:57:04.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/lefteval/Makefile 1970-01-01 00:00:00.000000000 +0000 @@ -1,61 +0,0 @@ -######################################################################### -# # -# Objective Caml # -# # -# Camlp4 # -# # -# Copyright 2004 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### -# -# Makefile for pa_lefteval -# M.Mauny -# - -include ../../config/Makefile.cnf - -OCAMLTOP=../../.. -CAMLP4=../../camlp4/camlp4$(EXE) - -OCAMLC=$(OCAMLTOP)/ocamlc$(EXE) -OCAMLOPT=$(OCAMLTOP)/ocamlopt$(EXE) - -P4INCLUDES= -nolib -I ../../meta -I ../../etc -OCAMLINCLUDES= -nostdlib -I $(OCAMLTOP)/stdlib -I ../../camlp4 -OCAMLCFLAGS=-warn-error A $(OCAMLINCLUDES) - -SRC=pa_lefteval.ml -OBJS=$(SRC:.ml=.cmo) -OBJSX=$(SRC:.ml=.cmx) - -all: $(OBJS) - -opt: $(OBJSX) - -depend: - cp .depend .depend.bak - > .depend - for file in $(SRC); do \ - $(CAMLP4) $(P4INCLUDES) `awk 'NR == 1 { ORS=" "; for (i=2; i < NF; i++) print $$i; } ' $$file` pr_depend.cmo $$i | \ - sed -e 's| \.\./\.\./\.\.| $$(OCAMLTOP)|g' >> .depend; \ - done - -clean: - rm -f *.cm* *.$(O) *.bak .*.bak - - -.SUFFIXES: .cmx .cmo .cmi .ml .mli - -.mli.cmi: - $(OCAMLC) $(OCAMLCFLAGS) -c $< - - -.ml.cmo: - $(OCAMLC) $(OCAMLCFLAGS) -pp "$(CAMLP4) $(P4INCLUDES) `awk 'NR == 1 { ORS=" "; for (i=2; i < NF; i++) print $$i; } ' $<`" -c $< - -.ml.cmx: - $(OCAMLOPT) $(OCAMLCFLAGS) -pp "$(CAMLP4) $(P4INCLUDES) `awk 'NR == 1 { ORS=" "; for (i=2; i < NF; i++) print $$i; } ' $<`" -c $< - -include .depend diff -Nru ocaml-3.12.1/camlp4/unmaintained/lefteval/README ocaml-4.01.0/camlp4/unmaintained/lefteval/README --- ocaml-3.12.1/camlp4/unmaintained/lefteval/README 2004-07-13 12:25:21.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/lefteval/README 1970-01-01 00:00:00.000000000 +0000 @@ -1,15 +0,0 @@ -This is an application of or an extension for Camlp4. Although it is -currently distributed with OCaml/Camlp4, it may or may not be -actively maintained. - -It probably won't be part of future OCaml/Camlp4 distributions but be -accessible from the Camlp4 hump. If you are interested in developing -this package further and/or actively maintain it, please let us know -(caml@inria.fr) - -This package is distributed under the same license as the Objective -Caml Library (that is, LGPL with a special exception allowing both -static and dynamic link). - --- Michel Mauny - diff -Nru ocaml-3.12.1/camlp4/unmaintained/lefteval/pa_lefteval.ml ocaml-4.01.0/camlp4/unmaintained/lefteval/pa_lefteval.ml --- ocaml-3.12.1/camlp4/unmaintained/lefteval/pa_lefteval.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/lefteval/pa_lefteval.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,241 +0,0 @@ -(* pa_r.cmo q_MLast.cmo pr_dump.cmo *) -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2002 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file *) -(* ../../../LICENSE. *) -(* *) -(***********************************************************************) - - -value not_impl name x = - let desc = - if Obj.is_block (Obj.repr x) then - "tag = " ^ string_of_int (Obj.tag (Obj.repr x)) - else "int_val = " ^ string_of_int (Obj.magic x) - in - failwith ("pa_lefteval: not impl: " ^ name ^ "; " ^ desc ^ ">") -; - -value rec expr_fa al = - fun - [ <:expr< $f$ $a$ >> -> expr_fa [a :: al] f - | f -> (f, al) ] -; - -(* generating let..in before functions calls which evaluates - several (more than one) of their arguments *) - -value no_side_effects_ht = - let ht = Hashtbl.create 73 in - do { - List.iter (fun s -> Hashtbl.add ht s True) - ["<"; "="; "@"; "^"; "+"; "-"; "ref"]; - ht - } -; - -value no_side_effects = - fun - [ <:expr< $uid:_$ >> -> True - | <:expr< $uid:_$ . $uid:_$ >> -> True - | <:expr< $lid:s$ >> -> - try Hashtbl.find no_side_effects_ht s with [ Not_found -> False ] - | _ -> False ] -; - -value rec may_side_effect = - fun - [ <:expr< $lid:_$ >> | <:expr< $uid:_$ >> | <:expr< $str:_$ >> | - <:expr< $chr:_$ >> | <:expr< $int:_$ >> | <:expr< $flo:_$ >> | - <:expr< $_$ . $_$ >> | <:expr< fun [ $list:_$ ] >> -> - False - | <:expr< ($list:el$) >> -> List.exists may_side_effect el - | <:expr< $_$ $_$ >> as e -> - let (f, el) = expr_fa [] e in - not (no_side_effects f) || List.exists may_side_effect el - | _ -> True ] -; - -value rec may_be_side_effect_victim = - fun - [ <:expr< $lid:_$ . $_$ >> -> True - | <:expr< $uid:_$ . $e$ >> -> may_be_side_effect_victim e - | _ -> False ] -; - -value rec may_depend_on_order el = - loop False False el where rec loop - side_effect_found side_effect_victim_found = - fun - [ [e :: el] -> - if may_side_effect e then - if side_effect_found || side_effect_victim_found then True - else loop True True el - else if may_be_side_effect_victim e then - if side_effect_found then True else loop False True el - else loop side_effect_found side_effect_victim_found el - | [] -> False ] -; - -value gen_let_in loc expr el = - let (pel, el) = - loop 0 (List.rev el) where rec loop n = - fun - [ [e :: el] -> - if may_side_effect e || may_be_side_effect_victim e then - if n = 0 then - let (pel, el) = loop 1 el in - (pel, [expr e :: el]) - else - let id = "xxx" ^ string_of_int n in - let (pel, el) = loop (n + 1) el in - ([(<:patt< $lid:id$ >>, expr e) :: pel], - [<:expr< $lid:id$ >> :: el]) - else - let (pel, el) = loop n el in - (pel, [expr e :: el]) - | [] -> ([], []) ] - in - match List.rev el with - [ [e :: el] -> (pel, e, el) - | _ -> assert False ] -; - -value left_eval_apply loc expr e1 e2 = - let (f, el) = expr_fa [] <:expr< $e1$ $e2$ >> in - if not (may_depend_on_order [f :: el]) then <:expr< $expr e1$ $expr e2$ >> - else - let (pel, e, el) = gen_let_in loc expr [f :: el] in - let e = List.fold_left (fun e e1 -> <:expr< $e$ $e1$ >>) e el in - List.fold_left (fun e (p1, e1) -> <:expr< let $p1$ = $e1$ in $e$ >>) e pel -; - -value left_eval_tuple loc expr el = - if not (may_depend_on_order el) then <:expr< ($list:List.map expr el$) >> - else - let (pel, e, el) = gen_let_in loc expr el in - List.fold_left (fun e (p1, e1) -> <:expr< let $p1$ = $e1$ in $e$ >>) - <:expr< ($list:[e :: el]$) >> pel -; - -value left_eval_record loc expr lel = - let el = List.map snd lel in - if not (may_depend_on_order el) then - let lel = List.map (fun (p, e) -> (p, expr e)) lel in - <:expr< { $list:lel$ } >> - else - let (pel, e, el) = gen_let_in loc expr el in - let e = - let lel = List.combine (List.map fst lel) [e :: el] in - <:expr< { $list:lel$ } >> - in - List.fold_left (fun e (p1, e1) -> <:expr< let $p1$ = $e1$ in $e$ >>) e pel -; - -value left_eval_assign loc expr e1 e2 = <:expr< $e1$ := $expr e2$ >>; - -(* scanning the input tree, calling "left_eval_*" functions if necessary *) - -value map_option f = - fun - [ Some x -> Some (f x) - | None -> None ] -; - -value class_infos f ci = - {MLast.ciLoc = ci.MLast.ciLoc; MLast.ciVir = ci.MLast.ciVir; - MLast.ciPrm = ci.MLast.ciPrm; MLast.ciNam = ci.MLast.ciNam; - MLast.ciExp = f ci.MLast.ciExp} -; - -value rec expr x = - let loc = MLast.loc_of_expr x in - match x with - [ <:expr< fun [ $list:pwel$ ] >> -> - <:expr< fun [ $list:List.map match_assoc pwel$ ] >> - | <:expr< match $e$ with [ $list:pwel$ ] >> -> - <:expr< match $expr e$ with [ $list:List.map match_assoc pwel$ ] >> - | <:expr< try $e$ with [ $list:pwel$ ] >> -> - <:expr< try $expr e$ with [ $list:List.map match_assoc pwel$ ] >> - | <:expr< let $opt:rf$ $list:pel$ in $e$ >> -> - <:expr< let $opt:rf$ $list:List.map let_binding pel$ in $expr e$ >> - | <:expr< let module $s$ = $me$ in $e$ >> -> - <:expr< let module $s$ = $module_expr me$ in $expr e$ >> - | <:expr< if $e1$ then $e2$ else $e3$ >> -> - <:expr< if $expr e1$ then $expr e2$ else $expr e3$ >> - | <:expr< while $e$ do { $list:el$ } >> -> - <:expr< while $expr e$ do { $list:List.map expr el$ } >> - | <:expr< do { $list:el$ } >> -> <:expr< do { $list:List.map expr el$ } >> - | <:expr< $e$ # $s$ >> -> <:expr< $expr e$ # $s$ >> - | <:expr< ($e$ : $t$) >> -> <:expr< ($expr e$ : $t$) >> - | <:expr< $e1$ || $e2$ >> -> <:expr< $expr e1$ || $expr e2$ >> - | <:expr< $e1$ && $e2$ >> -> <:expr< $expr e1$ && $expr e2$ >> - | <:expr< $e1$ $e2$ >> -> left_eval_apply loc expr e1 e2 - | <:expr< ($list:el$) >> -> left_eval_tuple loc expr el - | <:expr< { $list:lel$ } >> -> left_eval_record loc expr lel - | <:expr< $e1$ := $e2$ >> -> left_eval_assign loc expr e1 e2 - | <:expr< $_$ . $_$ >> | <:expr< $uid:_$ >> | <:expr< $lid:_$ >> | - <:expr< $str:_$ >> | <:expr< $chr:_$ >> | <:expr< $int:_$ >> | - <:expr< $flo:_$ >> | <:expr< new $list:_$ >> -> - x - | x -> not_impl "expr" x ] -and let_binding (p, e) = (p, expr e) -and match_assoc (p, eo, e) = (p, map_option expr eo, expr e) -and module_expr x = - let loc = MLast.loc_of_module_expr x in - match x with - [ <:module_expr< functor ($s$ : $mt$) -> $me$ >> -> - <:module_expr< functor ($s$ : $mt$) -> $module_expr me$ >> - | <:module_expr< ($me$ : $mt$) >> -> - <:module_expr< ($module_expr me$ : $mt$) >> - | <:module_expr< struct $list:sil$ end >> -> - <:module_expr< struct $list:List.map str_item sil$ end >> - | <:module_expr< $_$ . $_$ >> | <:module_expr< $_$ $_$ >> | - <:module_expr< $uid:_$ >> -> - x ] -and str_item x = - let loc = MLast.loc_of_str_item x in - match x with - [ <:str_item< module $s$ = $me$ >> -> - <:str_item< module $s$ = $module_expr me$ >> - | <:str_item< value $opt:rf$ $list:pel$ >> -> - <:str_item< value $opt:rf$ $list:List.map let_binding pel$ >> - | <:str_item< declare $list:sil$ end >> -> - <:str_item< declare $list:List.map str_item sil$ end >> - | <:str_item< class $list:ce$ >> -> - <:str_item< class $list:List.map (class_infos class_expr) ce$ >> - | <:str_item< $exp:e$ >> -> <:str_item< $exp:expr e$ >> - | <:str_item< open $_$ >> | <:str_item< type $list:_$ >> | - <:str_item< exception $_$ of $list:_$ = $_$ >> | - <:str_item< module type $_$ = $_$ >> | <:str_item< # $_$ $opt:_$ >> -> - x - | x -> not_impl "str_item" x ] -and class_expr x = - let loc = MLast.loc_of_class_expr x in - match x with - [ <:class_expr< object $opt:p$ $list:csil$ end >> -> - <:class_expr< object $opt:p$ $list:List.map class_str_item csil$ end >> - | x -> not_impl "class_expr" x ] -and class_str_item x = - let loc = MLast.loc_of_class_str_item x in - match x with - [ <:class_str_item< value $opt:mf$ $s$ = $e$ >> -> - <:class_str_item< value $opt:mf$ $s$ = $expr e$ >> - | <:class_str_item< method $s$ = $e$ >> -> - <:class_str_item< method $s$ = $expr e$ >> - | x -> not_impl "class_str_item" x ] -; - -value parse_implem = Pcaml.parse_implem.val; -value parse_implem_with_left_eval strm = - let (r, b) = parse_implem strm in - (List.map (fun (si, loc) -> (str_item si, loc)) r, b) -; -Pcaml.parse_implem.val := parse_implem_with_left_eval; diff -Nru ocaml-3.12.1/camlp4/unmaintained/lib/.cvsignore ocaml-4.01.0/camlp4/unmaintained/lib/.cvsignore --- ocaml-3.12.1/camlp4/unmaintained/lib/.cvsignore 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/lib/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -*.cm[oiax] -*.cmxa -*.lib diff -Nru ocaml-3.12.1/camlp4/unmaintained/lib/.depend ocaml-4.01.0/camlp4/unmaintained/lib/.depend --- ocaml-3.12.1/camlp4/unmaintained/lib/.depend 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/lib/.depend 1970-01-01 00:00:00.000000000 +0000 @@ -1,14 +0,0 @@ -debug.cmo: debug.cmi -debug.cmx: debug.cmi -extfun.cmo: extfun.cmi -extfun.cmx: extfun.cmi -fstream.cmo: fstream.cmi -fstream.cmx: fstream.cmi -grammar.cmo: token.cmi plexer.cmi loc.cmi -grammar.cmx: token.cmx plexer.cmi loc.cmx -loc.cmo: loc.cmi -loc.cmx: loc.cmi -token.cmo: loc.cmi token.cmi -token.cmx: loc.cmx token.cmi -plexer.cmi: token.cmi loc.cmi -token.cmi: loc.cmi diff -Nru ocaml-3.12.1/camlp4/unmaintained/lib/Makefile ocaml-4.01.0/camlp4/unmaintained/lib/Makefile --- ocaml-3.12.1/camlp4/unmaintained/lib/Makefile 2008-10-27 14:03:31.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/lib/Makefile 1970-01-01 00:00:00.000000000 +0000 @@ -1,52 +0,0 @@ - - -include ../config/Makefile.cnf - -INCLUDES=-I $(OTOP)/parsing -I $(OTOP)/utils -LIBRARIES=gramlib.cma -OBJS=$(OTOP)/utils/misc.cmo $(OTOP)/parsing/linenum.cmo \ - $(OTOP)/utils/warnings.cmo $(OTOP)/parsing/location.cmo \ - $(OTOP)/utils/config.cmo debug.cmo loc.cmo \ - token.cmo lexer_token.cmo lexer_error.cmo \ - plexer.cmo grammar.cmo extfun.cmo \ - fstream.cmo -CLEANFILES=plexer.ml - -include ../config/Makefile.base - -debug.cmo: debug.cmi -debug.cmo: debug.ml - $(OCAMLC) -pp '$(CAMLP4BOOT)' -rectypes $(OCAMLCFLAGS) $< -c -o $@ - -plexer.cmo: plexer.ml plexer.cmi - $(OCAMLC) $(OCAMLCFLAGS) $< -c -o $@ - -plexer.cmx: plexer.ml plexer.cmi - $(OCAMLOPT) $(OCAMLCFLAGS) $< -c -o $@ - -$(LIBRARIES): $(OBJS) - $(OCAMLC) -linkall $(OBJS) -a -o $(LIBRARIES) - -$(LIBRARIESX): $(OBJSX) - $(OCAMLOPT) -linkall $(OBJSX) -a -o $(LIBRARIESX) - -$(LIBRARIESP): $(OBJSP) - $(OCAMLOPT) -linkall $(OBJSP) -a -o $(LIBRARIESP) - -install-local: - -$(MKDIR) "$(LIBDIR)/camlp4" - cp $(LIBRARIES) *.mli "$(LIBDIR)/camlp4/." - cp *.cmi "$(LIBDIR)/camlp4/." - test -f $(LIBRARIESX) && $(MAKE) installopt LIBDIR="$(LIBDIR)" || true - -installopt: - for f in $(LIBRARIESX) $(LIBRARIESP) *.cmx ; do \ - test -f $$f && cp $$f "$(LIBDIR)/camlp4/." || true ; \ - done - # Special treatment for this one: some versions of make don't like $(A) in $(TARGET:.cma=.$(A)) - target="`echo $(LIBRARIES) | sed -e 's/\.cma$$/.$(A)/'`" ; \ - if test -f $$target ; then \ - cp $$target "$(LIBDIR)/camlp4/." && ( cd "$(LIBDIR)/camlp4/." && $(RANLIB) $$target ) \ - fi - -include .depend diff -Nru ocaml-3.12.1/camlp4/unmaintained/lib/extfun.ml ocaml-4.01.0/camlp4/unmaintained/lib/extfun.ml --- ocaml-3.12.1/camlp4/unmaintained/lib/extfun.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/lib/extfun.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,107 +0,0 @@ -(* camlp4r *) - -(* Copyright 2001 INRIA *) - -(* Extensible Functions *) - -type t 'a 'b = list (matching 'a 'b) -and matching 'a 'b = { patt : patt; has_when : bool; expr : expr 'a 'b } -and patt = - [ Eapp of list patt - | Eacc of list patt - | Econ of string - | Estr of string - | Eint of string - | Etup of list patt - | Evar of unit ] -and expr 'a 'b = 'a -> option 'b -; - -exception Failure; - -value empty = []; - -(*** Apply ***) - -value rec apply_matchings a = - fun - [ [m :: ml] -> - match m.expr a with - [ None -> apply_matchings a ml - | x -> x ] - | [] -> None ] -; - -value apply ef a = - match apply_matchings a ef with - [ Some x -> x - | None -> raise Failure ] -; - -(*** Trace ***) - -value rec list_iter_sep f s = - fun - [ [] -> () - | [x] -> f x - | [x :: l] -> do { f x; s (); list_iter_sep f s l } ] -; - -value rec print_patt = - fun - [ Eapp pl -> list_iter_sep print_patt2 (fun () -> print_string " ") pl - | p -> print_patt2 p ] -and print_patt2 = - fun - [ Eacc pl -> list_iter_sep print_patt1 (fun () -> print_string ".") pl - | p -> print_patt1 p ] -and print_patt1 = - fun - [ Econ s -> print_string s - | Estr s -> do { print_string "\""; print_string s; print_string "\"" } - | Eint s -> print_string s - | Evar () -> print_string "_" - | Etup pl -> - do { - print_string "("; - list_iter_sep print_patt (fun () -> print_string ", ") pl; - print_string ")" - } - | Eapp _ | Eacc _ as p -> - do { print_string "("; print_patt p; print_string ")" } ] -; - -value print ef = - List.iter - (fun m -> - do { - print_patt m.patt; - if m.has_when then print_string " when ..." else (); - print_newline () - }) - ef -; - -(*** Extension ***) - -value insert_matching matchings (patt, has_when, expr) = - let m1 = {patt = patt; has_when = has_when; expr = expr} in - let rec loop = - fun - [ [m :: ml] as gml -> - if m1.has_when && not m.has_when then [m1 :: gml] else - if not m1.has_when && m.has_when then [m :: loop ml] else - (* either both or none have a when clause *) - if compare m1.patt m.patt = 0 then - if not m1.has_when then [m1 :: ml] else [m1 :: gml] - else [m :: loop ml] - | [] -> [m1] ] - in - loop matchings -; - -(* available extension function *) - -value extend ef matchings_def = - List.fold_left insert_matching ef matchings_def -; diff -Nru ocaml-3.12.1/camlp4/unmaintained/lib/extfun.mli ocaml-4.01.0/camlp4/unmaintained/lib/extfun.mli --- ocaml-3.12.1/camlp4/unmaintained/lib/extfun.mli 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/lib/extfun.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,35 +0,0 @@ -(* camlp4r *) - - -(** Extensible functions. - - This module implements pattern matching extensible functions. - To extend, use syntax [pa_extfun.cmo]: - - [extfun e with [ pattern_matching ]] *) - -type t 'a 'b = 'x; - (** The type of the extensible functions of type ['a -> 'b] *) -value empty : t 'a 'b; - (** Empty extensible function *) -value apply : t 'a 'b -> 'a -> 'b; - (** Apply an extensible function *) -exception Failure; - (** Match failure while applying an extensible function *) -value print : t 'a 'b -> unit; - (** Print patterns in the order they are recorded *) - -(**/**) - -type patt = - [ Eapp of list patt - | Eacc of list patt - | Econ of string - | Estr of string - | Eint of string - | Etup of list patt - | Evar of unit ] -and expr 'a 'b = 'a -> option 'b -; - -value extend : t 'a 'b -> list (patt * bool * expr 'a 'b) -> t 'a 'b; diff -Nru ocaml-3.12.1/camlp4/unmaintained/lib/fstream.ml ocaml-4.01.0/camlp4/unmaintained/lib/fstream.ml --- ocaml-3.12.1/camlp4/unmaintained/lib/fstream.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/lib/fstream.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,77 +0,0 @@ -(* camlp4r *) - -(* Copyright 2001 INRIA *) - -type t 'a = { count : int; data : Lazy.t (data 'a) } -and data 'a = - [ Nil - | Cons of 'a and t 'a - | App of t 'a and t 'a ] -; - -value from f = - loop 0 where rec loop i = - {count = 0; - data = - lazy - (match f i with - [ Some x -> Cons x (loop (i + 1)) - | None -> Nil ])} -; - -value rec next s = - let count = s.count + 1 in - match Lazy.force s.data with - [ Nil -> None - | Cons a s -> Some (a, {count = count; data = s.data}) - | App s1 s2 -> - match next s1 with - [ Some (a, s1) -> Some (a, {count = count; data = lazy (App s1 s2)}) - | None -> - match next s2 with - [ Some (a, s2) -> Some (a, {count = count; data = s2.data}) - | None -> None ] ] ] -; - -value empty s = - match next s with - [ Some _ -> None - | None -> Some ((), s) ] -; - -value nil = {count = 0; data = lazy Nil}; -value cons a s = Cons a s; -value app s1 s2 = App s1 s2; -value flazy f = {count = 0; data = Lazy.lazy_from_fun f}; - -value of_list l = - List.fold_right (fun x s -> flazy (fun () -> cons x s)) l nil -; - -value of_string s = - from (fun c -> if c < String.length s then Some s.[c] else None) -; - -value of_channel ic = - from (fun _ -> try Some (input_char ic) with [ End_of_file -> None ]) -; - -value iter f = - do_rec where rec do_rec strm = - match next strm with - [ Some (a, strm) -> - let _ = f a in - do_rec strm - | None -> () ] -; - -value count s = s.count; - -value count_unfrozen s = - loop 0 s where rec loop cnt s = - if Lazy.lazy_is_val s.data then - match Lazy.force s.data with - [ Cons _ s -> loop (cnt + 1) s - | _ -> cnt ] - else cnt -; diff -Nru ocaml-3.12.1/camlp4/unmaintained/lib/fstream.mli ocaml-4.01.0/camlp4/unmaintained/lib/fstream.mli --- ocaml-3.12.1/camlp4/unmaintained/lib/fstream.mli 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/lib/fstream.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,60 +0,0 @@ -(* camlp4r *) - - -(* Module [Fstream]: functional streams *) - -(* This module implement functional streams. - To be used with syntax [pa_fstream.cmo]. The syntax is: -- stream: [fstream [: ... :]] -- parser: [parser [ [: ... :] -> ... | ... ]] - - Functional parsers are of type: [Fstream.t 'a -> option ('a * Fstream.t 'a)] - - They have limited backtrack, i.e if a rule fails, the next rule is tested - with the initial stream; limited because when in case of a rule with two - consecutive symbols [a] and [b], if [b] fails, the rule fails: there is - no try with the next rule of [a]. -*) - -type t 'a = 'x; - (* The type of 'a functional streams *) -value from : (int -> option 'a) -> t 'a; - (* [Fstream.from f] returns a stream built from the function [f]. - To create a new stream element, the function [f] is called with - the current stream count. The user function [f] must return either - [Some ] for a value or [None] to specify the end of the - stream. *) - -value of_list : list 'a -> t 'a; - (* Return the stream holding the elements of the list in the same - order. *) -value of_string : string -> t char; - (* Return the stream of the characters of the string parameter. *) -value of_channel : in_channel -> t char; - (* Return the stream of the characters read from the input channel. *) - -value iter : ('a -> unit) -> t 'a -> unit; - (* [Fstream.iter f s] scans the whole stream s, applying function [f] - in turn to each stream element encountered. *) - -value next : t 'a -> option ('a * t 'a); - (* Return [Some (a, s)] where [a] is the first element of the stream - and [s] the remaining stream, or [None] if the stream is empty. *) -value empty : t 'a -> option (unit * t 'a); - (* Return [Some ((), s)] if the stream is empty where [s] is itself, - else [None] *) -value count : t 'a -> int; - (* Return the current count of the stream elements, i.e. the number - of the stream elements discarded. *) -value count_unfrozen : t 'a -> int; - (* Return the number of unfrozen elements in the beginning of the - stream; useful to determine the position of a parsing error (longuest - path). *) - -(*--*) - -value nil : t 'a; -type data 'a = 'x; -value cons : 'a -> t 'a -> data 'a; -value app : t 'a -> t 'a -> data 'a; -value flazy : (unit -> data 'a) -> t 'a; diff -Nru ocaml-3.12.1/camlp4/unmaintained/ocamllex/Makefile ocaml-4.01.0/camlp4/unmaintained/ocamllex/Makefile --- ocaml-3.12.1/camlp4/unmaintained/ocamllex/Makefile 2004-11-30 18:57:04.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/ocamllex/Makefile 1970-01-01 00:00:00.000000000 +0000 @@ -1,59 +0,0 @@ -######################################################################### -# # -# Objective Caml # -# # -# Camlp4 # -# # -# Copyright 2004 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### -# -# Makefile for pa_ocamllex -# M.Mauny -# - -include ../../config/Makefile.cnf - -OCAMLTOP=../../.. - -CAMLP4=../../camlp4/camlp4$(EXE) - -OCAMLC=$(OCAMLTOP)/ocamlc$(EXE) -OCAMLOPT=$(OCAMLTOP)/ocamlopt$(EXE) - -P4INCLUDES= -nolib -I ../../etc -I ../../meta -OCAMLINCLUDES= -nostdlib -I $(OCAMLTOP)/stdlib -I ../../camlp4 -I ../../lib -I $(OCAMLTOP)/lex -OCAMLCFLAGS=-warn-error A $(OCAMLINCLUDES) - -SRC=pa_ocamllex.ml -OBJS=pa_ocamllex.cmo -OBJSX=$(OBJS:.cmo=.cmx) - -all: $(OBJS) pa_ocamllex.cma - -opt: $(OBJSX) pa_ocamllex.cmxa - -pa_ocamllex.cma: pa_ocamllex.cmo - $(OCAMLC) $(OCAMLCFLAGS) cset.cmo syntax.cmo table.cmo lexgen.cmo compact.cmo pa_ocamllex.cmo -a -o pa_ocamllex.cma - -pa_ocamllex.cmxa: pa_ocamllex.cmo - $(OCAMLOPT) $(OCAMLCFLAGS) cset.cmx syntax.cmx table.cmx lexgen.cmx compact.cmx pa_ocamllex.cmx -a -o pa_ocamllex.cmxa - -clean: - rm -f *.cm* *.$(O) *.$(A) *.bak .*.bak - -depend: - -.SUFFIXES: .cmx .cmo .cmi .ml .mli - -.mli.cmi: - $(OCAMLC) $(OCAMLCFLAGS) -c $< - - -.ml.cmo: - $(OCAMLC) $(OCAMLCFLAGS) -pp "$(CAMLP4) $(P4INCLUDES) `awk 'NR == 1 { ORS=" "; for (i=2; i < NF; i++) print $$i; } ' $<`" -c $< - -.ml.cmx: - $(OCAMLOPT) $(OCAMLCFLAGS) -pp "$(CAMLP4) $(P4INCLUDES) `awk 'NR == 1 { ORS=" "; for (i=2; i < NF; i++) print $$i; } ' $<`" -c $< diff -Nru ocaml-3.12.1/camlp4/unmaintained/ocamllex/README ocaml-4.01.0/camlp4/unmaintained/ocamllex/README --- ocaml-3.12.1/camlp4/unmaintained/ocamllex/README 2004-07-13 12:25:21.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/ocamllex/README 1970-01-01 00:00:00.000000000 +0000 @@ -1,15 +0,0 @@ -This is an application of or an extension for Camlp4. Although it is -currently distributed with OCaml/Camlp4, it may or may not be -actively maintained. - -It probably won't be part of future OCaml/Camlp4 distributions but be -accessible from the Camlp4 hump. If you are interested in developing -this package further and/or actively maintain it, please let us know -(caml@inria.fr) - -This package is distributed under the same license as the Objective -Caml Library (that is, LGPL with a special exception allowing both -static and dynamic link). - --- Michel Mauny - diff -Nru ocaml-3.12.1/camlp4/unmaintained/ocamllex/pa_ocamllex.ml ocaml-4.01.0/camlp4/unmaintained/ocamllex/pa_ocamllex.ml --- ocaml-3.12.1/camlp4/unmaintained/ocamllex/pa_ocamllex.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/ocamllex/pa_ocamllex.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,356 +0,0 @@ -(* pa_o.cmo q_MLast.cmo pa_extend.cmo pr_dump.cmo *) -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Alain Frisch, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2002 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file *) -(* ../../../LICENSE. *) -(* *) -(***********************************************************************) - - -open Syntax -open Lexgen -open Compact - -(* Adapted from output.ml *) -(**************************) - -(* Output the DFA tables and its entry points *) - -(* To output an array of short ints, encoded as a string *) - -let output_byte buf b = - Buffer.add_char buf '\\'; - Buffer.add_char buf (Char.chr(48 + b / 100)); - Buffer.add_char buf (Char.chr(48 + (b / 10) mod 10)); - Buffer.add_char buf (Char.chr(48 + b mod 10)) - -let loc = (Lexing.dummy_pos,Lexing.dummy_pos) - -let output_array v = - let b = Buffer.create (Array.length v * 3) in - for i = 0 to Array.length v - 1 do - output_byte b (v.(i) land 0xFF); - output_byte b ((v.(i) asr 8) land 0xFF); - if i land 7 = 7 then Buffer.add_string b "\\\n " - done; - let s = Buffer.contents b in - <:expr< $str:s$ >> - -let output_byte_array v = - let b = Buffer.create (Array.length v * 2) in - for i = 0 to Array.length v - 1 do - output_byte b (v.(i) land 0xFF); - if i land 15 = 15 then Buffer.add_string b "\\\n " - done; - let s = Buffer.contents b in - <:expr< $str:s$ >> - - - -(* Output the tables *) - -let output_tables tbl = - <:str_item< value lex_tables = { - Lexing.lex_base = $output_array tbl.tbl_base$; - Lexing.lex_backtrk = $output_array tbl.tbl_backtrk$; - Lexing.lex_default = $output_array tbl.tbl_default$; - Lexing.lex_trans = $output_array tbl.tbl_trans$; - Lexing.lex_check = $output_array tbl.tbl_check$; - Lexing.lex_base_code = $output_array tbl.tbl_base_code$; - Lexing.lex_backtrk_code = $output_array tbl.tbl_backtrk_code$; - Lexing.lex_default_code = $output_array tbl.tbl_default_code$; - Lexing.lex_trans_code = $output_array tbl.tbl_trans_code$; - Lexing.lex_check_code = $output_array tbl.tbl_check_code$; - Lexing.lex_code = $output_byte_array tbl.tbl_code$ - } >> - -(* Output the entries *) - -let rec make_alias n = function - | [] -> [] - | h::t -> - (h, "__ocaml_lex_arg_" ^ (string_of_int n)) :: (make_alias (succ n) t) - -let abstraction = - List.fold_right (fun (p,a) e -> <:expr< fun ($p$ as $lid:a$) -> $e$ >>) - - -let application = - List.fold_left (fun f (_,a) -> <:expr< $f$ $lid:a$ >>) - -let int i = <:expr< $int:string_of_int i$ >> - -let output_memory_actions acts = - let aux = function - | Copy (tgt, src) -> - <:expr< lexbuf.Lexing.lex_mem.($int tgt$) := - lexbuf.Lexing.lex_mem.($int src$) >> - | Set tgt -> - <:expr< lexbuf.Lexing.lex_mem.($int tgt$) := - lexbuf.Lexing.lex_curr_pos >> - in - <:expr< do { $list:List.map aux acts$ } >> - -let output_base_mem = function - | Mem i -> <:expr< lexbuf.Lexing.lex_mem.($int i$) >> - | Start -> <:expr< lexbuf.Lexing.lex_start_pos >> - | End -> <:expr< lexbuf.Lexing.lex_curr_pos >> - -let output_tag_access = function - | Sum (a,0) -> output_base_mem a - | Sum (a,i) -> <:expr< $output_base_mem a$ + $int i$ >> - -let rec output_env e = function - | [] -> e - | (x, Ident_string (o,nstart,nend)) :: rem -> - <:expr< - let $lid:x$ = - Lexing.$lid:if o then "sub_lexeme_opt" else "sub_lexeme"$ - lexbuf $output_tag_access nstart$ $output_tag_access nend$ - in $output_env e rem$ - >> - | (x, Ident_char (o,nstart)) :: rem -> - <:expr< - let $lid:x$ = - Lexing.$lid: if o then "sub_lexeme_char_opt" else "sub_lexeme_char"$ - lexbuf $output_tag_access nstart$ - in $output_env e rem$ - >> - -let output_entry e = - let init_num, init_moves = e.auto_initial_state in - let args = make_alias 0 (e.auto_args @ [ <:patt< lexbuf >> ]) in - let f = "__ocaml_lex_rec_" ^ e.auto_name ^ "_rec" in - let call_f = application <:expr< $lid:f$ >> args in - let body_wrapper = - <:expr< - do { - lexbuf.Lexing.lex_mem := Array.create $int e.auto_mem_size$ (-1) ; - $output_memory_actions init_moves$; - $call_f$ $int init_num$ - } >> in - let cases = - List.map - (fun (num, env, (loc,e)) -> - <:patt< $int:string_of_int num$ >>, - None, - output_env <:expr< $e$ >> env - (* Note: the <:expr<...>> above is there to set the location *) - ) e.auto_actions @ - [ <:patt< __ocaml_lex_n >>, - None, - <:expr< do - { lexbuf.Lexing.refill_buff lexbuf; $call_f$ __ocaml_lex_n }>> ] - in - let engine = - if e.auto_mem_size = 0 - then <:expr< Lexing.engine >> - else <:expr< Lexing.new_engine >> in - let body = - <:expr< fun state -> - match $engine$ lex_tables state lexbuf with [ $list:cases$ ] >> in - [ - <:patt< $lid:e.auto_name$ >>, (abstraction args body_wrapper); - <:patt< $lid:f$ >>, (abstraction args body) - ] - -(* Main output function *) - -exception Table_overflow - -let output_lexdef tables entry_points = - Printf.eprintf - "pa_ocamllex: lexer found; %d states, %d transitions, table size %d bytes\n" - (Array.length tables.tbl_base) - (Array.length tables.tbl_trans) - (2 * (Array.length tables.tbl_base + Array.length tables.tbl_backtrk + - Array.length tables.tbl_default + Array.length tables.tbl_trans + - Array.length tables.tbl_check)); - let size_groups = - (2 * (Array.length tables.tbl_base_code + - Array.length tables.tbl_backtrk_code + - Array.length tables.tbl_default_code + - Array.length tables.tbl_trans_code + - Array.length tables.tbl_check_code) + - Array.length tables.tbl_code) in - if size_groups > 0 then - Printf.eprintf "pa_ocamllex: %d additional bytes used for bindings\n" - size_groups ; - flush stderr; - if Array.length tables.tbl_trans > 0x8000 then raise Table_overflow; - - let entries = List.map output_entry entry_points in - [output_tables tables; <:str_item< value rec $list:List.flatten entries$ >> ] - - -(* Adapted from parser.mly and main.ml *) -(***************************************) - -(* Auxiliaries for the parser. *) - -let char s = Char.code (Token.eval_char s) - -let named_regexps = - (Hashtbl.create 13 : (string, regular_expression) Hashtbl.t) - -let regexp_for_string s = - let rec re_string n = - if n >= String.length s then Epsilon - else if succ n = String.length s then - Characters (Cset.singleton (Char.code s.[n])) - else - Sequence - (Characters(Cset.singleton (Char.code s.[n])), - re_string (succ n)) - in re_string 0 - -let char_class c1 c2 = Cset.interval c1 c2 - -let all_chars = Cset.all_chars - -let rec remove_as = function - | Bind (e,_) -> remove_as e - | Epsilon|Eof|Characters _ as e -> e - | Sequence (e1, e2) -> Sequence (remove_as e1, remove_as e2) - | Alternative (e1, e2) -> Alternative (remove_as e1, remove_as e2) - | Repetition e -> Repetition (remove_as e) - -let () = - Hashtbl.add named_regexps "eof" (Characters Cset.eof) - -(* The parser *) - -let let_regexp = Grammar.Entry.create Pcaml.gram "pa_ocamllex let" -let header = Grammar.Entry.create Pcaml.gram "pa_ocamllex header" -let lexer_def = Grammar.Entry.create Pcaml.gram "pa_ocaml lexerdef" - -EXTEND - GLOBAL: Pcaml.str_item let_regexp header lexer_def; - - let_regexp: [ - [ x = LIDENT; "="; r = regexp -> - if Hashtbl.mem named_regexps x then - Printf.eprintf - "pa_ocamllex (warning): multiple definition of named regexp '%s'\n" - x; - Hashtbl.add named_regexps x r; - ] - ]; - - lexer_def: [ - [ def = LIST0 definition SEP "and" -> - (try - let (entries, transitions) = make_dfa def in - let tables = compact_tables transitions in - let output = output_lexdef tables entries in - <:str_item< declare $list: output$ end >> - with - |Table_overflow -> - failwith "Transition table overflow in lexer, automaton is too big" - | Lexgen.Memory_overflow -> - failwith "Position memory overflow in lexer, too many as variables") - ] - ]; - - - Pcaml.str_item: [ - [ "pa_ocamllex"; LIDENT "rule"; d = lexer_def -> d - | "pa_ocamllex"; "let"; let_regexp -> - <:str_item< declare $list: []$ end >> - ] - ]; - - definition: [ - [ x=LIDENT; pl = LIST0 Pcaml.patt LEVEL "simple"; "="; - short=[ LIDENT "parse" -> false | LIDENT "shortest" -> true ]; - OPT "|"; l = LIST0 [ r=regexp; a=action -> (r,a) ] SEP "|" -> - { name=x ; shortest=short ; args=pl ; clauses = l } ] - ]; - - action: [ - [ "{"; e = OPT Pcaml.expr; "}" -> - let e = match e with - | Some e -> e - | None -> <:expr< () >> - in - (loc,e) - ] - ]; - - header: [ - [ "{"; e = LIST0 [ si = Pcaml.str_item; OPT ";;" -> si ]; "}" -> - [<:str_item< declare $list:e$ end>>, loc] ] - | [ -> [] ] - ]; - - regexp: [ - [ r = regexp; "as"; i = LIDENT -> Bind (r,i) ] - | [ r1 = regexp; "|"; r2 = regexp -> Alternative(r1,r2) ] - | [ r1 = regexp; r2 = regexp -> Sequence(r1,r2) ] - | [ r = regexp; "*" -> Repetition r - | r = regexp; "+" -> Sequence(Repetition (remove_as r), r) - | r = regexp; "?" -> Alternative(Epsilon, r) - | "("; r = regexp; ")" -> r - | "_" -> Characters all_chars - | c = CHAR -> Characters (Cset.singleton (char c)) - | s = STRING -> regexp_for_string (Token.eval_string loc s) - | "["; cc = ch_class; "]" -> Characters cc - | x = LIDENT -> - try Hashtbl.find named_regexps x - with Not_found -> - failwith - ("pa_ocamllex (error): reference to unbound regexp name `"^x^"'") - ] - ]; - - ch_class: [ - [ "^"; cc = ch_class -> Cset.complement cc] - | [ c1 = CHAR; "-"; c2 = CHAR -> Cset.interval (char c1) (char c2) - | c = CHAR -> Cset.singleton (char c) - | cc1 = ch_class; cc2 = ch_class -> Cset.union cc1 cc2 - ] - ]; -END - -(* We have to be careful about "rule"; in standalone mode, - it is used as a keyword (otherwise, there is a conflict - with named regexp); in normal mode, it is used as LIDENT - (we do not want to reserve such an useful identifier). - - Plexer does not like identifiers used as keyword _and_ - as LIDENT ... -*) - -let standalone = - let already = ref false in - fun () -> - if not (!already) then - begin - already := true; - Printf.eprintf "pa_ocamllex: stand-alone mode\n"; - - DELETE_RULE Pcaml.str_item: "pa_ocamllex"; LIDENT "rule";lexer_def END; - DELETE_RULE Pcaml.str_item: "pa_ocamllex"; "let"; let_regexp END; - let ocamllex = Grammar.Entry.create Pcaml.gram "pa_ocamllex" in - EXTEND GLOBAL: ocamllex let_regexp header lexer_def; - ocamllex: [ - [ h = header; - l = [LIST0 ["let"; let_regexp]; "rule"; d = lexer_def -> (d,loc)]; - t = header; EOI -> h @ (l :: t) ,false - ] - ]; - END; - Pcaml.parse_implem := Grammar.Entry.parse ocamllex - end - -let () = - Pcaml.add_option "-ocamllex" (Arg.Unit standalone) - "Activate (standalone) ocamllex emulation mode." - diff -Nru ocaml-3.12.1/camlp4/unmaintained/ocpp/.cvsignore ocaml-4.01.0/camlp4/unmaintained/ocpp/.cvsignore --- ocaml-3.12.1/camlp4/unmaintained/ocpp/.cvsignore 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/ocpp/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -*.cm[oia] -ocpp -crc.ml diff -Nru ocaml-3.12.1/camlp4/unmaintained/ocpp/Makefile ocaml-4.01.0/camlp4/unmaintained/ocpp/Makefile --- ocaml-3.12.1/camlp4/unmaintained/ocpp/Makefile 2008-10-27 14:03:31.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/ocpp/Makefile 1970-01-01 00:00:00.000000000 +0000 @@ -1,24 +0,0 @@ - - -include ../config/Makefile.cnf - -EXECUTABLES=ocpp -OBJS=ocpp.cmo -INCLUDES=-I ../camlp4 -I ../lib -I ../odyl -I $(OTOP)/otherlibs/dynlink -OCPPM=../lib/debug.cmo ../lib/loc.cmo ../lib/stdpp.cmo ../camlp4/quotation.cmo - -include ../config/Makefile.base - -ocpp$(EXE): $(OBJS) - $(OCAMLC) $(LINKFLAGS) $(OCPPM) ../odyl/odyl.cma $(OBJS) ../odyl/odyl.cmo -linkall -o $@ - -ocpp.opt: $(OBJSX) - $(OCAMLOPT) $(LINKFLAGS) $(OCPPM:.cmo=.cmx) ../odyl/odyl.cmxa $(OBJSX) ../odyl/odyl.cmx -linkall -o $@ - -install-local: - -$(MKDIR) "$(LIBDIR)/camlp4" "$(BINDIR)" - cp $(OBJS) "$(LIBDIR)/camlp4/." - cp ocpp$(EXE) "$(BINDIR)/." - if test -f ocpp.opt ; then \ - cp ocpp.opt "$(LIBDIR)/camlp4/." ; \ - fi diff -Nru ocaml-3.12.1/camlp4/unmaintained/ocpp/ocpp.ml ocaml-4.01.0/camlp4/unmaintained/ocpp/ocpp.ml --- ocaml-3.12.1/camlp4/unmaintained/ocpp/ocpp.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/ocpp/ocpp.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,129 +0,0 @@ -(* camlp4r *) -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2002 Institut National de Recherche en Informatique et *) -(* Automatique. Distributed only by permission. *) -(* *) -(***********************************************************************) - - - - -value buff = ref (String.create 80); -value store len x = - do { - if len >= String.length buff.val then - buff.val := buff.val ^ String.create (String.length buff.val) - else (); - buff.val.[len] := x; - succ len - } -; -value get_buff len = String.sub buff.val 0 len; - -value rec copy_strip_locate cs = - match cs with parser - [ [: `'$' :] -> maybe_locate cs - | [: `c :] -> do { print_char c; copy_strip_locate cs } - | [: :] -> () ] -and maybe_locate cs = - match cs with parser - [ [: `'1'..'9' :] -> locate cs - | [: :] -> do { print_char '$'; copy_strip_locate cs } ] -and locate cs = - match cs with parser - [ [: `'0'..'9' :] -> locate cs - | [: `':' :] -> inside_locate cs - | [: :] -> raise (Stream.Error "colon char expected") ] -and inside_locate cs = - match cs with parser - [ [: `'$' :] -> copy_strip_locate cs - | [: `'\\'; `c :] -> do { print_char c; inside_locate cs } - | [: `c :] -> do { print_char c; inside_locate cs } - | [: :] -> raise (Stream.Error "end of file in locate directive") ] -; - -value file = ref ""; - -value quot name loc str = - let loc = Loc.move `stop (String.length str) loc in - let exp = - try - match Quotation.find name with - [ Quotation.ExStr f -> f - | _ -> raise Not_found ] - with - [ Not_found -> Stdpp.raise_with_loc loc Not_found ] - in - let new_str = - try exp True { Quotation.loc = Loc.mk file.val ; loc_name_opt = None } str with - [ Loc.Exc_located loc exc -> Stdpp.raise_with_loc loc exc - | exc -> Stdpp.raise_with_loc loc exc ] - in - let cs = Stream.of_string new_str in copy_strip_locate cs -; - -value rec ident len = - parser - [ [: `('A'..'Z' | 'a'..'z' | '0'..'9' | '_' | ''' as c); s :] -> - ident (store len c) s - | [: :] -> get_buff len ] -; - -value loc_of_ep ep = - Loc.set_all `start 1 0 ep (Loc.mk file.val); - -value rec copy cs = - match cs with parser - [ [: `'<' :] -> maybe_quot cs - | [: `'"' :] -> do { print_char '"'; inside_string cs } - | [: `c :] -> do { print_char c; copy cs } - | [: :] -> () ] -and maybe_quot cs = - match cs with parser - [ [: `'<' :] ep -> inside_quot "" (loc_of_ep ep) 0 cs - | [: `':'; i = ident 0; `'<' ?? "less char expected" :] ep -> - inside_quot i (loc_of_ep ep) 0 cs - | [: :] -> do { print_char '<'; copy cs } ] -and inside_quot name loc len cs = - match cs with parser - [ [: `'>' :] -> maybe_end_quot name loc len cs - | [: `c :] -> inside_quot name loc (store len c) cs - | [: :] -> raise (Stream.Error "end of file in quotation") ] -and maybe_end_quot name loc len cs = - match cs with parser - [ [: `'>' :] -> do { quot name loc (get_buff len); copy cs } - | [: :] -> inside_quot name loc (store len '>') cs ] -and inside_string cs = - match cs with parser - [ [: `'"' :] -> do { print_char '"'; copy cs } - | [: `c :] -> do { print_char c; inside_string cs } - | [: :] -> raise (Stream.Error "end of file in string") ] -; - -value copy_quot cs = do { copy cs; flush stdout; }; - -Arg.parse [] (fun x -> file.val := x) "ocpp "; - -value main () = - try - if file.val <> "" then - copy_quot (Stream.of_channel (open_in_bin file.val)) - else () - with exc -> - do { - Format.printf "@."; - raise - (match exc with - [ Loc.Exc_located loc exc -> - do { Format.eprintf "%a@." Loc.print loc; exc } - | exc -> exc ]) - } -; - -Odyl_main.name.val := "ocpp"; -Odyl_main.go.val := main; diff -Nru ocaml-3.12.1/camlp4/unmaintained/odyl/.cvsignore ocaml-4.01.0/camlp4/unmaintained/odyl/.cvsignore --- ocaml-3.12.1/camlp4/unmaintained/odyl/.cvsignore 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/odyl/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,4 +0,0 @@ -*.cm[oia] -odyl -*.lib -odyl_config.ml diff -Nru ocaml-3.12.1/camlp4/unmaintained/odyl/.depend ocaml-4.01.0/camlp4/unmaintained/odyl/.depend --- ocaml-3.12.1/camlp4/unmaintained/odyl/.depend 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/odyl/.depend 1970-01-01 00:00:00.000000000 +0000 @@ -1,4 +0,0 @@ -odyl.cmo: odyl_main.cmi odyl_config.cmo -odyl.cmx: odyl_main.cmx odyl_config.cmx -odyl_main.cmo: odyl_config.cmo odyl_main.cmi -odyl_main.cmx: odyl_config.cmx odyl_main.cmi diff -Nru ocaml-3.12.1/camlp4/unmaintained/odyl/Makefile ocaml-4.01.0/camlp4/unmaintained/odyl/Makefile --- ocaml-3.12.1/camlp4/unmaintained/odyl/Makefile 2008-10-27 14:03:31.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/odyl/Makefile 1970-01-01 00:00:00.000000000 +0000 @@ -1,61 +0,0 @@ - - -include ../config/Makefile.cnf - -EXECUTABLES=odyl -INCLUDES=-I $(OTOP)/otherlibs/dynlink -OBJS=odyl_config.cmo odyl_main.cmo -OBJSX=odyl.cmx odyl.cmxa -CLEANFILES=odyl_config.ml - -include ../config/Makefile.base - -odyl$(EXE): odyl.cma odyl.cmo - $(OCAMLC) odyl.cma odyl.cmo -o $@ - -odyl.opt: odyl.cmxa odyl.cmx - $(OCAMLOPT) odyl.cmxa odyl.cmx -o $@ - -odyl.cma: $(OBJS) - $(OCAMLC) $(LINKFLAGS) dynlink.cma $(OBJS) -a -o $@ - -odyl.cmxa: $(OBJSX) - $(OCAMLOPT) $(LINKFLAGS) $(OBJSX) -a -o $@ - -odyl.p.cmxa: $(OBJSP) - $(OCAMLOPT) $(LINKFLAGS) $(OBJSP) -a -o $@ - -odyl_main.cmx: odyl_main.ml - $(CAMLP4BOOT) -nolib -DOPT -o odyl_main.ppo odyl_main.ml - $(OCAMLOPT) -c -impl odyl_main.ppo - rm -f odyl_main.ppo - -odyl_main.p.cmx: odyl_main.ml - $(CAMLP4BOOT) -nolib -DOPT -o odyl_main.ppo odyl_main.ml - $(OCAMLOPT) -p -c -o $@ -impl odyl_main.ppo - rm -f odyl_main.ppo - -odyl_config.ml: - (echo '(* camlp4r *)'; \ - echo 'value standard_library ='; \ - echo ' try Sys.getenv "CAMLP4LIB" with [ Not_found -> '; \ - echo ' try Sys.getenv "OCAMLLIB" ^ "/camlp4" with [ Not_found -> '; \ - echo ' try Sys.getenv "CAMLLIB" ^ "/camlp4" with [ Not_found -> '; \ - echo ' "$(LIBDIR)/camlp4"]]];') \ - | sed -e 's|\\|/|g' > odyl_config.ml - -install-local: - -$(MKDIR) "$(LIBDIR)/camlp4" "$(BINDIR)" - cp odyl.cmo odyl.cma odyl_main.cmi $(LIBDIR)/camlp4/. - for f in odyl.$(A) odyl.p.$(A) ; do \ - if test -f $$f ; then \ - cp $$f "$(LIBDIR)/camlp4/." && ( cd "$(LIBDIR)/camlp4/." && $(RANLIB) $$f ) ; \ - fi ; \ - done - for f in odyl.cmx odyl.o odyl.p.cmx odyl.p.o odyl.cmxa odyl.p.cmxa ; do \ - if test -f $$f ; then \ - cp $$f "$(LIBDIR)/camlp4/." ; \ - fi ; \ - done - -include .depend diff -Nru ocaml-3.12.1/camlp4/unmaintained/odyl/odyl.ml ocaml-4.01.0/camlp4/unmaintained/odyl/odyl.ml --- ocaml-3.12.1/camlp4/unmaintained/odyl/odyl.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/odyl/odyl.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,57 +0,0 @@ -(* camlp4r *) -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2001 Institut National de Recherche en Informatique et *) -(* Automatique. Distributed only by permission. *) -(* *) -(***********************************************************************) - - - -value apply_load () = - let i = ref 1 in - let stop = ref False in - while not stop.val && i.val < Array.length Sys.argv do { - let s = Sys.argv.(i.val) in - if s = "-I" && i.val + 1 < Array.length Sys.argv then do { - Odyl_main.directory Sys.argv.(i.val + 1); - i.val := i.val + 2 - } - else if s = "-nolib" then do { Odyl_main.nolib.val := True; incr i } - else if s = "-where" then do { - print_string Odyl_config.standard_library; - print_newline (); - flush stdout; - exit 0 - } - else if s = "-version" then do { - print_string Sys.ocaml_version; - print_newline (); - flush stdout; - exit 0 - } - else if s = "--" then do { incr i; stop.val := True; () } - else if String.length s > 0 && s.[0] == '-' then stop.val := True - else if Filename.check_suffix s ".cmo" || Filename.check_suffix s ".cma" - then do { Odyl_main.loadfile s; incr i } - else stop.val := True - } -; - -value main () = - try do { apply_load () ; Odyl_main.go.val () } with - [ Odyl_main.Error fname str -> - do { - flush stdout; - Printf.eprintf "Error while loading \"%s\": " fname; - Printf.eprintf "%s.\n" str; - flush stderr; - exit 2 - } ] -; - -Printexc.catch main (); diff -Nru ocaml-3.12.1/camlp4/unmaintained/odyl/odyl_main.mli ocaml-4.01.0/camlp4/unmaintained/odyl/odyl_main.mli --- ocaml-3.12.1/camlp4/unmaintained/odyl/odyl_main.mli 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/odyl/odyl_main.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,13 +0,0 @@ -(* camlp4r *) - - -exception Error of string and string; - -value nolib : ref bool; -value initialized : ref bool; -value path : ref (list string); -value loadfile : string -> unit; -value directory : string -> unit; - -value go : ref (unit -> unit); -value name : ref string; diff -Nru ocaml-3.12.1/camlp4/unmaintained/olabl/Makefile ocaml-4.01.0/camlp4/unmaintained/olabl/Makefile --- ocaml-3.12.1/camlp4/unmaintained/olabl/Makefile 2004-11-30 18:57:04.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/olabl/Makefile 1970-01-01 00:00:00.000000000 +0000 @@ -1,61 +0,0 @@ -######################################################################### -# # -# Objective Caml # -# # -# Camlp4 # -# # -# Copyright 2004 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### -# -# Makefile for pa_lefteval -# M.Mauny -# - -include ../../config/Makefile.cnf - -OCAMLTOP=../../.. -CAMLP4=../../camlp4/camlp4$(EXE) - -OCAMLC=$(OCAMLTOP)/ocamlc$(EXE) -OCAMLOPT=$(OCAMLTOP)/ocamlopt$(EXE) - -P4INCLUDES= -nolib -I ../../meta -I ../../lib -I ../../etc -OCAMLINCLUDES= -nostdlib -I $(OCAMLTOP)/stdlib -I ../../lib -I ../../camlp4 -OCAMLCFLAGS=-warn-error A $(OCAMLINCLUDES) - -SRC=pa_olabl.ml -OBJS=$(SRC:.ml=.cmo) -OBJSX=$(SRC:.ml=.cmx) - -all: $(OBJS) - -opt: $(OBJSX) - -depend: - cp .depend .depend.bak - > .depend - for file in $(SRC); do \ - $(CAMLP4) $(P4INCLUDES) `awk 'NR == 1 { ORS=" "; for (i=2; i < NF; i++) print $$i; } ' $$file` pr_depend.cmo $$i | \ - sed -e 's| \.\./\.\./\.\.| $$(OCAMLTOP)|g' >> .depend; \ - done - -clean: - rm -f *.cm* *.$(O) *.bak .*.bak - - -.SUFFIXES: .cmx .cmo .cmi .ml .mli - -.mli.cmi: - $(OCAMLC) $(OCAMLCFLAGS) -c $< - - -.ml.cmo: - $(OCAMLC) $(OCAMLCFLAGS) -pp "$(CAMLP4) $(P4INCLUDES) `awk 'NR == 1 { ORS=" "; for (i=2; i < NF; i++) print $$i; } ' $<`" -c $< - -.ml.cmx: - $(OCAMLOPT) $(OCAMLCFLAGS) -pp "$(CAMLP4) $(P4INCLUDES) `awk 'NR == 1 { ORS=" "; for (i=2; i < NF; i++) print $$i; } ' $<`" -c $< - -include .depend diff -Nru ocaml-3.12.1/camlp4/unmaintained/olabl/README ocaml-4.01.0/camlp4/unmaintained/olabl/README --- ocaml-3.12.1/camlp4/unmaintained/olabl/README 2004-07-13 12:25:21.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/olabl/README 1970-01-01 00:00:00.000000000 +0000 @@ -1,15 +0,0 @@ -This is an application of or an extension for Camlp4. Although it is -currently distributed with OCaml/Camlp4, it may or may not be -actively maintained. - -It probably won't be part of future OCaml/Camlp4 distributions but be -accessible from the Camlp4 hump. If you are interested in developing -this package further and/or actively maintain it, please let us know -(caml@inria.fr) - -This package is distributed under the same license as the Objective -Caml Library (that is, LGPL with a special exception allowing both -static and dynamic link). - --- Michel Mauny - diff -Nru ocaml-3.12.1/camlp4/unmaintained/olabl/pa_olabl.ml ocaml-4.01.0/camlp4/unmaintained/olabl/pa_olabl.ml --- ocaml-3.12.1/camlp4/unmaintained/olabl/pa_olabl.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/olabl/pa_olabl.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,2022 +0,0 @@ -(* pa_r.cmo pa_rp.cmo pa_extend.cmo q_MLast.cmo pr_dump.cmo *) -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2002 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file *) -(* ../../../LICENSE. *) -(* *) -(***********************************************************************) - - - -module Plexer = - struct - open Stdpp; - open Token; - value buff = ref (String.create 80); - value store len x = - do { - if len >= String.length buff.val then - buff.val := buff.val ^ String.create (String.length buff.val) - else (); - buff.val.[len] := x; - succ len - } - ; - value mstore len s = - add_rec len 0 where rec add_rec len i = - if i == String.length s then len - else add_rec (store len s.[i]) (succ i) - ; - value get_buff len = String.sub buff.val 0 len; - value rec ident len = - parser - [ [: `('A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | - '\248'..'\255' | '0'..'9' | '_' | ''' as - c) - ; - s :] -> - ident (store len c) s - | [: :] -> len ] - and ident2 len = - parser - [ [: `('!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | - '%' | '.' | ':' | '<' | '>' | '|' as - c) - ; - s :] -> - ident2 (store len c) s - | [: :] -> len ] - and ident3 len = - parser - [ [: `('0'..'9' | 'A'..'Z' | 'a'..'z' | '\192'..'\214' | - '\216'..'\246' | '\248'..'\255' | '_' | '!' | '%' | '&' | '*' | - '+' | '-' | '.' | '/' | ':' | '<' | '=' | '>' | '?' | '@' | '^' | - '|' | '~' | ''' | '$' as - c) - ; - s :] -> - ident3 (store len c) s - | [: :] -> len ] - and ident4 len = - parser - [ [: `('!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | - '%' | '.' | '<' | '>' | '|' as - c) - ; - s :] -> - ident4 (store len c) s - | [: :] -> len ] - and base_number len = - parser - [ [: `'o' | 'O'; s :] -> octal_digits (store len 'o') s - | [: `'x' | 'X'; s :] -> hexa_digits (store len 'x') s - | [: `'b' | 'B'; s :] -> binary_digits (store len 'b') s - | [: a = number len :] -> a ] - and octal_digits len = - parser - [ [: `('0'..'7' as d); s :] -> octal_digits (store len d) s - | [: :] -> ("INT", get_buff len) ] - and hexa_digits len = - parser - [ [: `('0'..'9' | 'a'..'f' | 'A'..'F' as d); s :] -> - hexa_digits (store len d) s - | [: :] -> ("INT", get_buff len) ] - and binary_digits len = - parser - [ [: `('0'..'1' as d); s :] -> binary_digits (store len d) s - | [: :] -> ("INT", get_buff len) ] - and number len = - parser - [ [: `('0'..'9' as c); s :] -> number (store len c) s - | [: `'.'; s :] -> decimal_part (store len '.') s - | [: `'e' | 'E'; s :] -> exponent_part (store len 'E') s - | [: :] -> ("INT", get_buff len) ] - and decimal_part len = - parser - [ [: `('0'..'9' as c); s :] -> decimal_part (store len c) s - | [: `'e' | 'E'; s :] -> exponent_part (store len 'E') s - | [: :] -> ("FLOAT", get_buff len) ] - and exponent_part len = - parser - [ [: `('+' | '-' as c); s :] -> end_exponent_part (store len c) s - | [: a = end_exponent_part len :] -> a ] - and end_exponent_part len = - parser - [ [: `('0'..'9' as c); s :] -> end_exponent_part (store len c) s - | [: :] -> ("FLOAT", get_buff len) ] - ; - value valch x = Char.code x - Char.code '0'; - value rec backslash s i = - if i = String.length s then raise Not_found - else - match s.[i] with - [ 'n' -> ('\n', i + 1) - | 'r' -> ('\r', i + 1) - | 't' -> ('\t', i + 1) - | 'b' -> ('\b', i + 1) - | '\\' -> ('\\', i + 1) - | '0'..'9' as c -> backslash1 (valch c) s (i + 1) - | _ -> raise Not_found ] - and backslash1 cod s i = - if i = String.length s then (Char.chr cod, i) - else - match s.[i] with - [ '0'..'9' as c -> backslash2 (10 * cod + valch c) s (i + 1) - | _ -> (Char.chr cod, i) ] - and backslash2 cod s i = - if i = String.length s then (Char.chr cod, i) - else - match s.[i] with - [ '0'..'9' as c -> (Char.chr (10 * cod + valch c), i + 1) - | _ -> (Char.chr cod, i) ] - ; - value rec skip_indent s i = - if i = String.length s then i - else - match s.[i] with - [ ' ' | '\t' -> skip_indent s (i + 1) - | _ -> i ] - ; - value skip_opt_linefeed s i = - if i = String.length s then i else if s.[i] = '\010' then i + 1 else i - ; - value char_of_char_token s = - if String.length s = 1 then s.[0] - else if String.length s = 0 then failwith "invalid char token" - else if s.[0] = '\\' then - if String.length s = 2 && s.[1] = ''' then ''' - else - try - let (c, i) = backslash s 1 in - if i = String.length s then c else raise Not_found - with - [ Not_found -> failwith "invalid char token" ] - else failwith "invalid char token" - ; - value string_of_string_token s = - loop 0 0 where rec loop len i = - if i = String.length s then get_buff len - else - let (len, i) = - if s.[i] = '\\' then - let i = i + 1 in - if i = String.length s then failwith "invalid string token" - else if s.[i] = '"' then (store len '"', i + 1) - else - match s.[i] with - [ '\010' -> (len, skip_indent s (i + 1)) - | '\013' -> (len, skip_indent s (skip_opt_linefeed s (i + 1))) - | c -> - try - let (c, i) = backslash s i in - (store len c, i) - with - [ Not_found -> (store (store len '\\') c, i + 1) ] ] - else (store len s.[i], i + 1) - in - loop len i - ; - value rec skip_spaces = - parser - [ [: `' ' | '\n' | '\r' | '\t' | '\026' | '\012'; s :] -> skip_spaces s - | [: :] -> () ] - ; - value error_on_unknown_keywords = ref False; - value next_token_fun find_id_kwd find_spe_kwd fname lnum bolpos = - let make_pos p = - {Lexing.pos_fname = fname.val; Lexing.pos_lnum = lnum.val; - Lexing.pos_bol = bolpos.val; Lexing.pos_cnum = p} in - let mkloc (bp, ep) = (make_pos bp, make_pos ep) in - - let err loc msg = raise_with_loc loc (Token.Error msg) in - let keyword_or_error (bp,ep) s = - try ("", find_spe_kwd s) with - [ Not_found -> - if error_on_unknown_keywords.val then - err (mkloc (bp, ep)) ("illegal token: " ^ s) - else ("", s) ] - in - let rec next_token = - parser bp - [ [: `('A'..'Z' | 'À'..'Ö' | 'Ø'..'Þ' as c); s :] -> - let id = get_buff (ident (store 0 c) s) in - try ("", find_id_kwd id) with [ Not_found -> ("UIDENT", id) ] - | [: `('a'..'z' | 'ß'..'ö' | 'ø'..'ÿ' | '_' as c); s :] -> - let id = get_buff (ident (store 0 c) s) in - let is_label = - match Stream.peek s with - [ Some ':' -> - match Stream.npeek 2 s with - [ [_; ':' | '=' | '>'] -> False - | _ -> True ] - | _ -> False ] - in - if is_label then do { Stream.junk s; ("LABEL", id) } - else try ("", find_id_kwd id) with [ Not_found -> ("LIDENT", id) ] - | [: `('1'..'9' as c); s :] -> number (store 0 c) s - | [: `'0'; s :] -> base_number (store 0 '0') s - | [: `'''; s :] ep -> - match Stream.npeek 2 s with - [ [_; '''] | ['\\'; _] -> ("CHAR", char bp 0 s) - | _ -> keyword_or_error (bp, ep) "'" ] - | [: `'"'; s :] -> ("STRING", string bp 0 s) - | [: `'$'; s :] -> locate_or_antiquot bp 0 s - | [: `('!' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | - '%' as - c) - ; - s :] -> - let id = get_buff (ident2 (store 0 c) s) in - keyword_or_error (bp, Stream.count s) id - | [: `('?' as c); s :] -> - let id = get_buff (ident4 (store 0 c) s) in - keyword_or_error (bp, Stream.count s) id - | [: `'<'; s :] -> less bp s - | [: `(':' as c1); - (is_label, len) = - parser - [ [: `(']' | ':' | '=' | '>' as c2) :] -> - (False, store (store 0 c1) c2) - | [: `('a'..'z' | 'ß'..'ö' | 'ø'..'ÿ' | '_' as c); s :] -> - (True, ident (store 0 c) s) - | [: :] -> (False, store 0 c1) ] :] ep -> - let id = get_buff len in - if is_label then ("ELABEL", id) else keyword_or_error (bp, ep) id - | [: `('>' | '|' as c1); - len = - parser - [ [: `(']' | '}' as c2) :] -> store (store 0 c1) c2 - | [: a = ident2 (store 0 c1) :] -> a ] :] ep -> - let id = get_buff len in - keyword_or_error (bp, ep) id - | [: `('[' | '{' as c1); s :] -> - let len = - match Stream.npeek 2 s with - [ ['<'; '<' | ':'] -> store 0 c1 - | _ -> - match s with parser - [ [: `('|' | '<' | ':' as c2) :] -> store (store 0 c1) c2 - | [: :] -> store 0 c1 ] ] - in - let ep = Stream.count s in - let id = get_buff len in - keyword_or_error (bp, ep) id - | [: `'.'; id = parser [ [: `'.' :] -> ".." | [: :] -> "." ] :] ep -> - keyword_or_error (bp, ep) id - | [: `';'; id = parser [ [: `';' :] -> ";;" | [: :] -> ";" ] :] ep -> - keyword_or_error (bp, ep) id - | [: `'\\'; s :] -> ("LIDENT", get_buff (ident3 0 s)) - | [: `c :] ep -> keyword_or_error (bp, ep) (String.make 1 c) ] - and less bp = - parser - [ [: `'<'; s :] -> ("QUOTATION", ":" ^ get_buff (quotation bp 0 s)) - | [: `':'; i = parser [: len = ident 0 :] -> get_buff len; - `'<' ? "character '<' expected"; s :] -> - ("QUOTATION", i ^ ":" ^ get_buff (quotation bp 0 s)) - | [: s :] ep -> - let id = get_buff (ident2 (store 0 '<') s) in - keyword_or_error (bp, ep) id ] - and string bp len = - parser - [ [: `'"' :] -> get_buff len - | [: `'\\'; `c; s :] -> string bp (store (store len '\\') c) s - | [: `c; s :] -> string bp (store len c) s - | [: :] ep -> err (mkloc (bp, ep)) "string not terminated" ] - and char bp len = - parser - [ [: `'''; s :] -> - if len = 0 then char bp (store len ''') s else get_buff len - | [: `'\\'; `c; s :] -> char bp (store (store len '\\') c) s - | [: `c; s :] -> char bp (store len c) s - | [: :] ep -> err (mkloc(bp,ep)) "char not terminated" ] - and locate_or_antiquot bp len = - parser - [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) - | [: `('a'..'z' | 'A'..'Z' as c); s :] -> antiquot bp (store len c) s - | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s - | [: `':'; s :] -> - let k = get_buff len in - ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s) - | [: `'\\'; `c; s :] -> - ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) - | [: `c; s :] -> - ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) - | [: :] ep -> err (mkloc(bp,ep)) "antiquotation not terminated" ] - and maybe_locate bp len = - parser - [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) - | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s - | [: `':'; s :] -> - ("LOCATE", get_buff len ^ ":" ^ locate_or_antiquot_rest bp 0 s) - | [: `'\\'; `c; s :] -> - ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) - | [: `c; s :] -> - ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) - | [: :] ep -> err (mkloc(bp,ep)) "antiquotation not terminated" ] - and antiquot bp len = - parser - [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) - | [: `('a'..'z' | 'A'..'Z' | '0'..'9' as c); s :] -> - antiquot bp (store len c) s - | [: `':'; s :] -> - let k = get_buff len in - ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s) - | [: `'\\'; `c; s :] -> - ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) - | [: `c; s :] -> - ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) - | [: :] ep -> err (mkloc(bp,ep)) "antiquotation not terminated" ] - and locate_or_antiquot_rest bp len = - parser - [ [: `'$' :] -> get_buff len - | [: `'\\'; `c; s :] -> locate_or_antiquot_rest bp (store len c) s - | [: `c; s :] -> locate_or_antiquot_rest bp (store len c) s - | [: :] ep -> err (mkloc(bp,ep)) "antiquotation not terminated" ] - and quotation bp len = - parser - [ [: `'>'; s :] -> maybe_end_quotation bp len s - | [: `'<'; s :] -> - quotation bp (maybe_nested_quotation bp (store len '<') __strm) s - | [: `'\\'; - len = - parser - [ [: `('>' | '<' | '\\' as c) :] -> store len c - | [: :] -> store len '\\' ]; - s :] -> - quotation bp len s - | [: `c; s :] -> quotation bp (store len c) s - | [: :] ep -> err (mkloc(bp,ep)) "quotation not terminated" ] - and maybe_nested_quotation bp len = - parser - [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>" - | [: `':'; len = ident (store len ':'); - a = - parser - [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>" - | [: :] -> len ] :] -> - a - | [: :] -> len ] - and maybe_end_quotation bp len = - parser - [ [: `'>' :] -> len - | [: a = quotation bp (store len '>') :] -> a ] - in - let rec next_token_loc = - parser bp - [ [: `' ' | '\n' | '\r' | '\t' | '\026' | '\012'; s :] -> - next_token_loc s - | [: `'('; s :] -> maybe_comment bp s - | [: `'#'; _ = spaces_tabs; a = linenum bp :] -> a - | [: tok = next_token :] ep -> (tok, mkloc(bp, ep)) - | [: _ = Stream.empty :] -> (("EOI", ""), mkloc(bp, succ bp)) ] - and maybe_comment bp = - parser - [ [: `'*'; s :] -> do { comment bp s; next_token_loc s } - | [: :] ep -> - let tok = keyword_or_error (bp, ep) "(" in - (tok, mkloc(bp, ep)) ] - and comment bp = - parser - [ [: `'('; s :] -> maybe_nested_comment bp s - | [: `'*'; s :] -> maybe_end_comment bp s - | [: `c; s :] -> comment bp s - | [: :] ep -> err (mkloc(bp,ep)) "comment not terminated" ] - and maybe_nested_comment bp = - parser - [ [: `'*'; s :] -> do { comment bp s; comment bp s } - | [: a = comment bp :] -> a ] - and maybe_end_comment bp = - parser [ [: `')' :] -> () | [: a = comment bp :] -> a ] - and linenum bp = - parser - [ [: `'0'..'9'; _ = digits; _ = spaces_tabs; `'"'; _ = any_to_nl; - s :] -> - next_token_loc s - | [: :] -> (keyword_or_error (bp, bp + 1) "#", mkloc(bp, bp + 1)) ] - and spaces_tabs = - parser [ [: `' ' | '\t'; s :] -> spaces_tabs s | [: :] -> () ] - and digits = parser [ [: `'0'..'9'; s :] -> digits s | [: :] -> () ] - and any_to_nl = - parser - [ [: `'\r' | '\n' :] -> () - | [: `_; s :] -> any_to_nl s - | [: :] -> () ] - in - fun cstrm -> - try next_token_loc cstrm with - [ Stream.Error str -> - err (mkloc(Stream.count cstrm, Stream.count cstrm + 1)) str ] - ; - value locerr () = invalid_arg "Lexer: location function"; - value loct_create () = ref (Array.create 1024 None); - value loct_func loct i = - match - if i < 0 || i >= Array.length loct.val then None - else Array.unsafe_get loct.val i - with - [ Some loc -> loc - | _ -> locerr () ] - ; - value loct_add loct i loc = - do { - if i >= Array.length loct.val then do { - let new_tmax = Array.length loct.val * 2 in - let new_loct = Array.create new_tmax None in - Array.blit loct.val 0 new_loct 0 (Array.length loct.val); - loct.val := new_loct - } - else (); - loct.val.(i) := Some loc - } - ; - value func kwd_table = - let bolpos = ref 0 in - let lnum = ref 0 in - let fname = ref "" in - let find = Hashtbl.find kwd_table in - let lex cstrm = - let next_token_loc = next_token_fun find find fname lnum bolpos in - let loct = loct_create () in - let ts = - Stream.from - (fun i -> - let (tok, loc) = next_token_loc cstrm in - do { loct_add loct i loc; Some tok }) - in - let locf = loct_func loct in - (ts, locf) - in - lex - ; - value rec check_keyword_stream = - parser [: _ = check; _ = Stream.empty :] -> True - and check = - parser - [ [: `'A'..'Z' | 'a'..'z' | 'À'..'Ö' | 'Ø'..'ö' | 'ø'..'ÿ'; s :] -> - check_ident s - | [: `'!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | - '%' | '.' - ; - s :] -> - check_ident2 s - | [: `'<'; s :] -> - match Stream.npeek 1 s with - [ [':' | '<'] -> () - | _ -> check_ident2 s ] - | [: `':'; - _ = - parser - [ [: `']' | ':' | '=' | '>' :] -> () - | [: :] -> () ] :] ep -> - () - | [: `'>' | '|'; - _ = - parser - [ [: `']' | '}' :] -> () - | [: a = check_ident2 :] -> a ] :] -> - () - | [: `'[' | '{'; s :] -> - match Stream.npeek 2 s with - [ ['<'; '<' | ':'] -> () - | _ -> - match s with parser - [ [: :] -> - match Stream.peek __strm with - [ Some ('|' | '<' | ':') -> Stream.junk __strm - | _ -> () ] ] ] - | [: `';'; _ = parser [ [: `';' :] -> () | [: :] -> () ] :] -> () - | [: `_ :] -> () ] - and check_ident = - parser - [ [: `'A'..'Z' | 'a'..'z' | 'À'..'Ö' | 'Ø'..'ö' | 'ø'..'ÿ' | '0'..'9' | - '_' | ''' - ; - s :] -> - check_ident s - | [: :] -> () ] - and check_ident2 = - parser - [ [: `'!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | - '%' | '.' | ':' | '<' | '>' | '|' - ; - s :] -> - check_ident2 s - | [: :] -> () ] - ; - value check_keyword s = - try check_keyword_stream (Stream.of_string s) with _ -> False - ; - value using_token kwd_table (p_con, p_prm) = - match p_con with - [ "" -> - try - let _ = Hashtbl.find kwd_table p_prm in - () - with - [ Not_found -> - if check_keyword p_prm then Hashtbl.add kwd_table p_prm p_prm - else - raise - (Token.Error - ("the token \"" ^ p_prm ^ - "\" does not respect Plexer rules")) ] - | "LIDENT" | "UIDENT" | "INT" | "FLOAT" | "CHAR" | "STRING" | - "QUOTATION" | "ANTIQUOT" | "LOCATE" | "LABEL" | "ELABEL" | "EOI" -> - () - | _ -> - raise - (Token.Error - ("the constructor \"" ^ p_con ^ - "\" is not recognized by Llexer")) ] - ; - value removing_token kwd_table (p_con, p_prm) = - if p_con = "" then Hashtbl.remove kwd_table p_prm else () - ; - value text = - fun - [ ("", t) -> "'" ^ t ^ "'" - | ("LIDENT", "") -> "lowercase identifier" - | ("LIDENT", t) -> "'" ^ t ^ "'" - | ("UIDENT", "") -> "uppercase identifier" - | ("UIDENT", t) -> "'" ^ t ^ "'" - | ("INT", "") -> "integer" - | ("INT", s) -> "'" ^ s ^ "'" - | ("FLOAT", "") -> "float" - | ("STRING", "") -> "string" - | ("CHAR", "") -> "char" - | ("QUOTATION", "") -> "quotation" - | ("ANTIQUOT", k) -> "antiquot \"" ^ k ^ "\"" - | ("LOCATE", "") -> "locate" - | ("LABEL", "") -> "label" - | ("ELABEL", "") -> "elabel" - | ("EOI", "") -> "end of input" - | (con, "") -> con - | (con, prm) -> con ^ " \"" ^ prm ^ "\"" ] - ; - value eq_before_colon p e = - loop 0 where rec loop i = - if i == String.length e then - failwith "Internal error in Plexer: incorrect ANTIQUOT" - else if i == String.length p then e.[i] == ':' - else if p.[i] == e.[i] then loop (i + 1) - else False - ; - value after_colon e = - try - let i = String.index e ':' in - String.sub e (i + 1) (String.length e - i - 1) - with - [ Not_found -> "" ] - ; - value gmake () = - let kwd_table = Hashtbl.create 301 in - {tok_func = func kwd_table; tok_using = using_token kwd_table; - tok_removing = removing_token kwd_table; - tok_match = Token.default_match; tok_text = text; tok_comm = None} - ; - end -; - -open Stdpp; -open Pcaml; - -Pcaml.no_constructors_arity.val := True; - -do { - Grammar.Unsafe.gram_reinit gram (Plexer.gmake ()); - Grammar.Unsafe.clear_entry interf; - Grammar.Unsafe.clear_entry implem; - Grammar.Unsafe.clear_entry top_phrase; - Grammar.Unsafe.clear_entry use_file; - Grammar.Unsafe.clear_entry module_type; - Grammar.Unsafe.clear_entry module_expr; - Grammar.Unsafe.clear_entry sig_item; - Grammar.Unsafe.clear_entry str_item; - Grammar.Unsafe.clear_entry expr; - Grammar.Unsafe.clear_entry patt; - Grammar.Unsafe.clear_entry ctyp; - Grammar.Unsafe.clear_entry let_binding; - Grammar.Unsafe.clear_entry class_type; - Grammar.Unsafe.clear_entry class_expr; - Grammar.Unsafe.clear_entry class_sig_item; - Grammar.Unsafe.clear_entry class_str_item -}; - -Pcaml.parse_interf.val := Grammar.Entry.parse interf; -Pcaml.parse_implem.val := Grammar.Entry.parse implem; - -value o2b = - fun - [ Some _ -> True - | None -> False ] -; - -value mkumin loc f arg = - match arg with - [ <:expr< $int:n$ >> when int_of_string n > 0 -> - let n = "-" ^ n in - <:expr< $int:n$ >> - | <:expr< $flo:n$ >> when float_of_string n > 0.0 -> - let n = "-" ^ n in - <:expr< $flo:n$ >> - | _ -> - let f = "~" ^ f in - <:expr< $lid:f$ $arg$ >> ] -; - -external loc_of_node : 'a -> Loc.t = "%field0"; - -value mklistexp loc last = - loop True where rec loop top = - fun - [ [] -> - match last with - [ Some e -> e - | None -> <:expr< [] >> ] - | [e1 :: el] -> - let loc = if top then loc else (fst (loc_of_node e1), snd loc) in - <:expr< [$e1$ :: $loop False el$] >> ] -; - -value mklistpat loc last = - loop True where rec loop top = - fun - [ [] -> - match last with - [ Some p -> p - | None -> <:patt< [] >> ] - | [p1 :: pl] -> - let loc = if top then loc else (fst (loc_of_node p1), snd loc) in - <:patt< [$p1$ :: $loop False pl$] >> ] -; - -value neg s = string_of_int (- int_of_string s); - -value is_operator = - let ht = Hashtbl.create 73 in - let ct = Hashtbl.create 73 in - do { - List.iter (fun x -> Hashtbl.add ht x True) - ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"]; - List.iter (fun x -> Hashtbl.add ct x True) - ['!'; '&'; '*'; '+'; '-'; '/'; ':'; '<'; '='; '>'; '@'; '^'; '|'; '~'; - '?'; '%'; '.']; - fun x -> - try Hashtbl.find ht x with - [ Not_found -> try Hashtbl.find ct x.[0] with _ -> False ] - } -; - -(* -value p_operator strm = - match Stream.peek strm with - [ Some (Token.Tterm "(") -> - match Stream.npeek 3 strm with - [ [_; Token.Tterm x; Token.Tterm ")"] when is_operator x -> - do { Stream.junk strm; Stream.junk strm; Stream.junk strm; x } - | _ -> raise Stream.Failure ] - | _ -> raise Stream.Failure ] -; - -value operator = Grammar.Entry.of_parser gram "operator" p_operator; -*) - -value operator = - Grammar.Entry.of_parser gram "operator" - (parser [: `("", x) when is_operator x :] -> x) -; - -value symbolchar = - let list = - ['!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; - '@'; '^'; '|'; '~'] - in - let rec loop s i = - if i == String.length s then True - else if List.mem s.[i] list then loop s (i + 1) - else False - in - loop -; - -value prefixop = - let list = ['!'; '?'; '~'] in - let excl = ["!="] in - Grammar.Entry.of_parser gram "prefixop" - (parser - [: `("", x) - when - not (List.mem x excl) && String.length x >= 2 && - List.mem x.[0] list && symbolchar x 1 :] -> - x) -; - -value infixop0 = - let list = ['='; '<'; '>'; '|'; '&'; '$'] in - let excl = ["<-"; "||"; "&&"] in - Grammar.Entry.of_parser gram "infixop0" - (parser - [: `("", x) - when - not (List.mem x excl) && String.length x >= 2 && - List.mem x.[0] list && symbolchar x 1 :] -> - x) -; - -value infixop1 = - let list = ['@'; '^'] in - Grammar.Entry.of_parser gram "infixop1" - (parser - [: `("", x) - when - String.length x >= 2 && List.mem x.[0] list && - symbolchar x 1 :] -> - x) -; - -value infixop2 = - let list = ['+'; '-'] in - Grammar.Entry.of_parser gram "infixop2" - (parser - [: `("", x) - when - x <> "->" && String.length x >= 2 && List.mem x.[0] list && - symbolchar x 1 :] -> - x) -; - -value infixop3 = - let list = ['*'; '/'; '%'] in - Grammar.Entry.of_parser gram "infixop3" - (parser - [: `("", x) - when - String.length x >= 2 && List.mem x.[0] list && - symbolchar x 1 :] -> - x) -; - -value infixop4 = - Grammar.Entry.of_parser gram "infixop4" - (parser - [: `("", x) - when - String.length x >= 3 && x.[0] == '*' && x.[1] == '*' && - symbolchar x 2 :] -> - x) -; - -value test_constr_decl = - Grammar.Entry.of_parser gram "test_constr_decl" - (fun strm -> - match Stream.npeek 1 strm with - [ [("UIDENT", _)] -> - match Stream.npeek 2 strm with - [ [_; ("", ".")] -> raise Stream.Failure - | [_; ("", "(")] -> raise Stream.Failure - | [_ :: _] -> () - | _ -> raise Stream.Failure ] - | [("", "|")] -> () - | _ -> raise Stream.Failure ]) -; - -value stream_peek_nth n strm = - loop n (Stream.npeek n strm) where rec loop n = - fun - [ [] -> None - | [x] -> if n == 1 then Some x else None - | [_ :: l] -> loop (n - 1) l ] -; - -value test_label_eq = - let rec test lev strm = - match stream_peek_nth lev strm with - [ Some (("UIDENT", _) | ("LIDENT", _) | ("", ".")) -> test (lev + 1) strm - | Some ("", "=") -> () - | _ -> raise Stream.Failure ] - in - Grammar.Entry.of_parser gram "test_label_eq" (test 1) -; - -value constr_arity = ref [("Some", 1); ("Match_Failure", 1)]; - -value rec constr_expr_arity = - fun - [ <:expr< $uid:c$ >> -> - try List.assoc c constr_arity.val with [ Not_found -> 0 ] - | <:expr< $uid:_$.$e$ >> -> constr_expr_arity e - | _ -> 1 ] -; - -value rec constr_patt_arity = - fun - [ <:patt< $uid:c$ >> -> - try List.assoc c constr_arity.val with [ Not_found -> 0 ] - | <:patt< $uid:_$.$p$ >> -> constr_patt_arity p - | _ -> 1 ] -; - -value rec get_seq = - fun - [ <:expr< do { $list:el$ } >> -> el - | e -> [e] ] -; - -value choose_tvar tpl = - let rec find_alpha v = - let s = String.make 1 v in - if List.mem_assoc s tpl then - if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) - else Some (String.make 1 v) - in - let rec make_n n = - let v = "a" ^ string_of_int n in - if List.mem_assoc v tpl then make_n (succ n) else v - in - match find_alpha 'a' with - [ Some x -> x - | None -> make_n 1 ] -; - -value rec patt_lid = - fun - [ <:patt< $lid:i$ $p$ >> -> Some (i, [p]) - | <:patt< $p1$ $p2$ >> -> - match patt_lid p1 with - [ Some (i, pl) -> Some (i, [p2 :: pl]) - | None -> None ] - | _ -> None ] -; - -value type_parameter = Grammar.Entry.create gram "type_parameter"; -value fun_def = Grammar.Entry.create gram "fun_def"; -value fun_binding = Grammar.Entry.create gram "fun_binding"; - -EXTEND - GLOBAL: interf implem top_phrase use_file sig_item str_item ctyp patt expr - module_type module_expr let_binding type_parameter fun_def fun_binding; - (* Main entry points *) - interf: - [ [ st = LIST0 [ s = sig_item; OPT ";;" -> (s, loc) ]; EOI -> - (st, False) ] ] - ; - implem: - [ [ st = LIST0 [ s = str_item; OPT ";;" -> (s, loc) ]; EOI -> - (st, False) ] ] - ; - top_phrase: - [ [ ph = phrase; ";;" -> Some ph - | EOI -> None ] ] - ; - use_file: - [ [ l = LIST0 [ ph = phrase; OPT ";;" -> ph ]; EOI -> (l, False) ] ] - ; - phrase: - [ [ sti = str_item -> sti - | "#"; n = LIDENT; dp = dir_param -> MLast.StDir loc n dp ] ] - ; - dir_param: - [ [ -> None - | e = expr -> Some e ] ] - ; - (* Module expressions *) - module_expr: - [ [ "functor"; "("; i = UIDENT; ":"; t = module_type; ")"; "->"; - me = SELF -> - <:module_expr< functor ( $i$ : $t$ ) -> $me$ >> - | "struct"; st = LIST0 [ s = str_item; OPT ";;" -> s ]; "end" -> - <:module_expr< struct $list:st$ end >> ] - | [ me1 = SELF; me2 = SELF -> <:module_expr< $me1$ $me2$ >> ] - | [ i = mod_expr_ident -> i - | "("; me = SELF; ":"; mt = module_type; ")" -> - <:module_expr< ( $me$ : $mt$ ) >> - | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ] - ; - mod_expr_ident: - [ LEFTA - [ m1 = SELF; "."; m2 = SELF -> <:module_expr< $m1$ . $m2$ >> ] - | [ m = UIDENT -> <:module_expr< $uid:m$ >> ] ] - ; - str_item: - [ "top" - [ "exception"; (_, c, tl) = constructor_declaration -> - <:str_item< exception $c$ of $list:tl$ >> - | "external"; i = LIDENT; ":"; t = ctyp; "="; pd = LIST1 STRING -> - <:str_item< external $i$ : $t$ = $list:pd$ >> - | "external"; i = LABEL; t = ctyp; "="; pd = LIST1 STRING -> - <:str_item< external $i$ : $t$ = $list:pd$ >> - | "external"; "("; i = operator; ")"; ":"; t = ctyp; "="; - pd = LIST1 STRING -> - <:str_item< external $i$ : $t$ = $list:pd$ >> - | "module"; i = UIDENT; mb = module_binding -> - <:str_item< module $i$ = $mb$ >> - | "module"; "type"; i = UIDENT; "="; mt = module_type -> - <:str_item< module type $i$ = $mt$ >> - | "open"; i = mod_ident -> <:str_item< open $i$ >> - | "type"; tdl = LIST1 type_declaration SEP "and" -> - <:str_item< type $list:tdl$ >> - | "let"; r = OPT "rec"; l = LIST1 let_binding SEP "and"; "in"; - x = expr -> - let e = <:expr< let $opt:o2b r$ $list:l$ in $x$ >> in - <:str_item< $exp:e$ >> - | "let"; r = OPT "rec"; l = LIST1 let_binding SEP "and" -> - match l with - [ [(<:patt< _ >>, e)] -> <:str_item< $exp:e$ >> - | _ -> <:str_item< value $opt:o2b r$ $list:l$ >> ] - | "let"; "module"; m = UIDENT; mb = module_binding; "in"; e = expr -> - <:str_item< let module $m$ = $mb$ in $e$ >> - | e = expr -> <:str_item< $exp:e$ >> ] ] - ; - module_binding: - [ RIGHTA - [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF -> - <:module_expr< functor ( $m$ : $mt$ ) -> $mb$ >> - | ":"; mt = module_type; "="; me = module_expr -> - <:module_expr< ( $me$ : $mt$ ) >> - | "="; me = module_expr -> <:module_expr< $me$ >> ] ] - ; - (* Module types *) - module_type: - [ [ "functor"; "("; i = UIDENT; ":"; t = SELF; ")"; "->"; mt = SELF -> - <:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ] - | [ mt = SELF; "with"; wcl = LIST1 with_constr SEP "and" -> - <:module_type< $mt$ with $list:wcl$ >> ] - | [ "sig"; sg = LIST0 [ s = sig_item; OPT ";;" -> s ]; "end" -> - <:module_type< sig $list:sg$ end >> - | i = mod_type_ident -> i - | "("; mt = SELF; ")" -> <:module_type< $mt$ >> ] ] - ; - mod_type_ident: - [ LEFTA - [ m1 = SELF; "."; m2 = SELF -> <:module_type< $m1$ . $m2$ >> - | m1 = SELF; "("; m2 = SELF; ")" -> <:module_type< $m1$ $m2$ >> ] - | [ m = UIDENT -> <:module_type< $uid:m$ >> - | m = LIDENT -> <:module_type< $lid:m$ >> ] ] - ; - sig_item: - [ "top" - [ "exception"; (_, c, tl) = constructor_declaration -> - <:sig_item< exception $c$ of $list:tl$ >> - | "external"; i = LIDENT; ":"; t = ctyp; "="; pd = LIST1 STRING -> - <:sig_item< external $i$ : $t$ = $list:pd$ >> - | "external"; i = LABEL; t = ctyp; "="; pd = LIST1 STRING -> - <:sig_item< external $i$ : $t$ = $list:pd$ >> - | "external"; "("; i = operator; ")"; ":"; t = ctyp; "="; - pd = LIST1 STRING -> - <:sig_item< external $i$ : $t$ = $list:pd$ >> - | "include"; mt = module_type -> <:sig_item< include $mt$ >> - | "module"; i = UIDENT; mt = module_declaration -> - <:sig_item< module $i$ : $mt$ >> - | "module"; "type"; i = UIDENT; "="; mt = module_type -> - <:sig_item< module type $i$ = $mt$ >> - | "open"; i = mod_ident -> <:sig_item< open $i$ >> - | "type"; tdl = LIST1 type_declaration SEP "and" -> - <:sig_item< type $list:tdl$ >> - | "val"; i = LIDENT; ":"; t = ctyp -> <:sig_item< value $i$ : $t$ >> - | "val"; i = LABEL; t = ctyp -> <:sig_item< value $i$ : $t$ >> - | "val"; "("; i = operator; ")"; ":"; t = ctyp -> - <:sig_item< value $i$ : $t$ >> ] ] - ; - module_declaration: - [ RIGHTA - [ ":"; mt = module_type -> <:module_type< $mt$ >> - | "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF -> - <:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ] ] - ; - (* "with" constraints (additional type equations over signature - components) *) - with_constr: - [ [ "type"; tp = type_parameters; i = mod_ident; "="; t = ctyp -> - MLast.WcTyp loc i tp t - | "module"; i = mod_ident; "="; me = module_expr -> - MLast.WcMod loc i me ] ] - ; - (* Core expressions *) - expr: - [ "top" LEFTA - [ e1 = SELF; ";"; e2 = SELF -> - <:expr< do { $list:[e1 :: get_seq e2]$ } >> - | e1 = SELF; ";" -> e1 ] - | "expr1" - [ "let"; o = OPT "rec"; l = LIST1 let_binding SEP "and"; "in"; - x = expr LEVEL "top" -> - <:expr< let $opt:o2b o$ $list:l$ in $x$ >> - | "let"; "module"; m = UIDENT; mb = module_binding; "in"; - e = expr LEVEL "top" -> - <:expr< let module $m$ = $mb$ in $e$ >> - | "function"; OPT "|"; l = LIST1 match_case SEP "|" -> - <:expr< fun [ $list:l$ ] >> - | "fun"; p = patt LEVEL "simple"; e = fun_def -> - <:expr< fun [$p$ -> $e$] >> - | "match"; x = SELF; "with"; OPT "|"; l = LIST1 match_case SEP "|" -> - <:expr< match $x$ with [ $list:l$ ] >> - | "try"; x = SELF; "with"; OPT "|"; l = LIST1 match_case SEP "|" -> - <:expr< try $x$ with [ $list:l$ ] >> - | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1"; - e3 = [ "else"; e = expr LEVEL "expr1" -> e | -> <:expr< () >> ] -> - <:expr< if $e1$ then $e2$ else $e3$ >> - | "for"; i = LIDENT; "="; e1 = SELF; df = direction_flag; e2 = SELF; - "do"; e = SELF; "done" -> - <:expr< for $i$ = $e1$ $to:df$ $e2$ do { $list:get_seq e$ } >> - | "while"; e1 = SELF; "do"; e2 = SELF; "done" -> - <:expr< while $e1$ do { $list:get_seq e2$ } >> ] - | [ e = SELF; ","; el = LIST1 NEXT SEP "," -> - <:expr< ( $list:[e :: el]$ ) >> ] - | ":=" NONA - [ e1 = SELF; ":="; e2 = expr LEVEL "expr1" -> - <:expr< $e1$.val := $e2$ >> - | e1 = SELF; "<-"; e2 = expr LEVEL "expr1" -> <:expr< $e1$ := $e2$ >> ] - | "||" RIGHTA - [ e1 = SELF; f = [ op = "or" -> op | op = "||" -> op ]; e2 = SELF -> - <:expr< $lid:f$ $e1$ $e2$ >> ] - | "&&" RIGHTA - [ e1 = SELF; f = [ op = "&" -> op | op = "&&" -> op ]; e2 = SELF -> - <:expr< $lid:f$ $e1$ $e2$ >> ] - | "<" LEFTA - [ e1 = SELF; - f = - [ op = "<" -> op - | op = ">" -> op - | op = "<=" -> op - | op = ">=" -> op - | op = "=" -> op - | op = "<>" -> op - | op = "==" -> op - | op = "!=" -> op - | op = infixop0 -> op ]; - e2 = SELF -> - <:expr< $lid:f$ $e1$ $e2$ >> ] - | "^" RIGHTA - [ e1 = SELF; - f = [ op = "^" -> op | op = "@" -> op | op = infixop1 -> op ]; - e2 = SELF -> - <:expr< $lid:f$ $e1$ $e2$ >> ] - | RIGHTA - [ e1 = SELF; "::"; e2 = SELF -> <:expr< [$e1$ :: $e2$] >> ] - | "+" LEFTA - [ e1 = SELF; - f = - [ op = "+" -> op - | op = "-" -> op - | op = "+." -> op - | op = "-." -> op - | op = infixop2 -> op ]; - e2 = SELF -> - <:expr< $lid:f$ $e1$ $e2$ >> ] - | "*" LEFTA - [ e1 = SELF; - f = - [ op = "*" -> op - | op = "/" -> op - | op = "*." -> op - | op = "/." -> op - | op = "land" -> op - | op = "lor" -> op - | op = "lxor" -> op - | op = "mod" -> op - | op = infixop3 -> op ]; - e2 = SELF -> - <:expr< $lid:f$ $e1$ $e2$ >> ] - | "**" RIGHTA - [ e1 = SELF; - f = - [ op = "**" -> op - | op = "asr" -> op - | op = "lsl" -> op - | op = "lsr" -> op - | op = infixop4 -> op ]; - e2 = SELF -> - <:expr< $lid:f$ $e1$ $e2$ >> ] - | "unary minus" NONA - [ f = [ op = "-" -> op | op = "-." -> op ]; e = SELF -> - <:expr< $mkumin loc f e$ >> ] - | "apply" LEFTA - [ e1 = SELF; e2 = SELF -> - match constr_expr_arity e1 with - [ 1 -> <:expr< $e1$ $e2$ >> - | _ -> - match e2 with - [ <:expr< ( $list:el$ ) >> -> - List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) e1 el - | _ -> <:expr< $e1$ $e2$ >> ] ] - | "assert"; e = expr LEVEL "simple" -> - match e with - [ <:expr< False >> -> MLast.ExAsf loc - | _ -> MLast.ExAsr loc e ] - | "lazy"; e = SELF -> - <:expr< lazy ($e$) >> ] - | "simple" LEFTA - [ e1 = SELF; "."; "("; e2 = SELF; ")" -> <:expr< $e1$ .( $e2$ ) >> - | e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >> - | e1 = SELF; "."; e2 = SELF -> <:expr< $e1$ . $e2$ >> - | "!"; e = SELF -> <:expr< $e$ . val>> - | f = - [ op = "~-" -> op - | op = "~-." -> op - | op = "~" -> op - | op = prefixop -> op ]; - e = SELF -> - <:expr< $lid:f$ $e$ >> - | s = INT -> <:expr< $int:s$ >> - | s = FLOAT -> <:expr< $flo:s$ >> - | s = STRING -> <:expr< $str:s$ >> - | c = CHAR -> <:expr< $chr:c$ >> - | i = expr_ident -> i - | s = "false" -> <:expr< False >> - | s = "true" -> <:expr< True >> - | "["; "]" -> <:expr< [] >> - | "["; el = expr1_semi_list; "]" -> <:expr< $mklistexp loc None el$ >> - | "[|"; "|]" -> <:expr< [| |] >> - | "[|"; el = expr1_semi_list; "|]" -> <:expr< [| $list:el$ |] >> - | "{"; test_label_eq; lel = lbl_expr_list; "}" -> - <:expr< { $list:lel$ } >> - | "{"; e = expr LEVEL "simple"; "with"; lel = lbl_expr_list; "}" -> - <:expr< { ($e$) with $list:lel$ } >> - | "("; ")" -> <:expr< () >> - | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >> - | "("; e = SELF; ")" -> <:expr< $e$ >> - | "("; "-"; ")" -> <:expr< $lid:"-"$ >> - | "("; "-."; ")" -> <:expr< $lid:"-."$ >> - | "("; op = operator; ")" -> <:expr< $lid:op$ >> - | "begin"; e = SELF; "end" -> <:expr< $e$ >> - | x = LOCATE -> - let x = - try - let i = String.index x ':' in - ({Lexing.pos_fname = ""; - Lexing.pos_lnum = 0; - Lexing.pos_bol = 0; - Lexing.pos_cnum = int_of_string (String.sub x 0 i)}, - String.sub x (i + 1) (String.length x - i - 1)) - with - [ Not_found | Failure _ -> (Token.nowhere, x) ] - in - Pcaml.handle_expr_locate loc x - | x = QUOTATION -> - let x = - try - let i = String.index x ':' in - (String.sub x 0 i, - String.sub x (i + 1) (String.length x - i - 1)) - with - [ Not_found -> ("", x) ] - in - Pcaml.handle_expr_quotation loc x ] ] - ; - let_binding: - [ [ p = patt; e = fun_binding -> - match patt_lid p with - [ Some (i, pl) -> - let e = - List.fold_left (fun e p -> <:expr< fun $p$ -> $e$ >>) e pl - in - (<:patt< $lid:i$ >>, e) - | None -> (p, e) ] ] ] - ; - fun_binding: - [ RIGHTA - [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> - | "="; e = expr -> <:expr< $e$ >> - | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> ] ] - ; - match_case: - [ [ x1 = patt; w = OPT [ "when"; e = expr -> e ]; "->"; x2 = expr -> - (x1, w, x2) ] ] - ; - lbl_expr_list: - [ [ le = lbl_expr; ";"; lel = SELF -> [le :: lel] - | le = lbl_expr; ";" -> [le] - | le = lbl_expr -> [le] ] ] - ; - lbl_expr: - [ [ i = patt_label_ident; "="; e = expr LEVEL "expr1" -> (i, e) ] ] - ; - expr1_semi_list: - [ [ e = expr LEVEL "expr1"; ";"; el = SELF -> [e :: el] - | e = expr LEVEL "expr1"; ";" -> [e] - | e = expr LEVEL "expr1" -> [e] ] ] - ; - fun_def: - [ RIGHTA - [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> - | "->"; e = expr -> <:expr< $e$ >> ] ] - ; - expr_ident: - [ RIGHTA - [ i = LIDENT -> <:expr< $lid:i$ >> - | i = UIDENT -> <:expr< $uid:i$ >> - | m = UIDENT; "."; i = SELF -> - let rec loop m = - fun - [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y - | e -> <:expr< $m$ . $e$ >> ] - in - loop <:expr< $uid:m$ >> i - | m = UIDENT; "."; "("; i = operator; ")" -> - <:expr< $uid:m$ . $lid:i$ >> ] ] - ; - (* Patterns *) - patt: - [ LEFTA - [ p1 = SELF; "as"; i = LIDENT -> <:patt< ($p1$ as $lid:i$) >> ] - | LEFTA - [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ] - | [ p = SELF; ","; pl = LIST1 NEXT SEP "," -> - <:patt< ( $list:[p :: pl]$) >> ] - | NONA - [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ] - | RIGHTA - [ p1 = SELF; "::"; p2 = SELF -> <:patt< [$p1$ :: $p2$] >> ] - | LEFTA - [ p1 = SELF; p2 = SELF -> - match constr_patt_arity p1 with - [ 1 -> <:patt< $p1$ $p2$ >> - | n -> - let p2 = - match p2 with - [ <:patt< _ >> when n > 1 -> - let pl = - loop n where rec loop n = - if n = 0 then [] else [<:patt< _ >> :: loop (n - 1)] - in - <:patt< ( $list:pl$ ) >> - | _ -> p2 ] - in - match p2 with - [ <:patt< ( $list:pl$ ) >> -> - List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>) p1 pl - | _ -> <:patt< $p1$ $p2$ >> ] ] ] - | LEFTA - [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] - | "simple" - [ s = LIDENT -> <:patt< $lid:s$ >> - | s = UIDENT -> <:patt< $uid:s$ >> - | s = INT -> <:patt< $int:s$ >> - | "-"; s = INT -> <:patt< $int:neg s$ >> - | s = STRING -> <:patt< $str:s$ >> - | s = CHAR -> <:patt< $chr:s$ >> - | s = "false" -> <:patt< False >> - | s = "true" -> <:patt< True >> - | "["; "]" -> <:patt< [] >> - | "["; pl = patt_semi_list; "]" -> <:patt< $mklistpat loc None pl$ >> - | "[|"; "|]" -> <:patt< [| |] >> - | "[|"; pl = patt_semi_list; "|]" -> <:patt< [| $list:pl$ |] >> - | "{"; lpl = lbl_patt_list; "}" -> <:patt< { $list:lpl$ } >> - | "("; ")" -> <:patt< () >> - | "("; p = SELF; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> - | "("; p = SELF; ")" -> <:patt< $p$ >> - | "("; "-"; ")" -> <:patt< $lid:"-"$ >> - | "("; op = operator; ")" -> <:patt< $lid:op$ >> - | "_" -> <:patt< _ >> - | x = LOCATE -> - let x = - try - let i = String.index x ':' in - ({Lexing.pos_fname = ""; - Lexing.pos_lnum = 0; - Lexing.pos_bol = 0; - Lexing.pos_cnum = int_of_string (String.sub x 0 i)}, - String.sub x (i + 1) (String.length x - i - 1)) - with - [ Not_found | Failure _ -> (Token.nowhere, x) ] - in - Pcaml.handle_patt_locate loc x - | x = QUOTATION -> - let x = - try - let i = String.index x ':' in - (String.sub x 0 i, - String.sub x (i + 1) (String.length x - i - 1)) - with - [ Not_found -> ("", x) ] - in - Pcaml.handle_patt_quotation loc x ] ] - ; - patt_semi_list: - [ [ p = patt; ";"; pl = SELF -> [p :: pl] - | p = patt; ";" -> [p] - | p = patt -> [p] ] ] - ; - lbl_patt_list: - [ [ le = lbl_patt; ";"; lel = SELF -> [le :: lel] - | le = lbl_patt; ";" -> [le] - | le = lbl_patt -> [le] ] ] - ; - lbl_patt: - [ [ i = patt_label_ident; "="; p = patt -> (i, p) ] ] - ; - patt_label_ident: - [ RIGHTA - [ i = UIDENT -> <:patt< $uid:i$ >> - | i = LIDENT -> <:patt< $lid:i$ >> - | m = UIDENT; "."; i = SELF -> <:patt< $uid:m$ . $i$ >> ] ] - ; - (* Type declaration *) - type_declaration: - [ [ tpl = type_parameters; n = type_patt; "="; tk = type_kind; - cl = LIST0 constrain -> - (n, tpl, tk, cl) - | tpl = type_parameters; n = type_patt; cl = LIST0 constrain -> - (n, tpl, <:ctyp< '$choose_tvar tpl$ >>, cl) ] ] - ; - type_patt: - [ [ n = LIDENT -> (loc, n) ] ] - ; - constrain: - [ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ] - ; - type_kind: - [ [ test_constr_decl; OPT "|"; - cdl = LIST1 constructor_declaration SEP "|" -> - <:ctyp< [ $list:cdl$ ] >> - | t = ctyp -> <:ctyp< $t$ >> - | t = ctyp; "="; "{"; ldl = label_declarations; "}" -> - <:ctyp< $t$ == { $list:ldl$ } >> - | t = ctyp; "="; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> - <:ctyp< $t$ == [ $list:cdl$ ] >> - | "{"; ldl = label_declarations; "}" -> <:ctyp< { $list:ldl$ } >> ] ] - ; - type_parameters: - [ [ -> (* empty *) [] - | tp = type_parameter -> [tp] - | "("; tpl = LIST1 type_parameter SEP ","; ")" -> tpl ] ] - ; - type_parameter: - [ [ "'"; i = ident -> (i, (False, False)) ] ] - ; - constructor_declaration: - [ [ ci = UIDENT; "of"; cal = LIST1 ctyp LEVEL "ctyp1" SEP "*" -> - (loc, ci, cal) - | ci = UIDENT -> (loc, ci, []) ] ] - ; - label_declarations: - [ [ ld = label_declaration; ";"; ldl = SELF -> [ld :: ldl] - | ld = label_declaration; ";" -> [ld] - | ld = label_declaration -> [ld] ] ] - ; - label_declaration: - [ [ i = LIDENT; ":"; t = ctyp -> (loc, i, False, t) - | i = LABEL; t = ctyp -> (loc, i, False, t) - | "mutable"; i = LIDENT; ":"; t = ctyp -> (loc, i, True, t) - | "mutable"; i = LABEL; t = ctyp -> (loc, i, True, t) ] ] - ; - (* Core types *) - ctyp: - [ [ t1 = SELF; "as"; "'"; i = ident -> <:ctyp< $t1$ as '$i$ >> ] - | "arrow" RIGHTA - [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] - | [ t = SELF; "*"; tl = LIST1 ctyp LEVEL "ctyp1" SEP "*" -> - <:ctyp< ( $list:[t :: tl]$ ) >> ] - | "ctyp1" - [ t1 = SELF; t2 = SELF -> <:ctyp< $t2$ $t1$ >> ] - | "ctyp2" - [ t1 = SELF; "."; t2 = SELF -> <:ctyp< $t1$ . $t2$ >> - | t1 = SELF; "("; t2 = SELF; ")" -> <:ctyp< $t1$ $t2$ >> ] - | "simple" - [ "'"; i = ident -> <:ctyp< '$i$ >> - | "_" -> <:ctyp< _ >> - | i = LIDENT -> <:ctyp< $lid:i$ >> - | i = UIDENT -> <:ctyp< $uid:i$ >> - | "("; t = SELF; ","; tl = LIST1 ctyp SEP ","; ")"; - i = ctyp LEVEL "ctyp2" -> - List.fold_left (fun c a -> <:ctyp< $c$ $a$ >>) i [t :: tl] - | "("; t = SELF; ")" -> <:ctyp< $t$ >> ] ] - ; - (* Identifiers *) - ident: - [ [ i = LIDENT -> i - | i = UIDENT -> i ] ] - ; - mod_ident: - [ RIGHTA - [ i = UIDENT -> [i] - | i = LIDENT -> [i] - | m = UIDENT; "."; i = SELF -> [m :: i] ] ] - ; - (* Miscellaneous *) - direction_flag: - [ [ "to" -> True - | "downto" -> False ] ] - ; -END; - -(* Objects and Classes *) - -value rec class_type_of_ctyp loc t = - match t with - [ <:ctyp< $lid:i$ >> -> <:class_type< $list:[i]$ >> - | <:ctyp< $uid:m$.$t$ >> -> <:class_type< $list:[m :: type_id_list t]$ >> - | _ -> raise_with_loc loc (Stream.Error "lowercase identifier expected") ] -and type_id_list = - fun - [ <:ctyp< $uid:m$.$t$ >> -> [m :: type_id_list t] - | <:ctyp< $lid:i$ >> -> [i] - | t -> - raise_with_loc (loc_of_node t) - (Stream.Error "lowercase identifier expected") ] -; - -value class_fun_binding = Grammar.Entry.create gram "class_fun_binding"; - -EXTEND - GLOBAL: str_item sig_item expr ctyp class_sig_item class_str_item class_type - class_expr class_fun_binding; - str_item: - [ [ "class"; cd = LIST1 class_declaration SEP "and" -> - <:str_item< class $list:cd$ >> - | "class"; "type"; ctd = LIST1 class_type_declaration SEP "and" -> - <:str_item< class type $list:ctd$ >> ] ] - ; - sig_item: - [ [ "class"; cd = LIST1 class_description SEP "and" -> - <:sig_item< class $list:cd$ >> - | "class"; "type"; ctd = LIST1 class_type_declaration SEP "and" -> - <:sig_item< class type $list:ctd$ >> ] ] - ; - (* Class expressions *) - class_declaration: - [ [ vf = OPT "virtual"; ctp = class_type_parameters; i = LIDENT; - cfb = class_fun_binding -> - {MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; - MLast.ciNam = i; MLast.ciExp = cfb} ] ] - ; - class_fun_binding: - [ [ "="; ce = class_expr -> ce - | ":"; ct = class_type; "="; ce = class_expr -> - <:class_expr< ($ce$ : $ct$) >> - | p = patt LEVEL "simple"; cfb = SELF -> - <:class_expr< fun $p$ -> $cfb$ >> ] ] - ; - class_type_parameters: - [ [ -> (loc, []) - | "["; tpl = LIST1 type_parameter SEP ","; "]" -> (loc, tpl) ] ] - ; - class_fun_def: - [ [ p = patt LEVEL "simple"; "->"; ce = class_expr -> - <:class_expr< fun $p$ -> $ce$ >> - | p = patt LEVEL "simple"; cfd = SELF -> - <:class_expr< fun $p$ -> $cfd$ >> ] ] - ; - class_expr: - [ "top" - [ "fun"; cfd = class_fun_def -> cfd - | "let"; rf = OPT "rec"; lb = LIST1 let_binding SEP "and"; "in"; - ce = SELF -> - <:class_expr< let $opt:o2b rf$ $list:lb$ in $ce$ >> ] - | "apply" NONA - [ ce = SELF; e = expr LEVEL "label" -> - <:class_expr< $ce$ $e$ >> ] - | "simple" - [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]"; - ci = class_longident -> - <:class_expr< $list:ci$ [ $list:[ct :: ctcl]$ ] >> - | "["; ct = ctyp; "]"; ci = class_longident -> - <:class_expr< $list:ci$ [ $ct$ ] >> - | ci = class_longident -> <:class_expr< $list:ci$ >> - | "object"; cspo = OPT class_self_patt; cf = class_structure; "end" -> - <:class_expr< object $opt:cspo$ $list:cf$ end >> - | "("; ce = SELF; ":"; ct = class_type; ")" -> - <:class_expr< ($ce$ : $ct$) >> - | "("; ce = SELF; ")" -> ce ] ] - ; - class_structure: - [ [ cf = LIST0 class_str_item -> cf ] ] - ; - class_self_patt: - [ [ "("; p = patt; ")" -> p - | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> ] ] - ; - class_str_item: - [ [ "inherit"; ce = class_expr; pb = OPT [ "as"; i = LIDENT -> i ] -> - <:class_str_item< inherit $ce$ $opt:pb$ >> - | "val"; (lab, mf, e) = cvalue -> - <:class_str_item< value $opt:mf$ $lab$ = $e$ >> - | "method"; "private"; "virtual"; l = label; ":"; t = ctyp -> - <:class_str_item< method virtual private $l$ : $t$ >> - | "method"; "virtual"; "private"; l = label; ":"; t = ctyp -> - <:class_str_item< method virtual private $l$ : $t$ >> - | "method"; "virtual"; l = label; ":"; t = ctyp -> - <:class_str_item< method virtual $l$ : $t$ >> - | "method"; "private"; l = label; fb = fun_binding -> - <:class_str_item< method private $l$ = $fb$ >> - | "method"; l = label; fb = fun_binding -> - <:class_str_item< method $l$ = $fb$ >> - | "constraint"; t1 = ctyp; "="; t2 = ctyp -> - <:class_str_item< type $t1$ = $t2$ >> - | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ] - ; - cvalue: - [ [ mf = OPT "mutable"; l = label; "="; e = expr -> (l, o2b mf, e) - | mf = OPT "mutable"; l = label; ":"; t = ctyp; "="; e = expr -> - (l, o2b mf, <:expr< ($e$ : $t$) >>) - | mf = OPT "mutable"; l = label; ":"; t1 = ctyp; ":>"; t2 = ctyp; "="; - e = expr -> - (l, o2b mf, <:expr< ($e$ : $t1$ :> $t2$) >>) - | mf = OPT "mutable"; l = label; ":>"; t = ctyp; "="; e = expr -> - (l, o2b mf, <:expr< ($e$ :> $t$) >>) ] ] - ; - label: - [ [ i = LIDENT -> i ] ] - ; - (* Class types *) - class_type: - [ [ t = ctyp LEVEL "ctyp1" -> class_type_of_ctyp loc t - | t = ctyp LEVEL "ctyp1"; "->"; ct = SELF -> - <:class_type< [ $t$ ] -> $ct$ >> - | t = ctyp LEVEL "ctyp1"; "*"; tl = LIST1 ctyp LEVEL "simple" SEP "*"; - "->"; ct = SELF -> - <:class_type< [ ($t$ * $list:tl$) ] -> $ct$ >> - | cs = class_signature -> cs ] ] - ; - class_signature: - [ [ "["; tl = LIST1 ctyp SEP ","; "]"; id = clty_longident -> - <:class_type< $list:id$ [ $list:tl$ ] >> - | id = clty_longident -> <:class_type< $list:id$ >> - | "object"; cst = OPT class_self_type; csf = LIST0 class_sig_item; - "end" -> - <:class_type< object $opt:cst$ $list:csf$ end >> ] ] - ; - class_self_type: - [ [ "("; t = ctyp; ")" -> t ] ] - ; - class_sig_item: - [ [ "inherit"; cs = class_signature -> <:class_sig_item< inherit $cs$ >> - | "val"; mf = OPT "mutable"; l = label; ":"; t = ctyp -> - <:class_sig_item< value $opt:o2b mf$ $l$ : $t$ >> - | "method"; "private"; "virtual"; l = label; ":"; t = ctyp -> - <:class_sig_item< method virtual private $l$ : $t$ >> - | "method"; "virtual"; "private"; l = label; ":"; t = ctyp -> - <:class_sig_item< method virtual private $l$ : $t$ >> - | "method"; "virtual"; l = label; ":"; t = ctyp -> - <:class_sig_item< method virtual $l$ : $t$ >> - | "method"; "private"; l = label; ":"; t = ctyp -> - <:class_sig_item< method private $l$ : $t$ >> - | "method"; l = label; ":"; t = ctyp -> - <:class_sig_item< method $l$ : $t$ >> - | "constraint"; t1 = ctyp; "="; t2 = ctyp -> - <:class_sig_item< type $t1$ = $t2$ >> ] ] - ; - class_description: - [ [ vf = OPT "virtual"; ctp = class_type_parameters; n = LIDENT; ":"; - ct = class_type -> - {MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; - MLast.ciNam = n; MLast.ciExp = ct} - | vf = OPT "virtual"; ctp = class_type_parameters; n = LABEL; - ct = class_type -> - {MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; - MLast.ciNam = n; MLast.ciExp = ct} ] ] - ; - class_type_declaration: - [ [ vf = OPT "virtual"; ctp = class_type_parameters; n = LIDENT; "="; - cs = class_signature -> - {MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; - MLast.ciNam = n; MLast.ciExp = cs} ] ] - ; - (* Expressions *) - expr: LEVEL "apply" - [ LEFTA - [ "new"; i = class_longident -> <:expr< new $list:i$ >> ] ] - ; - expr: LEVEL "simple" - [ [ e = SELF; "#"; lab = label -> <:expr< $e$ # $lab$ >> ] ] - ; - expr: LEVEL "simple" - [ [ "("; e = SELF; ":"; t1 = ctyp; ":>"; t2 = ctyp; ")" -> - <:expr< ($e$ : $t1$ :> $t2$) >> - | "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >> - | "{<"; ">}" -> <:expr< {< >} >> - | "{<"; fel = field_expr_list; ">}" -> <:expr< {< $list:fel$ >} >> ] ] - ; - field_expr_list: - [ [ l = label; "="; e = expr LEVEL "expr1"; ";"; fel = SELF -> - [(l, e) :: fel] - | l = label; "="; e = expr LEVEL "expr1"; ";" -> [(l, e)] - | l = label; "="; e = expr LEVEL "expr1" -> [(l, e)] ] ] - ; - (* Core types *) - ctyp: LEVEL "simple" - [ [ "#"; id = class_longident -> <:ctyp< # $list:id$ >> - | "<"; (ml, v) = meth_list; ">" -> <:ctyp< < $list:ml$ $opt:v$ > >> - | "<"; ">" -> <:ctyp< < > >> ] ] - ; - meth_list: - [ [ f = field; ";"; (ml, v) = SELF -> ([f :: ml], v) - | f = field; ";" -> ([f], False) - | f = field -> ([f], False) - | ".." -> ([], True) ] ] - ; - field: - [ [ lab = LIDENT; ":"; t = ctyp -> (lab, t) - | lab = LABEL; t = ctyp -> (lab, t) ] ] - ; - (* Identifiers *) - clty_longident: - [ [ m = UIDENT; "."; l = SELF -> [m :: l] - | i = LIDENT -> [i] ] ] - ; - class_longident: - [ [ m = UIDENT; "."; l = SELF -> [m :: l] - | i = LIDENT -> [i] ] ] - ; -END; - -(* Labels *) - -EXTEND - GLOBAL: ctyp expr patt fun_def fun_binding class_type class_fun_binding; - ctyp: AFTER "arrow" - [ NONA - [ i = LABEL; t = SELF -> <:ctyp< ~ $i$ : $t$ >> - | "?"; i = LABEL; t = SELF -> <:ctyp< ? $i$ : $t$ >> ] ] - ; - ctyp: LEVEL "simple" - [ [ "["; OPT "|"; rfl = LIST0 row_field SEP "|"; "]" -> - <:ctyp< [ = $list:rfl$ ] >> - | "["; ">"; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> - <:ctyp< [ > $list:rfl$ ] >> - | "[<"; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> - <:ctyp< [ < $list:rfl$ ] >> - | "[<"; OPT "|"; rfl = LIST1 row_field SEP "|"; ">"; - ntl = LIST1 name_tag; "]" -> - <:ctyp< [ < $list:rfl$ > $list:ntl$ ] >> ] ] - ; - row_field: - [ [ "`"; i = ident -> MLast.RfTag i False [] - | "`"; i = ident; "of"; ao = OPT "&"; l = LIST1 ctyp SEP "&" -> - MLast.RfTag i (o2b ao) l - | "`"; i = ident; "&"; l = LIST1 ctyp SEP "&" -> MLast.RfTag i True l - | "`"; i = ident; l = LIST1 ctyp SEP "&" -> MLast.RfTag i False l ] ] - ; - name_tag: - [ [ "`"; i = ident -> i ] ] - ; - expr: LEVEL "expr1" - [ [ "fun"; p = labeled_patt; e = fun_def -> <:expr< fun $p$ -> $e$ >> ] ] - ; - expr: AFTER "apply" - [ "label" - [ i = LABEL; e = SELF -> <:expr< ~ $i$ : $e$ >> - | i = ELABEL -> <:expr< ~ $i$ >> - | "?"; i = LABEL; e = SELF -> <:expr< ? $i$ : $e$ >> - | "?"; i = ELABEL -> <:expr< ? $i$ >> ] ] - ; - expr: LEVEL "simple" - [ [ "`"; s = ident -> <:expr< ` $s$ >> ] ] - ; - fun_def: - [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] - ; - fun_binding: - [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] - ; - patt: LEVEL "simple" - [ [ "`"; s = ident -> <:patt< ` $s$ >> ] ] - ; - labeled_patt: - [ [ i = LABEL; p = patt LEVEL "simple" -> <:patt< ~ $i$ : $p$ >> - | i = ELABEL -> <:patt< ~ $i$ >> - | "?"; i = LABEL; j = LIDENT -> <:patt< ? $i$ : ($lid:j$) >> - | "?"; "("; i = LABEL; j = LIDENT; ")" -> <:patt< ? $i$ : ($lid:j$) >> - | "?"; "("; i = LABEL; j = LIDENT; "="; e = expr; ")" -> - <:patt< ? $i$ : ( $lid:j$ = $e$ ) >> - | "?"; i = ELABEL -> <:patt< ? $i$ : ($lid:i$) >> - | "?"; "("; i = ELABEL; "="; e = expr; ")" -> - <:patt< ? $i$ : ( $lid:i$ = $e$ ) >> ] ] - ; - class_type: - [ [ i = LABEL; t = ctyp LEVEL "ctyp1"; "->"; ct = SELF -> - <:class_type< [ ~ $i$ : $t$ ] -> $ct$ >> - | "?"; i = LABEL; t = ctyp LEVEL "ctyp1"; "->"; ct = SELF -> - <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> ] ] - ; - class_fun_binding: - [ [ p = labeled_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] - ; - ident: - [ [ i = LIDENT -> i - | i = UIDENT -> i ] ] - ; -END; - -type spat_comp = - [ SpTrm of Loc.t and MLast.patt and option MLast.expr - | SpNtr of Loc.t and MLast.patt and MLast.expr - | SpStr of Loc.t and MLast.patt ] -; -type sexp_comp = - [ SeTrm of Loc.t and MLast.expr | SeNtr of Loc.t and MLast.expr ] -; - -value strm_n = "__strm"; -value peek_fun loc = <:expr< Stream.peek >>; -value junk_fun loc = <:expr< Stream.junk >>; - -(* Parsers. *) -(* In syntax generated, many cases are optimisations. *) - -value rec pattern_eq_expression p e = - match (p, e) with - [ (<:patt< $lid:a$ >>, <:expr< $lid:b$ >>) -> a = b - | (<:patt< $uid:a$ >>, <:expr< $uid:b$ >>) -> a = b - | (<:patt< $p1$ $p2$ >>, <:expr< $e1$ $e2$ >>) -> - pattern_eq_expression p1 e1 && pattern_eq_expression p2 e2 - | _ -> False ] -; - -value is_raise e = - match e with - [ <:expr< raise $_$ >> -> True - | _ -> False ] -; - -value is_raise_failure e = - match e with - [ <:expr< raise Stream.Failure >> -> True - | _ -> False ] -; - -value rec handle_failure e = - match e with - [ <:expr< try $te$ with [ Stream.Failure -> $e$] >> -> handle_failure e - | <:expr< match $me$ with [ $list:pel$ ] >> -> - handle_failure me && - List.for_all - (fun - [ (_, None, e) -> handle_failure e - | _ -> False ]) - pel - | <:expr< let $list:pel$ in $e$ >> -> - List.for_all (fun (p, e) -> handle_failure e) pel && handle_failure e - | <:expr< $lid:_$ >> | <:expr< $int:_$ >> | <:expr< $str:_$ >> | - <:expr< $chr:_$ >> | <:expr< fun [ $list:_$ ] >> | <:expr< $uid:_$ >> -> - True - | <:expr< raise $e$ >> -> - match e with - [ <:expr< Stream.Failure >> -> False - | _ -> True ] - | <:expr< $f$ $x$ >> -> - is_constr_apply f && handle_failure f && handle_failure x - | _ -> False ] -and is_constr_apply = - fun - [ <:expr< $uid:_$ >> -> True - | <:expr< $lid:_$ >> -> False - | <:expr< $x$ $_$ >> -> is_constr_apply x - | _ -> False ] -; - -value rec subst v e = - let loc = MLast.loc_of_expr e in - match e with - [ <:expr< $lid:x$ >> -> - let x = if x = v then strm_n else x in - <:expr< $lid:x$ >> - | <:expr< $uid:_$ >> -> e - | <:expr< $int:_$ >> -> e - | <:expr< $chr:_$ >> -> e - | <:expr< $str:_$ >> -> e - | <:expr< $_$ . $_$ >> -> e - | <:expr< let $opt:rf$ $list:pel$ in $e$ >> -> - <:expr< let $opt:rf$ $list:List.map (subst_pe v) pel$ in $subst v e$ >> - | <:expr< $e1$ $e2$ >> -> <:expr< $subst v e1$ $subst v e2$ >> - | <:expr< ( $list:el$ ) >> -> <:expr< ( $list:List.map (subst v) el$ ) >> - | _ -> raise Not_found ] -and subst_pe v (p, e) = - match p with - [ <:patt< $lid:v'$ >> -> if v = v' then (p, e) else (p, subst v e) - | _ -> raise Not_found ] -; - -value stream_pattern_component skont ckont = - fun - [ SpTrm loc p wo -> - <:expr< match $peek_fun loc$ $lid:strm_n$ with - [ Some $p$ $when:wo$ -> - do { $junk_fun loc$ $lid:strm_n$; $skont$ } - | _ -> $ckont$ ] >> - | SpNtr loc p e -> - let e = - match e with - [ <:expr< fun [ ($lid:v$ : Stream.t _) -> $e$ ] >> when v = strm_n -> - e - | _ -> <:expr< $e$ $lid:strm_n$ >> ] - in - if pattern_eq_expression p skont then - if is_raise_failure ckont then e - else if handle_failure e then e - else <:expr< try $e$ with [ Stream.Failure -> $ckont$ ] >> - else if is_raise_failure ckont then <:expr< let $p$ = $e$ in $skont$ >> - else if pattern_eq_expression <:patt< Some $p$ >> skont then - <:expr< try Some $e$ with [ Stream.Failure -> $ckont$ ] >> - else if is_raise ckont then - let tst = - if handle_failure e then e - else <:expr< try $e$ with [ Stream.Failure -> $ckont$ ] >> - in - <:expr< let $p$ = $tst$ in $skont$ >> - else - <:expr< match try Some $e$ with [ Stream.Failure -> None ] with - [ Some $p$ -> $skont$ - | _ -> $ckont$ ] >> - | SpStr loc p -> - try - match p with - [ <:patt< $lid:v$ >> -> subst v skont - | _ -> raise Not_found ] - with - [ Not_found -> <:expr< let $p$ = $lid:strm_n$ in $skont$ >> ] ] -; - -value rec stream_pattern loc epo e ekont = - fun - [ [] -> - match epo with - [ Some ep -> <:expr< let $ep$ = Stream.count $lid:strm_n$ in $e$ >> - | _ -> e ] - | [(spc, err) :: spcl] -> - let skont = - let ekont err = - let str = - match err with - [ Some estr -> estr - | _ -> <:expr< "" >> ] - in - <:expr< raise (Stream.Error $str$) >> - in - stream_pattern loc epo e ekont spcl - in - let ckont = ekont err in - stream_pattern_component skont ckont spc ] -; - -value stream_patterns_term loc ekont tspel = - let pel = - List.map - (fun (p, w, loc, spcl, epo, e) -> - let p = <:patt< Some $p$ >> in - let e = - let ekont err = - let str = - match err with - [ Some estr -> estr - | _ -> <:expr< "" >> ] - in - <:expr< raise (Stream.Error $str$) >> - in - let skont = stream_pattern loc epo e ekont spcl in - <:expr< do { $junk_fun loc$ $lid:strm_n$; $skont$ } >> - in - (p, w, e)) - tspel - in - let pel = pel @ [(<:patt< _ >>, None, ekont ())] in - <:expr< match $peek_fun loc$ $lid:strm_n$ with [ $list:pel$ ] >> -; - -value rec group_terms = - fun - [ [([(SpTrm loc p w, None) :: spcl], epo, e) :: spel] -> - let (tspel, spel) = group_terms spel in - ([(p, w, loc, spcl, epo, e) :: tspel], spel) - | spel -> ([], spel) ] -; - -value rec parser_cases loc = - fun - [ [] -> <:expr< raise Stream.Failure >> - | spel -> - match group_terms spel with - [ ([], [(spcl, epo, e) :: spel]) -> - stream_pattern loc epo e (fun _ -> parser_cases loc spel) spcl - | (tspel, spel) -> - stream_patterns_term loc (fun _ -> parser_cases loc spel) tspel ] ] -; - -value cparser loc bpo pc = - let e = parser_cases loc pc in - let e = - match bpo with - [ Some bp -> <:expr< let $bp$ = Stream.count $lid:strm_n$ in $e$ >> - | None -> e ] - in - let p = <:patt< ($lid:strm_n$ : Stream.t _) >> in - <:expr< fun $p$ -> $e$ >> -; - -value cparser_match loc me bpo pc = - let pc = parser_cases loc pc in - let e = - match bpo with - [ Some bp -> <:expr< let $bp$ = Stream.count $lid:strm_n$ in $pc$ >> - | None -> pc ] - in - <:expr< let $lid:strm_n$ = $me$ in $e$ >> -; - -(* streams *) - -value rec not_computing = - fun - [ <:expr< $lid:_$ >> | <:expr< $uid:_$ >> | <:expr< $int:_$ >> | - <:expr< $flo:_$ >> | <:expr< $chr:_$ >> | <:expr< $str:_$ >> -> - True - | <:expr< $x$ $y$ >> -> is_cons_apply_not_computing x && not_computing y - | _ -> False ] -and is_cons_apply_not_computing = - fun - [ <:expr< $uid:_$ >> -> True - | <:expr< $lid:_$ >> -> False - | <:expr< $x$ $y$ >> -> is_cons_apply_not_computing x && not_computing y - | _ -> False ] -; - -value slazy loc e = - match e with - [ <:expr< $f$ () >> -> - match f with - [ <:expr< $lid:_$ >> -> f - | _ -> <:expr< fun _ -> $e$ >> ] - | _ -> <:expr< fun _ -> $e$ >> ] -; - -value rec cstream gloc = - fun - [ [] -> - let loc = gloc in - <:expr< Stream.sempty >> - | [SeTrm loc e] -> - if not_computing e then <:expr< Stream.ising $e$ >> - else <:expr< Stream.lsing $slazy loc e$ >> - | [SeTrm loc e :: secl] -> - if not_computing e then <:expr< Stream.icons $e$ $cstream gloc secl$ >> - else <:expr< Stream.lcons $slazy loc e$ $cstream gloc secl$ >> - | [SeNtr loc e] -> - if not_computing e then e else <:expr< Stream.slazy $slazy loc e$ >> - | [SeNtr loc e :: secl] -> - if not_computing e then <:expr< Stream.iapp $e$ $cstream gloc secl$ >> - else <:expr< Stream.lapp $slazy loc e$ $cstream gloc secl$ >> ] -; - -(* Syntax extensions in Ocaml grammar *) - -EXTEND - GLOBAL: expr; - expr: LEVEL "expr1" - [ [ "parser"; po = OPT ipatt; OPT "|"; pcl = LIST1 parser_case SEP "|" -> - <:expr< $cparser loc po pcl$ >> - | "match"; e = SELF; "with"; "parser"; po = OPT ipatt; OPT "|"; - pcl = LIST1 parser_case SEP "|" -> - <:expr< $cparser_match loc e po pcl$ >> ] ] - ; - parser_case: - [ [ "[<"; sp = stream_patt; ">]"; po = OPT ipatt; "->"; e = expr -> - (sp, po, e) ] ] - ; - stream_patt: - [ [ spc = stream_patt_comp -> [(spc, None)] - | spc = stream_patt_comp; ";" -> [(spc, None)] - | spc = stream_patt_comp; ";"; sp = stream_patt_comp_err_list -> - [(spc, None) :: sp] - | -> (* empty *) [] ] ] - ; - stream_patt_comp_err_list: - [ [ spc = stream_patt_comp_err -> [spc] - | spc = stream_patt_comp_err; ";" -> [spc] - | spc = stream_patt_comp_err; ";"; sp = SELF -> [spc :: sp] ] ] - ; - stream_patt_comp: - [ [ "'"; p = patt; eo = OPT [ "when"; e = expr LEVEL "expr1" -> e ] -> - SpTrm loc p eo - | p = patt; "="; e = expr LEVEL "expr1" -> SpNtr loc p e - | p = patt -> SpStr loc p ] ] - ; - stream_patt_comp_err: - [ [ spc = stream_patt_comp; - eo = OPT [ "?"; e = expr LEVEL "expr1" -> e ] -> - (spc, eo) ] ] - ; - ipatt: - [ [ i = LIDENT -> <:patt< $lid:i$ >> ] ] - ; - expr: LEVEL "simple" - [ [ "[<"; ">]" -> <:expr< $cstream loc []$ >> - | "[<"; sel = stream_expr_comp_list; ">]" -> - <:expr< $cstream loc sel$ >> ] ] - ; - stream_expr_comp_list: - [ [ se = stream_expr_comp; ";"; sel = SELF -> [se :: sel] - | se = stream_expr_comp; ";" -> [se] - | se = stream_expr_comp -> [se] ] ] - ; - stream_expr_comp: - [ [ "'"; e = expr LEVEL "expr1" -> SeTrm loc e - | e = expr LEVEL "expr1" -> SeNtr loc e ] ] - ; -END; diff -Nru ocaml-3.12.1/camlp4/unmaintained/scheme/Makefile ocaml-4.01.0/camlp4/unmaintained/scheme/Makefile --- ocaml-3.12.1/camlp4/unmaintained/scheme/Makefile 2006-01-04 16:55:50.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/scheme/Makefile 1970-01-01 00:00:00.000000000 +0000 @@ -1,85 +0,0 @@ -######################################################################### -# # -# Objective Caml # -# # -# Camlp4 # -# # -# Copyright 2004 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### -# -# Makefile for pa_lefteval -# M.Mauny -# - -include ../../config/Makefile.cnf - -OCAMLTOP=../../.. -CAMLP4=../../camlp4/camlp4$(EXE) - -OCAMLC=$(OCAMLTOP)/ocamlc$(EXE) -OCAMLOPT=$(OCAMLTOP)/ocamlopt$(EXE) - -P4INCLUDES= -nolib -I ../../meta -I ../../etc -OCAMLINCLUDES= -nostdlib -I $(OCAMLTOP)/stdlib -I ../../camlp4 -I ../../lib -I ../../etc -OCAMLCFLAGS=-warn-error A $(OCAMLINCLUDES) - -SCHSRC=pa_scheme.sc -SRC=pa_scheme.ml pr_scheme.ml pr_schp_main.ml -OBJS=$(SRC:.ml=.cmo) -OBJSX=$(OCAMLSRC:.ml=.cmx) - -all: $(OBJS) pr_schemep.cmo camlp4sch$(EXE) - -opt: all - -bootstrap: camlp4sch$(EXE) save - ./camlp4sch$(EXE) ../../etc/q_phony.cmo ../../meta/pa_extend.cmo ../../etc/pr_r.cmo ../../etc/pr_extend.cmo ../../etc/pr_rp.cmo -impl pa_scheme.sc \ - | sed -e 's/^;; \(.*\)$$/(* \1 *)/' -e 's/^; \(.*\)$$/(* \1 *)/' \ - -e 's/$$Id.*\$$/File generated by pretty print; do not edit!/' > pa_scheme.ml - @if cmp -s pa_scheme.ml SAVED/pa_scheme.ml; then \ - echo 'pa_scheme.ml and SAVED/pa_scheme.ml are identical' ; \ - else \ - echo '**** Note: pa_scheme.ml differs from SAVED/pa_scheme.ml'; \ - fi - -save: - test -d SAVED || mkdir SAVED - mkdir SAVED.$$$$ && mv SAVED pa_scheme.ml SAVED.$$$$ && mv SAVED.$$$$ SAVED - -restore: - mv SAVED SAVED.$$$$ && mv SAVED.$$$$/* . && rmdir SAVED.$$$$ - -depend: - cp .depend .depend.bak - > .depend - for file in $(SRC); do \ - $(CAMLP4) $(P4INCLUDES) `awk 'NR == 1 { ORS=" "; for (i=2; i < NF; i++) print $$i; } ' $$file` pr_depend.cmo $$i | \ - sed -e 's| \.\./\.\./\.\.| $$(OCAMLTOP)|g' >> .depend; \ - done - -clean: - rm -f camlp4sch$(EXE) *.cm* *.$(O) *.bak .*.bak - -camlp4sch: pa_scheme.cmo - rm -f camlp4sch - DIR=`pwd` && cd ../../camlp4 && $(MAKE) CAMLP4=$$DIR/camlp4sch CAMLP4M="-I $$DIR pa_scheme.cmo ../meta/pr_dump.cmo" - -pr_schemep.cmo: pr_schp_main.cmo - $(OCAMLC) ../../etc/parserify.cmo pr_schp_main.cmo -a -o $@ - -.SUFFIXES: .cmx .cmo .cmi .ml .mli - -.mli.cmi: - $(OCAMLC) $(OCAMLCFLAGS) -c $< - - -.ml.cmo: - $(OCAMLC) $(OCAMLCFLAGS) -pp "$(CAMLP4) $(P4INCLUDES) `awk 'NR == 1 { ORS=" "; for (i=2; i < NF; i++) print $$i; } ' $<` -loc loc" -c $< - -.ml.cmx: - $(OCAMLOPT) $(OCAMLCFLAGS) -pp "$(CAMLP4) $(P4INCLUDES) `awk 'NR == 1 { ORS=" "; for (i=2; i < NF; i++) print $$i; } ' $<` -loc loc" -c $< - -include .depend diff -Nru ocaml-3.12.1/camlp4/unmaintained/scheme/README ocaml-4.01.0/camlp4/unmaintained/scheme/README --- ocaml-3.12.1/camlp4/unmaintained/scheme/README 2004-07-13 12:25:21.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/scheme/README 1970-01-01 00:00:00.000000000 +0000 @@ -1,15 +0,0 @@ -This is an application of or an extension for Camlp4. Although it is -currently distributed with OCaml/Camlp4, it may or may not be -actively maintained. - -It probably won't be part of future OCaml/Camlp4 distributions but be -accessible from the Camlp4 hump. If you are interested in developing -this package further and/or actively maintain it, please let us know -(caml@inria.fr) - -This package is distributed under the same license as the Objective -Caml Library (that is, LGPL with a special exception allowing both -static and dynamic link). - --- Michel Mauny - diff -Nru ocaml-3.12.1/camlp4/unmaintained/scheme/pa_scheme.ml ocaml-4.01.0/camlp4/unmaintained/scheme/pa_scheme.ml --- ocaml-3.12.1/camlp4/unmaintained/scheme/pa_scheme.ml 2006-06-29 08:12:46.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/scheme/pa_scheme.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,1093 +0,0 @@ -(* pa_r.cmo pa_rp.cmo pa_extend.cmo q_MLast.cmo pr_dump.cmo *) -(* ********************************************************************** *) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2002 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file *) -(* ../../../LICENSE. *) -(* *) -(* ********************************************************************** *) -(* File generated by pretty print; do not edit! *) - -open Pcaml; -open Stdpp; - -type choice 'a 'b = - [ Left of 'a - | Right of 'b ] -; - -(* Buffer *) - -module Buff = - struct - value buff = ref (String.create 80); - value store len x = - do { - if len >= String.length buff.val then - buff.val := buff.val ^ String.create (String.length buff.val) - else (); - buff.val.[len] := x; - succ len - } - ; - value get len = String.sub buff.val 0 len; - end -; - -(* Lexer *) - -value rec skip_to_eol = - parser - [ [: `'\n' | '\r' :] -> () - | [: `_; s :] -> skip_to_eol s ] -; - -value no_ident = ['('; ')'; '['; ']'; '{'; '}'; ' '; '\t'; '\n'; '\r'; ';']; - -value rec ident len = - parser - [ [: `'.' :] -> (Buff.get len, True) - | [: `x when not (List.mem x no_ident); s :] -> ident (Buff.store len x) s - | [: :] -> (Buff.get len, False) ] -; - -value identifier kwt (s, dot) = - let con = - try do { (Hashtbl.find kwt s : unit); "" } with - [ Not_found -> - match s.[0] with - [ 'A'..'Z' -> if dot then "UIDENTDOT" else "UIDENT" - | _ -> if dot then "LIDENTDOT" else "LIDENT" ] ] - in - (con, s) -; - -value rec string len = - parser - [ [: `'"' :] -> Buff.get len - | [: `'\\'; `c; s :] -> string (Buff.store (Buff.store len '\\') c) s - | [: `x; s :] -> string (Buff.store len x) s ] -; - -value rec end_exponent_part_under len = - parser - [ [: `('0'..'9' as c); s :] -> end_exponent_part_under (Buff.store len c) s - | [: :] -> ("FLOAT", Buff.get len) ] -; - -value end_exponent_part len = - parser - [ [: `('0'..'9' as c); s :] -> end_exponent_part_under (Buff.store len c) s - | [: :] -> raise (Stream.Error "ill-formed floating-point constant") ] -; - -value exponent_part len = - parser - [ [: `('+' | '-' as c); s :] -> end_exponent_part (Buff.store len c) s - | [: a = end_exponent_part len :] -> a ] -; - -value rec decimal_part len = - parser - [ [: `('0'..'9' as c); s :] -> decimal_part (Buff.store len c) s - | [: `'e' | 'E'; s :] -> exponent_part (Buff.store len 'E') s - | [: :] -> ("FLOAT", Buff.get len) ] -; - -value rec number len = - parser - [ [: `('0'..'9' as c); s :] -> number (Buff.store len c) s - | [: `'.'; s :] -> decimal_part (Buff.store len '.') s - | [: `'e' | 'E'; s :] -> exponent_part (Buff.store len 'E') s - | [: :] -> ("INT", Buff.get len) ] -; - -value binary = parser [: `('0'..'1' as c) :] -> c; - -value octal = parser [: `('0'..'7' as c) :] -> c; - -value hexa = parser [: `('0'..'9' | 'a'..'f' | 'A'..'F' as c) :] -> c; - -value rec digits_under kind len = - parser - [ [: d = kind; s :] -> digits_under kind (Buff.store len d) s - | [: :] -> Buff.get len ] -; - -value digits kind bp len = - parser - [ [: d = kind; s :] -> ("INT", digits_under kind (Buff.store len d) s) - | [: s :] ep -> - raise_with_loc - (Reloc.shift_pos bp Reloc.zero_loc, Reloc.shift_pos ep Reloc.zero_loc) - (Failure "ill-formed integer constant") ] -; - -value base_number kwt bp len = - parser - [ [: `'b' | 'B'; s :] -> digits binary bp (Buff.store len 'b') s - | [: `'o' | 'O'; s :] -> digits octal bp (Buff.store len 'o') s - | [: `'x' | 'X'; s :] -> digits hexa bp (Buff.store len 'x') s - | [: id = ident (Buff.store 0 '#') :] -> identifier kwt id ] -; - -value rec operator len = - parser - [ [: `'.' :] -> Buff.get (Buff.store len '.') - | [: :] -> Buff.get len ] -; - -value char_or_quote_id x = - parser - [ [: `''' :] -> ("CHAR", String.make 1 x) - | [: s :] ep -> - if List.mem x no_ident then - Stdpp.raise_with_loc - (Reloc.shift_pos (ep - 2) Reloc.zero_loc, - Reloc.shift_pos (ep - 1) Reloc.zero_loc) - (Stream.Error "bad quote") - else - let len = Buff.store (Buff.store 0 ''') x in - let (s, dot) = ident len s in - (if dot then "LIDENTDOT" else "LIDENT", s) ] -; - -value rec char len = - parser - [ [: `''' :] -> len - | [: `x; s :] -> char (Buff.store len x) s ] -; - -value quote = - parser - [ [: `'\\'; len = char (Buff.store 0 '\\') :] -> ("CHAR", Buff.get len) - | [: `x; s :] -> char_or_quote_id x s ] -; - -(* The system with LIDENTDOT and UIDENTDOT is not great (it would be *) -(* better to have a token DOT (actually SPACEDOT and DOT)) but it is *) -(* the only way (that I have found) to have a good behaviour in the *) -(* toplevel (not expecting tokens after a phrase). Drawbacks: 1/ to be *) -(* complete, we should have STRINGDOT, RIGHTPARENDOT, and so on 2/ the *) -(* parser rule with dot is right associative and we have to reverse *) -(* the resulting tree (using the function leftify). *) -(* This is a complicated issue: the behaviour of the OCaml toplevel *) -(* is strange, anyway. For example, even without Camlp4, The OCaml *) -(* toplevel accepts that: *) -(* # let x = 32;; foo bar match let ) *) - -value rec lexer kwt = parser [: t = lexer0 kwt; _ = no_dot :] -> t -and no_dot = - parser - [ [: `'.' :] ep -> - Stdpp.raise_with_loc - (Reloc.shift_pos (ep - 1) Reloc.zero_loc, - Reloc.shift_pos ep Reloc.zero_loc) - (Stream.Error "bad dot") - | [: :] -> () ] -and lexer0 kwt = - parser bp - [ [: `'\t' | '\n' | '\r'; s :] -> lexer0 kwt s - | [: `' '; s :] -> after_space kwt s - | [: `';'; _ = skip_to_eol; s :] -> lexer kwt s - | [: `'(' :] -> (("", "("), (bp, bp + 1)) - | [: `')'; s :] ep -> (("", rparen s), (bp, ep)) - | [: `'[' :] -> (("", "["), (bp, bp + 1)) - | [: `']' :] -> (("", "]"), (bp, bp + 1)) - | [: `'{' :] -> (("", "{"), (bp, bp + 1)) - | [: `'}' :] -> (("", "}"), (bp, bp + 1)) - | [: `'"'; s = string 0 :] ep -> (("STRING", s), (bp, ep)) - | [: `'''; tok = quote :] ep -> (tok, (bp, ep)) - | [: `'<'; tok = less kwt :] ep -> (tok, (bp, ep)) - | [: `'-'; tok = minus kwt :] ep -> (tok, (bp, ep)) - | [: `'~'; tok = tilde :] ep -> (tok, (bp, ep)) - | [: `'?'; tok = question :] ep -> (tok, (bp, ep)) - | [: `'#'; tok = base_number kwt bp (Buff.store 0 '0') :] ep -> - (tok, (bp, ep)) - | [: `('0'..'9' as c); tok = number (Buff.store 0 c) :] ep -> - (tok, (bp, ep)) - | [: `('+' | '*' | '/' as c); id = operator (Buff.store 0 c) :] ep -> - (identifier kwt (id, False), (bp, ep)) - | [: `x; id = ident (Buff.store 0 x) :] ep -> (identifier kwt id, (bp, ep)) - | [: :] -> (("EOI", ""), (bp, bp + 1)) ] -and rparen = - parser - [ [: `'.' :] -> ")." - | [: ___ :] -> ")" ] -and after_space kwt = - parser - [ [: `'.' :] ep -> (("", "."), (ep - 1, ep)) - | [: x = lexer0 kwt :] -> x ] -and tilde = - parser - [ [: `('a'..'z' as c); (s, dot) = ident (Buff.store 0 c) :] -> - ("TILDEIDENT", s) - | [: :] -> ("LIDENT", "~") ] -and question = - parser - [ [: `('a'..'z' as c); (s, dot) = ident (Buff.store 0 c) :] -> - ("QUESTIONIDENT", s) - | [: :] -> ("LIDENT", "?") ] -and minus kwt = - parser - [ [: `'.' :] -> identifier kwt ("-.", False) - | [: `('0'..'9' as c); n = number (Buff.store (Buff.store 0 '-') c) :] -> - n - | [: id = ident (Buff.store 0 '-') :] -> identifier kwt id ] -and less kwt = - parser - [ [: `':'; lab = label 0; `'<' ? "'<' expected"; q = quotation 0 :] -> - ("QUOT", lab ^ ":" ^ q) - | [: id = ident (Buff.store 0 '<') :] -> identifier kwt id ] -and label len = - parser - [ [: `('a'..'z' | 'A'..'Z' | '_' as c); s :] -> label (Buff.store len c) s - | [: :] -> Buff.get len ] -and quotation len = - parser - [ [: `'>'; s :] -> quotation_greater len s - | [: `x; s :] -> quotation (Buff.store len x) s - | [: :] -> failwith "quotation not terminated" ] -and quotation_greater len = - parser - [ [: `'>' :] -> Buff.get len - | [: a = quotation (Buff.store len '>') :] -> a ] -; - -value lexer_using kwt (con, prm) = - match con with - [ "CHAR" | "EOI" | "INT" | "FLOAT" | "LIDENT" | "LIDENTDOT" | - "QUESTIONIDENT" | "QUOT" | "STRING" | "TILDEIDENT" | "UIDENT" | - "UIDENTDOT" -> - () - | "ANTIQUOT" -> () - | "" -> - try Hashtbl.find kwt prm with [ Not_found -> Hashtbl.add kwt prm () ] - | _ -> - raise - (Token.Error - ("the constructor \"" ^ con ^ "\" is not recognized by Plexer")) ] -; - -value lexer_text (con, prm) = - if con = "" then "'" ^ prm ^ "'" - else if prm = "" then con - else con ^ " \"" ^ prm ^ "\"" -; - -value lexer_gmake () = - let kwt = Hashtbl.create 89 in - {Token.tok_func = - Token.lexer_func_of_parser - (fun s -> - let (r, (bp, ep)) = lexer kwt s in - (r, - (Reloc.shift_pos bp Reloc.zero_loc, - Reloc.shift_pos ep Reloc.zero_loc))); - Token.tok_using = lexer_using kwt; Token.tok_removing = fun []; - Token.tok_match = Token.default_match; Token.tok_text = lexer_text; - Token.tok_comm = None} -; - -(* Building AST *) - -type sexpr = - [ Sacc of Loc.t and sexpr and sexpr - | Schar of Loc.t and string - | Sexpr of Loc.t and list sexpr - | Sint of Loc.t and string - | Sfloat of Loc.t and string - | Slid of Loc.t and string - | Slist of Loc.t and list sexpr - | Sqid of Loc.t and string - | Squot of Loc.t and string and string - | Srec of Loc.t and list sexpr - | Sstring of Loc.t and string - | Stid of Loc.t and string - | Suid of Loc.t and string ] -; - -value loc_of_sexpr = - fun [ - Sacc loc _ _ | Schar loc _ | Sexpr loc _ | Sint loc _ | Sfloat loc _ | - Slid loc _ | Slist loc _ | Sqid loc _ | Squot loc _ _ | Srec loc _ | - Sstring loc _ | Stid loc _ | Suid loc _ -> - loc ] -; -value error_loc loc err = - raise_with_loc loc (Stream.Error (err ^ " expected")) -; -value error se err = error_loc (loc_of_sexpr se) err; - -value strm_n = "__strm"; -value peek_fun loc = <:expr< Stream.peek >>; -value junk_fun loc = <:expr< Stream.junk >>; - -value assoc_left_parsed_op_list = - ["+"; "*"; "+."; "*."; "land"; "lor"; "lxor"] -; -value assoc_right_parsed_op_list = ["and"; "or"; "^"; "@"]; -value and_by_couple_op_list = ["="; "<>"; "<"; ">"; "<="; ">="; "=="; "!="]; - -value op_apply loc e1 e2 = - fun - [ "and" -> <:expr< $e1$ && $e2$ >> - | "or" -> <:expr< $e1$ || $e2$ >> - | x -> <:expr< $lid:x$ $e1$ $e2$ >> ] -; - -value string_se = - fun - [ Sstring loc s -> s - | se -> error se "string" ] -; - -value mod_ident_se = - fun - [ Suid _ s -> [Pcaml.rename_id.val s] - | Slid _ s -> [Pcaml.rename_id.val s] - | se -> error se "mod_ident" ] -; - -value lident_expr loc s = - if String.length s > 1 && s.[0] = '`' then - let s = String.sub s 1 (String.length s - 1) in - <:expr< ` $s$ >> - else <:expr< $lid:(Pcaml.rename_id.val s)$ >> -; - -value rec module_expr_se = - fun - [ Sexpr loc [Slid _ "functor"; Suid _ s; se1; se2] -> - let s = Pcaml.rename_id.val s in - let mt = module_type_se se1 in - let me = module_expr_se se2 in - <:module_expr< functor ($s$ : $mt$) -> $me$ >> - | Sexpr loc [Slid _ "struct" :: sl] -> - let mel = List.map str_item_se sl in - <:module_expr< struct $list:mel$ end >> - | Sexpr loc [se1; se2] -> - let me1 = module_expr_se se1 in - let me2 = module_expr_se se2 in - <:module_expr< $me1$ $me2$ >> - | Suid loc s -> <:module_expr< $uid:(Pcaml.rename_id.val s)$ >> - | se -> error se "module expr" ] -and module_type_se = - fun - [ Sexpr loc [Slid _ "functor"; Suid _ s; se1; se2] -> - let s = Pcaml.rename_id.val s in - let mt1 = module_type_se se1 in - let mt2 = module_type_se se2 in - <:module_type< functor ($s$ : $mt1$) -> $mt2$ >> - | Sexpr loc [Slid _ "sig" :: sel] -> - let sil = List.map sig_item_se sel in - <:module_type< sig $list:sil$ end >> - | Sexpr loc [Slid _ "with"; se; Sexpr _ sel] -> - let mt = module_type_se se in - let wcl = List.map with_constr_se sel in - <:module_type< $mt$ with $list:wcl$ >> - | Suid loc s -> <:module_type< $uid:(Pcaml.rename_id.val s)$ >> - | se -> error se "module type" ] -and with_constr_se = - fun - [ Sexpr loc [Slid _ "type"; se1; se2] -> - let tn = mod_ident_se se1 in - let te = ctyp_se se2 in - MLast.WcTyp loc tn [] te - | se -> error se "with constr" ] -and sig_item_se = - fun - [ Sexpr loc [Slid _ "type" :: sel] -> - let tdl = type_declaration_list_se sel in - <:sig_item< type $list:tdl$ >> - | Sexpr loc [Slid _ "exception"; Suid _ c :: sel] -> - let c = Pcaml.rename_id.val c in - let tl = List.map ctyp_se sel in - <:sig_item< exception $c$ of $list:tl$ >> - | Sexpr loc [Slid _ "value"; Slid _ s; se] -> - let s = Pcaml.rename_id.val s in - let t = ctyp_se se in - <:sig_item< value $s$ : $t$ >> - | Sexpr loc [Slid _ "external"; Slid _ i; se :: sel] -> - let i = Pcaml.rename_id.val i in - let pd = List.map string_se sel in - let t = ctyp_se se in - <:sig_item< external $i$ : $t$ = $list:pd$ >> - | Sexpr loc [Slid _ "module"; Suid _ s; se] -> - let s = Pcaml.rename_id.val s in - let mb = module_type_se se in - <:sig_item< module $s$ : $mb$ >> - | Sexpr loc [Slid _ "moduletype"; Suid _ s; se] -> - let s = Pcaml.rename_id.val s in - let mt = module_type_se se in - <:sig_item< module type $s$ = $mt$ >> - | se -> error se "sig item" ] -and str_item_se se = - match se with - [ Sexpr loc [Slid _ "open"; se] -> - let s = mod_ident_se se in - <:str_item< open $s$ >> - | Sexpr loc [Slid _ "type" :: sel] -> - let tdl = type_declaration_list_se sel in - <:str_item< type $list:tdl$ >> - | Sexpr loc [Slid _ "exception"; Suid _ c :: sel] -> - let c = Pcaml.rename_id.val c in - let tl = List.map ctyp_se sel in - <:str_item< exception $c$ of $list:tl$ >> - | Sexpr loc [Slid _ ("define" | "definerec" as r); se :: sel] -> - let r = r = "definerec" in - let (p, e) = fun_binding_se se (begin_se loc sel) in - <:str_item< value $opt:r$ $p$ = $e$ >> - | Sexpr loc [Slid _ ("define*" | "definerec*" as r) :: sel] -> - let r = r = "definerec*" in - let lbs = List.map let_binding_se sel in - <:str_item< value $opt:r$ $list:lbs$ >> - | Sexpr loc [Slid _ "external"; Slid _ i; se :: sel] -> - let i = Pcaml.rename_id.val i in - let pd = List.map string_se sel in - let t = ctyp_se se in - <:str_item< external $i$ : $t$ = $list:pd$ >> - | Sexpr loc [Slid _ "module"; Suid _ i; se] -> - let i = Pcaml.rename_id.val i in - let mb = module_binding_se se in - <:str_item< module $i$ = $mb$ >> - | Sexpr loc [Slid _ "moduletype"; Suid _ s; se] -> - let s = Pcaml.rename_id.val s in - let mt = module_type_se se in - <:str_item< module type $s$ = $mt$ >> - | _ -> - let loc = loc_of_sexpr se in - let e = expr_se se in - <:str_item< $exp:e$ >> ] -and module_binding_se se = module_expr_se se -and expr_se = - fun - [ Sacc loc se1 se2 -> - let e1 = expr_se se1 in - match se2 with - [ Slist loc [se2] -> - let e2 = expr_se se2 in - <:expr< $e1$ .[ $e2$ ] >> - | Sexpr loc [se2] -> - let e2 = expr_se se2 in - <:expr< $e1$ .( $e2$ ) >> - | _ -> - let e2 = expr_se se2 in - <:expr< $e1$ . $e2$ >> ] - | Slid loc s -> lident_expr loc s - | Suid loc s -> <:expr< $uid:(Pcaml.rename_id.val s)$ >> - | Sint loc s -> <:expr< $int:s$ >> - | Sfloat loc s -> <:expr< $flo:s$ >> - | Schar loc s -> <:expr< $chr:s$ >> - | Sstring loc s -> <:expr< $str:s$ >> - | Stid loc s -> <:expr< ~ $(Pcaml.rename_id.val s)$ >> - | Sqid loc s -> <:expr< ? $(Pcaml.rename_id.val s)$ >> - | Sexpr loc [] -> <:expr< () >> - | Sexpr loc [Slid _ s; e1 :: ([_ :: _] as sel)] - when List.mem s assoc_left_parsed_op_list -> - let rec loop e1 = - fun - [ [] -> e1 - | [e2 :: el] -> loop (op_apply loc e1 e2 s) el ] - in - loop (expr_se e1) (List.map expr_se sel) - | Sexpr loc [Slid _ s :: ([_; _ :: _] as sel)] - when List.mem s assoc_right_parsed_op_list -> - let rec loop = - fun - [ [] -> assert False - | [e1] -> e1 - | [e1 :: el] -> - let e2 = loop el in - op_apply loc e1 e2 s ] - in - loop (List.map expr_se sel) - | Sexpr loc [Slid _ s :: ([_; _ :: _] as sel)] - when List.mem s and_by_couple_op_list -> - let rec loop = - fun - [ [] | [_] -> assert False - | [e1; e2] -> <:expr< $lid:s$ $e1$ $e2$ >> - | [e1 :: ([e2; _ :: _] as el)] -> - let a1 = op_apply loc e1 e2 s in - let a2 = loop el in - <:expr< $a1$ && $a2$ >> ] - in - loop (List.map expr_se sel) - | Sexpr loc [Stid _ s; se] -> - let e = expr_se se in - <:expr< ~ $s$ : $e$ >> - | Sexpr loc [Slid _ "-"; se] -> - let e = expr_se se in - <:expr< - $e$ >> - | Sexpr loc [Slid _ "if"; se; se1] -> - let e = expr_se se in - let e1 = expr_se se1 in - <:expr< if $e$ then $e1$ else () >> - | Sexpr loc [Slid _ "if"; se; se1; se2] -> - let e = expr_se se in - let e1 = expr_se se1 in - let e2 = expr_se se2 in - <:expr< if $e$ then $e1$ else $e2$ >> - | Sexpr loc [Slid _ "cond" :: sel] -> - let rec loop = - fun - [ [Sexpr loc [Slid _ "else" :: sel]] -> begin_se loc sel - | [Sexpr loc [se1 :: sel1] :: sel] -> - let e1 = expr_se se1 in - let e2 = begin_se loc sel1 in - let e3 = loop sel in - <:expr< if $e1$ then $e2$ else $e3$ >> - | [] -> <:expr< () >> - | [se :: _] -> error se "cond clause" ] - in - loop sel - | Sexpr loc [Slid _ "while"; se :: sel] -> - let e = expr_se se in - let el = List.map expr_se sel in - <:expr< while $e$ do { $list:el$ } >> - | Sexpr loc [Slid _ "for"; Slid _ i; se1; se2 :: sel] -> - let i = Pcaml.rename_id.val i in - let e1 = expr_se se1 in - let e2 = expr_se se2 in - let el = List.map expr_se sel in - <:expr< for $i$ = $e1$ to $e2$ do { $list:el$ } >> - | Sexpr loc [Slid loc1 "lambda"] -> <:expr< fun [] >> - | Sexpr loc [Slid loc1 "lambda"; sep :: sel] -> - let e = begin_se loc1 sel in - match ipatt_opt_se sep with - [ Left p -> <:expr< fun $p$ -> $e$ >> - | Right (se, sel) -> - List.fold_right - (fun se e -> - let p = ipatt_se se in - <:expr< fun $p$ -> $e$ >>) - [se :: sel] e ] - | Sexpr loc [Slid _ "lambda_match" :: sel] -> - let pel = List.map (match_case loc) sel in - <:expr< fun [ $list:pel$ ] >> - | Sexpr loc [Slid _ ("let" | "letrec" as r) :: sel] -> - match sel with - [ [Sexpr _ sel1 :: sel2] -> - let r = r = "letrec" in - let lbs = List.map let_binding_se sel1 in - let e = begin_se loc sel2 in - <:expr< let $opt:r$ $list:lbs$ in $e$ >> - | [Slid _ n; Sexpr _ sl :: sel] -> - let n = Pcaml.rename_id.val n in - let (pl, el) = - List.fold_right - (fun se (pl, el) -> - match se with - [ Sexpr _ [se1; se2] -> - ([patt_se se1 :: pl], [expr_se se2 :: el]) - | se -> error se "named let" ]) - sl ([], []) - in - let e1 = - List.fold_right (fun p e -> <:expr< fun $p$ -> $e$ >>) pl - (begin_se loc sel) - in - let e2 = - List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) - <:expr< $lid:n$ >> el - in - <:expr< let rec $lid:n$ = $e1$ in $e2$ >> - | [se :: _] -> error se "let_binding" - | _ -> error_loc loc "let_binding" ] - | Sexpr loc [Slid _ "let*" :: sel] -> - match sel with - [ [Sexpr _ sel1 :: sel2] -> - List.fold_right - (fun se ek -> - let (p, e) = let_binding_se se in - <:expr< let $p$ = $e$ in $ek$ >>) - sel1 (begin_se loc sel2) - | [se :: _] -> error se "let_binding" - | _ -> error_loc loc "let_binding" ] - | Sexpr loc [Slid _ "match"; se :: sel] -> - let e = expr_se se in - let pel = List.map (match_case loc) sel in - <:expr< match $e$ with [ $list:pel$ ] >> - | Sexpr loc [Slid _ "parser" :: sel] -> - let e = - match sel with - [ [(Slid _ _ as se) :: sel] -> - let p = patt_se se in - let pc = parser_cases_se loc sel in - <:expr< let $p$ = Stream.count $lid:strm_n$ in $pc$ >> - | _ -> parser_cases_se loc sel ] - in - <:expr< fun ($lid:strm_n$ : Stream.t _) -> $e$ >> - | Sexpr loc [Slid _ "match_with_parser"; se :: sel] -> - let me = expr_se se in - let (bpo, sel) = - match sel with - [ [(Slid _ _ as se) :: sel] -> (Some (patt_se se), sel) - | _ -> (None, sel) ] - in - let pc = parser_cases_se loc sel in - let e = - match bpo with - [ Some bp -> <:expr< let $bp$ = Stream.count $lid:strm_n$ in $pc$ >> - | None -> pc ] - in - match me with - [ <:expr< $lid:x$ >> when x = strm_n -> e - | _ -> <:expr< let ($lid:strm_n$ : Stream.t _) = $me$ in $e$ >> ] - | Sexpr loc [Slid _ "try"; se :: sel] -> - let e = expr_se se in - let pel = List.map (match_case loc) sel in - <:expr< try $e$ with [ $list:pel$ ] >> - | Sexpr loc [Slid _ "begin" :: sel] -> - let el = List.map expr_se sel in - <:expr< do { $list:el$ } >> - | Sexpr loc [Slid _ ":="; se1; se2] -> - let e1 = expr_se se1 in - let e2 = expr_se se2 in - <:expr< $e1$ := $e2$ >> - | Sexpr loc [Slid _ "values" :: sel] -> - let el = List.map expr_se sel in - <:expr< ( $list:el$ ) >> - | Srec loc [Slid _ "with"; se :: sel] -> - let e = expr_se se in - let lel = List.map (label_expr_se loc) sel in - <:expr< { ($e$) with $list:lel$ } >> - | Srec loc sel -> - let lel = List.map (label_expr_se loc) sel in - <:expr< { $list:lel$ } >> - | Sexpr loc [Slid _ ":"; se1; se2] -> - let e = expr_se se1 in - let t = ctyp_se se2 in - <:expr< ( $e$ : $t$ ) >> - | Sexpr loc [se] -> - let e = expr_se se in - <:expr< $e$ () >> - | Sexpr loc [Slid _ "assert"; Suid _ "False"] -> <:expr< assert False >> - | Sexpr loc [Slid _ "assert"; se] -> - let e = expr_se se in - <:expr< assert $e$ >> - | Sexpr loc [Slid _ "lazy"; se] -> - let e = expr_se se in - <:expr< lazy $e$ >> - | Sexpr loc [se :: sel] -> - List.fold_left - (fun e se -> - let e1 = expr_se se in - <:expr< $e$ $e1$ >>) - (expr_se se) sel - | Slist loc sel -> - let rec loop = - fun - [ [] -> <:expr< [] >> - | [se1; Slid _ "."; se2] -> - let e = expr_se se1 in - let el = expr_se se2 in - <:expr< [$e$ :: $el$] >> - | [se :: sel] -> - let e = expr_se se in - let el = loop sel in - <:expr< [$e$ :: $el$] >> ] - in - loop sel - | Squot loc typ txt -> Pcaml.handle_expr_quotation loc (typ, txt) ] -and begin_se loc = - fun - [ [] -> <:expr< () >> - | [se] -> expr_se se - | sel -> - let el = List.map expr_se sel in - let loc = (fst (loc_of_sexpr (List.hd sel)), snd loc) in - <:expr< do { $list:el$ } >> ] -and let_binding_se = - fun - [ Sexpr loc [se :: sel] -> - let e = begin_se loc sel in - match ipatt_opt_se se with - [ Left p -> (p, e) - | Right _ -> fun_binding_se se e ] - | se -> error se "let_binding" ] -and fun_binding_se se e = - match se with - [ Sexpr _ [Slid _ "values" :: _] -> (ipatt_se se, e) - | Sexpr _ [Slid loc s :: sel] -> - let s = Pcaml.rename_id.val s in - let e = - List.fold_right - (fun se e -> - let loc = (fst (loc_of_sexpr se), snd (MLast.loc_of_expr e)) in - let p = ipatt_se se in - <:expr< fun $p$ -> $e$ >>) - sel e - in - let p = <:patt< $lid:s$ >> in - (p, e) - | _ -> (ipatt_se se, e) ] -and match_case loc = - fun - [ Sexpr loc [Sexpr _ [Slid _ "when"; se; sew] :: sel] -> - (patt_se se, Some (expr_se sew), begin_se loc sel) - | Sexpr loc [se :: sel] -> (patt_se se, None, begin_se loc sel) - | se -> error se "match_case" ] -and label_expr_se loc = - fun - [ Sexpr _ [se1; se2] -> (patt_se se1, expr_se se2) - | se -> error se "label_expr" ] -and label_patt_se loc = - fun - [ Sexpr _ [se1; se2] -> (patt_se se1, patt_se se2) - | se -> error se "label_patt" ] -and parser_cases_se loc = - fun - [ [] -> <:expr< raise Stream.Failure >> - | [Sexpr loc [Sexpr _ spsel :: act] :: sel] -> - let ekont _ = parser_cases_se loc sel in - let act = - match act with - [ [se] -> expr_se se - | [sep; se] -> - let p = patt_se sep in - let e = expr_se se in - <:expr< let $p$ = Stream.count $lid:strm_n$ in $e$ >> - | _ -> error_loc loc "parser_case" ] - in - stream_pattern_se loc act ekont spsel - | [se :: _] -> error se "parser_case" ] -and stream_pattern_se loc act ekont = - fun - [ [] -> act - | [se :: sel] -> - let ckont err = <:expr< raise (Stream.Error $err$) >> in - let skont = stream_pattern_se loc act ckont sel in - stream_pattern_component skont ekont <:expr< "" >> se ] -and stream_pattern_component skont ekont err = - fun - [ Sexpr loc [Slid _ "`"; se :: wol] -> - let wo = - match wol with - [ [se] -> Some (expr_se se) - | [] -> None - | _ -> error_loc loc "stream_pattern_component" ] - in - let e = peek_fun loc in - let p = patt_se se in - let j = junk_fun loc in - let k = ekont err in - <:expr< match $e$ $lid:strm_n$ with - [ Some $p$ $when:wo$ -> do { $j$ $lid:strm_n$ ; $skont$ } - | _ -> $k$ ] >> - | Sexpr loc [se1; se2] -> - let p = patt_se se1 in - let e = - let e = expr_se se2 in - <:expr< try Some ($e$ $lid:strm_n$) with [ Stream.Failure -> None ] >> - in - let k = ekont err in - <:expr< match $e$ with [ Some $p$ -> $skont$ | _ -> $k$ ] >> - | Sexpr loc [Slid _ "?"; se1; se2] -> - stream_pattern_component skont ekont (expr_se se2) se1 - | Slid loc s -> - let s = Pcaml.rename_id.val s in - <:expr< let $lid:s$ = $lid:strm_n$ in $skont$ >> - | se -> error se "stream_pattern_component" ] -and patt_se = - fun - [ Sacc loc se1 se2 -> - let p1 = patt_se se1 in - let p2 = patt_se se2 in - <:patt< $p1$ . $p2$ >> - | Slid loc "_" -> <:patt< _ >> - | Slid loc s -> <:patt< $lid:(Pcaml.rename_id.val s)$ >> - | Suid loc s -> <:patt< $uid:(Pcaml.rename_id.val s)$ >> - | Sint loc s -> <:patt< $int:s$ >> - | Sfloat loc s -> <:patt< $flo:s$ >> - | Schar loc s -> <:patt< $chr:s$ >> - | Sstring loc s -> <:patt< $str:s$ >> - | Stid loc _ -> error_loc loc "patt" - | Sqid loc _ -> error_loc loc "patt" - | Srec loc sel -> - let lpl = List.map (label_patt_se loc) sel in - <:patt< { $list:lpl$ } >> - | Sexpr loc [Slid _ ":"; se1; se2] -> - let p = patt_se se1 in - let t = ctyp_se se2 in - <:patt< ($p$ : $t$) >> - | Sexpr loc [Slid _ "or"; se :: sel] -> - List.fold_left - (fun p se -> - let p1 = patt_se se in - <:patt< $p$ | $p1$ >>) - (patt_se se) sel - | Sexpr loc [Slid _ "range"; se1; se2] -> - let p1 = patt_se se1 in - let p2 = patt_se se2 in - <:patt< $p1$ .. $p2$ >> - | Sexpr loc [Slid _ "values" :: sel] -> - let pl = List.map patt_se sel in - <:patt< ( $list:pl$ ) >> - | Sexpr loc [Slid _ "as"; se1; se2] -> - let p1 = patt_se se1 in - let p2 = patt_se se2 in - <:patt< ($p1$ as $p2$) >> - | Sexpr loc [se :: sel] -> - List.fold_left - (fun p se -> - let p1 = patt_se se in - <:patt< $p$ $p1$ >>) - (patt_se se) sel - | Sexpr loc [] -> <:patt< () >> - | Slist loc sel -> - let rec loop = - fun - [ [] -> <:patt< [] >> - | [se1; Slid _ "."; se2] -> - let p = patt_se se1 in - let pl = patt_se se2 in - <:patt< [$p$ :: $pl$] >> - | [se :: sel] -> - let p = patt_se se in - let pl = loop sel in - <:patt< [$p$ :: $pl$] >> ] - in - loop sel - | Squot loc typ txt -> Pcaml.handle_patt_quotation loc (typ, txt) ] -and ipatt_se se = - match ipatt_opt_se se with - [ Left p -> p - | Right (se, _) -> error se "ipatt" ] -and ipatt_opt_se = - fun - [ Slid loc "_" -> Left <:patt< _ >> - | Slid loc s -> Left <:patt< $lid:(Pcaml.rename_id.val s)$ >> - | Stid loc s -> Left <:patt< ~ $(Pcaml.rename_id.val s)$ >> - | Sqid loc s -> Left <:patt< ? $(Pcaml.rename_id.val s)$ >> - | Sexpr loc [Sqid _ s; se] -> - let s = Pcaml.rename_id.val s in - let e = expr_se se in - Left <:patt< ? ( $lid:s$ = $e$ ) >> - | Sexpr loc [Slid _ ":"; se1; se2] -> - let p = ipatt_se se1 in - let t = ctyp_se se2 in - Left <:patt< ($p$ : $t$) >> - | Sexpr loc [Slid _ "values" :: sel] -> - let pl = List.map ipatt_se sel in - Left <:patt< ( $list:pl$ ) >> - | Sexpr loc [] -> Left <:patt< () >> - | Sexpr loc [se :: sel] -> Right (se, sel) - | se -> error se "ipatt" ] -and type_declaration_list_se = - fun - [ [se1; se2 :: sel] -> - let (n1, loc1, tpl) = - match se1 with - [ Sexpr _ [Slid loc n :: sel] -> - (n, loc, List.map type_parameter_se sel) - | Slid loc n -> (n, loc, []) - | se -> error se "type declaration" ] - in - [((loc1, Pcaml.rename_id.val n1), tpl, ctyp_se se2, []) :: - type_declaration_list_se sel] - | [] -> [] - | [se :: _] -> error se "type_declaration" ] -and type_parameter_se = - fun - [ Slid _ s when String.length s >= 2 && s.[0] = ''' -> - (String.sub s 1 (String.length s - 1), (False, False)) - | se -> error se "type_parameter" ] -and ctyp_se = - fun - [ Sexpr loc [Slid _ "sum" :: sel] -> - let cdl = List.map constructor_declaration_se sel in - <:ctyp< [ $list:cdl$ ] >> - | Srec loc sel -> - let ldl = List.map label_declaration_se sel in - <:ctyp< { $list:ldl$ } >> - | Sexpr loc [Slid _ "->" :: ([_; _ :: _] as sel)] -> - let rec loop = - fun - [ [] -> assert False - | [se] -> ctyp_se se - | [se :: sel] -> - let t1 = ctyp_se se in - let loc = (fst (loc_of_sexpr se), snd loc) in - let t2 = loop sel in - <:ctyp< $t1$ -> $t2$ >> ] - in - loop sel - | Sexpr loc [Slid _ "*" :: sel] -> - let tl = List.map ctyp_se sel in - <:ctyp< ($list:tl$) >> - | Sexpr loc [se :: sel] -> - List.fold_left - (fun t se -> - let t2 = ctyp_se se in - <:ctyp< $t$ $t2$ >>) - (ctyp_se se) sel - | Sacc loc se1 se2 -> - let t1 = ctyp_se se1 in - let t2 = ctyp_se se2 in - <:ctyp< $t1$ . $t2$ >> - | Slid loc "_" -> <:ctyp< _ >> - | Slid loc s -> - if s.[0] = ''' then - let s = String.sub s 1 (String.length s - 1) in - <:ctyp< '$s$ >> - else <:ctyp< $lid:(Pcaml.rename_id.val s)$ >> - | Suid loc s -> <:ctyp< $uid:(Pcaml.rename_id.val s)$ >> - | se -> error se "ctyp" ] -and constructor_declaration_se = - fun - [ Sexpr loc [Suid _ ci :: sel] -> - (loc, Pcaml.rename_id.val ci, List.map ctyp_se sel) - | se -> error se "constructor_declaration" ] -and label_declaration_se = - fun - [ Sexpr loc [Slid _ lab; Slid _ "mutable"; se] -> - (loc, Pcaml.rename_id.val lab, True, ctyp_se se) - | Sexpr loc [Slid _ lab; se] -> - (loc, Pcaml.rename_id.val lab, False, ctyp_se se) - | se -> error se "label_declaration" ] -; - -value directive_se = - fun - [ Sexpr _ [Slid _ s] -> (s, None) - | Sexpr _ [Slid _ s; se] -> - let e = expr_se se in - (s, Some e) - | se -> error se "directive" ] -; - -(* Parser *) - -Pcaml.syntax_name.val := "Scheme"; -Pcaml.no_constructors_arity.val := False; - -do { - Grammar.Unsafe.gram_reinit gram (lexer_gmake ()); - Grammar.Unsafe.clear_entry interf; - Grammar.Unsafe.clear_entry implem; - Grammar.Unsafe.clear_entry top_phrase; - Grammar.Unsafe.clear_entry use_file; - Grammar.Unsafe.clear_entry module_type; - Grammar.Unsafe.clear_entry module_expr; - Grammar.Unsafe.clear_entry sig_item; - Grammar.Unsafe.clear_entry str_item; - Grammar.Unsafe.clear_entry expr; - Grammar.Unsafe.clear_entry patt; - Grammar.Unsafe.clear_entry ctyp; - Grammar.Unsafe.clear_entry let_binding; - Grammar.Unsafe.clear_entry type_declaration; - Grammar.Unsafe.clear_entry class_type; - Grammar.Unsafe.clear_entry class_expr; - Grammar.Unsafe.clear_entry class_sig_item; - Grammar.Unsafe.clear_entry class_str_item -}; - -Pcaml.parse_interf.val := Grammar.Entry.parse interf; -Pcaml.parse_implem.val := Grammar.Entry.parse implem; - -value sexpr = Grammar.Entry.create gram "sexpr"; - -value rec leftify = - fun - [ Sacc loc1 se1 se2 -> - match leftify se2 with - [ Sacc loc2 se2 se3 -> Sacc loc1 (Sacc loc2 se1 se2) se3 - | se2 -> Sacc loc1 se1 se2 ] - | x -> x ] -; - -EXTEND - GLOBAL: implem interf top_phrase use_file str_item sig_item expr patt sexpr; - implem: - [ [ "#"; se = sexpr -> - let (n, dp) = directive_se se in - ([(<:str_item< # $n$ $opt:dp$ >>, loc)], True) - | si = str_item; x = SELF -> - let (sil, stopped) = x in - let loc = MLast.loc_of_str_item si in - ([(si, loc) :: sil], stopped) - | EOI -> ([], False) ] ] - ; - interf: - [ [ "#"; se = sexpr -> - let (n, dp) = directive_se se in - ([(<:sig_item< # $n$ $opt:dp$ >>, loc)], True) - | si = sig_item; x = SELF -> - let (sil, stopped) = x in - let loc = MLast.loc_of_sig_item si in - ([(si, loc) :: sil], stopped) - | EOI -> ([], False) ] ] - ; - top_phrase: - [ [ "#"; se = sexpr -> - let (n, dp) = directive_se se in - Some <:str_item< # $n$ $opt:dp$ >> - | se = sexpr -> Some (str_item_se se) - | EOI -> None ] ] - ; - use_file: - [ [ "#"; se = sexpr -> - let (n, dp) = directive_se se in - ([<:str_item< # $n$ $opt:dp$ >>], True) - | si = str_item; x = SELF -> - let (sil, stopped) = x in - ([si :: sil], stopped) - | EOI -> ([], False) ] ] - ; - str_item: - [ [ se = sexpr -> str_item_se se - | e = expr -> <:str_item< $exp:e$ >> ] ] - ; - sig_item: - [ [ se = sexpr -> sig_item_se se ] ] - ; - expr: - [ "top" - [ se = sexpr -> expr_se se ] ] - ; - patt: - [ [ se = sexpr -> patt_se se ] ] - ; - sexpr: - [ [ se1 = sexpr_dot; se2 = SELF -> leftify (Sacc loc se1 se2) ] - | [ "("; sl = LIST0 sexpr; ")" -> Sexpr loc sl - | "("; sl = LIST0 sexpr; ")."; se = SELF -> - leftify (Sacc loc (Sexpr loc sl) se) - | "["; sl = LIST0 sexpr; "]" -> Slist loc sl - | "{"; sl = LIST0 sexpr; "}" -> Srec loc sl - | a = pa_extend_keyword -> Slid loc a - | s = LIDENT -> Slid loc s - | s = UIDENT -> Suid loc s - | s = TILDEIDENT -> Stid loc s - | s = QUESTIONIDENT -> Sqid loc s - | s = INT -> Sint loc s - | s = FLOAT -> Sfloat loc s - | s = CHAR -> Schar loc s - | s = STRING -> Sstring loc s - | s = QUOT -> - let i = String.index s ':' in - let typ = String.sub s 0 i in - let txt = String.sub s (i + 1) (String.length s - i - 1) in - Squot loc typ txt ] ] - ; - sexpr_dot: - [ [ s = LIDENTDOT -> Slid loc s - | s = UIDENTDOT -> Suid loc s ] ] - ; - pa_extend_keyword: - [ [ "_" -> "_" - | "," -> "," - | "=" -> "=" - | ":" -> ":" - | "." -> "." - | "/" -> "/" ] ] - ; -END; diff -Nru ocaml-3.12.1/camlp4/unmaintained/scheme/pa_scheme.sc ocaml-4.01.0/camlp4/unmaintained/scheme/pa_scheme.sc --- ocaml-3.12.1/camlp4/unmaintained/scheme/pa_scheme.sc 2008-10-27 14:03:57.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/scheme/pa_scheme.sc 1970-01-01 00:00:00.000000000 +0000 @@ -1,1029 +0,0 @@ -; pa_r.cmo pa_rp.cmo pa_extend.cmo q_MLast.cmo pr_dump.cmo -; ********************************************************************** -; -; Camlp4 -; -; Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt -; -; Copyright 2002 Institut National de Recherche en Informatique et -; en Automatique. All rights reserved. This file is distributed -; under the terms of the GNU Library General Public License, with -; the special exception on linking described in file -; ../../../LICENSE. -; -; ********************************************************************** - -(open Pcaml) -(open Stdpp) - -(type (choice 'a 'b) (sum (Left 'a) (Right 'b))) - -; Buffer - -(module Buff - (struct - (define buff (ref (String.create 80))) - (define (store len x) - (if (>= len (String.length buff.val)) - (:= buff.val (^ buff.val (String.create (String.length buff.val))))) - (:= buff.val.[len] x) - (succ len)) - (define (get len) (String.sub buff.val 0 len)))) - -; Lexer - -(definerec skip_to_eol - (parser - (((` (or '\n' '\r'))) ()) - (((` _) s) (skip_to_eol s)))) - -(define no_ident ['(' ')' '[' ']' '{' '}' ' ' '\t' '\n' '\r' ';']) - -(definerec (ident len) - (parser - (((` '.')) (values (Buff.get len) True)) - (((` x (not (List.mem x no_ident))) s) (ident (Buff.store len x) s)) - (() (values (Buff.get len) False)))) - -(define (identifier kwt (values s dot)) - (let ((con - (try (begin (: (Hashtbl.find kwt s) unit) "") - (Not_found - (match s.[0] - ((range 'A' 'Z') (if dot "UIDENTDOT" "UIDENT")) - (_ (if dot "LIDENTDOT" "LIDENT"))))))) - (values con s))) - -(definerec (string len) - (parser - (((` '"')) (Buff.get len)) - (((` '\\') (` c) s) (string (Buff.store (Buff.store len '\\') c) s)) - (((` x) s) (string (Buff.store len x) s)))) - -(definerec (end_exponent_part_under len) - (parser - (((` (as (range '0' '9') c)) s) - (end_exponent_part_under (Buff.store len c) s)) - (() (values "FLOAT" (Buff.get len))))) - -(define (end_exponent_part len) - (parser - (((` (as (range '0' '9') c)) s) - (end_exponent_part_under (Buff.store len c) s)) - (() (raise (Stream.Error "ill-formed floating-point constant"))))) - -(define (exponent_part len) - (parser - (((` (as (or '+' '-') c)) s) (end_exponent_part (Buff.store len c) s)) - (((a (end_exponent_part len))) a))) - -(definerec (decimal_part len) - (parser - (((` (as (range '0' '9') c)) s) (decimal_part (Buff.store len c) s)) - (((` (or 'e' 'E')) s) (exponent_part (Buff.store len 'E') s)) - (() (values "FLOAT" (Buff.get len))))) - -(definerec (number len) - (parser - (((` (as (range '0' '9') c)) s) (number (Buff.store len c) s)) - (((` '.') s) (decimal_part (Buff.store len '.') s)) - (((` (or 'e' 'E')) s) (exponent_part (Buff.store len 'E') s)) - (() (values "INT" (Buff.get len))))) - -(define binary - (parser - (((` (as (range '0' '1') c))) c))) - -(define octal - (parser - (((` (as (range '0' '7') c))) c))) - -(define hexa - (parser - (((` (as (or (range '0' '9') (range 'a' 'f') (range 'A' 'F')) c))) c))) - -(definerec (digits_under kind len) - (parser - (((d kind) s) (digits_under kind (Buff.store len d) s)) - (() (Buff.get len)))) - -(define (digits kind bp len) - (parser - (((d kind) s) (values "INT" (digits_under kind (Buff.store len d) s))) - ((s) ep - (raise_with_loc (values - (Reloc.shift_pos bp Reloc.zero_loc) - (Reloc.shift_pos ep Reloc.zero_loc)) - (Failure "ill-formed integer constant"))))) - -(define (base_number kwt bp len) - (parser - (((` (or 'b' 'B')) s) (digits binary bp (Buff.store len 'b') s)) - (((` (or 'o' 'O')) s) (digits octal bp (Buff.store len 'o') s)) - (((` (or 'x' 'X')) s) (digits hexa bp (Buff.store len 'x') s)) - (((id (ident (Buff.store 0 '#')))) (identifier kwt id)))) - -(definerec (operator len) - (parser - (((` '.')) (Buff.get (Buff.store len '.'))) - (() (Buff.get len)))) - -(define (char_or_quote_id x) - (parser - (((` ''')) (values "CHAR" (String.make 1 x))) - ((s) ep - (if (List.mem x no_ident) - (Stdpp.raise_with_loc (values - (Reloc.shift_pos (- ep 2) Reloc.zero_loc) - (Reloc.shift_pos (- ep 1) Reloc.zero_loc)) - (Stream.Error "bad quote")) - (let* ((len (Buff.store (Buff.store 0 ''') x)) - ((values s dot) (ident len s))) - (values (if dot "LIDENTDOT" "LIDENT") s)))))) - -(definerec (char len) - (parser - (((` ''')) len) - (((` x) s) (char (Buff.store len x) s)))) - -(define quote - (parser - (((` '\\') (len (char (Buff.store 0 '\\')))) - (values "CHAR" (Buff.get len))) - (((` x) s) (char_or_quote_id x s)))) - -; The system with LIDENTDOT and UIDENTDOT is not great (it would be -; better to have a token DOT (actually SPACEDOT and DOT)) but it is -; the only way (that I have found) to have a good behaviour in the -; toplevel (not expecting tokens after a phrase). Drawbacks: 1/ to be -; complete, we should have STRINGDOT, RIGHTPARENDOT, and so on 2/ the -; parser rule with dot is right associative and we have to reverse -; the resulting tree (using the function leftify). -; This is a complicated issue: the behaviour of the OCaml toplevel -; is strange, anyway. For example, even without Camlp4, The OCaml -; toplevel accepts that: -; # let x = 32;; foo bar match let ) - -(definerec* - ((lexer kwt) - (parser - (((t (lexer0 kwt)) - (_ no_dot)) t))) - (no_dot - (parser - (((` '.')) ep - (Stdpp.raise_with_loc (values - (Reloc.shift_pos (- ep 1) Reloc.zero_loc) - (Reloc.shift_pos ep Reloc.zero_loc)) - (Stream.Error "bad dot"))) - (() ()))) - ((lexer0 kwt) - (parser bp - (((` (or '\t' '\n' '\r')) s) (lexer0 kwt s)) - (((` ' ') s) (after_space kwt s)) - (((` ';') (_ skip_to_eol) s) (lexer kwt s)) - (((` '(')) (values (values "" "(") (values bp (+ bp 1)))) - (((` ')') s) ep (values (values "" (rparen s)) (values bp ep))) - (((` '[')) (values (values "" "[") (values bp (+ bp 1)))) - (((` ']')) (values (values "" "]") (values bp (+ bp 1)))) - (((` '{')) (values (values "" "{") (values bp (+ bp 1)))) - (((` '}')) (values (values "" "}") (values bp (+ bp 1)))) - (((` '"') (s (string 0))) ep - (values (values "STRING" s) (values bp ep))) - (((` ''') (tok quote)) ep (values tok (values bp ep))) - (((` '<') (tok (less kwt))) ep (values tok (values bp ep))) - (((` '-') (tok (minus kwt))) ep (values tok (values bp ep))) - (((` '~') (tok tilde)) ep (values tok (values bp ep))) - (((` '?') (tok question)) ep (values tok (values bp ep))) - (((` '#') (tok (base_number kwt bp (Buff.store 0 '0')))) ep - (values tok (values bp ep))) - (((` (as (range '0' '9') c)) (tok (number (Buff.store 0 c)))) ep - (values tok (values bp ep))) - (((` (as (or '+' '*' '/') c)) (id (operator (Buff.store 0 c)))) ep - (values (identifier kwt (values id False)) (values bp ep))) - (((` x) (id (ident (Buff.store 0 x)))) ep - (values (identifier kwt id) (values bp ep))) - (() (values (values "EOI" "") (values bp (+ bp 1)))))) - (rparen - (parser - (((` '.')) ").") - ((_) ")"))) - ((after_space kwt) - (parser - (((` '.')) ep (values (values "" ".") (values (- ep 1) ep))) - (((x (lexer0 kwt))) x))) - (tilde - (parser - (((` (as (range 'a' 'z') c)) ((values s dot) (ident (Buff.store 0 c)))) - (values "TILDEIDENT" s)) - (() (values "LIDENT" "~")))) - (question - (parser - (((` (as (range 'a' 'z') c)) ((values s dot) (ident (Buff.store 0 c)))) - (values "QUESTIONIDENT" s)) - (() (values "LIDENT" "?")))) - ((minus kwt) - (parser - (((` '.')) (identifier kwt (values "-." False))) - (((` (as (range '0' '9') c)) - (n (number (Buff.store (Buff.store 0 '-') c)))) ep n) - (((id (ident (Buff.store 0 '-')))) (identifier kwt id)))) - ((less kwt) - (parser - (((` ':') (lab (label 0)) (? (` '<') "'<' expected") (q (quotation 0))) - (values "QUOT" (^ lab ":" q))) - (((id (ident (Buff.store 0 '<')))) (identifier kwt id)))) - ((label len) - (parser - (((` (as (or (range 'a' 'z') (range 'A' 'Z') '_') c)) s) - (label (Buff.store len c) s)) - (() (Buff.get len)))) - ((quotation len) - (parser - (((` '>') s) (quotation_greater len s)) - (((` x) s) (quotation (Buff.store len x) s)) - (() (failwith "quotation not terminated")))) - ((quotation_greater len) - (parser - (((` '>')) (Buff.get len)) - (((a (quotation (Buff.store len '>')))) a)))) - -(define (lexer_using kwt (values con prm)) - (match con - ((or "CHAR" "EOI" "INT" "FLOAT" "LIDENT" "LIDENTDOT" "QUESTIONIDENT" - "QUOT" "STRING" "TILDEIDENT" "UIDENT" "UIDENTDOT") - ()) - ("ANTIQUOT" ()) - ("" (try (Hashtbl.find kwt prm) (Not_found (Hashtbl.add kwt prm ())))) - (_ - (raise - (Token.Error - (^ "the constructor \"" con "\" is not recognized by Plexer")))))) - -(define (lexer_text (values con prm)) - (cond - ((= con "") (^ "'"prm "'")) - ((= prm "") con) - (else (^ con " \"" prm "\"")))) - -(define (lexer_gmake ()) - (let ((kwt (Hashtbl.create 89))) - {(Token.tok_func - (Token.lexer_func_of_parser - (lambda (s) - (let (((values r (values bp ep)) (lexer kwt s))) - (values r (values (Reloc.shift_pos bp Reloc.zero_loc) - (Reloc.shift_pos ep Reloc.zero_loc))))))) - (Token.tok_using (lexer_using kwt)) - (Token.tok_removing (lambda)) - (Token.tok_match Token.default_match) - (Token.tok_text lexer_text) - (Token.tok_comm None)})) - -; Building AST - -(type sexpr - (sum - (Sacc MLast.loc sexpr sexpr) - (Schar MLast.loc string) - (Sexpr MLast.loc (list sexpr)) - (Sint MLast.loc string) - (Sfloat MLast.loc string) - (Slid MLast.loc string) - (Slist MLast.loc (list sexpr)) - (Sqid MLast.loc string) - (Squot MLast.loc string string) - (Srec MLast.loc (list sexpr)) - (Sstring MLast.loc string) - (Stid MLast.loc string) - (Suid MLast.loc string))) - -(define loc_of_sexpr - (lambda_match - ((or (Sacc loc _ _) (Schar loc _) (Sexpr loc _) (Sint loc _) - (Sfloat loc _) (Slid loc _) (Slist loc _) (Sqid loc _) (Squot loc _ _) - (Srec loc _) (Sstring loc _) (Stid loc _) (Suid loc _)) - loc))) -(define (error_loc loc err) - (raise_with_loc loc (Stream.Error (^ err " expected")))) -(define (error se err) (error_loc (loc_of_sexpr se) err)) - -(define strm_n "strm__") -(define (peek_fun loc) <:expr< Stream.peek >>) -(define (junk_fun loc) <:expr< Stream.junk >>) - -(define assoc_left_parsed_op_list ["+" "*" "+." "*." "land" "lor" "lxor"]) -(define assoc_right_parsed_op_list ["and" "or" "^" "@"]) -(define and_by_couple_op_list ["=" "<>" "<" ">" "<=" ">=" "==" "!="]) - -(define (op_apply loc e1 e2) - (lambda_match - ("and" <:expr< $e1$ && $e2$ >>) - ("or" <:expr< $e1$ || $e2$ >>) - (x <:expr< $lid:x$ $e1$ $e2$ >>))) - -(define string_se - (lambda_match - ((Sstring loc s) s) - (se (error se "string")))) - -(define mod_ident_se - (lambda_match - ((Suid _ s) [(Pcaml.rename_id.val s)]) - ((Slid _ s) [(Pcaml.rename_id.val s)]) - (se (error se "mod_ident")))) - -(define (lident_expr loc s) - (if (&& (> (String.length s) 1) (= s.[0] '`')) - (let ((s (String.sub s 1 (- (String.length s) 1)))) - <:expr< ` $s$ >>) - <:expr< $lid:(Pcaml.rename_id.val s)$ >>)) - -(definerec* - (module_expr_se - (lambda_match - ((Sexpr loc [(Slid _ "functor") (Suid _ s) se1 se2]) - (let* ((s (Pcaml.rename_id.val s)) - (mt (module_type_se se1)) - (me (module_expr_se se2))) - <:module_expr< functor ($s$ : $mt$) -> $me$ >>)) - ((Sexpr loc [(Slid _ "struct") . sl]) - (let ((mel (List.map str_item_se sl))) - <:module_expr< struct $list:mel$ end >>)) - ((Sexpr loc [se1 se2]) - (let* ((me1 (module_expr_se se1)) - (me2 (module_expr_se se2))) - <:module_expr< $me1$ $me2$ >>)) - ((Suid loc s) <:module_expr< $uid:(Pcaml.rename_id.val s)$ >>) - (se (error se "module expr")))) - (module_type_se - (lambda_match - ((Sexpr loc [(Slid _ "functor") (Suid _ s) se1 se2]) - (let* ((s (Pcaml.rename_id.val s)) - (mt1 (module_type_se se1)) - (mt2 (module_type_se se2))) - <:module_type< functor ($s$ : $mt1$) -> $mt2$ >>)) - ((Sexpr loc [(Slid _ "sig") . sel]) - (let ((sil (List.map sig_item_se sel))) - <:module_type< sig $list:sil$ end >>)) - ((Sexpr loc [(Slid _ "with") se (Sexpr _ sel)]) - (let* ((mt (module_type_se se)) - (wcl (List.map with_constr_se sel))) - <:module_type< $mt$ with $list:wcl$ >>)) - ((Suid loc s) <:module_type< $uid:(Pcaml.rename_id.val s)$ >>) - (se (error se "module type")))) - (with_constr_se - (lambda_match - ((Sexpr loc [(Slid _ "type") se1 se2]) - (let* ((tn (mod_ident_se se1)) - (te (ctyp_se se2))) - (MLast.WcTyp loc tn [] te))) - (se (error se "with constr")))) - (sig_item_se - (lambda_match - ((Sexpr loc [(Slid _ "type") . sel]) - (let ((tdl (type_declaration_list_se sel))) - <:sig_item< type $list:tdl$ >>)) - ((Sexpr loc [(Slid _ "exception") (Suid _ c) . sel]) - (let* ((c (Pcaml.rename_id.val c)) - (tl (List.map ctyp_se sel))) - <:sig_item< exception $c$ of $list:tl$ >>)) - ((Sexpr loc [(Slid _ "value") (Slid _ s) se]) - (let* ((s (Pcaml.rename_id.val s)) - (t (ctyp_se se))) - <:sig_item< value $s$ : $t$ >>)) - ((Sexpr loc [(Slid _ "external") (Slid _ i) se . sel]) - (let* ((i (Pcaml.rename_id.val i)) - (pd (List.map string_se sel)) - (t (ctyp_se se))) - <:sig_item< external $i$ : $t$ = $list:pd$ >>)) - ((Sexpr loc [(Slid _ "module") (Suid _ s) se]) - (let* ((s (Pcaml.rename_id.val s)) - (mb (module_type_se se))) - <:sig_item< module $s$ : $mb$ >>)) - ((Sexpr loc [(Slid _ "moduletype") (Suid _ s) se]) - (let* ((s (Pcaml.rename_id.val s)) - (mt (module_type_se se))) - <:sig_item< module type $s$ = $mt$ >>)) - (se (error se "sig item")))) - ((str_item_se se) - (match se - ((Sexpr loc [(Slid _ "open") se]) - (let ((s (mod_ident_se se))) <:str_item< open $s$ >>)) - ((Sexpr loc [(Slid _ "type") . sel]) - (let ((tdl (type_declaration_list_se sel))) - <:str_item< type $list:tdl$ >>)) - ((Sexpr loc [(Slid _ "exception") (Suid _ c) . sel]) - (let* ((c (Pcaml.rename_id.val c)) - (tl (List.map ctyp_se sel))) - <:str_item< exception $c$ of $list:tl$ >>)) - ((Sexpr loc [(Slid _ (as (or "define" "definerec") r)) se . sel]) - (let* ((r (= r "definerec")) - ((values p e) (fun_binding_se se (begin_se loc sel)))) - <:str_item< value $opt:r$ $p$ = $e$ >>)) - ((Sexpr loc [(Slid _ (as (or "define*" "definerec*") r)) . sel]) - (let* ((r (= r "definerec*")) - (lbs (List.map let_binding_se sel))) - <:str_item< value $opt:r$ $list:lbs$ >>)) - ((Sexpr loc [(Slid _ "external") (Slid _ i) se . sel]) - (let* ((i (Pcaml.rename_id.val i)) - (pd (List.map string_se sel)) - (t (ctyp_se se))) - <:str_item< external $i$ : $t$ = $list:pd$ >>)) - ((Sexpr loc [(Slid _ "module") (Suid _ i) se]) - (let* ((i (Pcaml.rename_id.val i)) - (mb (module_binding_se se))) - <:str_item< module $i$ = $mb$ >>)) - ((Sexpr loc [(Slid _ "moduletype") (Suid _ s) se]) - (let* ((s (Pcaml.rename_id.val s)) - (mt (module_type_se se))) - <:str_item< module type $s$ = $mt$ >>)) - (_ - (let* ((loc (loc_of_sexpr se)) - (e (expr_se se))) - <:str_item< $exp:e$ >>)))) - ((module_binding_se se) (module_expr_se se)) - (expr_se - (lambda_match - ((Sacc loc se1 se2) - (let ((e1 (expr_se se1))) - (match se2 - ((Slist loc [se2]) - (let ((e2 (expr_se se2))) <:expr< $e1$ .[ $e2$ ] >>)) - ((Sexpr loc [se2]) - (let ((e2 (expr_se se2))) <:expr< $e1$ .( $e2$ ) >>)) - (_ (let ((e2 (expr_se se2))) <:expr< $e1$ . $e2$ >>))))) - ((Slid loc s) (lident_expr loc s)) - ((Suid loc s) <:expr< $uid:(Pcaml.rename_id.val s)$ >>) - ((Sint loc s) <:expr< $int:s$ >>) - ((Sfloat loc s) <:expr< $flo:s$ >>) - ((Schar loc s) <:expr< $chr:s$ >>) - ((Sstring loc s) <:expr< $str:s$ >>) - ((Stid loc s) <:expr< ~ $(Pcaml.rename_id.val s)$ >>) - ((Sqid loc s) <:expr< ? $(Pcaml.rename_id.val s)$ >>) - ((Sexpr loc []) <:expr< () >>) - ((when (Sexpr loc [(Slid _ s) e1 . (as [_ . _] sel)]) - (List.mem s assoc_left_parsed_op_list)) - (letrec - (((loop e1) - (lambda_match - ([] e1) - ([e2 . el] (loop (op_apply loc e1 e2 s) el))))) - (loop (expr_se e1) (List.map expr_se sel)))) - ((when (Sexpr loc [(Slid _ s) . (as [_ _ . _] sel)]) - (List.mem s assoc_right_parsed_op_list)) - (letrec - ((loop - (lambda_match - ([] - (assert False)) - ([e1] e1) - ([e1 . el] (let ((e2 (loop el))) (op_apply loc e1 e2 s)))))) - (loop (List.map expr_se sel)))) - ((when (Sexpr loc [(Slid _ s) . (as [_ _ . _] sel)]) - (List.mem s and_by_couple_op_list)) - (letrec - ((loop - (lambda_match - ((or [] [_]) (assert False)) - ([e1 e2] <:expr< $lid:s$ $e1$ $e2$ >>) - ([e1 . (as [e2 _ . _] el)] - (let* ((a1 (op_apply loc e1 e2 s)) - (a2 (loop el))) - <:expr< $a1$ && $a2$ >>))))) - (loop (List.map expr_se sel)))) - ((Sexpr loc [(Stid _ s) se]) - (let ((e (expr_se se))) <:expr< ~ $s$ : $e$ >>)) - ((Sexpr loc [(Slid _ "-") se]) - (let ((e (expr_se se))) <:expr< - $e$ >>)) - ((Sexpr loc [(Slid _ "if") se se1]) - (let* ((e (expr_se se)) - (e1 (expr_se se1))) - <:expr< if $e$ then $e1$ else () >>)) - ((Sexpr loc [(Slid _ "if") se se1 se2]) - (let* ((e (expr_se se)) - (e1 (expr_se se1)) - (e2 (expr_se se2))) - <:expr< if $e$ then $e1$ else $e2$ >>)) - ((Sexpr loc [(Slid _ "cond") . sel]) - (letrec - ((loop - (lambda_match - ([(Sexpr loc [(Slid _ "else") . sel])] (begin_se loc sel)) - ([(Sexpr loc [se1 . sel1]) . sel] - (let* ((e1 (expr_se se1)) - (e2 (begin_se loc sel1)) - (e3 (loop sel))) - <:expr< if $e1$ then $e2$ else $e3$ >>)) - ([] <:expr< () >>) - ([se . _] (error se "cond clause"))))) - (loop sel))) - ((Sexpr loc [(Slid _ "while") se . sel]) - (let* ((e (expr_se se)) - (el (List.map expr_se sel))) - <:expr< while $e$ do { $list:el$ } >>)) - ((Sexpr loc [(Slid _ "for") (Slid _ i) se1 se2 . sel]) - (let* ((i (Pcaml.rename_id.val i)) - (e1 (expr_se se1)) - (e2 (expr_se se2)) - (el (List.map expr_se sel))) - <:expr< for $i$ = $e1$ to $e2$ do { $list:el$ } >>)) - ((Sexpr loc [(Slid loc1 "lambda")]) <:expr< fun [] >>) - ((Sexpr loc [(Slid loc1 "lambda") sep . sel]) - (let ((e (begin_se loc1 sel))) - (match (ipatt_opt_se sep) - ((Left p) <:expr< fun $p$ -> $e$ >>) - ((Right (values se sel)) - (List.fold_right - (lambda (se e) - (let ((p (ipatt_se se))) <:expr< fun $p$ -> $e$ >>)) - [se . sel] e))))) - ((Sexpr loc [(Slid _ "lambda_match") . sel]) - (let ((pel (List.map (match_case loc) sel))) - <:expr< fun [ $list:pel$ ] >>)) - ((Sexpr loc [(Slid _ (as (or "let" "letrec") r)) . sel]) - (match sel - ([(Sexpr _ sel1) . sel2] - (let* ((r (= r "letrec")) - (lbs (List.map let_binding_se sel1)) - (e (begin_se loc sel2))) - <:expr< let $opt:r$ $list:lbs$ in $e$ >>)) - ([(Slid _ n) (Sexpr _ sl) . sel] - (let* ((n (Pcaml.rename_id.val n)) - ((values pl el) - (List.fold_right - (lambda (se (values pl el)) - (match se - ((Sexpr _ [se1 se2]) - (values [(patt_se se1) . pl] - [(expr_se se2) . el])) - (se (error se "named let")))) - sl (values [] []))) - (e1 - (List.fold_right - (lambda (p e) <:expr< fun $p$ -> $e$ >>) - pl (begin_se loc sel))) - (e2 - (List.fold_left - (lambda (e1 e2) <:expr< $e1$ $e2$ >>) - <:expr< $lid:n$ >> el))) - <:expr< let rec $lid:n$ = $e1$ in $e2$ >>)) - ([se . _] (error se "let_binding")) - (_ (error_loc loc "let_binding")))) - ((Sexpr loc [(Slid _ "let*") . sel]) - (match sel - ([(Sexpr _ sel1) . sel2] - (List.fold_right - (lambda (se ek) - (let (((values p e) (let_binding_se se))) - <:expr< let $p$ = $e$ in $ek$ >>)) - sel1 (begin_se loc sel2))) - ([se . _] (error se "let_binding")) - (_ (error_loc loc "let_binding")))) - ((Sexpr loc [(Slid _ "match") se . sel]) - (let* ((e (expr_se se)) - (pel (List.map (match_case loc) sel))) - <:expr< match $e$ with [ $list:pel$ ] >>)) - ((Sexpr loc [(Slid _ "parser") . sel]) - (let ((e - (match sel - ([(as (Slid _ _) se) . sel] - (let* ((p (patt_se se)) - (pc (parser_cases_se loc sel))) - <:expr< let $p$ = Stream.count $lid:strm_n$ in $pc$ >>)) - (_ (parser_cases_se loc sel))))) - <:expr< fun ($lid:strm_n$ : Stream.t _) -> $e$ >>)) - ((Sexpr loc [(Slid _ "match_with_parser") se . sel]) - (let* ((me (expr_se se)) - ((values bpo sel) - (match sel - ([(as (Slid _ _) se) . sel] (values (Some (patt_se se)) sel)) - (_ (values None sel)))) - (pc (parser_cases_se loc sel)) - (e - (match bpo - ((Some bp) - <:expr< let $bp$ = Stream.count $lid:strm_n$ in $pc$ >>) - (None pc)))) - (match me - ((when <:expr< $lid:x$ >> (= x strm_n)) e) - (_ <:expr< let ($lid:strm_n$ : Stream.t _) = $me$ in $e$ >>)))) - ((Sexpr loc [(Slid _ "try") se . sel]) - (let* ((e (expr_se se)) - (pel (List.map (match_case loc) sel))) - <:expr< try $e$ with [ $list:pel$ ] >>)) - ((Sexpr loc [(Slid _ "begin") . sel]) - (let ((el (List.map expr_se sel))) <:expr< do { $list:el$ } >>)) - ((Sexpr loc [(Slid _ ":=") se1 se2]) - (let* ((e1 (expr_se se1)) - (e2 (expr_se se2))) - <:expr< $e1$ := $e2$ >>)) - ((Sexpr loc [(Slid _ "values") . sel]) - (let ((el (List.map expr_se sel))) <:expr< ( $list:el$ ) >>)) - ((Srec loc [(Slid _ "with") se . sel]) - (let* ((e (expr_se se)) - (lel (List.map (label_expr_se loc) sel))) - <:expr< { ($e$) with $list:lel$ } >>)) - ((Srec loc sel) - (let ((lel (List.map (label_expr_se loc) sel))) - <:expr< { $list:lel$ } >>)) - ((Sexpr loc [(Slid _ ":") se1 se2]) - (let* ((e (expr_se se1)) (t (ctyp_se se2))) <:expr< ( $e$ : $t$ ) >>)) - ((Sexpr loc [se]) (let ((e (expr_se se))) <:expr< $e$ () >>)) - ((Sexpr loc [(Slid _ "assert") (Suid _ "False")]) - <:expr< assert False >>) - ((Sexpr loc [(Slid _ "assert") se]) - (let ((e (expr_se se))) <:expr< assert $e$ >>)) - ((Sexpr loc [(Slid _ "lazy") se]) - (let ((e (expr_se se))) <:expr< lazy $e$ >>)) - ((Sexpr loc [se . sel]) - (List.fold_left - (lambda (e se) (let ((e1 (expr_se se))) <:expr< $e$ $e1$ >>)) - (expr_se se) sel)) - ((Slist loc sel) - (letrec ((loop - (lambda_match - ([] <:expr< [] >>) - ([se1 (Slid _ ".") se2] - (let* ((e (expr_se se1)) - (el (expr_se se2))) - <:expr< [$e$ :: $el$] >>)) - ([se . sel] - (let* ((e (expr_se se)) - (el (loop sel))) - <:expr< [$e$ :: $el$] >>))))) - (loop sel))) - ((Squot loc typ txt) - (Pcaml.handle_expr_quotation loc (values typ txt))))) - ((begin_se loc) - (lambda_match - ([] <:expr< () >>) - ([se] (expr_se se)) - ((sel) - (let* ((el (List.map expr_se sel)) - (loc (values (fst (loc_of_sexpr (List.hd sel))) (snd loc)))) - <:expr< do { $list:el$ } >>)))) - (let_binding_se - (lambda_match - ((Sexpr loc [se . sel]) - (let ((e (begin_se loc sel))) - (match (ipatt_opt_se se) - ((Left p) (values p e)) - ((Right _) (fun_binding_se se e))))) - (se (error se "let_binding")))) - ((fun_binding_se se e) - (match se - ((Sexpr _ [(Slid _ "values") . _]) (values (ipatt_se se) e)) - ((Sexpr _ [(Slid loc s) . sel]) - (let* ((s (Pcaml.rename_id.val s)) - (e - (List.fold_right - (lambda (se e) - (let* ((loc - (values (fst (loc_of_sexpr se)) - (snd (MLast.loc_of_expr e)))) - (p (ipatt_se se))) - <:expr< fun $p$ -> $e$ >>)) - sel e)) - (p <:patt< $lid:s$ >>)) - (values p e))) - ((_) (values (ipatt_se se) e)))) - ((match_case loc) - (lambda_match - ((Sexpr loc [(Sexpr _ [(Slid _ "when") se sew]) . sel]) - (values (patt_se se) (Some (expr_se sew)) (begin_se loc sel))) - ((Sexpr loc [se . sel]) - (values (patt_se se) None (begin_se loc sel))) - (se (error se "match_case")))) - ((label_expr_se loc) - (lambda_match - ((Sexpr _ [se1 se2]) (values (patt_se se1) (expr_se se2))) - (se (error se "label_expr")))) - ((label_patt_se loc) - (lambda_match - ((Sexpr _ [se1 se2]) (values (patt_se se1) (patt_se se2))) - (se (error se "label_patt")))) - ((parser_cases_se loc) - (lambda_match - ([] <:expr< raise Stream.Failure >>) - ([(Sexpr loc [(Sexpr _ spsel) . act]) . sel] - (let* ((ekont (lambda _ (parser_cases_se loc sel))) - (act (match act - ([se] (expr_se se)) - ([sep se] - (let* ((p (patt_se sep)) - (e (expr_se se))) - <:expr< let $p$ = Stream.count $lid:strm_n$ in $e$ >>)) - (_ (error_loc loc "parser_case"))))) - (stream_pattern_se loc act ekont spsel))) - ([se . _] - (error se "parser_case")))) - ((stream_pattern_se loc act ekont) - (lambda_match - ([] act) - ([se . sel] - (let* ((ckont (lambda err <:expr< raise (Stream.Error $err$) >>)) - (skont (stream_pattern_se loc act ckont sel))) - (stream_pattern_component skont ekont <:expr< "" >> se))))) - ((stream_pattern_component skont ekont err) - (lambda_match - ((Sexpr loc [(Slid _ "`") se . wol]) - (let* ((wo (match wol - ([se] (Some (expr_se se))) - ([] None) - (_ (error_loc loc "stream_pattern_component")))) - (e (peek_fun loc)) - (p (patt_se se)) - (j (junk_fun loc)) - (k (ekont err))) - <:expr< match $e$ $lid:strm_n$ with - [ Some $p$ $when:wo$ -> do { $j$ $lid:strm_n$ ; $skont$ } - | _ -> $k$ ] >>)) - ((Sexpr loc [se1 se2]) - (let* ((p (patt_se se1)) - (e (let ((e (expr_se se2))) - <:expr< try Some ($e$ $lid:strm_n$) with [ Stream.Failure -> None ] >>)) - (k (ekont err))) - <:expr< match $e$ with [ Some $p$ -> $skont$ | _ -> $k$ ] >>)) - ((Sexpr loc [(Slid _ "?") se1 se2]) - (stream_pattern_component skont ekont (expr_se se2) se1)) - ((Slid loc s) - (let ((s (Pcaml.rename_id.val s))) - <:expr< let $lid:s$ = $lid:strm_n$ in $skont$ >>)) - (se - (error se "stream_pattern_component")))) - (patt_se - (lambda_match - ((Sacc loc se1 se2) - (let* ((p1 (patt_se se1)) (p2 (patt_se se2))) <:patt< $p1$ . $p2$ >>)) - ((Slid loc "_") <:patt< _ >>) - ((Slid loc s) <:patt< $lid:(Pcaml.rename_id.val s)$ >>) - ((Suid loc s) <:patt< $uid:(Pcaml.rename_id.val s)$ >>) - ((Sint loc s) <:patt< $int:s$ >>) - ((Sfloat loc s) <:patt< $flo:s$ >>) - ((Schar loc s) <:patt< $chr:s$ >>) - ((Sstring loc s) <:patt< $str:s$ >>) - ((Stid loc _) (error_loc loc "patt")) - ((Sqid loc _) (error_loc loc "patt")) - ((Srec loc sel) - (let ((lpl (List.map (label_patt_se loc) sel))) - <:patt< { $list:lpl$ } >>)) - ((Sexpr loc [(Slid _ ":") se1 se2]) - (let* ((p (patt_se se1)) (t (ctyp_se se2))) <:patt< ($p$ : $t$) >>)) - ((Sexpr loc [(Slid _ "or") se . sel]) - (List.fold_left - (lambda (p se) (let ((p1 (patt_se se))) <:patt< $p$ | $p1$ >>)) - (patt_se se) sel)) - ((Sexpr loc [(Slid _ "range") se1 se2]) - (let* ((p1 (patt_se se1)) (p2 (patt_se se2))) <:patt< $p1$ .. $p2$ >>)) - ((Sexpr loc [(Slid _ "values") . sel]) - (let ((pl (List.map patt_se sel))) <:patt< ( $list:pl$ ) >>)) - ((Sexpr loc [(Slid _ "as") se1 se2]) - (let* ((p1 (patt_se se1)) - (p2 (patt_se se2))) - <:patt< ($p1$ as $p2$) >>)) - ((Sexpr loc [se . sel]) - (List.fold_left - (lambda (p se) (let ((p1 (patt_se se))) <:patt< $p$ $p1$ >>)) - (patt_se se) sel)) - ((Sexpr loc []) <:patt< () >>) - ((Slist loc sel) - (letrec ((loop - (lambda_match - ([] <:patt< [] >>) - ([se1 (Slid _ ".") se2] - (let* ((p (patt_se se1)) - (pl (patt_se se2))) - <:patt< [$p$ :: $pl$] >>)) - ([se . sel] - (let* ((p (patt_se se)) - (pl (loop sel))) - <:patt< [$p$ :: $pl$] >>))))) - (loop sel))) - ((Squot loc typ txt) - (Pcaml.handle_patt_quotation loc (values typ txt))))) - ((ipatt_se se) - (match (ipatt_opt_se se) - ((Left p) p) - ((Right (values se _)) (error se "ipatt")))) - (ipatt_opt_se - (lambda_match - ((Slid loc "_") (Left <:patt< _ >>)) - ((Slid loc s) (Left <:patt< $lid:(Pcaml.rename_id.val s)$ >>)) - ((Stid loc s) (Left <:patt< ~ $(Pcaml.rename_id.val s)$ >>)) - ((Sqid loc s) (Left <:patt< ? $(Pcaml.rename_id.val s)$ >>)) - ((Sexpr loc [(Sqid _ s) se]) - (let* ((s (Pcaml.rename_id.val s)) - (e (expr_se se))) - (Left <:patt< ? ( $lid:s$ = $e$ ) >>))) - ((Sexpr loc [(Slid _ ":") se1 se2]) - (let* ((p (ipatt_se se1)) (t (ctyp_se se2))) - (Left <:patt< ($p$ : $t$) >>))) - ((Sexpr loc [(Slid _ "values") . sel]) - (let ((pl (List.map ipatt_se sel))) (Left <:patt< ( $list:pl$ ) >>))) - ((Sexpr loc []) (Left <:patt< () >>)) - ((Sexpr loc [se . sel]) (Right (values se sel))) - (se (error se "ipatt")))) - (type_declaration_list_se - (lambda_match - ([se1 se2 . sel] - (let (((values n1 loc1 tpl) - (match se1 - ((Sexpr _ [(Slid loc n) . sel]) - (values n loc (List.map type_parameter_se sel))) - ((Slid loc n) - (values n loc [])) - ((se) - (error se "type declaration"))))) - [(values (values loc1 (Pcaml.rename_id.val n1)) tpl (ctyp_se se2) []) . - (type_declaration_list_se sel)])) - ([] []) - ([se . _] (error se "type_declaration")))) - (type_parameter_se - (lambda_match - ((when (Slid _ s) (and (>= (String.length s) 2) (= s.[0] '''))) - (values (String.sub s 1 (- (String.length s) 1)) (values False False))) - (se - (error se "type_parameter")))) - (ctyp_se - (lambda_match - ((Sexpr loc [(Slid _ "sum") . sel]) - (let ((cdl (List.map constructor_declaration_se sel))) - <:ctyp< [ $list:cdl$ ] >>)) - ((Srec loc sel) - (let ((ldl (List.map label_declaration_se sel))) - <:ctyp< { $list:ldl$ } >>)) - ((Sexpr loc [(Slid _ "->") . (as [_ _ . _] sel)]) - (letrec - ((loop - (lambda_match - ([] (assert False)) - ([se] (ctyp_se se)) - ([se . sel] - (let* ((t1 (ctyp_se se)) - (loc (values (fst (loc_of_sexpr se)) (snd loc))) - (t2 (loop sel))) - <:ctyp< $t1$ -> $t2$ >>))))) - (loop sel))) - ((Sexpr loc [(Slid _ "*") . sel]) - (let ((tl (List.map ctyp_se sel))) <:ctyp< ($list:tl$) >>)) - ((Sexpr loc [se . sel]) - (List.fold_left - (lambda (t se) (let ((t2 (ctyp_se se))) <:ctyp< $t$ $t2$ >>)) - (ctyp_se se) sel)) - ((Sacc loc se1 se2) - (let* ((t1 (ctyp_se se1)) (t2 (ctyp_se se2))) <:ctyp< $t1$ . $t2$ >>)) - ((Slid loc "_") <:ctyp< _ >>) - ((Slid loc s) - (if (= s.[0] ''') - (let ((s (String.sub s 1 (- (String.length s) 1)))) - <:ctyp< '$s$ >>) - <:ctyp< $lid:(Pcaml.rename_id.val s)$ >>)) - ((Suid loc s) <:ctyp< $uid:(Pcaml.rename_id.val s)$ >>) - (se (error se "ctyp")))) - (constructor_declaration_se - (lambda_match - ((Sexpr loc [(Suid _ ci) . sel]) - (values loc (Pcaml.rename_id.val ci) (List.map ctyp_se sel))) - (se - (error se "constructor_declaration")))) - (label_declaration_se - (lambda_match - ((Sexpr loc [(Slid _ lab) (Slid _ "mutable") se]) - (values loc (Pcaml.rename_id.val lab) True (ctyp_se se))) - ((Sexpr loc [(Slid _ lab) se]) - (values loc (Pcaml.rename_id.val lab) False (ctyp_se se))) - (se - (error se "label_declaration"))))) - -(define directive_se - (lambda_match - ((Sexpr _ [(Slid _ s)]) (values s None)) - ((Sexpr _ [(Slid _ s) se]) (let ((e (expr_se se))) (values s (Some e)))) - (se (error se "directive")))) - -; Parser - -(:= Pcaml.syntax_name.val "Scheme") -(:= Pcaml.no_constructors_arity.val False) - -(begin - (Grammar.Unsafe.gram_reinit gram (lexer_gmake ())) - (Grammar.Unsafe.clear_entry interf) - (Grammar.Unsafe.clear_entry implem) - (Grammar.Unsafe.clear_entry top_phrase) - (Grammar.Unsafe.clear_entry use_file) - (Grammar.Unsafe.clear_entry module_type) - (Grammar.Unsafe.clear_entry module_expr) - (Grammar.Unsafe.clear_entry sig_item) - (Grammar.Unsafe.clear_entry str_item) - (Grammar.Unsafe.clear_entry expr) - (Grammar.Unsafe.clear_entry patt) - (Grammar.Unsafe.clear_entry ctyp) - (Grammar.Unsafe.clear_entry let_binding) - (Grammar.Unsafe.clear_entry type_declaration) - (Grammar.Unsafe.clear_entry class_type) - (Grammar.Unsafe.clear_entry class_expr) - (Grammar.Unsafe.clear_entry class_sig_item) - (Grammar.Unsafe.clear_entry class_str_item)) - -(:= Pcaml.parse_interf.val (Grammar.Entry.parse interf)) -(:= Pcaml.parse_implem.val (Grammar.Entry.parse implem)) - -(define sexpr (Grammar.Entry.create gram "sexpr")) - -(definerec leftify - (lambda_match - ((Sacc loc1 se1 se2) - (match (leftify se2) - ((Sacc loc2 se2 se3) (Sacc loc1 (Sacc loc2 se1 se2) se3)) - (se2 (Sacc loc1 se1 se2)))) - (x x))) - -EXTEND - GLOBAL : implem interf top_phrase use_file str_item sig_item expr - patt sexpr / - implem : - [ [ "#" / se = sexpr -> - (let (((values n dp) (directive_se se))) - (values [(values <:str_item< # $n$ $opt:dp$ >> loc)] True)) - | si = str_item / x = SELF -> - (let* (((values sil stopped) x) - (loc (MLast.loc_of_str_item si))) - (values [(values si loc) . sil] stopped)) - | EOI -> (values [] False) ] ] - / - interf : - [ [ "#" / se = sexpr -> - (let (((values n dp) (directive_se se))) - (values [(values <:sig_item< # $n$ $opt:dp$ >> loc)] True)) - | si = sig_item / x = SELF -> - (let* (((values sil stopped) x) - (loc (MLast.loc_of_sig_item si))) - (values [(values si loc) . sil] stopped)) - | EOI -> (values [] False) ] ] - / - top_phrase : - [ [ "#" / se = sexpr -> - (let (((values n dp) (directive_se se))) - (Some <:str_item< # $n$ $opt:dp$ >>)) - | se = sexpr -> (Some (str_item_se se)) - | EOI -> None ] ] - / - use_file : - [ [ "#" / se = sexpr -> - (let (((values n dp) (directive_se se))) - (values [<:str_item< # $n$ $opt:dp$ >>] True)) - | si = str_item / x = SELF -> - (let (((values sil stopped) x)) (values [si . sil] stopped)) - | EOI -> (values [] False) ] ] - / - str_item : - [ [ se = sexpr -> (str_item_se se) - | e = expr -> <:str_item< $exp:e$ >> ] ] - / - sig_item : - [ [ se = sexpr -> (sig_item_se se) ] ] - / - expr : - [ "top" - [ se = sexpr -> (expr_se se) ] ] - / - patt : - [ [ se = sexpr -> (patt_se se) ] ] - / - sexpr : - [ [ se1 = sexpr_dot / se2 = sexpr -> (leftify (Sacc loc se1 se2)) ] - | [ "(" / sl = LIST0 sexpr / ")" -> (Sexpr loc sl) - | "(" / sl = LIST0 sexpr / ")." / se = sexpr -> - (leftify (Sacc loc (Sexpr loc sl) se)) - | "[" / sl = LIST0 sexpr / "]" -> (Slist loc sl) - | "{" / sl = LIST0 sexpr / "}" -> (Srec loc sl) - | a = pa_extend_keyword -> (Slid loc a) - | s = LIDENT -> (Slid loc s) - | s = UIDENT -> (Suid loc s) - | s = TILDEIDENT -> (Stid loc s) - | s = QUESTIONIDENT -> (Sqid loc s) - | s = INT -> (Sint loc s) - | s = FLOAT -> (Sfloat loc s) - | s = CHAR -> (Schar loc s) - | s = STRING -> (Sstring loc s) - | s = QUOT -> - (let* ((i (String.index s ':')) - (typ (String.sub s 0 i)) - (txt (String.sub s (+ i 1) (- (- (String.length s) i) 1)))) - (Squot loc typ txt)) ] ] - / - sexpr_dot : - [ [ s = LIDENTDOT -> (Slid loc s) - | s = UIDENTDOT -> (Suid loc s) ] ] - / - pa_extend_keyword : - [ [ "_" -> "_" - | "," -> "," - | "=" -> "=" - | ":" -> ":" - | "." -> "." - | "/" -> "/" ] ] - / -END diff -Nru ocaml-3.12.1/camlp4/unmaintained/scheme/pr_scheme.ml ocaml-4.01.0/camlp4/unmaintained/scheme/pr_scheme.ml --- ocaml-3.12.1/camlp4/unmaintained/scheme/pr_scheme.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/scheme/pr_scheme.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,826 +0,0 @@ -(* pa_r.cmo q_MLast.cmo pa_extfun.cmo pr_dump.cmo *) -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2002 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file *) -(* ../../../LICENSE. *) -(* *) -(***********************************************************************) - - -open Pcaml; -open Format; - -type printer_t 'a = - { pr_fun : mutable string -> next 'a; - pr_levels : mutable list (pr_level 'a) } -and pr_level 'a = - { pr_label : string; - pr_box : formatter -> (formatter -> unit) -> 'a -> unit; - pr_rules : mutable pr_rule 'a } -and pr_rule 'a = - Extfun.t 'a (formatter -> curr 'a -> next 'a -> string -> kont -> unit) -and curr 'a = formatter -> ('a * string * kont) -> unit -and next 'a = formatter -> ('a * string * kont) -> unit -and kont = formatter -> unit; - -value not_impl name x ppf k = - let desc = - if Obj.is_block (Obj.repr x) then - "tag = " ^ string_of_int (Obj.tag (Obj.repr x)) - else "int_val = " ^ string_of_int (Obj.magic x) - in - fprintf ppf "%t" name desc k -; - -value pr_fun name pr lab = - loop False pr.pr_levels where rec loop app = - fun - [ [] -> fun ppf (x, dg, k) -> failwith ("unable to print " ^ name) - | [lev :: levl] -> - if app || lev.pr_label = lab then - let next = loop True levl in - let rec curr ppf (x, dg, k) = - Extfun.apply lev.pr_rules x ppf curr next dg k - in - fun ppf ((x, _, _) as n) -> lev.pr_box ppf (fun ppf -> curr ppf n) x - else loop app levl ] -; - -value rec find_pr_level lab = - fun - [ [] -> failwith ("level " ^ lab ^ " not found") - | [lev :: levl] -> - if lev.pr_label = lab then lev else find_pr_level lab levl ] -; - -value pr_constr_decl = {pr_fun = fun []; pr_levels = []}; -value constr_decl ppf (x, k) = pr_constr_decl.pr_fun "top" ppf (x, "", k); -pr_constr_decl.pr_fun := pr_fun "constr_decl" pr_constr_decl; - -value pr_ctyp = {pr_fun = fun []; pr_levels = []}; -pr_ctyp.pr_fun := pr_fun "ctyp" pr_ctyp; -value ctyp ppf (x, k) = pr_ctyp.pr_fun "top" ppf (x, "", k); - -value pr_expr = {pr_fun = fun []; pr_levels = []}; -pr_expr.pr_fun := pr_fun "expr" pr_expr; -value expr ppf (x, k) = pr_expr.pr_fun "top" ppf (x, "", k); - -value pr_label_decl = {pr_fun = fun []; pr_levels = []}; -value label_decl ppf (x, k) = pr_label_decl.pr_fun "top" ppf (x, "", k); -pr_label_decl.pr_fun := pr_fun "label_decl" pr_label_decl; - -value pr_let_binding = {pr_fun = fun []; pr_levels = []}; -pr_let_binding.pr_fun := pr_fun "let_binding" pr_let_binding; -value let_binding ppf (x, k) = pr_let_binding.pr_fun "top" ppf (x, "", k); - -value pr_match_assoc = {pr_fun = fun []; pr_levels = []}; -pr_match_assoc.pr_fun := pr_fun "match_assoc" pr_match_assoc; -value match_assoc ppf (x, k) = pr_match_assoc.pr_fun "top" ppf (x, "", k); - -value pr_mod_ident = {pr_fun = fun []; pr_levels = []}; -pr_mod_ident.pr_fun := pr_fun "mod_ident" pr_mod_ident; -value mod_ident ppf (x, k) = pr_mod_ident.pr_fun "top" ppf (x, "", k); - -value pr_module_binding = {pr_fun = fun []; pr_levels = []}; -pr_module_binding.pr_fun := pr_fun "module_binding" pr_module_binding; -value module_binding ppf (x, k) = - pr_module_binding.pr_fun "top" ppf (x, "", k); - -value pr_module_expr = {pr_fun = fun []; pr_levels = []}; -pr_module_expr.pr_fun := pr_fun "module_expr" pr_module_expr; -value module_expr ppf (x, k) = pr_module_expr.pr_fun "top" ppf (x, "", k); - -value pr_module_type = {pr_fun = fun []; pr_levels = []}; -pr_module_type.pr_fun := pr_fun "module_type" pr_module_type; -value module_type ppf (x, k) = pr_module_type.pr_fun "top" ppf (x, "", k); - -value pr_patt = {pr_fun = fun []; pr_levels = []}; -pr_patt.pr_fun := pr_fun "patt" pr_patt; -value patt ppf (x, k) = pr_patt.pr_fun "top" ppf (x, "", k); - -value pr_sig_item = {pr_fun = fun []; pr_levels = []}; -pr_sig_item.pr_fun := pr_fun "sig_item" pr_sig_item; -value sig_item ppf (x, k) = pr_sig_item.pr_fun "top" ppf (x, "", k); - -value pr_str_item = {pr_fun = fun []; pr_levels = []}; -pr_str_item.pr_fun := pr_fun "str_item" pr_str_item; -value str_item ppf (x, k) = pr_str_item.pr_fun "top" ppf (x, "", k); - -value pr_type_decl = {pr_fun = fun []; pr_levels = []}; -value type_decl ppf (x, k) = pr_type_decl.pr_fun "top" ppf (x, "", k); -pr_type_decl.pr_fun := pr_fun "type_decl" pr_type_decl; - -value pr_type_params = {pr_fun = fun []; pr_levels = []}; -value type_params ppf (x, k) = pr_type_params.pr_fun "top" ppf (x, "", k); -pr_type_params.pr_fun := pr_fun "type_params" pr_type_params; - -value pr_with_constr = {pr_fun = fun []; pr_levels = []}; -value with_constr ppf (x, k) = pr_with_constr.pr_fun "top" ppf (x, "", k); -pr_with_constr.pr_fun := pr_fun "with_constr" pr_with_constr; - -(* general functions *) - -value nok ppf = (); -value ks s k ppf = fprintf ppf "%s%t" s k; - -value rec list f ppf (l, k) = - match l with - [ [] -> k ppf - | [x] -> f ppf (x, k) - | [x :: l] -> fprintf ppf "%a@ %a" f (x, nok) (list f) (l, k) ] -; - -value rec listwb b f ppf (l, k) = - match l with - [ [] -> k ppf - | [x] -> f ppf ((b, x), k) - | [x :: l] -> fprintf ppf "%a@ %a" f ((b, x), nok) (listwb "" f) (l, k) ] -; - -(* specific functions *) - -value rec is_irrefut_patt = - fun - [ <:patt< $lid:_$ >> -> True - | <:patt< () >> -> True - | <:patt< _ >> -> True - | <:patt< ($x$ as $y$) >> -> is_irrefut_patt x && is_irrefut_patt y - | <:patt< { $list:fpl$ } >> -> - List.for_all (fun (_, p) -> is_irrefut_patt p) fpl - | <:patt< ($p$ : $_$) >> -> is_irrefut_patt p - | <:patt< ($list:pl$) >> -> List.for_all is_irrefut_patt pl - | <:patt< ? $_$ : ( $p$ ) >> -> is_irrefut_patt p - | <:patt< ? $_$ : ($p$ = $_$) >> -> is_irrefut_patt p - | <:patt< ~ $_$ >> -> True - | <:patt< ~ $_$ : $p$ >> -> is_irrefut_patt p - | _ -> False ] -; - -value expr_fun_args ge = Extfun.apply pr_expr_fun_args.val ge; - -pr_expr_fun_args.val := - extfun Extfun.empty with - [ <:expr< fun [$p$ -> $e$] >> as ge -> - if is_irrefut_patt p then - let (pl, e) = expr_fun_args e in - ([p :: pl], e) - else ([], ge) - | ge -> ([], ge) ]; - -value sequence ppf (e, k) = - match e with - [ <:expr< do { $list:el$ } >> -> - fprintf ppf "@[%a@]" (list expr) (el, k) - | _ -> expr ppf (e, k) ] -; - -value string ppf (s, k) = fprintf ppf "\"%s\"%t" s k; - -value int_repr s = - if String.length s > 2 && s.[0] = '0' then - match s.[1] with - [ 'b' | 'o' | 'x' | 'B' | 'O' | 'X' -> - "#" ^ String.sub s 1 (String.length s - 1) - | _ -> s ] - else s -; - -value assoc_left_parsed_op_list = ["+"; "*"; "land"; "lor"; "lxor"]; -value assoc_right_parsed_op_list = ["and"; "or"; "^"; "@"]; -value and_by_couple_op_list = ["="; "<>"; "<"; ">"; "<="; ">="; "=="; "!="]; - -(* extensible pretty print functions *) - -pr_constr_decl.pr_levels := - [{pr_label = "top"; - pr_box ppf f x = fprintf ppf "@[%t@]" f; - pr_rules = - extfun Extfun.empty with - [ (loc, c, []) -> - fun ppf curr next dg k -> fprintf ppf "(@[%s%t@]" c (ks ")" k) - | (loc, c, tl) -> - fun ppf curr next dg k -> - fprintf ppf "(@[%s@ %a@]" c (list ctyp) (tl, ks ")" k) ]}]; - -pr_ctyp.pr_levels := - [{pr_label = "top"; - pr_box ppf f x = fprintf ppf "@[%t@]" f; - pr_rules = - extfun Extfun.empty with - [ <:ctyp< [ $list:cdl$ ] >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[sum@ %a@]" (list constr_decl) (cdl, ks ")" k) - | <:ctyp< { $list:cdl$ } >> -> - fun ppf curr next dg k -> - fprintf ppf "{@[%a@]" (list label_decl) (cdl, ks "}" k) - | <:ctyp< ( $list:tl$ ) >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[* @[%a@]@]" (list ctyp) (tl, ks ")" k) - | <:ctyp< $t1$ -> $t2$ >> -> - fun ppf curr next dg k -> - let tl = - loop t2 where rec loop = - fun - [ <:ctyp< $t1$ -> $t2$ >> -> [t1 :: loop t2] - | t -> [t] ] - in - fprintf ppf "(@[-> @[%a@]@]" (list ctyp) - ([t1 :: tl], ks ")" k) - | <:ctyp< $t1$ $t2$ >> -> - fun ppf curr next dg k -> - let (t, tl) = - loop [t2] t1 where rec loop tl = - fun - [ <:ctyp< $t1$ $t2$ >> -> loop [t2 :: tl] t1 - | t1 -> (t1, tl) ] - in - fprintf ppf "(@[%a@ %a@]" ctyp (t, nok) (list ctyp) (tl, ks ")" k) - | <:ctyp< $t1$ . $t2$ >> -> - fun ppf curr next dg k -> - fprintf ppf "%a.%a" ctyp (t1, nok) ctyp (t2, k) - | <:ctyp< $lid:s$ >> | <:ctyp< $uid:s$ >> -> - fun ppf curr next dg k -> fprintf ppf "%s%t" s k - | <:ctyp< ' $s$ >> -> - fun ppf curr next dg k -> fprintf ppf "'%s%t" s k - | <:ctyp< _ >> -> - fun ppf curr next dg k -> fprintf ppf "_%t" k - | x -> - fun ppf curr next dg k -> not_impl "ctyp" x ppf k ]}]; - -pr_expr.pr_levels := - [{pr_label = "top"; - pr_box ppf f x = fprintf ppf "@[%t@]" f; - pr_rules = - extfun Extfun.empty with - [ <:expr< fun [] >> -> - fun ppf curr next dg k -> - fprintf ppf "(lambda%t" (ks ")" k) - | <:expr< fun $lid:s$ -> $e$ >> -> - fun ppf curr next dg k -> - fprintf ppf "(lambda@ %s@;<1 1>%a" s expr (e, ks ")" k) - | <:expr< fun [ $list:pwel$ ] >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[lambda_match@ %a@]" (list match_assoc) - (pwel, ks ")" k) - | <:expr< match $e$ with [ $list:pwel$ ] >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[@[match@ %a@]@ %a@]" expr (e, nok) - (list match_assoc) (pwel, ks ")" k) - | <:expr< try $e$ with [ $list:pwel$ ] >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[@[try@ %a@]@ %a@]" expr (e, nok) - (list match_assoc) (pwel, ks ")" k) - | <:expr< let $p1$ = $e1$ in $e2$ >> -> - fun ppf curr next dg k -> - let (pel, e) = - loop [(p1, e1)] e2 where rec loop pel = - fun - [ <:expr< let $p1$ = $e1$ in $e2$ >> -> - loop [(p1, e1) :: pel] e2 - | e -> (List.rev pel, e) ] - in - let b = - match pel with - [ [_] -> "let" - | _ -> "let*" ] - in - fprintf ppf "(@[@[%s (@[%a@]@]@;<1 2>%a@]" b - (listwb "" let_binding) (pel, ks ")" nok) - sequence (e, ks ")" k) - | <:expr< let $opt:rf$ $list:pel$ in $e$ >> -> - fun ppf curr next dg k -> - let b = if rf then "letrec" else "let" in - fprintf ppf "(@[%s@ (@[%a@]@ %a@]" b - (listwb "" let_binding) (pel, ks ")" nok) expr (e, ks ")" k) - | <:expr< if $e1$ then $e2$ else () >> -> - fun ppf curr next dg k -> - fprintf ppf "(if @[%a@;<1 0>%a@]" expr (e1, nok) - expr (e2, ks ")" k) - | <:expr< if $e1$ then $e2$ else $e3$ >> -> - fun ppf curr next dg k -> - fprintf ppf "(if @[%a@ %a@ %a@]" expr (e1, nok) - expr (e2, nok) expr (e3, ks ")" k) - | <:expr< do { $list:el$ } >> -> - fun ppf curr next dg k -> - fprintf ppf "(begin@;<1 1>@[%a@]" (list expr) (el, ks ")" k) - | <:expr< for $i$ = $e1$ to $e2$ do { $list:el$ } >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[for %s@ %a@ %a %a@]" i expr (e1, nok) - expr (e2, nok) (list expr) (el, ks ")" k) - | <:expr< ($e$ : $t$) >> -> - fun ppf curr next dg k -> - fprintf ppf "(:@ %a@ %a" expr (e, nok) ctyp (t, ks ")" k) - | <:expr< ($list:el$) >> -> - fun ppf curr next dg k -> - fprintf ppf "(values @[%a@]" (list expr) (el, ks ")" k) - | <:expr< { $list:fel$ } >> -> - fun ppf curr next dg k -> - let record_binding ppf ((p, e), k) = - fprintf ppf "(@[%a@ %a@]" patt (p, nok) expr (e, ks ")" k) - in - fprintf ppf "{@[%a@]" (list record_binding) (fel, ks "}" k) - | <:expr< { ($e$) with $list:fel$ } >> -> - fun ppf curr next dg k -> - let record_binding ppf ((p, e), k) = - fprintf ppf "(@[%a@ %a@]" patt (p, nok) expr (e, ks ")" k) - in - fprintf ppf "{@[@[with@ %a@]@ @[%a@]@]" expr (e, nok) - (list record_binding) (fel, ks "}" k) - | <:expr< $e1$ := $e2$ >> -> - fun ppf curr next dg k -> - fprintf ppf "(:=@;<1 1>%a@;<1 1>%a" expr (e1, nok) - expr (e2, ks ")" k) - | <:expr< [$_$ :: $_$] >> as e -> - fun ppf curr next dg k -> - let (el, c) = - make_list e where rec make_list e = - match e with - [ <:expr< [$e$ :: $y$] >> -> - let (el, c) = make_list y in - ([e :: el], c) - | <:expr< [] >> -> ([], None) - | x -> ([], Some e) ] - in - match c with - [ None -> - fprintf ppf "[%a" (list expr) (el, ks "]" k) - | Some x -> - fprintf ppf "[%a@ %a" (list expr) (el, ks " ." nok) - expr (x, ks "]" k) ] - | <:expr< lazy ($x$) >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[lazy@ %a@]" expr (x, ks ")" k) - | <:expr< $lid:s$ $e1$ $e2$ >> - when List.mem s assoc_right_parsed_op_list -> - fun ppf curr next dg k -> - let el = - loop [e1] e2 where rec loop el = - fun - [ <:expr< $lid:s1$ $e1$ $e2$ >> when s1 = s -> - loop [e1 :: el] e2 - | e -> List.rev [e :: el] ] - in - fprintf ppf "(@[%s %a@]" s (list expr) (el, ks ")" k) - | <:expr< $e1$ $e2$ >> -> - fun ppf curr next dg k -> - let (f, el) = - loop [e2] e1 where rec loop el = - fun - [ <:expr< $e1$ $e2$ >> -> loop [e2 :: el] e1 - | e1 -> (e1, el) ] - in - fprintf ppf "(@[%a@ %a@]" expr (f, nok) (list expr) (el, ks ")" k) - | <:expr< ~ $s$ : ($e$) >> -> - fun ppf curr next dg k -> - fprintf ppf "(~%s@ %a" s expr (e, ks ")" k) - | <:expr< $e1$ .[ $e2$ ] >> -> - fun ppf curr next dg k -> - fprintf ppf "%a.[%a" expr (e1, nok) expr (e2, ks "]" k) - | <:expr< $e1$ .( $e2$ ) >> -> - fun ppf curr next dg k -> - fprintf ppf "%a.(%a" expr (e1, nok) expr (e2, ks ")" k) - | <:expr< $e1$ . $e2$ >> -> - fun ppf curr next dg k -> - fprintf ppf "%a.%a" expr (e1, nok) expr (e2, k) - | <:expr< $int:s$ >> -> - fun ppf curr next dg k -> fprintf ppf "%s%t" (int_repr s) k - | <:expr< $lid:s$ >> | <:expr< $uid:s$ >> -> - fun ppf curr next dg k -> fprintf ppf "%s%t" s k - | <:expr< ` $s$ >> -> - fun ppf curr next dg k -> fprintf ppf "`%s%t" s k - | <:expr< $str:s$ >> -> - fun ppf curr next dg k -> fprintf ppf "\"%s\"%t" s k - | <:expr< $chr:s$ >> -> - fun ppf curr next dg k -> fprintf ppf "'%s'%t" s k - | x -> - fun ppf curr next dg k -> not_impl "expr" x ppf k ]}]; - -pr_label_decl.pr_levels := - [{pr_label = "top"; - pr_box ppf f x = fprintf ppf "@[%t@]" f; - pr_rules = - extfun Extfun.empty with - [ (loc, f, m, t) -> - fun ppf curr next dg k -> - fprintf ppf "(@[%s%t@ %a@]" f - (fun ppf -> if m then fprintf ppf "@ mutable" else ()) - ctyp (t, ks ")" k) ]}]; - -pr_let_binding.pr_levels := - [{pr_label = "top"; - pr_box ppf f x = fprintf ppf "@[%t@]" f; - pr_rules = - extfun Extfun.empty with - [ (b, (p, e)) -> - fun ppf curr next dg k -> - let (pl, e) = expr_fun_args e in - match pl with - [ [] -> - fprintf ppf "(@[%s%s%a@ %a@]" b - (if b = "" then "" else " ") patt (p, nok) - sequence (e, ks ")" k) - | _ -> - fprintf ppf "(@[%s%s(%a)@ %a@]" b - (if b = "" then "" else " ") (list patt) ([p :: pl], nok) - sequence (e, ks ")" k) ] ]}]; - -pr_match_assoc.pr_levels := - [{pr_label = "top"; - pr_box ppf f x = fprintf ppf "@[%t@]" f; - pr_rules = - extfun Extfun.empty with - [ (p, we, e) -> - fun ppf curr next dg k -> - fprintf ppf "(@[%t@ %a@]" - (fun ppf -> - match we with - [ Some e -> - fprintf ppf "(when@ %a@ %a" patt (p, nok) - expr (e, ks ")" nok) - | None -> patt ppf (p, nok) ]) - sequence (e, ks ")" k) ]}]; - -pr_mod_ident.pr_levels := - [{pr_label = "top"; - pr_box ppf f x = fprintf ppf "@[%t@]" f; - pr_rules = - extfun Extfun.empty with - [ [s] -> - fun ppf curr next dg k -> - fprintf ppf "%s%t" s k - | [s :: sl] -> - fun ppf curr next dg k -> - fprintf ppf "%s.%a" s curr (sl, "", k) - | x -> - fun ppf curr next dg k -> not_impl "mod_ident" x ppf k ]}]; - -pr_module_binding.pr_levels := - [{pr_label = "top"; - pr_box ppf f x = fprintf ppf "@[%t@]" f; - pr_rules = - extfun Extfun.empty with - [ (b, s, me) -> - fun ppf curr next dg k -> - fprintf ppf "%s@ %s@ %a" b s module_expr (me, k) ]}]; - -pr_module_expr.pr_levels := - [{pr_label = "top"; - pr_box ppf f x = fprintf ppf "@[%t@]" f; - pr_rules = - extfun Extfun.empty with - [ <:module_expr< functor ($i$ : $mt$) -> $me$ >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[@[@[functor@ %s@]@ %a@]@ %a@]" - i module_type (mt, nok) module_expr (me, ks ")" k) - | <:module_expr< struct $list:sil$ end >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[struct@ @[%a@]@]" (list str_item) - (sil, ks ")" k) - | <:module_expr< $me1$ $me2$ >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[%a@ %a@]" module_expr (me1, nok) - module_expr (me2, ks ")" k) - | <:module_expr< $uid:s$ >> -> - fun ppf curr next dg k -> fprintf ppf "%s%t" s k - | x -> - fun ppf curr next dg k -> not_impl "module_expr" x ppf k ]}]; - -pr_module_type.pr_levels := - [{pr_label = "top"; - pr_box ppf f x = fprintf ppf "@[%t@]" f; - pr_rules = - extfun Extfun.empty with - [ <:module_type< functor ($i$ : $mt1$) -> $mt2$ >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[@[@[functor@ %s@]@ %a@]@ %a@]" - i module_type (mt1, nok) module_type (mt2, ks ")" k) - | <:module_type< sig $list:sil$ end >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[sig@ @[%a@]@]" (list sig_item) (sil, ks ")" k) - | <:module_type< $mt$ with $list:wcl$ >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[with@;<1 2>@[%a@ (%a@]@]" module_type (mt, nok) - (list with_constr) (wcl, ks "))" k) - | <:module_type< $uid:s$ >> -> - fun ppf curr next dg k -> fprintf ppf "%s%t" s k - | x -> - fun ppf curr next dg k -> not_impl "module_type" x ppf k ]}]; - -pr_patt.pr_levels := - [{pr_label = "top"; - pr_box ppf f x = fprintf ppf "@[%t@]" f; - pr_rules = - extfun Extfun.empty with - [ <:patt< $p1$ | $p2$ >> -> - fun ppf curr next dg k -> - let (f, pl) = - loop [p2] p1 where rec loop pl = - fun - [ <:patt< $p1$ | $p2$ >> -> loop [p2 :: pl] p1 - | p1 -> (p1, pl) ] - in - fprintf ppf "(@[or@ %a@ %a@]" patt (f, nok) (list patt) - (pl, ks ")" k) - | <:patt< ($p1$ as $p2$) >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[as@ %a@ %a@]" patt (p1, nok) patt (p2, ks ")" k) - | <:patt< $p1$ .. $p2$ >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[range@ %a@ %a@]" patt (p1, nok) patt (p2, ks ")" k) - | <:patt< [$_$ :: $_$] >> as p -> - fun ppf curr next dg k -> - let (pl, c) = - make_list p where rec make_list p = - match p with - [ <:patt< [$p$ :: $y$] >> -> - let (pl, c) = make_list y in - ([p :: pl], c) - | <:patt< [] >> -> ([], None) - | x -> ([], Some p) ] - in - match c with - [ None -> - fprintf ppf "[%a" (list patt) (pl, ks "]" k) - | Some x -> - fprintf ppf "[%a@ %a" (list patt) (pl, ks " ." nok) - patt (x, ks "]" k) ] - | <:patt< $p1$ $p2$ >> -> - fun ppf curr next dg k -> - let pl = - loop [p2] p1 where rec loop pl = - fun - [ <:patt< $p1$ $p2$ >> -> loop [p2 :: pl] p1 - | p1 -> [p1 :: pl] ] - in - fprintf ppf "(@[%a@]" (list patt) (pl, ks ")" k) - | <:patt< ($p$ : $t$) >> -> - fun ppf curr next dg k -> - fprintf ppf "(:@ %a@ %a" patt (p, nok) ctyp (t, ks ")" k) - | <:patt< ($list:pl$) >> -> - fun ppf curr next dg k -> - fprintf ppf "(values @[%a@]" (list patt) (pl, ks ")" k) - | <:patt< { $list:fpl$ } >> -> - fun ppf curr next dg k -> - let record_binding ppf ((p1, p2), k) = - fprintf ppf "(@[%a@ %a@]" patt (p1, nok) patt (p2, ks ")" k) - in - fprintf ppf "(@[{}@ %a@]" (list record_binding) (fpl, ks ")" k) - | <:patt< ? $x$ >> -> - fun ppf curr next dg k -> fprintf ppf "?%s%t" x k - | <:patt< ? ($lid:x$ = $e$) >> -> - fun ppf curr next dg k -> fprintf ppf "(?%s@ %a" x expr (e, ks ")" k) - | <:patt< $p1$ . $p2$ >> -> - fun ppf curr next dg k -> - fprintf ppf "%a.%a" patt (p1, nok) patt (p2, k) - | <:patt< $lid:s$ >> | <:patt< $uid:s$ >> -> - fun ppf curr next dg k -> fprintf ppf "%s%t" s k - | <:patt< $str:s$ >> -> - fun ppf curr next dg k -> fprintf ppf "\"%s\"%t" s k - | <:patt< $chr:s$ >> -> - fun ppf curr next dg k -> fprintf ppf "'%s'%t" s k - | <:patt< $int:s$ >> -> - fun ppf curr next dg k -> fprintf ppf "%s%t" (int_repr s) k - | <:patt< $flo:s$ >> -> - fun ppf curr next dg k -> fprintf ppf "%s%t" s k - | <:patt< _ >> -> - fun ppf curr next dg k -> fprintf ppf "_%t" k - | x -> - fun ppf curr next dg k -> not_impl "patt" x ppf k ]}]; - -pr_sig_item.pr_levels := - [{pr_label = "top"; - pr_box ppf f x = fprintf ppf "@[%t@]" f; - pr_rules = - extfun Extfun.empty with - [ <:sig_item< type $list:tdl$ >> -> - fun ppf curr next dg k -> - match tdl with - [ [td] -> fprintf ppf "(%a" type_decl (("type", td), ks ")" k) - | tdl -> - fprintf ppf "(@[type@ %a@]" (listwb "" type_decl) - (tdl, ks ")" k) ] - | <:sig_item< exception $c$ of $list:tl$ >> -> - fun ppf curr next dg k -> - match tl with - [ [] -> fprintf ppf "(@[exception@ %s%t@]" c (ks ")" k) - | tl -> - fprintf ppf "(@[@[exception@ %s@]@ %a@]" c - (list ctyp) (tl, ks ")" k) ] - | <:sig_item< value $i$ : $t$ >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[@[value %s@]@ %a@]" i ctyp (t, ks ")" k) - | <:sig_item< external $i$ : $t$ = $list:pd$ >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[@[external@ %s@]@ %a@ %a@]" i ctyp (t, nok) - (list string) (pd, ks ")" k) - | <:sig_item< module $s$ : $mt$ >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[@[module@ %s@]@ %a@]" s - module_type (mt, ks ")" k) - | <:sig_item< module type $s$ = $mt$ >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[@[moduletype@ %s@]@ %a@]" s - module_type (mt, ks ")" k) - | <:sig_item< declare $list:s$ end >> -> - fun ppf curr next dg k -> - if s = [] then fprintf ppf "; ..." - else fprintf ppf "%a" (list sig_item) (s, k) - | MLast.SgUse _ _ _ -> - fun ppf curr next dg k -> () - | x -> - fun ppf curr next dg k -> not_impl "sig_item" x ppf k ]}]; - -pr_str_item.pr_levels := - [{pr_label = "top"; - pr_box ppf f x = fprintf ppf "@[%t@]" f; - pr_rules = - extfun Extfun.empty with - [ <:str_item< open $i$ >> -> - fun ppf curr next dg k -> - fprintf ppf "(open@ %a" mod_ident (i, ks ")" k) - | <:str_item< type $list:tdl$ >> -> - fun ppf curr next dg k -> - match tdl with - [ [td] -> fprintf ppf "(%a" type_decl (("type", td), ks ")" k) - | tdl -> - fprintf ppf "(@[type@ %a@]" (listwb "" type_decl) - (tdl, ks ")" k) ] - | <:str_item< exception $c$ of $list:tl$ >> -> - fun ppf curr next dg k -> - match tl with - [ [] -> fprintf ppf "(@[exception@ %s%t@]" c (ks ")" k) - | tl -> - fprintf ppf "(@[@[exception@ %s@]@ %a@]" c - (list ctyp) (tl, ks ")" k) ] - | <:str_item< value $opt:rf$ $list:pel$ >> -> - fun ppf curr next dg k -> - let b = if rf then "definerec" else "define" in - match pel with - [ [(p, e)] -> - fprintf ppf "%a" let_binding ((b, (p, e)), k) - | pel -> - fprintf ppf "(@[%s*@ %a@]" b (listwb "" let_binding) - (pel, ks ")" k) ] - | <:str_item< module $s$ = $me$ >> -> - fun ppf curr next dg k -> - fprintf ppf "(%a" module_binding (("module", s, me), ks ")" k) - | <:str_item< module type $s$ = $mt$ >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[@[moduletype@ %s@]@ %a@]" s - module_type (mt, ks ")" k) - | <:str_item< external $i$ : $t$ = $list:pd$ >> -> - fun ppf curr next dg k -> - fprintf ppf "(@[external@ %s@ %a@ %a@]" i ctyp (t, nok) - (list string) (pd, ks ")" k) - | <:str_item< $exp:e$ >> -> - fun ppf curr next dg k -> - fprintf ppf "%a" expr (e, k) - | <:str_item< # $s$ $opt:x$ >> -> - fun ppf curr next dg k -> - match x with - [ Some e -> fprintf ppf "; # (%s %a" s expr (e, ks ")" k) - | None -> fprintf ppf "; # (%s%t" s (ks ")" k) ] - | <:str_item< declare $list:s$ end >> -> - fun ppf curr next dg k -> - if s = [] then fprintf ppf "; ..." - else fprintf ppf "%a" (list str_item) (s, k) - | MLast.StUse _ _ _ -> - fun ppf curr next dg k -> () - | x -> - fun ppf curr next dg k -> not_impl "str_item" x ppf k ]}]; - -pr_type_decl.pr_levels := - [{pr_label = "top"; - pr_box ppf f x = fprintf ppf "@[%t@]" f; - pr_rules = - extfun Extfun.empty with - [ (b, ((_, tn), tp, te, cl)) -> - fun ppf curr next dg k -> - fprintf ppf "%t%t@;<1 1>%a" - (fun ppf -> - if b <> "" then fprintf ppf "%s@ " b - else ()) - (fun ppf -> - match tp with - [ [] -> fprintf ppf "%s" tn - | tp -> fprintf ppf "(%s%a)" tn type_params (tp, nok) ]) - ctyp (te, k) ]}]; - -pr_type_params.pr_levels := - [{pr_label = "top"; - pr_box ppf f x = fprintf ppf "@[%t@]" f; - pr_rules = - extfun Extfun.empty with - [ [(s, vari) :: tpl] -> - fun ppf curr next dg k -> - fprintf ppf "@ '%s%a" s type_params (tpl, k) - | [] -> - fun ppf curr next dg k -> () ]}]; - -pr_with_constr.pr_levels := - [{pr_label = "top"; - pr_box ppf f x = fprintf ppf "@[%t@]" f; - pr_rules = - extfun Extfun.empty with - [ MLast.WcTyp _ m tp te -> - fun ppf curr next dg k -> - fprintf ppf "(type@ %t@;<1 1>%a" - (fun ppf -> - match tp with - [ [] -> fprintf ppf "%a" mod_ident (m, nok) - | tp -> - fprintf ppf "(%a@ %a)" mod_ident (m, nok) - type_params (tp, nok) ]) - ctyp (te, ks ")" k) - | x -> - fun ppf curr next dg k -> not_impl "with_constr" x ppf k ]}]; - -(* main *) - -value output_string_eval ppf s = - loop 0 where rec loop i = - if i == String.length s then () - else if i == String.length s - 1 then pp_print_char ppf s.[i] - else - match (s.[i], s.[i + 1]) with - [ ('\\', 'n') -> do { pp_print_char ppf '\n'; loop (i + 2) } - | (c, _) -> do { pp_print_char ppf c; loop (i + 1) } ] -; - -value sep = Pcaml.inter_phrases; - -value input_source ic len = - let buff = Buffer.create 20 in - try - let rec loop i = - if i >= len then Buffer.contents buff - else do { let c = input_char ic in Buffer.add_char buff c; loop (i + 1) } - in - loop 0 - with - [ End_of_file -> - let s = Buffer.contents buff in - if s = "" then - match sep.val with - [ Some s -> s - | None -> "\n" ] - else s ] -; - -value copy_source ppf (ic, first, bp, ep) = - match sep.val with - [ Some str -> - if first then () - else if ep == in_channel_length ic then pp_print_string ppf "\n" - else output_string_eval ppf str - | None -> - do { - seek_in ic bp; - let s = input_source ic (ep - bp) in pp_print_string ppf s - } ] -; - -value copy_to_end ppf (ic, first, bp) = - let ilen = in_channel_length ic in - if bp < ilen then copy_source ppf (ic, first, bp, ilen) - else pp_print_string ppf "\n" -; - -value apply_printer printer ast = - let ppf = std_formatter in - if Pcaml.input_file.val <> "-" && Pcaml.input_file.val <> "" then do { - let ic = open_in_bin Pcaml.input_file.val in - try - let (first, last_pos) = - List.fold_left - (fun (first, last_pos) (si, (bp, ep)) -> - do { - fprintf ppf "@[%a@]@?" copy_source (ic, first, last_pos.Lexing.pos_cnum, bp.Lexing.pos_cnum); - fprintf ppf "@[%a@]@?" printer (si, nok); - (False, ep) - }) - (True, Token.nowhere) ast - in - fprintf ppf "@[%a@]@?" copy_to_end (ic, first, last_pos.Lexing.pos_cnum) - with x -> - do { fprintf ppf "@."; close_in ic; raise x }; - close_in ic; - } - else failwith "not implemented" -; - -Pcaml.print_interf.val := apply_printer sig_item; -Pcaml.print_implem.val := apply_printer str_item; - -Pcaml.add_option "-l" (Arg.Int (fun x -> set_margin x)) - " Maximum line length for pretty printing."; - -Pcaml.add_option "-sep" (Arg.String (fun x -> sep.val := Some x)) - " Use this string between phrases instead of reading source."; diff -Nru ocaml-3.12.1/camlp4/unmaintained/scheme/pr_schp_main.ml ocaml-4.01.0/camlp4/unmaintained/scheme/pr_schp_main.ml --- ocaml-3.12.1/camlp4/unmaintained/scheme/pr_schp_main.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/scheme/pr_schp_main.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,132 +0,0 @@ -(* pa_r.cmo q_MLast.cmo pa_extfun.cmo pr_dump.cmo *) -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2002 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file *) -(* ../../../LICENSE. *) -(* *) -(***********************************************************************) - - -open Format; -open Pcaml; -open Parserify; - -value nok = Pr_scheme.nok; -value ks = Pr_scheme.ks; -value patt = Pr_scheme.patt; -value expr = Pr_scheme.expr; -value find_pr_level = Pr_scheme.find_pr_level; -value pr_expr = Pr_scheme.pr_expr; -type printer_t 'a = Pr_scheme.printer_t 'a == - { pr_fun : mutable string -> Pr_scheme.next 'a; - pr_levels : mutable list (pr_level 'a) } -and pr_level 'a = Pr_scheme.pr_level 'a == - { pr_label : string; - pr_box : formatter -> (formatter -> unit) -> 'a -> unit; - pr_rules : mutable Pr_scheme.pr_rule 'a } -; - -(* extensions for rebuilding syntax of parsers *) - -value parser_cases ppf (spel, k) = - let rec parser_cases ppf (spel, k) = - match spel with - [ [] -> fprintf ppf "[: `HVbox [: b; k :] :]" - | [(sp, epo, e)] -> parser_case ppf (sp, epo, e, k) - | [(sp, epo, e) :: spel] -> - fprintf ppf "%a@ %a" parser_case (sp, epo, e, nok) - parser_cases (spel, k) ] - and parser_case ppf (sp, epo, e, k) = - fprintf ppf "(@[@[(%a)%t@]@ %a@]" stream_patt (sp, nok) - (fun ppf -> - match epo with - [ Some p -> fprintf ppf "@ %a" patt (p, nok) - | None -> () ]) - expr (e, ks ")" k) - and stream_patt ppf (sp, k) = - match sp with - [ [] -> k ppf - | [(spc, None)] -> fprintf ppf "%a" stream_patt_comp (spc, k) - | [(spc, Some e)] -> - fprintf ppf "(@[? %a@ %a@]" stream_patt_comp (spc, nok) - expr (e, ks ")" k) - | [(spc, None) :: spcl] -> - fprintf ppf "%a@ %a" stream_patt_comp (spc, nok) stream_patt (spcl, k) - | [(spc, Some e) :: spcl] -> - fprintf ppf "(@[? %a@ %a@]@ %a" stream_patt_comp (spc, nok) - expr (e, ks ")" nok) stream_patt (spcl, k) ] - and stream_patt_comp ppf (spc, k) = - match spc with - [ SPCterm (p, w) -> - match w with - [ Some e -> - fprintf ppf "(` %a@ %a" patt (p, nok) expr (e, ks ")" k) - | None -> fprintf ppf "(` %a" patt (p, ks ")" k) ] - | SPCnterm p e -> - fprintf ppf "(@[%a %a@]" patt (p, nok) expr (e, ks ")" k) - | SPCsterm p -> fprintf ppf "%a" patt (p, k) ] - in - parser_cases ppf (spel, k) -; - -value parser_body ppf (e, k) = - let (bp, e) = - match e with - [ <:expr< let $bp$ = Stream.count __strm in $e$ >> -> (Some bp, e) - | e -> (None, e) ] - in - match parser_of_expr e with - [ [] -> - fprintf ppf "(parser%t%t" - (fun ppf -> - match bp with - [ Some p -> fprintf ppf "@ %a" patt (p, nok) - | _ -> ()]) - (ks ")" k) - | spel -> - fprintf ppf "(@[@[parser%t@]@ @[%a@]@]" - (fun ppf -> - match bp with - [ Some p -> fprintf ppf "@ %a" patt (p, nok) - | _ -> ()]) - parser_cases (spel, ks ")" k) ] -; - -value pmatch ppf (e, k) = - let (me, e) = - match e with - [ <:expr< let (__strm : Stream.t _) = $me$ in $e$ >> -> (me, e) - | _ -> failwith "Pr_schp_main.pmatch" ] - in - let (bp, e) = - match e with - [ <:expr< let $bp$ = Stream.count __strm in $e$ >> -> (Some bp, e) - | e -> (None, e) ] - in - let spel = parser_of_expr e in - fprintf ppf "(@[@[match_with_parser@ %a@]%t@ @[%a@]@]" expr (me, nok) - (fun ppf -> - match bp with - [ Some p -> fprintf ppf "@ %a" patt (p, nok) - | _ -> () ]) - parser_cases (spel, ks ")" k) -; - -pr_expr_fun_args.val := - extfun pr_expr_fun_args.val with - [ <:expr< fun [(__strm : $_$) -> $_$] >> as ge -> ([], ge) ]; - -let lev = find_pr_level "top" pr_expr.pr_levels in -lev.pr_rules := - extfun lev.pr_rules with - [ <:expr< fun (__strm : $_$) -> $x$ >> -> - fun ppf curr next dg k -> fprintf ppf "%a" parser_body (x, k) - | <:expr< let (__strm : Stream.t _) = $_$ in $_$ >> as e -> - fun ppf curr next dg k -> fprintf ppf "%a" pmatch (e, k) ]; diff -Nru ocaml-3.12.1/camlp4/unmaintained/sml/Makefile ocaml-4.01.0/camlp4/unmaintained/sml/Makefile --- ocaml-3.12.1/camlp4/unmaintained/sml/Makefile 2004-11-30 18:57:04.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/sml/Makefile 1970-01-01 00:00:00.000000000 +0000 @@ -1,68 +0,0 @@ -######################################################################### -# # -# Objective Caml # -# # -# Camlp4 # -# # -# Copyright 2004 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### -# -# Makefile for pa_sml -# M.Mauny -# - -include ../../config/Makefile.cnf - -OCAMLTOP=../../.. - -OCAMLC=$(OCAMLTOP)/ocamlc$(EXE) -nostdlib -I $(OCAMLTOP)/stdlib -OCAMLOPT=$(OCAMLTOP)/ocamlopt$(EXE) -nostdlib -I $(OCAMLTOP)/stdlib - -P4INCLUDES=-I ../../meta -I ../../etc -I ../../lib -I ../../camlp4 -OCAMLINCLUDES=-I ../../meta -I ../../lib -I ../../camlp4 - -CAMLP4=camlp4$(EXE) -nolib -OCAMLCFLAGS=-warn-error A $(OCAMLINCLUDES) - -SRC=pa_sml.ml -OBJS=$(SRC:.ml=.cmo) -OBJSX=$(SRC:.ml=.cmx) - -all: $(OBJS) smllib.cmo - -opt: $(OBJSX) smllib.cmx - -depend: - cp .depend .depend.bak - > .depend - for file in $(SRC); do \ - $(CAMLP4) $(P4INCLUDES) `awk 'NR == 1 { ORS=" "; for (i=2; i < NF; i++) print $$i; } ' $$file` pr_depend.cmo $$i | \ - sed -e 's| \.\./\.\./\.\.| $$(OCAMLTOP)|g' >> .depend; \ - done - -clean: - rm -f *.cm* *.o *.bak .*.bak - - -.SUFFIXES: .cmx .cmo .cmi .ml .mli .sml - -.mli.cmi: - $(OCAMLC) $(OCAMLCFLAGS) -c $< - - -.sml.cmo: - $(OCAMLC) -I ../../../otherlibs/unix -pp "$(CAMLP4) ./pa_sml.cmo ../../meta/pr_dump.cmo -impl" -c -o $*.cmo -impl $< - -.sml.cmx: - $(OCAMLOPT) -I ../../../otherlibs/unix -pp "$(CAMLP4) ./pa_sml.cmo ../../meta/pr_dump.cmo -impl" -c -o $*.cmx -impl $< - -.ml.cmo: - $(OCAMLC) $(OCAMLCFLAGS) -pp "$(CAMLP4) $(P4INCLUDES) `awk 'NR == 1 { ORS=" "; for (i=2; i < NF; i++) print $$i; } ' $<`" -c $< - -.ml.cmx: - $(OCAMLOPT) $(OCAMLCFLAGS) -pp "$(CAMLP4) $(P4INCLUDES) `awk 'NR == 1 { ORS=" "; for (i=2; i < NF; i++) print $$i; } ' $<`" -c $< - -include .depend diff -Nru ocaml-3.12.1/camlp4/unmaintained/sml/README ocaml-4.01.0/camlp4/unmaintained/sml/README --- ocaml-3.12.1/camlp4/unmaintained/sml/README 2004-07-13 12:25:21.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/sml/README 1970-01-01 00:00:00.000000000 +0000 @@ -1,15 +0,0 @@ -This is an application of or an extension for Camlp4. Although it is -currently distributed with OCaml/Camlp4, it may or may not be -actively maintained. - -It probably won't be part of future OCaml/Camlp4 distributions but be -accessible from the Camlp4 hump. If you are interested in developing -this package further and/or actively maintain it, please let us know -(caml@inria.fr) - -This package is distributed under the same license as the Objective -Caml Library (that is, LGPL with a special exception allowing both -static and dynamic link). - --- Michel Mauny - diff -Nru ocaml-3.12.1/camlp4/unmaintained/sml/pa_sml.ml ocaml-4.01.0/camlp4/unmaintained/sml/pa_sml.ml --- ocaml-3.12.1/camlp4/unmaintained/sml/pa_sml.ml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/sml/pa_sml.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,952 +0,0 @@ -(* pa_r.cmo pa_rp.cmo pa_extend.cmo q_MLast.cmo pr_dump.cmo *) -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2002 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file *) -(* ../../../LICENSE. *) -(* *) -(***********************************************************************) - - - -open Stdpp; -open Pcaml; - -value ocaml_records = ref False; - -Pcaml.no_constructors_arity.val := True; - -value lexer = Plexer.gmake (); - -do { - Grammar.Unsafe.gram_reinit gram lexer; - Grammar.Unsafe.clear_entry interf; - Grammar.Unsafe.clear_entry implem; - Grammar.Unsafe.clear_entry top_phrase; - Grammar.Unsafe.clear_entry use_file; - Grammar.Unsafe.clear_entry module_type; - Grammar.Unsafe.clear_entry module_expr; - Grammar.Unsafe.clear_entry sig_item; - Grammar.Unsafe.clear_entry str_item; - Grammar.Unsafe.clear_entry expr; - Grammar.Unsafe.clear_entry patt; - Grammar.Unsafe.clear_entry ctyp; - Grammar.Unsafe.clear_entry let_binding; -}; - -Pcaml.parse_interf.val := Grammar.Entry.parse interf; -Pcaml.parse_implem.val := Grammar.Entry.parse implem; - -value not_impl loc s = - raise_with_loc loc (Stream.Error ("not implemented feature [" ^ s ^ "]")) -; - -type altern 'a 'b = [ Left of 'a | Right of 'b ]; - -value get_seq = - fun - [ <:expr< do { $list:el$ } >> -> el - | e -> [e] ] -; - -value choose_tvar tpl = - let rec find_alpha v = - let s = String.make 1 v in - if List.mem_assoc s tpl then - if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) - else Some (String.make 1 v) - in - let rec make_n n = - let v = "a" ^ string_of_int n in - if List.mem_assoc v tpl then make_n (succ n) else v - in - match find_alpha 'a' with - [ Some x -> x - | None -> make_n 1 ] -; - -value mklistexp loc last = - loop True where rec loop top = - fun - [ [] -> - match last with - [ Some e -> e - | None -> <:expr< [] >> ] - | [e1 :: el] -> - let loc = if top then loc else (fst (MLast.loc_of_expr e1), snd loc) in - <:expr< [$e1$ :: $loop False el$] >> ] -; - -value mklistpat loc last = - loop True where rec loop top = - fun - [ [] -> - match last with - [ Some p -> p - | None -> <:patt< [] >> ] - | [p1 :: pl] -> - let loc = if top then loc else (fst (MLast.loc_of_patt p1), snd loc) in - <:patt< [$p1$ :: $loop False pl$] >> ] -; - -value expr_of_patt p = - let loc = MLast.loc_of_patt p in - match p with - [ <:patt< $lid:x$ >> -> <:expr< $lid:x$ >> - | _ -> Stdpp.raise_with_loc loc (Stream.Error "identifier expected") ] -; - -value apply_bind loc e bl = - let rec loop e = - fun - [ [] -> e - | [<:str_item< value $p1$ = $e1$ >> :: list] -> - loop_let e [(p1, e1)] list - | [<:str_item< value rec $p1$ = $e1$ >> :: list] -> - loop_letrec e [(p1, e1)] list - | [<:str_item< module $s$ = $me$ >> :: list] -> - let e = <:expr< let module $s$ = $me$ in $e$ >> in - loop e list - | [si :: list] -> - raise Exit ] - and loop_let e pel = - fun - [ [<:str_item< value $p1$ = $e1$ >> :: list] -> - loop_let e [(p1, e1) :: pel] list - | list -> - let e = <:expr< let $list:pel$ in $e$ >> in - loop e list ] - and loop_letrec e pel = - fun - [ [<:str_item< value rec $p1$ = $e1$ >> :: list] -> - loop_letrec e [(p1, e1) :: pel] list - | list -> - let e = <:expr< let rec $list:pel$ in $e$ >> in - loop e list ] - in - loop e (List.rev bl) -; - -value make_local loc sl1 sl2 = - try - let pl = - List.map - (fun - [ <:str_item< value $opt:_$ $p$ = $_$ >> -> p - | _ -> raise Exit ]) - sl2 - in - let e1 = - match List.map expr_of_patt pl with - [ [e] -> e - | el -> <:expr< ($list:el$) >> ] - in - let p1 = - match pl with - [ [p] -> p - | pl -> <:patt< ($list:pl$) >> ] - in - let e = apply_bind loc e1 sl2 in - let e = apply_bind loc e sl1 in - <:str_item< value $p1$ = $e$ >> - with - [ Exit -> - do { - Printf.eprintf "\ -*** Warning: a 'local' statement will be defined global because of bindings -which cannot be defined as first class values (modules, exceptions, ...)\n"; - flush stderr; - <:str_item< declare $list:sl1 @ sl2$ end >> - } ] -; - -value str_declare loc = - fun - [ [d] -> d - | dl -> <:str_item< declare $list:dl$ end >> ] -; - -value sig_declare loc = - fun - [ [d] -> d - | dl -> <:sig_item< declare $list:dl$ end >> ] -; - -value extract_label_types loc tn tal cdol = - let (cdl, aux) = - List.fold_right - (fun (loc, c, tl, aux_opt) (cdl, aux) -> - match aux_opt with - [ Some anon_record_type -> - let new_tn = tn ^ "_" ^ c in - let loc = MLast.loc_of_ctyp anon_record_type in - let aux_def = ((loc, new_tn), [], anon_record_type, []) in - let tl = [<:ctyp< $lid:new_tn$ >>] in - ([(loc, c, tl) :: cdl], [aux_def :: aux]) - | None -> ([(loc, c, tl) :: cdl], aux) ]) - cdol ([], []) - in - [((loc, tn), tal, <:ctyp< [ $list:cdl$ ] >>, []) :: aux] -; - -value function_of_clause_list loc xl = - let (fname, fname_loc, nbpat, l) = - List.fold_left - (fun (fname, fname_loc, nbpat, l) ((x1, loc), x2, x3, x4) -> - let (fname, fname_loc, nbpat) = - if fname = "" then (x1, loc, List.length x2) - else if x1 <> fname then - raise_with_loc loc - (Stream.Error ("'" ^ fname ^ "' expected")) - else if List.length x2 <> nbpat then - raise_with_loc loc - (Stream.Error "bad number of patterns in that clause") - else (fname, fname_loc, nbpat) - in - let x4 = - match x3 with - [ Some t -> <:expr< ($x4$ : $t$) >> - | _ -> x4 ] - in - let l = [(x2, x4) :: l] in - (fname, fname_loc, nbpat, l)) - ("", loc, 0, []) xl - in - let l = List.rev l in - let e = - match l with - [ [(pl, e)] -> - List.fold_right (fun p e -> <:expr< fun $p$ -> $e$ >>) pl e - | _ -> - if nbpat = 1 then - let pwel = - List.map - (fun (pl, e) -> (<:patt< $List.hd pl$ >>, None, e)) l - in - <:expr< fun [ $list:pwel$ ] >> - else - let sl = - loop 0 where rec loop n = - if n = nbpat then [] - else ["a" ^ string_of_int (n + 1) :: loop (n + 1)] - in - let e = - let el = List.map (fun s -> <:expr< $lid:s$ >>) sl in - let pwel = - List.map - (fun (pl, e) -> (<:patt< ($list:pl$) >>, None, e)) l - in - <:expr< match ($list:el$) with [ $list:pwel$ ] >> - in - List.fold_right (fun s e -> <:expr< fun $lid:s$ -> $e$ >>) sl e ] - in - (let loc = fname_loc in <:patt< $lid:fname$ >>, e) -; - -value record_expr loc x1 = - if ocaml_records.val then <:expr< { $list:x1$ } >> - else - let list1 = - List.map - (fun (l, v) -> - let id = - match l with - [ <:patt< $lid:l$ >> -> l - | _ -> "" ] - in - let loc = MLast.loc_of_expr v in - <:class_str_item< value $id$ = $v$ >>) - x1 - in - let list2 = - List.map - (fun (l, v) -> - let id = - match l with - [ <:patt< $lid:l$ >> -> l - | _ -> "" ] - in - let loc = MLast.loc_of_patt l in - <:class_str_item< method $id$ = $lid:id$ >>) - x1 - in - <:expr< - let module M = - struct - class a = object $list:list1 @ list2$ end; - end - in - new M.a - >> -; - -value record_match_assoc loc lpl e = - if ocaml_records.val then (<:patt< { $list:lpl$ } >>, e) - else - let pl = List.map (fun (_, p) -> p) lpl in - let e = - let el = - List.map - (fun (l, _) -> - let s = - match l with - [ <:patt< $lid:l$ >> -> l - | _ -> "" ] - in - let loc = MLast.loc_of_patt l in - <:expr< v # $lid:s$ >>) - lpl - in - let loc = MLast.loc_of_expr e in - <:expr< let v = $e$ in ($list:el$) >> - in - let p = <:patt< ($list:pl$) >> in - (p, e) -; - -value op = - Grammar.Entry.of_parser gram "op" - (parser [: `("", "op"); `(_, x) :] -> x) -; -lexer.Token.tok_using ("", "op"); - -value special x = - if String.length x >= 2 then - match x.[0] with - [ '+' | '<' | '^' -> True - | _ -> False ] - else False -; - -value idd = - let p = - parser - [ [: `("LIDENT", x) :] -> x - | [: `("UIDENT", x) :] -> x - | [: `("", "op"); `(_, x) :] -> x - | [: `("", x) when special x :] -> x ] - in - Grammar.Entry.of_parser Pcaml.gram "ID" p -; - -value uncap s = String.uncapitalize s; - -EXTEND - GLOBAL: implem interf top_phrase use_file sig_item str_item ctyp patt expr - module_type module_expr; - - implem: - [ [ x = interdec; EOI -> x ] ] - ; - interf: - [ [ x = LIST1 [ s = sig_item; OPT ";" -> (s, loc) ] -> (x, False) ] ] - ; - top_phrase: - [ [ ph = phrase; ";" -> Some ph - | EOI -> None ] ] - ; - use_file: - [ [ l = LIST0 phrase; EOI -> (l, False) ] ] - ; - phrase: - [ [ x = str_item -> x - | x = expr -> <:str_item< $exp:x$ >> - | "#"; n = LIDENT; dp = dir_param -> MLast.StDir loc n dp ] ] - ; - dir_param: - [ [ -> None - | e = expr -> Some e ] ] - ; - sdecs: - [ [ x = sdec; l = sdecs -> [x :: l] - | ";"; l = sdecs -> l - | -> [] ] ] - ; - - fsigb: [ [ -> not_impl loc "fsigb" ] ]; - fsigconstraint_op: [ [ -> not_impl loc "fsigconstraint_op" ] ]; - fct_exp: [ [ -> not_impl loc "fct_exp" ] ]; - exp_pa: [ [ -> not_impl loc "exp_pa" ] ]; - rvb: [ [ -> not_impl loc "rvb" ] ]; - tyvarseq: [ [ -> not_impl loc "tyvarseq" ] ]; - - tyvar_pc: - [ [ "'"; x1 = LIDENT -> [(x1, (False, False))] - | "'"; x1 = LIDENT; ","; l = tyvar_pc -> [(x1, (False, False)) :: l] ] ] - ; - id: - [ [ x1 = idd -> x1 - | "*" -> "*" ] ] - ; - ident: - [ [ x1 = idd -> x1 - | "*" -> "*" - | "=" -> "=" - | "<" -> "<" - | ">" -> ">" - | "<=" -> "<=" - | ">=" -> ">=" - | "^" -> "^" ] ] - ; - op_op: - [ [ x1 = op -> not_impl loc "op_op 1" - | -> () ] ] - ; - qid: - [ [ x1 = idd; "."; x2 = qid -> <:module_expr< $uid:x1$ . $x2$ >> - | x1 = idd -> <:module_expr< $uid:x1$ >> - | x1 = "*" -> <:module_expr< $uid:x1$ >> - | x1 = "=" -> <:module_expr< $uid:x1$ >> ] ] - ; - eqid: - [ [ x1 = UIDENT; "."; x2 = eqid -> <:expr< $uid:x1$ . $x2$ >> - | x1 = UIDENT -> <:expr< $uid:x1$ >> - | x1 = idd -> <:expr< $lid:x1$ >> - | x1 = "*" -> <:expr< $lid:x1$ >> - | x1 = "=" -> <:expr< $lid:x1$ >> ] ] - ; - sqid: - [ [ x1 = idd; "."; x2 = sqid -> [x1 :: x2] - | x1 = idd -> [x1] - | x1 = "*" -> [x1] - | x1 = "=" -> [x1] ] ] - ; - tycon: - [ [ LIDENT "real" -> <:ctyp< float >> - | x1 = idd; "."; x2 = tycon -> - let r = <:ctyp< $uid:x1$ . $x2$ >> in - loop r where rec loop = - fun - [ <:ctyp< $a$ . ($b$ . $c$) >> -> <:ctyp< $a$ . $b$ . $loop c$ >> - | x -> x ] - | x1 = idd -> <:ctyp< $lid:uncap x1$ >> ] ] - ; - selector: - [ [ x1 = id -> x1 - | x1 = INT -> not_impl loc "selector 1" ] ] - ; - tlabel: - [ [ x1 = selector; ":"; x2 = ctyp -> (loc, x1, False, x2) ] ] - ; - tuple_ty: - [ [ x1 = ctyp LEVEL "ty'"; "*"; x2 = tuple_ty -> [x1 :: x2] - | x1 = ctyp LEVEL "ty'" -> [x1] ] ] - ; - ctyp: - [ RIGHTA - [ x1 = ctyp; "->"; x2 = ctyp -> <:ctyp< $x1$ -> $x2$ >> ] - | [ x1 = ctyp; "*"; x2 = tuple_ty -> <:ctyp< ($list:[x1 :: x2]$) >> ] - | "ty'" - [ "'"; x1 = LIDENT -> <:ctyp< '$x1$ >> - | "'"; "'"; x1 = LIDENT -> <:ctyp< '$x1$ >> - | "{"; x1 = LIST1 tlabel SEP ","; "}" -> - if ocaml_records.val then <:ctyp< { $list:x1$ } >> - else - let list = List.map (fun (_, l, _, t) -> (l, t)) x1 in - <:ctyp< < $list:list$ > >> - | "{"; "}" -> not_impl loc "ty' 3" - | "("; x1 = ctyp; ","; x2 = LIST1 ctyp SEP ","; ")"; x3 = tycon -> - List.fold_left (fun t1 t2 -> <:ctyp< $t1$ $t2$ >>) x3 [x1 :: x2] - | "("; x1 = ctyp; ")" -> x1 - | x1 = ctyp; x2 = tycon -> <:ctyp< $x2$ $x1$ >> - | x1 = tycon -> x1 ] ] - ; - rule: - [ [ x1 = patt; "=>"; x2 = expr -> (x1, None, x2) ] ] - ; - elabel: - [ [ x1 = selector; "="; x2 = expr -> (<:patt< $lid:x1$ >>, x2) ] ] - ; - exp_ps: - [ [ x1 = expr -> x1 - | x1 = expr; ";"; x2 = exp_ps -> - <:expr< do { $list:[x1 :: get_seq x2]$ } >> ] ] - ; - expr: - [ [ "if"; x1 = expr; "then"; x2 = expr; "else"; x3 = expr -> - <:expr< if $x1$ then $x2$ else $x3$ >> - | "fn"; x1 = LIST1 rule SEP "|" -> <:expr< fun [$list:x1$] >> - | "case"; x1 = expr; "of"; x2 = LIST1 rule SEP "|" -> - <:expr< match $x1$ with [$list:x2$] >> - | "while"; x1 = expr; "do"; x2 = expr -> - <:expr< while $x1$ do { $x2$ } >> - | x1 = expr; "handle"; x2 = LIST1 rule SEP "|" -> - <:expr< try $x1$ with [$list:x2$] >> ] - | RIGHTA - [ "raise"; x1 = expr -> <:expr< raise $x1$ >> ] - | [ e1 = expr; ":="; e2 = expr -> <:expr< $e1$.val := $e2$ >> ] - | LEFTA - [ x1 = expr; "orelse"; x2 = expr -> <:expr< $x1$ || $x2$ >> ] - | LEFTA - [ x1 = expr; "andalso"; x2 = expr -> <:expr< $x1$ && $x2$ >> ] - | LEFTA - [ x1 = expr; ":"; x2 = ctyp -> <:expr< ($x1$ : $x2$) >> ] - | "4" NONA - [ x1 = expr; "<"; x2 = expr -> <:expr< $x1$ < $x2$ >> - | x1 = expr; ">"; x2 = expr -> <:expr< $x1$ > $x2$ >> - | x1 = expr; "<>"; x2 = expr -> <:expr< $x1$ <> $x2$ >> - | x1 = expr; "="; x2 = expr -> <:expr< $x1$ = $x2$ >> - | x1 = expr; ">="; x2 = expr -> <:expr< $x1$ >= $x2$ >> - | x1 = expr; "<="; x2 = expr -> <:expr< $x1$ <= $x2$ >> ] - | RIGHTA - [ x1 = expr; "^"; x2 = expr -> <:expr< $x1$ ^ $x2$ >> - | x1 = expr; "@"; x2 = expr -> <:expr< $x1$ @ $x2$ >> - | x1 = expr; "o"; x2 = expr -> <:expr< ooo $x1$ $x2$ >> ] - | "5" RIGHTA - [ x1 = expr; "::"; x2 = expr -> <:expr< [$x1$ :: $x2$] >> ] - | "6" LEFTA - [ x1 = expr; "+"; x2 = expr -> <:expr< $x1$ + $x2$ >> - | x1 = expr; "-"; x2 = expr -> <:expr< $x1$ - $x2$ >> ] - | "7" LEFTA - [ x1 = expr; "*"; x2 = expr -> <:expr< $x1$ * $x2$ >> - | x1 = expr; "/"; x2 = expr -> <:expr< $x1$ / $x2$ >> - | x1 = expr; "div"; x2 = expr -> <:expr< $x1$ / $x2$ >> - | x1 = expr; "mod"; x2 = expr -> <:expr< $x1$ mod $x2$ >> ] - | LEFTA - [ x1 = expr; x2 = expr -> <:expr< $x1$ $x2$ >> ] - | [ "#"; x1 = STRING -> <:expr< $chr:x1$ >> - | "#"; x1 = selector; x2 = expr -> - if ocaml_records.val then <:expr< $x2$ . $lid:x1$ >> - else <:expr< $x2$ # $lid:x1$ >> - | x1 = expr; "ocaml_record_access"; x2 = expr -> <:expr< $x1$ . $x2$ >> ] - | [ "!"; x1 = expr -> <:expr< $x1$ . val >> - | "~"; x1 = expr -> <:expr< - $x1$ >> ] - | [ x1 = LIDENT -> - match x1 with - [ "true" | "false" -> <:expr< $uid:String.capitalize x1$ >> - | "nil" -> <:expr< [] >> - | _ -> <:expr< $lid:x1$ >> ] - | x1 = UIDENT -> <:expr< $uid:x1$ >> - | x1 = UIDENT; "."; x2 = eqid -> <:expr< $uid:x1$ . $x2$ >> - | x1 = INT -> <:expr< $int:x1$ >> - | x1 = FLOAT -> <:expr< $flo:x1$ >> - | x1 = STRING -> <:expr< $str:x1$ >> - | "~"; x1 = INT -> <:expr< $int:"-"^x1$ >> - | i = op -> - if i = "::" then <:expr< fun (x, y) -> [x :: y] >> - else <:expr< fun (x, y) -> $lid:i$ x y >> - | "let"; x1 = ldecs; "in"; x2 = exp_ps; "end" -> - List.fold_right - (fun pel x2 -> - let loc = - match pel with - [ [(p, _) :: _] -> - (fst (MLast.loc_of_patt p), snd (MLast.loc_of_expr x2)) - | _ -> loc ] - in - match pel with - [ [(_, <:expr< fun [$list:_$] >>) :: _] -> - <:expr< let rec $list:pel$ in $x2$ >> - | _ -> - let pel = - List.map - (fun (p, e) -> - match p with - [ <:patt< { $list:lpl$ } >> -> - record_match_assoc (MLast.loc_of_patt p) lpl e - | _ -> (p, e) ]) - pel - in - <:expr< let $list:pel$ in $x2$ >> ]) - x1 x2 - | "{"; x1 = LIST1 elabel SEP ","; "}" -> record_expr loc x1 - | "["; "]" -> <:expr< [] >> - | "["; x1 = expr; "]" -> <:expr< [$x1$] >> - | "["; x1 = expr; ","; x2 = LIST1 SELF SEP ","; "]" -> - mklistexp loc None [x1 :: x2] - | "("; ")" -> <:expr< () >> - | "("; x1 = expr; ","; x2 = LIST1 SELF SEP ","; ")" -> - <:expr< ($list:[x1::x2]$) >> - | "("; x1 = expr; ";"; x2 = LIST1 SELF SEP ";"; ")" -> - <:expr< do { $list:[x1::x2]$ } >> - | "("; x1 = expr; ")" -> x1 ] ] - ; - fixity: - [ [ "infix" -> ("infix", None) - | "infix"; x1 = INT -> not_impl loc "fixity 2" - | "infixr" -> not_impl loc "fixity 3" - | "infixr"; x1 = INT -> ("infixr", Some x1) - | "nonfix" -> not_impl loc "fixity 5" ] ] - ; - patt: - [ [ x1 = patt; "as"; x2 = patt -> <:patt< ($x1$ as $x2$) >> ] - | LEFTA - [ x1 = patt; ":"; x2 = ctyp -> <:patt< ($x1$ : $x2$) >> ] - | RIGHTA - [ x1 = patt; "::"; x2 = patt -> <:patt< [$x1$ :: $x2$] >> ] - | [ x1 = patt; x2 = patt -> - match x1 with - [ <:patt< ref >> -> <:patt< {contents = $x2$} >> - | _ -> <:patt< $x1$ $x2$ >> ] ] - | "apat" - [ x1 = patt; "."; x2 = patt -> <:patt< $x1$ . $x2$ >> - | x1 = INT -> <:patt< $int:x1$ >> - | x1 = UIDENT -> <:patt< $uid:x1$ >> - | x1 = STRING -> <:patt< $str:x1$ >> - | "#"; x1 = STRING -> <:patt< $chr:x1$ >> - | "~"; x1 = INT -> <:patt< $int:"-"^x1$ >> - | LIDENT "nil" -> <:patt< [] >> - | LIDENT "false" -> <:patt< False >> - | LIDENT "true" -> <:patt< True >> - | x1 = id -> <:patt< $lid:x1$ >> - | x1 = op -> <:patt< $lid:x1$ >> - | "_" -> <:patt< _ >> - | "["; "]" -> <:patt< [] >> - | "["; x1 = patt; "]" -> <:patt< [$x1$] >> - | "["; x1 = patt; ","; x2 = LIST1 SELF SEP ","; "]" -> - mklistpat loc None [x1 :: x2] - | "{"; x1 = LIST1 plabel SEP ","; "}" -> <:patt< {$list:x1$} >> - | "("; ")" -> <:patt< () >> - | "("; x1 = patt; ","; x2 = LIST1 SELF SEP ","; ")" -> - <:patt< ($list:[x1::x2]$) >> - | "("; x1 = patt; ")" -> x1 ] ] - ; - plabel: - [ [ x1 = selector; "="; x2 = patt -> (<:patt< $lid:x1$ >>, x2) - | x1 = selector -> (<:patt< $lid:x1$ >>, <:patt< $lid:x1$ >>) ] ] - ; - vb: - [ [ "lazy"; x1 = patt; "="; x2 = expr -> not_impl loc "vb 1" - | x1 = patt; "="; x2 = expr -> (x1, x2) ] ] - ; - constrain: - [ [ -> None - | ":"; x1 = ctyp -> Some x1 ] ] - ; - fb: - [ [ xl = LIST1 clause SEP "|" -> function_of_clause_list loc xl - | "lazy"; x1 = LIST1 clause SEP "|" -> not_impl loc "fb 2" ] ] - ; - clause: - [ [ x1 = patt LEVEL "apat"; x2 = LIST1 (patt LEVEL "apat"); - x3 = constrain; "="; x4 = expr -> - let x1 = - match x1 with - [ <:patt< $lid:id$ >> -> (id, MLast.loc_of_patt x1) - | _ -> not_impl loc "clause 1" ] - in - (x1, x2, x3, x4) ] ] - ; - tb: - [ [ x1 = tyvars; x2 = idd; "="; x3 = ctyp -> - ((loc, uncap x2), x1, x3, []) - | x1 = tyvars; x2 = idd; "="; x3 = ctyp; "=="; x4 = dbrhs -> - let x4 = List.map (fun (loc, c, tl, _) -> (loc, c, tl)) x4 in - ((loc, uncap x2), x1, <:ctyp< $x3$ == [ $list:x4$ ] >>, []) ] ] - ; - tyvars: - [ [ "'"; x1 = LIDENT -> [(x1, (False, False))] - | "("; x1 = tyvar_pc; ")" -> x1 - | -> [] ] ] - ; - db1: - [ [ x1 = tyvars; x2 = ident; "="; x3 = dbrhs -> - let x2 = uncap x2 in - extract_label_types loc x2 x1 x3 - | "lazy"; x1 = tyvars; x2 = ident; "="; x3 = dbrhs -> - not_impl loc "db 2" ] ] - ; - db: - [ [ x1 = LIST1 db1 SEP "and" -> - List.fold_right (fun td tdl -> td @ tdl) x1 [] ] ] - ; - dbrhs: - [ [ x1 = LIST1 constr SEP "|" -> x1 - | "datatype"; x1 = tycon -> not_impl loc "dbrhs 2" ] ] - ; - constr: - [ [ x1 = op_op; x2 = ident -> (loc, x2, [], None) - | x1 = op_op; x2 = ident; "of"; x3 = ctyp -> - match x3 with - [ <:ctyp< {$list:_$} >> -> (loc, x2, [], Some x3) - | _ -> (loc, x2, [x3], None) ] ] ] - ; - eb: - [ [ x1 = op_op; x2 = ident -> (x2, [], []) - | x1 = op_op; x2 = ident; "of"; x3 = ctyp -> (x2, [x3], []) - | x1 = op_op; x2 = ident; "="; x3 = sqid -> (x2, [], x3) ] ] - ; - ldec1: - [ [ "val"; x1 = LIST1 vb SEP "and" -> x1 - | "fun"; x1 = LIST1 fb SEP "and" -> x1 ] ] - ; - ldecs: - [ [ -> [] - | x1 = ldec1; x2 = ldecs -> [x1 :: x2] - | ";"; x1 = ldecs -> x1 - | "local"; x1 = ldecs; "in"; x2 = ldecs; "end"; x3 = ldecs -> - not_impl loc "ldecs 4" ] ] - ; - spec_s: - [ [ -> [] - | x1 = spec; x2 = spec_s -> [x1 :: x2] - | ";"; x1 = spec_s -> x1 ] ] - ; - spec: - [ [ "structure"; x1 = LIST1 strspec SEP "and" -> sig_declare loc x1 - | "functor"; x1 = LIST1 fctspec SEP "and" -> sig_declare loc x1 - | "datatype"; x1 = db -> <:sig_item< type $list:x1$ >> - | "type"; x1 = LIST1 tyspec SEP "and" -> <:sig_item< type $list:x1$ >> - | "eqtype"; x1 = LIST1 tyspec SEP "and" -> <:sig_item< type $list:x1$ >> - | "val"; x1 = LIST1 valspec SEP "and" -> sig_declare loc x1 - | "exception"; x1 = LIST1 exnspec SEP "and" -> sig_declare loc x1 - | "sharing"; x1 = LIST1 sharespec SEP "and" -> <:sig_item< declare end >> - | "include"; x1 = module_type -> <:sig_item< include $x1$ >> ] ] - ; - sig_item: - [ [ x = spec -> x ] ] - ; - strspec: - [ [ x1 = ident; ":"; x2 = module_type; x3 = LIST0 sharing_def -> - let x2 = - List.fold_left - (fun mt sdl -> - List.fold_right - (fun spl mt -> - match spl with - [ Right ([m1], m2) -> - let (m1, m2) = - match m2 with - [ <:module_expr< $uid:x$ . $_$ >> -> - if x = x1 then (m2, m1) else (m1, m2) - | _ -> (m1, m2) ] - in - let m1 = - loop m1 where rec loop = - fun - [ <:module_expr< $uid:x$ >> -> x - | <:module_expr< $uid:x$ . $y$ >> -> loop y - | _ -> not_impl loc "strspec 2" ] - in - <:module_type< $mt$ with module $[m1]$ = $m2$ >> - | _ -> not_impl loc "strspec 1" ]) - sdl mt) - x2 x3 - in - <:sig_item< module $x1$ : $x2$ >> ] ] - ; - sharing_def: - [ [ "sharing"; x3 = LIST1 sharespec SEP "and" -> x3 ] ] - ; - fctspec: - [ [ x1 = ident; x2 = fsig -> <:sig_item< module $x1$ : $x2$ >> ] ] - ; - tyspec: - [ [ x1 = tyvars; x2 = idd -> - ((loc, uncap x2), x1, <:ctyp< '$choose_tvar x1$ >>, []) - | x1 = tyvars; x2 = idd; "="; x3 = ctyp -> - ((loc, uncap x2), x1, x3, []) ] ] - ; - valspec: - [ [ x1 = op_op; x2 = ident; ":"; x3 = ctyp -> - <:sig_item< value $x2$ : $x3$ >> ] ] - ; - exnspec: - [ [ x1 = ident -> <:sig_item< exception $x1$ >> - | x1 = ident; "of"; x2 = ctyp -> - <:sig_item< exception $x1$ of $x2$ >> ] ] - ; - sharespec: - [ [ "type"; x1 = patheqn -> Left x1 - | x1 = patheqn -> Right x1 ] ] - ; - patheqn: - [ [ l = patheqn1 -> l ] ] - ; - patheqn1: - [ [ (l, y) = patheqn1; "="; x = qid -> ([y :: l], x) - | x = qid -> ([], x) ] ] - ; - whspec: - [ [ "type"; x1 = tyvars; x2 = sqid; "="; x3 = ctyp -> - MLast.WcTyp loc x2 x1 x3 - | x1 = sqid; "="; x2 = qid -> MLast.WcMod loc x1 x2 ] ] - ; - module_type: - [ [ x1 = ident -> <:module_type< $uid:x1$ >> - | "sig"; x1 = spec_s; "end" -> <:module_type< sig $list:x1$ end >> - | x1 = module_type; "where"; x2 = LIST1 whspec SEP "and" -> - <:module_type< $x1$ with $list:x2$ >> ] ] - ; - sigconstraint_op: - [ [ -> None - | ":"; x1 = module_type -> Some x1 - | ":>"; x1 = module_type -> not_impl loc "sigconstraint_op 3" ] ] - ; - sigb: - [ [ x1 = ident; "="; x2 = module_type -> - <:str_item< module type $x1$ = $x2$ >> ] ] - ; - fsig: - [ [ ":"; x1 = ident -> not_impl loc "fsig 1" - | x1 = fparamList; ":"; x2 = module_type -> not_impl loc "fsig 2" ] ] - ; - module_expr: - [ [ x1 = qid -> x1 - | "struct"; x1 = strdecs; "end" -> <:module_expr< struct $list:x1$ end >> - | x1 = qid; x2 = arg_fct -> - match x2 with - [ Left [] -> x1 - | Left x2 -> <:module_expr< $x1$ (struct $list:x2$ end) >> - | Right x2 -> <:module_expr< $x1$ $x2$ >> ] - | "let"; x1 = strdecs; "in"; x2 = module_expr; "end" -> - not_impl loc "str 4" - | x1 = module_expr; ":"; x2 = module_type -> not_impl loc "str 5" - | x1 = module_expr; x2 = ":>"; x3 = module_type -> - not_impl loc "str 6" ] ] - ; - arg_fct: - [ [ "("; x1 = strdecs; ")"; x2 = arg_fct -> not_impl loc "arg_fct 1" - | "("; x1 = module_expr; ")"; x2 = arg_fct -> not_impl loc "arg_fct 2" - | "("; x1 = module_expr; ")" -> Right x1 - | "("; x2 = strdecs; ")" -> Left x2 ] ] - ; - strdecs: - [ [ x1 = str_item LEVEL "strdec"; x2 = strdecs -> [x1 :: x2] - | ";"; x1 = strdecs -> x1 - | -> [] ] ] - ; - str_item: - [ [ "signature"; x1 = LIST1 sigb SEP "and" -> str_declare loc x1 - | "funsig"; x1 = fsigb -> not_impl loc "sdec 3" ] - | "strdec" - [ "structure"; x1 = LIST1 strb SEP "and" -> str_declare loc x1 - | "functor"; x1 = LIST1 fctb SEP "and" -> str_declare loc x1 - | "local"; x1 = sdecs; "in"; x2 = sdecs; "end" -> - make_local loc x1 x2 ] - | [ "val"; x1 = LIST1 vb SEP "and" -> <:str_item< value $list:x1$ >> - | "val"; x1 = tyvarseq; x3 = LIST1 vb SEP "and" -> - not_impl loc "ldec 2" - | "val"; "rec"; x1 = rvb -> not_impl loc "ldec 3" - | "val"; "rec"; x1 = tyvarseq; x2 = rvb -> not_impl loc "ldec 4" - | "fun"; x1 = LIST1 fb SEP "and" -> <:str_item< value rec $list:x1$ >> - | "fun"; x1 = tyvarseq; x2 = fb -> not_impl loc "ldec 6" - | "type"; x1 = LIST1 tb SEP "and" -> <:str_item< type $list:x1$ >> - | "datatype"; x1 = db -> <:str_item< type $list:x1$ >> - | "datatype"; x1 = db; "withtype"; x2 = tb -> - <:str_item< type $list:x1 @ [x2]$ >> - | "abstype"; x1 = db; "with"; x2 = ldecs; "end" -> not_impl loc "ldec 10" - | "abstype"; x1 = db; "withtype"; x2 = tb; "with"; x3 = ldecs; "end" -> - not_impl loc "ldec 11" - | "exception"; x1 = LIST1 eb SEP "and" -> - let dl = - List.map - (fun (s, tl, eqn) -> - <:str_item< exception $s$ of $list:tl$ = $eqn$ >>) - x1 - in - str_declare loc dl - | "open"; x1 = LIST1 sqid -> - let dl = List.map (fun sl -> <:str_item< open $sl$ >>) x1 in - str_declare loc dl - | LIDENT "use"; s = STRING -> - <:str_item< #use $str:s$ >> - | x1 = fixity; list = LIST1 idd -> - match x1 with - [ ("infixr", Some n) -> - do { - List.iter - (fun s -> - EXTEND - expr: LEVEL $n$ - [ [ x1 = expr; $s$; x2 = expr -> - <:expr< $lid:s$ ($x1$, $x2$) >> ] ] - ; - END) - list; - str_declare loc [] - } - | ("infix", None) -> - do { - List.iter - (fun s -> - EXTEND - expr: LEVEL "4" - [ [ x1 = expr; $s$; x2 = expr -> - <:expr< $lid:s$ ($x1$, $x2$) >> ] ] - ; - clause: - [ [ x1 = patt LEVEL "apat"; $s$; - x2 = patt LEVEL "apat"; "="; x4 = expr -> - ((s, loc), [<:patt< ($x1$, $x2$) >>], - None, x4) ] ] - ; - END) - list; - str_declare loc [] - } - | _ -> not_impl loc "ldec 14" ] - | "overload"; x1 = ident; ":"; x2 = ctyp; "as"; x3 = exp_pa -> - not_impl loc "ldec 15" - | x = expr -> <:str_item< $exp:x$ >> ] ] - ; - sdec: - [ [ x = str_item -> x ] ] - ; - strb: - [ [ x1 = ident; x2 = sigconstraint_op; "="; x3 = module_expr -> - let x3 = - match x2 with - [ Some x2 -> <:module_expr< ($x3$ : $x2$) >> - | None -> x3 ] - in - <:str_item< module $x1$ = $x3$ >> ] ] - ; - fparam: - [ [ x1 = idd; ":"; x2 = module_type -> [<:sig_item< module $x1$ : $x2$ >>] - | x1 = spec_s -> x1 ] ] - ; - fparamList: - [ [ "("; x1 = fparam; ")" -> [x1] - | "("; x1 = fparam; ")"; x2 = fparamList -> [x1 :: x2] ] ] - ; - fctb: - [ [ x1 = ident; x2 = fparamList; x3 = sigconstraint_op; "="; - x4 = module_expr -> - let list = List.flatten x2 in - let x4 = - if list = [] then x4 - else - match x4 with - [ <:module_expr< struct $list:list$ end >> -> - let si = - let loc = (Token.nowhere, Token.nowhere) in - <:str_item< open AAA >> in - <:module_expr< struct $list:[si :: list]$ end >> - | _ -> not_impl loc "fctb 1" ] - in - let x4 = - match x3 with - [ Some x3 -> <:module_expr< ($x4$ : $x3$) >> - | None -> x4 ] - in - let x4 = - if list = [] then x4 - else - let mt = - let loc = - (fst (MLast.loc_of_sig_item (List.hd list)), - snd (MLast.loc_of_sig_item (List.hd (List.rev list)))) - in - <:module_type< sig $list:list$ end >> - in - <:module_expr< functor (AAA : $mt$) -> $x4$ >> - in - <:str_item< module $x1$ = $x4$ >> - | x1 = ident; x2 = fsigconstraint_op; "="; x3 = fct_exp -> - not_impl loc "fctb 2" ] ] - ; - interdec: - [ [ x = LIST1 [ s = str_item; OPT ";" -> (s, loc) ] -> (x, False) - | x = expr; OPT ";" -> not_impl loc "interdec 2" ] ] - ; -END; - -Pcaml.add_option "-records" (Arg.Set ocaml_records) - "Convert record into OCaml records, instead of objects"; diff -Nru ocaml-3.12.1/camlp4/unmaintained/sml/smllib.sml ocaml-4.01.0/camlp4/unmaintained/sml/smllib.sml --- ocaml-3.12.1/camlp4/unmaintained/sml/smllib.sml 2008-10-27 14:03:15.000000000 +0000 +++ ocaml-4.01.0/camlp4/unmaintained/sml/smllib.sml 1970-01-01 00:00:00.000000000 +0000 @@ -1,395 +0,0 @@ -(***********************************************************************) -(* *) -(* Camlp4 *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2002 Institut National de Recherche en Informatique et *) -(* Automatique. Distributed only by permission. *) -(* *) -(***********************************************************************) - - - -datatype 'a option = SOME of 'a | NONE -exception Fail of string -exception Domain -exception Subscript -type 'a vector = 'a array - -structure OCaml = - struct - structure List = List - structure String = String - end - -structure Time = - struct - datatype time = TIME of { sec : int, usec : int } - fun toString _ = failwith "not implemented Time.toString" - fun now _ = failwith "not implemented Time.now" - end - -datatype cpu_timer = - CPUT of { gc : Time.time, sys : Time.time, usr : Time.time } - -datatype real_timer = - RealT of Time.time - -structure Char = - struct - val ord = Char.code - end - -structure General = - struct - datatype order = LESS | EQUAL | GREATER - end -type order = General.order == LESS | EQUAL | GREATER - -structure OS = - struct - exception SysErr - structure Path = - struct - fun dir s = - let val r = Filename.dirname s in - if r = "." then "" else r - end - val file = Filename.basename - fun ext s = - let fun loop i = - if i < 0 then NONE - else if String.get s i = #"." then - let val len = String.length s - i - 1 in - if len = 0 then NONE else SOME (String.sub s (i + 1) len) - end - else loop (i - 1) - in - loop (String.length s - 1) - end - fun splitDirFile s = - {dir = Filename.dirname s, - file = Filename.basename s} - fun joinDirFile x = - let val {dir,file} = x in Filename.concat dir file end - end - structure FileSys = - struct - datatype access_mode = A_READ | A_WRITE | A_EXEC - val chDir = Sys.chdir - fun isDir s = - (Unix.stat s) ocaml_record_access Unix.st_kind = Unix.S_DIR - handle Unix.Unix_error _ => raise SysErr - fun access (s, accs) = - let val st = Unix.stat s - val prm = st ocaml_record_access Unix.st_perm - val prm = - if st ocaml_record_access Unix.st_uid = Unix.getuid () then - lsr prm 6 - else if st ocaml_record_access Unix.st_uid = Unix.getgid () - then - lsr prm 3 - else prm - val rf = - if List.mem A_READ accs then land prm 4 <> 0 else true - val wf = - if List.mem A_WRITE accs then land prm 2 <> 0 else true - val xf = - if List.mem A_EXEC accs then land prm 1 <> 0 else true - in - rf andalso wf andalso xf - end - handle Unix.Unix_error (_, f, _) => - if f = "stat" then false else raise SysErr - end - structure Process = - struct - fun system s = (flush stdout; flush stderr; Sys.command s) - fun getEnv s = SOME (Sys.getenv s) handle Not_found => NONE - val success = 0 - end - end - -exception SysErr = OS.SysErr - -structure IO = - struct - exception Io of {cause:exn, function:string, name:string} - end - -structure TextIO = - struct - type instream = in_channel * char option option ref - type outstream = out_channel - type elem = char - type vector = string - fun openIn fname = - (open_in fname, ref NONE) handle exn => - raise IO.Io {cause = exn, function = "openIn", name = fname} - val openOut = open_out - fun closeIn (ic, ahc) = (ahc := SOME NONE; close_in ic) - val closeOut = close_out - val stdIn = (stdin, ref (NONE : char option option)) - fun endOfStream (ic, _) = pos_in ic = in_channel_length ic - fun inputLine (ic, ahc) = - case !ahc of - NONE => - (input_line ic ^ "\n" handle End_of_file => (ahc := SOME NONE; "")) - | SOME NONE => "" - | SOME (SOME c) => - (ahc := NONE; - if c = #"\n" then "\n" - else - String.make 1 c ^ input_line ic ^ "\n" handle - End_of_file => (ahc := SOME NONE; "")) - fun input1 (ic, ahc) = - case !ahc of - NONE => - (SOME (input_char ic) handle End_of_file => (ahc := SOME NONE; NONE)) - | SOME NONE => NONE - | SOME x => (ahc := NONE; x) - fun inputN (ins, n) = - let fun loop n = - if n <= 0 then "" - else - case input1 ins of - SOME c => String.make 1 c ^ loop (n - 1) - | NONE => "" - in - loop n - end - fun output (oc, v) = output_string oc v - fun inputAll ic = failwith "not implemented TextIO.inputAll" - fun lookahead (ic, ahc) = - case !ahc of - NONE => let val r = SOME (input_char ic) in ahc := SOME r; r end - | SOME x => x - fun print s = (print_string s; flush stdout) - end - -structure Timer = - struct - fun startRealTimer () = failwith "not implemented Timer.startRealTimer" - fun startCPUTimer () = failwith "not implemented Timer.startCPUTimer" - fun checkRealTimer _ = failwith "not implemented Timer.checkRealTimer" - fun checkCPUTimer _ = failwith "not implemented Timer.checkCPUTimer" - end - -structure Date = - struct - datatype month = - Jan | Feb | Mar | Apr | May | Jun | Jul | Sep | Oct | Nov | Dec - datatype wday = Sun | Mon | Tue | Wed | Thu | Fri | Sat - datatype date = - DATE of - {day : int, hour : int, isDst : bool option, minute : int, - month : month, offset : int option, second : int, wday : wday, - yday : int, year : int} - fun fmt _ _ = failwith "not implemented Date.fmt" - fun fromTimeLocal _ = failwith "not implemented Date.fromTimeLocal" - end - -structure Posix = - struct - structure ProcEnv = - struct - fun getenv s = SOME (Sys.getenv s) handle Not_found => NONE - end - end - -structure SMLofNJ = - struct - fun exportML s = failwith ("not implemented exportML " ^ s) - end - -fun null x = x = [] -fun explode s = - let fun loop i = - if i = String.length s then [] - else String.get s i :: loop (i + 1) - in - loop 0 - end - -val app = List.iter -fun implode [] = "" - | implode (c :: l) = String.make 1 c ^ implode l - -fun ooo f g x = f (g x) - -structure Array = - struct - fun array (len, v) = Array.create len v - fun sub _ = failwith "not implemented Array.sub" - fun update _ = failwith "not implemented Array.update" - (* for make the profiler work *) - val set = Array.set - val get = Array.get - end - -structure Vector = - struct - fun tabulate _ = failwith "not implemented Vector.tabulate" - fun sub _ = failwith "not implemented Vector.sub" - end - -structure Bool = - struct - val toString = string_of_bool - end - -structure String = - struct - val size = String.length - fun substring (s, beg, len) = - String.sub s beg len handle Invalid_argument _ => raise Subscript - val concat = String.concat "" - fun sub (s, i) = String.get s i - val str = String.make 1 - fun compare (s1, s2) = - if s1 < s2 then LESS - else if s1 > s2 then GREATER - else EQUAL - fun isPrefix s1 s2 = - let fun loop i1 i2 = - if i1 >= String.length s1 then true - else if i2 >= String.length s2 then false - else if String.get s1 i1 = String.get s2 i2 then loop (i1 + 1) (i2 + 1) - else false - in - loop 0 0 - end - fun tokens p s = - let fun loop tok i = - if i >= String.length s then - if tok = "" then [] else [tok] - else if p (String.get s i) then - if tok <> "" then tok :: loop "" (i + 1) - else loop "" (i + 1) - else loop (tok ^ String.make 1 (String.get s i)) (i + 1) - in - loop "" 0 - end - fun extract _ = failwith "not implemented String.extract" - end - -structure Substring = - struct - type substring = string * int * int - fun string (s : substring) = String.substring s - fun all s : substring = (s, 0, String.size s) - fun splitl f ((s, beg, len) : substring) : substring * substring = - let fun loop di = - if di = len then ((s, beg, len), (s, 0, 0)) - else if f (String.sub (s, beg + di)) then loop (di + 1) - else ((s, beg, di), (s, beg + di, len - di)) - in - loop 0 - end - fun getc (s, i, len) = - if len > 0 andalso i < String.size s then - SOME (String.sub (s, i), (s, i+1, len-1)) - else NONE - fun slice _ = failwith "not implemented: Substring.slice" - fun isEmpty (s, beg, len) = len = 0 - fun concat sl = String.concat (List.map string sl) - end -type substring = Substring.substring - -structure StringCvt = - struct - datatype radix = BIN | OCT | DEC | HEX - type ('a, 'b) reader = 'b -> ('a * 'b) option - end - -structure ListPair = - struct - fun zip (a1::l1, a2::l2) = (a1, a2) :: zip (l1, l2) - | zip _ = [] - val unzip = List.split - fun all f (x1 :: l1, x2 :: l2) = f (x1, x2) andalso all f (l1, l2) - | all _ _ = true - fun map f (a1::l1, a2::l2) = - let val r = f (a1, a2) in r :: map f (l1, l2) end - | map _ _ = [] - end - -structure ListMergeSort = - struct - fun uniqueSort cmp l = - List.sort - (fn x => fn y => - case cmp (x, y) of - LESS => ~1 - | EQUAL => 0 - | GREATER => 1) - l - end - -structure List = - struct - exception Empty - fun hd [] = raise Empty - | hd (x :: l) = x - fun tl [] = raise Empty - | tl (x :: l) = l - fun foldr f a l = - let fun loop a [] = a - | loop a (x :: l) = loop (f (x, a)) l - in - loop a (List.rev l) - end - fun foldl f a l = List.fold_left (fn a => fn x => f (x, a)) a l - val concat = List.flatten - val exists = List.exists - val filter = List.filter - val length = List.length - val map = List.map - val rev = List.rev - val all = List.for_all - fun find f [] = NONE - | find f (x :: l) = if f x then SOME x else find f l - fun last s = - case List.rev s of - [] => raise Empty - | x :: _ => x - fun take _ = failwith "not implemented: List.take" - fun partition _ = failwith "not implemented: List.partition" - fun mapPartial f [] = [] - | mapPartial f (x :: l) = - case f x of - NONE => mapPartial f l - | SOME y => y :: mapPartial f l - fun op @ l1 l2 = List.rev_append (List.rev l1) l2 - end - -structure Int = - struct - type int1 = int - type int = int1 - val toString = string_of_int - fun fromString s = SOME (int_of_string s) handle Failure _ => NONE - fun min (x, y) = if x < y then x else y - fun max (x, y) = if x > y then x else y - fun scan radix getc src = failwith "not impl: Int.scan" - end - -val foldr = List.foldr -val exists = List.exists -val size = String.size -val substring = String.substring -val concat = String.concat -val length = List.length -val op @ = List.op @ -val hd = List.hd -val tl = List.tl -val map = List.map -val rev = List.rev -val use_hook = ref (fn (s : string) => (failwith "no defined directive use" : unit)) -fun use s = !use_hook s -fun isSome (SOME _) = true - | isSome NONE = false -fun valOf (SOME x) = x - | valOf NONE = failwith "valOf" -val print = TextIO.print diff -Nru ocaml-3.12.1/config/.cvsignore ocaml-4.01.0/config/.cvsignore --- ocaml-3.12.1/config/.cvsignore 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/config/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,4 +0,0 @@ -m.h -s.h -Makefile -config.sh diff -Nru ocaml-3.12.1/config/.ignore ocaml-4.01.0/config/.ignore --- ocaml-3.12.1/config/.ignore 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/config/.ignore 2012-07-17 15:31:12.000000000 +0000 @@ -0,0 +1,4 @@ +m.h +s.h +Makefile +config.sh diff -Nru ocaml-3.12.1/config/Makefile-templ ocaml-4.01.0/config/Makefile-templ --- ocaml-3.12.1/config/Makefile-templ 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/config/Makefile-templ 2013-03-22 18:21:46.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -11,8 +11,6 @@ # # ######################################################################### -# $Id: Makefile-templ 9547 2010-01-22 12:48:24Z doligez $ - ### Compile-time configuration ########## General configuration @@ -46,19 +44,15 @@ #BYTECC=cc ### Additional compile-time options for $(BYTECC). -# If using gcc on Intel 386 or Motorola 68k: +# If using gcc on Intel x86: # (the -fno-defer-pop option circumvents a bug in certain versions of gcc) #BYTECCCOMPOPTS=-fno-defer-pop -Wall -# If using gcc and being superstitious: +# If using gcc and being cautious: #BYTECCCOMPOPTS=-Wall -# Under NextStep: -#BYTECCCOMPOPTS=-U__GNUC__ -fno-defer-pop -Wall # Otherwise: #BYTECCCOMPOPTS= ### Additional link-time options for $(BYTECC) -### If using GCC on a Dec Alpha under OSF1: -#BYTECCLINKOPTS=-Wl,-T,12000000 -Wl,-D,14000000 # To support dynamic loading of shared libraries (they need to look at # our own symbols): #BYTECCLINKOPTS=-Wl,-E @@ -90,6 +84,9 @@ #RANLIB=ar rs #RANLIBCMD= +### How to invoke ar +#ARCMD=ar + ### Shared library support # Extension for shared libraries: so if supported, a if not supported #SO=so @@ -111,23 +108,15 @@ ### Name of architecture for the native-code compiler ### Currently supported: ### -### alpha Digital/Compaq Alpha machines under DUnix/Tru64 or Linux ### i386 Intel Pentium PCs under Linux, *BSD*, NextStep ### sparc Sun Sparcstation under SunOS 4.1 or Solaris 2 -### mips SGI machines under IRIX -### hppa HP 9000/700 under HPUX and Linux ### power Macintosh under Mac OS X and Linux -### ia64 Intel Itanium/IA64 under Linux ### arm ARM under Linux ### ### Set ARCH=none if your machine is not supported -#ARCH=alpha #ARCH=i386 #ARCH=sparc -#ARCH=mips -#ARCH=hppa #ARCH=power -#ARCH=ia64 #ARCH=arm #ARCH=none @@ -144,37 +133,18 @@ #MODEL=default ### Name of operating system family for the native-code compiler. -### If ARCH=sparc: choose between -### SYSTEM=sunos SunOS 4.1 -### SYSTEM=solaris Solaris 2 -### -### If ARCH=i386: choose between -### SYSTEM=linux_aout Linux with a.out binaries -### SYSTEM=linux_elf Linux with ELF binaries -### SYSTEM=bsd FreeBSD, probably works for NetBSD also -### SYSTEM=nextstep NextStep -### -### For other architectures: set SYSTEM=unknown -### -#SYSTEM=sunos #SYSTEM=solaris #SYSTEM=linux #SYSTEM=linux_elf #SYSTEM=bsd -#SYSTEM=nextstep #SYSTEM=unknown ### Which C compiler to use for the native-code compiler. -### cc is better than gcc on the Mips and Alpha. #NATIVECC=cc #NATIVECC=gcc ### Additional compile-time options for $(NATIVECC). -# For cc on the Alpha: -#NATIVECCCOMPOPTS=-std1 -# For cc on the Mips: -#NATIVECCCOMPOPTS=-std -# For gcc if superstitious: +# For gcc if cautious: #NATIVECCCOMPOPTS=-Wall ### Additional link-time options for $(NATIVECC) @@ -185,29 +155,21 @@ #NATIVECCRPATH=-Wl,-rpath ### Command and flags to use for assembling ocamlopt-generated code -# For the Alpha or the Mips: -#AS=as -O2 -# For the PowerPC: -#AS=as -u -m ppc -w -# Otherwise: -#AS=as +#ASM=as ### Command and flags to use for assembling .S files (often with preprocessing) # If gcc is available: #ASPP=gcc -c -# On SunOS and Solaris: +# On Solaris: #ASPP=as -P ### Extra flags to use for assembling .S files in profiling mode -# On Digital Unix: -#ASPPPROFFLAGS=-pg -DPROFILING -# Otherwise: #ASPPPROFFLAGS=-DPROFILING ### Whether profiling with gprof is supported -# If yes: (x86/Linux, Alpha/Digital Unix, Sparc/Solaris): +# If yes: (e.g. x86/Linux, Sparc/Solaris): #PROFILING=prof -# If no: (all others) +# If no: #PROFILING=noprof ### Option to give to the C compiler for profiling @@ -238,8 +200,6 @@ # generic (portable C, works everywhere) # ia32 (Intel x86) # amd64 (AMD Opteron, Athlon64) -# alpha -# mips # ppc (Power PC) # sparc # If you don't know, leave BNG_ARCH=generic, which selects a portable @@ -268,13 +228,6 @@ # For SunOS with OpenLook: #X11_LINK=-L$(X11_LIB) -lX11 -### -I options for finding the include file ndbm.h -# Needed for the "dbm" package -# Usually: -#DBM_INCLUDES= -# For recent Linux systems: -#DBM_INCLUDES=-I/usr/include/gdbm - ### Preprocessor options for finding tcl.h and tk.h # Needed for the "labltk" package # Required only if not in the standard include path. diff -Nru ocaml-3.12.1/config/Makefile.mingw ocaml-4.01.0/config/Makefile.mingw --- ocaml-3.12.1/config/Makefile.mingw 2010-05-25 10:00:39.000000000 +0000 +++ ocaml-4.01.0/config/Makefile.mingw 2013-05-17 12:03:58.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -11,14 +11,15 @@ # # ######################################################################### -# $Id: Makefile.mingw 10461 2010-05-25 10:00:39Z frisch $ - # Configuration for Windows, Mingw compiler ######### General configuration PREFIX=C:/ocamlmgw +### Remove this to disable compiling camlp4 +CAMLP4=camlp4 + ### Where to install the binaries BINDIR=$(PREFIX)/bin @@ -37,6 +38,10 @@ ########## Toolchain and OS dependencies TOOLCHAIN=mingw + +### Toolchain prefix +TOOLPREF=i686-w64-mingw32- + CCOMPTYPE=cc O=o A=a @@ -53,16 +58,14 @@ PTHREAD_LINK= X11_INCLUDES= X11_LINK= -DBM_INCLUDES= -DBM_LINK= BYTECCRPATH= SUPPORTS_SHARED_LIBRARIES=true SHAREDCCCOMPOPTS= MKSHAREDLIBRPATH= NATIVECCPROFOPTS= NATIVECCRPATH= -ASM=as -ASPP=gcc +ASM=$(TOOLPREF)as +ASPP=$(TOOLPREF)gcc -c ASPPPROFFLAGS= PROFILING=noprof DYNLINKOPTS= @@ -72,11 +75,13 @@ EXTRALIBS= NATDYNLINK=true CMXS=cmxs +RUNTIMED=noruntimed +ASM_CFI_SUPPORTED=false ########## Configuration for the bytecode compiler ### Which C compiler to use for the bytecode interpreter. -BYTECC=gcc -mno-cygwin +BYTECC=$(TOOLPREF)gcc ### Additional compile-time options for $(BYTECC). (For static linking.) BYTECCCOMPOPTS=-O -mms-bitfields -Wall -Wno-unused @@ -95,7 +100,7 @@ CPP=$(BYTECC) -E ### Flexlink -FLEXLINK=flexlink -chain mingw +FLEXLINK=flexlink -chain mingw -stack 16777216 FLEXDIR=$(shell $(FLEXLINK) -where) IFLEXDIR=-I"$(FLEXDIR)" MKDLL=$(FLEXLINK) @@ -103,16 +108,19 @@ MKMAINDLL=$(FLEXLINK) -maindll ### How to build a static library -MKLIB=rm -f $(1); ar rcs $(1) $(2) -#ml let mklib out files opts = Printf.sprintf "rm -f %s && ar rcs %s %s %s" out opts out files;; +MKLIB=rm -f $(1); $(TOOLPREF)ar rc $(1) $(2); $(RANLIB) $(1) +#ml let mklib out files opts = Printf.sprintf "rm -f %s && %sar rcs %s %s %s" out toolpref opts out files;; ### Canonicalize the name of a system library SYSLIB=-l$(1) #ml let syslib x = "-l"^x;; ### The ranlib command -RANLIB=ranlib -RANLIBCMD=ranlib +RANLIB=$(TOOLPREF)ranlib +RANLIBCMD=$(TOOLPREF)ranlib + +### The ar command +ARCMD=$(TOOLPREF)ar ############# Configuration for the native-code compiler @@ -135,7 +143,7 @@ NATIVECCLINKOPTS= ### Build partially-linked object file -PACKLD=ld -r $(NATIVECCLINKOPTS) -o #there must be a space after this '-o' +PACKLD=$(TOOLPREF)ld -r $(NATIVECCLINKOPTS) -o # must have a space after '-o' ############# Configuration for the contributed libraries @@ -156,3 +164,12 @@ MAKEREC=$(MAKE) -f Makefile.nt MAKECMD=$(MAKE) + +############# for the testsuite makefiles +#ml let topdir = "" and wintopdir = "";; +OTOPDIR=$(WINTOPDIR) +CTOPDIR=$(TOPDIR) +CYGPATH=cygpath -m +DIFF=diff -q --strip-trailing-cr +CANKILL=false +SET_LD_PATH=PATH="$(PATH):$(LD_PATH)" diff -Nru ocaml-3.12.1/config/Makefile.mingw64 ocaml-4.01.0/config/Makefile.mingw64 --- ocaml-3.12.1/config/Makefile.mingw64 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/config/Makefile.mingw64 2013-05-17 12:03:58.000000000 +0000 @@ -0,0 +1,172 @@ +######################################################################### +# # +# OCaml # +# # +# Xavier Leroy, projet Cristal, INRIA Rocquencourt # +# # +# Copyright 1999 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the GNU Library General Public License, with # +# the special exception on linking described in file ../LICENSE. # +# # +######################################################################### + +# Configuration for Windows, Mingw compiler + +######### General configuration + +PREFIX=C:/ocamlmgw64 + +### Remove this to disable compiling camlp4 +CAMLP4=camlp4 + +### Where to install the binaries +BINDIR=$(PREFIX)/bin + +### Where to install the standard library +LIBDIR=$(PREFIX)/lib + +### Where to install the stub DLLs +STUBLIBDIR=$(LIBDIR)/stublibs + +### Where to install the info files +DISTRIB=$(PREFIX) + +### Where to install the man pages +MANDIR=$(PREFIX)/man + +########## Toolchain and OS dependencies + +TOOLCHAIN=mingw + +### Toolchain prefix +TOOLPREF=x86_64-w64-mingw32- + +CCOMPTYPE=cc +O=o +A=a +S=s +SO=s.o +DO=d.o +EXE=.exe +EXT_DLL=.dll +EXT_OBJ=.$(O) +EXT_LIB=.$(A) +EXT_ASM=.$(S) +MANEXT=1 +SHARPBANGSCRIPTS=false +PTHREAD_LINK= +X11_INCLUDES= +X11_LINK= +BYTECCRPATH= +SUPPORTS_SHARED_LIBRARIES=true +SHAREDCCCOMPOPTS= +MKSHAREDLIBRPATH= +NATIVECCPROFOPTS= +NATIVECCRPATH= +ASM=$(TOOLPREF)as +ASPP=$(TOOLPREF)gcc -c +ASPPPROFFLAGS= +PROFILING=noprof +DYNLINKOPTS= +DEBUGGER=ocamldebugger +CC_PROFILE= +SYSTHREAD_SUPPORT=true +EXTRALIBS= +NATDYNLINK=true +CMXS=cmxs +RUNTIMED=noruntimed +ASM_CFI_SUPPORTED=false + +########## Configuration for the bytecode compiler + +### Which C compiler to use for the bytecode interpreter. +BYTECC=$(TOOLPREF)gcc + +### Additional compile-time options for $(BYTECC). (For static linking.) +BYTECCCOMPOPTS=-O -mms-bitfields -Wall -Wno-unused + +### Additional link-time options for $(BYTECC). (For static linking.) +BYTECCLINKOPTS= + +### Additional compile-time options for $(BYTECC). (For building a DLL.) +DLLCCCOMPOPTS=-O -mms-bitfields -Wall -Wno-unused -DCAML_DLL + +### Libraries needed +BYTECCLIBS=-lws2_32 +NATIVECCLIBS=-lws2_32 + +### How to invoke the C preprocessor +CPP=$(BYTECC) -E + +### Flexlink +FLEXLINK=flexlink -chain mingw64 -stack 33554432 +FLEXDIR=$(shell $(FLEXLINK) -where) +IFLEXDIR=-I"$(FLEXDIR)" +MKDLL=$(FLEXLINK) +MKEXE=$(FLEXLINK) -exe +MKMAINDLL=$(FLEXLINK) -maindll + +### How to build a static library +MKLIB=rm -f $(1); $(TOOLPREF)ar rc $(1) $(2); $(RANLIB) $(1) +#ml let mklib out files opts = Printf.sprintf "rm -f %s && %sar rcs %s %s %s" out toolpref opts out files;; + +### Canonicalize the name of a system library +SYSLIB=-l$(1) +#ml let syslib x = "-l"^x;; + +### The ranlib command +RANLIB=$(TOOLPREF)ranlib +RANLIBCMD=$(TOOLPREF)ranlib + +### The ar command +ARCMD=$(TOOLPREF)ar + +############# Configuration for the native-code compiler + +### Name of architecture for the native-code compiler +ARCH=amd64 + +### Name of architecture model for the native-code compiler. +MODEL=default + +### Name of operating system family for the native-code compiler. +SYSTEM=mingw64 + +### Which C compiler to use for the native-code compiler. +NATIVECC=$(BYTECC) + +### Additional compile-time options for $(NATIVECC). +NATIVECCCOMPOPTS=-O -mms-bitfields -Wall -Wno-unused + +### Additional link-time options for $(NATIVECC) +NATIVECCLINKOPTS= + +### Build partially-linked object file +PACKLD=$(TOOLPREF)ld -r $(NATIVECCLINKOPTS) -o # must have a space after '-o' + +############# Configuration for the contributed libraries + +OTHERLIBRARIES=win32unix str num win32graph dynlink bigarray systhreads + +### Name of the target architecture for the "num" library +BNG_ARCH=amd64 +BNG_ASM_LEVEL=1 + +### Configuration for LablTk (not supported) +TK_DEFS= +TK_LINK= + +############# Aliases for common commands + +MAKEREC=$(MAKE) -f Makefile.nt +MAKECMD=$(MAKE) + +############# for the testsuite makefiles +#ml let topdir = "" and wintopdir = "";; +OTOPDIR=$(WINTOPDIR) +CTOPDIR=$(TOPDIR) +CYGPATH=cygpath -m +DIFF=diff -q --strip-trailing-cr +CANKILL=false +SET_LD_PATH=PATH="$(PATH):$(LD_PATH)" diff -Nru ocaml-3.12.1/config/Makefile.msvc ocaml-4.01.0/config/Makefile.msvc --- ocaml-3.12.1/config/Makefile.msvc 2010-07-07 12:04:32.000000000 +0000 +++ ocaml-4.01.0/config/Makefile.msvc 2013-05-17 12:03:58.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -11,8 +11,6 @@ # # ######################################################################### -# $Id: Makefile.msvc 10622 2010-07-07 12:04:32Z frisch $ - # Configuration for Windows, Visual C++ compiler ######### General configuration @@ -53,8 +51,6 @@ PTHREAD_LINK= X11_INCLUDES= X11_LINK= -DBM_INCLUDES= -DBM_LINK= BYTECCRPATH= SUPPORTS_SHARED_LIBRARIES=true SHAREDCCCOMPOPTS= @@ -71,6 +67,8 @@ EXTRALIBS= CMXS=cmxs NATDYNLINK=true +RUNTIMED=noruntimed +ASM_CFI_SUPPORTED=false ########## Configuration for the bytecode compiler @@ -94,11 +92,11 @@ CPP=cl /nologo /EP ### Flexlink -FLEXLINK=flexlink -merge-manifest +FLEXLINK=flexlink -merge-manifest -stack 16777216 FLEXDIR=$(shell $(FLEXLINK) -where) IFLEXDIR=-I"$(FLEXDIR)" MKDLL=$(FLEXLINK) -MKEXE=$(FLEXLINK) -exe -link /STACK:16777216 +MKEXE=$(FLEXLINK) -exe MKMAINDLL=$(FLEXLINK) -maindll ### How to build a static library @@ -114,6 +112,9 @@ RANLIB=echo RANLIBCMD= +### The ar command +ARCMD= + ############# Configuration for the native-code compiler ### Name of architecture for the native-code compiler @@ -137,6 +138,13 @@ ### Build partially-linked object file PACKLD=link /lib /nologo /out:# there must be no space after this '/out:' +############# Configuration for camlp4 + +# This variable controls whether camlp4 will be built. +# If it is set to camlp4, then it will be built. +# If it is set to the empty string, then it will not be built. +CAMLP4=camlp4 + ############# Configuration for the contributed libraries OTHERLIBRARIES=win32unix systhreads str num win32graph dynlink bigarray labltk @@ -162,3 +170,14 @@ MAKEREC=$(MAKE) -f Makefile.nt MAKECMD=$(MAKE) + +############# for the testsuite makefiles +#ml let topdir = "" and wintopdir = "";; +OTOPDIR=$(WINTOPDIR) +CTOPDIR=$(WINTOPDIR) +CYGPATH=cygpath -m +DIFF=diff -q --strip-trailing-cr +CANKILL=false +FIND=/usr/bin/find +SORT=/usr/bin/sort +SET_LD_PATH=PATH="$(PATH):$(LD_PATH)" diff -Nru ocaml-3.12.1/config/Makefile.msvc64 ocaml-4.01.0/config/Makefile.msvc64 --- ocaml-3.12.1/config/Makefile.msvc64 2010-07-07 12:04:32.000000000 +0000 +++ ocaml-4.01.0/config/Makefile.msvc64 2013-05-17 12:03:58.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -11,8 +11,6 @@ # # ######################################################################### -# $Id: Makefile.msvc64 10622 2010-07-07 12:04:32Z frisch $ - # Configuration for Windows, Visual C++ compiler ######### General configuration @@ -54,8 +52,6 @@ PTHREAD_LINK= X11_INCLUDES= X11_LINK= -DBM_INCLUDES= -DBM_LINK= BYTECCRPATH= SUPPORTS_SHARED_LIBRARIES=true SHAREDCCCOMPOPTS= @@ -71,6 +67,8 @@ SYSTHREAD_SUPPORT=true CMXS=cmxs NATDYNLINK=true +RUNTIMED=noruntimed +ASM_CFI_SUPPORTED=false ########## Configuration for the bytecode compiler @@ -99,11 +97,11 @@ CPP=cl /nologo /EP ### Flexlink -FLEXLINK=flexlink -x64 -merge-manifest +FLEXLINK=flexlink -x64 -merge-manifest -stack 33554432 FLEXDIR=$(shell $(FLEXLINK) -where) IFLEXDIR=-I"$(FLEXDIR)" MKDLL=$(FLEXLINK) -MKEXE=$(FLEXLINK) -exe -link /STACK:33554432 +MKEXE=$(FLEXLINK) -exe MKMAINDLL=$(FLEXLINK) -maindll ### How to build a static library @@ -119,6 +117,9 @@ RANLIB=echo RANLIBCMD= +### The ar command +ARCMD= + ############# Configuration for the native-code compiler ### Name of architecture for the native-code compiler @@ -140,7 +141,14 @@ NATIVECCLINKOPTS= ### Build partially-linked object file -PACKLD=link /lib /nologo /machine:AMD64 /out:# there must be no space after this '/out:' +PACKLD=link /lib /nologo /machine:AMD64 /out:# must have no space after '/out:' + +############# Configuration for camlp4 + +# This variable controls whether camlp4 will be built. +# If it is set to camlp4, then it will be built. +# If it is set to the empty string, then it will not be built. +CAMLP4=camlp4 ############# Configuration for the contributed libraries @@ -158,3 +166,14 @@ MAKEREC=$(MAKE) -f Makefile.nt MAKECMD=$(MAKE) + +############# for the testsuite makefiles +#ml let topdir = "" and wintopdir = "";; +OTOPDIR=$(WINTOPDIR) +CTOPDIR=$(WINTOPDIR) +CYGPATH=cygpath -m +DIFF=diff -q --strip-trailing-cr +CANKILL=false +FIND=/usr/bin/find +SORT=/usr/bin/sort +SET_LD_PATH=PATH="$(PATH):$(LD_PATH)" diff -Nru ocaml-3.12.1/config/auto-aux/.cvsignore ocaml-4.01.0/config/auto-aux/.cvsignore --- ocaml-3.12.1/config/auto-aux/.cvsignore 2006-09-12 10:35:58.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -camlp4_config.ml diff -Nru ocaml-3.12.1/config/auto-aux/.ignore ocaml-4.01.0/config/auto-aux/.ignore --- ocaml-3.12.1/config/auto-aux/.ignore 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/.ignore 2012-07-17 15:31:12.000000000 +0000 @@ -0,0 +1 @@ +camlp4_config.ml diff -Nru ocaml-3.12.1/config/auto-aux/align.c ocaml-4.01.0/config/auto-aux/align.c --- ocaml-3.12.1/config/auto-aux/align.c 2001-12-07 13:41:02.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/align.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: align.c 4144 2001-12-07 13:41:02Z xleroy $ */ - #include #include #include diff -Nru ocaml-3.12.1/config/auto-aux/ansi.c ocaml-4.01.0/config/auto-aux/ansi.c --- ocaml-3.12.1/config/auto-aux/ansi.c 2001-12-07 13:41:02.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/ansi.c 2012-07-17 15:31:12.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ diff -Nru ocaml-3.12.1/config/auto-aux/async_io.c ocaml-4.01.0/config/auto-aux/async_io.c --- ocaml-3.12.1/config/auto-aux/async_io.c 2003-02-11 14:05:36.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/async_io.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: async_io.c 5393 2003-02-11 14:05:36Z xleroy $ */ - #include #include #include diff -Nru ocaml-3.12.1/config/auto-aux/bytecopy.c ocaml-4.01.0/config/auto-aux/bytecopy.c --- ocaml-3.12.1/config/auto-aux/bytecopy.c 2001-12-07 13:41:02.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/bytecopy.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: bytecopy.c 4144 2001-12-07 13:41:02Z xleroy $ */ - char buffer[27]; #ifdef reverse diff -Nru ocaml-3.12.1/config/auto-aux/cfi.S ocaml-4.01.0/config/auto-aux/cfi.S --- ocaml-3.12.1/config/auto-aux/cfi.S 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/cfi.S 2012-08-02 08:17:59.000000000 +0000 @@ -0,0 +1,6 @@ +camlPervasives__loop_1128: + .file 1 "pervasives.ml" + .loc 1 193 + .cfi_startproc + .cfi_adjust_cfa_offset 8 + .cfi_endproc diff -Nru ocaml-3.12.1/config/auto-aux/dblalign.c ocaml-4.01.0/config/auto-aux/dblalign.c --- ocaml-3.12.1/config/auto-aux/dblalign.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/dblalign.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: dblalign.c 9547 2010-01-22 12:48:24Z doligez $ */ - #include #include #include diff -Nru ocaml-3.12.1/config/auto-aux/divmod.c ocaml-4.01.0/config/auto-aux/divmod.c --- ocaml-3.12.1/config/auto-aux/divmod.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/divmod.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: divmod.c 9547 2010-01-22 12:48:24Z doligez $ */ - /* Test semantics of division and modulus for negative arguments */ long div4[] = diff -Nru ocaml-3.12.1/config/auto-aux/elf.c ocaml-4.01.0/config/auto-aux/elf.c --- ocaml-3.12.1/config/auto-aux/elf.c 2001-12-07 13:41:02.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/elf.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: elf.c 4144 2001-12-07 13:41:02Z xleroy $ */ - #include int main(int argc, char ** argv) diff -Nru ocaml-3.12.1/config/auto-aux/endian.c ocaml-4.01.0/config/auto-aux/endian.c --- ocaml-3.12.1/config/auto-aux/endian.c 2001-12-07 13:41:02.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/endian.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: endian.c 4144 2001-12-07 13:41:02Z xleroy $ */ - #include "m.h" #ifndef ARCH_SIXTYFOUR diff -Nru ocaml-3.12.1/config/auto-aux/expm1.c ocaml-4.01.0/config/auto-aux/expm1.c --- ocaml-3.12.1/config/auto-aux/expm1.c 2011-05-12 15:42:02.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/expm1.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: longlong.c 4833 2002-05-25 08:33:26Z xleroy $ */ - #include volatile double x; diff -Nru ocaml-3.12.1/config/auto-aux/getgroups.c ocaml-4.01.0/config/auto-aux/getgroups.c --- ocaml-3.12.1/config/auto-aux/getgroups.c 2001-12-07 13:41:02.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/getgroups.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: getgroups.c 4144 2001-12-07 13:41:02Z xleroy $ */ - #include #include diff -Nru ocaml-3.12.1/config/auto-aux/gethostbyaddr.c ocaml-4.01.0/config/auto-aux/gethostbyaddr.c --- ocaml-3.12.1/config/auto-aux/gethostbyaddr.c 2002-05-06 08:29:52.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/gethostbyaddr.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: gethostbyaddr.c 4771 2002-05-06 08:29:52Z xleroy $ */ - #ifndef _REENTRANT /* This helps detection on Digital Unix... */ #define _REENTRANT diff -Nru ocaml-3.12.1/config/auto-aux/gethostbyname.c ocaml-4.01.0/config/auto-aux/gethostbyname.c --- ocaml-3.12.1/config/auto-aux/gethostbyname.c 2002-05-06 08:29:52.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/gethostbyname.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: gethostbyname.c 4771 2002-05-06 08:29:52Z xleroy $ */ - #ifndef _REENTRANT /* This helps detection on Digital Unix... */ #define _REENTRANT diff -Nru ocaml-3.12.1/config/auto-aux/hasgot ocaml-4.01.0/config/auto-aux/hasgot --- ocaml-3.12.1/config/auto-aux/hasgot 2004-04-09 13:23:11.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/hasgot 2012-07-17 15:31:12.000000000 +0000 @@ -1,5 +1,18 @@ #!/bin/sh +######################################################################### +# # +# OCaml # +# # +# Xavier Leroy, projet Cristal, INRIA Rocquencourt # +# # +# Copyright 1995 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the GNU Library General Public License, with # +# the special exception on linking described in file ../../LICENSE. # +# # +######################################################################### + opts="" libs="$cclibs" args=$* diff -Nru ocaml-3.12.1/config/auto-aux/hasgot2 ocaml-4.01.0/config/auto-aux/hasgot2 --- ocaml-3.12.1/config/auto-aux/hasgot2 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/hasgot2 2011-07-27 14:17:02.000000000 +0000 @@ -0,0 +1,42 @@ +#!/bin/sh + +######################################################################### +# # +# OCaml # +# # +# Xavier Leroy, projet Cristal, INRIA Rocquencourt # +# # +# Copyright 2011 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the GNU Library General Public License, with # +# the special exception on linking described in file ../../LICENSE. # +# # +######################################################################### + +opts="" +libs="$cclibs" +args=$* +rm -f hasgot.c +var="x" +while : ; do + case "$1" in + -i) echo "#include <$2>" >> hasgot.c; shift;; + -t) echo "$2 $var;" >> hasgot.c; var="x$var"; shift;; + -l*|-L*|-F*) libs="$libs $1";; + -framework) libs="$libs $1 $2"; shift;; + -*) opts="$opts $1";; + *) break;; + esac + shift +done + +(echo "main() {" + for f in $*; do echo " (void) & $f;"; done + echo "}") >> hasgot.c + +if test "$verbose" = yes; then + echo "hasgot2 $args: $cc $opts -o tst hasgot.c $libs" >&2 + exec $cc $opts -o tst hasgot.c $libs > /dev/null +else + exec $cc $opts -o tst hasgot.c $libs > /dev/null 2>/dev/null +fi diff -Nru ocaml-3.12.1/config/auto-aux/ia32sse2.c ocaml-4.01.0/config/auto-aux/ia32sse2.c --- ocaml-3.12.1/config/auto-aux/ia32sse2.c 2005-03-24 17:20:54.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/ia32sse2.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: ia32sse2.c 6824 2005-03-24 17:20:54Z doligez $ */ - /* Test whether IA32 assembler supports SSE2 instructions */ int main() diff -Nru ocaml-3.12.1/config/auto-aux/initgroups.c ocaml-4.01.0/config/auto-aux/initgroups.c --- ocaml-3.12.1/config/auto-aux/initgroups.c 2009-04-01 16:50:10.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/initgroups.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,8 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ +/* */ +/* Contributed by Stephane Glondu */ /* */ /* Copyright 2009 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ @@ -9,10 +11,6 @@ /* */ /***********************************************************************/ -/* Contributed by Stephane Glondu */ - -/* $Id: initgroups.c 9220 2009-04-01 16:50:10Z xleroy $ */ - #include #include diff -Nru ocaml-3.12.1/config/auto-aux/int64align.c ocaml-4.01.0/config/auto-aux/int64align.c --- ocaml-3.12.1/config/auto-aux/int64align.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/int64align.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: int64align.c 9547 2010-01-22 12:48:24Z doligez $ */ - #include #include #include diff -Nru ocaml-3.12.1/config/auto-aux/longlong.c ocaml-4.01.0/config/auto-aux/longlong.c --- ocaml-3.12.1/config/auto-aux/longlong.c 2002-05-25 08:33:26.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/longlong.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: longlong.c 4833 2002-05-25 08:33:26Z xleroy $ */ - #include #include diff -Nru ocaml-3.12.1/config/auto-aux/runtest ocaml-4.01.0/config/auto-aux/runtest --- ocaml-3.12.1/config/auto-aux/runtest 2001-09-06 08:52:32.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/runtest 2012-07-17 15:31:12.000000000 +0000 @@ -1,4 +1,18 @@ #!/bin/sh + +######################################################################### +# # +# OCaml # +# # +# Xavier Leroy, projet Cristal, INRIA Rocquencourt # +# # +# Copyright 1995 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the GNU Library General Public License, with # +# the special exception on linking described in file ../../LICENSE. # +# # +######################################################################### + if test "$verbose" = yes; then echo "runtest: $cc -o tst $* $cclibs" >&2 $cc -o tst $* $cclibs || exit 100 diff -Nru ocaml-3.12.1/config/auto-aux/schar.c ocaml-4.01.0/config/auto-aux/schar.c --- ocaml-3.12.1/config/auto-aux/schar.c 2001-12-07 13:41:02.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/schar.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: schar.c 4144 2001-12-07 13:41:02Z xleroy $ */ - char foo[]="\377"; int main(int argc, char ** argv) diff -Nru ocaml-3.12.1/config/auto-aux/schar2.c ocaml-4.01.0/config/auto-aux/schar2.c --- ocaml-3.12.1/config/auto-aux/schar2.c 2001-12-07 13:41:02.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/schar2.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: schar2.c 4144 2001-12-07 13:41:02Z xleroy $ */ - signed char foo[]="\377"; int main(int argc, char ** argv) diff -Nru ocaml-3.12.1/config/auto-aux/searchpath ocaml-4.01.0/config/auto-aux/searchpath --- ocaml-3.12.1/config/auto-aux/searchpath 1996-02-13 16:29:09.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/searchpath 2012-07-17 15:31:12.000000000 +0000 @@ -1,4 +1,18 @@ #!/bin/sh + +######################################################################### +# # +# OCaml # +# # +# Xavier Leroy, projet Cristal, INRIA Rocquencourt # +# # +# Copyright 1996 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the GNU Library General Public License, with # +# the special exception on linking described in file ../../LICENSE. # +# # +######################################################################### + # Find a program in the path IFS=':' diff -Nru ocaml-3.12.1/config/auto-aux/setgroups.c ocaml-4.01.0/config/auto-aux/setgroups.c --- ocaml-3.12.1/config/auto-aux/setgroups.c 2009-04-01 16:50:10.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/setgroups.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,8 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ +/* */ +/* Contributed by Stephane Glondu */ /* */ /* Copyright 2009 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ @@ -9,10 +11,6 @@ /* */ /***********************************************************************/ -/* Contributed by Stephane Glondu */ - -/* $Id: setgroups.c 9220 2009-04-01 16:50:10Z xleroy $ */ - #include #include diff -Nru ocaml-3.12.1/config/auto-aux/sighandler.c ocaml-4.01.0/config/auto-aux/sighandler.c --- ocaml-3.12.1/config/auto-aux/sighandler.c 2001-12-07 13:41:02.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/sighandler.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: sighandler.c 4144 2001-12-07 13:41:02Z xleroy $ */ - #include int main(void) diff -Nru ocaml-3.12.1/config/auto-aux/signals.c ocaml-4.01.0/config/auto-aux/signals.c --- ocaml-3.12.1/config/auto-aux/signals.c 2001-12-07 13:41:02.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/signals.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: signals.c 4144 2001-12-07 13:41:02Z xleroy $ */ - /* To determine the semantics of signal handlers (System V: signal is reset to default behavior on entrance to the handler BSD: signal handler remains active). */ diff -Nru ocaml-3.12.1/config/auto-aux/sizes.c ocaml-4.01.0/config/auto-aux/sizes.c --- ocaml-3.12.1/config/auto-aux/sizes.c 2001-12-07 13:41:02.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/sizes.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: sizes.c 4144 2001-12-07 13:41:02Z xleroy $ */ - #include int main(int argc, char **argv) diff -Nru ocaml-3.12.1/config/auto-aux/solaris-ld ocaml-4.01.0/config/auto-aux/solaris-ld --- ocaml-3.12.1/config/auto-aux/solaris-ld 2001-08-28 14:47:48.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/solaris-ld 2012-07-17 15:31:12.000000000 +0000 @@ -1,4 +1,18 @@ #!/bin/sh + +######################################################################### +# # +# OCaml # +# # +# Xavier Leroy, projet Cristal, INRIA Rocquencourt # +# # +# Copyright 2001 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the GNU Library General Public License, with # +# the special exception on linking described in file ../../LICENSE. # +# # +######################################################################### + # Determine if gcc calls the Solaris ld or the GNU ld # Exit code is 0 for Solaris ld, 1 for GNU ld diff -Nru ocaml-3.12.1/config/auto-aux/stackov.c ocaml-4.01.0/config/auto-aux/stackov.c --- ocaml-3.12.1/config/auto-aux/stackov.c 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/stackov.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: stackov.c 9547 2010-01-22 12:48:24Z doligez $ */ - #include #include #include diff -Nru ocaml-3.12.1/config/auto-aux/tclversion.c ocaml-4.01.0/config/auto-aux/tclversion.c --- ocaml-3.12.1/config/auto-aux/tclversion.c 2003-08-20 15:11:52.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/tclversion.c 2012-10-15 17:50:56.000000000 +0000 @@ -1,3 +1,19 @@ +/***********************************************************************/ +/* */ +/* MLTk, Tcl/Tk interface of OCaml */ +/* */ +/* Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis */ +/* projet Cristal, INRIA Rocquencourt */ +/* Jacques Garrigue, Kyoto University RIMS */ +/* */ +/* Copyright 2002 Institut National de Recherche en Informatique et */ +/* en Automatique and Kyoto University. All rights reserved. */ +/* This file is distributed under the terms of the GNU Library */ +/* General Public License, with the special exception on linking */ +/* described in file LICENSE found in the OCaml source tree. */ +/* */ +/***********************************************************************/ + #include #include #include diff -Nru ocaml-3.12.1/config/auto-aux/tryassemble ocaml-4.01.0/config/auto-aux/tryassemble --- ocaml-3.12.1/config/auto-aux/tryassemble 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/tryassemble 2012-08-02 08:17:59.000000000 +0000 @@ -0,0 +1,31 @@ +#!/bin/sh + +######################################################################### +# # +# OCaml # +# # +# Xavier Leroy, projet Cristal, INRIA Rocquencourt # +# # +# Copyright 2012 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the GNU Library General Public License, with # +# the special exception on linking described in file ../../LICENSE. # +# # +######################################################################### + +if test "$verbose" = yes; then +echo "tryassemble: $aspp -o tst $*" >&2 +$aspp -o tst $* || exit 100 +else +$aspp -o tst $* 2> /dev/null || exit 100 +fi + +# test as also (if differs) +if test "$aspp" != "$as"; then +if test "$verbose" = yes; then +echo "tryassemble: $as -o tst $*" >&2 +$as -o tst $* || exit 100 +else +$as -o tst $* 2> /dev/null || exit 100 +fi +fi diff -Nru ocaml-3.12.1/config/auto-aux/trycompile ocaml-4.01.0/config/auto-aux/trycompile --- ocaml-3.12.1/config/auto-aux/trycompile 2002-05-04 09:58:01.000000000 +0000 +++ ocaml-4.01.0/config/auto-aux/trycompile 2012-07-17 15:31:12.000000000 +0000 @@ -1,4 +1,18 @@ #!/bin/sh + +######################################################################### +# # +# OCaml # +# # +# Xavier Leroy, projet Cristal, INRIA Rocquencourt # +# # +# Copyright 2002 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the GNU Library General Public License, with # +# the special exception on linking described in file ../../LICENSE. # +# # +######################################################################### + if test "$verbose" = yes; then echo "trycompile: $cc -o tst $* $cclibs" >&2 $cc -o tst $* $cclibs || exit 100 diff -Nru ocaml-3.12.1/config/gnu/config.guess ocaml-4.01.0/config/gnu/config.guess --- ocaml-3.12.1/config/gnu/config.guess 2004-02-16 12:37:15.000000000 +0000 +++ ocaml-4.01.0/config/gnu/config.guess 2012-08-02 08:17:59.000000000 +0000 @@ -1,9 +1,10 @@ #! /bin/sh # Attempt to guess a canonical system name. # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, +# 2011 Free Software Foundation, Inc. -timestamp='2004-02-16' +timestamp='2011-11-11' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -17,23 +18,25 @@ # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA +# 02110-1301, USA. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. -# Originally written by Per Bothner . -# Please send patches to . Submit a context -# diff and a properly formatted ChangeLog entry. + +# Originally written by Per Bothner. Please send patches (context +# diff format) to and include a ChangeLog +# entry. # # This script attempts to guess a canonical system name similar to # config.sub. If it succeeds, it prints the system name on stdout, and # exits with 0. Otherwise, it exits with 1. # -# The plan is that this can be called by configure scripts if you -# don't specify an explicit build system type. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD me=`echo "$0" | sed -e 's,.*/,,'` @@ -53,8 +56,9 @@ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 -Free Software Foundation, Inc. +Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, +2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free +Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -66,11 +70,11 @@ while test $# -gt 0 ; do case $1 in --time-stamp | --time* | -t ) - echo "$timestamp" ; exit 0 ;; + echo "$timestamp" ; exit ;; --version | -v ) - echo "$version" ; exit 0 ;; + echo "$version" ; exit ;; --help | --h* | -h ) - echo "$usage"; exit 0 ;; + echo "$usage"; exit ;; -- ) # Stop option processing shift; break ;; - ) # Use stdin as input. @@ -104,7 +108,7 @@ trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; : ${TMPDIR=/tmp} ; - { tmp=`(umask 077 && mktemp -d -q "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || + { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; @@ -123,7 +127,7 @@ ;; ,,*) CC_FOR_BUILD=$CC ;; ,*,*) CC_FOR_BUILD=$HOST_CC ;; -esac ;' +esac ; set_cc_for_build= ;' # This is needed to find uname on a Pyramid OSx when run in the BSD universe. # (ghazi@noc.rutgers.edu 1994-08-24) @@ -158,6 +162,7 @@ arm*) machine=arm-unknown ;; sh3el) machine=shl-unknown ;; sh3eb) machine=sh-unknown ;; + sh5el) machine=sh5le-unknown ;; *) machine=${UNAME_MACHINE_ARCH}-unknown ;; esac # The Operating System including object format, if it has switched @@ -166,7 +171,7 @@ arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep __ELF__ >/dev/null + | grep -q __ELF__ then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? @@ -176,7 +181,7 @@ fi ;; *) - os=netbsd + os=netbsd ;; esac # The OS release @@ -196,68 +201,32 @@ # contains redundant information, the shorter form: # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" - exit 0 ;; - amd64:OpenBSD:*:*) - echo x86_64-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - amiga:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - arc:OpenBSD:*:*) - echo mipsel-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - cats:OpenBSD:*:*) - echo arm-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - hp300:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - mac68k:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - macppc:OpenBSD:*:*) - echo powerpc-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - mvme68k:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - mvme88k:OpenBSD:*:*) - echo m88k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - mvmeppc:OpenBSD:*:*) - echo powerpc-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - pegasos:OpenBSD:*:*) - echo powerpc-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - pmax:OpenBSD:*:*) - echo mipsel-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - sgi:OpenBSD:*:*) - echo mipseb-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - sun3:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - wgrisc:OpenBSD:*:*) - echo mipsel-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; + exit ;; *:OpenBSD:*:*) - echo ${UNAME_MACHINE}-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; + UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} + exit ;; *:ekkoBSD:*:*) echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE} - exit 0 ;; + exit ;; + *:SolidBSD:*:*) + echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} + exit ;; macppc:MirBSD:*:*) - echo powerppc-unknown-mirbsd${UNAME_RELEASE} - exit 0 ;; + echo powerpc-unknown-mirbsd${UNAME_RELEASE} + exit ;; *:MirBSD:*:*) echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} - exit 0 ;; + exit ;; alpha:OSF1:*:*) - if test $UNAME_RELEASE = "V4.0"; then + case $UNAME_RELEASE in + *4.0) UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` - fi + ;; + *5.*) + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + ;; + esac # According to Compaq, /usr/sbin/psrinfo has been available on # OSF/1 and Tru64 systems produced since 1995. I hope that # covers most systems running today. This code pipes the CPU @@ -295,45 +264,52 @@ "EV7.9 (21364A)") UNAME_MACHINE="alphaev79" ;; esac + # A Pn.n version is a patched version. # A Vn.n version is a released version. # A Tn.n version is a released field test version. # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. - echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - exit 0 ;; - Alpha*:OpenVMS:*:*) - echo alpha-hp-vms - exit 0 ;; + echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead # of the specific Alpha model? echo alpha-pc-interix - exit 0 ;; + exit ;; 21064:Windows_NT:50:3) echo alpha-dec-winnt3.5 - exit 0 ;; + exit ;; Amiga*:UNIX_System_V:4.0:*) echo m68k-unknown-sysv4 - exit 0;; + exit ;; *:[Aa]miga[Oo][Ss]:*:*) echo ${UNAME_MACHINE}-unknown-amigaos - exit 0 ;; + exit ;; *:[Mm]orph[Oo][Ss]:*:*) echo ${UNAME_MACHINE}-unknown-morphos - exit 0 ;; + exit ;; *:OS/390:*:*) echo i370-ibm-openedition - exit 0 ;; + exit ;; + *:z/VM:*:*) + echo s390-ibm-zvmoe + exit ;; *:OS400:*:*) - echo powerpc-ibm-os400 - exit 0 ;; + echo powerpc-ibm-os400 + exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} - exit 0;; + exit ;; + arm:riscos:*:*|arm:RISCOS:*:*) + echo arm-unknown-riscos + exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) echo hppa1.1-hitachi-hiuxmpp - exit 0;; + exit ;; Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. if test "`(/bin/universe) 2>/dev/null`" = att ; then @@ -341,32 +317,51 @@ else echo pyramid-pyramid-bsd fi - exit 0 ;; + exit ;; NILE*:*:*:dcosx) echo pyramid-pyramid-svr4 - exit 0 ;; + exit ;; DRS?6000:unix:4.0:6*) echo sparc-icl-nx6 - exit 0 ;; - DRS?6000:UNIX_SV:4.2*:7*) + exit ;; + DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) case `/usr/bin/uname -p` in - sparc) echo sparc-icl-nx7 && exit 0 ;; + sparc) echo sparc-icl-nx7; exit ;; esac ;; + s390x:SunOS:*:*) + echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit 0 ;; + exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit 0 ;; - i86pc:SunOS:5.*:*) - echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit 0 ;; + exit ;; + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux${UNAME_RELEASE} + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + eval $set_cc_for_build + SUN_ARCH="i386" + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH="x86_64" + fi + fi + echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize # SunOS6. Hard to guess exactly what SunOS6 will be like, but # it's likely to be more like Solaris than SunOS4. echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit 0 ;; + exit ;; sun4*:SunOS:*:*) case "`/usr/bin/arch -k`" in Series*|S4*) @@ -375,10 +370,10 @@ esac # Japanese Language versions have a version number like `4.1.3-JL'. echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` - exit 0 ;; + exit ;; sun3*:SunOS:*:*) echo m68k-sun-sunos${UNAME_RELEASE} - exit 0 ;; + exit ;; sun*:*:4.2BSD:*) UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 @@ -390,10 +385,10 @@ echo sparc-sun-sunos${UNAME_RELEASE} ;; esac - exit 0 ;; + exit ;; aushp:SunOS:*:*) echo sparc-auspex-sunos${UNAME_RELEASE} - exit 0 ;; + exit ;; # The situation for MiNT is a little confusing. The machine name # can be virtually everything (everything which is not # "atarist" or "atariste" at least should have a processor @@ -403,41 +398,41 @@ # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} - exit 0 ;; + echo m68k-atari-mint${UNAME_RELEASE} + exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} - exit 0 ;; + exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} - exit 0 ;; + echo m68k-atari-mint${UNAME_RELEASE} + exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit 0 ;; + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit 0 ;; + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit 0 ;; + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} - exit 0 ;; + exit ;; powerpc:machten:*:*) echo powerpc-apple-machten${UNAME_RELEASE} - exit 0 ;; + exit ;; RISC*:Mach:*:*) echo mips-dec-mach_bsd4.3 - exit 0 ;; + exit ;; RISC*:ULTRIX:*:*) echo mips-dec-ultrix${UNAME_RELEASE} - exit 0 ;; + exit ;; VAX*:ULTRIX*:*:*) echo vax-dec-ultrix${UNAME_RELEASE} - exit 0 ;; + exit ;; 2020:CLIX:*:* | 2430:CLIX:*:*) echo clipper-intergraph-clix${UNAME_RELEASE} - exit 0 ;; + exit ;; mips:*:*:UMIPS | mips:*:*:RISCos) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c @@ -461,35 +456,36 @@ exit (-1); } EOF - $CC_FOR_BUILD -o $dummy $dummy.c \ - && $dummy `echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` \ - && exit 0 + $CC_FOR_BUILD -o $dummy $dummy.c && + dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` && + SYSTEM_NAME=`$dummy $dummyarg` && + { echo "$SYSTEM_NAME"; exit; } echo mips-mips-riscos${UNAME_RELEASE} - exit 0 ;; + exit ;; Motorola:PowerMAX_OS:*:*) echo powerpc-motorola-powermax - exit 0 ;; + exit ;; Motorola:*:4.3:PL8-*) echo powerpc-harris-powermax - exit 0 ;; + exit ;; Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) echo powerpc-harris-powermax - exit 0 ;; + exit ;; Night_Hawk:Power_UNIX:*:*) echo powerpc-harris-powerunix - exit 0 ;; + exit ;; m88k:CX/UX:7*:*) echo m88k-harris-cxux7 - exit 0 ;; + exit ;; m88k:*:4*:R4*) echo m88k-motorola-sysv4 - exit 0 ;; + exit ;; m88k:*:3*:R3*) echo m88k-motorola-sysv3 - exit 0 ;; + exit ;; AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ @@ -502,29 +498,29 @@ else echo i586-dg-dgux${UNAME_RELEASE} fi - exit 0 ;; + exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 - exit 0 ;; + exit ;; M88*:*:R3*:*) # Delta 88k system running SVR3 echo m88k-motorola-sysv3 - exit 0 ;; + exit ;; XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) echo m88k-tektronix-sysv3 - exit 0 ;; + exit ;; Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) echo m68k-tektronix-bsd - exit 0 ;; + exit ;; *:IRIX*:*:*) echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` - exit 0 ;; + exit ;; ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. - echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id - exit 0 ;; # Note that: echo "'`uname -s`'" gives 'AIX ' + echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id + exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' i*86:AIX:*:*) echo i386-ibm-aix - exit 0 ;; + exit ;; ia64:AIX:*:*) if [ -x /usr/bin/oslevel ] ; then IBM_REV=`/usr/bin/oslevel` @@ -532,7 +528,7 @@ IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} fi echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} - exit 0 ;; + exit ;; *:AIX:2:3) if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then eval $set_cc_for_build @@ -547,15 +543,19 @@ exit(0); } EOF - $CC_FOR_BUILD -o $dummy $dummy.c && $dummy && exit 0 - echo rs6000-ibm-aix3.2.5 + if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` + then + echo "$SYSTEM_NAME" + else + echo rs6000-ibm-aix3.2.5 + fi elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then echo rs6000-ibm-aix3.2.4 else echo rs6000-ibm-aix3.2 fi - exit 0 ;; - *:AIX:*:[45]) + exit ;; + *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 @@ -568,28 +568,28 @@ IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} fi echo ${IBM_ARCH}-ibm-aix${IBM_REV} - exit 0 ;; + exit ;; *:AIX:*:*) echo rs6000-ibm-aix - exit 0 ;; + exit ;; ibmrt:4.4BSD:*|romp-ibm:BSD:*) echo romp-ibm-bsd4.4 - exit 0 ;; + exit ;; ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to - exit 0 ;; # report: romp-ibm BSD 4.3 + exit ;; # report: romp-ibm BSD 4.3 *:BOSX:*:*) echo rs6000-bull-bosx - exit 0 ;; + exit ;; DPX/2?00:B.O.S.:*:*) echo m68k-bull-sysv3 - exit 0 ;; + exit ;; 9000/[34]??:4.3bsd:1.*:*) echo m68k-hp-bsd - exit 0 ;; + exit ;; hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) echo m68k-hp-bsd4.4 - exit 0 ;; + exit ;; 9000/[34678]??:HP-UX:*:*) HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` case "${UNAME_MACHINE}" in @@ -598,52 +598,52 @@ 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac + esac ;; + esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c + sed 's/^ //' << EOF >$dummy.c + + #define _HPUX_SOURCE + #include + #include + + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); - #define _HPUX_SOURCE - #include - #include - - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); - - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa @@ -651,9 +651,19 @@ esac if [ ${HP_ARCH} = "hppa2.0w" ] then - # avoid double evaluation of $set_cc_for_build - test -n "$CC_FOR_BUILD" || eval $set_cc_for_build - if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E -) | grep __LP64__ >/dev/null + eval $set_cc_for_build + + # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating + # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler + # generating 64-bit code. GNU and HP use different nomenclature: + # + # $ CC_FOR_BUILD=cc ./config.guess + # => hppa2.0w-hp-hpux11.23 + # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess + # => hppa64-hp-hpux11.23 + + if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | + grep -q __LP64__ then HP_ARCH="hppa2.0w" else @@ -661,11 +671,11 @@ fi fi echo ${HP_ARCH}-hp-hpux${HPUX_REV} - exit 0 ;; + exit ;; ia64:HP-UX:*:*) HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` echo ia64-hp-hpux${HPUX_REV} - exit 0 ;; + exit ;; 3050*:HI-UX:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c @@ -693,224 +703,259 @@ exit (0); } EOF - $CC_FOR_BUILD -o $dummy $dummy.c && $dummy && exit 0 + $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && + { echo "$SYSTEM_NAME"; exit; } echo unknown-hitachi-hiuxwe2 - exit 0 ;; + exit ;; 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) echo hppa1.1-hp-bsd - exit 0 ;; + exit ;; 9000/8??:4.3bsd:*:*) echo hppa1.0-hp-bsd - exit 0 ;; + exit ;; *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) echo hppa1.0-hp-mpeix - exit 0 ;; + exit ;; hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) echo hppa1.1-hp-osf - exit 0 ;; + exit ;; hp8??:OSF1:*:*) echo hppa1.0-hp-osf - exit 0 ;; + exit ;; i*86:OSF1:*:*) if [ -x /usr/sbin/sysversion ] ; then echo ${UNAME_MACHINE}-unknown-osf1mk else echo ${UNAME_MACHINE}-unknown-osf1 fi - exit 0 ;; + exit ;; parisc*:Lites*:*:*) echo hppa1.1-hp-lites - exit 0 ;; + exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd - exit 0 ;; + exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi - exit 0 ;; + exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd - exit 0 ;; + exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd - exit 0 ;; + exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd - exit 0 ;; + exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit 0 ;; + exit ;; CRAY*[A-Z]90:*:*:*) echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ -e 's/\.[^.]*$/.X/' - exit 0 ;; + exit ;; CRAY*TS:*:*:*) echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit 0 ;; + exit ;; CRAY*T3E:*:*:*) echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit 0 ;; + exit ;; CRAY*SV1:*:*:*) echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit 0 ;; + exit ;; *:UNICOS/mp:*:*) - echo nv1-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit 0 ;; + echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit 0 ;; + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit 0 ;; + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} - exit 0 ;; + exit ;; sparc*:BSD/OS:*:*) echo sparc-unknown-bsdi${UNAME_RELEASE} - exit 0 ;; + exit ;; *:BSD/OS:*:*) echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} - exit 0 ;; + exit ;; *:FreeBSD:*:*) - # Determine whether the default compiler uses glibc. - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include - #if __GLIBC__ >= 2 - LIBC=gnu - #else - LIBC= - #endif -EOF - eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^LIBC=` - # GNU/KFreeBSD systems have a "k" prefix to indicate we are using - # FreeBSD's kernel, but not the complete OS. - case ${LIBC} in gnu) kernel_only='k' ;; esac - echo ${UNAME_MACHINE}-unknown-${kernel_only}freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`${LIBC:+-$LIBC} - exit 0 ;; + UNAME_PROCESSOR=`/usr/bin/uname -p` + case ${UNAME_PROCESSOR} in + amd64) + echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + *) + echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + esac + exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin - exit 0 ;; - i*:MINGW*:*) + exit ;; + *:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 - exit 0 ;; + exit ;; + i*:MSYS*:*) + echo ${UNAME_MACHINE}-pc-msys + exit ;; + i*:windows32*:*) + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 + exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 - exit 0 ;; - x86:Interix*:[34]*) - echo i586-pc-interix${UNAME_RELEASE}|sed -e 's/\..*//' - exit 0 ;; + exit ;; + *:Interix*:*) + case ${UNAME_MACHINE} in + x86) + echo i586-pc-interix${UNAME_RELEASE} + exit ;; + authenticamd | genuineintel | EM64T) + echo x86_64-unknown-interix${UNAME_RELEASE} + exit ;; + IA64) + echo ia64-unknown-interix${UNAME_RELEASE} + exit ;; + esac ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks - exit 0 ;; + exit ;; + 8664:Windows_NT:*) + echo x86_64-pc-mks + exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we # UNAME_MACHINE based on the output of uname instead of i386? echo i586-pc-interix - exit 0 ;; + exit ;; i*:UWIN*:*) echo ${UNAME_MACHINE}-pc-uwin - exit 0 ;; + exit ;; + amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) + echo x86_64-unknown-cygwin + exit ;; p*:CYGWIN*:*) echo powerpcle-unknown-cygwin - exit 0 ;; + exit ;; prep*:SunOS:5.*:*) echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit 0 ;; + exit ;; *:GNU:*:*) # the GNU system echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` - exit 0 ;; + exit ;; *:GNU/*:*:*) # other systems with GNU libc and userland echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu - exit 0 ;; + exit ;; i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix - exit 0 ;; + exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit ;; arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo ${UNAME_MACHINE}-unknown-linux-gnu + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo ${UNAME_MACHINE}-unknown-linux-gnueabi + else + echo ${UNAME_MACHINE}-unknown-linux-gnueabihf + fi + fi + exit ;; + avr32*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu - exit 0 ;; - sa110:Linux:*:*) - echo arm-unknown-linux-gnu - exit 0 ;; + exit ;; cris:Linux:*:*) echo cris-axis-linux-gnu - exit 0 ;; - ia64:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit 0 ;; - m68*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit 0 ;; - mips:Linux:*:*) + exit ;; + crisv32:Linux:*:*) + echo crisv32-axis-linux-gnu + exit ;; + frv:Linux:*:*) + echo frv-unknown-linux-gnu + exit ;; + hexagon:Linux:*:*) + echo hexagon-unknown-linux-gnu + exit ;; + i*86:Linux:*:*) + LIBC=gnu eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef mips - #undef mipsel - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mipsel - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips - #else - CPU= - #endif + #ifdef __dietlibc__ + LIBC=dietlibc #endif EOF - eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^CPU=` - test x"${CPU}" != x && echo "${CPU}-unknown-linux-gnu" && exit 0 - ;; - mips64:Linux:*:*) + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` + echo "${UNAME_MACHINE}-pc-linux-${LIBC}" + exit ;; + ia64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + m32r*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + m68*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + mips:Linux:*:* | mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU - #undef mips64 - #undef mips64el + #undef ${UNAME_MACHINE} + #undef ${UNAME_MACHINE}el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mips64el + CPU=${UNAME_MACHINE}el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips64 + CPU=${UNAME_MACHINE} #else CPU= #endif #endif EOF - eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^CPU=` - test x"${CPU}" != x && echo "${CPU}-unknown-linux-gnu" && exit 0 + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` + test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu - exit 0 ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu - exit 0 ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} - exit 0 ;; + or32:Linux:*:*) + echo or32-unknown-linux-gnu + exit ;; + padre:Linux:*:*) + echo sparc-unknown-linux-gnu + exit ;; + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu + exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in @@ -918,115 +963,71 @@ PA8*) echo hppa2.0-unknown-linux-gnu ;; *) echo hppa-unknown-linux-gnu ;; esac - exit 0 ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu - exit 0 ;; + exit ;; + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu + exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux - exit 0 ;; + exit ;; sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit 0 ;; + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu - exit 0 ;; + exit ;; sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu - exit 0 ;; + exit ;; + tile*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + vax:Linux:*:*) + echo ${UNAME_MACHINE}-dec-linux-gnu + exit ;; x86_64:Linux:*:*) echo x86_64-unknown-linux-gnu - exit 0 ;; - i*86:Linux:*:*) - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. cd to the root directory to prevent - # problems with other programs or directories called `ld' in the path. - # Set LC_ALL=C to ensure ld outputs messages in English. - ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ - | sed -ne '/supported targets:/!d - s/[ ][ ]*/ /g - s/.*supported targets: *// - s/ .*// - p'` - case "$ld_supported_targets" in - elf32-i386) - TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" - ;; - a.out-i386-linux) - echo "${UNAME_MACHINE}-pc-linux-gnuaout" - exit 0 ;; - coff-i386) - echo "${UNAME_MACHINE}-pc-linux-gnucoff" - exit 0 ;; - "") - # Either a pre-BFD a.out linker (linux-gnuoldld) or - # one that does not give us useful --help. - echo "${UNAME_MACHINE}-pc-linux-gnuoldld" - exit 0 ;; - esac - # Determine whether the default compiler is a.out or elf - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include - #ifdef __ELF__ - # ifdef __GLIBC__ - # if __GLIBC__ >= 2 - LIBC=gnu - # else - LIBC=gnulibc1 - # endif - # else - LIBC=gnulibc1 - # endif - #else - #ifdef __INTEL_COMPILER - LIBC=gnu - #else - LIBC=gnuaout - #endif - #endif - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^LIBC=` - test x"${LIBC}" != x && echo "${UNAME_MACHINE}-pc-linux-${LIBC}" && exit 0 - test x"${TENTATIVE}" != x && echo "${TENTATIVE}" && exit 0 - ;; + exit ;; + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both # sysname and nodename. echo i386-sequent-sysv4 - exit 0 ;; + exit ;; i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. + # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} - exit 0 ;; + exit ;; i*86:OS/2:*:*) # If we were able to find `uname', then EMX Unix compatibility # is probably installed. echo ${UNAME_MACHINE}-pc-os2-emx - exit 0 ;; + exit ;; i*86:XTS-300:*:STOP) echo ${UNAME_MACHINE}-unknown-stop - exit 0 ;; + exit ;; i*86:atheos:*:*) echo ${UNAME_MACHINE}-unknown-atheos - exit 0 ;; - i*86:syllable:*:*) + exit ;; + i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable - exit 0 ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + exit ;; + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) echo i386-unknown-lynxos${UNAME_RELEASE} - exit 0 ;; + exit ;; i*86:*DOS:*:*) echo ${UNAME_MACHINE}-pc-msdosdjgpp - exit 0 ;; + exit ;; i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then @@ -1034,15 +1035,16 @@ else echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} fi - exit 0 ;; - i*86:*:5:[78]*) + exit ;; + i*86:*:5:[678]*) + # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; *Pent*|*Celeron) UNAME_MACHINE=i686 ;; esac echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} - exit 0 ;; + exit ;; i*86:*:3.2:*) if test -f /usr/options/cb.name; then UNAME_REL=`sed -n 's/.*Version //p' /dev/null 2>&1 ; then echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 else # Add other i860-SVR4 vendors below as they are discovered. echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 fi - exit 0 ;; + exit ;; mini*:CTIX:SYS*5:*) # "miniframe" echo m68010-convergent-sysv - exit 0 ;; + exit ;; mc68k:UNIX:SYSTEM5:3.51m) echo m68k-convergent-sysv - exit 0 ;; + exit ;; M680?0:D-NIX:5.3:*) echo m68k-diab-dnix - exit 0 ;; - M68*:*:R3V[567]*:*) - test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;; - 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0) + exit ;; + M68*:*:R3V[5678]*:*) + test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; + 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) OS_REL='' test -r /etc/.relid \ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && echo i486-ncr-sysv4.3${OS_REL} && exit 0 + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ - && echo i586-ncr-sysv4.3${OS_REL} && exit 0 ;; + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && echo i486-ncr-sysv4 && exit 0 ;; + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} - exit 0 ;; + exit ;; mc68030:UNIX_System_V:4.*:*) echo m68k-atari-sysv4 - exit 0 ;; + exit ;; TSUNAMI:LynxOS:2.*:*) echo sparc-unknown-lynxos${UNAME_RELEASE} - exit 0 ;; + exit ;; rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} - exit 0 ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + exit ;; + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} - exit 0 ;; + exit ;; SM[BE]S:UNIX_SV:*:*) echo mips-dde-sysv${UNAME_RELEASE} - exit 0 ;; + exit ;; RM*:ReliantUNIX-*:*:*) echo mips-sni-sysv4 - exit 0 ;; + exit ;; RM*:SINIX-*:*:*) echo mips-sni-sysv4 - exit 0 ;; + exit ;; *:SINIX-*:*:*) if uname -p 2>/dev/null >/dev/null ; then UNAME_MACHINE=`(uname -p) 2>/dev/null` @@ -1134,71 +1149,94 @@ else echo ns32k-sni-sysv fi - exit 0 ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says - echo i586-unisys-sysv4 - exit 0 ;; + exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says + echo i586-unisys-sysv4 + exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes . # How about differentiating between stratus architectures? -djm echo hppa1.1-stratus-sysv4 - exit 0 ;; + exit ;; *:*:*:FTX*) # From seanf@swdc.stratus.com. echo i860-stratus-sysv4 - exit 0 ;; + exit ;; + i*86:VOS:*:*) + # From Paul.Green@stratus.com. + echo ${UNAME_MACHINE}-stratus-vos + exit ;; *:VOS:*:*) # From Paul.Green@stratus.com. echo hppa1.1-stratus-vos - exit 0 ;; + exit ;; mc68*:A/UX:*:*) echo m68k-apple-aux${UNAME_RELEASE} - exit 0 ;; + exit ;; news*:NEWS-OS:6*:*) echo mips-sony-newsos6 - exit 0 ;; + exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} + echo mips-nec-sysv${UNAME_RELEASE} else - echo mips-unknown-sysv${UNAME_RELEASE} + echo mips-unknown-sysv${UNAME_RELEASE} fi - exit 0 ;; + exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos - exit 0 ;; + exit ;; BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. echo powerpc-apple-beos - exit 0 ;; + exit ;; BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos - exit 0 ;; + exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} - exit 0 ;; + exit ;; SX-5:SUPER-UX:*:*) echo sx5-nec-superux${UNAME_RELEASE} - exit 0 ;; - osfmach3_ppc:*:*:*) - echo powerpc-unknown-linux - exit 0 ;; + exit ;; SX-6:SUPER-UX:*:*) echo sx6-nec-superux${UNAME_RELEASE} - exit 0 ;; + exit ;; + SX-7:SUPER-UX:*:*) + echo sx7-nec-superux${UNAME_RELEASE} + exit ;; + SX-8:SUPER-UX:*:*) + echo sx8-nec-superux${UNAME_RELEASE} + exit ;; + SX-8R:SUPER-UX:*:*) + echo sx8r-nec-superux${UNAME_RELEASE} + exit ;; Power*:Rhapsody:*:*) echo powerpc-apple-rhapsody${UNAME_RELEASE} - exit 0 ;; + exit ;; *:Rhapsody:*:*) echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} - exit 0 ;; + exit ;; *:Darwin:*:*) - case `uname -p` in - *86) UNAME_PROCESSOR=i686 ;; - powerpc) UNAME_PROCESSOR=powerpc ;; + UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown + case $UNAME_PROCESSOR in + i386) + eval $set_cc_for_build + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + UNAME_PROCESSOR="x86_64" + fi + fi ;; + unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} - exit 0 ;; + exit ;; *:procnto*:*:* | *:QNX:[0123456789]*:*) UNAME_PROCESSOR=`uname -p` if test "$UNAME_PROCESSOR" = "x86"; then @@ -1206,22 +1244,28 @@ UNAME_MACHINE=pc fi echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} - exit 0 ;; + exit ;; *:QNX:*:4*) echo i386-pc-qnx - exit 0 ;; + exit ;; + NEO-?:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk${UNAME_RELEASE} + exit ;; + NSE-?:NONSTOP_KERNEL:*:*) + echo nse-tandem-nsk${UNAME_RELEASE} + exit ;; NSR-?:NONSTOP_KERNEL:*:*) echo nsr-tandem-nsk${UNAME_RELEASE} - exit 0 ;; + exit ;; *:NonStop-UX:*:*) echo mips-compaq-nonstopux - exit 0 ;; + exit ;; BS2000:POSIX*:*:*) echo bs2000-siemens-sysv - exit 0 ;; + exit ;; DS/*:UNIX_System_V:*:*) echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} - exit 0 ;; + exit ;; *:Plan9:*:*) # "uname -m" is not consistent, so use $cputype instead. 386 # is converted to i386 for consistency with other x86 @@ -1232,31 +1276,50 @@ UNAME_MACHINE="$cputype" fi echo ${UNAME_MACHINE}-unknown-plan9 - exit 0 ;; + exit ;; *:TOPS-10:*:*) echo pdp10-unknown-tops10 - exit 0 ;; + exit ;; *:TENEX:*:*) echo pdp10-unknown-tenex - exit 0 ;; + exit ;; KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) echo pdp10-dec-tops20 - exit 0 ;; + exit ;; XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) echo pdp10-xkl-tops20 - exit 0 ;; + exit ;; *:TOPS-20:*:*) echo pdp10-unknown-tops20 - exit 0 ;; + exit ;; *:ITS:*:*) echo pdp10-unknown-its - exit 0 ;; + exit ;; SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} - exit 0 ;; + echo mips-sei-seiux${UNAME_RELEASE} + exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` - exit 0 ;; + exit ;; + *:*VMS:*:*) + UNAME_MACHINE=`(uname -p) 2>/dev/null` + case "${UNAME_MACHINE}" in + A*) echo alpha-dec-vms ; exit ;; + I*) echo ia64-dec-vms ; exit ;; + V*) echo vax-dec-vms ; exit ;; + esac ;; + *:XENIX:*:SysV) + echo i386-pc-xenix + exit ;; + i*86:skyos:*:*) + echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' + exit ;; + i*86:rdos:*:*) + echo ${UNAME_MACHINE}-pc-rdos + exit ;; + i*86:AROS:*:*) + echo ${UNAME_MACHINE}-pc-aros + exit ;; esac #echo '(No uname command or uname output not recognized.)' 1>&2 @@ -1279,16 +1342,16 @@ #include printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 - "4" + "4" #else - "" + "" #endif - ); exit (0); + ); exit (0); #endif #endif #if defined (__arm) && defined (__acorn) && defined (__unix) - printf ("arm-acorn-riscix"); exit (0); + printf ("arm-acorn-riscix\n"); exit (0); #endif #if defined (hp300) && !defined (hpux) @@ -1296,16 +1359,15 @@ #endif #if defined (NeXT) - char * arch; - int version; #if !defined (__ARCHITECTURE__) - arch = "m68k"; -#else - arch = __ARCHITECTURE__; - if (strcmp(arch, "hppa") == 0) arch = "hppa1.1"; +#define __ARCHITECTURE__ "m68k" #endif + int version; version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; - printf ("%s-next-nextstep%d\n", arch, version); + if (version < 4) + printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); + else + printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); exit (0); #endif @@ -1378,11 +1440,12 @@ } EOF -$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && $dummy && exit 0 +$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` && + { echo "$SYSTEM_NAME"; exit; } # Apollos put the system type in the environment. -test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit 0; } +test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; } # Convex versions that predate uname can use getsysinfo(1) @@ -1391,22 +1454,22 @@ case `getsysinfo -f cpu_type` in c1*) echo c1-convex-bsd - exit 0 ;; + exit ;; c2*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi - exit 0 ;; + exit ;; c34*) echo c34-convex-bsd - exit 0 ;; + exit ;; c38*) echo c38-convex-bsd - exit 0 ;; + exit ;; c4*) echo c4-convex-bsd - exit 0 ;; + exit ;; esac fi @@ -1417,7 +1480,9 @@ the operating system you are using. It is advised that you download the most up to date version of the config scripts from - ftp://ftp.gnu.org/pub/gnu/config/ + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD +and + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD If the version you run ($0) is already up to date, please send the following data and any information you think might be diff -Nru ocaml-3.12.1/config/gnu/config.sub ocaml-4.01.0/config/gnu/config.sub --- ocaml-3.12.1/config/gnu/config.sub 2004-02-16 12:30:04.000000000 +0000 +++ ocaml-4.01.0/config/gnu/config.sub 2012-08-02 08:17:59.000000000 +0000 @@ -1,9 +1,10 @@ #! /bin/sh # Configuration validation subroutine script. # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, +# 2011 Free Software Foundation, Inc. -timestamp='2004-02-16' +timestamp='2011-11-11' # This file is (in principle) common to ALL GNU software. # The presence of a machine in this file suggests that SOME GNU software @@ -21,22 +22,26 @@ # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. - +# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA +# 02110-1301, USA. +# # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. + # Please send patches to . Submit a context -# diff and a properly formatted ChangeLog entry. +# diff and a properly formatted GNU ChangeLog entry. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. @@ -70,8 +75,9 @@ version="\ GNU config.sub ($timestamp) -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 -Free Software Foundation, Inc. +Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, +2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free +Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -83,11 +89,11 @@ while test $# -gt 0 ; do case $1 in --time-stamp | --time* | -t ) - echo "$timestamp" ; exit 0 ;; + echo "$timestamp" ; exit ;; --version | -v ) - echo "$version" ; exit 0 ;; + echo "$version" ; exit ;; --help | --h* | -h ) - echo "$usage"; exit 0 ;; + echo "$usage"; exit ;; -- ) # Stop option processing shift; break ;; - ) # Use stdin as input. @@ -99,7 +105,7 @@ *local*) # First pass through any local machine types. echo $1 - exit 0;; + exit ;; * ) break ;; @@ -118,8 +124,11 @@ # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in - nto-qnx* | linux-gnu* | linux-dietlibc | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | \ - kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | storm-chaos* | os2-emx* | rtmk-nova*) + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ + linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | \ + kopensolaris*-gnu* | \ + storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; @@ -145,10 +154,13 @@ -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis) + -apple | -axis | -knuth | -cray | -microblaze) os= basic_machine=$1 ;; + -bluegene*) + os=-cnk + ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 @@ -163,13 +175,17 @@ os=-chorusos basic_machine=$1 ;; - -chorusrdb) - os=-chorusrdb + -chorusrdb) + os=-chorusrdb basic_machine=$1 - ;; + ;; -hiux*) os=-hiuxwe2 ;; + -sco6) + os=-sco5v6 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; -sco5) os=-sco3.2v5 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` @@ -186,6 +202,10 @@ # Don't forget version if it is 3.2v4 or newer. basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -sco5v6*) + # Don't forget version if it is 3.2v4 or newer. + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; -sco*) os=-sco3.2v2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` @@ -230,22 +250,32 @@ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ - | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr \ + | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ + | be32 | be64 \ + | bfin \ | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ - | fr30 | frv \ + | epiphany \ + | fido | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ - | m32r | m68000 | m68k | m88k | mcore \ + | le32 | le64 \ + | lm32 \ + | m32c | m32r | m32rle | m68000 | m68k | m88k \ + | maxq | mb | microblaze | mcore | mep | metag \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ - | mips64vr | mips64vrel \ + | mips64octeon | mips64octeonel \ | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ + | mips64vr5900 | mips64vr5900el \ | mipsisa32 | mipsisa32el \ | mipsisa32r2 | mipsisa32r2el \ | mipsisa64 | mipsisa64el \ @@ -254,30 +284,63 @@ | mipsisa64sr71k | mipsisa64sr71kel \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ + | moxie \ + | mt \ | msp430 \ + | nds32 | nds32le | nds32be \ + | nios | nios2 \ | ns16k | ns32k \ - | openrisc | or32 \ + | open8 \ + | or32 \ | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | powerpc | powerpc64 | powerpc64le | powerpcle \ | pyramid \ - | sh | sh[1234] | sh[23]e | sh[34]eb | shbe | shle | sh[1234]le | sh3ele \ + | rl78 | rx \ + | score \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ - | sparc | sparc64 | sparc86x | sparclet | sparclite | sparcv9 | sparcv9b \ - | strongarm \ - | tahoe | thumb | tic4x | tic80 | tron \ - | v850 | v850e \ + | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ + | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ + | spu \ + | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ | we32k \ - | x86 | xscale | xstormy16 | xtensa \ - | z8k) + | x86 | xc16x | xstormy16 | xtensa \ + | z8k | z80) basic_machine=$basic_machine-unknown ;; - m6811 | m68hc11 | m6812 | m68hc12) + c54x) + basic_machine=tic54x-unknown + ;; + c55x) + basic_machine=tic55x-unknown + ;; + c6x) + basic_machine=tic6x-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12 | picochip) # Motorola 68HC11/12. basic_machine=$basic_machine-unknown os=-none ;; m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) ;; + ms1) + basic_machine=mt-unknown + ;; + + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; + + xscaleeb) + basic_machine=armeb-unknown + ;; + + xscaleel) + basic_machine=armel-unknown + ;; # We use `pc' rather than `unknown' # because (1) that's what they normally are, and @@ -297,28 +360,35 @@ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ - | avr-* \ - | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ - | clipper-* | cydra-* \ + | avr-* | avr32-* \ + | be32-* | be64-* \ + | bfin-* | bs2000-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* \ + | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ - | f30[01]-* | f700-* | fr30-* | frv-* | fx80-* \ + | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | hexagon-* \ | i*86-* | i860-* | i960-* | ia64-* \ | ip2k-* | iq2000-* \ - | m32r-* \ + | le32-* | le64-* \ + | lm32-* \ + | m32c-* | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | mcore-* \ + | m88110-* | m88k-* | maxq-* | mcore-* | metag-* | microblaze-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ - | mips64vr-* | mips64vrel-* \ + | mips64octeon-* | mips64octeonel-* \ | mips64orion-* | mips64orionel-* \ + | mips64r5900-* | mips64r5900el-* \ + | mips64vr-* | mips64vrel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ + | mips64vr5900-* | mips64vr5900el-* \ | mipsisa32-* | mipsisa32el-* \ | mipsisa32r2-* | mipsisa32r2el-* \ | mipsisa64-* | mipsisa64el-* \ @@ -326,26 +396,39 @@ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ | mipstx39-* | mipstx39el-* \ + | mmix-* \ + | mt-* \ | msp430-* \ - | none-* | np1-* | nv1-* | ns16k-* | ns32k-* \ + | nds32-* | nds32le-* | nds32be-* \ + | nios-* | nios2-* \ + | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ | pyramid-* \ - | romp-* | rs6000-* \ - | sh-* | sh[1234]-* | sh[23]e-* | sh[34]eb-* | shbe-* \ + | rl78-* | romp-* | rs6000-* | rx-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ - | sparc-* | sparc64-* | sparc86x-* | sparclet-* | sparclite-* \ - | sparcv9-* | sparcv9b-* | strongarm-* | sv1-* | sx?-* \ - | tahoe-* | thumb-* \ + | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ + | sparclite-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ + | tahoe-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tile*-* \ | tron-* \ - | v850-* | v850e-* | vax-* \ + | ubicom32-* \ + | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ + | vax-* \ | we32k-* \ - | x86-* | x86_64-* | xps100-* | xscale-* | xstormy16-* \ - | xtensa-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* \ + | xstormy16-* | xtensa*-* \ | ymp-* \ - | z8k-*) + | z8k-* | z80-*) + ;; + # Recognize the basic CPU types without company name, with glob match. + xtensa*) + basic_machine=$basic_machine-unknown ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. @@ -363,7 +446,7 @@ basic_machine=a29k-amd os=-udi ;; - abacus) + abacus) basic_machine=abacus-unknown ;; adobe68k) @@ -409,6 +492,10 @@ basic_machine=m68k-apollo os=-bsd ;; + aros) + basic_machine=i386-pc + os=-aros + ;; aux) basic_machine=m68k-apple os=-aux @@ -417,10 +504,35 @@ basic_machine=ns32k-sequent os=-dynix ;; + blackfin) + basic_machine=bfin-unknown + os=-linux + ;; + blackfin-*) + basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + bluegene*) + basic_machine=powerpc-ibm + os=-cnk + ;; + c54x-*) + basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c55x-*) + basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c6x-*) + basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; c90) basic_machine=c90-cray os=-unicos ;; + cegcc) + basic_machine=arm-unknown + os=-cegcc + ;; convex-c1) basic_machine=c1-convex os=-bsd @@ -445,16 +557,27 @@ basic_machine=j90-cray os=-unicos ;; - cr16c) - basic_machine=cr16c-unknown + craynv) + basic_machine=craynv-cray + os=-unicosmp + ;; + cr16 | cr16-*) + basic_machine=cr16-unknown os=-elf ;; crds | unos) basic_machine=m68k-crds ;; + crisv32 | crisv32-* | etraxfs*) + basic_machine=crisv32-axis + ;; cris | cris-* | etrax*) basic_machine=cris-axis ;; + crx) + basic_machine=crx-unknown + os=-elf + ;; da30 | da30-*) basic_machine=m68k-da30 ;; @@ -477,6 +600,14 @@ basic_machine=m88k-motorola os=-sysv3 ;; + dicos) + basic_machine=i686-pc + os=-dicos + ;; + djgpp) + basic_machine=i586-pc + os=-msdosdjgpp + ;; dpx20 | dpx20-*) basic_machine=rs6000-bull os=-bosx @@ -627,6 +758,14 @@ basic_machine=m68k-isi os=-sysv ;; + m68knommu) + basic_machine=m68k-unknown + os=-linux + ;; + m68knommu-*) + basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; m88k-omron*) basic_machine=m88k-omron ;; @@ -638,10 +777,17 @@ basic_machine=ns32k-utek os=-sysv ;; + microblaze) + basic_machine=microblaze-xilinx + ;; mingw32) basic_machine=i386-pc os=-mingw32 ;; + mingw32ce) + basic_machine=arm-unknown + os=-mingw32ce + ;; miniframe) basic_machine=m68000-convergent ;; @@ -655,10 +801,6 @@ mips3*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown ;; - mmix*) - basic_machine=mmix-knuth - os=-mmixware - ;; monitor) basic_machine=m68k-rom68k os=-coff @@ -671,10 +813,21 @@ basic_machine=i386-pc os=-msdos ;; + ms1-*) + basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` + ;; + msys) + basic_machine=i386-pc + os=-msys + ;; mvs) basic_machine=i370-ibm os=-mvs ;; + nacl) + basic_machine=le32-unknown + os=-nacl + ;; ncr3000) basic_machine=i486-ncr os=-sysv4 @@ -739,9 +892,11 @@ np1) basic_machine=np1-gould ;; - nv1) - basic_machine=nv1-cray - os=-unicosmp + neo-tandem) + basic_machine=neo-tandem + ;; + nse-tandem) + basic_machine=nse-tandem ;; nsr-tandem) basic_machine=nsr-tandem @@ -750,9 +905,8 @@ basic_machine=hppa1.1-oki os=-proelf ;; - or32 | or32-*) + openrisc | openrisc-*) basic_machine=or32-unknown - os=-coff ;; os400) basic_machine=powerpc-ibm @@ -774,6 +928,14 @@ basic_machine=i860-intel os=-osf ;; + parisc) + basic_machine=hppa-unknown + os=-linux + ;; + parisc-*) + basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; pbd) basic_machine=sparc-tti ;; @@ -783,6 +945,12 @@ pc532 | pc532-*) basic_machine=ns32k-pc532 ;; + pc98) + basic_machine=i386-pc + ;; + pc98-*) + basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; pentium | p5 | k5 | k6 | nexgen | viac3) basic_machine=i586-pc ;; @@ -812,9 +980,10 @@ ;; power) basic_machine=power-ibm ;; - ppc) basic_machine=powerpc-unknown + ppc | ppcbe) basic_machine=powerpc-unknown ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ppc-* | ppcbe-*) + basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown @@ -839,6 +1008,10 @@ basic_machine=i586-unknown os=-pw32 ;; + rdos) + basic_machine=i386-pc + os=-rdos + ;; rom68k) basic_machine=m68k-rom68k os=-coff @@ -865,6 +1038,10 @@ sb1el) basic_machine=mipsisa64sb1el-unknown ;; + sde) + basic_machine=mipsisa32-sde + os=-elf + ;; sei) basic_machine=mips-sei os=-seiux @@ -876,6 +1053,9 @@ basic_machine=sh-hitachi os=-hms ;; + sh5el) + basic_machine=sh5le-unknown + ;; sh64) basic_machine=sh64-unknown ;; @@ -897,6 +1077,9 @@ basic_machine=i860-stratus os=-sysv4 ;; + strongarm-* | thumb-*) + basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; sun2) basic_machine=m68000-sun ;; @@ -953,17 +1136,9 @@ basic_machine=t90-cray os=-unicos ;; - tic54x | c54x*) - basic_machine=tic54x-unknown - os=-coff - ;; - tic55x | c55x*) - basic_machine=tic55x-unknown - os=-coff - ;; - tic6x | c6x*) - basic_machine=tic6x-unknown - os=-coff + tile*) + basic_machine=$basic_machine-unknown + os=-linux-gnu ;; tx39) basic_machine=mipstx39-unknown @@ -1025,9 +1200,16 @@ basic_machine=hppa1.1-winbond os=-proelf ;; + xbox) + basic_machine=i686-pc + os=-mingw32 + ;; xps | xps100) basic_machine=xps100-honeywell ;; + xscale-* | xscalee[bl]-*) + basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` + ;; ymp) basic_machine=ymp-cray os=-unicos @@ -1036,6 +1218,10 @@ basic_machine=z8k-unknown os=-sim ;; + z80-*-coff) + basic_machine=z80-unknown + os=-sim + ;; none) basic_machine=none-none os=-none @@ -1055,6 +1241,9 @@ romp) basic_machine=romp-ibm ;; + mmix) + basic_machine=mmix-knuth + ;; rs6000) basic_machine=rs6000-ibm ;; @@ -1071,13 +1260,10 @@ we32k) basic_machine=we32k-att ;; - sh3 | sh4 | sh[34]eb | sh[1234]le | sh[23]ele) + sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; - sh64) - basic_machine=sh64-unknown - ;; - sparc | sparcv9 | sparcv9b) + sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) basic_machine=sparc-sun ;; cydra) @@ -1121,9 +1307,12 @@ if [ x"$os" != x"" ] then case $os in - # First match some system type aliases - # that might get confused with valid system types. + # First match some system type aliases + # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. + -auroraux) + os=-auroraux + ;; -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; @@ -1144,26 +1333,31 @@ # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ + | -sym* | -kopensolaris* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* \ + | -aos* | -aros* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ - | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* | -openbsd* \ + | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ + | -openbsd* | -solidbsd* \ | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* \ - | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -linux-uclibc* | -uxpv* | -beos* | -mpeix* | -udk* \ + | -chorusos* | -chorusrdb* | -cegcc* \ + | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -linux-gnu* | -linux-android* \ + | -linux-newlib* | -linux-uclibc* \ + | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ - | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly*) + | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ + | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) @@ -1181,7 +1375,7 @@ os=`echo $os | sed -e 's|nto|nto-qnx|'` ;; -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ - | -windows* | -osx | -abug | -netware* | -os9* | -beos* \ + | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) ;; -mac*) @@ -1202,7 +1396,7 @@ -opened*) os=-openedition ;; - -os400*) + -os400*) os=-os400 ;; -wince*) @@ -1251,7 +1445,7 @@ -sinix*) os=-sysv4 ;; - -tpf*) + -tpf*) os=-tpf ;; -triton*) @@ -1290,6 +1484,14 @@ -kaos*) os=-kaos ;; + -zvmoe) + os=-zvmoe + ;; + -dicos*) + os=-dicos + ;; + -nacl*) + ;; -none) ;; *) @@ -1312,6 +1514,12 @@ # system, and we'll never get to this point. case $basic_machine in + score-*) + os=-elf + ;; + spu-*) + os=-elf + ;; *-acorn) os=-riscix1.2 ;; @@ -1321,9 +1529,18 @@ arm*-semi) os=-aout ;; - c4x-* | tic4x-*) - os=-coff - ;; + c4x-* | tic4x-*) + os=-coff + ;; + tic54x-*) + os=-coff + ;; + tic55x-*) + os=-coff + ;; + tic6x-*) + os=-coff + ;; # This must come before the *-dec entry. pdp10-*) os=-tops20 @@ -1349,6 +1566,9 @@ m68*-cisco) os=-aout ;; + mep-*) + os=-elf + ;; mips*-cisco) os=-elf ;; @@ -1367,9 +1587,15 @@ *-be) os=-beos ;; + *-haiku) + os=-haiku + ;; *-ibm) os=-aix ;; + *-knuth) + os=-mmixware + ;; *-wec) os=-proelf ;; @@ -1472,7 +1698,7 @@ -sunos*) vendor=sun ;; - -aix*) + -cnk*|-aix*) vendor=ibm ;; -beos*) @@ -1535,7 +1761,7 @@ esac echo $basic_machine$os -exit 0 +exit # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) diff -Nru ocaml-3.12.1/config/m-nt.h ocaml-4.01.0/config/m-nt.h --- ocaml-3.12.1/config/m-nt.h 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/config/m-nt.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: m-nt.h 9547 2010-01-22 12:48:24Z doligez $ */ - /* Machine configuration, Intel x86 processors, Win32, Visual C++ or Mingw compiler */ diff -Nru ocaml-3.12.1/config/m-templ.h ocaml-4.01.0/config/m-templ.h --- ocaml-3.12.1/config/m-templ.h 2005-09-22 14:21:50.000000000 +0000 +++ ocaml-4.01.0/config/m-templ.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: m-templ.h 7064 2005-09-22 14:21:50Z xleroy $ */ - /* Processor dependencies */ #define ARCH_SIXTYFOUR diff -Nru ocaml-3.12.1/config/s-nt.h ocaml-4.01.0/config/s-nt.h --- ocaml-3.12.1/config/s-nt.h 2002-06-18 13:01:53.000000000 +0000 +++ ocaml-4.01.0/config/s-nt.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: s-nt.h 4933 2002-06-18 13:01:53Z xleroy $ */ - /* Operating system dependencies, Intel x86 processors, Windows NT */ #define OCAML_OS_TYPE "Win32" @@ -27,3 +25,5 @@ #define HAS_MKTIME #define HAS_PUTENV #define HAS_LOCALE +#define HAS_BROKEN_PRINTF +#define HAS_IPV6 diff -Nru ocaml-3.12.1/config/s-templ.h ocaml-4.01.0/config/s-templ.h --- ocaml-3.12.1/config/s-templ.h 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/config/s-templ.h 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: s-templ.h 9547 2010-01-22 12:48:24Z doligez $ */ - /* Operating system and standard library dependencies. */ /* 0. Operating system type string. */ @@ -52,10 +50,10 @@ /* Define SUPPORT_DYNAMIC_LINKING if dynamic loading of C stub code via dlopen() is available. */ -#define HAS_EXPM1_LOG1P +#define HAS_C99_FLOAT_OPS -/* Define HAS_EXPM1_LOG1P if the math functions expm1() and log1p() - are available. (Standard C99 but not C89.) */ +/* Define HAS_C99_FLOAT_OPS if conforms to ISO C99. + In particular, it should provide expm1(), log1p(), hypot(), copysign(). */ /* 2. For the Unix library. */ diff -Nru ocaml-3.12.1/configure ocaml-4.01.0/configure --- ocaml-3.12.1/configure 2011-07-04 21:15:01.000000000 +0000 +++ ocaml-4.01.0/configure 2013-08-23 06:22:36.000000000 +0000 @@ -2,7 +2,7 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -13,8 +13,6 @@ # # ######################################################################### -# $Id: configure 11110 2011-07-04 21:15:01Z doligez $ - configure_options="$*" prefix=/usr/local bindir='' @@ -31,6 +29,7 @@ dllib='' x11_include_dir='' x11_lib_dir='' +graph_wanted=yes tk_wanted=yes pthread_wanted=yes tk_defs='' @@ -39,9 +38,13 @@ dl_defs='' verbose=no withcurses=yes +debugruntime=noruntimed withsharedlibs=yes gcc_warnings="-Wall" partialld="ld -r" +withcamlp4=camlp4 +with_frame_pointers=false +with_cfi=true # Try to turn internationalization off, can cause config.guess to malfunction! unset LANG @@ -81,14 +84,15 @@ asppoption="$2"; shift;; -lib*) cclibs="$2 $cclibs"; shift;; - -no-curses) + -no-curses|--no-curses) withcurses=no;; - -no-shared-libs) + -no-shared-libs|--no-shared-libs) withsharedlibs=no;; -x11include*|--x11include*) x11_include_dir=$2; shift;; -x11lib*|--x11lib*) x11_lib_dir=$2; shift;; + -no-graph|--no-graph) graph_wanted=no;; -with-pthread*|--with-pthread*) ;; # Ignored for backward compatibility -no-pthread*|--no-pthread*) @@ -109,6 +113,14 @@ dllib="$2"; shift;; -verbose|--verbose) verbose=yes;; + -with-debug-runtime|--with-debug-runtime) + debugruntime=runtimed;; + -no-camlp4|--no-camlp4) + withcamlp4="";; + -with-frame-pointers|--with-frame-pointers) + with_frame_pointers=true;; + -no-cfi|--no-cfi) + with_cfi=false;; *) echo "Unknown option \"$1\"." 1>&2; exit 2;; esac shift @@ -123,17 +135,23 @@ case "$bindir" in /*) ;; "") ;; - *) echo "The -bindir directory must be absolute." 1>&2; exit 2;; + '$(PREFIX)/'*) ;; + *) echo 'The -bindir directory must be absolute or relative to $(PREFIX).'>&2 + exit 2;; esac case "$libdir" in /*) ;; "") ;; - *) echo "The -libdir directory must be absolute." 1>&2; exit 2;; + '$(PREFIX)/'*) ;; + *) echo 'The -libdir directory must be absolute or relative to $(PREFIX).'>&2 + exit 2;; esac case "$mandir" in /*) ;; "") ;; - *) echo "The -mandir directory must be absolute." 1>&2; exit 2;; + '$(PREFIX)/'*) ;; + *) echo 'The -mandir directory must be absolute or relative to $(PREFIX).'>&2 + exit 2;; esac # Generate the files @@ -206,14 +224,14 @@ WARNING: you are using gcc version 2.7.2.1 on an Intel x86 processor. This version of gcc is known to generate incorrect code for the -Objective Caml runtime system on some Intel x86 machines. (The symptom +OCaml runtime system on some Intel x86 machines. (The symptom is a crash of boot/ocamlc when compiling stdlib/pervasives.mli.) In particular, the version of gcc 2.7.2.1 that comes with Linux RedHat 4.x / Intel is affected by this problem. Other Linux distributions might also be affected. If you are using one of these configurations, you are strongly advised to use another version of gcc, such as 2.95, which are -known to work well with Objective Caml. +known to work well with OCaml. Press to proceed or to stop. EOF @@ -222,7 +240,7 @@ WARNING: you are using gcc version 2.96 on an Intel x86 processor. Certain patched versions of gcc 2.96 are known to generate incorrect -code for the Objective Caml runtime system. (The symptom is a segmentation +code for the OCaml runtime system. (The symptom is a segmentation violation on boot/ocamlc.) Those incorrectly patched versions can be found in RedHat 7.2 and Mandrake 8.0 and 8.1; other Linux distributions might also be affected. (See bug #57760 on bugzilla.redhat.com) @@ -242,6 +260,7 @@ bytecc="$cc" mkexe="\$(BYTECC)" +mkexedebugflag="-g" bytecccompopts="" bytecclinkopts="" dllccompopts="" @@ -259,8 +278,9 @@ bytecccompopts="-fno-defer-pop $gcc_warnings -DSHRINKED_GNUC" mathlib="";; *,*-*-darwin*) - bytecccompopts="-fno-defer-pop -no-cpp-precomp $gcc_warnings" + bytecccompopts="-fno-defer-pop $gcc_warnings" mathlib="" + mkexe="$mkexe -Wl,-no_compact_unwind" # Tell gcc that we can use 32-bit code addresses for threaded code # unless we are compiled for a shared library (-fPIC option) echo "#ifndef __PIC__" >> m.h @@ -306,7 +326,7 @@ bytecccompopts="-fno-defer-pop $gcc_warnings -U_WIN32" dllccompopts="-U_WIN32 -DCAML_DLL" if test $withsharedlibs = yes; then - flexlink="flexlink -chain cygwin -merge-manifest" + flexlink="flexlink -chain cygwin -merge-manifest -stack 16777216" flexdir=`$flexlink -where | dos2unix` if test -z "$flexdir"; then echo "flexlink not found: native shared libraries won't be available" @@ -314,6 +334,7 @@ else iflexdir="-I\"$flexdir\"" mkexe="$flexlink -exe" + mkexedebugflag="-link -g" fi fi exe=".exe" @@ -340,7 +361,7 @@ case $? in 0) echo "The C compiler is ANSI-compliant.";; 1) echo "The C compiler $cc is not ANSI-compliant." - echo "You need an ANSI C compiler to build Objective Caml." + echo "You need an ANSI C compiler to build OCaml." exit 2;; *) echo "Unable to compile the test program." echo "Make sure the C compiler $cc is properly installed." @@ -359,7 +380,7 @@ echo "#define ARCH_SIXTYFOUR" >> m.h arch64=true;; *,*) echo "This architecture seems to be neither 32 bits nor 64 bits." - echo "Objective Caml won't run on this architecture." + echo "OCaml won't run on this architecture." exit 2;; *) echo "Unable to compile the test program." echo "Make sure the C compiler $cc is properly installed." @@ -368,7 +389,7 @@ if test $1 != 4 && test $2 != 4 && test $4 != 4; then echo "Sorry, we can't find a 32-bit integer type" echo "(sizeof(short) = $4, sizeof(int) = $1, sizeof(long) = $2)" - echo "Objective Caml won't run on this architecture." + echo "OCaml won't run on this architecture." exit 2 fi @@ -410,7 +431,7 @@ if test $3 = 8 && test $int64_native = false; then echo "This architecture has 64-bit pointers but no 64-bit integer type." - echo "Objective Caml won't run on this architecture." + echo "OCaml won't run on this architecture." exit 2 fi @@ -423,7 +444,7 @@ 1) echo "This is a little-endian architecture." echo "#undef ARCH_BIG_ENDIAN" >> m.h;; 2) echo "This architecture seems to be neither big endian nor little endian." - echo "Objective Caml won't run on this architecture." + echo "OCaml won't run on this architecture." exit 2;; *) echo "Something went wrong during endianness determination." echo "You'll have to figure out endianness yourself" @@ -457,9 +478,9 @@ 1) echo "Doubles must be doubleword-aligned." echo "#define ARCH_ALIGN_DOUBLE" >> m.h;; *) echo "Something went wrong during alignment determination for doubles." - echo "I'm going to assume this architecture has alignment constraints over doubles." - echo "That's a safe bet: Objective Caml will work even if" - echo "this architecture has actually no alignment constraints." + echo "We will assume alignment constraints over doubles." + echo "That's a safe bet: OCaml will work even if" + echo "this architecture actually has no alignment constraints." echo "#define ARCH_ALIGN_DOUBLE" >> m.h;; esac;; esac @@ -482,9 +503,9 @@ echo "#undef ARCH_ALIGN_INT64" >> m.h;; 1) echo "64-bit integers must be doubleword-aligned." echo "#define ARCH_ALIGN_INT64" >> m.h;; - *) echo "Something went wrong during alignment determination for 64-bit integers." - echo "I'm going to assume this architecture has alignment constraints." - echo "That's a safe bet: Objective Caml will work even if" + *) echo "Something went wrong during alignment determination for 64-bit" + echo "integers. I'm going to assume this architecture has alignment" + echo "constraints. That's a safe bet: OCaml will work even if" echo "this architecture has actually no alignment constraints." echo "#define ARCH_ALIGN_INT64" >> m.h;; esac @@ -497,11 +518,14 @@ sh ./runtest divmod.c case $? in - 0) echo "Native division and modulus have round-towards-zero semantics, will use them." + 0) echo "Native division and modulus have round-towards-zero semantics," + echo "will use them." echo "#undef NONSTANDARD_DIV_MOD" >> m.h;; - 1) echo "Native division and modulus do not have round-towards-zero semantics, will use software emulation." + 1) echo "Native division and modulus do not have round-towards-zero" + echo "semantics, will use software emulation." echo "#define NONSTANDARD_DIV_MOD" >> m.h;; - *) echo "Something went wrong while checking native division and modulus, please report it." + *) echo "Something went wrong while checking native division and modulus," + echo "please report it at http://http://caml.inria.fr/mantis/" echo "#define NONSTANDARD_DIV_MOD" >> m.h;; esac @@ -521,7 +545,7 @@ mksharedlib="$flexlink" mkmaindll="$flexlink -maindll" shared_libraries_supported=true;; - *-*-linux-gnu|*-*-linux|*-*-freebsd[3-9]*|*-*-openbsd*|*-*-netbsd*|*-*-gnu*) + *-*-linux-gnu|*-*-linux|*-*-freebsd[3-9]*|*-*-freebsd[1-9][0-9]*|*-*-openbsd*|*-*-netbsd*|*-*-gnu*) sharedcccompopts="-fPIC" mksharedlib="$bytecc -shared" bytecclinkopts="$bytecclinkopts -Wl,-E" @@ -576,19 +600,13 @@ byteccrpath="-Wl,-rpath," mksharedlibrpath="-rpath " shared_libraries_supported=true;; - i[3456]86-*-darwin10.*) - mksharedlib="$bytecc -bundle -flat_namespace -undefined suppress" - bytecccompopts="$dl_defs $bytecccompopts" - dl_needs_underscore=false - shared_libraries_supported=true - ;; - i[3456]86-*-darwin*) + i[3456]86-*-darwin[89].*) mksharedlib="$bytecc -bundle -flat_namespace -undefined suppress -read_only_relocs suppress" bytecccompopts="$dl_defs $bytecccompopts" dl_needs_underscore=false shared_libraries_supported=true;; *-apple-darwin*) - mksharedlib="$bytecc -bundle -flat_namespace -undefined suppress" + mksharedlib="$bytecc -bundle -flat_namespace -undefined suppress -Wl,-no_compact_unwind" bytecccompopts="$dl_defs $bytecccompopts" dl_needs_underscore=false shared_libraries_supported=true;; @@ -619,14 +637,16 @@ case "$host" in *-*-cygwin*) natdynlink=true;; i[3456]86-*-linux*) natdynlink=true;; + i[3456]86-*-gnu*) natdynlink=true;; x86_64-*-linux*) natdynlink=true;; - i[3456]86-*-darwin10.*) + i[3456]86-*-darwin[89].*) natdynlink=true;; + i[3456]86-*-darwin*) if test $arch64 == true; then natdynlink=true fi;; - i[3456]86-*-darwin[89]*) natdynlink=true;; - powerpc64-*-linux*) natdynlink=true;; - sparc-*-linux*) natdynlink=true;; + x86_64-*-darwin*) natdynlink=true;; + powerpc*-*-linux*) natdynlink=true;; + sparc*-*-linux*) natdynlink=true;; i686-*-kfreebsd*) natdynlink=true;; x86_64-*-kfreebsd*) natdynlink=true;; i[345]86-*-freebsd*) natdynlink=true;; @@ -636,6 +656,7 @@ i[345]86-*-netbsd*) natdynlink=true;; x86_64-*-netbsd*) natdynlink=true;; i386-*-gnu0.3) natdynlink=true;; + arm*-*-linux*) natdynlink=true;; esac fi @@ -653,13 +674,6 @@ system=unknown case "$host" in - alpha*-*-osf*) arch=alpha; system=digital;; - alpha*-*-linux*) arch=alpha; system=linux;; - alpha*-*-gnu*) arch=alpha; system=gnu;; - alpha*-*-freebsd*) arch=alpha; system=freebsd;; - alpha*-*-netbsd*) arch=alpha; system=netbsd;; - alpha*-*-openbsd*) arch=alpha; system=openbsd;; - sparc*-*-sunos4.*) arch=sparc; system=sunos;; sparc*-*-solaris2.*) arch=sparc; system=solaris;; sparc*-*-*bsd*) arch=sparc; system=bsd;; sparc*-*-linux*) arch=sparc; system=linux;; @@ -680,27 +694,26 @@ arch=i386; system=macosx fi;; i[3456]86-*-gnu*) arch=i386; system=gnu;; - mips-*-irix6*) arch=mips; system=irix;; - hppa1.1-*-hpux*) arch=hppa; system=hpux;; - hppa2.0*-*-hpux*) arch=hppa; system=hpux;; - hppa*-*-linux*) arch=hppa; system=linux;; - hppa*-*-gnu*) arch=hppa; system=gnu;; powerpc*-*-linux*) arch=power; model=ppc; system=elf;; powerpc-*-netbsd*) arch=power; model=ppc; system=elf;; + powerpc-*-openbsd*) arch=power; model=ppc; system=bsd_elf;; powerpc-*-rhapsody*) arch=power; model=ppc; system=rhapsody;; powerpc-*-darwin*) arch=power; system=rhapsody - if $arch64; then model=ppc64; else model=ppc; fi;; - arm*-*-linux*) arch=arm; system=linux;; - arm*-*-gnu*) arch=arm; system=gnu;; - ia64-*-linux*) arch=ia64; system=linux;; - ia64-*-gnu*) arch=ia64; system=gnu;; - ia64-*-freebsd*) arch=ia64; system=freebsd;; + if $arch64;then model=ppc64;else model=ppc;fi;; + armv6*-*-linux-gnueabihf) arch=arm; model=armv6; system=linux_eabihf;; + arm*-*-linux-gnueabihf) arch=arm; system=linux_eabihf;; + armv7*-*-linux-gnueabi) arch=arm; model=armv7; system=linux_eabi;; + armv6t2*-*-linux-gnueabi) arch=arm; model=armv6t2; system=linux_eabi;; + armv6*-*-linux-gnueabi) arch=arm; model=armv6; system=linux_eabi;; + armv5te*-*-linux-gnueabi) arch=arm; model=armv5te; system=linux_eabi;; + armv5*-*-linux-gnueabi) arch=arm; model=armv5; system=linux_eabi;; + arm*-*-linux-gnueabi) arch=arm; system=linux_eabi;; x86_64-*-linux*) arch=amd64; system=linux;; x86_64-*-gnu*) arch=amd64; system=gnu;; x86_64-*-freebsd*) arch=amd64; system=freebsd;; x86_64-*-netbsd*) arch=amd64; system=netbsd;; x86_64-*-openbsd*) arch=amd64; system=openbsd;; - x86_64-*-darwin9.5) arch=amd64; system=macosx;; + x86_64-*-darwin*) arch=amd64; system=macosx;; esac # Some platforms exist both in 32-bit and 64-bit variants, not distinguished @@ -709,29 +722,24 @@ if $arch64; then case "$arch,$model" in - sparc,default|mips,default|hppa,default|power,ppc) + sparc,default|power,ppc) arch=none; model=default; system=unknown;; esac fi if test -z "$ccoption"; then - case "$arch,$system,$cc" in - alpha,digital,gcc*) nativecc=cc;; - mips,*,gcc*) nativecc=cc;; - *) nativecc="$bytecc";; - esac + nativecc="$bytecc" else nativecc="$ccoption" fi nativecccompopts='' nativecclinkopts='' +# FIXME the naming of nativecclinkopts is broken: these are options for +# ld (for shared libs), not for cc nativeccrpath="$byteccrpath" case "$arch,$nativecc,$system,$host_type" in - alpha,cc*,digital,*) nativecccompopts=-std1;; - mips,cc*,irix,*) nativecccompopts=-n32 - nativecclinkopts="-n32 -Wl,-woff,84";; *,*,nextstep,*) nativecccompopts="$gcc_warnings -U__GNUC__ -posix" nativecclinkopts="-posix";; *,*,rhapsody,*darwin[1-5].*) @@ -747,32 +755,26 @@ asppprofflags='-DPROFILING' case "$arch,$model,$system" in - alpha,*,digital) as='as -O2 -nocpp' - aspp='as -O2' - asppprofflags='-pg -DPROFILING';; - alpha,*,*) as='as' - aspp='gcc -c';; - amd64,*,macosx) as='as -arch x86_64' - aspp='gcc -arch x86_64 -c';; + amd64,*,macosx) if ./searchpath clang; then + as='clang -arch x86_64 -c' + aspp='clang -arch x86_64 -c' + else + as='as -arch x86_64' + aspp='gcc -arch x86_64 -c' + fi;; amd64,*,solaris) as='as --64' aspp='gcc -m64 -c';; amd64,*,*) as='as' aspp='gcc -c';; arm,*,*) as='as'; aspp='gcc -c';; - hppa,*,*) as='as'; - aspp='gcc -traditional -c';; i386,*,solaris) as='as' aspp='/usr/ccs/bin/as -P';; i386,*,*) as='as' aspp='gcc -c';; - ia64,*,*) as='as -xexplicit' - aspp='gcc -c -Wa,-xexplicit';; - mips,*,irix) as='as -n32 -O2 -nocpp -g0' - aspp='as -n32 -O2';; power,*,elf) as='as -u -m ppc' aspp='gcc -c';; - power,*,bsd) as='as' + power,*,bsd*) as='as' aspp='gcc -c';; power,*,rhapsody) as="as -arch $model" aspp="$bytecc -c";; @@ -790,7 +792,6 @@ cc_profile='-pg' case "$arch,$model,$system" in - alpha,*,digital) profiling='prof';; i386,*,linux_elf) profiling='prof';; i386,*,gnu) profiling='prof';; i386,*,bsd_elf) profiling='prof';; @@ -801,6 +802,7 @@ case "$nativecc" in gcc*) ;; *) cc_profile='-xpg';; esac;; amd64,*,linux) profiling='prof';; amd64,*,gnu) profiling='prof';; + arm,*,linux*) profiling='prof';; *) profiling='noprof';; esac @@ -816,6 +818,9 @@ echo "RANLIBCMD=" >> Makefile fi +echo "ARCMD=ar" >> Makefile + + # Do #! scripts work? if (SHELL=/bin/sh; export SHELL; (./sharpbang || ./sharpbang2) >/dev/null); then @@ -827,7 +832,7 @@ echo "SHARPBANGSCRIPTS=false" >> Makefile;; *-*-cygwin*) echo "We won't use it, though, because of conflicts with .exe extension" - echo "under Cygwin" + echo " under Cygwin" echo "SHARPBANGSCRIPTS=false" >> Makefile;; *) echo "SHARPBANGSCRIPTS=true" >> Makefile;; @@ -867,9 +872,9 @@ # For the Pervasives module -if sh ./trycompile expm1.c $mathlib; then - echo "expm1() and log1p() found." - echo "#define HAS_EXPM1_LOG1P" >> s.h +if sh ./hasgot2 -i math.h $mathlib expm1 log1p hypot copysign; then + echo "expm1(), log1p(), hypot(), copysign() found." + echo "#define HAS_C99_FLOAT_OPS" >> s.h fi # For the Sys module @@ -1056,14 +1061,7 @@ echo "#define HAS_TERMIOS" >> s.h fi -# Async I/O under OSF1 3.x are so buggy that the test program hangs... -testasyncio=true -if test -f /usr/bin/uname; then - case "`/usr/bin/uname -s -r`" in - "OSF1 V3."*) testasyncio=false;; - esac -fi -if $testasyncio && sh ./runtest async_io.c; then +if sh ./runtest async_io.c; then echo "Asynchronous I/O are supported." echo "#define HAS_ASYNC_IO" >> s.h fi @@ -1138,6 +1136,11 @@ echo "#define HAS_MMAP" >> s.h fi +if sh ./hasgot pwrite; then + echo "pwrite() found" + echo "#define HAS_PWRITE" >> s.h +fi + nargs=none for i in 5 6; do if sh ./trycompile -DNUM_ARGS=${i} gethostbyname.c; then nargs=$i; break; fi @@ -1170,7 +1173,7 @@ # Determine if system stack overflows can be detected case "$arch,$system" in - i386,linux_elf|amd64,linux|power,rhapsody|amd64,macosx|i386,macosx|amd64,macosx) + i386,linux_elf|amd64,linux|power,rhapsody|amd64,macosx|i386,macosx) echo "System stack overflow can be detected." echo "#define HAS_STACK_OVERFLOW_DETECTION" >> s.h;; *) @@ -1180,13 +1183,11 @@ # Determine the target architecture for the "num" library case "$arch" in - alpha) bng_arch=alpha; bng_asm_level=1;; i386) bng_arch=ia32 if sh ./trycompile ia32sse2.c then bng_asm_level=2 else bng_asm_level=1 fi;; - mips) bng_arch=mips; bng_asm_level=1;; power) bng_arch=ppc; bng_asm_level=1;; amd64) bng_arch=amd64; bng_asm_level=1;; *) bng_arch=generic; bng_asm_level=0;; @@ -1253,10 +1254,22 @@ # Determine the location of X include files and libraries +# If the user specified -x11include and/or -x11lib, these settings +# are used. Otherwise, we check whether there is pkg-config, and take +# the flags from there. Otherwise, we search the location. + x11_include="not found" x11_link="not found" -for dir in \ +if test -z "$x11_include_dir" -a -z "$x11_lib_dir"; then + if pkg-config --exists x11 2>/dev/null; then + x11_include=`pkg-config --cflags x11` + x11_link=`pkg-config --libs x11` + fi +fi + +if test "$x11_include" = "not found"; then + for dir in \ $x11_include_dir \ \ /usr/X11R7/include \ @@ -1302,20 +1315,21 @@ /usr/openwin/include \ /usr/openwin/share/include \ ; \ -do - if test -f $dir/X11/X.h; then - x11_include=$dir - break - fi -done + do + if test -f $dir/X11/X.h; then + x11_include_dir=$dir + x11_include="-I$dir" + break + fi + done -if test "$x11_include" = "not found"; then - x11_try_lib_dir='' -else - x11_try_lib_dir=`echo $x11_include | sed -e 's|include|lib|'` -fi + if test "$x11_include" = "not found"; then + x11_try_lib_dir='' + else + x11_try_lib_dir=`echo $x11_include_dir | sed -e 's|include|lib|'` + fi -for dir in \ + for dir in \ $x11_lib_dir \ $x11_try_lib_dir \ \ @@ -1357,93 +1371,62 @@ /lib/usr/lib/X11 \ \ /usr/openwin/lib \ - /usr/openwin/share/lib \ + /usr/openwin/share/lib \ + \ + /usr/lib/i386-linux-gnu \ + /usr/lib/x86_64-linux-gnu \ ; \ -do - if test -f $dir/libX11.a || \ - test -f $dir/libX11.so || \ - test -f $dir/libX11.dll.a || \ - test -f $dir/libX11.dylib || \ - test -f $dir/libX11.sa; then - if test $dir = /usr/lib; then - x11_link="-lX11" - else - x11_libs="-L$dir" - case "$host" in - *-*-*bsd*) x11_link="-R$dir -L$dir -lX11";; - *) x11_link="-L$dir -lX11";; - esac + do + if test -f $dir/libX11.a || \ + test -f $dir/libX11.so || \ + test -f $dir/libX11.dll.a || \ + test -f $dir/libX11.dylib || \ + test -f $dir/libX11.sa; then + if test $dir = /usr/lib; then + x11_link="-lX11" + else + x11_libs="-L$dir" + case "$host" in + *-kfreebsd*-gnu) x11_link="-L$dir -lX11";; + *-*-*bsd*) x11_link="-R$dir -L$dir -lX11";; + *) x11_link="-L$dir -lX11";; + esac + fi + break fi - break - fi -done + done +fi +if test "x11_include" != "not found"; then + if test "$x11_include" = "-I/usr/include"; then + x11_include="" + fi + if ./hasgot $x11_include $x11_link -i X11/Xlib.h XrmInitialize; then + echo "X11 works" + else + echo "Cannot compile X11 program" + x11_include="not found" + fi +fi +has_graph=false if test "$x11_include" = "not found" || test "$x11_link" = "not found" then echo "X11 not found, the \"graph\" library will not be supported." - x11_include="" + x11_include="not found" + x11_link="not found" else - echo "Location of X11 include files: $x11_include/X11" + echo "Options for compiling for X11: $x11_include" echo "Options for linking with X11: $x11_link" - otherlibraries="$otherlibraries graph" - if test "$x11_include" = "/usr/include"; then - x11_include="" - else - x11_include="-I$x11_include" + if test "$graph_wanted" = yes + then + has_graph=true + otherlibraries="$otherlibraries graph" fi fi echo "X11_INCLUDES=$x11_include" >> Makefile echo "X11_LINK=$x11_link" >> Makefile -# See if we can compile the dbm library - -dbm_include="not found" -dbm_link="not found" -use_gdbm_ndbm=no - -for dir in /usr/include /usr/include/db1 /usr/include/gdbm; do - if test -f $dir/ndbm.h; then - dbm_include=$dir - if sh ./hasgot dbm_open; then - dbm_link="" - elif sh ./hasgot -lndbm dbm_open; then - dbm_link="-lndbm" - elif sh ./hasgot -ldb1 dbm_open; then - dbm_link="-ldb1" - elif sh ./hasgot -lgdbm dbm_open; then - dbm_link="-lgdbm" - elif sh ./hasgot -lgdbm_compat -lgdbm dbm_open; then - dbm_link="-lgdbm_compat -lgdbm" - fi - break - fi - if test -f $dir/gdbm-ndbm.h; then - dbm_include=$dir - use_gdbm_ndbm=yes - if sh ./hasgot -lgdbm_compat -lgdbm dbm_open; then - dbm_link="-lgdbm_compat -lgdbm" - fi - break - fi -done -if test "$dbm_include" = "not found" || test "$dbm_link" = "not found"; then - echo "NDBM not found, the \"dbm\" library will not be supported." -else - echo "NDBM found (in $dbm_include)" - if test "$dbm_include" = "/usr/include"; then - dbm_include="" - else - dbm_include="-I$dbm_include" - fi - if test "$use_gdbm_ndbm" = "yes"; then - echo "#define DBM_USES_GDBM_NDBM" >> s.h - fi - otherlibraries="$otherlibraries dbm" -fi -echo "DBM_INCLUDES=$dbm_include" >> Makefile -echo "DBM_LINK=$dbm_link" >> Makefile - # Look for tcl/tk echo "Configuring LablTk..." @@ -1453,11 +1436,11 @@ elif test $tk_x11 = no; then has_tk=true elif test "$x11_include" = "not found" || test "$x11_link" = "not found"; then - echo "X11 not found." + echo "X11 not found or disabled." has_tk=false else tk_x11_include="$x11_include" - tk_x11_libs="$x11_libs -lX11" + tk_x11_libs="$x11_link" has_tk=true fi @@ -1467,6 +1450,8 @@ for tk_incs in \ "-I/usr/local/include" \ "-I/usr/include" \ + "-I/usr/local/include/tcl8.6 -I/usr/local/include/tk8.6" \ + "-I/usr/include/tcl8.6 -I/usr/include/tk8.6" \ "-I/usr/local/include/tcl8.5 -I/usr/local/include/tk8.5" \ "-I/usr/include/tcl8.5 -I/usr/include/tk8.5" \ "-I/usr/local/include/tcl8.4 -I/usr/local/include/tk8.4" \ @@ -1484,14 +1469,15 @@ if test -n "$tcl_version" && test "x$tcl_version" != "xnone"; then echo "tcl.h and tk.h version $tcl_version found with \"$tk_defs\"." case $tcl_version in - 7.5) tclmaj=7 tclmin=5 tkmaj=4 tkmin=1 ;; - 7.6) tclmaj=7 tclmin=6 tkmaj=4 tkmin=2 ;; - 8.0) tclmaj=8 tclmin=0 tkmaj=8 tkmin=0 ;; - 8.1) tclmaj=8 tclmin=1 tkmaj=8 tkmin=1 ;; - 8.2) tclmaj=8 tclmin=2 tkmaj=8 tkmin=2 ;; - 8.3) tclmaj=8 tclmin=3 tkmaj=8 tkmin=3 ;; - 8.4) tclmaj=8 tclmin=4 tkmaj=8 tkmin=4 ;; + 8.6) tclmaj=8 tclmin=6 tkmaj=8 tkmin=6 ;; 8.5) tclmaj=8 tclmin=5 tkmaj=8 tkmin=5 ;; + 8.4) tclmaj=8 tclmin=4 tkmaj=8 tkmin=4 ;; + 8.3) tclmaj=8 tclmin=3 tkmaj=8 tkmin=3 ;; + 8.2) tclmaj=8 tclmin=2 tkmaj=8 tkmin=2 ;; + 8.1) tclmaj=8 tclmin=1 tkmaj=8 tkmin=1 ;; + 8.0) tclmaj=8 tclmin=0 tkmaj=8 tkmin=0 ;; + 7.6) tclmaj=7 tclmin=6 tkmaj=4 tkmin=2 ;; + 7.5) tclmaj=7 tclmin=5 tkmaj=4 tkmin=1 ;; *) echo "This version is not known."; has_tk=false ;; esac else @@ -1537,10 +1523,6 @@ fi fi -case "$host" in - *-*-cygwin*) tk_libs="$tk_libs -lws2_32";; -esac - if test $has_tk = true; then if sh ./hasgot $tk_libs $tk_x11_libs $tkauxlibs Tk_SetGrid; then echo "Tcl/Tk libraries found." @@ -1591,6 +1573,36 @@ echo "LIBBFD_LINK=" >> Makefile fi +# Check whether assembler supports CFI directives + +asm_cfi_supported=false + +export as aspp + +if ! $with_cfi; then + echo "CFI support: disabled by command-line option -no-cfi" +elif sh ./tryassemble cfi.S; then + echo "#define ASM_CFI_SUPPORTED" >> m.h + asm_cfi_supported=true + echo "Assembler supports CFI" +else + echo "Assembler does not support CFI" +fi + +if test "$with_frame_pointers" = "true"; then + case "$host,$cc" in + x86_64-*-linux*,gcc*) + nativecccompopts="$nativecccompopts -g -fno-omit-frame-pointer" + bytecccompopts="$bytecccompopts -g -fno-omit-frame-pointer" + nativecclinkopts="$nativecclinkopts -g" + echo "#define WITH_FRAME_POINTERS" >> m.h + ;; + *) echo "Unsupported architecture with frame pointers" 1>&2; exit 2;; + esac + +fi + + # Final twiddling of compiler options to work around known bugs nativeccprofopts="$nativecccompopts" @@ -1658,8 +1670,17 @@ echo "NATDYNLINK=$natdynlink" >> Makefile echo "CMXS=$cmxs" >> Makefile echo "MKEXE=$mkexe" >> Makefile +echo "MKEXEDEBUGFLAG=$mkexedebugflag" >> Makefile echo "MKDLL=$mksharedlib" >> Makefile echo "MKMAINDLL=$mkmaindll" >> Makefile +echo "RUNTIMED=${debugruntime}" >>Makefile +echo "CAMLP4=${withcamlp4}" >>Makefile +echo "ASM_CFI_SUPPORTED=$asm_cfi_supported" >> Makefile +echo "WITH_FRAME_POINTERS=$with_frame_pointers" >> Makefile +if [ "$ostype" = Cygwin ]; then + echo "DIFF=diff -q --strip-trailing-cr" >>Makefile +fi + rm -f tst hasgot.c rm -f ../m.h ../s.h ../Makefile @@ -1670,7 +1691,7 @@ echo echo "** Configuration summary **" echo -echo "Directories where Objective Caml will be installed:" +echo "Directories where OCaml will be installed:" echo " binaries.................. $bindir" echo " standard library.......... $libdir" echo " manual pages.............. $mandir (with extension .$manext)" @@ -1704,6 +1725,16 @@ echo " options for linking....... $nativecclinkopts $cclibs" echo " assembler ................ $as" echo " preprocessed assembler ... $aspp" + if test "$asm_cfi_supported" = "true"; then + echo " assembler supports CFI ... yes" + else + echo " assembler supports CFI ... no" + fi + if test "$with_frame_pointers" = "true"; then + echo " with frame pointers....... yes" + else + echo " with frame pointers....... no" + fi echo " native dynlink ........... $natdynlink" if test "$profiling" = "prof"; then echo " profiling with gprof ..... supported" @@ -1718,27 +1749,38 @@ echo "Source-level replay debugger: not supported" fi +if test "$debugruntime" = "runtimed"; then + echo "Debug runtime will be compiled and installed" +fi + echo "Additional libraries supported:" echo " $otherlibraries" echo "Configuration for the \"num\" library:" echo " target architecture ...... $bng_arch (asm level $bng_asm_level)" -if test "$x11_include" != "not found" && test "$x11_lib" != "not found"; then +if $has_graph; then echo "Configuration for the \"graph\" library:" echo " options for compiling .... $x11_include" echo " options for linking ...... $x11_link" +else +echo "The \"graph\" library: not supported" fi if test $has_tk = true; then echo "Configuration for the \"labltk\" library:" echo " use tcl/tk version ....... $tcl_version" -echo " options for compiling .... $tk_defs" -echo " options for linking ...... $tk_libs" +echo " options for compiling .... $tk_defs $tk_x11_include" +echo " options for linking ...... $tk_libs $tk_x11_libs" else echo "The \"labltk\" library: not supported" fi echo -echo "** Objective Caml configuration completed successfully **" +echo "** OCaml configuration completed successfully **" echo + +if test ! -z "$MACOSX_DEPLOYMENT_TARGET"; then + echo "WARNING: the environment variable MACOSX_DEPLOYMENT_TARGET is set." + echo "This will probably prevent compiling the OCaml system." +fi diff -Nru ocaml-3.12.1/debian/MANIFEST ocaml-4.01.0/debian/MANIFEST --- ocaml-3.12.1/debian/MANIFEST 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/debian/MANIFEST 2013-09-19 21:03:42.000000000 +0000 @@ -0,0 +1,65 @@ +debian/MANIFEST +debian/README.Debian +debian/README.source +debian/TODO.Debian +debian/camlp4-extra.install.in +debian/camlp4-extra.links +debian/camlp4.dirs.in +debian/camlp4.install.in +debian/camlp4.links.in +debian/camlp4.manpages +debian/changelog +debian/clean +debian/compat +debian/control +debian/control.in +debian/copyright +debian/gbp.conf +debian/gen_modules.pl +debian/ld.conf.in +debian/man/camlp4.1 +debian/man/ocamldumpobj.1 +debian/man/ocamlmklib.1 +debian/man/ocamlobjinfo.1 +debian/natdynlink-archs +debian/native-archs +debian/ocaml-base-nox.README.Debian +debian/ocaml-base-nox.dirs.in +debian/ocaml-base-nox.docs +debian/ocaml-base-nox.install.in +debian/ocaml-base-nox.postinst.in +debian/ocaml-base-nox.prerm.in +debian/ocaml-base.dirs.in +debian/ocaml-base.install.in +debian/ocaml-compiler-libs.install.in +debian/ocaml-interp.install.in +debian/ocaml-interp.menu +debian/ocaml-mode.README.Debian +debian/ocaml-mode.dirs +debian/ocaml-mode.emacsen-install +debian/ocaml-mode.emacsen-remove +debian/ocaml-mode.emacsen-startup +debian/ocaml-native-compilers.dirs +debian/ocaml-native-compilers.files +debian/ocaml-native-compilers.install +debian/ocaml-native-compilers.links +debian/ocaml-nox.dirs.in +debian/ocaml-nox.install.in +debian/ocaml-nox.links.in +debian/ocaml-nox.lintian-overrides.in +debian/ocaml-nox.manpages.in +debian/ocaml-nox.postinst.in +debian/ocaml-nox.postrm +debian/ocaml-nox.preinst +debian/ocaml-source.dirs.in +debian/ocaml-source.exclude +debian/ocaml-source.install.in +debian/ocaml.dirs.in +debian/ocaml.examples +debian/ocaml.install.in +debian/ocaml.xpm +debian/ocamlfind/ocaml-native-compilers.conf +debian/ocamlinit.mk +debian/rules +debian/source/format +debian/watch diff -Nru ocaml-3.12.1/debian/changelog ocaml-4.01.0/debian/changelog --- ocaml-3.12.1/debian/changelog 2013-04-27 18:46:51.000000000 +0000 +++ ocaml-4.01.0/debian/changelog 2013-10-31 15:14:19.000000000 +0000 @@ -1,10 +1,168 @@ -ocaml (3.12.1-4ubuntu1) saucy; urgency=low +ocaml (4.01.0-1ppa4~saucy) saucy; urgency=low - * Merge from Debian unstable. Remaining changes: - - Pass --hash-style=both --as-needed --build-id to the linker. - - Add armhf to the ocaml-native-compilers architectures list. + * Bump - -- Adam Conrad Sat, 27 Apr 2013 12:45:36 -0600 + -- Anil Madhavapeddy Thu, 31 Oct 2013 15:14:19 +0000 + +ocaml (4.01.0-1ppa4~raring) raring; urgency=low + + * Bump + + -- Anil Madhavapeddy Thu, 19 Sep 2013 23:25:57 +0100 + +ocaml (4.01.0-1ppa4~quantal) quantal; urgency=low + + * Bump + + -- Anil Madhavapeddy Thu, 19 Sep 2013 23:25:46 +0100 + +ocaml (4.01.0-1ppa4~precise) precise; urgency=low + + * Bump + + -- Anil Madhavapeddy Thu, 19 Sep 2013 23:25:31 +0100 + +ocaml (4.01.0-1ppa3~raring) raring; urgency=low + + * Bump + + -- Anil Madhavapeddy Thu, 19 Sep 2013 22:52:28 +0100 + +ocaml (4.01.0-1ppa3~quantal) quantal; urgency=low + + * Bump + + -- Anil Madhavapeddy Thu, 19 Sep 2013 22:52:17 +0100 + +ocaml (4.01.0-1ppa3~precise) precise; urgency=low + + * Bump + + -- Anil Madhavapeddy Thu, 19 Sep 2013 22:50:45 +0100 + +ocaml (4.01.0-1ppa2~raring) raring; urgency=low + + * Bump + + -- Anil Madhavapeddy Thu, 19 Sep 2013 22:09:54 +0100 + +ocaml (4.01.0-1ppa2~quantal) quantal; urgency=low + + * Bump + + -- Anil Madhavapeddy Thu, 19 Sep 2013 22:09:43 +0100 + +ocaml (4.01.0-1ppa2~precise) precise; urgency=low + + * Bump + + -- Anil Madhavapeddy Thu, 19 Sep 2013 22:09:28 +0100 + +ocaml (4.01.0-1ppa1~raring) raring; urgency=low + + * Bump + + -- Anil Madhavapeddy Thu, 19 Sep 2013 18:09:45 +0100 + +ocaml (4.01.0-1ppa1~quantal) quantal; urgency=low + + * Bump + + -- Anil Madhavapeddy Thu, 19 Sep 2013 18:09:19 +0100 + +ocaml (4.01.0-1ppa1~precise) precise; urgency=low + + * Bump + + -- Anil Madhavapeddy Thu, 19 Sep 2013 18:08:48 +0100 + +ocaml (4.01.0-1ppa1~precise) precise; urgency=low + + * Bump + + -- Anil Madhavapeddy Thu, 19 Sep 2013 17:51:37 +0100 + +ocaml (4.00.2+SNAPSHOT20130828-1ppa2~precise1) precise; urgency=low + + * Update to latest 4.01 snap. + + -- Anil Madhavapeddy Wed, 07 Aug 2013 00:38:30 +0100 + +ocaml (4.00.1-1) experimental; urgency=low + + [ Stéphane Glondu ] + * New upstream release + * ocaml-compiler-libs: Replaces/Breaks previous versions of + ocaml-base-nox (Closes: #684031) + * Bump Standards-Version to 3.9.4 + * Bump debhelper compat level to 9 + + [ Sylvain Le Gall ] + * Remove Sylvain Le Gall from uploaders + + [ Mehdi Dogguy ] + * Use DEB_BUILD_GNU_TYPE instead of relying on "uname -m" (Closes: #689517). + Thanks to Konstantinos Margaritis for the patch. + + -- Stéphane Glondu Wed, 14 Nov 2012 14:17:27 +0100 + +ocaml (4.00.0-1) experimental; urgency=low + + * New upstream release + + -- Stéphane Glondu Fri, 27 Jul 2012 07:30:10 +0200 + +ocaml (4.00.0~rc1-1) experimental; urgency=low + + * New upstream release candidate + - fix linking of pthread_atfork (Closes: #682441) + * Merge changes from 3.12.1-4 + + -- Stéphane Glondu Sat, 21 Jul 2012 15:42:10 +0200 + +ocaml (4.00.0~beta2-2) experimental; urgency=low + + * Fix natdynlink detection on sparc + * Cherry-pick an upstream fix in native compilation on powerpc + * Fixes in the test suite: + - use legacy -custom for lib-marshal test + - some tests were still triggering ocamlopt even on bytecode + - fix asmcomp tests on powerpc + - fix symbol mangling in asmcomp tests on kfreebsd-i386 and sparc + * Bump Standards-Version to 3.9.3 + + -- Stéphane Glondu Thu, 21 Jun 2012 16:42:25 +0200 + +ocaml (4.00.0~beta2-1) experimental; urgency=low + + * New upstream beta release + - new "R" parameter in OCAMLRUNPARAMS to enable automatic + randomization of the generic hash function (Closes: #659149, + CVE-2012-0839) + - the layout of the ocaml-compiler-libs binary package has changed + significantly as a result of upstream installing +compiler-libs by + itself; toplevel libraries have been moved there + * Change the layout of the ocaml-source binary package + * Merge changes from version 3.12.1-3 + + -- Stéphane Glondu Wed, 13 Jun 2012 22:38:41 +0200 + +ocaml (4.00.0~~dev15+12379-1) experimental; urgency=low + + * New upstream snapshot, based on the 4.00 upstream branch + - partially revert r12328 to avoid FTBFS + - the dbm bindings have been removed upstream and are now released + separately + - declare armel and armhf as native architectures supporting + natdynlink + * Run the test-suite + - on kfreebsd-*, skip lib-thread tests (they hang and I am not able + to reproduce it myself) + - on slow architectures, skip some tests that take too much time + - fix asmcomp tests on Hurd (Closes: #661716) + - fix "embedded" test broken by our -custom behaviour + + -- Stéphane Glondu Thu, 19 Apr 2012 09:04:28 +0200 ocaml (3.12.1-4) unstable; urgency=low @@ -30,25 +188,6 @@ -- Stéphane Glondu Mon, 14 May 2012 07:52:40 +0200 -ocaml (3.12.1-2ubuntu3) quantal; urgency=low - - * No-change rebuild against latest armel toolchain. - - -- Adam Conrad Fri, 27 Apr 2012 07:35:22 -0600 - -ocaml (3.12.1-2ubuntu2) precise; urgency=low - - * Build ocaml-native-compilers for armhf. - - -- Matthias Klose Mon, 05 Dec 2011 17:09:44 +0100 - -ocaml (3.12.1-2ubuntu1) precise; urgency=low - - * Merge with Debian; remaining changes: - - Pass --hash-style=both --as-needed --build-id to the linker. - - -- Matthias Klose Fri, 18 Nov 2011 18:55:13 +0100 - ocaml (3.12.1-2) unstable; urgency=low * Fix compilation on kfreebsd-any: do not add -R$dir in X11 link options @@ -76,24 +215,6 @@ -- Stéphane Glondu Tue, 01 Nov 2011 13:53:49 +0100 -ocaml (3.12.0-7ubuntu2) oneiric; urgency=low - - * Pass --hash-style=both --no-copy-dt-needed-entries --as-needed to the linker. - - -- Matthias Klose Mon, 15 Aug 2011 12:17:36 +0200 - -ocaml (3.12.0-7ubuntu1) oneiric; urgency=low - - * ocamlopt/arm: Add .type directive for code symbols. LP: #810402. - - -- Matthias Klose Sat, 13 Aug 2011 08:59:40 +0200 - -ocaml (3.12.0-7build1) oneiric; urgency=low - - * Rebuild with GCC-4.6. - - -- Matthias Klose Thu, 14 Jul 2011 14:56:21 +0200 - ocaml (3.12.0-7) unstable; urgency=low * Force aligned access for double and int64 on mips* @@ -1932,4 +2053,3 @@ * Added Debian GNU/Linux Linux package maintenance system files -- Christophe Le Bars Fri, 11 Oct 1996 22:25:01 +0200 - diff -Nru ocaml-3.12.1/debian/clean ocaml-4.01.0/debian/clean --- ocaml-3.12.1/debian/clean 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/clean 2013-09-19 21:03:42.000000000 +0000 @@ -6,3 +6,5 @@ config/s.h myocamlbuild_config.ml tools/myocamlbuild_config.ml +ocamlc +ocamlcomp.sh diff -Nru ocaml-3.12.1/debian/compat ocaml-4.01.0/debian/compat --- ocaml-3.12.1/debian/compat 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/compat 2013-09-19 21:03:42.000000000 +0000 @@ -1 +1 @@ -8 +9 diff -Nru ocaml-3.12.1/debian/control ocaml-4.01.0/debian/control --- ocaml-3.12.1/debian/control 2013-04-27 18:47:00.000000000 +0000 +++ ocaml-4.01.0/debian/control 2013-09-19 21:03:42.000000000 +0000 @@ -1,26 +1,24 @@ Source: ocaml Section: ocaml Priority: optional -Maintainer: Ubuntu Developers -XSBC-Original-Maintainer: Debian OCaml Maintainers +Maintainer: Debian OCaml Maintainers Uploaders: Samuel Mimram , - Sylvain Le Gall , Ralf Treinen , Stéphane Glondu , Mehdi Dogguy Build-Depends: - debhelper (>= 8), + debhelper (>= 9), pkg-config, + quilt, autotools-dev, binutils-dev, tcl8.5-dev, tk8.5-dev, libncurses5-dev, - libgdbm-dev, bzip2, dh-ocaml (>= 1.0.0~) -Standards-Version: 3.9.2 +Standards-Version: 3.9.4 Vcs-Git: git://git.debian.org/git/pkg-ocaml-maint/packages/ocaml.git Vcs-Browser: http://git.debian.org/?p=pkg-ocaml-maint/packages/ocaml.git Homepage: http://caml.inria.fr/ @@ -42,7 +40,6 @@ libnums-ocaml-dev Suggests: ocaml-doc, - libgdbm-dev, tuareg-mode | ocaml-mode Recommends: camlp4, @@ -234,6 +231,7 @@ Package: ocaml-interp Architecture: any Depends: + ocaml-compiler-libs (= ${binary:Version}), ${ocaml:Depends}, ${shlibs:Depends}, ${misc:Depends} @@ -257,6 +255,8 @@ ocaml-nox-${F:OCamlABI} Provides: ocaml-compiler-libs-${F:OCamlABI} +Replaces: ocaml-base-nox (<< 4) +Breaks: ocaml-base-nox (<< 4) Description: OCaml interpreter and standard libraries Objective (OCaml) is an implementation of the ML language, based on the Caml Light dialect extended with a complete class-based object system diff -Nru ocaml-3.12.1/debian/control.in ocaml-4.01.0/debian/control.in --- ocaml-3.12.1/debian/control.in 2013-04-27 18:47:00.000000000 +0000 +++ ocaml-4.01.0/debian/control.in 2013-09-19 21:03:42.000000000 +0000 @@ -1,8 +1,7 @@ Source: ocaml Section: ocaml Priority: optional -Maintainer: Ubuntu Developers -XSBC-Original-Maintainer: Debian OCaml Maintainers +Maintainer: Debian OCaml Maintainers Uploaders: Samuel Mimram , Sylvain Le Gall , @@ -12,12 +11,12 @@ Build-Depends: debhelper (>= 8), pkg-config, + quilt, autotools-dev, binutils-dev, tcl8.5-dev, tk8.5-dev, libncurses5-dev, - libgdbm-dev, bzip2, dh-ocaml (>= 1.0.0~) Standards-Version: 3.9.2 @@ -28,6 +27,7 @@ Package: ocaml-nox Architecture: any Depends: + ocaml-base-nox, ${shlibs:Depends}, ${misc:Depends}, ${ocaml:Depends}, @@ -41,7 +41,6 @@ libnums-ocaml-dev Suggests: ocaml-doc, - libgdbm-dev, tuareg-mode | ocaml-mode Recommends: camlp4, @@ -101,6 +100,7 @@ Package: camlp4-extra Architecture: any Depends: + camlp4, ${shlibs:Depends}, ${misc:Depends}, ${ocaml:Depends}, @@ -124,6 +124,7 @@ Package: ocaml Architecture: any Depends: + ocaml-base-nox, ${shlibs:Depends}, ${misc:Depends}, ${ocaml:Depends}, @@ -179,6 +180,7 @@ Package: ocaml-base Architecture: any Depends: + ocaml-base-nox, ${shlibs:Depends}, ${misc:Depends}, ${ocaml:Depends} @@ -230,6 +232,7 @@ Package: ocaml-interp Architecture: any Depends: + ocaml-compiler-libs (= ${binary:Version}), ${ocaml:Depends}, ${shlibs:Depends}, ${misc:Depends} diff -Nru ocaml-3.12.1/debian/gbp.conf ocaml-4.01.0/debian/gbp.conf --- ocaml-3.12.1/debian/gbp.conf 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/gbp.conf 2013-09-19 21:03:42.000000000 +0000 @@ -1,2 +1,4 @@ [DEFAULT] pristine-tar = True +upstream-branch = experimental/upstream +debian-branch = experimental/master diff -Nru ocaml-3.12.1/debian/natdynlink-archs ocaml-4.01.0/debian/natdynlink-archs --- ocaml-3.12.1/debian/natdynlink-archs 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/natdynlink-archs 2013-09-19 21:03:42.000000000 +0000 @@ -1 +1 @@ -amd64 hurd-i386 i386 kfreebsd-i386 kfreebsd-amd64 lpia powerpc sparc +amd64 armel armhf hurd-i386 i386 kfreebsd-i386 kfreebsd-amd64 lpia powerpc sparc diff -Nru ocaml-3.12.1/debian/ocaml-base-nox.install.in ocaml-4.01.0/debian/ocaml-base-nox.install.in --- ocaml-3.12.1/debian/ocaml-base-nox.install.in 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/ocaml-base-nox.install.in 2013-09-19 21:03:42.000000000 +0000 @@ -1,17 +1,15 @@ usr/bin/ocamlrun usr/share/man/man1/ocamlrun.1 toplevel/*.mli @OCamlStdlibDir@ + @OCamlStdlibDir@/VERSION @OCamlDllDir@/dllunix.so @OCamlDllDir@/dllcamlstr.so @OCamlDllDir@/dllbigarray.so @OCamlDllDir@/dllthreads.so @OCamlDllDir@/dllvmthreads.so - @OCamlDllDir@/dllmldbm.so @OCamlDllDir@/dllnums.so @OCamlStdlibDir@/ld.conf debian/ld.conf @OCamlStdlibDir@ - @OCamlStdlibDir@/dbm.cma -DYN: @OCamlStdlibDir@/dbm.cmxs @OCamlStdlibDir@/unix.cma DYN: @OCamlStdlibDir@/unix.cmxs @OCamlStdlibDir@/str.cma @@ -63,9 +61,6 @@ @OCamlStdlibDir@/stringLabels.cmi @OCamlStdlibDir@/sys.cmi @OCamlStdlibDir@/weak.cmi - @OCamlStdlibDir@/toploop.cmi - @OCamlStdlibDir@/topdirs.cmi - @OCamlStdlibDir@/topmain.cmi @OCamlStdlibDir@/unix.cmi @OCamlStdlibDir@/unixLabels.cmi @OCamlStdlibDir@/str.cmi diff -Nru ocaml-3.12.1/debian/ocaml-compiler-libs.dirs.in ocaml-4.01.0/debian/ocaml-compiler-libs.dirs.in --- ocaml-3.12.1/debian/ocaml-compiler-libs.dirs.in 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/ocaml-compiler-libs.dirs.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -@OCamlStdlibDir@/compiler-libs/parsing -@OCamlStdlibDir@/compiler-libs/typing -@OCamlStdlibDir@/compiler-libs/utils diff -Nru ocaml-3.12.1/debian/ocaml-compiler-libs.install.in ocaml-4.01.0/debian/ocaml-compiler-libs.install.in --- ocaml-3.12.1/debian/ocaml-compiler-libs.install.in 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/ocaml-compiler-libs.install.in 2013-09-19 21:03:42.000000000 +0000 @@ -1,3 +1,2 @@ -parsing/* @OCamlStdlibDir@/compiler-libs/parsing -typing/* @OCamlStdlibDir@/compiler-libs/typing -utils/* @OCamlStdlibDir@/compiler-libs/utils +@OCamlStdlibDir@/compiler-libs +@OCamlStdlibDir@/topdirs.cmi diff -Nru ocaml-3.12.1/debian/ocaml-nox.install.in ocaml-4.01.0/debian/ocaml-nox.install.in --- ocaml-3.12.1/debian/ocaml-nox.install.in 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/ocaml-nox.install.in 2013-09-19 21:03:42.000000000 +0000 @@ -15,8 +15,8 @@ debian/native-archs @OCamlStdlibDir@ OPT: usr/bin/ocamlbuild.native OPT: usr/bin/ocamlopt +OPT: usr/bin/ocamloptp @OCamlStdlibDir@/stdlib.cma - @OCamlStdlibDir@/toplevellib.cma @OCamlStdlibDir@/dynlink.cma DYN: @OCamlStdlibDir@/dynlink.cmx DYN: @OCamlStdlibDir@/dynlink.cmxa @@ -36,7 +36,6 @@ OPT: @OCamlStdlibDir@/libasmrunp.a @OCamlStdlibDir@/libcamlrun.a @OCamlStdlibDir@/libcamlrun_shared.so - @OCamlStdlibDir@/libmldbm.a @OCamlStdlibDir@/libnums.a @OCamlStdlibDir@/libcamlstr.a @OCamlStdlibDir@/libthreads.a @@ -55,7 +54,6 @@ usr/share/man/man3/CamlinternalLazy.3o usr/share/man/man3/CamlinternalMod.3o usr/share/man/man3/CamlinternalOO.3o - usr/share/man/man3/Char.3o usr/share/man/man3/Complex.3o usr/share/man/man3/Digest.3o usr/share/man/man3/Filename.3o @@ -65,10 +63,12 @@ usr/share/man/man3/Hashtbl.3o usr/share/man/man3/Hashtbl.HashedType.3o usr/share/man/man3/Hashtbl.Make.3o + usr/share/man/man3/Hashtbl.MakeSeeded.3o usr/share/man/man3/Hashtbl.S.3o + usr/share/man/man3/Hashtbl.SeededHashedType.3o + usr/share/man/man3/Hashtbl.SeededS.3o usr/share/man/man3/Int32.3o usr/share/man/man3/Int64.3o - usr/share/man/man3/Lazy.3o usr/share/man/man3/Lexing.3o usr/share/man/man3/List.3o usr/share/man/man3/ListLabels.3o @@ -81,7 +81,10 @@ usr/share/man/man3/MoreLabels.Hashtbl.3o usr/share/man/man3/MoreLabels.Hashtbl.HashedType.3o usr/share/man/man3/MoreLabels.Hashtbl.Make.3o + usr/share/man/man3/MoreLabels.Hashtbl.MakeSeeded.3o usr/share/man/man3/MoreLabels.Hashtbl.S.3o + usr/share/man/man3/MoreLabels.Hashtbl.SeededHashedType.3o + usr/share/man/man3/MoreLabels.Hashtbl.SeededS.3o usr/share/man/man3/MoreLabels.Map.3o usr/share/man/man3/MoreLabels.Map.Make.3o usr/share/man/man3/MoreLabels.Map.OrderedType.3o @@ -104,7 +107,6 @@ usr/share/man/man3/Random.State.3o usr/share/man/man3/Scanf.3o usr/share/man/man3/Scanf.Scanning.3o - usr/share/man/man3/Set.3o usr/share/man/man3/Set.Make.3o usr/share/man/man3/Set.OrderedType.3o usr/share/man/man3/Set.S.3o @@ -116,7 +118,6 @@ usr/share/man/man3/StdLabels.String.3o usr/share/man/man3/Str.3o usr/share/man/man3/Stream.3o - usr/share/man/man3/String.3o usr/share/man/man3/StringLabels.3o usr/share/man/man3/Sys.3o usr/share/man/man3/Unix.3o @@ -125,6 +126,7 @@ usr/share/man/man3/Weak.Make.3o usr/share/man/man3/Weak.S.3o OPT: usr/share/man/man1/ocamlopt.1 +OPT: usr/share/man/man1/ocamloptp.1 usr/share/man/man1/ocamlprof.1 usr/share/man/man1/ocamlc.1 usr/share/man/man1/ocamldep.1 @@ -176,10 +178,6 @@ STD: complex.mli STD: complex.cmx STD: condition.mli -STD: dbm.cmi -STD: dbm.cmx -STD: dbm.cmxa -STD: dbm.mli STD: digest.ml STD: digest.mli STD: digest.cmx @@ -243,8 +241,6 @@ STD: oo.ml STD: oo.mli STD: oo.cmx -STD: outcometree.cmi -STD: outcometree.mli STD: parsing.ml STD: parsing.mli STD: parsing.cmx @@ -259,6 +255,7 @@ STD: printf.cmx STD: profiling.cmi STD: profiling.cmo +STD: profiling.cmx STD: queue.ml STD: queue.mli STD: queue.cmx @@ -303,7 +300,6 @@ STD: sys.cmx STD: thread.mli STD: threadUnix.mli -STD: topstart.cmo STD: unix.cmx STD: unix.cmxa STD: unix.mli diff -Nru ocaml-3.12.1/debian/ocaml-source.install.in ocaml-4.01.0/debian/ocaml-source.install.in --- ocaml-3.12.1/debian/ocaml-source.install.in 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/ocaml-source.install.in 2013-09-19 21:03:42.000000000 +0000 @@ -1 +1 @@ -debian/ocaml-source-@OCamlABI@.tar.bz2 /usr/src/ +debian/ocaml-source-@OCamlABI@.tar /usr/src/ diff -Nru ocaml-3.12.1/debian/patches/0001-Pass-no-relax-to-ld-on-alpha.patch ocaml-4.01.0/debian/patches/0001-Pass-no-relax-to-ld-on-alpha.patch --- ocaml-3.12.1/debian/patches/0001-Pass-no-relax-to-ld-on-alpha.patch 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/patches/0001-Pass-no-relax-to-ld-on-alpha.patch 2013-09-19 21:03:42.000000000 +0000 @@ -9,10 +9,10 @@ 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/configure b/configure -index 9be5199..236e016 100755 +index e08bbce..c95424e 100755 --- a/configure +++ b/configure -@@ -284,7 +284,8 @@ case "$bytecc,$host" in +@@ -299,7 +299,8 @@ case "$bytecc,$host" in gcc,alpha*-*-linux*) if cc="$bytecc" sh ./hasgot -mieee; then bytecccompopts="-mieee $bytecccompopts"; @@ -22,7 +22,7 @@ cc,mips-*-irix6*) # Add -n32 flag to ensure compatibility with native-code compiler bytecccompopts="-n32" -@@ -738,6 +739,7 @@ case "$arch,$nativecc,$system,$host_type" in +@@ -734,6 +735,7 @@ case "$arch,$nativecc,$system,$host_type" in nativecccompopts="$gcc_warnings -DSHRINKED_GNUC";; *,*,rhapsody,*) nativecccompopts="$gcc_warnings -DDARWIN_VERSION_6 $dl_defs" if $arch64; then partialld="ld -r -arch ppc64"; fi;; diff -Nru ocaml-3.12.1/debian/patches/0002-Call-ld-with-proper-flags.patch ocaml-4.01.0/debian/patches/0002-Call-ld-with-proper-flags.patch --- ocaml-3.12.1/debian/patches/0002-Call-ld-with-proper-flags.patch 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/patches/0002-Call-ld-with-proper-flags.patch 2013-09-19 21:03:42.000000000 +0000 @@ -10,10 +10,10 @@ 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure b/configure -index 236e016..d4287ed 100755 +index c95424e..20f7977 100755 --- a/configure +++ b/configure -@@ -1643,7 +1643,7 @@ echo "DEBUGGER=$debugger" >> Makefile +@@ -1619,7 +1619,7 @@ echo "DEBUGGER=$debugger" >> Makefile echo "CC_PROFILE=$cc_profile" >> Makefile echo "SYSTHREAD_SUPPORT=$systhread_support" >> Makefile echo "PARTIALLD=$partialld" >> Makefile diff -Nru ocaml-3.12.1/debian/patches/0003-Don-t-use-rpath.patch ocaml-4.01.0/debian/patches/0003-Don-t-use-rpath.patch --- ocaml-3.12.1/debian/patches/0003-Don-t-use-rpath.patch 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/patches/0003-Don-t-use-rpath.patch 2013-09-19 21:03:42.000000000 +0000 @@ -7,10 +7,10 @@ 1 file changed, 5 insertions(+) diff --git a/tools/ocamlmklib.mlp b/tools/ocamlmklib.mlp -index 8374439..b8d9e33 100644 +index b6c236e..b491fdd 100644 --- a/tools/ocamlmklib.mlp +++ b/tools/ocamlmklib.mlp -@@ -37,6 +37,11 @@ and output_c = ref "" (* Output name for C part of library *) +@@ -38,6 +38,11 @@ and output_c = ref "" (* Output name for C part of library *) and rpath = ref [] (* rpath options *) and verbose = ref false diff -Nru ocaml-3.12.1/debian/patches/0004-Put-manpages-in-section-3o-instead-of-3.patch ocaml-4.01.0/debian/patches/0004-Put-manpages-in-section-3o-instead-of-3.patch --- ocaml-3.12.1/debian/patches/0004-Put-manpages-in-section-3o-instead-of-3.patch 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/patches/0004-Put-manpages-in-section-3o-instead-of-3.patch 2013-09-19 21:03:42.000000000 +0000 @@ -7,10 +7,10 @@ 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile -index 8f6e87c..ace934c 100644 +index 74c82d3..1ef43b3 100644 --- a/ocamldoc/Makefile +++ b/ocamldoc/Makefile -@@ -318,7 +318,7 @@ test_texi: dummy +@@ -344,7 +344,7 @@ test_texi: dummy stdlib_man/Pervasives.3o: $(STDLIB_MLIS) $(MKDIR) stdlib_man $(OCAMLDOC_RUN) -man -d stdlib_man $(INCLUDES) \ diff -Nru ocaml-3.12.1/debian/patches/0005-Patch-config.sh-for-installation.patch ocaml-4.01.0/debian/patches/0005-Patch-config.sh-for-installation.patch --- ocaml-3.12.1/debian/patches/0005-Patch-config.sh-for-installation.patch 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/patches/0005-Patch-config.sh-for-installation.patch 2013-09-19 21:03:42.000000000 +0000 @@ -9,7 +9,7 @@ 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/build/install.sh b/build/install.sh -index 2785932..e8a6c15 100755 +index df01db4..546d65a 100755 --- a/build/install.sh +++ b/build/install.sh @@ -18,7 +18,7 @@ set -e @@ -22,7 +22,7 @@ not_installed=$PWD/_build/not_installed diff --git a/build/partial-install.sh b/build/partial-install.sh -index 56d3181..8e4fbd2 100755 +index a8113c9..15071d4 100755 --- a/build/partial-install.sh +++ b/build/partial-install.sh @@ -22,7 +22,7 @@ set -e diff -Nru ocaml-3.12.1/debian/patches/0006-Install-ocamlbuild-as-a-link-on-either-.native-or-.b.patch ocaml-4.01.0/debian/patches/0006-Install-ocamlbuild-as-a-link-on-either-.native-or-.b.patch --- ocaml-3.12.1/debian/patches/0006-Install-ocamlbuild-as-a-link-on-either-.native-or-.b.patch 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/patches/0006-Install-ocamlbuild-as-a-link-on-either-.native-or-.b.patch 2013-09-19 21:03:42.000000000 +0000 @@ -7,7 +7,7 @@ 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/build/partial-install.sh b/build/partial-install.sh -index 8e4fbd2..ca66bc1 100755 +index 15071d4..8170706 100755 --- a/build/partial-install.sh +++ b/build/partial-install.sh @@ -60,6 +60,21 @@ installbestbin() { @@ -32,7 +32,7 @@ installlib() { if [ -f "$1" ]; then dest="$2/`basename $1`" -@@ -156,7 +171,7 @@ echo "Installing ocamlbuild..." +@@ -158,7 +173,7 @@ echo "Installing ocamlbuild..." cd ocamlbuild installbin ocamlbuild.byte$EXE $BINDIR/ocamlbuild.byte$EXE installbin ocamlbuild.native$EXE $BINDIR/ocamlbuild.native$EXE diff -Nru ocaml-3.12.1/debian/patches/0007-Avoid-multiple-declarations-in-generated-.c-files-in.patch ocaml-4.01.0/debian/patches/0007-Avoid-multiple-declarations-in-generated-.c-files-in.patch --- ocaml-3.12.1/debian/patches/0007-Avoid-multiple-declarations-in-generated-.c-files-in.patch 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/debian/patches/0007-Avoid-multiple-declarations-in-generated-.c-files-in.patch 2013-09-19 21:03:42.000000000 +0000 @@ -0,0 +1,101 @@ +From: Stephane Glondu +Date: Thu, 21 Apr 2011 18:39:31 +0200 +Subject: Avoid multiple declarations in generated .c files in -output-obj + +In -output-obj mode, (which contains some +primitives) is included in the generated .c file, leading to errors +when compiling with g++ (multiple declarations). + +There are probably better implementations (in particular, in this one, +care must be taken when changing the list of primitives available in +mlvalues.h), but this is a small and (not too) intrusive patch. + +Bug: http://caml.inria.fr/mantis/view.php?id=5254 +Signed-off-by: Stephane Glondu +--- + bytecomp/bytelink.ml | 17 +++++++++++++++-- + bytecomp/symtable.ml | 8 +++++--- + bytecomp/symtable.mli | 2 +- + 3 files changed, 21 insertions(+), 6 deletions(-) + +diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml +index f40e425..bb14de6 100644 +--- a/bytecomp/bytelink.ml ++++ b/bytecomp/bytelink.ml +@@ -408,6 +408,19 @@ let output_cds_file outfile = + remove_file outfile; + raise x + ++(* List of primitives declared in caml/mlvalues.h, to avoid duplicate ++ declarations in generated .c files *) ++ ++let mlvalues_primitives = [ ++ "caml_get_public_method"; ++ "caml_hash_variant"; ++ "caml_string_length"; ++ "caml_Double_val"; ++ "caml_Store_double_val"; ++ "caml_Int64_val"; ++ "caml_atom_table"; ++] ++ + (* Output a bytecode executable as a C file *) + + let link_bytecode_as_c ppf tolink outfile = +@@ -450,7 +463,7 @@ let link_bytecode_as_c ppf tolink outfile = + (Marshal.to_string sections []); + output_string outchan "\n};\n\n"; + (* The table of primitives *) +- Symtable.output_primitive_table outchan; ++ Symtable.output_primitive_table outchan mlvalues_primitives; + (* The entry point *) + output_string outchan "\ + \nvoid caml_startup(char ** argv)\ +@@ -530,7 +543,7 @@ let link ppf objfiles output_name = + #else\n\ + typedef long value;\n\ + #endif\n"; +- Symtable.output_primitive_table poc; ++ Symtable.output_primitive_table poc []; + output_string poc "\ + #ifdef __cplusplus\n\ + }\n\ +diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml +index 7ab4bfd..3f4495e 100644 +--- a/bytecomp/symtable.ml ++++ b/bytecomp/symtable.ml +@@ -115,15 +115,17 @@ let output_primitive_names outchan = + + open Printf + +-let output_primitive_table outchan = ++let output_primitive_table outchan blacklist = + let prim = all_primitives() in + for i = 0 to Array.length prim - 1 do +- fprintf outchan "extern value %s();\n" prim.(i) ++ let p = prim.(i) in ++ if not (List.mem p blacklist) then ++ fprintf outchan "extern value %s();\n" p + done; + fprintf outchan "typedef value (*primitive)();\n"; + fprintf outchan "primitive caml_builtin_cprim[] = {\n"; + for i = 0 to Array.length prim - 1 do +- fprintf outchan " %s,\n" prim.(i) ++ fprintf outchan " (primitive)%s,\n" prim.(i) + done; + fprintf outchan " (primitive) 0 };\n"; + fprintf outchan "const char * caml_names_of_builtin_cprim[] = {\n"; +diff --git a/bytecomp/symtable.mli b/bytecomp/symtable.mli +index b4268f4..22dfebc 100644 +--- a/bytecomp/symtable.mli ++++ b/bytecomp/symtable.mli +@@ -24,7 +24,7 @@ val require_primitive: string -> unit + val initial_global_table: unit -> Obj.t array + val output_global_map: out_channel -> unit + val output_primitive_names: out_channel -> unit +-val output_primitive_table: out_channel -> unit ++val output_primitive_table: out_channel -> string list -> unit + val data_global_map: unit -> Obj.t + val data_primitive_names: unit -> string + +-- diff -Nru ocaml-3.12.1/debian/patches/0007-Natdynlink-works-on-powerpc-and-hurd-i386.patch ocaml-4.01.0/debian/patches/0007-Natdynlink-works-on-powerpc-and-hurd-i386.patch --- ocaml-3.12.1/debian/patches/0007-Natdynlink-works-on-powerpc-and-hurd-i386.patch 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/patches/0007-Natdynlink-works-on-powerpc-and-hurd-i386.patch 1970-01-01 00:00:00.000000000 +0000 @@ -1,37 +0,0 @@ -From: Stephane Glondu -Date: Sat, 16 Apr 2011 23:41:23 +0200 -Subject: Natdynlink works on powerpc and hurd-i386 - -Rationale: ssreflect used to work with natdynlink on powerpc and hurd -with ocaml 3.11.2 / coq 8.2... - -Note: there is no native compiler for powerpc64! This must be a -typo... - -Bug: http://caml.inria.fr/mantis/view.php?id=5255 -Signed-off-by: Stephane Glondu ---- - configure | 3 ++- - 1 file changed, 2 insertions(+), 1 deletion(-) - -diff --git a/configure b/configure -index d4287ed..d6ba2e3 100755 ---- a/configure -+++ b/configure -@@ -620,13 +620,14 @@ if test $withsharedlibs = "yes"; then - case "$host" in - *-*-cygwin*) natdynlink=true;; - i[3456]86-*-linux*) natdynlink=true;; -+ i[3456]86-*-gnu*) natdynlink=true;; - x86_64-*-linux*) natdynlink=true;; - i[3456]86-*-darwin10.*) - if test $arch64 == true; then - natdynlink=true - fi;; - i[3456]86-*-darwin[89]*) natdynlink=true;; -- powerpc64-*-linux*) natdynlink=true;; -+ powerpc-*-linux*) natdynlink=true;; - sparc-*-linux*) natdynlink=true;; - i686-*-kfreebsd*) natdynlink=true;; - x86_64-*-kfreebsd*) natdynlink=true;; --- diff -Nru ocaml-3.12.1/debian/patches/0008-Declare-primitive-name-table-as-const-char.patch ocaml-4.01.0/debian/patches/0008-Declare-primitive-name-table-as-const-char.patch --- ocaml-3.12.1/debian/patches/0008-Declare-primitive-name-table-as-const-char.patch 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/patches/0008-Declare-primitive-name-table-as-const-char.patch 1970-01-01 00:00:00.000000000 +0000 @@ -1,26 +0,0 @@ -From: Stephane Glondu -Date: Thu, 21 Apr 2011 18:39:57 +0200 -Subject: Declare primitive name table as const char * - -This avoids lots of warnings when compiling with g++... - -Bug: http://caml.inria.fr/mantis/view.php?id=5131 -Signed-off-by: Stephane Glondu ---- - bytecomp/symtable.ml | 2 +- - 1 file changed, 1 insertion(+), 1 deletion(-) - -diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml -index d6ecc94..37def29 100644 ---- a/bytecomp/symtable.ml -+++ b/bytecomp/symtable.ml -@@ -123,7 +123,7 @@ let output_primitive_table outchan = - fprintf outchan " %s,\n" prim.(i) - done; - fprintf outchan " (primitive) 0 };\n"; -- fprintf outchan "char * caml_names_of_builtin_cprim[] = {\n"; -+ fprintf outchan "const char * caml_names_of_builtin_cprim[] = {\n"; - for i = 0 to Array.length prim - 1 do - fprintf outchan " \"%s\",\n" prim.(i) - done; --- diff -Nru ocaml-3.12.1/debian/patches/0008-Embed-bytecode-in-C-object-when-using-custom.patch ocaml-4.01.0/debian/patches/0008-Embed-bytecode-in-C-object-when-using-custom.patch --- ocaml-3.12.1/debian/patches/0008-Embed-bytecode-in-C-object-when-using-custom.patch 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/debian/patches/0008-Embed-bytecode-in-C-object-when-using-custom.patch 2013-09-19 21:03:42.000000000 +0000 @@ -0,0 +1,127 @@ +From: Stephane Glondu +Date: Sat, 21 Jul 2012 15:40:52 +0200 +Subject: Embed bytecode in C object when using -custom + +This patch fixes non-strippability of bytecode executables linked with +custom runtime. The new behaviour is enabled when OCAML_CUSTOM_EMBED +is set to "y", or when DEB_HOST_ARCH is non-empty. + +Forwarded: not-needed +Bug-Debian: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=256900 +Bug-Debian: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=627761 +Bug-Debian: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=678577 +Signed-off-by: Stephane Glondu +--- + bytecomp/bytelink.ml | 42 ++++++++++++++++++++++++++++++---- + testsuite/tests/embedded/Makefile | 3 +++ + testsuite/tests/lib-marshal/Makefile | 3 +++ + 3 files changed, 44 insertions(+), 4 deletions(-) + +--- a/bytecomp/bytelink.ml ++++ b/bytecomp/bytelink.ml +@@ -435,7 +435,7 @@ + + (* Output a bytecode executable as a C file *) + +-let link_bytecode_as_c ppf tolink outfile = ++let link_bytecode_as_c ppf tolink outfile with_main = + let outchan = open_out outfile in + begin try + (* The bytecode *) +@@ -477,14 +477,27 @@ + (* The table of primitives *) + Symtable.output_primitive_table outchan mlvalues_primitives; + (* The entry point *) +- output_string outchan "\ ++ if with_main then begin ++ output_string outchan "\ ++\nint main(int argc, char **argv)\ ++\n{\ ++\n caml_startup_code(caml_code, sizeof(caml_code),\ ++\n caml_data, sizeof(caml_data),\ ++\n caml_sections, sizeof(caml_sections),\ ++\n argv);\ ++\n return 0; /* not reached */\ ++\n}\n" ++ end else begin ++ output_string outchan "\ + \nvoid caml_startup(char ** argv)\ + \n{\ + \n caml_startup_code(caml_code, sizeof(caml_code),\ + \n caml_data, sizeof(caml_data),\ + \n caml_sections, sizeof(caml_sections),\ + \n argv);\ +-\n}\ ++\n}\n" ++ end; ++ output_string outchan "\ + \n#ifdef __cplusplus\ + \n}\ + \n#endif\n"; +@@ -523,6 +536,17 @@ + if String.contains name '.' then name else name ^ ".exe" + | _ -> name + ++(* Debian-specific -custom behaviour: ++ - if DEB_HOST_ARCH is non-empty, it is activated by default ++ - can be enabled/disabled by setting OCAML_CUSTOM_EMBED to y/n ++*) ++ ++let custom_embed = ++ try Sys.getenv "OCAML_CUSTOM_EMBED" = "y" ++ with Not_found -> ++ try Sys.getenv "DEB_HOST_ARCH" <> "" ++ with Not_found -> false ++ + (* Main entry point (build a custom runtime if needed) *) + + let link ppf objfiles output_name = +@@ -536,6 +560,16 @@ + Clflags.dllibs := !lib_dllibs @ !Clflags.dllibs; (* put user's DLLs first *) + if not !Clflags.custom_runtime then + link_bytecode ppf tolink output_name true ++ else if custom_embed && not !Clflags.output_c_object && not !Clflags.make_runtime then ++ let c_file = Filename.temp_file "camlobj" ".c" in ++ try ++ link_bytecode_as_c ppf tolink c_file true; ++ let exec_name = fix_exec_name output_name in ++ if not (build_custom_runtime c_file exec_name) ++ then raise(Error Custom_runtime); ++ with x -> ++ remove_file c_file; ++ raise x + else if not !Clflags.output_c_object then begin + let bytecode_name = Filename.temp_file "camlcode" "" in + let prim_name = Filename.temp_file "camlprim" ".c" in +@@ -578,7 +612,7 @@ + if Sys.file_exists c_file then raise(Error(File_exists c_file)); + let temps = ref [] in + try +- link_bytecode_as_c ppf tolink c_file; ++ link_bytecode_as_c ppf tolink c_file false; + if not (Filename.check_suffix output_name ".c") then begin + temps := c_file :: !temps; + if Ccomp.compile_file c_file <> 0 then raise(Error Custom_runtime); +--- a/testsuite/tests/embedded/Makefile ++++ b/testsuite/tests/embedded/Makefile +@@ -12,6 +12,9 @@ + + BASEDIR=../.. + ++# This test relies on the upstream behaviour of -custom ++export OCAML_CUSTOM_EMBED=n ++ + .PHONY: default + default: compile run + +--- a/testsuite/tests/lib-marshal/Makefile ++++ b/testsuite/tests/lib-marshal/Makefile +@@ -15,5 +15,8 @@ + MAIN_MODULE=intext + C_FILES=intextaux + ++# This test relies on the upstream behaviour of -custom ++export OCAML_CUSTOM_EMBED=n ++ + include $(BASEDIR)/makefiles/Makefile.one + include $(BASEDIR)/makefiles/Makefile.common diff -Nru ocaml-3.12.1/debian/patches/0009-Avoid-multiple-declarations-in-generated-.c-files-in.patch ocaml-4.01.0/debian/patches/0009-Avoid-multiple-declarations-in-generated-.c-files-in.patch --- ocaml-3.12.1/debian/patches/0009-Avoid-multiple-declarations-in-generated-.c-files-in.patch 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/patches/0009-Avoid-multiple-declarations-in-generated-.c-files-in.patch 1970-01-01 00:00:00.000000000 +0000 @@ -1,101 +0,0 @@ -From: Stephane Glondu -Date: Thu, 21 Apr 2011 18:39:31 +0200 -Subject: Avoid multiple declarations in generated .c files in -output-obj - -In -output-obj mode, (which contains some -primitives) is included in the generated .c file, leading to errors -when compiling with g++ (multiple declarations). - -There are probably better implementations (in particular, in this one, -care must be taken when changing the list of primitives available in -mlvalues.h), but this is a small and (not too) intrusive patch. - -Bug: http://caml.inria.fr/mantis/view.php?id=5254 -Signed-off-by: Stephane Glondu ---- - bytecomp/bytelink.ml | 17 +++++++++++++++-- - bytecomp/symtable.ml | 8 +++++--- - bytecomp/symtable.mli | 2 +- - 3 files changed, 21 insertions(+), 6 deletions(-) - -diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml -index bd8f3b2..9d62fc6 100644 ---- a/bytecomp/bytelink.ml -+++ b/bytecomp/bytelink.ml -@@ -400,6 +400,19 @@ let output_cds_file outfile = - remove_file outfile; - raise x - -+(* List of primitives declared in caml/mlvalues.h, to avoid duplicate -+ declarations in generated .c files *) -+ -+let mlvalues_primitives = [ -+ "caml_get_public_method"; -+ "caml_hash_variant"; -+ "caml_string_length"; -+ "caml_Double_val"; -+ "caml_Store_double_val"; -+ "caml_Int64_val"; -+ "caml_atom_table"; -+] -+ - (* Output a bytecode executable as a C file *) - - let link_bytecode_as_c tolink outfile = -@@ -442,7 +455,7 @@ let link_bytecode_as_c tolink outfile = - (Marshal.to_string sections []); - output_string outchan "\n};\n\n"; - (* The table of primitives *) -- Symtable.output_primitive_table outchan; -+ Symtable.output_primitive_table outchan mlvalues_primitives; - (* The entry point *) - output_string outchan "\ - \nvoid caml_startup(char ** argv)\ -@@ -516,7 +529,7 @@ let link objfiles output_name = - #else\n\ - typedef long value;\n\ - #endif\n"; -- Symtable.output_primitive_table poc; -+ Symtable.output_primitive_table poc []; - output_string poc "\ - #ifdef __cplusplus\n\ - }\n\ -diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml -index 37def29..70958ee 100644 ---- a/bytecomp/symtable.ml -+++ b/bytecomp/symtable.ml -@@ -112,15 +112,17 @@ let output_primitive_names outchan = - - open Printf - --let output_primitive_table outchan = -+let output_primitive_table outchan blacklist = - let prim = all_primitives() in - for i = 0 to Array.length prim - 1 do -- fprintf outchan "extern value %s();\n" prim.(i) -+ let p = prim.(i) in -+ if not (List.mem p blacklist) then -+ fprintf outchan "extern value %s();\n" p - done; - fprintf outchan "typedef value (*primitive)();\n"; - fprintf outchan "primitive caml_builtin_cprim[] = {\n"; - for i = 0 to Array.length prim - 1 do -- fprintf outchan " %s,\n" prim.(i) -+ fprintf outchan " (primitive)%s,\n" prim.(i) - done; - fprintf outchan " (primitive) 0 };\n"; - fprintf outchan "const char * caml_names_of_builtin_cprim[] = {\n"; -diff --git a/bytecomp/symtable.mli b/bytecomp/symtable.mli -index 2b1583f..316381e 100644 ---- a/bytecomp/symtable.mli -+++ b/bytecomp/symtable.mli -@@ -24,7 +24,7 @@ val require_primitive: string -> unit - val initial_global_table: unit -> Obj.t array - val output_global_map: out_channel -> unit - val output_primitive_names: out_channel -> unit --val output_primitive_table: out_channel -> unit -+val output_primitive_table: out_channel -> string list -> unit - val data_global_map: unit -> Obj.t - val data_primitive_names: unit -> string - --- diff -Nru ocaml-3.12.1/debian/patches/0010-Properly-initialize-executable-name-in-caml_startup_.patch ocaml-4.01.0/debian/patches/0010-Properly-initialize-executable-name-in-caml_startup_.patch --- ocaml-3.12.1/debian/patches/0010-Properly-initialize-executable-name-in-caml_startup_.patch 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/patches/0010-Properly-initialize-executable-name-in-caml_startup_.patch 1970-01-01 00:00:00.000000000 +0000 @@ -1,48 +0,0 @@ -From: Stephane Glondu -Date: Tue, 24 May 2011 12:16:20 +0200 -Subject: Properly initialize executable name in caml_startup_code - -Bug: http://caml.inria.fr/mantis/view.php?id=5279 -Bug-Debian: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=627756 -Signed-off-by: Stephane Glondu ---- - byterun/startup.c | 11 ++++++++++- - 1 file changed, 10 insertions(+), 1 deletion(-) - -diff --git a/byterun/startup.c b/byterun/startup.c -index db273b2..780cb1e 100644 ---- a/byterun/startup.c -+++ b/byterun/startup.c -@@ -443,6 +443,10 @@ CAMLexport void caml_startup_code( - { - value res; - char* cds_file; -+ char * exe_name; -+#ifdef __linux__ -+ static char proc_self_exe[256]; -+#endif - - caml_init_ieee_floats(); - caml_init_custom_operations(); -@@ -455,6 +459,11 @@ CAMLexport void caml_startup_code( - strcpy(caml_cds_file, cds_file); - } - parse_camlrunparam(); -+ exe_name = argv[0]; -+#ifdef __linux__ -+ if (caml_executable_name(proc_self_exe, sizeof(proc_self_exe)) == 0) -+ exe_name = proc_self_exe; -+#endif - caml_external_raise = NULL; - /* Initialize the abstract machine */ - caml_init_gc (minor_heap_init, heap_size_init, heap_chunk_init, -@@ -489,7 +498,7 @@ CAMLexport void caml_startup_code( - caml_section_table_size = section_table_size; - /* Initialize system libraries */ - caml_init_exceptions(); -- caml_sys_init("", argv); -+ caml_sys_init(exe_name, argv); - /* Execute the program */ - caml_debugger(PROGRAM_START); - res = caml_interprete(caml_start_code, caml_code_size); --- diff -Nru ocaml-3.12.1/debian/patches/0011-Embed-bytecode-in-C-object-when-using-custom.patch ocaml-4.01.0/debian/patches/0011-Embed-bytecode-in-C-object-when-using-custom.patch --- ocaml-3.12.1/debian/patches/0011-Embed-bytecode-in-C-object-when-using-custom.patch 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/patches/0011-Embed-bytecode-in-C-object-when-using-custom.patch 1970-01-01 00:00:00.000000000 +0000 @@ -1,105 +0,0 @@ -From: Stephane Glondu -Date: Sun, 17 Aug 2008 17:10:03 +0200 -Subject: Embed bytecode in C object when using -custom - -This patch fixes non-strippability of bytecode executables linked with -custom runtime. The new behaviour is enabled when OCAML_CUSTOM_EMBED -is set to "y", or when DEB_HOST_ARCH is non-empty. - -Forwarded: not-needed -Bug-Debian: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=256900 -Bug-Debian: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=627761 -Bug-Debian: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=678577 -Signed-off-by: Stephane Glondu ---- - bytecomp/bytelink.ml | 42 ++++++++++++++++++++++++++++++++++++++---- - 1 file changed, 38 insertions(+), 4 deletions(-) - -diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml -index 9d62fc6..c6d558f 100644 ---- a/bytecomp/bytelink.ml -+++ b/bytecomp/bytelink.ml -@@ -415,7 +415,7 @@ let mlvalues_primitives = [ - - (* Output a bytecode executable as a C file *) - --let link_bytecode_as_c tolink outfile = -+let link_bytecode_as_c tolink outfile with_main = - let outchan = open_out outfile in - begin try - (* The bytecode *) -@@ -457,14 +457,27 @@ let link_bytecode_as_c tolink outfile = - (* The table of primitives *) - Symtable.output_primitive_table outchan mlvalues_primitives; - (* The entry point *) -- output_string outchan "\ -+ if with_main then begin -+ output_string outchan "\ -+\nint main(int argc, char **argv)\ -+\n{\ -+\n caml_startup_code(caml_code, sizeof(caml_code),\ -+\n caml_data, sizeof(caml_data),\ -+\n caml_sections, sizeof(caml_sections),\ -+\n argv);\ -+\n return 0; /* not reached */\ -+\n}\n" -+ end else begin -+ output_string outchan "\ - \nvoid caml_startup(char ** argv)\ - \n{\ - \n caml_startup_code(caml_code, sizeof(caml_code),\ - \n caml_data, sizeof(caml_data),\ - \n caml_sections, sizeof(caml_sections),\ - \n argv);\ --\n}\ -+\n}\n" -+ end; -+ output_string outchan "\ - \n#ifdef __cplusplus\ - \n}\ - \n#endif\n"; -@@ -501,6 +514,17 @@ let fix_exec_name name = - if String.contains name '.' then name else name ^ ".exe" - | _ -> name - -+(* Debian-specific -custom behaviour: -+ - if DEB_HOST_ARCH is non-empty, it is activated by default -+ - can be enabled/disabled by setting OCAML_CUSTOM_EMBED to y/n -+*) -+ -+let custom_embed = -+ try Sys.getenv "OCAML_CUSTOM_EMBED" = "y" -+ with Not_found -> -+ try Sys.getenv "DEB_HOST_ARCH" <> "" -+ with Not_found -> false -+ - (* Main entry point (build a custom runtime if needed) *) - - let link objfiles output_name = -@@ -514,6 +538,16 @@ let link objfiles output_name = - Clflags.dllibs := !lib_dllibs @ !Clflags.dllibs; (* put user's DLLs first *) - if not !Clflags.custom_runtime then - link_bytecode tolink output_name true -+ else if custom_embed && not !Clflags.output_c_object && not !Clflags.make_runtime then -+ let c_file = Filename.temp_file "camlobj" ".c" in -+ try -+ link_bytecode_as_c tolink c_file true; -+ let exec_name = fix_exec_name output_name in -+ if not (build_custom_runtime c_file exec_name) -+ then raise(Error Custom_runtime); -+ with x -> -+ remove_file c_file; -+ raise x - else if not !Clflags.output_c_object then begin - let bytecode_name = Filename.temp_file "camlcode" "" in - let prim_name = Filename.temp_file "camlprim" ".c" in -@@ -552,7 +586,7 @@ let link objfiles output_name = - if Sys.file_exists c_file then raise(Error(File_exists c_file)); - let temps = ref [] in - try -- link_bytecode_as_c tolink c_file; -+ link_bytecode_as_c tolink c_file false; - if not (Filename.check_suffix output_name ".c") then begin - temps := c_file :: !temps; - if Ccomp.compile_file c_file <> 0 then raise(Error Custom_runtime); --- diff -Nru ocaml-3.12.1/debian/patches/0012-Make-objinfo-show-force_link-and-ccobjs-ccopts-when-.patch ocaml-4.01.0/debian/patches/0012-Make-objinfo-show-force_link-and-ccobjs-ccopts-when-.patch --- ocaml-3.12.1/debian/patches/0012-Make-objinfo-show-force_link-and-ccobjs-ccopts-when-.patch 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/patches/0012-Make-objinfo-show-force_link-and-ccobjs-ccopts-when-.patch 1970-01-01 00:00:00.000000000 +0000 @@ -1,92 +0,0 @@ -From: Mehdi Dogguy -Date: Fri, 15 Jul 2011 21:45:29 +0200 -Subject: Make objinfo show force_link and ccobjs/ccopts when needed - -- Show force_link for cmx/cma -- Show ccobjs/ccopts for cmxa - -Forwarded: http://caml.inria.fr/mantis/view.php?id=5316 ---- - tools/objinfo.ml | 25 +++++++++++++++++++++---- - 1 file changed, 21 insertions(+), 4 deletions(-) - -diff --git a/tools/objinfo.ml b/tools/objinfo.ml -index 4f467f2..b75b83a 100644 ---- a/tools/objinfo.ml -+++ b/tools/objinfo.ml -@@ -44,8 +44,12 @@ let print_name_crc (name, crc) = - let print_line name = - printf "\t%s\n" name - -+let string_of_bool name = -+ if name then "YES" else "no" -+ - let print_cmo_infos cu = - printf "Unit name: %s\n" cu.cu_name; -+ printf "Force link: %s\n" (string_of_bool cu.cu_force_link); - print_string "Interfaces imported:\n"; - List.iter print_name_crc cu.cu_imports; - printf "Uses unsafe features: "; -@@ -85,7 +89,7 @@ let print_spaced_string s = - printf " %s" s - - let print_cma_infos (lib : Cmo_format.library) = -- printf "Force custom: %s\n" (if lib.lib_custom then "YES" else "no"); -+ printf "Force custom: %s\n" (string_of_bool lib.lib_custom); - printf "Extra C object files:"; - (* PR#4949: print in linking order *) - List.iter print_spaced_string (List.rev lib.lib_ccobjs); -@@ -102,8 +106,11 @@ let print_cmi_infos name sign comps crcs = - printf "Interfaces imported:\n"; - List.iter print_name_crc crcs - --let print_general_infos name crc defines cmi cmx = -+let print_general_infos name force_link crc defines cmi cmx = - printf "Name: %s\n" name; -+ (match force_link with -+ Some flag -> printf "Force link: %s\n" (string_of_bool flag) -+ | None -> ()); - printf "CRC of implementation: %s\n" (Digest.to_hex crc); - printf "Globals defined:\n"; - List.iter print_line defines; -@@ -116,7 +123,7 @@ open Cmx_format - - let print_cmx_infos (ui, crc) = - print_general_infos -- ui.ui_name crc ui.ui_defines ui.ui_imports_cmi ui.ui_imports_cmx; -+ ui.ui_name (Some ui.ui_force_link) crc ui.ui_defines ui.ui_imports_cmi ui.ui_imports_cmx; - printf "Approximation:\n"; - Format.fprintf Format.std_formatter " %a@." print_approx_infos ui.ui_approx; - let pr_funs _ fns = -@@ -124,11 +131,21 @@ let print_cmx_infos (ui, crc) = - printf "Currying functions:%a\n" pr_funs ui.ui_curry_fun; - printf "Apply functions:%a\n" pr_funs ui.ui_apply_fun - -+let print_cmxa_infos lib = -+ printf "Extra C object files:"; -+ (* PR#4949: print in linking order *) -+ List.iter print_spaced_string (List.rev lib.lib_ccobjs); -+ printf "\nExtra C options:"; -+ List.iter print_spaced_string lib.lib_ccopts; -+ printf "\n"; -+ List.iter print_cmx_infos lib.lib_units -+ - let print_cmxs_infos header = - List.iter - (fun ui -> - print_general_infos - ui.dynu_name -+ None - ui.dynu_crc - ui.dynu_defines - ui.dynu_imports_cmi -@@ -234,7 +251,7 @@ let dump_obj filename = - end else if magic_number = cmxa_magic_number then begin - let li = (input_value ic : library_infos) in - close_in ic; -- List.iter print_cmx_infos li.lib_units -+ print_cmxa_infos li - end else begin - let pos_trailer = in_channel_length ic - len_magic_number in - let _ = seek_in ic pos_trailer in --- diff -Nru ocaml-3.12.1/debian/patches/0013-ocamlopt-arm-add-.type-directive-for-code-symbols.patch ocaml-4.01.0/debian/patches/0013-ocamlopt-arm-add-.type-directive-for-code-symbols.patch --- ocaml-3.12.1/debian/patches/0013-ocamlopt-arm-add-.type-directive-for-code-symbols.patch 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/patches/0013-ocamlopt-arm-add-.type-directive-for-code-symbols.patch 1970-01-01 00:00:00.000000000 +0000 @@ -1,125 +0,0 @@ -From: Stephane Glondu -Date: Fri, 12 Aug 2011 21:13:17 +0200 -Subject: ocamlopt/arm: add .type directive for code symbols - -Bug: http://caml.inria.fr/mantis/view.php?id=5336 -Bug-Ubuntu: https://bugs.launchpad.net/bugs/810402 -Signed-off-by: Stephane Glondu ---- - asmcomp/arm/emit.mlp | 1 + - asmrun/arm.S | 12 ++++++++++++ - 2 files changed, 13 insertions(+) - -diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp -index 2003313..a4b2241 100644 ---- a/asmcomp/arm/emit.mlp -+++ b/asmcomp/arm/emit.mlp -@@ -556,6 +556,7 @@ let fundecl fundecl = - ` .text\n`; - ` .align 2\n`; - ` .global {emit_symbol fundecl.fun_name}\n`; -+ ` .type {emit_symbol fundecl.fun_name}, %function\n`; - `{emit_symbol fundecl.fun_name}:\n`; - let n = frame_size() in - ignore(emit_stack_adjustment "sub" n); -diff --git a/asmrun/arm.S b/asmrun/arm.S -index 164f731..1313e9c 100644 ---- a/asmrun/arm.S -+++ b/asmrun/arm.S -@@ -24,6 +24,7 @@ alloc_limit .req r10 - /* Allocation functions and GC interface */ - - .globl caml_call_gc -+ .type caml_call_gc, %function - caml_call_gc: - /* Record return address and desired size */ - /* Can use alloc_limit as a temporary since it will be reloaded by -@@ -41,6 +42,7 @@ caml_call_gc: - bx lr - - .globl caml_alloc1 -+ .type caml_alloc1, %function - caml_alloc1: - sub alloc_ptr, alloc_ptr, #8 - cmp alloc_ptr, alloc_limit -@@ -54,6 +56,7 @@ caml_alloc1: - b caml_alloc1 - - .globl caml_alloc2 -+ .type caml_alloc2, %function - caml_alloc2: - sub alloc_ptr, alloc_ptr, #12 - cmp alloc_ptr, alloc_limit -@@ -67,6 +70,7 @@ caml_alloc2: - b caml_alloc2 - - .globl caml_alloc3 -+ .type caml_alloc3, %function - caml_alloc3: - sub alloc_ptr, alloc_ptr, #16 - cmp alloc_ptr, alloc_limit -@@ -80,6 +84,7 @@ caml_alloc3: - b caml_alloc3 - - .globl caml_allocN -+ .type caml_allocN, %function - caml_allocN: - sub alloc_ptr, alloc_ptr, r12 - cmp alloc_ptr, alloc_limit -@@ -134,6 +139,7 @@ caml_allocN: - /* Function to call is in r12 */ - - .globl caml_c_call -+ .type caml_c_call, %function - caml_c_call: - /* Preserve return address in callee-save register r4 */ - mov r4, lr -@@ -160,6 +166,7 @@ caml_c_call: - /* Start the Caml program */ - - .globl caml_start_program -+ .type caml_start_program, %function - caml_start_program: - ldr r12, .Lcaml_program - -@@ -235,6 +242,7 @@ caml_start_program: - /* Raise an exception from C */ - - .globl caml_raise_exception -+ .type caml_raise_exception, %function - caml_raise_exception: - /* Reload Caml allocation pointers */ - ldr r12, .Lcaml_young_ptr -@@ -250,6 +258,7 @@ caml_raise_exception: - /* Callback from C to Caml */ - - .globl caml_callback_exn -+ .type caml_callback_exn, %function - caml_callback_exn: - /* Initial shuffling of arguments (r0 = closure, r1 = first arg) */ - mov r12, r0 -@@ -259,6 +268,7 @@ caml_callback_exn: - b .Ljump_to_caml - - .globl caml_callback2_exn -+ .type caml_callback2_exn, %function - caml_callback2_exn: - /* Initial shuffling of arguments (r0 = closure, r1 = arg1, r2 = arg2) */ - mov r12, r0 -@@ -269,6 +279,7 @@ caml_callback2_exn: - b .Ljump_to_caml - - .globl caml_callback3_exn -+ .type caml_callback3_exn, %function - caml_callback3_exn: - /* Initial shuffling of arguments */ - /* (r0 = closure, r1 = arg1, r2 = arg2, r3 = arg3) */ -@@ -281,6 +292,7 @@ caml_callback3_exn: - b .Ljump_to_caml - - .globl caml_ml_array_bound_error -+ .type caml_ml_array_bound_error, %function - caml_ml_array_bound_error: - /* Load address of [caml_array_bound_error] in r12 */ - ldr r12, .Lcaml_array_bound_error --- diff -Nru ocaml-3.12.1/debian/patches/0014-Add-support-for-ENOTSUP.patch ocaml-4.01.0/debian/patches/0014-Add-support-for-ENOTSUP.patch --- ocaml-3.12.1/debian/patches/0014-Add-support-for-ENOTSUP.patch 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/patches/0014-Add-support-for-ENOTSUP.patch 1970-01-01 00:00:00.000000000 +0000 @@ -1,49 +0,0 @@ -From: Samuel Thibault -Date: Tue, 1 Nov 2011 13:48:38 +0100 -Subject: Add support for ENOTSUP - -On some systems such as Solaris or GNU/Hurd, ENOTSUP and EOPNOSUPP do -not have the same value, but ocaml code only deals with EOPNOSUPP, and -thus ocaml applications only handle the EOPNOSUPP case. The attached -patch fixes it by making ocaml convert ENOTSUP errors into EOPNOSUPP -errors. - -This patch fixes omake build on hurd-i386. - -Bug: http://caml.inria.fr/mantis/view.php?id=5382 -Bug-Debian: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=646372 -Signed-off-by: Stephane Glondu ---- - otherlibs/unix/unixsupport.c | 11 ++++++++++- - 1 file changed, 10 insertions(+), 1 deletion(-) - -diff --git a/otherlibs/unix/unixsupport.c b/otherlibs/unix/unixsupport.c -index a471f9e..db5912e 100644 ---- a/otherlibs/unix/unixsupport.c -+++ b/otherlibs/unix/unixsupport.c -@@ -165,7 +165,11 @@ - #define ESOCKTNOSUPPORT (-1) - #endif - #ifndef EOPNOTSUPP --#define EOPNOTSUPP (-1) -+# ifdef ENOTSUP -+# define EOPNOTSUPP ENOTSUP -+# else -+# define EOPNOTSUPP (-1) -+# endif - #endif - #ifndef EPFNOSUPPORT - #define EPFNOSUPPORT (-1) -@@ -252,6 +256,11 @@ value unix_error_of_code (int errcode) - int errconstr; - value err; - -+#if defined(ENOTSUP) && (EOPNOTSUPP != ENOTSUP) -+ if (errcode == ENOTSUP) -+ errcode = EOPNOTSUPP; -+#endif -+ - errconstr = - cst_to_constr(errcode, error_table, sizeof(error_table)/sizeof(int), -1); - if (errconstr == Val_int(-1)) { --- diff -Nru ocaml-3.12.1/debian/patches/0015-Do-not-add-R-dir-in-X11-link-options-on-GNU-kFreeBSD.patch ocaml-4.01.0/debian/patches/0015-Do-not-add-R-dir-in-X11-link-options-on-GNU-kFreeBSD.patch --- ocaml-3.12.1/debian/patches/0015-Do-not-add-R-dir-in-X11-link-options-on-GNU-kFreeBSD.patch 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/patches/0015-Do-not-add-R-dir-in-X11-link-options-on-GNU-kFreeBSD.patch 1970-01-01 00:00:00.000000000 +0000 @@ -1,23 +0,0 @@ -From: Stephane Glondu -Date: Tue, 1 Nov 2011 15:28:15 +0100 -Subject: Do not add -R$dir in X11 link options on GNU/kFreeBSD - -Signed-off-by: Stephane Glondu -Bug: http://caml.inria.fr/mantis/view.php?id=5393 ---- - configure | 1 + - 1 file changed, 1 insertion(+) - -diff --git a/configure b/configure -index d6ba2e3..20b4b17 100755 ---- a/configure -+++ b/configure -@@ -1373,6 +1373,7 @@ do - else - x11_libs="-L$dir" - case "$host" in -+ *-kfreebsd*-gnu) x11_link="-L$dir -lX11";; - *-*-*bsd*) x11_link="-R$dir -L$dir -lX11";; - *) x11_link="-L$dir -lX11";; - esac --- diff -Nru ocaml-3.12.1/debian/patches/linker-flags.patch ocaml-4.01.0/debian/patches/linker-flags.patch --- ocaml-3.12.1/debian/patches/linker-flags.patch 2011-11-18 17:55:08.000000000 +0000 +++ ocaml-4.01.0/debian/patches/linker-flags.patch 1970-01-01 00:00:00.000000000 +0000 @@ -1,25 +0,0 @@ -Index: ocaml-3.12.1/configure -=================================================================== ---- ocaml-3.12.1.orig/configure 2011-11-18 17:45:15.000000000 +0000 -+++ ocaml-3.12.1/configure 2011-11-18 17:54:51.104603036 +0000 -@@ -285,7 +285,9 @@ - if cc="$bytecc" sh ./hasgot -mieee; then - bytecccompopts="-mieee $bytecccompopts"; - fi -- bytecclinkopts="-Wl,--no-relax";; -+ bytecclinkopts="-Wl,--hash-style=both -Wl,--as-needed -Wl,--build-id -Wl,--no-relax";; -+ gcc,*-*-linux*) -+ bytecclinkopts="-Wl,--hash-style=both -Wl,--as-needed -Wl,--build-id";; - cc,mips-*-irix6*) - # Add -n32 flag to ensure compatibility with native-code compiler - bytecccompopts="-n32" -@@ -740,7 +742,8 @@ - nativecccompopts="$gcc_warnings -DSHRINKED_GNUC";; - *,*,rhapsody,*) nativecccompopts="$gcc_warnings -DDARWIN_VERSION_6 $dl_defs" - if $arch64; then partialld="ld -r -arch ppc64"; fi;; -- alpha,gcc*,linux*,*) nativecclinkopts="-Wl,--no-relax";; -+ alpha,gcc*,linux*,*) nativecclinkopts="-Wl,--hash-style=both -Wl,--as-needed -Wl,--build-id -Wl,--no-relax";; -+ *,gcc*,linux*,*) nativecclinkopts="-Wl,--hash-style=both -Wl,--as-needed -Wl,--build-id";; - *,gcc*,cygwin,*) nativecccompopts="$gcc_warnings -U_WIN32";; - amd64,gcc*,macosx,*) partialld="ld -r -arch x86_64";; - amd64,gcc*,solaris,*) partialld="ld -r -m elf_x86_64";; diff -Nru ocaml-3.12.1/debian/patches/series ocaml-4.01.0/debian/patches/series --- ocaml-3.12.1/debian/patches/series 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/patches/series 2013-09-19 21:03:42.000000000 +0000 @@ -4,13 +4,5 @@ 0004-Put-manpages-in-section-3o-instead-of-3.patch 0005-Patch-config.sh-for-installation.patch 0006-Install-ocamlbuild-as-a-link-on-either-.native-or-.b.patch -0007-Natdynlink-works-on-powerpc-and-hurd-i386.patch -0008-Declare-primitive-name-table-as-const-char.patch -0009-Avoid-multiple-declarations-in-generated-.c-files-in.patch -0010-Properly-initialize-executable-name-in-caml_startup_.patch -0011-Embed-bytecode-in-C-object-when-using-custom.patch -0012-Make-objinfo-show-force_link-and-ccobjs-ccopts-when-.patch -0013-ocamlopt-arm-add-.type-directive-for-code-symbols.patch -0014-Add-support-for-ENOTSUP.patch -0015-Do-not-add-R-dir-in-X11-link-options-on-GNU-kFreeBSD.patch -linker-flags.patch +0007-Avoid-multiple-declarations-in-generated-.c-files-in.patch +0008-Embed-bytecode-in-C-object-when-using-custom.patch diff -Nru ocaml-3.12.1/debian/rules ocaml-4.01.0/debian/rules --- ocaml-3.12.1/debian/rules 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/rules 2013-10-31 15:13:53.000000000 +0000 @@ -2,18 +2,20 @@ PACKAGE := ocaml ALL_PACKAGES := $(shell dh_listpackages) -OCAMLMAJOR := 3.12 -OCAMLMINOR := 1 +OCAMLMAJOR := 4.01 +OCAMLMINOR := 0 # Build cache (for Debian debugging) BUILDCACHE := $(wildcard ../ocaml.cache) # These are defined here to avoid definition of them in ocamlvars.mk OCAML_ABI := $(OCAMLMAJOR).$(OCAMLMINOR) +#OCAML_ABI := 4.01.1+dev0-2013-09-11 OCAML_STDLIB_DIR := /usr/lib/ocaml OCAML_NATIVE_ARCHS := $(shell cat debian/native-archs) OCAML_NATDYNLINK_ARCHS := $(shell cat debian/natdynlink-archs) DEB_BUILD_ARCH ?= $(shell dpkg-architecture -qDEB_BUILD_ARCH) +DEB_BUILD_GNU_TYPE ?= $(shell dpkg-architecture -qDEB_BUILD_GNU_TYPE) OCAML_OPT_ARCH := $(findstring $(DEB_BUILD_ARCH),$(OCAML_NATIVE_ARCHS)) OCAML_HAVE_OCAMLOPT := $(if $(OCAML_OPT_ARCH),yes,no) OCAML_OCAMLDOC_DESTDIR_HTML = @@ -30,12 +32,17 @@ MD5SUMSDIR = /var/lib/ocaml/md5sums INSTDIR = $(CURDIR)/debian/tmp/usr DISTDIR = $(PACKAGE)-$(OCAML_ABI) -SRCTARBALL = $(PACKAGE)-source-$(OCAML_ABI).tar.bz2 +UPSTREAM_VERSION = $(shell dpkg-parsechangelog | awk '/^Version:/{print $$2}' | { read u; echo $${u%-*}; }) +UPSTREAM_TARBALL = ../$(PACKAGE)_$(UPSTREAM_VERSION).orig.tar.gz +SRCTARBALL = $(PACKAGE)-source-$(OCAML_ABI).tar +TESTDIR := debian/test-build +TESTRULES := debian/rules DEB_TEST_BUILD_PREFIX=$(CURDIR)/$(TESTDIR) + +ifeq (,$(DEB_TEST_BUILD_PREFIX)) ifneq (,$(findstring ocaml-source,$(ALL_PACKAGES))) TARBALL_TARGET = debian/$(SRCTARBALL) -else - TARBALL_TARGET = +endif endif # Environment variable for dh_ocaml @@ -54,10 +61,11 @@ export OCAML_STDLIB_DIR CONFIGURE_OPTS := \ - --with-pthread -prefix /usr \ - -libdir $(OCAML_STDLIB_DIR) \ + --host $(DEB_BUILD_GNU_TYPE)\ + --with-pthread -prefix $(DEB_TEST_BUILD_PREFIX)/usr \ + -libdir $(DEB_TEST_BUILD_PREFIX)$(OCAML_STDLIB_DIR) \ -x11lib "$(shell pkg-config --variable=libdir x11)" \ - -mandir /usr/share/man \ + -mandir $(DEB_TEST_BUILD_PREFIX)/usr/share/man \ -tkdefs "-I/usr/include/tcl8.5" \ -tklibs "-L/usr/lib -ltk8.5 -ltcl8.5" @@ -70,6 +78,11 @@ %: dh $@ +# Needed because there is a "build" in the upstream tarball +.PHONY: build +build: + dh $@ + ocamlinit-stamp: $(TARBALL_TARGET) # Generate ocaml-native-compilers' Architecture field. @@ -88,26 +101,19 @@ cp -f /usr/share/misc/config.$$ext config/gnu/config.$$ext; \ fi; \ done +# Create empty directory present in upstream tarball + mkdir -p compilerlibs touch $@ ifneq (,$(TARBALL_TARGET)) -$(TARBALL_TARGET): -# Make a copy of the current (patched) sources in debian/$(DISTDIR) - ln -fs . $(DISTDIR) # beware of the symlink recursion! +$(TARBALL_TARGET): $(UPSTREAM_TARBALL) mkdir debian/$(DISTDIR) - tar --anchored -ch \ - --exclude=$(DISTDIR)/$(DISTDIR) \ - --exclude-from=debian/ocaml-source.exclude \ - $(DISTDIR)/ | tar -C debian -x - rm -f $(DISTDIR) -# Copy patches and unapply them +# Copy upstream tarball + cp $< debian/$(DISTDIR) +# Copy debian/patches cp -a debian/patches debian/$(DISTDIR)/debian-patches - cd debian/$(DISTDIR) && sort -r debian-patches/series | \ - while read u; do \ - patch -R -V never -p1 < debian-patches/$$u; \ - done # Create the tarball and cleanup - tar -C debian -cjf $@ $(DISTDIR) + tar -C debian -cf $@ $(DISTDIR) rm -Rf debian/$(DISTDIR) endif @@ -175,7 +181,7 @@ sed -i 1d emacs/ocamltags.in; \ fi # Remaining stuff - -rm -Rf debian/$(SRCTARBALL) debian/examples + -rm -Rf debian/$(SRCTARBALL) debian/examples $(TESTDIR) .PHONY: override_dh_auto_install override_dh_auto_install: install-stamp @@ -194,17 +200,28 @@ # Install OCaml sed -e 's|PREFIX=\"/.*\"|PREFIX=\"$(INSTDIR)"|' < config/config.sh > config/config.debian.install.sh $(MAKE) install PREFIX=$(INSTDIR) +ifeq (,$(DEB_TEST_BUILD_PREFIX)) # Remove empty directory rmdir $(CURDIR)/debian/tmp$(OCAML_STDLIB_DIR)/ocamldoc/custom -# To avoid erroneous dh_install warnings - rm -f $(INSTDIR)/share/man/man1/ocamlopt.opt.1 $(INSTDIR)/share/man/man1/ocamlc.opt.1 +# Remove uninstalled files + rm -f \ + $(INSTDIR)/share/man/man1/ocamlopt.opt.1 \ + $(INSTDIR)/share/man/man1/ocamlc.opt.1 \ + $(INSTDIR)/bin/camlp4boot +ifeq ($(OCAML_HAVE_OCAMLOPT),no) +# Remove files that make no sense without ocamlopt + rm -f \ + $(INSTDIR)/share/man/man1/ocamloptp.1 \ + $(INSTDIR)/share/man/man1/ocamlopt.1 \ + $(INSTDIR)/bin/ocamloptp +endif # Dispatch files with dh_install cd debian && \ for u in ocaml ocaml-nox; do \ DESTDIR=tmp ./gen_modules.pl $$u.install > $$u.install.new; \ mv $$u.install.new $$u.install; \ done - if ! dh_install --list-missing; then \ + if ! dh_install --fail-missing; then \ echo "===> dh_install has failed <==="; \ find debian/tmp; \ exit 1; \ @@ -225,6 +242,7 @@ ln -sf ../ocaml-base-nox/README.gz . && \ ln -sf ../ocaml-base-nox/README.Debian .; \ ); done +endif # Remaining stuff touch $@ @@ -254,3 +272,24 @@ echo "Please adjust OCAML_ABI in debian/rules"; \ exit 2; \ fi + +.PHONY: regenerate +regenerate: debian/control + git ls-tree --name-only -r HEAD debian \ + | grep -v '^debian/\(patches/\|source/local-\)' \ + > debian/MANIFEST + +# Architectures where running the test suite completely makes the +# whole build last more than one hour on buildds. Originally, because +# some tests do not even finish on mips. +SLOW_ARCHITECTURES := hurd-i386 mips mipsel powerpc sparc armel + +.PHONY: override_dh_auto_test +override_dh_auto_test: + rm -f testsuite/tests/lib-threads/testsocket.ml + rm -f testsuite/tests/lib-threads/testsignal.ml + rm -rf testsuite/tests/basic-manyargs + rm -rf testsuite/tests/callback + rm -rf testsuite/tests/gc-roots + rm -rf testsuite/tests/lib-dynlink-bytecode§ +# cd testsuite && $(MAKE) all diff -Nru ocaml-3.12.1/debian/watch ocaml-4.01.0/debian/watch --- ocaml-3.12.1/debian/watch 2012-06-29 00:49:42.000000000 +0000 +++ ocaml-4.01.0/debian/watch 2013-09-19 21:03:42.000000000 +0000 @@ -1,3 +1,3 @@ version=3 opts=uversionmangle=s/\+/~/ \ -http://caml.inria.fr/pub/distrib/ocaml-([\d\.]+)/ocaml-([^-]+)\.tar\.gz +http://caml.inria.fr/pub/distrib/ocaml-([\d\.]+)/ocaml-([^-]+)\.tar\.bz2 diff -Nru ocaml-3.12.1/debugger/.cvsignore ocaml-4.01.0/debugger/.cvsignore --- ocaml-3.12.1/debugger/.cvsignore 2010-05-18 12:44:36.000000000 +0000 +++ ocaml-4.01.0/debugger/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -lexer.ml -parser.ml -parser.mli -ocamldebug -dynlink.ml -dynlink.mli diff -Nru ocaml-3.12.1/debugger/.depend ocaml-4.01.0/debugger/.depend --- ocaml-3.12.1/debugger/.depend 2010-01-20 16:26:46.000000000 +0000 +++ ocaml-4.01.0/debugger/.depend 2013-08-15 16:13:16.000000000 +0000 @@ -1,212 +1,211 @@ -breakpoints.cmi: primitives.cmi ../bytecomp/instruct.cmi -checkpoints.cmi: primitives.cmi debugcom.cmi -command_line.cmi: -debugcom.cmi: primitives.cmi -debugger_config.cmi: -dynlink.cmi: -envaux.cmi: ../typing/path.cmi ../bytecomp/instruct.cmi ../typing/env.cmi -eval.cmi: ../typing/types.cmi ../typing/path.cmi parser_aux.cmi \ +breakpoints.cmi : primitives.cmi ../bytecomp/instruct.cmi +checkpoints.cmi : primitives.cmi debugcom.cmi +command_line.cmi : +debugcom.cmi : primitives.cmi +debugger_config.cmi : +dynlink.cmi : +eval.cmi : ../typing/types.cmi ../typing/path.cmi parser_aux.cmi \ ../parsing/longident.cmi ../bytecomp/instruct.cmi ../typing/ident.cmi \ ../typing/env.cmi debugcom.cmi -events.cmi: ../bytecomp/instruct.cmi -exec.cmi: -frames.cmi: primitives.cmi ../bytecomp/instruct.cmi -history.cmi: -input_handling.cmi: primitives.cmi -int64ops.cmi: -lexer.cmi: parser.cmi -loadprinter.cmi: ../parsing/longident.cmi dynlink.cmi -parameters.cmi: -parser.cmi: parser_aux.cmi ../parsing/longident.cmi -parser_aux.cmi: primitives.cmi ../parsing/longident.cmi -pattern_matching.cmi: ../typing/typedtree.cmi parser_aux.cmi debugcom.cmi -pos.cmi: ../bytecomp/instruct.cmi -primitives.cmi: $(UNIXDIR)/unix.cmi -printval.cmi: ../typing/types.cmi ../typing/path.cmi parser_aux.cmi \ +events.cmi : ../bytecomp/instruct.cmi +exec.cmi : +frames.cmi : primitives.cmi ../bytecomp/instruct.cmi +history.cmi : +input_handling.cmi : primitives.cmi +int64ops.cmi : +lexer.cmi : parser.cmi +loadprinter.cmi : ../parsing/longident.cmi dynlink.cmi +parameters.cmi : +parser.cmi : parser_aux.cmi ../parsing/longident.cmi +parser_aux.cmi : primitives.cmi ../parsing/longident.cmi +pattern_matching.cmi : ../typing/typedtree.cmi parser_aux.cmi debugcom.cmi +pos.cmi : ../bytecomp/instruct.cmi +primitives.cmi : $(UNIXDIR)/unix.cmi +printval.cmi : ../typing/types.cmi ../typing/path.cmi parser_aux.cmi \ ../typing/env.cmi debugcom.cmi -program_loading.cmi: primitives.cmi -program_management.cmi: -question.cmi: -show_information.cmi: ../bytecomp/instruct.cmi -show_source.cmi: ../bytecomp/instruct.cmi -source.cmi: -symbols.cmi: ../bytecomp/instruct.cmi -time_travel.cmi: primitives.cmi -trap_barrier.cmi: -unix_tools.cmi: $(UNIXDIR)/unix.cmi -breakpoints.cmo: symbols.cmi primitives.cmi pos.cmi ../bytecomp/instruct.cmi \ - exec.cmi debugcom.cmi checkpoints.cmi breakpoints.cmi -breakpoints.cmx: symbols.cmx primitives.cmx pos.cmx ../bytecomp/instruct.cmx \ - exec.cmx debugcom.cmx checkpoints.cmx breakpoints.cmi -checkpoints.cmo: primitives.cmi int64ops.cmi debugcom.cmi checkpoints.cmi -checkpoints.cmx: primitives.cmx int64ops.cmx debugcom.cmx checkpoints.cmi -command_line.cmo: unix_tools.cmi $(UNIXDIR)/unix.cmi \ +program_loading.cmi : primitives.cmi +program_management.cmi : +question.cmi : +show_information.cmi : ../bytecomp/instruct.cmi +show_source.cmi : ../bytecomp/instruct.cmi +source.cmi : +symbols.cmi : ../bytecomp/instruct.cmi +time_travel.cmi : primitives.cmi +trap_barrier.cmi : +unix_tools.cmi : $(UNIXDIR)/unix.cmi +breakpoints.cmo : symbols.cmi primitives.cmi pos.cmi \ + ../bytecomp/instruct.cmi exec.cmi debugcom.cmi checkpoints.cmi \ + breakpoints.cmi +breakpoints.cmx : symbols.cmx primitives.cmx pos.cmx \ + ../bytecomp/instruct.cmx exec.cmx debugcom.cmx checkpoints.cmx \ + breakpoints.cmi +checkpoints.cmo : primitives.cmi int64ops.cmi debugcom.cmi checkpoints.cmi +checkpoints.cmx : primitives.cmx int64ops.cmx debugcom.cmx checkpoints.cmi +command_line.cmo : unix_tools.cmi $(UNIXDIR)/unix.cmi \ ../typing/types.cmi time_travel.cmi symbols.cmi source.cmi \ show_source.cmi show_information.cmi question.cmi program_management.cmi \ program_loading.cmi printval.cmi primitives.cmi pos.cmi parser_aux.cmi \ parser.cmi parameters.cmi ../utils/misc.cmi ../parsing/longident.cmi \ ../parsing/location.cmi loadprinter.cmi lexer.cmi int64ops.cmi \ ../bytecomp/instruct.cmi input_handling.cmi history.cmi frames.cmi \ - events.cmi eval.cmi envaux.cmi debugger_config.cmi debugcom.cmi \ - ../typing/ctype.cmi ../utils/config.cmi checkpoints.cmi breakpoints.cmi \ - command_line.cmi -command_line.cmx: unix_tools.cmx $(UNIXDIR)/unix.cmx \ + events.cmi eval.cmi ../typing/envaux.cmi ../typing/env.cmi \ + debugger_config.cmi debugcom.cmi ../typing/ctype.cmi ../utils/config.cmi \ + checkpoints.cmi breakpoints.cmi command_line.cmi +command_line.cmx : unix_tools.cmx $(UNIXDIR)/unix.cmx \ ../typing/types.cmx time_travel.cmx symbols.cmx source.cmx \ show_source.cmx show_information.cmx question.cmx program_management.cmx \ program_loading.cmx printval.cmx primitives.cmx pos.cmx parser_aux.cmi \ parser.cmx parameters.cmx ../utils/misc.cmx ../parsing/longident.cmx \ ../parsing/location.cmx loadprinter.cmx lexer.cmx int64ops.cmx \ ../bytecomp/instruct.cmx input_handling.cmx history.cmx frames.cmx \ - events.cmx eval.cmx envaux.cmx debugger_config.cmx debugcom.cmx \ - ../typing/ctype.cmx ../utils/config.cmx checkpoints.cmx breakpoints.cmx \ - command_line.cmi -debugcom.cmo: primitives.cmi ../utils/misc.cmi int64ops.cmi \ + events.cmx eval.cmx ../typing/envaux.cmx ../typing/env.cmx \ + debugger_config.cmx debugcom.cmx ../typing/ctype.cmx ../utils/config.cmx \ + checkpoints.cmx breakpoints.cmx command_line.cmi +debugcom.cmo : primitives.cmi ../utils/misc.cmi int64ops.cmi \ input_handling.cmi debugcom.cmi -debugcom.cmx: primitives.cmx ../utils/misc.cmx int64ops.cmx \ +debugcom.cmx : primitives.cmx ../utils/misc.cmx int64ops.cmx \ input_handling.cmx debugcom.cmi -debugger_config.cmo: int64ops.cmi debugger_config.cmi -debugger_config.cmx: int64ops.cmx debugger_config.cmi -dynlink.cmo: ../bytecomp/symtable.cmi ../bytecomp/opcodes.cmo \ +debugger_config.cmo : int64ops.cmi debugger_config.cmi +debugger_config.cmx : int64ops.cmx debugger_config.cmi +dynlink.cmo : ../bytecomp/symtable.cmi ../bytecomp/opcodes.cmo \ ../utils/misc.cmi ../bytecomp/meta.cmi ../bytecomp/dll.cmi \ ../utils/consistbl.cmi ../utils/config.cmi ../bytecomp/cmo_format.cmi \ - dynlink.cmi -dynlink.cmx: ../bytecomp/symtable.cmx ../bytecomp/opcodes.cmx \ + ../typing/cmi_format.cmi dynlink.cmi +dynlink.cmx : ../bytecomp/symtable.cmx ../bytecomp/opcodes.cmx \ ../utils/misc.cmx ../bytecomp/meta.cmx ../bytecomp/dll.cmx \ ../utils/consistbl.cmx ../utils/config.cmx ../bytecomp/cmo_format.cmi \ - dynlink.cmi -envaux.cmo: ../typing/types.cmi ../typing/subst.cmi ../typing/printtyp.cmi \ - ../typing/path.cmi ../typing/mtype.cmi ../utils/misc.cmi \ - ../bytecomp/instruct.cmi ../typing/env.cmi envaux.cmi -envaux.cmx: ../typing/types.cmx ../typing/subst.cmx ../typing/printtyp.cmx \ - ../typing/path.cmx ../typing/mtype.cmx ../utils/misc.cmx \ - ../bytecomp/instruct.cmx ../typing/env.cmx envaux.cmi -eval.cmo: ../typing/types.cmi ../bytecomp/symtable.cmi ../typing/subst.cmi \ + ../typing/cmi_format.cmx dynlink.cmi +eval.cmo : ../typing/types.cmi ../bytecomp/symtable.cmi ../typing/subst.cmi \ printval.cmi ../typing/printtyp.cmi ../typing/predef.cmi \ ../typing/path.cmi parser_aux.cmi ../utils/misc.cmi \ ../parsing/longident.cmi ../bytecomp/instruct.cmi ../typing/ident.cmi \ frames.cmi ../typing/env.cmi debugcom.cmi ../typing/ctype.cmi \ ../typing/btype.cmi eval.cmi -eval.cmx: ../typing/types.cmx ../bytecomp/symtable.cmx ../typing/subst.cmx \ +eval.cmx : ../typing/types.cmx ../bytecomp/symtable.cmx ../typing/subst.cmx \ printval.cmx ../typing/printtyp.cmx ../typing/predef.cmx \ ../typing/path.cmx parser_aux.cmi ../utils/misc.cmx \ ../parsing/longident.cmx ../bytecomp/instruct.cmx ../typing/ident.cmx \ frames.cmx ../typing/env.cmx debugcom.cmx ../typing/ctype.cmx \ ../typing/btype.cmx eval.cmi -events.cmo: ../parsing/location.cmi ../bytecomp/instruct.cmi events.cmi -events.cmx: ../parsing/location.cmx ../bytecomp/instruct.cmx events.cmi -exec.cmo: exec.cmi -exec.cmx: exec.cmi -frames.cmo: symbols.cmi ../utils/misc.cmi ../bytecomp/instruct.cmi events.cmi \ - debugcom.cmi frames.cmi -frames.cmx: symbols.cmx ../utils/misc.cmx ../bytecomp/instruct.cmx events.cmx \ - debugcom.cmx frames.cmi -history.cmo: primitives.cmi int64ops.cmi debugger_config.cmi checkpoints.cmi \ - history.cmi -history.cmx: primitives.cmx int64ops.cmx debugger_config.cmx checkpoints.cmx \ - history.cmi -input_handling.cmo: $(UNIXDIR)/unix.cmi primitives.cmi \ +events.cmo : ../parsing/location.cmi ../bytecomp/instruct.cmi events.cmi +events.cmx : ../parsing/location.cmx ../bytecomp/instruct.cmx events.cmi +exec.cmo : exec.cmi +exec.cmx : exec.cmi +frames.cmo : symbols.cmi ../utils/misc.cmi ../bytecomp/instruct.cmi \ + events.cmi debugcom.cmi frames.cmi +frames.cmx : symbols.cmx ../utils/misc.cmx ../bytecomp/instruct.cmx \ + events.cmx debugcom.cmx frames.cmi +history.cmo : primitives.cmi int64ops.cmi debugger_config.cmi \ + checkpoints.cmi history.cmi +history.cmx : primitives.cmx int64ops.cmx debugger_config.cmx \ + checkpoints.cmx history.cmi +input_handling.cmo : $(UNIXDIR)/unix.cmi primitives.cmi \ input_handling.cmi -input_handling.cmx: $(UNIXDIR)/unix.cmx primitives.cmx \ +input_handling.cmx : $(UNIXDIR)/unix.cmx primitives.cmx \ input_handling.cmi -int64ops.cmo: int64ops.cmi -int64ops.cmx: int64ops.cmi -lexer.cmo: parser.cmi lexer.cmi -lexer.cmx: parser.cmx lexer.cmi -loadprinter.cmo: ../typing/types.cmi ../bytecomp/symtable.cmi printval.cmi \ +int64ops.cmo : int64ops.cmi +int64ops.cmx : int64ops.cmi +lexer.cmo : parser.cmi lexer.cmi +lexer.cmx : parser.cmx lexer.cmi +loadprinter.cmo : ../typing/types.cmi ../bytecomp/symtable.cmi printval.cmi \ ../typing/printtyp.cmi ../typing/path.cmi ../utils/misc.cmi \ ../parsing/longident.cmi ../typing/ident.cmi ../typing/env.cmi \ dynlink.cmi ../typing/ctype.cmi ../utils/config.cmi loadprinter.cmi -loadprinter.cmx: ../typing/types.cmx ../bytecomp/symtable.cmx printval.cmx \ +loadprinter.cmx : ../typing/types.cmx ../bytecomp/symtable.cmx printval.cmx \ ../typing/printtyp.cmx ../typing/path.cmx ../utils/misc.cmx \ ../parsing/longident.cmx ../typing/ident.cmx ../typing/env.cmx \ dynlink.cmx ../typing/ctype.cmx ../utils/config.cmx loadprinter.cmi -main.cmo: unix_tools.cmi $(UNIXDIR)/unix.cmi time_travel.cmi \ +main.cmo : unix_tools.cmi $(UNIXDIR)/unix.cmi time_travel.cmi \ show_information.cmi question.cmi program_management.cmi primitives.cmi \ parameters.cmi ../utils/misc.cmi input_handling.cmi frames.cmi exec.cmi \ ../typing/env.cmi debugger_config.cmi ../utils/config.cmi \ - command_line.cmi ../utils/clflags.cmi checkpoints.cmi -main.cmx: unix_tools.cmx $(UNIXDIR)/unix.cmx time_travel.cmx \ + command_line.cmi ../typing/cmi_format.cmi ../utils/clflags.cmi \ + checkpoints.cmi +main.cmx : unix_tools.cmx $(UNIXDIR)/unix.cmx time_travel.cmx \ show_information.cmx question.cmx program_management.cmx primitives.cmx \ parameters.cmx ../utils/misc.cmx input_handling.cmx frames.cmx exec.cmx \ ../typing/env.cmx debugger_config.cmx ../utils/config.cmx \ - command_line.cmx ../utils/clflags.cmx checkpoints.cmx -parameters.cmo: primitives.cmi envaux.cmi debugger_config.cmi \ + command_line.cmx ../typing/cmi_format.cmx ../utils/clflags.cmx \ + checkpoints.cmx +parameters.cmo : primitives.cmi ../typing/envaux.cmi debugger_config.cmi \ ../utils/config.cmi parameters.cmi -parameters.cmx: primitives.cmx envaux.cmx debugger_config.cmx \ +parameters.cmx : primitives.cmx ../typing/envaux.cmx debugger_config.cmx \ ../utils/config.cmx parameters.cmi -parser.cmo: parser_aux.cmi ../parsing/longident.cmi int64ops.cmi \ +parser.cmo : parser_aux.cmi ../parsing/longident.cmi int64ops.cmi \ input_handling.cmi parser.cmi -parser.cmx: parser_aux.cmi ../parsing/longident.cmx int64ops.cmx \ +parser.cmx : parser_aux.cmi ../parsing/longident.cmx int64ops.cmx \ input_handling.cmx parser.cmi -pattern_matching.cmo: ../typing/typedtree.cmi parser_aux.cmi \ +pattern_matching.cmo : ../typing/typedtree.cmi parser_aux.cmi \ ../utils/misc.cmi debugger_config.cmi debugcom.cmi ../typing/ctype.cmi \ pattern_matching.cmi -pattern_matching.cmx: ../typing/typedtree.cmx parser_aux.cmi \ +pattern_matching.cmx : ../typing/typedtree.cmx parser_aux.cmi \ ../utils/misc.cmx debugger_config.cmx debugcom.cmx ../typing/ctype.cmx \ pattern_matching.cmi -pos.cmo: source.cmi primitives.cmi ../parsing/location.cmi \ +pos.cmo : source.cmi primitives.cmi ../parsing/location.cmi \ ../bytecomp/instruct.cmi pos.cmi -pos.cmx: source.cmx primitives.cmx ../parsing/location.cmx \ +pos.cmx : source.cmx primitives.cmx ../parsing/location.cmx \ ../bytecomp/instruct.cmx pos.cmi -primitives.cmo: $(UNIXDIR)/unix.cmi primitives.cmi -primitives.cmx: $(UNIXDIR)/unix.cmx primitives.cmi -printval.cmo: ../typing/types.cmi ../bytecomp/symtable.cmi \ +primitives.cmo : $(UNIXDIR)/unix.cmi primitives.cmi +primitives.cmx : $(UNIXDIR)/unix.cmx primitives.cmi +printval.cmo : ../typing/types.cmi ../bytecomp/symtable.cmi \ ../typing/printtyp.cmi ../typing/path.cmi parser_aux.cmi \ ../typing/outcometree.cmi ../typing/oprint.cmi \ ../toplevel/genprintval.cmi debugcom.cmi printval.cmi -printval.cmx: ../typing/types.cmx ../bytecomp/symtable.cmx \ +printval.cmx : ../typing/types.cmx ../bytecomp/symtable.cmx \ ../typing/printtyp.cmx ../typing/path.cmx parser_aux.cmi \ ../typing/outcometree.cmi ../typing/oprint.cmx \ ../toplevel/genprintval.cmx debugcom.cmx printval.cmi -program_loading.cmo: unix_tools.cmi $(UNIXDIR)/unix.cmi primitives.cmi \ - parameters.cmi input_handling.cmi debugger_config.cmi program_loading.cmi -program_loading.cmx: unix_tools.cmx $(UNIXDIR)/unix.cmx primitives.cmx \ - parameters.cmx input_handling.cmx debugger_config.cmx program_loading.cmi -program_management.cmo: unix_tools.cmi $(UNIXDIR)/unix.cmi \ +program_loading.cmo : unix_tools.cmi $(UNIXDIR)/unix.cmi \ + primitives.cmi parameters.cmi input_handling.cmi debugger_config.cmi \ + program_loading.cmi +program_loading.cmx : unix_tools.cmx $(UNIXDIR)/unix.cmx \ + primitives.cmx parameters.cmx input_handling.cmx debugger_config.cmx \ + program_loading.cmi +program_management.cmo : unix_tools.cmi $(UNIXDIR)/unix.cmi \ time_travel.cmi symbols.cmi question.cmi program_loading.cmi \ primitives.cmi parameters.cmi int64ops.cmi input_handling.cmi history.cmi \ debugger_config.cmi breakpoints.cmi program_management.cmi -program_management.cmx: unix_tools.cmx $(UNIXDIR)/unix.cmx \ +program_management.cmx : unix_tools.cmx $(UNIXDIR)/unix.cmx \ time_travel.cmx symbols.cmx question.cmx program_loading.cmx \ primitives.cmx parameters.cmx int64ops.cmx input_handling.cmx history.cmx \ debugger_config.cmx breakpoints.cmx program_management.cmi -question.cmo: primitives.cmi lexer.cmi input_handling.cmi question.cmi -question.cmx: primitives.cmx lexer.cmx input_handling.cmx question.cmi -show_information.cmo: symbols.cmi source.cmi show_source.cmi printval.cmi \ +question.cmo : primitives.cmi lexer.cmi input_handling.cmi question.cmi +question.cmx : primitives.cmx lexer.cmx input_handling.cmx question.cmi +show_information.cmo : symbols.cmi source.cmi show_source.cmi printval.cmi \ ../utils/misc.cmi ../bytecomp/instruct.cmi frames.cmi events.cmi \ debugcom.cmi checkpoints.cmi breakpoints.cmi show_information.cmi -show_information.cmx: symbols.cmx source.cmx show_source.cmx printval.cmx \ +show_information.cmx : symbols.cmx source.cmx show_source.cmx printval.cmx \ ../utils/misc.cmx ../bytecomp/instruct.cmx frames.cmx events.cmx \ debugcom.cmx checkpoints.cmx breakpoints.cmx show_information.cmi -show_source.cmo: source.cmi primitives.cmi parameters.cmi \ +show_source.cmo : source.cmi primitives.cmi parameters.cmi \ ../parsing/location.cmi ../bytecomp/instruct.cmi events.cmi \ debugger_config.cmi show_source.cmi -show_source.cmx: source.cmx primitives.cmx parameters.cmx \ +show_source.cmx : source.cmx primitives.cmx parameters.cmx \ ../parsing/location.cmx ../bytecomp/instruct.cmx events.cmx \ debugger_config.cmx show_source.cmi -source.cmo: primitives.cmi ../utils/misc.cmi debugger_config.cmi \ +source.cmo : primitives.cmi ../utils/misc.cmi debugger_config.cmi \ ../utils/config.cmi source.cmi -source.cmx: primitives.cmx ../utils/misc.cmx debugger_config.cmx \ +source.cmx : primitives.cmx ../utils/misc.cmx debugger_config.cmx \ ../utils/config.cmx source.cmi -symbols.cmo: ../bytecomp/symtable.cmi program_loading.cmi \ +symbols.cmo : ../bytecomp/symtable.cmi program_loading.cmi \ ../bytecomp/instruct.cmi events.cmi debugger_config.cmi debugcom.cmi \ checkpoints.cmi ../bytecomp/bytesections.cmi symbols.cmi -symbols.cmx: ../bytecomp/symtable.cmx program_loading.cmx \ +symbols.cmx : ../bytecomp/symtable.cmx program_loading.cmx \ ../bytecomp/instruct.cmx events.cmx debugger_config.cmx debugcom.cmx \ checkpoints.cmx ../bytecomp/bytesections.cmx symbols.cmi -time_travel.cmo: trap_barrier.cmi symbols.cmi question.cmi \ +time_travel.cmo : trap_barrier.cmi symbols.cmi question.cmi \ program_loading.cmi primitives.cmi ../utils/misc.cmi int64ops.cmi \ ../bytecomp/instruct.cmi input_handling.cmi exec.cmi events.cmi \ debugger_config.cmi debugcom.cmi checkpoints.cmi breakpoints.cmi \ time_travel.cmi -time_travel.cmx: trap_barrier.cmx symbols.cmx question.cmx \ +time_travel.cmx : trap_barrier.cmx symbols.cmx question.cmx \ program_loading.cmx primitives.cmx ../utils/misc.cmx int64ops.cmx \ ../bytecomp/instruct.cmx input_handling.cmx exec.cmx events.cmx \ debugger_config.cmx debugcom.cmx checkpoints.cmx breakpoints.cmx \ time_travel.cmi -trap_barrier.cmo: exec.cmi debugcom.cmi checkpoints.cmi trap_barrier.cmi -trap_barrier.cmx: exec.cmx debugcom.cmx checkpoints.cmx trap_barrier.cmi -unix_tools.cmo: $(UNIXDIR)/unix.cmi primitives.cmi ../utils/misc.cmi \ +trap_barrier.cmo : exec.cmi debugcom.cmi checkpoints.cmi trap_barrier.cmi +trap_barrier.cmx : exec.cmx debugcom.cmx checkpoints.cmx trap_barrier.cmi +unix_tools.cmo : $(UNIXDIR)/unix.cmi primitives.cmi ../utils/misc.cmi \ unix_tools.cmi -unix_tools.cmx: $(UNIXDIR)/unix.cmx primitives.cmx ../utils/misc.cmx \ +unix_tools.cmx : $(UNIXDIR)/unix.cmx primitives.cmx ../utils/misc.cmx \ unix_tools.cmi diff -Nru ocaml-3.12.1/debugger/.ignore ocaml-4.01.0/debugger/.ignore --- ocaml-3.12.1/debugger/.ignore 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/debugger/.ignore 2012-07-26 19:21:54.000000000 +0000 @@ -0,0 +1,7 @@ +lexer.ml +parser.ml +parser.mli +ocamldebug +ocamldebug.exe +dynlink.ml +dynlink.mli diff -Nru ocaml-3.12.1/debugger/Makefile ocaml-4.01.0/debugger/Makefile --- ocaml-3.12.1/debugger/Makefile 2008-07-29 08:31:41.000000000 +0000 +++ ocaml-4.01.0/debugger/Makefile 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -10,7 +10,5 @@ # # ######################################################################### -# $Id: Makefile 8955 2008-07-29 08:31:41Z xleroy $ - UNIXDIR=../otherlibs/unix include Makefile.shared diff -Nru ocaml-3.12.1/debugger/Makefile.nt ocaml-4.01.0/debugger/Makefile.nt --- ocaml-3.12.1/debugger/Makefile.nt 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/debugger/Makefile.nt 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -10,7 +10,5 @@ # # ######################################################################### -# $Id: Makefile.nt 9547 2010-01-22 12:48:24Z doligez $ - UNIXDIR=../otherlibs/win32unix include Makefile.shared diff -Nru ocaml-3.12.1/debugger/Makefile.shared ocaml-4.01.0/debugger/Makefile.shared --- ocaml-3.12.1/debugger/Makefile.shared 2010-05-17 15:49:53.000000000 +0000 +++ ocaml-4.01.0/debugger/Makefile.shared 2013-08-15 10:21:57.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -10,8 +10,6 @@ # # ######################################################################### -# $Id: Makefile.shared 10413 2010-05-17 15:49:53Z doligez $ - include ../config/Makefile CAMLC=../ocamlcomp.sh @@ -29,14 +27,16 @@ OTHEROBJS=\ $(UNIXDIR)/unix.cma \ - ../utils/misc.cmo ../utils/config.cmo \ - ../utils/tbl.cmo ../utils/clflags.cmo ../utils/consistbl.cmo \ - ../parsing/longident.cmo \ + ../utils/misc.cmo ../utils/config.cmo ../utils/tbl.cmo \ + ../utils/clflags.cmo ../utils/consistbl.cmo ../utils/warnings.cmo \ + ../parsing/location.cmo ../parsing/longident.cmo \ ../typing/ident.cmo ../typing/path.cmo ../typing/types.cmo \ ../typing/btype.cmo ../typing/primitive.cmo ../typing/typedtree.cmo \ ../typing/subst.cmo ../typing/predef.cmo \ - ../typing/datarepr.cmo ../typing/env.cmo ../typing/oprint.cmo \ + ../typing/datarepr.cmo ../typing/cmi_format.cmo ../typing/env.cmo \ + ../typing/oprint.cmo \ ../typing/ctype.cmo ../typing/printtyp.cmo ../typing/mtype.cmo \ + ../typing/envaux.cmo \ ../bytecomp/runtimedef.cmo ../bytecomp/bytesections.cmo \ ../bytecomp/dll.cmo ../bytecomp/meta.cmo ../bytecomp/symtable.cmo \ ../bytecomp/opcodes.cmo \ @@ -49,7 +49,6 @@ primitives.cmo \ unix_tools.cmo \ debugger_config.cmo \ - envaux.cmo \ parameters.cmo \ lexer.cmo \ input_handling.cmo \ diff -Nru ocaml-3.12.1/debugger/breakpoints.ml ocaml-4.01.0/debugger/breakpoints.ml --- ocaml-3.12.1/debugger/breakpoints.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/debugger/breakpoints.ml 2013-03-09 22:38:52.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: breakpoints.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (******************************* Breakpoints ***************************) open Checkpoints @@ -67,7 +65,8 @@ [] end @ - List.map fst (List.filter (function (_, {ev_pos = pos}) -> pos = pc) !breakpoints) + List.map fst (List.filter (function (_, {ev_pos = pos}) -> pos = pc) + !breakpoints) (* Is there a breakpoint at `pc' ? *) let breakpoint_at_pc pc = @@ -169,7 +168,7 @@ incr breakpoint_number; insert_position event.ev_pos; breakpoints := (!breakpoint_number, event) :: !breakpoints); - printf "Breakpoint %d at %d : %s" !breakpoint_number event.ev_pos + printf "Breakpoint %d at %d: %s" !breakpoint_number event.ev_pos (Pos.get_desc event); print_newline () @@ -182,7 +181,7 @@ (function () -> breakpoints := List.remove_assoc number !breakpoints; remove_position pos; - printf "Removed breakpoint %d at %d : %s" number ev.ev_pos + printf "Removed breakpoint %d at %d: %s" number ev.ev_pos (Pos.get_desc ev); print_newline () ) diff -Nru ocaml-3.12.1/debugger/breakpoints.mli ocaml-4.01.0/debugger/breakpoints.mli --- ocaml-3.12.1/debugger/breakpoints.mli 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/debugger/breakpoints.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: breakpoints.mli 2553 1999-11-17 18:59:06Z xleroy $ *) - (******************************* Breakpoints ***************************) open Primitives diff -Nru ocaml-3.12.1/debugger/checkpoints.ml ocaml-4.01.0/debugger/checkpoints.ml --- ocaml-3.12.1/debugger/checkpoints.ml 2002-10-29 17:53:24.000000000 +0000 +++ ocaml-4.01.0/debugger/checkpoints.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: checkpoints.ml 5200 2002-10-29 17:53:24Z doligez $ *) - (*************************** Checkpoints *******************************) open Int64ops diff -Nru ocaml-3.12.1/debugger/checkpoints.mli ocaml-4.01.0/debugger/checkpoints.mli --- ocaml-3.12.1/debugger/checkpoints.mli 2002-10-29 17:53:24.000000000 +0000 +++ ocaml-4.01.0/debugger/checkpoints.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: checkpoints.mli 5200 2002-10-29 17:53:24Z doligez $ *) - (***************************** Checkpoints *****************************) open Primitives diff -Nru ocaml-3.12.1/debugger/command_line.ml ocaml-4.01.0/debugger/command_line.ml --- ocaml-3.12.1/debugger/command_line.ml 2010-09-29 16:46:54.000000000 +0000 +++ ocaml-4.01.0/debugger/command_line.ml 2013-03-22 18:18:26.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: command_line.ml 10695 2010-09-29 16:46:54Z doligez $ *) - (************************ Reading and executing commands ***************) open Int64ops @@ -126,7 +124,7 @@ new_breakpoint (any_event_at_pc pc) with | Not_found -> - eprintf "Can't add breakpoint at pc %i : no event there.@." pc; + eprintf "Can't add breakpoint at pc %i: no event there.@." pc; raise Toplevel let add_breakpoint_after_pc pc = @@ -187,6 +185,8 @@ with | Parsing.Parse_error -> error "Syntax error." + | Failure "int_of_string" -> + error "Integer overflow" let line_loop ppf line_buffer = resume_user_input (); @@ -209,8 +209,8 @@ with | Exit -> stop_user_input () - | Sys_error s -> - error ("System error : " ^ s) +(* | Sys_error s -> + error ("System error: " ^ s) *) (** Instructions. **) let instr_cd ppf lexbuf = @@ -230,6 +230,22 @@ if (err != 0) then eprintf "Shell command %S failed with exit code %d\n%!" cmd err +let instr_env ppf lexbuf = + let cmdarg = argument_list_eol argument lexbuf in + let cmdarg = string_trim (String.concat " " cmdarg) in + if cmdarg <> "" then + try + if (String.index cmdarg '=') > 0 then + Debugger_config.environment := cmdarg :: !Debugger_config.environment + else + eprintf "Environment variables should not have an empty name\n%!" + with Not_found -> + eprintf "Environment variables should have the \"name=value\" format\n%!" + else + List.iter + (printf "%s\n%!") + (List.rev !Debugger_config.environment) + let instr_pwd ppf lexbuf = eol lexbuf; fprintf ppf "%s@." (Sys.getcwd ()) @@ -247,16 +263,18 @@ else begin let new_directory' = List.rev new_directory in match new_directory' with - | mdl :: for_keyw :: tl when (String.lowercase for_keyw) = "for" && (List.length tl) > 0 -> + | mdl :: for_keyw :: tl + when (String.lowercase for_keyw) = "for" && (List.length tl) > 0 -> List.iter (function x -> add_path_for mdl (expand_path x)) tl | _ -> List.iter (function x -> add_path (expand_path x)) new_directory' end; let print_dirs ppf l = List.iter (function x -> fprintf ppf "@ %s" x) l in - fprintf ppf "@[<2>Directories :%a@]@." print_dirs !Config.load_path; + fprintf ppf "@[<2>Directories: %a@]@." print_dirs !Config.load_path; Hashtbl.iter (fun mdl dirs -> - fprintf ppf "@[<2>Source directories for %s :%a@]@." mdl print_dirs dirs) + fprintf ppf "@[<2>Source directories for %s: %a@]@." mdl print_dirs + dirs) Debugger_config.load_path_for let instr_kill ppf lexbuf = @@ -355,11 +373,11 @@ let print_variable_list ppf = let pr_vars ppf = List.iter (fun v -> fprintf ppf "%s@ " v.var_name) in - fprintf ppf "List of variables :%a@." pr_vars !variable_list + fprintf ppf "List of variables: %a@." pr_vars !variable_list let print_info_list ppf = let pr_infos ppf = List.iter (fun i -> fprintf ppf "%s@ " i.info_name) in - fprintf ppf "List of info commands :%a@." pr_infos !info_list + fprintf ppf "List of info commands: %a@." pr_infos !info_list let instr_complete ppf lexbuf = let ppf = Format.err_formatter in @@ -415,7 +433,7 @@ | Some x -> let print_help nm hlp = eol lexbuf; - fprintf ppf "%s : %s@." nm hlp in + fprintf ppf "%s: %s@." nm hlp in begin match matching_instructions x with | [] -> eol lexbuf; @@ -451,10 +469,10 @@ print_help i.instr_name i.instr_help | l -> eol lexbuf; - fprintf ppf "Ambiguous command \"%s\" : %a@." x pr_instrs l + fprintf ppf "Ambiguous command \"%s\": %a@." x pr_instrs l end | None -> - fprintf ppf "List of commands :%a@." pr_instrs !instruction_list + fprintf ppf "List of commands: %a@." pr_instrs !instruction_list (* Printing values *) @@ -467,12 +485,18 @@ Eval.report_error ppf msg; raise Toplevel +let env_of_event = + function + None -> Env.empty + | Some ev -> + Envaux.env_from_summary ev.Instruct.ev_typenv ev.Instruct.ev_typsubst + let print_command depth ppf lexbuf = let exprs = expression_list_eol Lexer.lexeme lexbuf in ensure_loaded (); let env = try - Envaux.env_of_event !selected_event + env_of_event !selected_event with | Envaux.Error msg -> Envaux.report_error ppf msg; @@ -532,7 +556,7 @@ (function ppf -> List.iter (function {var_name = nm; var_action = (_, funct)} -> - fprintf ppf "%s : " nm; + fprintf ppf "%s: " nm; funct ppf) !variable_list) @@ -557,7 +581,7 @@ | BA_function expr -> (* break FUNCTION *) let env = try - Envaux.env_of_event !selected_event + env_of_event !selected_event with | Envaux.Error msg -> Envaux.report_error ppf msg; @@ -600,7 +624,9 @@ raise Toplevel) | BA_pos2 (mdle, position) -> (* break @ [MODULE] # POSITION *) try - new_breakpoint (event_near_pos (convert_module (module_of_longident mdle)) position) + new_breakpoint + (event_near_pos (convert_module (module_of_longident mdle)) + position) with | Not_found -> eprintf "Can't find any event there.@." @@ -827,18 +853,18 @@ let pr_modules ppf mods = let pr_mods ppf = List.iter (function x -> fprintf ppf "%s@ " x) in - fprintf ppf "Used modules :@.%a@?" pr_mods mods + fprintf ppf "Used modules: @.%a@?" pr_mods mods let info_modules ppf lexbuf = eol lexbuf; ensure_loaded (); pr_modules ppf !modules (******** - print_endline "Opened modules :"; + print_endline "Opened modules: "; if !opened_modules_names = [] then print_endline "(no module opened)." else - (List.iter (function x -> print_string x; print_space) !opened_modules_names; + (List.iter (function x -> print_string x;print_space) !opened_modules_names; print_newline ()) *********) @@ -876,8 +902,10 @@ let info_events ppf lexbuf = ensure_loaded (); - let mdle = convert_module (module_of_longident (opt_longident_eol Lexer.lexeme lexbuf)) in - print_endline ("Module : " ^ mdle); + let mdle = + convert_module (module_of_longident (opt_longident_eol Lexer.lexeme lexbuf)) + in + print_endline ("Module: " ^ mdle); print_endline " Address Characters Kind Repr."; List.iter (function ev -> @@ -962,6 +990,9 @@ { instr_name = "shell"; instr_prio = false; instr_action = instr_shell; instr_repeat = true; instr_help = "Execute a given COMMAND thru the system shell." }; + { instr_name = "environment"; instr_prio = false; + instr_action = instr_env; instr_repeat = false; instr_help = +"environment variable to give to program being debugged when it is started." }; (* Displacements *) { instr_name = "run"; instr_prio = true; instr_action = instr_run; instr_repeat = true; instr_help = @@ -1081,10 +1112,10 @@ var_action = loading_mode_variable ppf; var_help = "mode of loading.\n\ -It can be either :\n\ - direct : the program is directly called by the debugger.\n\ - runtime : the debugger execute `ocamlrun programname arguments'.\n\ - manual : the program is not launched by the debugger,\n\ +It can be either:\n\ + direct: the program is directly called by the debugger.\n\ + runtime: the debugger execute `ocamlrun programname arguments'.\n\ + manual: the program is not launched by the debugger,\n\ but manually by the user." }; { var_name = "processcount"; var_action = integer_variable false 1 "Must be >= 1." @@ -1128,8 +1159,8 @@ var_help = "process to follow after forking.\n\ It can be either : - child : the newly created process.\n\ - parent : the process that called fork.\n" }]; + child: the newly created process.\n\ + parent: the process that called fork.\n" }]; info_list := (* info name, function, help *) diff -Nru ocaml-3.12.1/debugger/command_line.mli ocaml-4.01.0/debugger/command_line.mli --- ocaml-3.12.1/debugger/command_line.mli 2000-03-07 18:22:19.000000000 +0000 +++ ocaml-4.01.0/debugger/command_line.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: command_line.mli 2919 2000-03-07 18:22:19Z weis $ *) - (************************ Reading and executing commands ***************) open Lexing;; diff -Nru ocaml-3.12.1/debugger/debugcom.ml ocaml-4.01.0/debugger/debugcom.ml --- ocaml-3.12.1/debugger/debugcom.ml 2010-04-20 15:47:15.000000000 +0000 +++ ocaml-4.01.0/debugger/debugcom.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: debugcom.ml 10287 2010-04-20 15:47:15Z doligez $ *) - (* Low-level communication with the debuggee *) open Int64ops @@ -189,8 +187,7 @@ let value_size = if 1 lsl 31 = 0 then 4 else 8 let input_remote_value ic = - let v = String.create value_size in - really_input ic v 0 value_size; v + Misc.input_bytes ic value_size let output_remote_value ic v = output ic v 0 value_size @@ -247,8 +244,7 @@ if input_byte !conn.io_in = 0 then Remote(input_remote_value !conn.io_in) else begin - let buf = String.create 8 in - really_input !conn.io_in buf 0 8; + let buf = Misc.input_bytes !conn.io_in 8 in let floatbuf = float n (* force allocation of a new float *) in String.unsafe_blit buf 0 (Obj.magic floatbuf) 0 8; Local(Obj.repr floatbuf) diff -Nru ocaml-3.12.1/debugger/debugcom.mli ocaml-4.01.0/debugger/debugcom.mli --- ocaml-3.12.1/debugger/debugcom.mli 2010-04-20 15:47:15.000000000 +0000 +++ ocaml-4.01.0/debugger/debugcom.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: debugcom.mli 10287 2010-04-20 15:47:15Z doligez $ *) - (* Low-level communication with the debuggee *) type execution_summary = diff -Nru ocaml-3.12.1/debugger/debugger_config.ml ocaml-4.01.0/debugger/debugger_config.ml --- ocaml-3.12.1/debugger/debugger_config.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/debugger/debugger_config.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: debugger_config.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (**************************** Configuration file ***********************) open Int64ops @@ -56,7 +54,7 @@ "Win32" -> "cmd" | _ -> "/bin/sh" -(* Name of the Objective Caml runtime. *) +(* Name of the OCaml runtime. *) let runtime_program = "ocamlrun" (* Time history size (for `last') *) @@ -80,3 +78,7 @@ (match Sys.os_type with "Win32" -> false | _ -> true) + +(*** Environment variables for debugee. ***) + +let environment = ref [] diff -Nru ocaml-3.12.1/debugger/debugger_config.mli ocaml-4.01.0/debugger/debugger_config.mli --- ocaml-3.12.1/debugger/debugger_config.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/debugger/debugger_config.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: debugger_config.mli 9547 2010-01-22 12:48:24Z doligez $ *) - (********************** Configuration file *****************************) exception Toplevel @@ -33,3 +31,7 @@ val checkpoint_small_step : int64 ref val checkpoint_max_count : int ref val make_checkpoints : bool ref + +(*** Environment variables for debugee. ***) + +val environment : string list ref diff -Nru ocaml-3.12.1/debugger/envaux.ml ocaml-4.01.0/debugger/envaux.ml --- ocaml-3.12.1/debugger/envaux.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/debugger/envaux.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,84 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: envaux.ml 9547 2010-01-22 12:48:24Z doligez $ *) - -open Misc -open Types -open Env - -type error = - Module_not_found of Path.t - -exception Error of error - -let env_cache = - (Hashtbl.create 59 : ((Env.summary * Subst.t), Env.t) Hashtbl.t) - -let reset_cache () = - Hashtbl.clear env_cache; - Env.reset_cache() - -let extract_sig env mty = - match Mtype.scrape env mty with - Tmty_signature sg -> sg - | _ -> fatal_error "Envaux.extract_sig" - -let rec env_from_summary sum subst = - try - Hashtbl.find env_cache (sum, subst) - with Not_found -> - let env = - match sum with - Env_empty -> - Env.empty - | Env_value(s, id, desc) -> - Env.add_value id (Subst.value_description subst desc) (env_from_summary s subst) - | Env_type(s, id, desc) -> - Env.add_type id (Subst.type_declaration subst desc) (env_from_summary s subst) - | Env_exception(s, id, desc) -> - Env.add_exception id (Subst.exception_declaration subst desc) (env_from_summary s subst) - | Env_module(s, id, desc) -> - Env.add_module id (Subst.modtype subst desc) (env_from_summary s subst) - | Env_modtype(s, id, desc) -> - Env.add_modtype id (Subst.modtype_declaration subst desc) (env_from_summary s subst) - | Env_class(s, id, desc) -> - Env.add_class id (Subst.class_declaration subst desc) (env_from_summary s subst) - | Env_cltype (s, id, desc) -> - Env.add_cltype id (Subst.cltype_declaration subst desc) (env_from_summary s subst) - | Env_open(s, path) -> - let env = env_from_summary s subst in - let path' = Subst.module_path subst path in - let mty = - try - Env.find_module path' env - with Not_found -> - raise (Error (Module_not_found path')) - in - Env.open_signature path' (extract_sig env mty) env - in - Hashtbl.add env_cache (sum, subst) env; - env - -let env_of_event = - function - None -> Env.empty - | Some ev -> env_from_summary ev.Instruct.ev_typenv ev.Instruct.ev_typsubst - -(* Error report *) - -open Format - -let report_error ppf = function - | Module_not_found p -> - fprintf ppf "@[Cannot find module %a@].@." Printtyp.path p diff -Nru ocaml-3.12.1/debugger/envaux.mli ocaml-4.01.0/debugger/envaux.mli --- ocaml-3.12.1/debugger/envaux.mli 2000-03-06 22:12:09.000000000 +0000 +++ ocaml-4.01.0/debugger/envaux.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,33 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id: envaux.mli 2908 2000-03-06 22:12:09Z weis $ *) - -open Format - -(* Convert environment summaries to environments *) - -val env_of_event: Instruct.debug_event option -> Env.t - -(* Empty the environment caches. To be called when load_path changes. *) - -val reset_cache: unit -> unit - -(* Error report *) - -type error = - Module_not_found of Path.t - -exception Error of error - -val report_error: formatter -> error -> unit diff -Nru ocaml-3.12.1/debugger/eval.ml ocaml-4.01.0/debugger/eval.ml --- ocaml-3.12.1/debugger/eval.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/debugger/eval.ml 2013-03-22 18:18:26.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: eval.ml 9547 2010-01-22 12:48:24Z doligez $ *) - open Misc open Path open Instruct @@ -89,7 +87,8 @@ end | E_result -> begin match event with - Some {ev_kind = Event_after ty; ev_typsubst = subst} when !Frames.current_frame = 0 -> + Some {ev_kind = Event_after ty; ev_typsubst = subst} + when !Frames.current_frame = 0 -> (Debugcom.Remote_value.accu(), Subst.type_expr subst ty) | _ -> raise(Error(No_result)) @@ -149,7 +148,7 @@ [] -> raise(Error(Wrong_label(ty, lbl))) | (name, mut, ty_arg) :: rem -> - if name = lbl then begin + if Ident.name name = lbl then begin let ty_res = Btype.newgenty(Tconstr(path, tydesc.type_params, ref Mnil)) in @@ -183,10 +182,12 @@ pos len Printtyp.type_expr ty | Array_index(len, pos) -> fprintf ppf - "@[Cannot extract element number %i from an array of length %i@]@." pos len + "@[Cannot extract element number %i from an array of length %i@]@." + pos len | List_index(len, pos) -> fprintf ppf - "@[Cannot extract element number %i from a list of length %i@]@." pos len + "@[Cannot extract element number %i from a list of length %i@]@." + pos len | String_index(s, len, pos) -> fprintf ppf "@[Cannot extract character number %i@ \ diff -Nru ocaml-3.12.1/debugger/eval.mli ocaml-4.01.0/debugger/eval.mli --- ocaml-3.12.1/debugger/eval.mli 2000-03-06 22:12:09.000000000 +0000 +++ ocaml-4.01.0/debugger/eval.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: eval.mli 2908 2000-03-06 22:12:09Z weis $ *) - open Types open Parser_aux open Format diff -Nru ocaml-3.12.1/debugger/events.ml ocaml-4.01.0/debugger/events.ml --- ocaml-3.12.1/debugger/events.ml 2009-05-20 11:52:42.000000000 +0000 +++ ocaml-4.01.0/debugger/events.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: events.ml 9270 2009-05-20 11:52:42Z doligez $ *) - (********************************* Events ******************************) open Instruct diff -Nru ocaml-3.12.1/debugger/events.mli ocaml-4.01.0/debugger/events.mli --- ocaml-3.12.1/debugger/events.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/debugger/events.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: events.mli 9547 2010-01-22 12:48:24Z doligez $ *) - open Instruct val get_pos : debug_event -> Lexing.position;; diff -Nru ocaml-3.12.1/debugger/exec.ml ocaml-4.01.0/debugger/exec.ml --- ocaml-3.12.1/debugger/exec.ml 2008-07-29 08:31:41.000000000 +0000 +++ ocaml-4.01.0/debugger/exec.ml 2013-03-09 22:38:52.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: exec.ml 8955 2008-07-29 08:31:41Z xleroy $ *) - (* Handling of keyboard interrupts *) let interrupted = ref false @@ -29,7 +27,7 @@ "Win32" -> () | _ -> Sys.set_signal Sys.sigint (Sys.Signal_handle break); - Sys.set_signal Sys.sigpipe (Sys.Signal_handle (fun _ -> raise End_of_file)) + Sys.set_signal Sys.sigpipe (Sys.Signal_handle(fun _ -> raise End_of_file)) let protect f = if !is_protected then diff -Nru ocaml-3.12.1/debugger/exec.mli ocaml-4.01.0/debugger/exec.mli --- ocaml-3.12.1/debugger/exec.mli 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/debugger/exec.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: exec.mli 2553 1999-11-17 18:59:06Z xleroy $ *) - (* Handling of keyboard interrupts *) val protect : (unit -> unit) -> unit diff -Nru ocaml-3.12.1/debugger/frames.ml ocaml-4.01.0/debugger/frames.ml --- ocaml-3.12.1/debugger/frames.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/debugger/frames.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: frames.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (***************************** Frames **********************************) open Instruct diff -Nru ocaml-3.12.1/debugger/frames.mli ocaml-4.01.0/debugger/frames.mli --- ocaml-3.12.1/debugger/frames.mli 2010-01-20 16:26:46.000000000 +0000 +++ ocaml-4.01.0/debugger/frames.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: frames.mli 9540 2010-01-20 16:26:46Z doligez $ *) - (****************************** Frames *********************************) open Instruct diff -Nru ocaml-3.12.1/debugger/history.ml ocaml-4.01.0/debugger/history.ml --- ocaml-3.12.1/debugger/history.ml 2009-05-20 11:52:42.000000000 +0000 +++ ocaml-4.01.0/debugger/history.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: history.ml 9270 2009-05-20 11:52:42Z doligez $ *) - open Int64ops open Checkpoints open Primitives diff -Nru ocaml-3.12.1/debugger/history.mli ocaml-4.01.0/debugger/history.mli --- ocaml-3.12.1/debugger/history.mli 2002-10-29 17:53:24.000000000 +0000 +++ ocaml-4.01.0/debugger/history.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: history.mli 5200 2002-10-29 17:53:24Z doligez $ *) - val empty_history : unit -> unit val add_current_time : unit -> unit diff -Nru ocaml-3.12.1/debugger/input_handling.ml ocaml-4.01.0/debugger/input_handling.ml --- ocaml-3.12.1/debugger/input_handling.ml 2009-05-20 11:52:42.000000000 +0000 +++ ocaml-4.01.0/debugger/input_handling.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: input_handling.ml 9270 2009-05-20 11:52:42Z doligez $ *) - (**************************** Input control ****************************) open Unix diff -Nru ocaml-3.12.1/debugger/input_handling.mli ocaml-4.01.0/debugger/input_handling.mli --- ocaml-3.12.1/debugger/input_handling.mli 2006-12-09 13:49:10.000000000 +0000 +++ ocaml-4.01.0/debugger/input_handling.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: input_handling.mli 7767 2006-12-09 13:49:10Z ertai $ *) - (***************************** Input control ***************************) open Primitives diff -Nru ocaml-3.12.1/debugger/int64ops.ml ocaml-4.01.0/debugger/int64ops.ml --- ocaml-3.12.1/debugger/int64ops.ml 2002-10-29 17:53:24.000000000 +0000 +++ ocaml-4.01.0/debugger/int64ops.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Damien Doligez, projet Moscova, INRIA Rocqencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: int64ops.ml 5200 2002-10-29 17:53:24Z doligez $ *) - (****************** arithmetic operators for Int64 *********************) let ( ++ ) = Int64.add;; diff -Nru ocaml-3.12.1/debugger/int64ops.mli ocaml-4.01.0/debugger/int64ops.mli --- ocaml-3.12.1/debugger/int64ops.mli 2002-10-29 17:53:24.000000000 +0000 +++ ocaml-4.01.0/debugger/int64ops.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Damien Doligez, projet Moscova, INRIA Rocqencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: int64ops.mli 5200 2002-10-29 17:53:24Z doligez $ *) - (****************** arithmetic operators for Int64 *********************) val ( ++ ) : int64 -> int64 -> int64;; diff -Nru ocaml-3.12.1/debugger/lexer.mli ocaml-4.01.0/debugger/lexer.mli --- ocaml-3.12.1/debugger/lexer.mli 2004-06-13 12:46:11.000000000 +0000 +++ ocaml-4.01.0/debugger/lexer.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: lexer.mli 6394 2004-06-13 12:46:11Z xleroy $ *) - val line: Lexing.lexbuf -> string val lexeme: Lexing.lexbuf -> Parser.token val argument: Lexing.lexbuf -> Parser.token diff -Nru ocaml-3.12.1/debugger/lexer.mll ocaml-4.01.0/debugger/lexer.mll --- ocaml-3.12.1/debugger/lexer.mll 2009-05-20 11:52:42.000000000 +0000 +++ ocaml-4.01.0/debugger/lexer.mll 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: lexer.mll 9270 2009-05-20 11:52:42Z doligez $ *) - { open Parser diff -Nru ocaml-3.12.1/debugger/loadprinter.ml ocaml-4.01.0/debugger/loadprinter.ml --- ocaml-3.12.1/debugger/loadprinter.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/debugger/loadprinter.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: loadprinter.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Loading and installation of user-defined printer functions *) open Misc @@ -95,6 +93,15 @@ (* Install, remove a printer (as in toplevel/topdirs) *) +(* since 4.00, "topdirs.cmi" is not in the same directory as the standard + libray, so we load it beforehand as it cannot be found in the search path. *) +let () = + let compiler_libs = + Filename.concat Config.standard_library "compiler-libs" in + let topdirs = + Filename.concat compiler_libs "topdirs.cmi" in + ignore (Env.read_signature "Topdirs" topdirs) + let match_printer_type desc typename = let (printer_type, _) = try @@ -106,7 +113,7 @@ let ty_arg = Ctype.newvar() in Ctype.unify Env.empty (Ctype.newconstr printer_type [ty_arg]) - (Ctype.instance desc.val_type); + (Ctype.instance Env.empty desc.val_type); Ctype.end_def(); Ctype.generalize ty_arg; ty_arg diff -Nru ocaml-3.12.1/debugger/loadprinter.mli ocaml-4.01.0/debugger/loadprinter.mli --- ocaml-3.12.1/debugger/loadprinter.mli 2000-03-07 18:22:19.000000000 +0000 +++ ocaml-4.01.0/debugger/loadprinter.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: loadprinter.mli 2919 2000-03-07 18:22:19Z weis $ *) - (* Loading and installation of user-defined printer functions *) open Format diff -Nru ocaml-3.12.1/debugger/main.ml ocaml-4.01.0/debugger/main.ml --- ocaml-3.12.1/debugger/main.ml 2010-05-20 14:06:29.000000000 +0000 +++ ocaml-4.01.0/debugger/main.ml 2013-03-09 22:38:52.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: main.ml 10444 2010-05-20 14:06:29Z doligez $ *) - open Input_handling open Question open Command_line @@ -74,7 +72,8 @@ protect ppf restart (function ppf -> let b = if !current_duration = -1L then begin - let msg = sprintf "Restart from time %Ld and try to get closer of the problem" time in + let msg = sprintf "Restart from time %Ld and try to get \ + closer of the problem" time in stop_user_input (); if yes_or_no msg then (current_duration := init_duration; true) @@ -158,7 +157,7 @@ let set_directory dir = Sys.chdir dir let print_version () = - printf "The Objective Caml debugger, version %s@." Sys.ocaml_version; + printf "The OCaml debugger, version %s@." Sys.ocaml_version; exit 0; ;; let print_version_num () = @@ -183,7 +182,11 @@ " Print version number and exit"; ] +let function_placeholder () = + raise Not_found + let main () = + Callback.register "Debugger.function_placeholder" function_placeholder; try socket_name := (match Sys.os_type with @@ -206,7 +209,7 @@ arguments := !arguments ^ " " ^ (Filename.quote Sys.argv.(j)) done end; - printf "\tObjective Caml Debugger version %s@.@." Config.version; + printf "\tOCaml Debugger version %s@.@." Config.version; Config.load_path := !default_load_path; Clflags.recursive_types := true; (* Allow recursive types. *) toplevel_loop (); (* Toplevel. *) @@ -220,6 +223,11 @@ Env.report_error err_formatter e; eprintf "@]@."; exit 2 + | Cmi_format.Error e -> + eprintf "Debugger [version %s] environment error:@ @[@;" Config.version; + Cmi_format.report_error err_formatter e; + eprintf "@]@."; + exit 2 let _ = Printexc.catch (Unix.handle_unix_error main) () diff -Nru ocaml-3.12.1/debugger/parameters.ml ocaml-4.01.0/debugger/parameters.ml --- ocaml-3.12.1/debugger/parameters.ml 2009-05-20 11:52:42.000000000 +0000 +++ ocaml-4.01.0/debugger/parameters.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: parameters.ml 9270 2009-05-20 11:52:42Z doligez $ *) - (* Miscellaneous parameters *) open Primitives diff -Nru ocaml-3.12.1/debugger/parameters.mli ocaml-4.01.0/debugger/parameters.mli --- ocaml-3.12.1/debugger/parameters.mli 2009-05-20 11:52:42.000000000 +0000 +++ ocaml-4.01.0/debugger/parameters.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: parameters.mli 9270 2009-05-20 11:52:42Z doligez $ *) - (* Miscellaneous parameters *) val program_name : string ref diff -Nru ocaml-3.12.1/debugger/parser.mly ocaml-4.01.0/debugger/parser.mly --- ocaml-3.12.1/debugger/parser.mly 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/debugger/parser.mly 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Jerome Vouillon, projet Cristal, INRIA Rocquencourt */ -/* Objective Caml port by John Malecki and Xavier Leroy */ +/* OCaml port by John Malecki and Xavier Leroy */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ @@ -11,8 +11,6 @@ /* */ /***********************************************************************/ -/* $Id: parser.mly 9547 2010-01-22 12:48:24Z doligez $ */ - %{ open Int64ops @@ -170,6 +168,8 @@ LIDENT { Lident $1 } | module_path DOT LIDENT { Ldot($1, $3) } | OPERATOR { Lident $1 } + | module_path DOT OPERATOR { Ldot($1, $3) } + | module_path DOT LPAREN OPERATOR RPAREN { Ldot($1, $4) } ; module_path : diff -Nru ocaml-3.12.1/debugger/parser_aux.mli ocaml-4.01.0/debugger/parser_aux.mli --- ocaml-3.12.1/debugger/parser_aux.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/debugger/parser_aux.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: parser_aux.mli 9547 2010-01-22 12:48:24Z doligez $ *) - (*open Globals*) open Primitives diff -Nru ocaml-3.12.1/debugger/pattern_matching.ml ocaml-4.01.0/debugger/pattern_matching.ml --- ocaml-3.12.1/debugger/pattern_matching.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/debugger/pattern_matching.ml 2013-03-22 18:18:26.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: pattern_matching.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (************************ Simple pattern matching **********************) open Debugger_config @@ -91,7 +89,8 @@ | P_nth (n, patt) -> if n >= List.length ty_list then (prerr_endline "Out of range."; raise Toplevel); - pattern_matching patt (Debugcom.get_field obj n) (List.nth ty_list n) + pattern_matching patt (Debugcom.get_field obj n) + (List.nth ty_list n) | _ -> error_matching ()) | Tconstr(cstr, [ty_arg],_) when same_type_constr cstr constr_type_list -> @@ -223,7 +222,8 @@ filter (ty_res, ty) with Unify -> fatal_error "pattern_matching: types should match"); - pattern_matching patt (Debugcom.get_field obj lbl.info.lbl_pos) ty_arg + pattern_matching patt (Debugcom.get_field obj lbl.info.lbl_pos) + ty_arg in (match pattern with P_record pattern_label_list -> diff -Nru ocaml-3.12.1/debugger/pattern_matching.mli ocaml-4.01.0/debugger/pattern_matching.mli --- ocaml-3.12.1/debugger/pattern_matching.mli 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/debugger/pattern_matching.mli 2013-03-22 18:18:26.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,11 +11,10 @@ (* *) (***********************************************************************) -(* $Id: pattern_matching.mli 2553 1999-11-17 18:59:06Z xleroy $ *) - (************************ Simple pattern matching **********************) open Parser_aux val pattern_matching : - pattern -> Debugcom.remote_value -> Typedtree.type_expr -> (string * Debugcom.remote_value * Typedtree.type_expr) list;; + pattern -> Debugcom.remote_value -> Typedtree.type_expr -> + (string * Debugcom.remote_value * Typedtree.type_expr) list;; diff -Nru ocaml-3.12.1/debugger/pos.ml ocaml-4.01.0/debugger/pos.ml --- ocaml-3.12.1/debugger/pos.ml 2006-12-09 13:49:10.000000000 +0000 +++ ocaml-4.01.0/debugger/pos.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Damien Doligez, projet Moscova, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: pos.ml 7767 2006-12-09 13:49:10Z ertai $ *) - open Instruct;; open Lexing;; open Location;; @@ -20,23 +18,8 @@ let get_desc ev = let loc = ev.ev_loc in - if loc.loc_start.pos_fname <> "" - then Printf.sprintf "file %s, line %d, characters %d-%d" - loc.loc_start.pos_fname loc.loc_start.pos_lnum - (loc.loc_start.pos_cnum - loc.loc_start.pos_bol + 1) - (loc.loc_end.pos_cnum - loc.loc_start.pos_bol + 1) - else begin - let filename = source_of_module ev.ev_loc.loc_start ev.ev_module in - try - let (start, line) = line_of_pos (get_buffer loc.loc_start ev.ev_module) - loc.loc_start.pos_cnum - in - Printf.sprintf "file %s, line %d, characters %d-%d" - filename line (loc.loc_start.pos_cnum - start + 1) - (loc.loc_end.pos_cnum - start + 1) - with Not_found | Out_of_range -> - Printf.sprintf "file %s, characters %d-%d" - filename (loc.loc_start.pos_cnum + 1) - (loc.loc_end.pos_cnum + 1) - end + Printf.sprintf "file %s, line %d, characters %d-%d" + loc.loc_start.pos_fname loc.loc_start.pos_lnum + (loc.loc_start.pos_cnum - loc.loc_start.pos_bol + 1) + (loc.loc_end.pos_cnum - loc.loc_start.pos_bol + 1) ;; diff -Nru ocaml-3.12.1/debugger/pos.mli ocaml-4.01.0/debugger/pos.mli --- ocaml-3.12.1/debugger/pos.mli 2003-11-21 16:10:57.000000000 +0000 +++ ocaml-4.01.0/debugger/pos.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Damien Doligez, projet Moscova, INRIA Rocquencourt *) (* *) @@ -10,6 +10,4 @@ (* *) (***********************************************************************) -(* $Id: pos.mli 5966 2003-11-21 16:10:57Z doligez $ *) - val get_desc : Instruct.debug_event -> string;; diff -Nru ocaml-3.12.1/debugger/primitives.ml ocaml-4.01.0/debugger/primitives.ml --- ocaml-3.12.1/debugger/primitives.ml 2009-05-20 11:52:42.000000000 +0000 +++ ocaml-4.01.0/debugger/primitives.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: primitives.ml 9270 2009-05-20 11:52:42Z doligez $ *) - (*********************** Basic functions and types *********************) (*** Miscellaneous ***) diff -Nru ocaml-3.12.1/debugger/primitives.mli ocaml-4.01.0/debugger/primitives.mli --- ocaml-3.12.1/debugger/primitives.mli 2009-05-20 11:52:42.000000000 +0000 +++ ocaml-4.01.0/debugger/primitives.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: primitives.mli 9270 2009-05-20 11:52:42Z doligez $ *) - (********************* Basic functions and types ***********************) (*** Miscellaneous ***) diff -Nru ocaml-3.12.1/debugger/printval.ml ocaml-4.01.0/debugger/printval.ml --- ocaml-3.12.1/debugger/printval.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/debugger/printval.ml 2012-10-17 12:26:42.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: printval.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* To print values *) open Format @@ -47,7 +45,7 @@ module EvalPath = struct - type value = Debugcom.Remote_value.t + type valu = Debugcom.Remote_value.t exception Error let rec eval_path = function Pident id -> @@ -102,7 +100,7 @@ let n = name_value obj ty in fprintf ppf "$%i" n in Printtyp.reset_and_mark_loops ty; - fprintf ppf "@[<2>%a :@ %a@ =@ %a@]@." + fprintf ppf "@[<2>%a:@ %a@ =@ %a@]@." print_value_name exp Printtyp.type_expr ty (print_value max_depth env obj) ty diff -Nru ocaml-3.12.1/debugger/printval.mli ocaml-4.01.0/debugger/printval.mli --- ocaml-3.12.1/debugger/printval.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/debugger/printval.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: printval.mli 9547 2010-01-22 12:48:24Z doligez $ *) - open Format val max_printer_depth : int ref diff -Nru ocaml-3.12.1/debugger/program_loading.ml ocaml-4.01.0/debugger/program_loading.ml --- ocaml-3.12.1/debugger/program_loading.ml 2009-05-20 11:52:42.000000000 +0000 +++ ocaml-4.01.0/debugger/program_loading.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: program_loading.ml 9270 2009-05-20 11:52:42Z doligez $ *) - (* Program loading *) open Unix @@ -35,6 +33,39 @@ (*** Launching functions. ***) +(* Returns the environment to be passed to debugee *) +let get_environment () = + let env = Unix.environment () in + let have_same_name x y = + let split = Primitives.split_string '=' in + match split x, split y with + (hd1 :: _), (hd2 :: _) -> hd1 = hd2 + | _ -> false in + let have_name_in_config_env x = + List.exists + (have_same_name x) + !Debugger_config.environment in + let env = + Array.fold_right + (fun elem acc -> + if have_name_in_config_env elem then + acc + else + elem :: acc) + env + [] in + Array.of_list (env @ !Debugger_config.environment) + +(* Returns the environment to be passed to debugee *) +let get_win32_environment () = + let res = Buffer.create 256 in + let env = get_environment () in + let len = Array.length env in + for i = 0 to pred len do + Buffer.add_string res (Printf.sprintf "set %s && " env.(i)) + done; + Buffer.contents res + (* A generic function for launching the program *) let generic_exec_unix cmdline = function () -> if !debug_loading then @@ -52,7 +83,7 @@ 0 -> (* Try to detach the process from the controlling terminal, so that it does not receive SIGINT on ctrl-C. *) begin try ignore(setsid()) with Invalid_argument _ -> () end; - execv shell [| shell; "-c"; cmdline() |] + execve shell [| shell; "-c"; cmdline() |] (get_environment ()) | _ -> exit 0 with x -> Unix_tools.report_error x; @@ -76,7 +107,7 @@ "Win32" -> generic_exec_win | _ -> generic_exec_unix -(* Execute the program by calling the runtime explicitely *) +(* Execute the program by calling the runtime explicitly *) let exec_with_runtime = generic_exec (function () -> @@ -86,7 +117,8 @@ but quoting is even worse because Unix.create_process thinks each command line parameter is a file. So no good solution so far *) - Printf.sprintf "set CAML_DEBUG_SOCKET=%s && %s %s %s" + Printf.sprintf "%sset CAML_DEBUG_SOCKET=%s && %s %s %s" + (get_win32_environment ()) !socket_name runtime_program !program_name @@ -105,7 +137,8 @@ match Sys.os_type with "Win32" -> (* See the comment above *) - Printf.sprintf "set CAML_DEBUG_SOCKET=%s && %s %s" + Printf.sprintf "%sset CAML_DEBUG_SOCKET=%s && %s %s" + (get_win32_environment ()) !socket_name !program_name !arguments diff -Nru ocaml-3.12.1/debugger/program_loading.mli ocaml-4.01.0/debugger/program_loading.mli --- ocaml-3.12.1/debugger/program_loading.mli 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/debugger/program_loading.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: program_loading.mli 2553 1999-11-17 18:59:06Z xleroy $ *) - (*** Debugging. ***) val debug_loading : bool ref diff -Nru ocaml-3.12.1/debugger/program_management.ml ocaml-4.01.0/debugger/program_management.ml --- ocaml-3.12.1/debugger/program_management.ml 2010-05-21 12:00:49.000000000 +0000 +++ ocaml-4.01.0/debugger/program_management.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: program_management.ml 10450 2010-05-21 12:00:49Z doligez $ *) - (* Manage the loading of the program *) open Int64ops @@ -116,8 +114,10 @@ (*** Program loading and initializations. ***) let initialize_loading () = - if !debug_loading then + if !debug_loading then begin prerr_endline "Loading debugging information..."; + Printf.fprintf Pervasives.stderr "\tProgram: [%s]\n%!" !program_name; + end; begin try access !program_name [F_OK] with Unix_error _ -> prerr_endline "Program not found."; diff -Nru ocaml-3.12.1/debugger/program_management.mli ocaml-4.01.0/debugger/program_management.mli --- ocaml-3.12.1/debugger/program_management.mli 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/debugger/program_management.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: program_management.mli 2553 1999-11-17 18:59:06Z xleroy $ *) - (*** Program loading and initializations. ***) val loaded : bool ref diff -Nru ocaml-3.12.1/debugger/question.ml ocaml-4.01.0/debugger/question.ml --- ocaml-3.12.1/debugger/question.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/debugger/question.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,3 +1,15 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Nicolas Pouillard, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2006 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + open Input_handling open Primitives diff -Nru ocaml-3.12.1/debugger/question.mli ocaml-4.01.0/debugger/question.mli --- ocaml-3.12.1/debugger/question.mli 2006-12-09 13:49:56.000000000 +0000 +++ ocaml-4.01.0/debugger/question.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,2 +1,14 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Nicolas Pouillard, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2006 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + (* Ask user a yes or no question. *) val yes_or_no : string -> bool diff -Nru ocaml-3.12.1/debugger/show_information.ml ocaml-4.01.0/debugger/show_information.ml --- ocaml-3.12.1/debugger/show_information.ml 2010-01-20 16:26:46.000000000 +0000 +++ ocaml-4.01.0/debugger/show_information.ml 2012-10-17 12:26:42.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: show_information.ml 9540 2010-01-20 16:26:46Z doligez $ *) - open Instruct open Format open Debugcom @@ -26,10 +24,10 @@ (* Display information about the current event. *) let show_current_event ppf = - fprintf ppf "Time : %Li" (current_time ()); + fprintf ppf "Time: %Li" (current_time ()); (match current_pc () with | Some pc -> - fprintf ppf " - pc : %i" pc + fprintf ppf " - pc: %i" pc | _ -> ()); update_current_event (); reset_frame (); @@ -44,9 +42,9 @@ | [] -> () | [breakpoint] -> - fprintf ppf "Breakpoint : %i@." breakpoint + fprintf ppf "Breakpoint: %i@." breakpoint | breakpoints -> - fprintf ppf "Breakpoints : %a@." + fprintf ppf "Breakpoints: %a@." (fun ppf l -> List.iter (function x -> fprintf ppf "%i " x) l) @@ -75,7 +73,7 @@ let buffer = get_buffer pos event.ev_module in snd (start_and_cnum buffer pos) with _ -> pos.Lexing.pos_cnum in - fprintf ppf "#%i Pc : %i %s char %i@." + fprintf ppf "#%i Pc: %i %s char %i@." framenum event.ev_pos event.ev_module cnum @@ -90,9 +88,9 @@ begin match breakpoints_at_pc sel_ev.ev_pos with | [] -> () | [breakpoint] -> - fprintf ppf "Breakpoint : %i@." breakpoint + fprintf ppf "Breakpoint: %i@." breakpoint | breakpoints -> - fprintf ppf "Breakpoints : %a@." + fprintf ppf "Breakpoints: %a@." (fun ppf l -> List.iter (function x -> fprintf ppf "%i " x) l) (List.sort compare breakpoints); diff -Nru ocaml-3.12.1/debugger/show_information.mli ocaml-4.01.0/debugger/show_information.mli --- ocaml-3.12.1/debugger/show_information.mli 2000-03-06 22:12:09.000000000 +0000 +++ ocaml-4.01.0/debugger/show_information.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: show_information.mli 2908 2000-03-06 22:12:09Z weis $ *) - open Format;; (* Display information about the current event. *) diff -Nru ocaml-3.12.1/debugger/show_source.ml ocaml-4.01.0/debugger/show_source.ml --- ocaml-3.12.1/debugger/show_source.ml 2010-01-20 16:26:46.000000000 +0000 +++ ocaml-4.01.0/debugger/show_source.ml 2013-03-22 18:18:26.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: show_source.ml 9540 2010-01-20 16:26:46Z doligez $ *) - open Debugger_config open Instruct open Parameters @@ -77,7 +75,8 @@ let buffer = get_buffer pos mdle in let rec aff (line_start, line_number) = if line_number <= stop then - aff (print_line buffer line_number line_start point before + 1, line_number + 1) + aff (print_line buffer line_number line_start point before + 1, + line_number + 1) in aff (pos_of_line buffer start) with diff -Nru ocaml-3.12.1/debugger/show_source.mli ocaml-4.01.0/debugger/show_source.mli --- ocaml-3.12.1/debugger/show_source.mli 2006-12-09 13:49:10.000000000 +0000 +++ ocaml-4.01.0/debugger/show_source.mli 2013-03-22 18:18:26.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: show_source.mli 7767 2006-12-09 13:49:10Z ertai $ *) - (* Print the line containing the point *) val show_point : Instruct.debug_event -> bool -> unit;; @@ -20,4 +18,6 @@ val show_no_point : unit -> unit;; (* Display part of the source. *) -val show_listing : Lexing.position -> string -> int -> int -> int -> bool -> unit;; +val show_listing : + Lexing.position -> string -> int -> int -> int -> bool -> unit +;; diff -Nru ocaml-3.12.1/debugger/source.ml ocaml-4.01.0/debugger/source.ml --- ocaml-3.12.1/debugger/source.ml 2010-01-20 16:26:46.000000000 +0000 +++ ocaml-4.01.0/debugger/source.ml 2013-03-09 22:38:52.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: source.ml 9540 2010-01-20 16:26:46Z doligez $ *) - (************************ Source management ****************************) open Misc @@ -28,7 +26,7 @@ try (String.sub m 0 len') = m' && (String.get m len') = '.' with - Invalid_argument _ -> false in + Invalid_argument _ -> false in let path = Hashtbl.fold (fun mdl dirs acc -> @@ -43,16 +41,16 @@ let innermost_module = try let dot_index = String.rindex mdle '.' in - String.sub mdle (succ dot_index) (pred ((String.length mdle) - dot_index)) + String.sub mdle (succ dot_index) (pred (String.length mdle - dot_index)) with Not_found -> mdle in let rec loop = function - | [] -> raise Not_found - | ext :: exts -> + | [] -> raise Not_found + | ext :: exts -> try find_in_path_uncap path (innermost_module ^ ext) with Not_found -> loop exts in loop source_extensions - else if Filename.is_implicit fname then + else if Filename.is_implicit fname then find_in_path path fname else fname @@ -76,13 +74,11 @@ try List.assoc mdle !buffer_list with Not_found -> let inchan = open_in_bin (source_of_module pos mdle) in - let (content, _) as buffer = - (String.create (in_channel_length inchan), ref []) - in - unsafe_really_input inchan content 0 (in_channel_length inchan); - buffer_list := - (list_truncate !buffer_max_count ((mdle, buffer)::!buffer_list)); - buffer + let content = Misc.input_bytes inchan (in_channel_length inchan) in + let buffer = (content, ref []) in + buffer_list := + (list_truncate !buffer_max_count ((mdle, buffer)::!buffer_list)); + buffer let buffer_content = (fst : buffer -> string) diff -Nru ocaml-3.12.1/debugger/source.mli ocaml-4.01.0/debugger/source.mli --- ocaml-3.12.1/debugger/source.mli 2010-01-20 16:26:46.000000000 +0000 +++ ocaml-4.01.0/debugger/source.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: source.mli 9540 2010-01-20 16:26:46Z doligez $ *) - (************************ Source management ****************************) (*** Conversion function. ***) diff -Nru ocaml-3.12.1/debugger/symbols.ml ocaml-4.01.0/debugger/symbols.ml --- ocaml-3.12.1/debugger/symbols.ml 2010-01-20 16:26:46.000000000 +0000 +++ ocaml-4.01.0/debugger/symbols.ml 2013-03-09 22:38:52.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: symbols.ml 9540 2010-01-20 16:26:46Z doligez $ *) - (* Handling of symbol tables (globals and events) *) open Instruct @@ -65,7 +63,8 @@ begin try ignore (Bytesections.seek_section ic "CODE") with Not_found -> - (* The file contains only debugging info, loading mode is forced to "manual" *) + (* The file contains only debugging info, + loading mode is forced to "manual" *) set_launching_function (List.assoc "manual" loading_modes) end; close_in_noerr ic; diff -Nru ocaml-3.12.1/debugger/symbols.mli ocaml-4.01.0/debugger/symbols.mli --- ocaml-3.12.1/debugger/symbols.mli 2005-08-25 15:35:16.000000000 +0000 +++ ocaml-4.01.0/debugger/symbols.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: symbols.mli 7031 2005-08-25 15:35:16Z doligez $ *) - (* Modules used by the program. *) val modules : string list ref diff -Nru ocaml-3.12.1/debugger/time_travel.ml ocaml-4.01.0/debugger/time_travel.ml --- ocaml-3.12.1/debugger/time_travel.ml 2009-05-20 11:52:42.000000000 +0000 +++ ocaml-4.01.0/debugger/time_travel.ml 2013-03-09 22:38:52.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: time_travel.ml 9270 2009-05-20 11:52:42Z doligez $ *) - (**************************** Time travel ******************************) open Int64ops @@ -94,7 +92,7 @@ (* Select a checkpoint as current. *) let set_current_checkpoint checkpoint = if !debug_time_travel then - prerr_endline ("Select : " ^ (string_of_int checkpoint.c_pid)); + prerr_endline ("Select: " ^ (string_of_int checkpoint.c_pid)); if not checkpoint.c_valid then wait_for_connection checkpoint; current_checkpoint := checkpoint; @@ -103,7 +101,7 @@ (* Kill `checkpoint'. *) let kill_checkpoint checkpoint = if !debug_time_travel then - prerr_endline ("Kill : " ^ (string_of_int checkpoint.c_pid)); + prerr_endline ("Kill: " ^ (string_of_int checkpoint.c_pid)); if checkpoint.c_pid > 0 then (* Ghosts don't have to be killed ! *) (if not checkpoint.c_valid then wait_for_connection checkpoint; @@ -240,7 +238,7 @@ Checkpoint_done pid -> (new_checkpoint.c_pid <- pid; if !debug_time_travel then - prerr_endline ("Waiting for connection : " ^ (string_of_int pid))) + prerr_endline ("Waiting for connection: " ^ string_of_int pid)) | Checkpoint_failed -> prerr_endline "A fork failed. Reducing maximum number of checkpoints."; @@ -326,7 +324,7 @@ set_current_checkpoint (find_checkpoint_before (current_time ())))); if !debug_time_travel then begin - print_string "Checkpoints : pid(time)"; print_newline (); + print_string "Checkpoints: pid(time)"; print_newline (); List.iter (function {c_time = time; c_pid = pid; c_valid = valid} -> Printf.printf "%d(%Ld)%s " pid time @@ -372,7 +370,7 @@ true) in if !debug_time_travel then - prerr_endline ("New connection : " ^(string_of_int pid)); + prerr_endline ("New connection: " ^(string_of_int pid)); find (!current_checkpoint::!checkpoints) (* Kill all the checkpoints. *) diff -Nru ocaml-3.12.1/debugger/time_travel.mli ocaml-4.01.0/debugger/time_travel.mli --- ocaml-3.12.1/debugger/time_travel.mli 2006-11-20 10:29:45.000000000 +0000 +++ ocaml-4.01.0/debugger/time_travel.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: time_travel.mli 7745 2006-11-20 10:29:45Z ertai $ *) - (**************************** Time travel ******************************) open Primitives diff -Nru ocaml-3.12.1/debugger/trap_barrier.ml ocaml-4.01.0/debugger/trap_barrier.ml --- ocaml-3.12.1/debugger/trap_barrier.ml 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/debugger/trap_barrier.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: trap_barrier.ml 2553 1999-11-17 18:59:06Z xleroy $ *) - (************************** Trap barrier *******************************) open Debugcom diff -Nru ocaml-3.12.1/debugger/trap_barrier.mli ocaml-4.01.0/debugger/trap_barrier.mli --- ocaml-3.12.1/debugger/trap_barrier.mli 1999-11-17 18:59:06.000000000 +0000 +++ ocaml-4.01.0/debugger/trap_barrier.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: trap_barrier.mli 2553 1999-11-17 18:59:06Z xleroy $ *) - (************************* Trap barrier ********************************) val install_trap_barrier : int -> unit diff -Nru ocaml-3.12.1/debugger/unix_tools.ml ocaml-4.01.0/debugger/unix_tools.ml --- ocaml-3.12.1/debugger/unix_tools.ml 2009-05-20 11:52:42.000000000 +0000 +++ ocaml-4.01.0/debugger/unix_tools.ml 2012-10-17 12:26:42.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: unix_tools.ml 9270 2009-05-20 11:52:42Z doligez $ *) - (****************** Tools for Unix *************************************) open Misc @@ -30,7 +28,7 @@ ADDR_INET ((try inet_addr_of_string host with Failure _ -> try (gethostbyname host).h_addr_list.(0) with Not_found -> - prerr_endline ("Unknown host : " ^ host); + prerr_endline ("Unknown host: " ^ host); failwith "Can't convert address"), (try int_of_string port with Failure _ -> prerr_endline "The port number should be an integer"; @@ -43,14 +41,14 @@ (*** Report a unix error. ***) let report_error = function | Unix_error (err, fun_name, arg) -> - prerr_string "Unix error : '"; + prerr_string "Unix error: '"; prerr_string fun_name; prerr_string "' failed"; if String.length arg > 0 then (prerr_string " on '"; prerr_string arg; prerr_string "'"); - prerr_string " : "; + prerr_string ": "; prerr_endline (error_message err) | _ -> fatal_error "report_error: not a Unix error" @@ -58,6 +56,7 @@ (* Return the full path if found. *) (* Raise `Not_found' otherwise. *) let search_in_path name = + Printf.fprintf Pervasives.stderr "search_in_path [%s]\n%!" name; let check name = try access name [X_OK]; name with Unix_error _ -> raise Not_found in diff -Nru ocaml-3.12.1/debugger/unix_tools.mli ocaml-4.01.0/debugger/unix_tools.mli --- ocaml-3.12.1/debugger/unix_tools.mli 2002-11-02 22:36:46.000000000 +0000 +++ ocaml-4.01.0/debugger/unix_tools.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,9 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *) -(* Objective Caml port by John Malecki and Xavier Leroy *) +(* OCaml port by John Malecki and Xavier Leroy *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: unix_tools.mli 5232 2002-11-02 22:36:46Z doligez $ *) - (**************************** Tools for Unix ***************************) open Unix diff -Nru ocaml-3.12.1/driver/compenv.ml ocaml-4.01.0/driver/compenv.ml --- ocaml-3.12.1/driver/compenv.ml 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/driver/compenv.ml 2013-07-23 14:48:47.000000000 +0000 @@ -0,0 +1,271 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Fabrice Le Fessant, EPI Gallium, INRIA Paris-Rocquencourt *) +(* *) +(* Copyright 2013 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +open Clflags + +let output_prefix name = + let oname = + match !output_name with + | None -> name + | Some n -> if !compile_only then (output_name := None; n) else name in + Misc.chop_extension_if_any oname + +let print_version_and_library compiler = + Printf.printf "The OCaml %s, version " compiler; + print_string Config.version; print_newline(); + print_string "Standard library directory: "; + print_string Config.standard_library; print_newline(); + exit 0 + +let print_version_string () = + print_string Config.version; print_newline(); exit 0 + +let print_standard_library () = + print_string Config.standard_library; print_newline(); exit 0 + +let fatal err = + prerr_endline err; + exit 2 + +let extract_output = function + | Some s -> s + | None -> + fatal "Please specify the name of the output file, using option -o" + +let default_output = function + | Some s -> s + | None -> Config.default_executable_name + +let implicit_modules = ref [] +let first_include_dirs = ref [] +let last_include_dirs = ref [] +let first_ccopts = ref [] +let last_ccopts = ref [] +let first_ppx = ref [] +let last_ppx = ref [] +let first_objfiles = ref [] +let last_objfiles = ref [] + +(* Note: this function is duplicated in optcompile.ml *) +let check_unit_name ppf filename name = + try + begin match name.[0] with + | 'A'..'Z' -> () + | _ -> + Location.print_warning (Location.in_file filename) ppf + (Warnings.Bad_module_name name); + raise Exit; + end; + for i = 1 to String.length name - 1 do + match name.[i] with + | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> () + | _ -> + Location.print_warning (Location.in_file filename) ppf + (Warnings.Bad_module_name name); + raise Exit; + done; + with Exit -> () +;; + + + + + + + +type readenv_position = + Before_args | Before_compile | Before_link + +(* Syntax of OCAMLPARAM: (name=VALUE,)* _ (,name=VALUE)* + where VALUE should not contain ',' *) +exception SyntaxError of string + +let parse_args s = + let args = Misc.split s ',' in + let rec iter is_after args before after = + match args with + [] -> + if not is_after then + raise (SyntaxError "no '_' separator found") + else + (List.rev before, List.rev after) + | "_" :: _ when is_after -> raise (SyntaxError "too many '_' separators") + | "_" :: tail -> iter true tail before after + | arg :: tail -> + let binding = try + Misc.cut_at arg '=' + with Not_found -> + raise (SyntaxError ("missing '=' in " ^ arg)) + in + if is_after then + iter is_after tail before (binding :: after) + else + iter is_after tail (binding :: before) after + in + iter false args [] [] + +let setter ppf f name options s = + try + let bool = match s with + | "0" -> false + | "1" -> true + | _ -> raise Not_found + in + List.iter (fun b -> b := f bool) options + with Not_found -> + Location.print_warning Location.none ppf + (Warnings.Bad_env_variable ("OCAMLPARAM", + Printf.sprintf "bad value for %s" name)) + +let read_OCAMLPARAM ppf position = + try + let s = Sys.getenv "OCAMLPARAM" in + let (before, after) = + try + parse_args s + with SyntaxError s -> + Location.print_warning Location.none ppf + (Warnings.Bad_env_variable ("OCAMLPARAM", s)); + [],[] + in + + let set name options s = setter ppf (fun b -> b) name options s in + let clear name options s = setter ppf (fun b -> not b) name options s in + List.iter (fun (name, v) -> + match name with + | "g" -> set "g" [ Clflags.debug ] v + | "p" -> set "p" [ Clflags.gprofile ] v + | "bin-annot" -> set "bin-annot" [ Clflags.binary_annotations ] v + | "annot" -> set "annot" [ Clflags.annotations ] v + | "absname" -> set "absname" [ Location.absname ] v + | "compat-32" -> set "compat-32" [ bytecode_compatible_32 ] v + | "noassert" -> set "noassert" [ noassert ] v + | "noautolink" -> set "noautolink" [ no_auto_link ] v + | "nostdlib" -> set "nostdlib" [ no_std_include ] v + | "linkall" -> set "linkall" [ link_everything ] v + | "nolabels" -> set "nolabels" [ classic ] v + | "principal" -> set "principal" [ principal ] v + | "rectypes" -> set "rectypes" [ recursive_types ] v + | "strict-sequence" -> set "strict-sequence" [ strict_sequence ] v + | "thread" -> set "thread" [ use_threads ] v + | "unsafe" -> set "unsafe" [ fast ] v + | "verbose" -> set "verbose" [ verbose ] v + | "nopervasives" -> set "nopervasives" [ nopervasives ] v + | "slash" -> set "slash" [ force_slash ] v (* for ocamldep *) + + | "compact" -> clear "compact" [ optimize_for_speed ] v + | "no-app-funct" -> clear "no-app-funct" [ applicative_functors ] v + | "nodynlink" -> clear "nodynlink" [ dlcode ] v + | "short-paths" -> clear "short-paths" [ real_paths ] v + + | "pp" -> preprocessor := Some v + | "runtime-variant" -> runtime_variant := v + | "cc" -> c_compiler := Some v + + (* assembly sources *) + | "s" -> + set "s" [ Clflags.keep_asm_file ; Clflags.keep_startup_file ] v + | "S" -> set "S" [ Clflags.keep_asm_file ] v + | "dstartup" -> set "dstartup" [ Clflags.keep_startup_file ] v + + (* warn-errors *) + | "we" | "warn-error" -> Warnings.parse_options true v + (* warnings *) + | "w" -> Warnings.parse_options false v + (* warn-errors *) + | "wwe" -> Warnings.parse_options false v + + (* inlining *) + | "inline" -> begin try + inline_threshold := 8 * int_of_string v + with _ -> + Location.print_warning Location.none ppf + (Warnings.Bad_env_variable ("OCAMLPARAM", + "non-integer parameter for \"inline\"")) + end + + | "intf-suffix" -> Config.interface_suffix := v + + | "I" -> begin + match position with + | Before_args -> first_include_dirs := v :: !first_include_dirs + | Before_link | Before_compile -> + last_include_dirs := v :: !last_include_dirs + end + + | "cclib" -> + begin + match position with + | Before_compile -> () + | Before_link | Before_args -> + ccobjs := Misc.rev_split_words v @ !ccobjs + end + + | "ccopts" -> + begin + match position with + | Before_link | Before_compile -> + last_ccopts := v :: !last_ccopts + | Before_args -> + first_ccopts := v :: !first_ccopts + end + + | "ppx" -> + begin + match position with + | Before_link | Before_compile -> + last_ppx := v :: !last_ppx + | Before_args -> + first_ppx := v :: !first_ppx + end + + + | "cmo" | "cma" -> + if not !native_code then + begin + match position with + | Before_link | Before_compile -> + last_objfiles := v ::! last_objfiles + | Before_args -> + first_objfiles := v :: !first_objfiles + end + + | "cmx" | "cmxa" -> + if !native_code then + begin + match position with + | Before_link | Before_compile -> + last_objfiles := v ::! last_objfiles + | Before_args -> + first_objfiles := v :: !first_objfiles + end + + | _ -> + Printf.eprintf + "Warning: discarding value of variable %S in OCAMLPARAM\n%!" + name + ) (match position with + Before_args -> before + | Before_compile | Before_link -> after) + with Not_found -> () + +let readenv ppf position = + last_include_dirs := []; + last_ccopts := []; + last_ppx := []; + last_objfiles := []; + read_OCAMLPARAM ppf position; + all_ccopts := !last_ccopts @ !first_ccopts; + all_ppx := !last_ppx @ !first_ppx + +let get_objfiles () = + List.rev (!last_objfiles @ !objfiles @ !first_objfiles) diff -Nru ocaml-3.12.1/driver/compenv.mli ocaml-4.01.0/driver/compenv.mli --- ocaml-3.12.1/driver/compenv.mli 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/driver/compenv.mli 2013-07-17 12:35:50.000000000 +0000 @@ -0,0 +1,36 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Fabrice Le Fessant, EPI Gallium, INRIA Paris-Rocquencourt *) +(* *) +(* Copyright 2013 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +val check_unit_name : Format.formatter -> string -> string -> unit + +val output_prefix : string -> string +val extract_output : string option -> string +val default_output : string option -> string + +val print_version_and_library : string -> 'a +val print_version_string : unit -> 'a +val print_standard_library : unit -> 'a +val fatal : string -> 'a + +val first_ccopts : string list ref +val first_ppx : string list ref +val first_include_dirs : string list ref +val last_include_dirs : string list ref +val implicit_modules : string list ref + +(* return the list of objfiles, after OCAMLPARAM and List.rev *) +val get_objfiles : unit -> string list + +type readenv_position = + Before_args | Before_compile | Before_link + +val readenv : Format.formatter -> readenv_position -> unit diff -Nru ocaml-3.12.1/driver/compile.ml ocaml-4.01.0/driver/compile.ml --- ocaml-3.12.1/driver/compile.ml 2008-10-06 13:53:54.000000000 +0000 +++ ocaml-4.01.0/driver/compile.ml 2013-06-05 16:34:40.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,89 +10,48 @@ (* *) (***********************************************************************) -(* $Id: compile.ml 9074 2008-10-06 13:53:54Z doligez $ *) - (* The batch compiler *) open Misc open Config open Format open Typedtree - -(* Initialize the search path. - The current directory is always searched first, - then the directories specified with the -I option (in command-line order), - then the standard library directory (unless the -nostdlib option is given). - *) - -let init_path () = - let dirs = - if !Clflags.use_threads then "+threads" :: !Clflags.include_dirs - else if !Clflags.use_vmthreads then "+vmthreads" :: !Clflags.include_dirs - else !Clflags.include_dirs in - let exp_dirs = - List.map (expand_directory Config.standard_library) dirs in - load_path := "" :: List.rev_append exp_dirs (Clflags.std_include_dir ()); - Env.reset_cache () - -(* Return the initial environment in which compilation proceeds. *) - -(* Note: do not do init_path() in initial_env, this breaks - toplevel initialization (PR#1775) *) -let initial_env () = - Ident.reinit(); - try - if !Clflags.nopervasives - then Env.initial - else Env.open_pers_signature "Pervasives" Env.initial - with Not_found -> - fatal_error "cannot open pervasives.cmi" - -(* Note: this function is duplicated in optcompile.ml *) -let check_unit_name ppf filename name = - try - begin match name.[0] with - | 'A'..'Z' -> () - | _ -> - Location.print_warning (Location.in_file filename) ppf - (Warnings.Bad_module_name name); - raise Exit; - end; - for i = 1 to String.length name - 1 do - match name.[i] with - | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> () - | _ -> - Location.print_warning (Location.in_file filename) ppf - (Warnings.Bad_module_name name); - raise Exit; - done; - with Exit -> () -;; +open Compenv (* Compile a .mli file *) let interface ppf sourcefile outputprefix = Location.input_name := sourcefile; - init_path (); + Compmisc.init_path false; let modulename = String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in check_unit_name ppf sourcefile modulename; Env.set_unit_name modulename; let inputfile = Pparse.preprocess sourcefile in + let initial_env = Compmisc.initial_env () in try let ast = Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast; - let sg = Typemod.transl_signature (initial_env()) ast in + if !Clflags.dump_source then fprintf ppf "%a@." Pprintast.signature ast; + let tsg = Typemod.transl_signature initial_env ast in + if !Clflags.dump_typedtree then fprintf ppf "%a@." Printtyped.interface tsg; + let sg = tsg.sig_type in if !Clflags.print_types then - fprintf std_formatter "%a@." Printtyp.signature - (Typemod.simplify_signature sg); + Printtyp.wrap_printing_env initial_env (fun () -> + fprintf std_formatter "%a@." + Printtyp.signature (Typemod.simplify_signature sg)); + ignore (Includemod.signatures initial_env sg sg); + Typecore.force_delayed_checks (); Warnings.check_fatal (); - if not !Clflags.print_types then - Env.save_signature sg modulename (outputprefix ^ ".cmi"); + if not !Clflags.print_types then begin + let sg = Env.save_signature sg modulename (outputprefix ^ ".cmi") in + Typemod.save_signature modulename tsg outputprefix sourcefile + initial_env sg ; + end; Pparse.remove_preprocessed inputfile with e -> - Pparse.remove_preprocessed_if_ast inputfile; + Pparse.remove_preprocessed inputfile; raise e (* Compile a .ml file *) @@ -105,20 +64,27 @@ let implementation ppf sourcefile outputprefix = Location.input_name := sourcefile; - init_path (); + Compmisc.init_path false; let modulename = String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in check_unit_name ppf sourcefile modulename; Env.set_unit_name modulename; let inputfile = Pparse.preprocess sourcefile in - let env = initial_env() in + let env = Compmisc.initial_env() in if !Clflags.print_types then begin try ignore( Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number ++ print_if ppf Clflags.dump_parsetree Printast.implementation - ++ Typemod.type_implementation sourcefile outputprefix modulename env) + ++ print_if ppf Clflags.dump_source Pprintast.structure + ++ Typemod.type_implementation sourcefile outputprefix modulename env + ++ print_if ppf Clflags.dump_typedtree + Printtyped.implementation_with_coercion); + Warnings.check_fatal (); + Pparse.remove_preprocessed inputfile; + Stypes.dump (Some (outputprefix ^ ".annot")); with x -> - Pparse.remove_preprocessed_if_ast inputfile; + Pparse.remove_preprocessed inputfile; + Stypes.dump (Some (outputprefix ^ ".annot")); raise x end else begin let objfile = outputprefix ^ ".cmo" in @@ -126,8 +92,10 @@ try Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number ++ print_if ppf Clflags.dump_parsetree Printast.implementation - ++ Unused_var.warn ppf + ++ print_if ppf Clflags.dump_source Pprintast.structure ++ Typemod.type_implementation sourcefile outputprefix modulename env + ++ print_if ppf Clflags.dump_typedtree + Printtyped.implementation_with_coercion ++ Translmod.transl_implementation modulename ++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda ++ Simplif.simplify_lambda @@ -138,12 +106,12 @@ Warnings.check_fatal (); close_out oc; Pparse.remove_preprocessed inputfile; - Stypes.dump (outputprefix ^ ".annot"); + Stypes.dump (Some (outputprefix ^ ".annot")); with x -> close_out oc; remove_file objfile; - Pparse.remove_preprocessed_if_ast inputfile; - Stypes.dump (outputprefix ^ ".annot"); + Pparse.remove_preprocessed inputfile; + Stypes.dump (Some (outputprefix ^ ".annot")); raise x end diff -Nru ocaml-3.12.1/driver/compile.mli ocaml-4.01.0/driver/compile.mli --- ocaml-3.12.1/driver/compile.mli 2004-06-13 12:46:41.000000000 +0000 +++ ocaml-4.01.0/driver/compile.mli 2013-06-05 16:34:40.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: compile.mli 6395 2004-06-13 12:46:41Z xleroy $ *) - (* Compile a .ml or .mli file *) open Format @@ -19,6 +17,3 @@ val interface: formatter -> string -> string -> unit val implementation: formatter -> string -> string -> unit val c_file: string -> unit - -val initial_env: unit -> Env.t -val init_path: unit -> unit diff -Nru ocaml-3.12.1/driver/compmisc.ml ocaml-4.01.0/driver/compmisc.ml --- ocaml-3.12.1/driver/compmisc.ml 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/driver/compmisc.ml 2013-07-09 13:20:20.000000000 +0000 @@ -0,0 +1,58 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Fabrice Le Fessant, EPI Gallium, INRIA Paris-Rocquencourt *) +(* *) +(* Copyright 2013 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +open Compenv + +(* Initialize the search path. + The current directory is always searched first, + then the directories specified with the -I option (in command-line order), + then the standard library directory (unless the -nostdlib option is given). + *) + +let init_path native = + let dirs = + if !Clflags.use_threads then "+threads" :: !Clflags.include_dirs + else if !Clflags.use_vmthreads && not native then + "+vmthreads" :: !Clflags.include_dirs + else + !last_include_dirs @ + !Clflags.include_dirs @ + !first_include_dirs + in + let exp_dirs = + List.map (Misc.expand_directory Config.standard_library) dirs in + Config.load_path := "" :: + List.rev_append exp_dirs (Clflags.std_include_dir ()); + Env.reset_cache () + +(* Return the initial environment in which compilation proceeds. *) + +(* Note: do not do init_path() in initial_env, this breaks + toplevel initialization (PR#1775) *) + +let open_implicit_module m env = + try + Env.open_pers_signature m env + with Not_found -> + Misc.fatal_error (Printf.sprintf "cannot open implicit module %S" m) + +let initial_env () = + Ident.reinit(); + let env = + if !Clflags.nopervasives + then Env.initial + else + open_implicit_module "Pervasives" Env.initial + in + List.fold_left (fun env m -> + open_implicit_module m env + ) env !implicit_modules diff -Nru ocaml-3.12.1/driver/compmisc.mli ocaml-4.01.0/driver/compmisc.mli --- ocaml-3.12.1/driver/compmisc.mli 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/driver/compmisc.mli 2013-07-09 13:20:20.000000000 +0000 @@ -0,0 +1,14 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Fabrice Le Fessant, EPI Gallium, INRIA Paris-Rocquencourt *) +(* *) +(* Copyright 2013 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +val init_path : bool -> unit +val initial_env : unit -> Env.t diff -Nru ocaml-3.12.1/driver/errors.ml ocaml-4.01.0/driver/errors.ml --- ocaml-3.12.1/driver/errors.ml 2007-12-04 13:38:58.000000000 +0000 +++ ocaml-4.01.0/driver/errors.ml 2013-08-20 15:32:13.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: errors.ml 8705 2007-12-04 13:38:58Z doligez $ *) - (* WARNING: if you change something in this file, you must look at opterrors.ml and ocamldoc/odoc_analyse.ml to see if you need to make the same changes there. @@ -28,30 +26,32 @@ Lexer.report_error ppf err | Syntaxerr.Error err -> Syntaxerr.report_error ppf err - | Pparse.Error -> - Location.print_error_cur_file ppf; - fprintf ppf "Preprocessor error" + | Pparse.Error err -> + Pparse.report_error ppf err | Env.Error err -> Location.print_error_cur_file ppf; Env.report_error ppf err + | Cmi_format.Error err -> + Location.print_error_cur_file ppf; + Cmi_format.report_error ppf err | Ctype.Tags(l, l') -> Location.print_error_cur_file ppf; fprintf ppf "In this program,@ variant constructors@ `%s and `%s@ \ have the same hash value.@ Change one of them." l l' - | Typecore.Error(loc, err) -> - Location.print_error ppf loc; Typecore.report_error ppf err - | Typetexp.Error(loc, err) -> - Location.print_error ppf loc; Typetexp.report_error ppf err + | Typecore.Error(loc, env, err) -> + Location.print_error ppf loc; Typecore.report_error env ppf err + | Typetexp.Error(loc, env, err) -> + Location.print_error ppf loc; Typetexp.report_error env ppf err | Typedecl.Error(loc, err) -> Location.print_error ppf loc; Typedecl.report_error ppf err - | Typeclass.Error(loc, err) -> - Location.print_error ppf loc; Typeclass.report_error ppf err + | Typeclass.Error(loc, env, err) -> + Location.print_error ppf loc; Typeclass.report_error env ppf err | Includemod.Error err -> Location.print_error_cur_file ppf; Includemod.report_error ppf err - | Typemod.Error(loc, err) -> - Location.print_error ppf loc; Typemod.report_error ppf err + | Typemod.Error(loc, env, err) -> + Location.print_error ppf loc; Typemod.report_error env ppf err | Translcore.Error(loc, err) -> Location.print_error ppf loc; Translcore.report_error ppf err | Translclass.Error(loc, err) -> @@ -75,7 +75,7 @@ fprintf ppf "I/O error: %s" msg | Warnings.Errors (n) -> Location.print_error_cur_file ppf; - fprintf ppf "Error-enabled warnings (%d occurrences)" n + fprintf ppf "Some fatal warnings were triggered (%d occurrences)" n | x -> fprintf ppf "@]"; raise x in fprintf ppf "@[%a@]@." report exn diff -Nru ocaml-3.12.1/driver/errors.mli ocaml-4.01.0/driver/errors.mli --- ocaml-3.12.1/driver/errors.mli 2000-03-06 22:12:09.000000000 +0000 +++ ocaml-4.01.0/driver/errors.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: errors.mli 2908 2000-03-06 22:12:09Z weis $ *) - (* Error report *) open Format diff -Nru ocaml-3.12.1/driver/main.ml ocaml-4.01.0/driver/main.ml --- ocaml-3.12.1/driver/main.ml 2010-05-20 14:06:29.000000000 +0000 +++ ocaml-4.01.0/driver/main.ml 2013-08-20 15:32:13.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,17 +10,9 @@ (* *) (***********************************************************************) -(* $Id: main.ml 10444 2010-05-20 14:06:29Z doligez $ *) - open Config open Clflags - -let output_prefix name = - let oname = - match !output_name with - | None -> name - | Some n -> if !compile_only then (output_name := None; n) else name in - Misc.chop_extension_if_any oname +open Compenv let process_interface_file ppf name = Compile.interface ppf name (output_prefix name) @@ -60,25 +52,17 @@ else raise(Arg.Bad("don't know what to do with " ^ name)) -let print_version_and_library () = - print_string "The Objective Caml compiler, version "; - print_string Config.version; print_newline(); - print_string "Standard library directory: "; - print_string Config.standard_library; print_newline(); - exit 0 - -let print_version_string () = - print_string Config.version; print_newline(); exit 0 - -let print_standard_library () = - print_string Config.standard_library; print_newline(); exit 0 - let usage = "Usage: ocamlc \nOptions are:" +let ppf = Format.err_formatter + (* Error messages to standard error formatter *) -let anonymous = process_file Format.err_formatter;; -let impl = process_implementation_file Format.err_formatter;; -let intf = process_interface_file Format.err_formatter;; +let anonymous filename = + readenv ppf Before_compile; process_file ppf filename;; +let impl filename = + readenv ppf Before_compile; process_implementation_file ppf filename;; +let intf filename = + readenv ppf Before_compile; process_interface_file ppf filename;; let show_config () = Config.print_config stdout; @@ -89,11 +73,14 @@ let set r () = r := true let unset r () = r := false let _a = set make_archive + let _absname = set Location.absname let _annot = set annotations + let _binannot = set binary_annotations let _c = set compile_only let _cc s = c_compiler := Some s let _cclib s = ccobjs := Misc.rev_split_words s @ !ccobjs - let _ccopt s = ccopts := s :: !ccopts + let _ccopt s = first_ccopts := s :: !first_ccopts + let _compat_32 = set bytecode_compatible_32 let _config = show_config let _custom = set custom_runtime let _dllib s = dllibs := Misc.rev_split_words s @ !dllibs @@ -117,15 +104,18 @@ let _output_obj () = output_c_object := true; custom_runtime := true let _pack = set make_package let _pp s = preprocessor := Some s + let _ppx s = first_ppx := s :: !first_ppx let _principal = set principal let _rectypes = set recursive_types + let _runtime_variant s = runtime_variant := s + let _short_paths = unset real_paths let _strict_sequence = set strict_sequence let _thread = set use_threads let _vmthread = set use_vmthreads let _unsafe = set fast let _use_prims s = use_prims := s let _use_runtime s = use_runtime := s - let _v = print_version_and_library + let _v () = print_version_and_library "compiler" let _version = print_version_string let _vnum = print_version_string let _w = (Warnings.parse_options false) @@ -134,28 +124,20 @@ let _where = print_standard_library let _verbose = set verbose let _nopervasives = set nopervasives + let _dsource = set dump_source let _dparsetree = set dump_parsetree + let _dtypedtree = set dump_typedtree let _drawlambda = set dump_rawlambda let _dlambda = set dump_lambda let _dinstr = set dump_instr let anonymous = anonymous end) -let fatal err = - prerr_endline err; - exit 2 - -let extract_output = function - | Some s -> s - | None -> fatal "Please specify the name of the output file, using option -o" - -let default_output = function - | Some s -> s - | None -> Config.default_executable_name - let main () = try + readenv ppf Before_args; Arg.parse Options.list anonymous usage; + readenv ppf Before_link; if List.length (List.filter (fun x -> !x) [make_archive;make_package;compile_only;output_c_object]) @@ -165,16 +147,19 @@ fatal "Option -i is incompatible with -pack, -a, -output-obj" else fatal "Please specify at most one of -pack, -a, -c, -output-obj"; - if !make_archive then begin - Compile.init_path(); - Bytelibrarian.create_archive (List.rev !objfiles) - (extract_output !output_name) + Compmisc.init_path false; + + Bytelibrarian.create_archive ppf (Compenv.get_objfiles ()) + (extract_output !output_name); + Warnings.check_fatal (); end else if !make_package then begin - Compile.init_path(); - Bytepackager.package_files (List.rev !objfiles) - (extract_output !output_name) + Compmisc.init_path false; + let extracted_output = extract_output !output_name in + let revd = get_objfiles () in + Bytepackager.package_files ppf revd (extracted_output); + Warnings.check_fatal (); end else if not !compile_only && !objfiles <> [] then begin let target = @@ -193,12 +178,13 @@ else default_output !output_name in - Compile.init_path(); - Bytelink.link (List.rev !objfiles) target + Compmisc.init_path false; + Bytelink.link ppf (get_objfiles ()) target; + Warnings.check_fatal (); end; exit 0 with x -> - Errors.report_error Format.err_formatter x; + Errors.report_error ppf x; exit 2 let _ = main () diff -Nru ocaml-3.12.1/driver/main.mli ocaml-4.01.0/driver/main.mli --- ocaml-3.12.1/driver/main.mli 2000-01-07 16:03:04.000000000 +0000 +++ ocaml-4.01.0/driver/main.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Damien Doligez, projet Moscova, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: main.mli 2740 2000-01-07 16:03:04Z doligez $ *) - (* this "empty" file is here to speed up garbage collection in ocamlc.opt *) diff -Nru ocaml-3.12.1/driver/main_args.ml ocaml-4.01.0/driver/main_args.ml --- ocaml-3.12.1/driver/main_args.ml 2010-07-06 14:05:26.000000000 +0000 +++ ocaml-4.01.0/driver/main_args.ml 2013-08-20 15:32:13.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Damien Doligez, projet Para, INRIA Rocquencourt *) (* *) @@ -10,16 +10,22 @@ (* *) (***********************************************************************) -(* $Id: main_args.ml 10621 2010-07-06 14:05:26Z maranget $ *) - let mk_a f = "-a", Arg.Unit f, " Build a library" ;; +let mk_absname f = + "-absname", Arg.Unit f, " Show absolute filenames in error messages" +;; + let mk_annot f = "-annot", Arg.Unit f, " Save information in .annot" ;; +let mk_binannot f = + "-bin-annot", Arg.Unit f, " Save typedtree in .cmt" +;; + let mk_c f = "-c", Arg.Unit f, " Compile only (do not link)" ;; @@ -33,13 +39,19 @@ ;; let mk_ccopt f = - "-ccopt", Arg.String f, " Pass option to the C compiler and linker" + "-ccopt", Arg.String f, + " Pass option to the C compiler and linker" ;; let mk_compact f = "-compact", Arg.Unit f, " Optimize code size rather than speed" ;; +let mk_compat_32 f = + "-compat-32", Arg.Unit f, + " Check that generated bytecode can run on 32-bit platforms" +;; + let mk_config f = "-config", Arg.Unit f, " Print configuration values and exit" ;; @@ -165,6 +177,11 @@ "-noprompt", Arg.Unit f, " Suppress all prompts" ;; +let mk_nopromptcont f = + "-nopromptcont", Arg.Unit f, + " Suppress prompts for continuation lines of multi-line inputs" +;; + let mk_nostdlib f = "-nostdlib", Arg.Unit f, " Do not add default directory to the list of include directories" @@ -196,6 +213,11 @@ "-pp", Arg.String f, " Pipe sources through preprocessor " ;; +let mk_ppx f = + "-ppx", Arg.String f, + " Pipe abstract syntax trees through preprocessor " +;; + let mk_principal f = "-principal", Arg.Unit f, " Check principality of type inference" ;; @@ -204,10 +226,23 @@ "-rectypes", Arg.Unit f, " Allow arbitrary recursive types" ;; +let mk_runtime_variant f = + "-runtime-variant", Arg.String f, + " Use the variant of the run-time system" +;; + let mk_S f = "-S", Arg.Unit f, " Keep intermediate assembly file" ;; +let mk_short_paths f = + "-short-paths", Arg.Unit f, " Shorten paths in types" +;; + +let mk_stdin f = + "-stdin", Arg.Unit f, " Read script from standard input" +;; + let mk_strict_sequence f = "-strict-sequence", Arg.Unit f, " Left-hand part of a sequence must have type unit" @@ -242,24 +277,24 @@ " Print compiler version and location of standard library and exit" ;; -let mk_version f = - "-version", Arg.Unit f, " Print version and exit" -;; - -let mk_vnum f = - "-vnum", Arg.Unit f, " Print version number and exit" -;; - let mk_verbose f = "-verbose", Arg.Unit f, " Print calls to external commands" ;; +let mk_version f = + "-version", Arg.Unit f, " Print version and exit" +;; + let mk_vmthread f = "-vmthread", Arg.Unit f, " Generate code that supports the threads library with VM-level\n\ \ scheduling" ;; +let mk_vnum f = + "-vnum", Arg.Unit f, " Print version number and exit" +;; + let mk_w f = "-w", Arg.String f, Printf.sprintf @@ -283,7 +318,7 @@ ;; let mk_warn_help f = - "-warn-help", Arg.Unit f, " Show description of warning numbers" + "-warn-help", Arg.Unit f, " Show description of warning numbers" ;; let mk_where f = @@ -302,14 +337,26 @@ "-dparsetree", Arg.Unit f, " (undocumented)" ;; +let mk_dtypedtree f = + "-dtypedtree", Arg.Unit f, " (undocumented)" +;; + let mk_drawlambda f = "-drawlambda", Arg.Unit f, " (undocumented)" ;; +let mk_dsource f = + "-dsource", Arg.Unit f, " (undocumented)" +;; + let mk_dlambda f = "-dlambda", Arg.Unit f, " (undocumented)" ;; +let mk_dclambda f = + "-dclambda", Arg.Unit f, " (undocumented)" +;; + let mk_dinstr f = "-dinstr", Arg.Unit f, " (undocumented)" ;; @@ -373,11 +420,14 @@ module type Bytecomp_options = sig val _a : unit -> unit + val _absname : unit -> unit val _annot : unit -> unit + val _binannot : unit -> unit val _c : unit -> unit val _cc : string -> unit val _cclib : string -> unit val _ccopt : string -> unit + val _compat_32 : unit -> unit val _config : unit -> unit val _custom : unit -> unit val _dllib : string -> unit @@ -400,8 +450,11 @@ val _output_obj : unit -> unit val _pack : unit -> unit val _pp : string -> unit + val _ppx : string -> unit val _principal : unit -> unit val _rectypes : unit -> unit + val _runtime_variant : string -> unit + val _short_paths : unit -> unit val _strict_sequence : unit -> unit val _thread : unit -> unit val _vmthread : unit -> unit @@ -418,7 +471,9 @@ val _nopervasives : unit -> unit val _use_prims : string -> unit + val _dsource : unit -> unit val _dparsetree : unit -> unit + val _dtypedtree : unit -> unit val _drawlambda : unit -> unit val _dlambda : unit -> unit val _dinstr : unit -> unit @@ -427,6 +482,7 @@ end;; module type Bytetop_options = sig + val _absname : unit -> unit val _I : string -> unit val _init : string -> unit val _labels : unit -> unit @@ -434,9 +490,13 @@ val _noassert : unit -> unit val _nolabels : unit -> unit val _noprompt : unit -> unit + val _nopromptcont : unit -> unit val _nostdlib : unit -> unit + val _ppx : string -> unit val _principal : unit -> unit val _rectypes : unit -> unit + val _short_paths : unit -> unit + val _stdin: unit -> unit val _strict_sequence : unit -> unit val _unsafe : unit -> unit val _version : unit -> unit @@ -445,7 +505,9 @@ val _warn_error : string -> unit val _warn_help : unit -> unit + val _dsource : unit -> unit val _dparsetree : unit -> unit + val _dtypedtree : unit -> unit val _drawlambda : unit -> unit val _dlambda : unit -> unit val _dinstr : unit -> unit @@ -455,7 +517,9 @@ module type Optcomp_options = sig val _a : unit -> unit + val _absname : unit -> unit val _annot : unit -> unit + val _binannot : unit -> unit val _c : unit -> unit val _cc : string -> unit val _cclib : string -> unit @@ -483,26 +547,32 @@ val _p : unit -> unit val _pack : unit -> unit val _pp : string -> unit + val _ppx : string -> unit val _principal : unit -> unit val _rectypes : unit -> unit - val _strict_sequence : unit -> unit - val _shared : unit -> unit + val _runtime_variant : string -> unit val _S : unit -> unit + val _shared : unit -> unit + val _short_paths : unit -> unit + val _strict_sequence : unit -> unit val _thread : unit -> unit val _unsafe : unit -> unit val _v : unit -> unit + val _verbose : unit -> unit val _version : unit -> unit val _vnum : unit -> unit - val _verbose : unit -> unit val _w : string -> unit val _warn_error : string -> unit val _warn_help : unit -> unit val _where : unit -> unit val _nopervasives : unit -> unit + val _dsource : unit -> unit val _dparsetree : unit -> unit + val _dtypedtree : unit -> unit val _drawlambda : unit -> unit val _dlambda : unit -> unit + val _dclambda : unit -> unit val _dcmm : unit -> unit val _dsel : unit -> unit val _dcombine : unit -> unit @@ -521,6 +591,7 @@ end;; module type Opttop_options = sig + val _absname : unit -> unit val _compact : unit -> unit val _I : string -> unit val _init : string -> unit @@ -530,11 +601,15 @@ val _noassert : unit -> unit val _nolabels : unit -> unit val _noprompt : unit -> unit + val _nopromptcont : unit -> unit val _nostdlib : unit -> unit + val _ppx : string -> unit val _principal : unit -> unit val _rectypes : unit -> unit - val _strict_sequence : unit -> unit val _S : unit -> unit + val _short_paths : unit -> unit + val _stdin : unit -> unit + val _strict_sequence : unit -> unit val _unsafe : unit -> unit val _version : unit -> unit val _vnum : unit -> unit @@ -542,9 +617,12 @@ val _warn_error : string -> unit val _warn_help : unit -> unit + val _dsource : unit -> unit val _dparsetree : unit -> unit + val _dtypedtree : unit -> unit val _drawlambda : unit -> unit val _dlambda : unit -> unit + val _dclambda : unit -> unit val _dcmm : unit -> unit val _dsel : unit -> unit val _dcombine : unit -> unit @@ -570,11 +648,14 @@ struct let list = [ mk_a F._a; + mk_absname F._absname; mk_annot F._annot; + mk_binannot F._binannot; mk_c F._c; mk_cc F._cc; mk_cclib F._cclib; mk_ccopt F._ccopt; + mk_compat_32 F._compat_32; mk_config F._config; mk_custom F._custom; mk_dllib F._dllib; @@ -602,18 +683,21 @@ mk_output_obj F._output_obj; mk_pack_byt F._pack; mk_pp F._pp; + mk_ppx F._ppx; mk_principal F._principal; mk_rectypes F._rectypes; + mk_runtime_variant F._runtime_variant; + mk_short_paths F._short_paths; mk_strict_sequence F._strict_sequence; mk_thread F._thread; mk_unsafe F._unsafe; mk_use_runtime F._use_runtime; mk_use_runtime_2 F._use_runtime; mk_v F._v; - mk_version F._version; - mk_vnum F._vnum; mk_verbose F._verbose; + mk_version F._version; mk_vmthread F._vmthread; + mk_vnum F._vnum; mk_w F._w; mk_warn_error F._warn_error; mk_warn_help F._warn_help; @@ -621,7 +705,9 @@ mk_nopervasives F._nopervasives; mk_use_prims F._use_prims; + mk_dsource F._dsource; mk_dparsetree F._dparsetree; + mk_dtypedtree F._dtypedtree; mk_drawlambda F._drawlambda; mk_dlambda F._dlambda; mk_dinstr F._dinstr; @@ -633,6 +719,7 @@ module Make_bytetop_options (F : Bytetop_options) = struct let list = [ + mk_absname F._absname; mk_I F._I; mk_init F._init; mk_labels F._labels; @@ -640,9 +727,13 @@ mk_noassert F._noassert; mk_nolabels F._nolabels; mk_noprompt F._noprompt; + mk_nopromptcont F._nopromptcont; mk_nostdlib F._nostdlib; + mk_ppx F._ppx; mk_principal F._principal; mk_rectypes F._rectypes; + mk_short_paths F._short_paths; + mk_stdin F._stdin; mk_strict_sequence F._strict_sequence; mk_unsafe F._unsafe; mk_version F._version; @@ -651,7 +742,9 @@ mk_warn_error F._warn_error; mk_warn_help F._warn_help; + mk_dsource F._dsource; mk_dparsetree F._dparsetree; + mk_dtypedtree F._dtypedtree; mk_drawlambda F._drawlambda; mk_dlambda F._dlambda; mk_dinstr F._dinstr; @@ -664,7 +757,9 @@ struct let list = [ mk_a F._a; + mk_absname F._absname; mk_annot F._annot; + mk_binannot F._binannot; mk_c F._c; mk_cc F._cc; mk_cclib F._cclib; @@ -693,31 +788,38 @@ mk_p F._p; mk_pack_opt F._pack; mk_pp F._pp; + mk_ppx F._ppx; mk_principal F._principal; mk_rectypes F._rectypes; + mk_runtime_variant F._runtime_variant; mk_S F._S; - mk_strict_sequence F._strict_sequence; mk_shared F._shared; + mk_short_paths F._short_paths; + mk_strict_sequence F._strict_sequence; mk_thread F._thread; mk_unsafe F._unsafe; mk_v F._v; + mk_verbose F._verbose; mk_version F._version; mk_vnum F._vnum; - mk_verbose F._verbose; mk_w F._w; mk_warn_error F._warn_error; mk_warn_help F._warn_help; mk_where F._where; mk_nopervasives F._nopervasives; + mk_dsource F._dsource; mk_dparsetree F._dparsetree; + mk_dtypedtree F._dtypedtree; mk_drawlambda F._drawlambda; mk_dlambda F._dlambda; + mk_dclambda F._dclambda; mk_dcmm F._dcmm; mk_dsel F._dsel; mk_dcombine F._dcombine; mk_dlive F._dlive; mk_dspill F._dspill; + mk_dsplit F._dsplit; mk_dinterf F._dinterf; mk_dprefer F._dprefer; mk_dalloc F._dalloc; @@ -732,6 +834,7 @@ module Make_opttop_options (F : Opttop_options) = struct let list = [ + mk_absname F._absname; mk_compact F._compact; mk_I F._I; mk_init F._init; @@ -741,10 +844,14 @@ mk_noassert F._noassert; mk_nolabels F._nolabels; mk_noprompt F._noprompt; + mk_nopromptcont F._nopromptcont; mk_nostdlib F._nostdlib; + mk_ppx F._ppx; mk_principal F._principal; mk_rectypes F._rectypes; mk_S F._S; + mk_short_paths F._short_paths; + mk_stdin F._stdin; mk_strict_sequence F._strict_sequence; mk_unsafe F._unsafe; mk_version F._version; @@ -753,13 +860,17 @@ mk_warn_error F._warn_error; mk_warn_help F._warn_help; + mk_dsource F._dsource; mk_dparsetree F._dparsetree; + mk_dtypedtree F._dtypedtree; mk_drawlambda F._drawlambda; + mk_dclambda F._dclambda; mk_dcmm F._dcmm; mk_dsel F._dsel; mk_dcombine F._dcombine; mk_dlive F._dlive; mk_dspill F._dspill; + mk_dsplit F._dsplit; mk_dinterf F._dinterf; mk_dprefer F._dprefer; mk_dalloc F._dalloc; diff -Nru ocaml-3.12.1/driver/main_args.mli ocaml-4.01.0/driver/main_args.mli --- ocaml-3.12.1/driver/main_args.mli 2010-05-20 14:06:29.000000000 +0000 +++ ocaml-4.01.0/driver/main_args.mli 2013-08-20 15:32:13.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Damien Doligez, projet Para, INRIA Rocquencourt *) (* *) @@ -10,16 +10,17 @@ (* *) (***********************************************************************) -(* $Id: main_args.mli 10444 2010-05-20 14:06:29Z doligez $ *) - module type Bytecomp_options = sig val _a : unit -> unit + val _absname : unit -> unit val _annot : unit -> unit + val _binannot : unit -> unit val _c : unit -> unit val _cc : string -> unit val _cclib : string -> unit val _ccopt : string -> unit + val _compat_32 : unit -> unit val _config : unit -> unit val _custom : unit -> unit val _dllib : string -> unit @@ -42,8 +43,11 @@ val _output_obj : unit -> unit val _pack : unit -> unit val _pp : string -> unit + val _ppx : string -> unit val _principal : unit -> unit val _rectypes : unit -> unit + val _runtime_variant : string -> unit + val _short_paths : unit -> unit val _strict_sequence : unit -> unit val _thread : unit -> unit val _vmthread : unit -> unit @@ -60,7 +64,9 @@ val _nopervasives : unit -> unit val _use_prims : string -> unit + val _dsource : unit -> unit val _dparsetree : unit -> unit + val _dtypedtree : unit -> unit val _drawlambda : unit -> unit val _dlambda : unit -> unit val _dinstr : unit -> unit @@ -70,6 +76,7 @@ ;; module type Bytetop_options = sig + val _absname : unit -> unit val _I : string -> unit val _init : string -> unit val _labels : unit -> unit @@ -77,9 +84,13 @@ val _noassert : unit -> unit val _nolabels : unit -> unit val _noprompt : unit -> unit + val _nopromptcont : unit -> unit val _nostdlib : unit -> unit + val _ppx : string -> unit val _principal : unit -> unit val _rectypes : unit -> unit + val _short_paths : unit -> unit + val _stdin : unit -> unit val _strict_sequence : unit -> unit val _unsafe : unit -> unit val _version : unit -> unit @@ -88,7 +99,9 @@ val _warn_error : string -> unit val _warn_help : unit -> unit + val _dsource : unit -> unit val _dparsetree : unit -> unit + val _dtypedtree : unit -> unit val _drawlambda : unit -> unit val _dlambda : unit -> unit val _dinstr : unit -> unit @@ -98,7 +111,9 @@ module type Optcomp_options = sig val _a : unit -> unit + val _absname : unit -> unit val _annot : unit -> unit + val _binannot : unit -> unit val _c : unit -> unit val _cc : string -> unit val _cclib : string -> unit @@ -126,26 +141,32 @@ val _p : unit -> unit val _pack : unit -> unit val _pp : string -> unit + val _ppx : string -> unit val _principal : unit -> unit val _rectypes : unit -> unit - val _strict_sequence : unit -> unit - val _shared : unit -> unit + val _runtime_variant : string -> unit val _S : unit -> unit + val _shared : unit -> unit + val _short_paths : unit -> unit + val _strict_sequence : unit -> unit val _thread : unit -> unit val _unsafe : unit -> unit val _v : unit -> unit + val _verbose : unit -> unit val _version : unit -> unit val _vnum : unit -> unit - val _verbose : unit -> unit val _w : string -> unit val _warn_error : string -> unit val _warn_help : unit -> unit val _where : unit -> unit val _nopervasives : unit -> unit + val _dsource : unit -> unit val _dparsetree : unit -> unit + val _dtypedtree : unit -> unit val _drawlambda : unit -> unit val _dlambda : unit -> unit + val _dclambda : unit -> unit val _dcmm : unit -> unit val _dsel : unit -> unit val _dcombine : unit -> unit @@ -164,6 +185,7 @@ end;; module type Opttop_options = sig + val _absname : unit -> unit val _compact : unit -> unit val _I : string -> unit val _init : string -> unit @@ -173,11 +195,15 @@ val _noassert : unit -> unit val _nolabels : unit -> unit val _noprompt : unit -> unit + val _nopromptcont : unit -> unit val _nostdlib : unit -> unit + val _ppx : string -> unit val _principal : unit -> unit val _rectypes : unit -> unit - val _strict_sequence : unit -> unit val _S : unit -> unit + val _short_paths : unit -> unit + val _stdin : unit -> unit + val _strict_sequence : unit -> unit val _unsafe : unit -> unit val _version : unit -> unit val _vnum : unit -> unit @@ -185,9 +211,12 @@ val _warn_error : string -> unit val _warn_help : unit -> unit + val _dsource : unit -> unit val _dparsetree : unit -> unit + val _dtypedtree : unit -> unit val _drawlambda : unit -> unit val _dlambda : unit -> unit + val _dclambda : unit -> unit val _dcmm : unit -> unit val _dsel : unit -> unit val _dcombine : unit -> unit diff -Nru ocaml-3.12.1/driver/ocamlcomp.sh.in ocaml-4.01.0/driver/ocamlcomp.sh.in --- ocaml-3.12.1/driver/ocamlcomp.sh.in 2010-05-20 09:44:25.000000000 +0000 +++ ocaml-4.01.0/driver/ocamlcomp.sh.in 2012-07-17 15:31:12.000000000 +0000 @@ -1,5 +1,17 @@ #!/bin/sh +######################################################################### +# # +# OCaml # +# # +# Jacques Garrigue, Kyoto University RIMS # +# # +# Copyright 2002 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + topdir=`dirname $0` exec @compiler@ -nostdlib -I $topdir/stdlib "$@" diff -Nru ocaml-3.12.1/driver/optcompile.ml ocaml-4.01.0/driver/optcompile.ml --- ocaml-3.12.1/driver/optcompile.ml 2008-12-03 18:09:09.000000000 +0000 +++ ocaml-4.01.0/driver/optcompile.ml 2013-06-05 16:34:40.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,88 +10,49 @@ (* *) (***********************************************************************) -(* $Id: optcompile.ml 9153 2008-12-03 18:09:09Z doligez $ *) - (* The batch compiler *) open Misc open Config open Format open Typedtree - -(* Initialize the search path. - The current directory is always searched first, - then the directories specified with the -I option (in command-line order), - then the standard library directory. *) - -let init_path () = - let dirs = - if !Clflags.use_threads - then "+threads" :: !Clflags.include_dirs - else !Clflags.include_dirs in - let exp_dirs = - List.map (expand_directory Config.standard_library) dirs in - load_path := "" :: List.rev_append exp_dirs (Clflags.std_include_dir ()); - Env.reset_cache () - -(* Return the initial environment in which compilation proceeds. *) - -let initial_env () = - Ident.reinit(); - try - if !Clflags.nopervasives - then Env.initial - else Env.open_pers_signature "Pervasives" Env.initial - with Not_found -> - fatal_error "cannot open pervasives.cmi" - -(* Note: this function is duplicated in compile.ml *) -let check_unit_name ppf filename name = - try - begin match name.[0] with - | 'A'..'Z' -> () - | _ -> - Location.print_warning (Location.in_file filename) ppf - (Warnings.Bad_module_name name); - raise Exit; - end; - for i = 1 to String.length name - 1 do - match name.[i] with - | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> () - | _ -> - Location.print_warning (Location.in_file filename) ppf - (Warnings.Bad_module_name name); - raise Exit; - done; - with Exit -> () -;; +open Compenv (* Compile a .mli file *) let interface ppf sourcefile outputprefix = Location.input_name := sourcefile; - init_path (); + Compmisc.init_path true; let modulename = String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in check_unit_name ppf sourcefile modulename; Env.set_unit_name modulename; let inputfile = Pparse.preprocess sourcefile in + let initial_env = Compmisc.initial_env() in try let ast = Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast; - let sg = Typemod.transl_signature (initial_env()) ast in + if !Clflags.dump_source then fprintf ppf "%a@." Pprintast.signature ast; + let tsg = Typemod.transl_signature initial_env ast in + if !Clflags.dump_typedtree then fprintf ppf "%a@." Printtyped.interface tsg; + let sg = tsg.sig_type in if !Clflags.print_types then fprintf std_formatter "%a@." Printtyp.signature (Typemod.simplify_signature sg); + ignore (Includemod.signatures initial_env sg sg); + Typecore.force_delayed_checks (); Warnings.check_fatal (); - if not !Clflags.print_types then - Env.save_signature sg modulename (outputprefix ^ ".cmi"); + if not !Clflags.print_types then begin + let sg = Env.save_signature sg modulename (outputprefix ^ ".cmi") in + Typemod.save_signature modulename tsg outputprefix sourcefile + initial_env sg ; + end; Pparse.remove_preprocessed inputfile; - Stypes.dump (outputprefix ^ ".annot"); + Stypes.dump (Some (outputprefix ^ ".annot")) with e -> - Pparse.remove_preprocessed_if_ast inputfile; - Stypes.dump (outputprefix ^ ".annot"); + Pparse.remove_preprocessed inputfile; + Stypes.dump (Some (outputprefix ^ ".annot")); raise e (* Compile a .ml file *) @@ -105,27 +66,31 @@ let implementation ppf sourcefile outputprefix = Location.input_name := sourcefile; - init_path (); + Compmisc.init_path true; let modulename = String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in check_unit_name ppf sourcefile modulename; Env.set_unit_name modulename; let inputfile = Pparse.preprocess sourcefile in - let env = initial_env() in + let env = Compmisc.initial_env() in Compilenv.reset ?packname:!Clflags.for_package modulename; let cmxfile = outputprefix ^ ".cmx" in let objfile = outputprefix ^ ext_obj in try - if !Clflags.print_types then ignore( + if !Clflags.print_types then ignore begin Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number ++ print_if ppf Clflags.dump_parsetree Printast.implementation - ++ Unused_var.warn ppf - ++ Typemod.type_implementation sourcefile outputprefix modulename env) - else begin + ++ print_if ppf Clflags.dump_source Pprintast.structure + ++ Typemod.type_implementation sourcefile outputprefix modulename env + ++ print_if ppf Clflags.dump_typedtree + Printtyped.implementation_with_coercion + end else begin Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number ++ print_if ppf Clflags.dump_parsetree Printast.implementation - ++ Unused_var.warn ppf + ++ print_if ppf Clflags.dump_source Pprintast.structure ++ Typemod.type_implementation sourcefile outputprefix modulename env + ++ print_if ppf Clflags.dump_typedtree + Printtyped.implementation_with_coercion ++ Translmod.transl_store_implementation modulename +++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda +++ Simplif.simplify_lambda @@ -135,12 +100,12 @@ end; Warnings.check_fatal (); Pparse.remove_preprocessed inputfile; - Stypes.dump (outputprefix ^ ".annot"); + Stypes.dump (Some (outputprefix ^ ".annot")); with x -> remove_file objfile; remove_file cmxfile; - Pparse.remove_preprocessed_if_ast inputfile; - Stypes.dump (outputprefix ^ ".annot"); + Pparse.remove_preprocessed inputfile; + Stypes.dump (Some (outputprefix ^ ".annot")); raise x let c_file name = diff -Nru ocaml-3.12.1/driver/optcompile.mli ocaml-4.01.0/driver/optcompile.mli --- ocaml-3.12.1/driver/optcompile.mli 2004-06-13 12:46:41.000000000 +0000 +++ ocaml-4.01.0/driver/optcompile.mli 2013-06-05 16:34:40.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: optcompile.mli 6395 2004-06-13 12:46:41Z xleroy $ *) - (* Compile a .ml or .mli file *) open Format @@ -19,6 +17,3 @@ val interface: formatter -> string -> string -> unit val implementation: formatter -> string -> string -> unit val c_file: string -> unit - -val initial_env: unit -> Env.t -val init_path: unit -> unit diff -Nru ocaml-3.12.1/driver/opterrors.ml ocaml-4.01.0/driver/opterrors.ml --- ocaml-3.12.1/driver/opterrors.ml 2007-12-04 13:38:58.000000000 +0000 +++ ocaml-4.01.0/driver/opterrors.ml 2013-08-20 15:32:13.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: opterrors.ml 8705 2007-12-04 13:38:58Z doligez $ *) - (* WARNING: if you change something in this file, you must look at errors.ml to see if you need to make the same changes there. *) @@ -27,30 +25,32 @@ Lexer.report_error ppf err | Syntaxerr.Error err -> Syntaxerr.report_error ppf err - | Pparse.Error -> - Location.print_error_cur_file ppf; - fprintf ppf "Preprocessor error" + | Pparse.Error err -> + Pparse.report_error ppf err | Env.Error err -> Location.print_error_cur_file ppf; Env.report_error ppf err + | Cmi_format.Error err -> + Location.print_error_cur_file ppf; + Cmi_format.report_error ppf err | Ctype.Tags(l, l') -> Location.print_error_cur_file ppf; fprintf ppf "In this program,@ variant constructors@ `%s and `%s@ \ have the same hash value.@ Change one of them." l l' - | Typecore.Error(loc, err) -> - Location.print_error ppf loc; Typecore.report_error ppf err - | Typetexp.Error(loc, err) -> - Location.print_error ppf loc; Typetexp.report_error ppf err + | Typecore.Error(loc, env, err) -> + Location.print_error ppf loc; Typecore.report_error env ppf err + | Typetexp.Error(loc, env, err) -> + Location.print_error ppf loc; Typetexp.report_error env ppf err | Typedecl.Error(loc, err) -> Location.print_error ppf loc; Typedecl.report_error ppf err - | Typeclass.Error(loc, err) -> - Location.print_error ppf loc; Typeclass.report_error ppf err + | Typeclass.Error(loc, env, err) -> + Location.print_error ppf loc; Typeclass.report_error env ppf err | Includemod.Error err -> Location.print_error_cur_file ppf; Includemod.report_error ppf err - | Typemod.Error(loc, err) -> - Location.print_error ppf loc; Typemod.report_error ppf err + | Typemod.Error(loc, env, err) -> + Location.print_error ppf loc; Typemod.report_error env ppf err | Translcore.Error(loc, err) -> Location.print_error ppf loc; Translcore.report_error ppf err | Translclass.Error(loc, err) -> @@ -77,7 +77,7 @@ fprintf ppf "I/O error: %s" msg | Warnings.Errors (n) -> Location.print_error_cur_file ppf; - fprintf ppf "Error-enabled warnings (%d occurrences)" n + fprintf ppf "Some fatal warnings were triggered (%d occurrences)" n | x -> fprintf ppf "@]"; raise x in fprintf ppf "@[%a@]@." report exn diff -Nru ocaml-3.12.1/driver/opterrors.mli ocaml-4.01.0/driver/opterrors.mli --- ocaml-3.12.1/driver/opterrors.mli 2000-03-07 05:02:33.000000000 +0000 +++ ocaml-4.01.0/driver/opterrors.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: opterrors.mli 2910 2000-03-07 05:02:33Z garrigue $ *) - (* Error report *) val report_error: Format.formatter -> exn -> unit diff -Nru ocaml-3.12.1/driver/optmain.ml ocaml-4.01.0/driver/optmain.ml --- ocaml-3.12.1/driver/optmain.ml 2010-05-20 14:06:29.000000000 +0000 +++ ocaml-4.01.0/driver/optmain.ml 2013-08-20 15:32:13.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,17 +10,9 @@ (* *) (***********************************************************************) -(* $Id: optmain.ml 10444 2010-05-20 14:06:29Z doligez $ *) - open Config open Clflags - -let output_prefix name = - let oname = - match !output_name with - | None -> name - | Some n -> if !compile_only then (output_name := None; n) else name in - Misc.chop_extension_if_any oname +open Compenv let process_interface_file ppf name = Optcompile.interface ppf name (output_prefix name) @@ -30,6 +22,8 @@ Optcompile.implementation ppf name opref; objfiles := (opref ^ ".cmx") :: !objfiles +let cmxa_present = ref false;; + let process_file ppf name = if Filename.check_suffix name ".ml" || Filename.check_suffix name ".mlt" then @@ -39,10 +33,12 @@ Optcompile.interface ppf name opref; if !make_package then objfiles := (opref ^ ".cmi") :: !objfiles end - else if Filename.check_suffix name ".cmx" - || Filename.check_suffix name ".cmxa" then + else if Filename.check_suffix name ".cmx" then objfiles := name :: !objfiles - else if Filename.check_suffix name ".cmi" && !make_package then + else if Filename.check_suffix name ".cmxa" then begin + cmxa_present := true; + objfiles := name :: !objfiles + end else if Filename.check_suffix name ".cmi" && !make_package then objfiles := name :: !objfiles else if Filename.check_suffix name ext_obj || Filename.check_suffix name ext_lib then @@ -55,38 +51,17 @@ else raise(Arg.Bad("don't know what to do with " ^ name)) -let print_version_and_library () = - print_string "The Objective Caml native-code compiler, version "; - print_string Config.version; print_newline(); - print_string "Standard library directory: "; - print_string Config.standard_library; print_newline(); - exit 0 - -let print_version_string () = - print_string Config.version; print_newline(); exit 0 - -let print_standard_library () = - print_string Config.standard_library; print_newline(); exit 0 - -let fatal err = - prerr_endline err; - exit 2 - -let extract_output = function - | Some s -> s - | None -> - fatal "Please specify the name of the output file, using option -o" - -let default_output = function - | Some s -> s - | None -> Config.default_executable_name - let usage = "Usage: ocamlopt \nOptions are:" +let ppf = Format.err_formatter + (* Error messages to standard error formatter *) -let anonymous = process_file Format.err_formatter;; -let impl = process_implementation_file Format.err_formatter;; -let intf = process_interface_file Format.err_formatter;; +let anonymous filename = + readenv ppf Before_compile; process_file ppf filename;; +let impl filename = + readenv ppf Before_compile; process_implementation_file ppf filename;; +let intf filename = + readenv ppf Before_compile; process_interface_file ppf filename;; let show_config () = Config.print_config stdout; @@ -98,11 +73,13 @@ let clear r () = r := false let _a = set make_archive + let _absname = set Location.absname let _annot = set annotations + let _binannot = set binary_annotations let _c = set compile_only let _cc s = c_compiler := Some s let _cclib s = ccobjs := Misc.rev_split_words s @ !ccobjs - let _ccopt s = ccopts := s :: !ccopts + let _ccopt s = first_ccopts := s :: !first_ccopts let _compact = clear optimize_for_speed let _config () = show_config () let _for_pack s = for_package := Some s @@ -126,14 +103,17 @@ let _p = set gprofile let _pack = set make_package let _pp s = preprocessor := Some s + let _ppx s = first_ppx := s :: !first_ppx let _principal = set principal let _rectypes = set recursive_types + let _runtime_variant s = runtime_variant := s + let _short_paths = clear real_paths let _strict_sequence = set strict_sequence let _shared () = shared := true; dlcode := true let _S = set keep_asm_file let _thread = set use_threads let _unsafe = set fast - let _v () = print_version_and_library () + let _v () = print_version_and_library "native-code compiler" let _version () = print_version_string () let _vnum () = print_version_string () let _verbose = set verbose @@ -143,9 +123,12 @@ let _where () = print_standard_library () let _nopervasives = set nopervasives + let _dsource = set dump_source let _dparsetree = set dump_parsetree + let _dtypedtree = set dump_typedtree let _drawlambda = set dump_rawlambda let _dlambda = set dump_lambda + let _dclambda = set dump_clambda let _dcmm = set dump_cmm let _dsel = set dump_selection let _dcombine = set dump_combine @@ -167,7 +150,9 @@ native_code := true; let ppf = Format.err_formatter in try + readenv ppf Before_args; Arg.parse (Arch.command_line_options @ Options.list) anonymous usage; + readenv ppf Before_link; if List.length (List.filter (fun x -> !x) [make_package; make_archive; shared; @@ -175,19 +160,24 @@ then fatal "Please specify at most one of -pack, -a, -shared, -c, -output-obj"; if !make_archive then begin - Optcompile.init_path(); + if !cmxa_present then + fatal "Option -a cannot be used with .cmxa input files."; + Compmisc.init_path true; let target = extract_output !output_name in - Asmlibrarian.create_archive (List.rev !objfiles) target; + Asmlibrarian.create_archive (get_objfiles ()) target; + Warnings.check_fatal (); end else if !make_package then begin - Optcompile.init_path(); + Compmisc.init_path true; let target = extract_output !output_name in - Asmpackager.package_files ppf (List.rev !objfiles) target; + Asmpackager.package_files ppf (get_objfiles ()) target; + Warnings.check_fatal (); end else if !shared then begin - Optcompile.init_path(); + Compmisc.init_path true; let target = extract_output !output_name in - Asmlink.link_shared ppf (List.rev !objfiles) target; + Asmlink.link_shared ppf (get_objfiles ()) target; + Warnings.check_fatal (); end else if not !compile_only && !objfiles <> [] then begin let target = @@ -205,8 +195,9 @@ else default_output !output_name in - Optcompile.init_path(); - Asmlink.link ppf (List.rev !objfiles) target + Compmisc.init_path true; + Asmlink.link ppf (get_objfiles ()) target; + Warnings.check_fatal (); end; exit 0 with x -> diff -Nru ocaml-3.12.1/driver/optmain.mli ocaml-4.01.0/driver/optmain.mli --- ocaml-3.12.1/driver/optmain.mli 2000-01-07 16:03:04.000000000 +0000 +++ ocaml-4.01.0/driver/optmain.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Damien Doligez, projet Moscova, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: optmain.mli 2740 2000-01-07 16:03:04Z doligez $ *) - (* this "empty" file is here to speed up garbage collection in ocamlopt.opt *) diff -Nru ocaml-3.12.1/driver/pparse.ml ocaml-4.01.0/driver/pparse.ml --- ocaml-3.12.1/driver/pparse.ml 2004-06-16 16:58:46.000000000 +0000 +++ ocaml-4.01.0/driver/pparse.ml 2013-06-05 16:34:40.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,11 +10,13 @@ (* *) (***********************************************************************) -(* $Id: pparse.ml 6415 2004-06-16 16:58:46Z doligez $ *) - open Format -exception Error +type error = + | CannotRun of string + | WrongMagic of string + +exception Error of error (* Optionally preprocess a source file *) @@ -22,13 +24,13 @@ match !Clflags.preprocessor with None -> sourcefile | Some pp -> - let tmpfile = Filename.temp_file "camlpp" "" in + let tmpfile = Filename.temp_file "ocamlpp" "" in let comm = Printf.sprintf "%s %s > %s" pp (Filename.quote sourcefile) tmpfile in if Ccomp.command comm <> 0 then begin Misc.remove_file tmpfile; - raise Error; + raise (Error (CannotRun comm)); end; tmpfile @@ -37,13 +39,62 @@ None -> () | Some _ -> Misc.remove_file inputfile -let remove_preprocessed_if_ast inputfile = - match !Clflags.preprocessor with - None -> () - | Some _ -> - if inputfile <> !Location.input_name then Misc.remove_file inputfile +let write_ast magic ast = + let fn = Filename.temp_file "camlppx" "" in + let oc = open_out_bin fn in + output_string oc magic; + output_value oc !Location.input_name; + output_value oc ast; + close_out oc; + fn + +let apply_rewriter magic fn_in ppx = + let fn_out = Filename.temp_file "camlppx" "" in + let comm = + Printf.sprintf "%s %s %s" ppx (Filename.quote fn_in) (Filename.quote fn_out) + in + let ok = Ccomp.command comm = 0 in + Misc.remove_file fn_in; + if not ok then begin + Misc.remove_file fn_out; + raise (Error (CannotRun comm)); + end; + if not (Sys.file_exists fn_out) then raise (Error (WrongMagic comm)); + (* check magic before passing to the next ppx *) + let ic = open_in_bin fn_out in + let buffer = + try Misc.input_bytes ic (String.length magic) with End_of_file -> "" in + close_in ic; + if buffer <> magic then begin + Misc.remove_file fn_out; + raise (Error (WrongMagic comm)); + end; + fn_out + +let read_ast magic fn = + let ic = open_in_bin fn in + try + let buffer = Misc.input_bytes ic (String.length magic) in + assert(buffer = magic); (* already checked by apply_rewriter *) + Location.input_name := input_value ic; + let ast = input_value ic in + close_in ic; + Misc.remove_file fn; + ast + with exn -> + close_in ic; + Misc.remove_file fn; + raise exn + +let apply_rewriters magic ast = + match !Clflags.all_ppx with + | [] -> ast + | ppxs -> + let fn = + List.fold_left (apply_rewriter magic) (write_ast magic ast) ppxs in + read_ast magic fn -(* Parse a file or get a dumped syntax tree in it *) +(* Parse a file or get a dumped syntax tree from it *) exception Outdated_version @@ -51,21 +102,21 @@ let ic = open_in_bin inputfile in let is_ast_file = try - let buffer = String.create (String.length ast_magic) in - really_input ic buffer 0 (String.length ast_magic); + let buffer = Misc.input_bytes ic (String.length ast_magic) in if buffer = ast_magic then true else if String.sub buffer 0 9 = String.sub ast_magic 0 9 then raise Outdated_version else false with Outdated_version -> - Misc.fatal_error "Ocaml and preprocessor have incompatible versions" + Misc.fatal_error "OCaml and preprocessor have incompatible versions" | _ -> false in let ast = try if is_ast_file then begin if !Clflags.fast then + (* FIXME make this a proper warning *) fprintf ppf "@[Warning: %s@]@." "option -unsafe used with a preprocessor returning a syntax tree"; Location.input_name := input_value ic; @@ -80,4 +131,12 @@ with x -> close_in ic; raise x in close_in ic; - ast + apply_rewriters ast_magic ast + +let report_error ppf = function + | CannotRun cmd -> + fprintf ppf "Error while running external preprocessor@.\ + Command line: %s@." cmd + | WrongMagic cmd -> + fprintf ppf "External preprocessor does not produce a valid file@.\ + Command line: %s@." cmd diff -Nru ocaml-3.12.1/driver/pparse.mli ocaml-4.01.0/driver/pparse.mli --- ocaml-3.12.1/driver/pparse.mli 2002-02-08 10:14:31.000000000 +0000 +++ ocaml-4.01.0/driver/pparse.mli 2013-03-18 20:13:53.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,13 +10,16 @@ (* *) (***********************************************************************) -(* $Id: pparse.mli 4365 2002-02-08 10:14:31Z ddr $ *) - open Format -exception Error +type error = + | CannotRun of string + | WrongMagic of string + +exception Error of error val preprocess : string -> string val remove_preprocessed : string -> unit -val remove_preprocessed_if_ast : string -> unit val file : formatter -> string -> (Lexing.lexbuf -> 'a) -> string -> 'a +val apply_rewriters : string -> 'a -> 'a +val report_error : formatter -> error -> unit diff -Nru ocaml-3.12.1/emacs/.cvsignore ocaml-4.01.0/emacs/.cvsignore --- ocaml-3.12.1/emacs/.cvsignore 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/emacs/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -ocamltags diff -Nru ocaml-3.12.1/emacs/.ignore ocaml-4.01.0/emacs/.ignore --- ocaml-3.12.1/emacs/.ignore 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/emacs/.ignore 2013-07-09 13:45:17.000000000 +0000 @@ -0,0 +1,2 @@ +ocamltags +*.elc diff -Nru ocaml-3.12.1/emacs/Makefile ocaml-4.01.0/emacs/Makefile --- ocaml-3.12.1/emacs/Makefile 2010-08-30 10:16:22.000000000 +0000 +++ ocaml-4.01.0/emacs/Makefile 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -10,8 +10,6 @@ # # ######################################################################### -# $Id: Makefile 10661 2010-08-30 10:16:22Z doligez $ - include ../config/Makefile # Files to install @@ -37,18 +35,22 @@ (byte-compile-file "inf-caml.el") \ (byte-compile-file "caml-help.el") \ (byte-compile-file "caml-types.el") \ + (byte-compile-file "caml-font.el") \ (byte-compile-file "camldebug.el")) install: @if test "$(EMACSDIR)" = ""; then \ + $(EMACS) --batch --eval 't; see PR#5403'; \ set xxx `($(EMACS) --batch --eval "(mapcar 'print load-path)") \ - 2>/dev/null | \ - sed -n -e '/\/site-lisp/s/"//gp'`; \ - if test "$$2" = ""; then \ - echo "Cannot determine Emacs site-lisp directory"; \ - exit 2; \ - fi; \ + 2>/dev/null | \ + sed -n -e 's/^"\(.*\/site-lisp\).*/\1/gp' | \ + sort -u`; \ + if test "$$2" = "" -o "$$3" != ""; then \ + echo "Cannot determine Emacs site-lisp directory:"; \ + shift; while test "$$1" != ""; do echo "\t$$1"; shift; done; \ + else \ $(MAKE) EMACSDIR="$$2" simple-install; \ + fi; \ else \ $(MAKE) simple-install; \ fi @@ -77,4 +79,4 @@ $(EMACS) --batch --eval '$(COMPILECMD)' clean: - rm -f ocamltags *~ #*# *.elc + rm -f ocamltags *~ \#*# *.elc diff -Nru ocaml-3.12.1/emacs/README ocaml-4.01.0/emacs/README --- ocaml-3.12.1/emacs/README 2008-01-11 16:13:18.000000000 +0000 +++ ocaml-4.01.0/emacs/README 2012-08-02 08:17:59.000000000 +0000 @@ -1,7 +1,7 @@ - O'Caml emacs mode, snapshot of $Date: 2008-01-11 17:13:18 +0100 (Fri, 11 Jan 2008) $ + OCaml emacs mode, snapshot of $Date$ The files in this archive define a caml-mode for emacs, for editing -Objective Caml and Objective Label programs, as well as an +OCaml and Objective Label programs, as well as an inferior-caml-mode, to run a toplevel. Caml-mode supports indentation, compilation and error retrieving, @@ -12,17 +12,20 @@ Xavier Leroy, extended with indentation by Ian Zimmerman. For details see README.itz, which is the README from Ian Zimmerman's package. -To use it, just put the .el files in your path, and add the following -three lines in your .emacs. +To use it, just put the .el files in your emacs load path, and add the +following lines in your .emacs. - (setq auto-mode-alist - (cons '("\\.ml[iylp]?$" . caml-mode) auto-mode-alist)) - (autoload 'caml-mode "caml" "Major mode for editing Caml code." t) - (autoload 'run-caml "inf-caml" "Run an inferior Caml process." t) - -I added camldebug.el from the original distribution, since there will -soon be a debugger for Objective Caml, but I do not know enough about -it. + (add-to-list 'auto-mode-alist '("\\.ml[iylp]?$" . caml-mode)) + (autoload 'caml-mode "caml" "Major mode for editing OCaml code." t) + (autoload 'run-caml "inf-caml" "Run an inferior OCaml process." t) + (autoload 'camldebug "camldebug" "Run ocamldebug on program." t) + (add-to-list 'interpreter-mode-alist '("ocamlrun" . caml-mode)) + (add-to-list 'interpreter-mode-alist '("ocaml" . caml-mode)) + +or put the .el files in, eg. "/usr/share/emacs/site-lisp/caml-mode/" +and add the following line in addtion to the four lines above: + + (add-to-list 'load-path "/usr/share/emacs/site-lisp/caml-mode") To install the mode itself, edit the Makefile and do @@ -120,7 +123,7 @@ Version 1.06: ------------ -* new keywords in O'Caml 1.06 +* new keywords in Objective Caml 1.06 * compatibility with GNU Emacs 20 @@ -150,7 +153,7 @@ (setq caml-quote-char "`") (setq inferior-caml-program "camllight") Literals will be correctly understood and highlighted. However, - indentation rules are still Objective Caml's: this just happens to + indentation rules are still OCaml's: this just happens to work well in most cases, but is only intended for occasional use. * as many people asked for it, application is now indented. This seems @@ -164,10 +167,10 @@ Version 1.03: ------------ -* support of Objective Caml and Objective Label. +* support of OCaml and Objective Label. * an indentation very close to mine, which happens to be the same as - Xavier's, since the sources of the Objective Caml compiler do not + Xavier's, since the sources of the OCaml compiler do not change if you indent them in this mode. * highlighting. @@ -175,7 +178,7 @@ Some remarks about the style supported: -------------------------------------- -Since Objective Caml's syntax is very liberal (more than 100 +Since OCaml's syntax is very liberal (more than 100 shift-reduce conflicts with yacc), automatic indentation is far from easy. Moreover, you expect the indentation to be not purely syntactic, but also semantic: reflecting the meaning of your program. diff -Nru ocaml-3.12.1/emacs/README.itz ocaml-4.01.0/emacs/README.itz --- ocaml-3.12.1/emacs/README.itz 2000-04-05 18:30:22.000000000 +0000 +++ ocaml-4.01.0/emacs/README.itz 2012-08-02 08:17:59.000000000 +0000 @@ -1,7 +1,7 @@ DESCRIPTION: -This directory contains files to help editing Caml code, running a -Caml toplevel, and running the Caml debugger under the Gnu Emacs editor. +This directory contains files to help editing OCaml code, running a +OCaml toplevel, and running the OCaml debugger under the Gnu Emacs editor. AUTHORS: @@ -13,10 +13,10 @@ CONTENTS: - caml.el A major mode for editing Caml code in Gnu Emacs - inf-caml.el To run a Caml toplevel under Emacs, with input and + caml.el A major mode for editing OCaml code in Gnu Emacs + inf-caml.el To run a OCaml toplevel under Emacs, with input and output in an Emacs buffer. - camldebug.el To run the Caml debugger under Emacs. + camldebug.el To run the OCaml debugger under Emacs. NOTE FOR EMACS 18 USERS: @@ -29,13 +29,13 @@ Add the following lines to your .emacs file: (setq auto-mode-alist (cons '("\\.ml[iylp]?" . caml-mode) auto-mode-alist)) -(autoload 'caml-mode "caml" "Major mode for editing Caml code." t) -(autoload 'run-caml "inf-caml" "Run an inferior Caml process." t) -(autoload 'camldebug "camldebug" "Run the Caml debugger." t) +(autoload 'caml-mode "caml" "Major mode for editing OCaml code." t) +(autoload 'run-caml "inf-caml" "Run an inferior OCaml process." t) +(autoload 'camldebug "camldebug" "Run the OCaml debugger." t) The Caml major mode is triggered by visiting a file with extension .ml, .mli, .mly. .mll or .mlp, or manually by M-x caml-mode. It gives you the -correct syntax table for the Caml language. For a brief description of +correct syntax table for the OCaml language. For a brief description of the indentation capabilities, see below under NEWS. The Caml mode also allows you to run batch Caml compilations from @@ -44,16 +44,16 @@ the mark at the end. Under Emacs 19, the program fragment is temporarily highlighted. -M-x run-caml starts a Caml toplevel with input and output in an Emacs +M-x run-caml starts an OCaml toplevel with input and output in an Emacs buffer named *inferior-caml*. This gives you the full power of Emacs -to edit the input to the Caml toplevel. This mode is based on comint +to edit the input to the OCaml toplevel. This mode is based on comint so you get all the usual comint features, including command history. After M-x run-caml, typing C-c C-e or M-C-x in a buffer in Caml mode -sends the current phrase (containing the point) to the Caml toplevel, +sends the current phrase (containing the point) to the OCaml toplevel, and evaluates it. -M-x camldebug FILE starts the Caml debugger camldebug on the executable +M-x camldebug FILE starts the OCaml debugger camldebug on the executable FILE, with input and output in an Emacs buffer named *camldebug-FILE*. For a brief description of the commands available in this buffer, see NEWS below. diff -Nru ocaml-3.12.1/emacs/caml-compat.el ocaml-4.01.0/emacs/caml-compat.el --- ocaml-3.12.1/emacs/caml-compat.el 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/emacs/caml-compat.el 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ ;(***********************************************************************) ;(* *) -;(* Objective Caml *) +;(* OCaml *) ;(* *) ;(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) ;(* *) @@ -10,8 +10,6 @@ ;(* *) ;(***********************************************************************) -;(* $Id: caml-compat.el 9547 2010-01-22 12:48:24Z doligez $ *) - ;; function definitions for old versions of emacs ;; indent-line-to diff -Nru ocaml-3.12.1/emacs/caml-emacs.el ocaml-4.01.0/emacs/caml-emacs.el --- ocaml-3.12.1/emacs/caml-emacs.el 2010-08-30 15:15:33.000000000 +0000 +++ ocaml-4.01.0/emacs/caml-emacs.el 2013-01-17 02:56:00.000000000 +0000 @@ -1,6 +1,6 @@ ;(***********************************************************************) ;(* *) -;(* Objective Caml *) +;(* OCaml *) ;(* *) ;(* Didier Remy, projet Cristal, INRIA Rocquencourt *) ;(* *) @@ -10,8 +10,6 @@ ;(* *) ;(***********************************************************************) -;(* $Id: caml-emacs.el 10662 2010-08-30 15:15:33Z doligez $ *) - ;; for caml-help.el (defalias 'caml-info-other-window 'info-other-window) @@ -27,7 +25,7 @@ (defalias 'caml-mouse-movement-p 'mouse-movement-p) (defalias 'caml-sit-for 'sit-for) -(defmacro caml-track-mouse (&rest body) (cons 'track-mouse body)) +(defalias 'caml-track-mouse 'track-mouse) (defun caml-event-window (e) (posn-window (event-start e))) (defun caml-event-point-start (e) (posn-point (event-start e))) @@ -39,8 +37,7 @@ (or (member 'drag modifiers) (member 'click modifiers))))) -(if (fboundp 'string-to-number) - (defalias 'caml-string-to-int 'string-to-number) - (defalias 'caml-string-to-int 'string-to-int)) +(defalias 'caml-string-to-int (if (fboundp 'string-to-number) + 'string-to-number 'string-to-int)) (provide 'caml-emacs) diff -Nru ocaml-3.12.1/emacs/caml-font-old.el ocaml-4.01.0/emacs/caml-font-old.el --- ocaml-3.12.1/emacs/caml-font-old.el 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/emacs/caml-font-old.el 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ ;(***********************************************************************) ;(* *) -;(* Objective Caml *) +;(* OCaml *) ;(* *) ;(* Jacques Garrigue and Ian T Zimmerman *) ;(* *) @@ -10,8 +10,6 @@ ;(* *) ;(***********************************************************************) -;(* $Id: caml-font-old.el 9547 2010-01-22 12:48:24Z doligez $ *) - ;; useful colors (cond @@ -55,7 +53,7 @@ ; The same definition is in caml.el: ; we don't know in which order they will be loaded. (defvar caml-quote-char "'" - "*Quote for character constants. \"'\" for Objective Caml, \"`\" for Caml-Light.") + "*Quote for character constants. \"'\" for OCaml, \"`\" for Caml-Light.") (defconst caml-font-lock-keywords (list diff -Nru ocaml-3.12.1/emacs/caml-font.el ocaml-4.01.0/emacs/caml-font.el --- ocaml-3.12.1/emacs/caml-font.el 2011-05-20 07:40:01.000000000 +0000 +++ ocaml-4.01.0/emacs/caml-font.el 2013-03-22 18:19:29.000000000 +0000 @@ -1,18 +1,17 @@ -;; caml-font: font-lock support for OCaml files -;; -;; rewrite and clean-up. -;; Changes: -;; - fontify strings and comments using syntactic font lock -;; - define a `font-lock-syntactic-face-function' to fontify ocamldoc comments -;; - fontify infix operators like mod, land, lsl, etc. -;; - fontify line number directives -;; - fontify "failwith" and "invalid_arg" like "raise" -;; - fontify '\x..' character constants -;; - use the regexp-opt function to build regexps (more readable) -;; - use backquote and comma in sexp (more readable) -;; - drop the `caml-quote-char' variable (I don't use caml-light :)) -;; - stop doing weird things with faces +;(***********************************************************************) +;(* *) +;(* OCaml *) +;(* *) +;(* Jacques Garrigue, Ian T Zimmerman, Damien Doligez *) +;(* *) +;(* Copyright 1997 Institut National de Recherche en Informatique et *) +;(* en Automatique. All rights reserved. This file is distributed *) +;(* under the terms of the GNU General Public License. *) +;(* *) +;(***********************************************************************) +;; caml-font: font-lock support for OCaml files +;; now with perfect parsing of comments and strings (require 'font-lock) @@ -36,9 +35,6 @@ (defconst caml-font-lock-keywords `( -;character literals - ("'\\(.\\|\\\\\\([ntbr\"'\\\\]\\|[0-9]\\{3\\}\\|x[0-9A-Fa-f]\\{2\\}\\)\\)'" - . font-lock-string-face) ;modules and constructors ("`?\\<[A-Z][A-Za-z0-9_']*\\>" . font-lock-function-name-face) ;definition @@ -87,14 +83,303 @@ ((looking-at "(\\*\\*[^*]") 'caml-font-doccomment-face) (t 'font-lock-comment-face))))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; In order to correctly fontify an OCaml buffer, it is necessary to +; lex the buffer to tell what is a comment and what is a string. +; We do this incrementally in a hook +; (font-lock-extend-after-change-region-function), which is called +; whenever the buffer changes. It sets the syntax-table property +; on each beginning and end of chars, strings, and comments. + +; This mode handles correctly all the strange cases in the following +; OCaml code. +; +; let l' _ = ();; +; let _' _ = ();; +; let l' = ();; +; let b2_' = ();; +; let a'a' = ();; +; let f2 _ _ = ();; +; let f3 _ _ _ = ();; +; let f' _ _ _ _ _ = ();; +; let hello = ();; +; +; (* ==== easy stuff ==== *) +; +; (* a comment *) +; (* "a string" in a comment *) +; (* "another string *)" in a comment *) +; (* not a string '"' in a comment *) +; "a string";; +; '"';; (* not a string *) +; +; (* ==== hard stuff ==== *) +; +; l'"' not not a string ";; +; _'"' also not not a string";; +; f2 0l'"';; (* not not not a string *) +; f2 0_'"';; (* also not not not a string *) +; f3 0.0l'"' not not not not a string ";; +; f3 0.0_'"';; (* not not not not not a string *) +; f2 0b01_'"';; (* not not not a string *) +; f3 0b2_'"' not not not not a string ";; +; f3 0b02_'"';; (* not not not not not a string *) +; '\'';; (* a char *) +; ' +; ';; (* a char *) +; '^M +; ';; (* also a char [replace ^M with one CR character] *) +; a'a';; (* not a char *) +; type ' +; a' t = X;; (* also not a char *) +; +; (* ==== far-out stuff ==== *) +; +; f'"'" "*) print_endline "hello";;(* \"" ;; +; (* f'"'" "*) print_endline "hello";;(* \"" ;; *) + + +(defconst caml-font-ident-re + (concat "[A-Za-z_\300-\326\330-\366\370-\377]" + "[A-Za-z_\300-\326\330-\366\370-\377'0-9]*") +) + +(defconst caml-font-int-re + (concat "\\(0[xX][0-9A-Fa-f][0-9A-Fa-f_]*\\|0[oO][0-7][0-7_]*" + "\\|0[bB][01][01_]*\\)[lLn]?") +) + +; decimal integers are folded into the RE for floats to get longest-match +; without using posix-looking-at +(defconst caml-font-decimal-re + "[0-9][0-9_]*\\([lLn]\\|\\.[0-9_]*\\)?\\([eE][+-]?[0-9][0-9_]*\\)?" +) + +; match any ident or numeral token +(defconst caml-font-ident-or-num-re + (concat caml-font-ident-re "\\|" caml-font-int-re "\\|" caml-font-decimal-re) +) + +; match any char token +(defconst caml-font-char-re + (concat "'\\(\015\012\\|[^\\']\\|" + "\\(\\\\\\([\\'\"ntbr ]\\|[0-9][0-9][0-9]" + "\\|x[0-9A-Fa-f][0-9A-Fa-f]\\)\\)\\)'") +) + +; match a quote followed by a newline +(defconst caml-font-quote-newline-re + "'\\(\015\012\\|[\012\015]\\)" +) + +; match any token or sequence of tokens that cannot contain a +; quote, double quote, a start of comment, or a newline +; note: this is only to go faster than one character at a time +(defconst caml-font-other-re + "[^A-Za-z_0-9\012\015\300-\326\330-\366\370-\377'\"(]+" +) + +; match any sequence of non-special characters in a comment +; note: this is only to go faster than one character at a time +(defconst caml-font-other-comment-re + "[^(*\"'\012\015]+" +) + +; match any sequence of non-special characters in a string +; note: this is only to go faster than one character at a time +(defconst caml-font-other-string-re + "[^\\\"\012\015]" +) + +; match a newline +(defconst caml-font-newline-re + "\\(\015\012\\|[\012\015]\\)" +) + +; Put the 'caml-font-state property with the given state on the +; character before pos. Return nil if it was already there, t if not. +(defun caml-font-put-state (pos state) + (if (equal state (get-text-property (1- pos) 'caml-font-state)) + nil + (put-text-property (1- pos) pos 'caml-font-state state) + t) +) + +; Same as looking-at, but erase properties 'caml-font-state and +; 'syntax-table from the matched range +(defun caml-font-looking-at (re) + (let ((result (looking-at re))) + (when result + (remove-text-properties (match-beginning 0) (match-end 0) + '(syntax-table nil caml-font-state nil))) + result) +) + +; Annotate the buffer starting at point in state (st . depth) +; Set the 'syntax-table property on beginnings and ends of: +; - strings +; - chars +; - comments +; Also set the 'caml-font-state property on each LF character that is +; not preceded by a single quote. The property gives the state of the +; lexer (nil or t) after reading that character. + +; Leave the point at a point where the pre-existing 'caml-font-state +; property is consistent with the new parse, or at the end of the buffer. + +; depth is the depth of nested comments at this point +; it must be a non-negative integer +; st can be: +; nil -- we are in the base state +; t -- we are within a string + +(defun caml-font-annotate (st depth) + (let ((continue t)) + (while (and continue (not (eobp))) + (cond + ((and (equal st nil) (= depth 0)) ; base state, outside comment + (cond + ((caml-font-looking-at caml-font-ident-or-num-re) + (goto-char (match-end 0))) + ((caml-font-looking-at caml-font-char-re) + (put-text-property (point) (1+ (point)) + 'syntax-table (string-to-syntax "|")) + (put-text-property (1- (match-end 0)) (match-end 0) + 'syntax-table (string-to-syntax "|")) + (goto-char (match-end 0))) + ((caml-font-looking-at caml-font-quote-newline-re) + (goto-char (match-end 0))) + ((caml-font-looking-at "\"") + (put-text-property (point) (1+ (point)) + 'syntax-table (string-to-syntax "|")) + (goto-char (match-end 0)) + (setq st t)) + ((caml-font-looking-at "(\\*") + (put-text-property (point) (1+ (point)) + 'syntax-table (string-to-syntax "!")) + (goto-char (match-end 0)) + (setq depth 1)) + ((looking-at caml-font-newline-re) + (goto-char (match-end 0)) + (setq continue (caml-font-put-state (match-end 0) '(nil . 0)))) + ((caml-font-looking-at caml-font-other-re) + (goto-char (match-end 0))) + (t + (remove-text-properties (point) (1+ (point)) + '(syntax-table nil caml-font-state nil)) + (goto-char (1+ (point)))))) + ((equal st nil) ; base state inside comment + (cond + ((caml-font-looking-at "(\\*") + (goto-char (match-end 0)) + (setq depth (1+ depth))) + ((caml-font-looking-at "\\*)") + (goto-char (match-end 0)) + (setq depth (1- depth)) + (when (= depth 0) + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "!")))) + ((caml-font-looking-at "\"") + (goto-char (match-end 0)) + (setq st t)) + ((caml-font-looking-at caml-font-char-re) + (goto-char (match-end 0))) + ((caml-font-looking-at caml-font-quote-newline-re) + (goto-char (match-end 0))) + ((caml-font-looking-at "''") + (goto-char (match-end 0))) + ((looking-at caml-font-newline-re) + (goto-char (match-end 0)) + (setq continue (caml-font-put-state (match-end 0) (cons nil depth)))) + ((caml-font-looking-at caml-font-other-comment-re) + (goto-char (match-end 0))) + (t + (remove-text-properties (point) (1+ (point)) + '(syntax-table nil caml-font-state nil)) + (goto-char (1+ (point)))))) + (t ; string state inside or outside a comment + (cond + ((caml-font-looking-at "\"") + (when (= depth 0) + (put-text-property (point) (1+ (point)) + 'syntax-table (string-to-syntax "|"))) + (goto-char (1+ (point))) + (setq st nil)) + ((caml-font-looking-at "\\\\[\"\\]") + (goto-char (match-end 0))) + ((looking-at caml-font-newline-re) + (goto-char (match-end 0)) + (setq continue (caml-font-put-state (match-end 0) (cons t depth)))) + ((caml-font-looking-at caml-font-other-string-re) + (goto-char (match-end 0))) + (t + (remove-text-properties (point) (1+ (point)) + '(syntax-table nil caml-font-state nil)) + (goto-char (1+ (point))))))))) +) + +; This is the hook function for font-lock-extend-after-change-function +; It finds the nearest saved state at the left of the changed text, +; calls caml-font-annotate to set the 'caml-font-state and 'syntax-table +; properties, then returns the range that was parsed by caml-font-annotate. +(defun caml-font-extend-after-change (beg end &optional old-len) + (save-excursion + (save-match-data + (let ((caml-font-modified (buffer-modified-p)) + start-at + end-at + state) + (remove-text-properties beg end '(syntax-table nil caml-font-state nil)) + (setq start-at + (or (and (> beg (point-min)) + (get-text-property (1- beg) 'caml-font-state) + beg) + (previous-single-property-change beg 'caml-font-state) + (point-min))) + (setq state (or (and (> start-at (point-min)) + (get-text-property (1- start-at) 'caml-font-state)) + (cons nil 0))) + (goto-char start-at) + (caml-font-annotate (car state) (cdr state)) + (setq end-at (point)) + (restore-buffer-modified-p caml-font-modified) + (cons start-at end-at)))) +) + +; We don't use the normal caml-mode syntax table because it contains an +; approximation of strings and comments that interferes with our +; annotations. +(defconst caml-font-syntax-table + (let ((tbl (make-syntax-table))) + (modify-syntax-entry ?' "w" tbl) + (modify-syntax-entry ?_ "w" tbl) + (modify-syntax-entry ?\" "." tbl) + (let ((i 192)) + (while (< i 256) + (or (= i 215) (= i 247) (modify-syntax-entry i "w" tbl)) + (setq i (1+ i)))) + tbl)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; font-lock commands are similar for caml-mode and inferior-caml-mode (defun caml-font-set-font-lock () + (setq parse-sexp-lookup-properties t) (setq font-lock-defaults - '(caml-font-lock-keywords - nil nil nil nil - (font-lock-syntactic-face-function . caml-font-syntactic-face))) - (font-lock-mode 1)) + (list + 'caml-font-lock-keywords ; keywords + nil ; keywords-only + nil ; case-fold + nil ; syntax-alist + nil ; syntax-begin + (cons 'font-lock-syntax-table caml-font-syntax-table) + '(font-lock-extend-after-change-region-function + . caml-font-extend-after-change) + '(font-lock-syntactic-face-function . caml-font-syntactic-face) + )) + (caml-font-extend-after-change (point-min) (point-max) 0) + (font-lock-mode 1) +) (add-hook 'caml-mode-hook 'caml-font-set-font-lock) @@ -104,11 +389,22 @@ ,@caml-font-lock-keywords)) (defun inferior-caml-set-font-lock () + (setq parse-sexp-lookup-properties t) (setq font-lock-defaults - '(inferior-caml-font-lock-keywords - nil nil nil nil - (font-lock-syntactic-face-function . caml-font-syntactic-face))) - (font-lock-mode 1)) + (list + 'inferior-caml-font-lock-keywords ; keywords + nil ; keywords-only + nil ; case-fold + nil ; syntax-alist + nil ; syntax-begin + (cons 'font-lock-syntax-table caml-font-syntax-table) + '(font-lock-extend-after-change-region-function + . caml-font-extend-after-change) + '(font-lock-syntactic-face-function . caml-font-syntactic-face) + )) + (caml-font-extend-after-change (point-min) (point-max) 0) + (font-lock-mode 1) +) (add-hook 'inferior-caml-mode-hooks 'inferior-caml-set-font-lock) (provide 'caml-font) diff -Nru ocaml-3.12.1/emacs/caml-help.el ocaml-4.01.0/emacs/caml-help.el --- ocaml-3.12.1/emacs/caml-help.el 2010-04-28 11:11:07.000000000 +0000 +++ ocaml-4.01.0/emacs/caml-help.el 2013-03-17 17:17:21.000000000 +0000 @@ -1,6 +1,7 @@ +;;; caml-help.el --- Contextual completion and help to caml-mode ;(***********************************************************************) ;(* *) -;(* Objective Caml *) +;(* OCaml *) ;(* *) ;(* Didier Remy, projet Cristal, INRIA Rocquencourt *) ;(* *) @@ -10,14 +11,12 @@ ;(* *) ;(***********************************************************************) -;(* $Id: caml-help.el 10323 2010-04-28 11:11:07Z remy $ *) +;; Author: Didier Remy, November 2001. -;; caml-info.el --- contextual completion and help to caml-mode +;;; Commentary: -;; Didier Remy, November 2001. - -;; This provides two functions completion and help -;; look for caml-complete and caml-help +;; This provides two functions: completion and help. +;; Look for caml-complete and caml-help. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -34,15 +33,16 @@ ;; - the viewing method and the database, so that the documentation for ;; and identifier could be search in ;; * info / html / man / mli's sources -;; * viewed in emacs or using an external previewer. +;; * viewed in Emacs or using an external previewer. ;; ;; Take all identifiers (labels, Constructors, exceptions, etc.) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Code: (eval-and-compile - (if (and (boundp 'running-xemacs) running-xemacs) + (if (featurep 'xemacs) (require 'caml-xemacs) (require 'caml-emacs))) @@ -52,11 +52,11 @@ ;; variables to be customized (defvar ocaml-lib-path 'lazy - "Path list for ocaml lib sources (mli files) + "Path list for ocaml lib sources (mli files). -'lazy means ask ocaml to find it for your at first use.") +`lazy' means ask ocaml to find it for your at first use.") (defun ocaml-lib-path () - "Computes if necessary and returns the path for ocaml libs" + "Compute if necessary and return the path for ocaml libs." (if (listp ocaml-lib-path) nil (setq ocaml-lib-path (split-string @@ -85,13 +85,11 @@ (concat (downcase (substring s 0 1)) (substring s 1)) s)) -(defun iter (f l) (while (consp l) (apply f (list (car l))) (setq l (cdr l)))) - (defun ocaml-find-files (path filter &optional depth split) (let* ((path-string (if (stringp path) (if (file-directory-p path) path nil) - (mapconcat '(lambda (d) (if (file-directory-p d) d)) + (mapconcat (lambda (d) (if (file-directory-p d) d)) path " "))) (command (and path-string @@ -112,7 +110,7 @@ (defvar ocaml-module-alist 'lazy "A-list of modules with how and where to find help information. - 'delay means non computed yet") +`delay' means non computed yet.") (defun ocaml-add-mli-modules (modules tag &optional path) (let ((files @@ -133,13 +131,13 @@ modules)) (defun ocaml-add-path (dir &optional path) - "Extend ocaml-module-alist with modules of DIR relative to PATH" + "Extend `ocaml-module-alist' with modules of DIR relative to PATH." (interactive "D") (let* ((old (ocaml-lib-path)) (new (if (file-name-absolute-p dir) dir (concat - (or (find-if '(lambda (p) (file-directory-p (concat p "/" dir))) + (or (find-if (lambda (p) (file-directory-p (concat p "/" dir))) (cons default-directory old)) (error "Directory not found")) "/" dir)))) @@ -148,7 +146,7 @@ (ocaml-add-mli-modules (ocaml-module-alist) 'lib new)))) (defun ocaml-module-alist () - "Call by need value of variable ocaml-module-alist" + "Call by need value of variable `ocaml-module-alist'." (if (listp ocaml-module-alist) nil ;; build list of mli files @@ -199,7 +197,7 @@ (insert-file-contents file)) (message "Module %s not found" module)) (while (re-search-forward - "\\([ \t]*val\\|let\\|external\\| [|]\\) \\([a-zA-Z_0-9'][a-zA-Z_0-9']*\\)\\|^ *[{]* \\([a-z_][A-Za-z_0-9]*\\) : [^;\n][^;\n]*;" + "\\([ \t]*val\\|let\\|exception\\|external\\| [|]\\) \\([a-zA-Z_0-9'][a-zA-Z_0-9']*\\)\\|^ *[{]* \\([a-z_][A-Za-z_0-9]*\\) : [^;\n][^;\n]*;" (point-max) 'move) (pop-to-buffer (current-buffer)) (setq alist (cons (or (match-string 2) (match-string 3)) alist))) @@ -251,7 +249,7 @@ (defun ocaml-close-module (arg) "*Close module of name ARG when ARG is a string. When call interactively, make completion over visible modules. -Otherwise if ARG is true, close all modules and reset to default. " +Otherwise if ARG is true, close all modules and reset to default." (interactive "P") (if (= (prefix-numeric-value arg) 4) (setq ocaml-visible-modules 'lazy) @@ -264,7 +262,7 @@ modules)) (if (equal arg "") (setq arg (caar modules)))) (setq ocaml-visible-modules - (remove-if '(lambda (m) (equal (car m) arg)) + (remove-if (lambda (m) (equal (car m) arg)) ocaml-visible-modules)) )) (message "%S" (mapcar 'car (ocaml-visible-modules)))) @@ -284,8 +282,7 @@ and are nil otherwise. For debugging purposes, it returns the string Module.entry if called -with an optional non-nil argument. -" +with an optional non-nil argument." (save-excursion (let ((module) (entry)) (if (looking-at "[ \n]") (skip-chars-backward " ")) @@ -322,12 +319,12 @@ (if (null pattern) (apply 'append (mapcar 'ocaml-module-symbols list)) (let ((pat (concat "^" (regexp-quote pattern))) (res)) - (iter - '(lambda (l) - (iter '(lambda (x) - (if (string-match pat (car l)) - (if (member x res) nil (setq res (cons x res))))) - (ocaml-module-symbols l))) + (mapc + (lambda (l) + (mapc (lambda (x) + (if (string-match pat (car l)) + (if (member x res) nil (setq res (cons x res))))) + (ocaml-module-symbols l))) list) res) ))) @@ -427,8 +424,7 @@ (defvar ocaml-info-prefix "ocaml-lib" "Prefix of ocaml info files describing library modules. Suffix .info will be added to info files. -Additional suffix .gz may be added if info files are compressed. -") +Additional suffix .gz may be added if info files are compressed.") ;; (defun ocaml-hevea-info-add-entries (entries dir name) @@ -474,15 +470,14 @@ of \\[Info-default-directory-list] and the base name \\[ocaml-info-name] of files to look for. -This uses info files produced by HeVeA. -" +This uses info files produced by HeVeA." (let ((collect) (seen)) - (iter '(lambda (d) - (if (member d seen) nil - (setq collect - (ocaml-hevea-info-add-entries - collect d ocaml-info-prefix)) - (setq done (cons d seen)))) + (mapc (lambda (d) + (if (member d seen) nil + (setq collect + (ocaml-hevea-info-add-entries + collect d ocaml-info-prefix)) + (setq seen (cons d seen)))) Info-directory-list) collect)) @@ -520,12 +515,12 @@ This uses info files produced by ocamldoc." (require 'info) (let ((collect) (seen)) - (iter '(lambda (d) - (if (member d seen) nil - (setq collect - (ocaml-ocamldoc-info-add-entries collect d - ocaml-info-prefix)) - (setq done (cons d seen)))) + (mapc (lambda (d) + (if (member d seen) nil + (setq collect + (ocaml-ocamldoc-info-add-entries collect d + ocaml-info-prefix)) + (setq seen (cons d seen)))) Info-directory-list) collect)) @@ -536,11 +531,11 @@ nil means do not use info. - A function to build the list lazily (at the first call). The result of + A function to build the list lazily (at the first call). The result of the function call will be assign permanently to this variable for future -uses. We provide two default functions \\[ocaml-info-default-function] -(info produced by HeVeA is the default) and \\[ocaml-info-default-function] -(info produced by ocamldoc). +uses. We provide two default functions `ocaml-hevea-info' +\(info produced by HeVeA is the default) and `ocaml-ocamldoc-info' +\(info produced by ocamldoc). Otherwise, this value should be an alist binding module names to info entries of the form to \"(entry)section\" be taken by the \\[info] @@ -548,7 +543,7 @@ ) (defun ocaml-info-alist () - "Call by need value of variable ocaml-info-alist" + "Call by need value of variable `ocaml-info-alist'." (cond ((listp ocaml-info-alist)) ((functionp ocaml-info-alist) @@ -574,9 +569,11 @@ ;; Help function. +(defvar view-return-to-alist) +(defvar view-exit-action) (defun ocaml-goto-help (&optional module entry same-window) - "Searches info manual for MODULE and ENTRY in MODULE. + "Search info manual for MODULE and ENTRY in MODULE. If unspecified, MODULE and ENTRY are inferred from the position in the current buffer using \\[ocaml-qualified-identifier]." (interactive) @@ -606,14 +603,18 @@ ) (if (stringp entry) (let ((here (point)) + (regex (regexp-quote entry)) (case-fold-search nil)) (goto-char (point-min)) (if (or (re-search-forward (concat "\\(val\\|exception\\|type\\|external\\|[|{;]\\) +" - (regexp-quote entry)) + regex) + ;; (concat "\\(val\\|exception\\|external\\) +\\(" + ;; regex "\\|( *" regex " *)\\)") (point-max) t) (re-search-forward - (concat "type [^{]*{[^}]*" (regexp-quote entry) " :") + (concat "type [^{]*{[^}]*" regex " :") + ;; (concat "\\(type\\|[|{;]\\) +" regex) (point-max) t) (progn (if (window-live-p window) (select-window window)) @@ -621,7 +622,7 @@ entry module)) ;; (search-forward entry (point-max) t) ) - (recenter 1) + (ocaml-help-show -1) (progn (message "Help for entry %s not found in module %s" entry module) @@ -631,6 +632,15 @@ (if (window-live-p window) (select-window window)) )) +(defface ocaml-help-face + '((t :background "#88FF44")) + "Face to highlight expressions and types.") + +(defvar ocaml-help-ovl + (let ((ovl (make-overlay 1 1))) + (overlay-put ovl 'face 'ocaml-help-face) + ovl)) + (defun caml-help (arg) "Find documentation for OCaml qualified identifiers. @@ -638,11 +648,11 @@ ``Module . entry'' around point using function `ocaml-qualified-identifier'. If Module is undetermined it is temptatively guessed from the identifier name -and according to visible modules. If this is still unsucessful, the user is +and according to visible modules. If this is still unsucessful, the user is then prompted for a Module name. The documentation for Module is first seach in the info manual if available, -then in the ``module.mli'' source file. The entry is then searched in the +then in the ``module.mli'' source file. The entry is then searched in the documentation. Visible modules are computed only once, at the first call. @@ -653,9 +663,9 @@ from the file content. Prefix arg 4 prompts for Module and identifier instead of guessing values -from the possition of point in the current buffer. -" +from the possition of point in the current buffer." (interactive "p") + (delete-overlay ocaml-help-ovl) (let ((module) (entry) (module-entry)) (cond ((= arg 4) @@ -669,7 +679,8 @@ (mapcar 'list (ocaml-module-symbols (assoc module (ocaml-module-alist)))))) - (setq entry (completing-read "Value: " symbols nil t))) + (setq entry + (completing-read (format "Value: %s." module) symbols nil t))) (if (string-equal entry "") (setq entry nil)) ) (t @@ -737,10 +748,21 @@ (setq ocaml-links (cons section all)) ))))) -(defvar ocaml-link-map (make-sparse-keymap)) -(define-key ocaml-link-map [mouse-2] 'ocaml-link-goto) +(defvar ocaml-link-map + (let ((map (make-sparse-keymap))) + (define-key map [mouse-2] 'ocaml-link-goto) + map)) + +(defun ocaml-help-show (arg) + (let ((right (point)) + (left (progn (forward-word arg) (point)))) + (goto-char right) + (move-overlay ocaml-help-ovl left right (current-buffer)) + (recenter 1) + )) (defun ocaml-link-goto (click) + "Follow link at point." (interactive "e") (let* ((pos (caml-event-point-start click)) (win (caml-event-window click)) @@ -761,16 +783,14 @@ (if (setq link (assoc link (cdr ocaml-links))) (progn (goto-char (cadr link)) - (recenter 1))) + (ocaml-help-show 1))) (if (window-live-p window) (select-window window)) ))) -(cond - ((and (x-display-color-p) - (not (memq 'ocaml-link-face (face-list)))) - (make-face 'ocaml-link-face) - (set-face-foreground 'ocaml-link-face "Purple"))) +(defface ocaml-link-face + '((((class color)) :foreground "Purple")) + "Face to highlight hyperlinks.") (defun ocaml-link-activate (section) (let ((links (ocaml-info-links section))) @@ -831,3 +851,4 @@ (provide 'caml-help) +;;; caml-help.el ends here diff -Nru ocaml-3.12.1/emacs/caml-hilit.el ocaml-4.01.0/emacs/caml-hilit.el --- ocaml-3.12.1/emacs/caml-hilit.el 2004-08-20 17:04:35.000000000 +0000 +++ ocaml-4.01.0/emacs/caml-hilit.el 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ ;(***********************************************************************) ;(* *) -;(* Objective Caml *) +;(* OCaml *) ;(* *) ;(* Jacques Garrigue and Ian T Zimmerman *) ;(* *) @@ -10,13 +10,11 @@ ;(* *) ;(***********************************************************************) -;(* $Id: caml-hilit.el 6612 2004-08-20 17:04:35Z doligez $ *) - ; Highlighting patterns for hilit19 under caml-mode ; defined also in caml.el (defvar caml-quote-char "'" - "*Quote for character constants. \"'\" for Objective Caml, \"`\" for Caml-Light.") + "*Quote for character constants. \"'\" for OCaml, \"`\" for Caml-Light.") (defconst caml-mode-patterns (list @@ -53,7 +51,7 @@ "\\|\|\\|->\\|&\\|#") nil 'keyword) '(";" nil struct)) - "Hilit19 patterns used for Caml mode") + "Hilit19 patterns used for OCaml mode") (hilit-set-mode-patterns 'caml-mode caml-mode-patterns) (hilit-set-mode-patterns diff -Nru ocaml-3.12.1/emacs/caml-types.el ocaml-4.01.0/emacs/caml-types.el --- ocaml-3.12.1/emacs/caml-types.el 2010-08-30 10:16:22.000000000 +0000 +++ ocaml-4.01.0/emacs/caml-types.el 2013-03-22 18:19:21.000000000 +0000 @@ -1,6 +1,6 @@ ;(***********************************************************************) ;(* *) -;(* Objective Caml *) +;(* OCaml *) ;(* *) ;(* Damien Doligez, projet Moscova, INRIA Rocquencourt *) ;(* *) @@ -10,8 +10,6 @@ ;(* *) ;(***********************************************************************) -;(* $Id: caml-types.el 10661 2010-08-30 10:16:22Z doligez $ *) - ; An emacs-lisp complement to the "-annot" option of ocamlc and ocamlopt. ;; XEmacs compatibility @@ -38,7 +36,7 @@ is a space character (ASCII 0x20) is a line-feed character (ASCII 0x0A) num is a sequence of decimal digits - filename is a string with the lexical conventions of O'Caml + filename is a string with the lexical conventions of OCaml open-paren is an open parenthesis (ASCII 0x28) close-paren is a closed parenthesis (ASCII 0x29) data is any sequence of characters where is always followed by @@ -56,6 +54,8 @@ type call ident" ) +(defvar caml-types-position-re nil) + (let* ((caml-types-filename-re "\"\\(\\([^\\\"]\\|\\\\.\\)*\\)\"") (caml-types-number-re "\\([0-9]*\\)")) (setq caml-types-position-re @@ -331,7 +331,8 @@ caml-types-annotation-date (not (caml-types-date< caml-types-annotation-date type-date))) (if (and type-date target-date (caml-types-date< type-date target-date)) - (error (format "`%s' is more recent than `%s'" target-path type-path))) + (error (format "`%s' is more recent than `%s'" + target-path type-path))) (message "Reading annotation file...") (let* ((type-buf (caml-types-find-file type-path)) (tree (with-current-buffer type-buf @@ -411,8 +412,7 @@ (unless (caml-types-not-in-file l-file r-file target-file) (setq annotation ()) (while (next-annotation) - (cond ((looking-at - "^\\([a-z]+\\)(\n \\(\\([^\n)]\\|.)\\|\n[^)]\\)*\\)\n)") + (cond ((looking-at "^\\([a-z]+\\)(\n \\(\\(.*\n \\)*.*\\)\n)") (let ((kind (caml-types-hcons (match-string 1) table)) (info (caml-types-hcons (match-string 2) table))) (setq annotation (cons (cons kind info) annotation)))))) @@ -595,7 +595,7 @@ . One overlay delimits the largest region whose all subnodes are well-typed. . Another overlay delimits the current node under the mouse (whose type - annotation is beeing displayed). + annotation is being displayed). " (interactive "e") (set-buffer (window-buffer (caml-event-window event))) @@ -687,30 +687,30 @@ target-pos (vector target-file target-line target-bol cnum)) (save-excursion - (setq node (caml-types-find-location "type" - target-pos () target-tree)) + (setq node (caml-types-find-location target-pos "type" () + target-tree)) (set-buffer caml-types-buffer) (erase-buffer) (cond - (node - (setq Left - (caml-types-get-pos target-buf (elt node 0)) - Right - (caml-types-get-pos target-buf (elt node 1))) - (move-overlay - caml-types-expr-ovl Left Right target-buf) - (setq limits - (caml-types-find-interval target-buf - target-pos node) - type (elt node 2)) - ) - (t + ((null node) (delete-overlay caml-types-expr-ovl) (setq type "*no type information*") (setq limits (caml-types-find-interval - target-buf target-pos target-tree)) + target-buf target-pos target-tree))) + (t + (let ((left + (caml-types-get-pos target-buf (elt node 0))) + (right + (caml-types-get-pos target-buf (elt node 1)))) + (move-overlay + caml-types-expr-ovl left right target-buf) + (setq limits + (caml-types-find-interval target-buf + target-pos node) + type (cdr (assoc "type" (elt node 2)))) )) + ) (setq mes (format "type: %s" type)) (insert type) )) diff -Nru ocaml-3.12.1/emacs/caml-xemacs.el ocaml-4.01.0/emacs/caml-xemacs.el --- ocaml-3.12.1/emacs/caml-xemacs.el 2010-08-30 15:15:33.000000000 +0000 +++ ocaml-4.01.0/emacs/caml-xemacs.el 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ ;(***********************************************************************) ;(* *) -;(* Objective Caml *) +;(* OCaml *) ;(* *) ;(* Didier Remy, projet Cristal, INRIA Rocquencourt *) ;(* *) @@ -10,8 +10,6 @@ ;(* *) ;(***********************************************************************) -;(* $Id: caml-xemacs.el 10662 2010-08-30 15:15:33Z doligez $ *) - (require 'overlay) ;; for caml-help.el diff -Nru ocaml-3.12.1/emacs/caml.el ocaml-4.01.0/emacs/caml.el --- ocaml-3.12.1/emacs/caml.el 2011-05-20 07:40:01.000000000 +0000 +++ ocaml-4.01.0/emacs/caml.el 2013-07-09 13:45:17.000000000 +0000 @@ -1,6 +1,6 @@ ;(***********************************************************************) ;(* *) -;(* Objective Caml *) +;(* OCaml *) ;(* *) ;(* Jacques Garrigue and Ian T Zimmerman *) ;(* *) @@ -10,21 +10,19 @@ ;(* *) ;(***********************************************************************) -;(* $Id: caml.el 11055 2011-05-20 07:40:01Z garrigue $ *) - -;;; caml.el --- O'Caml code editing commands for Emacs +;;; caml.el --- OCaml code editing commands for Emacs ;; Xavier Leroy, july 1993. ;;indentation code is Copyright (C) 1996 by Ian T Zimmerman ;;copying: covered by the current FSF General Public License. -;; indentation code adapted for Objective Caml by Jacques Garrigue, +;; indentation code adapted for OCaml by Jacques Garrigue, ;; july 1997. ;;user customizable variables (defvar caml-quote-char "'" - "*Quote for character constants. \"'\" for Objective Caml, \"`\" for Caml-Light.") + "*Quote for character constants. \"'\" for OCaml, \"`\" for Caml-Light.") (defvar caml-imenu-enable nil "*Enable Imenu support.") @@ -407,26 +405,27 @@ "Syntax table in use in Caml mode buffers.") (if caml-mode-syntax-table () - (setq caml-mode-syntax-table (make-syntax-table)) - ; backslash is an escape sequence - (modify-syntax-entry ?\\ "\\" caml-mode-syntax-table) - ; ( is first character of comment start - (modify-syntax-entry ?\( "()1n" caml-mode-syntax-table) - ; * is second character of comment start, - ; and first character of comment end - (modify-syntax-entry ?* ". 23n" caml-mode-syntax-table) - ; ) is last character of comment end - (modify-syntax-entry ?\) ")(4" caml-mode-syntax-table) - ; backquote was a string-like delimiter (for character literals) - ; (modify-syntax-entry ?` "\"" caml-mode-syntax-table) - ; quote and underscore are part of words - (modify-syntax-entry ?' "w" caml-mode-syntax-table) - (modify-syntax-entry ?_ "w" caml-mode-syntax-table) - ; ISO-latin accented letters and EUC kanjis are part of words - (let ((i 160)) - (while (< i 256) - (modify-syntax-entry i "w" caml-mode-syntax-table) - (setq i (1+ i))))) + (let ((n (if (string-match "XEmacs" (emacs-version)) "" "n"))) + (setq caml-mode-syntax-table (make-syntax-table)) + ; backslash is an escape sequence + (modify-syntax-entry ?\\ "\\" caml-mode-syntax-table) + ; ( is first character of comment start + (modify-syntax-entry ?\( (concat "()1" n) caml-mode-syntax-table) + ; * is second character of comment start, + ; and first character of comment end + (modify-syntax-entry ?* (concat ". 23" n) caml-mode-syntax-table) + ; ) is last character of comment end + (modify-syntax-entry ?\) ")(4" caml-mode-syntax-table) + ; backquote was a string-like delimiter (for character literals) + ; (modify-syntax-entry ?` "\"" caml-mode-syntax-table) + ; quote and underscore are part of words + (modify-syntax-entry ?' "w" caml-mode-syntax-table) + (modify-syntax-entry ?_ "w" caml-mode-syntax-table) + ; ISO-latin accented letters and EUC kanjis are part of words + (let ((i 160)) + (while (< i 256) + (modify-syntax-entry i "w" caml-mode-syntax-table) + (setq i (1+ i)))))) (defvar caml-mode-abbrev-table nil "Abbrev table used for Caml mode buffers.") @@ -484,7 +483,7 @@ "Hook for caml-mode") (defun caml-mode () - "Major mode for editing Caml code. + "Major mode for editing OCaml code. \\{caml-mode-map}" @@ -543,36 +542,41 @@ (caml-show-imenu))) (run-hooks 'caml-mode-hook)) -(defun caml-set-compile-command () - "Hook to set compile-command locally, unless there is a Makefile or - a _build directory or a _tags file in the current directory." - (interactive) - (unless (or (null buffer-file-name) - (file-exists-p "makefile") - (file-exists-p "Makefile") - (file-exists-p "_build") - (file-exists-p "_tags")) - (let* ((filename (file-name-nondirectory buffer-file-name)) - (basename (file-name-sans-extension filename)) - (command nil)) - (cond - ((string-match ".*\\.mli\$" filename) - (setq command "ocamlc -c")) - ((string-match ".*\\.ml\$" filename) - (setq command "ocamlc -c") ; (concat "ocamlc -o " basename) - ) - ((string-match ".*\\.mll\$" filename) - (setq command "ocamllex")) - ((string-match ".*\\.mll\$" filename) - (setq command "ocamlyacc")) - ) - (if command - (progn - (make-local-variable 'compile-command) - (setq compile-command (concat command " " filename)))) - ))) -(add-hook 'caml-mode-hook 'caml-set-compile-command) +;; Disabled because it assumes make and does not play well with ocamlbuild. +;; See PR#4469 for details. + +;; (defun caml-set-compile-command () +;; "Hook to set compile-command locally, unless there is a Makefile or +;; a _build directory or a _tags file in the current directory." +;; (interactive) +;; (unless (or (null buffer-file-name) +;; (file-exists-p "makefile") +;; (file-exists-p "Makefile") +;; (file-exists-p "_build") +;; (file-exists-p "_tags")) +;; (let* ((filename (file-name-nondirectory buffer-file-name)) +;; (basename (file-name-sans-extension filename)) +;; (command nil)) +;; (cond +;; ((string-match ".*\\.mli\$" filename) +;; (setq command "ocamlc -c")) +;; ((string-match ".*\\.ml\$" filename) +;; (setq command "ocamlc -c") ; (concat "ocamlc -o " basename) +;; ) +;; ((string-match ".*\\.mll\$" filename) +;; (setq command "ocamllex")) +;; ((string-match ".*\\.mll\$" filename) +;; (setq command "ocamlyacc")) +;; ) +;; (if command +;; (progn +;; (make-local-variable 'compile-command) +;; (setq compile-command (concat command " " filename)))) +;; ))) + +;; (add-hook 'caml-mode-hook 'caml-set-compile-command) + ;;; Auxiliary function. Garrigue 96-11-01. @@ -588,7 +592,7 @@ ;;; subshell support (defun caml-eval-region (start end) - "Send the current region to the inferior Caml process." + "Send the current region to the inferior OCaml process." (interactive"r") (require 'inf-caml) (inferior-caml-eval-region start end)) @@ -596,7 +600,7 @@ ;; old version ---to be deleted later ; ; (defun caml-eval-phrase () -; "Send the current Caml phrase to the inferior Caml process." +; "Send the current OCaml phrase to the inferior Caml process." ; (interactive) ; (save-excursion ; (let ((bounds (caml-mark-phrase))) @@ -693,14 +697,14 @@ ((looking-at "[ \t]*method") (setq method-alist (cons index method-alist))))) ;; build menu - (mapcar - '(lambda (pair) - (if (symbol-value (cdr pair)) - (setq menu-alist - (cons - (cons (car pair) - (sort (symbol-value (cdr pair)) 'imenu--sort-by-name)) - menu-alist)))) + (mapc + (lambda (pair) + (if (symbol-value (cdr pair)) + (setq menu-alist + (cons + (cons (car pair) + (sort (symbol-value (cdr pair)) 'imenu--sort-by-name)) + menu-alist)))) '(("Values" . value-alist) ("Types" . type-alist) ("Modules" . module-alist) @@ -789,17 +793,32 @@ ;; In Emacs 19, the regexps in compilation-error-regexp-alist do not ;; match the error messages when the language is not English. ;; Hence we add a regexp. +;; FIXME do we (still) have i18n of error messages ??? (defconst caml-error-regexp "^[ A-\377]+ \"\\([^\"\n]+\\)\", [A-\377]+ \\([0-9]+\\)[-,:]" "Regular expression matching the error messages produced by camlc.") +;; Newer emacs versions support line/char ranges +;; We will adapt OCaml to output error messages in a compatible format. +;; In the meantime we add the new format here in addition to the old one. +(defconst caml-error-regexp-newstyle + (concat "^[ A-\377]+ \"\\([^\"\n]+\\)\", line \\([0-9]+\\)," + "char \\([0-9]+\\) to line \\([0-9]+\\), char \\([0-9]+\\):") + "Regular expression matching the error messages produced by ocamlc/ocamlopt.") + (if (boundp 'compilation-error-regexp-alist) - (or (assoc caml-error-regexp - compilation-error-regexp-alist) - (setq compilation-error-regexp-alist - (cons (list caml-error-regexp 1 2) - compilation-error-regexp-alist)))) + (progn + (or (assoc caml-error-regexp + compilation-error-regexp-alist) + (setq compilation-error-regexp-alist + (cons (list caml-error-regexp 1 2) + compilation-error-regexp-alist))) + (or (assoc caml-error-regexp-newstyle + compilation-error-regexp-alist) + (setq compilation-error-regexp-alist + (cons (list caml-error-regexp-newstyle 1 '(2 . 4) '(3 . 5)) + compilation-error-regexp-alist))))) ;; A regexp to extract the range info @@ -825,7 +844,7 @@ ;that way we get our effect even when we do \C-x` in compilation buffer (defadvice next-error (after caml-next-error activate) - "Reads the extra positional information provided by the Caml compiler. + "Reads the extra positional information provided by the OCaml compiler. Puts the point and the mark exactly around the erroneous program fragment. The erroneous fragment is also temporarily highlighted if @@ -903,7 +922,7 @@ ;; itz Thu Sep 24 19:02:42 PDT 1998 this is to have some level of ;; comfort when sending phrases to the toplevel and getting errors. (defun caml-goto-phrase-error () - "Find the error location in current Caml phrase." + "Find the error location in current OCaml phrase." (interactive) (require 'inf-caml) (let ((bounds (save-excursion (caml-mark-phrase)))) @@ -984,7 +1003,7 @@ beg)) (defun caml-mark-phrase (&optional min-pos max-pos) - "Put mark at end of this Caml phrase, point at beginning. + "Put mark at end of this OCaml phrase, point at beginning. " (interactive) (let* ((beg (caml-find-phrase min-pos max-pos)) (end (point))) @@ -1185,6 +1204,11 @@ (defconst caml-kwop-regexps (make-vector 9 nil) "Array of regexps representing caml keywords of different priorities.") +(defun caml-in-shebang-line () + (save-excursion + (beginning-of-line) + (and (= 1 (point)) (looking-at "#!")))) + (defun caml-in-expr-p () (let ((pos (point)) (in-expr t)) (caml-find-kwop @@ -1192,6 +1216,8 @@ caml-matching-kw-regexp "\\|" (aref caml-kwop-regexps caml-max-indent-priority))) (cond + ; special case for #! at beginning of file + ((caml-in-shebang-line) (setq in-expr nil)) ; special case for ;; ((and (> (point) 1) (= (preceding-char) ?\;) (= (following-char) ?\;)) (setq in-expr nil)) @@ -1756,7 +1782,7 @@ (goto-char (match-end 0)))) ;; to mark phrases, so that repeated calls will take several of them -;; knows little about Ocaml appart literals and comments, so it should work +;; knows little about OCaml except literals and comments, so it should work ;; with other dialects as long as ;; marks the end of phrase. (defun caml-indent-phrase (arg) @@ -1912,7 +1938,7 @@ (beginning-of-line 1) (backward-char 4))) -(autoload 'run-caml "inf-caml" "Run an inferior Caml process." t) +(autoload 'run-caml "inf-caml" "Run an inferior OCaml process." t) (autoload 'caml-types-show-type "caml-types" "Show the type of expression or pattern at point." t) diff -Nru ocaml-3.12.1/emacs/camldebug.el ocaml-4.01.0/emacs/camldebug.el --- ocaml-3.12.1/emacs/camldebug.el 2010-08-30 10:16:22.000000000 +0000 +++ ocaml-4.01.0/emacs/camldebug.el 2013-03-22 18:19:29.000000000 +0000 @@ -1,6 +1,6 @@ ;(***********************************************************************) ;(* *) -;(* Objective Caml *) +;(* OCaml *) ;(* *) ;(* Jacques Garrigue and Ian T Zimmerman *) ;(* *) @@ -10,8 +10,6 @@ ;(* *) ;(***********************************************************************) -;(* $Id: camldebug.el 10661 2010-08-30 10:16:22Z doligez $ *) - ;;; Run camldebug under Emacs ;;; Derived from gdb.el. ;;; gdb.el is Copyright (C) 1988 Free Software Foundation, Inc, and is part @@ -89,7 +87,7 @@ (define-derived-mode camldebug-mode comint-mode "Inferior CDB" - "Major mode for interacting with an inferior Camldebug process. + "Major mode for interacting with an inferior ocamldebug process. The following commands are available: @@ -98,8 +96,8 @@ \\[camldebug-display-frame] displays in the other window the last line referred to in the camldebug buffer. -\\[camldebug-step], \\[camldebug-back] and \\[camldebug-next], in the camldebug window, -call camldebug to step, backstep or next and then update the other window +\\[camldebug-step], \\[camldebug-back] and \\[camldebug-next], in the camldebug +window,call camldebug to step, backstep or next and then update the other window with the current file and position. If you are in a source file, you may select a point to break @@ -252,7 +250,8 @@ camldebug-goto-position "-[0-9]+[ \t]*\\(before\\).*\n") camldebug-filter-accumulator) - (string-match (concat "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)[ \t]+[0-9]+-" + (string-match (concat "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)" + "[ \t]+[0-9]+-" camldebug-goto-position "[ \t]*\\(after\\).*\n") camldebug-filter-accumulator))) @@ -575,7 +574,7 @@ (let ((process-window)) ;; it does not seem necessary to save excursion here, ;; since set-buffer as a temporary effect. - ;; comint-output-filter explicitly avoids it. + ;; comint-output-filter explicitly avoids it. ;; in version 23, it prevents the marker to stay at end of buffer ;; (save-excursion (set-buffer (process-buffer proc)) @@ -595,8 +594,8 @@ (get-buffer-window (current-buffer)))) ;; Insert the text, moving the process-marker. (comint-output-filter proc output) - ;; ) - ;; this was the end of save-excursion. + ;; ) + ;; this was the end of save-excursion. ;; if save-excursion is used (comint-next-prompt 1) would be needed ;; to move the mark past then next prompt, but this is not as good ;; as solution. @@ -712,7 +711,8 @@ ;;; Miscellaneous. (defun camldebug-module-name (filename) - (substring filename (string-match "\\([^/]*\\)\\.ml$" filename) (match-end 1))) + (substring filename (string-match "\\([^/]*\\)\\.ml$" filename) + (match-end 1))) ;;; The camldebug-call function must do the right thing whether its ;;; invoking keystroke is from the camldebug buffer itself (via diff -Nru ocaml-3.12.1/emacs/inf-caml.el ocaml-4.01.0/emacs/inf-caml.el --- ocaml-3.12.1/emacs/inf-caml.el 2011-05-05 11:28:57.000000000 +0000 +++ ocaml-4.01.0/emacs/inf-caml.el 2013-03-22 18:19:29.000000000 +0000 @@ -1,6 +1,6 @@ ;(***********************************************************************) ;(* *) -;(* Objective Caml *) +;(* OCaml *) ;(* *) ;(* Xavier Leroy and Jacques Garrigue *) ;(* *) @@ -10,9 +10,7 @@ ;(* *) ;(***********************************************************************) -;(* $Id: inf-caml.el 11027 2011-05-05 11:28:57Z doligez $ *) - -;;; inf-caml.el --- run the Caml toplevel in an Emacs buffer +;;; inf-caml.el --- run the OCaml toplevel in an Emacs buffer ;; Xavier Leroy, july 1993. @@ -37,14 +35,14 @@ (setq inferior-caml-mode-map (copy-keymap comint-mode-map))) -;; Augment Caml mode, so you can process Caml code in the source files. +;; Augment Caml mode, so you can process OCaml code in the source files. (defvar inferior-caml-program "ocaml" - "*Program name for invoking an inferior Caml from Emacs.") + "*Program name for invoking an inferior OCaml from Emacs.") (defun inferior-caml-mode () - "Major mode for interacting with an inferior Caml process. -Runs a Caml toplevel as a subprocess of Emacs, with I/O through an + "Major mode for interacting with an inferior OCaml process. +Runs an OCaml toplevel as a subprocess of Emacs, with I/O through an Emacs buffer. A history of input phrases is maintained. Phrases can be sent from another buffer in Caml mode. @@ -95,7 +93,7 @@ (defun inferior-caml-mode-output-hook () (set-variable 'comint-output-filter-functions - (list (function inferior-caml-signal-output)) + (list (function inferior-caml-signal-output)) t)) (add-hook 'inferior-caml-mode-hooks 'inferior-caml-mode-output-hook) @@ -106,7 +104,7 @@ (if (not cmd) (if (comint-check-proc inferior-caml-buffer-name) (setq cmd inferior-caml-program) - (setq cmd (read-from-minibuffer "Caml toplevel to run: " + (setq cmd (read-from-minibuffer "OCaml toplevel to run: " inferior-caml-program)))) (setq inferior-caml-program cmd) (let ((cmdlist (inferior-caml-args-to-list cmd)) @@ -124,11 +122,11 @@ ;; caml-run-process-when-needed (defun run-caml (&optional cmd) - "Run an inferior Caml process. + "Run an inferior OCaml process. Input and output via buffer `*inferior-caml*'." (interactive (list (if (not (comint-check-proc inferior-caml-buffer-name)) - (read-from-minibuffer "Caml toplevel to run: " + (read-from-minibuffer "OCaml toplevel to run: " inferior-caml-program)))) (caml-run-process-if-needed cmd) (switch-to-buffer-other-window inferior-caml-buffer-name)) @@ -174,7 +172,7 @@ ;; patched by Didier to move cursor after evaluation (defun inferior-caml-eval-region (start end) - "Send the current region to the inferior Caml process." + "Send the current region to the inferior OCaml process." (interactive "r") (save-excursion (caml-run-process-if-needed)) (save-excursion @@ -282,7 +280,8 @@ (column (- (match-end 3) (match-beginning 3))) (width (- (match-end 2) (match-end 3)))) (if (string-match "^\\(.*\\)[<]EOF[>]$" expr) - (setq expr (substring expr (match-beginning 1) (match-end 1)))) + (setq expr (substring expr (match-beginning 1) + (match-end 1)))) (switch-to-buffer buf) (re-search-backward (concat "^" (regexp-quote expr) "$") diff -Nru ocaml-3.12.1/emacs/ocamltags.in ocaml-4.01.0/emacs/ocamltags.in --- ocaml-3.12.1/emacs/ocamltags.in 2004-08-20 17:04:35.000000000 +0000 +++ ocaml-4.01.0/emacs/ocamltags.in 2012-10-15 17:50:56.000000000 +0000 @@ -2,7 +2,7 @@ ;(***********************************************************************) ;(* *) -;(* Objective Caml *) +;(* OCaml *) ;(* *) ;(* Jacques Garrigue and Ian T Zimmerman *) ;(* *) @@ -12,8 +12,6 @@ ;(* *) ;(***********************************************************************) -;(* $Id: ocamltags.in 6612 2004-08-20 17:04:35Z doligez $ *) - ;; Copyright (C) 1998 Ian Zimmerman ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -24,7 +22,6 @@ ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. -;; $Id: ocamltags.in 6612 2004-08-20 17:04:35Z doligez $ (require 'caml) diff -Nru ocaml-3.12.1/lex/.cvsignore ocaml-4.01.0/lex/.cvsignore --- ocaml-3.12.1/lex/.cvsignore 2002-04-22 10:06:01.000000000 +0000 +++ ocaml-4.01.0/lex/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -parser.ml -parser.mli -lexer.ml -ocamllex -ocamllex.opt -parser.output diff -Nru ocaml-3.12.1/lex/.depend ocaml-4.01.0/lex/.depend --- ocaml-3.12.1/lex/.depend 2010-01-20 16:26:46.000000000 +0000 +++ ocaml-4.01.0/lex/.depend 2013-08-15 16:13:16.000000000 +0000 @@ -1,34 +1,34 @@ -common.cmi: syntax.cmi lexgen.cmi -compact.cmi: lexgen.cmi -cset.cmi: -lexer.cmi: parser.cmi -lexgen.cmi: syntax.cmi -output.cmi: syntax.cmi lexgen.cmi compact.cmi common.cmi -outputbis.cmi: syntax.cmi lexgen.cmi common.cmi -parser.cmi: syntax.cmi -syntax.cmi: cset.cmi -table.cmi: -common.cmo: syntax.cmi lexgen.cmi common.cmi -common.cmx: syntax.cmx lexgen.cmx common.cmi -compact.cmo: table.cmi lexgen.cmi compact.cmi -compact.cmx: table.cmx lexgen.cmx compact.cmi -cset.cmo: cset.cmi -cset.cmx: cset.cmi -lexer.cmo: syntax.cmi parser.cmi lexer.cmi -lexer.cmx: syntax.cmx parser.cmx lexer.cmi -lexgen.cmo: table.cmi syntax.cmi cset.cmi lexgen.cmi -lexgen.cmx: table.cmx syntax.cmx cset.cmx lexgen.cmi -main.cmo: syntax.cmi parser.cmi outputbis.cmi output.cmi lexgen.cmi lexer.cmi \ - cset.cmi compact.cmi common.cmi -main.cmx: syntax.cmx parser.cmx outputbis.cmx output.cmx lexgen.cmx lexer.cmx \ - cset.cmx compact.cmx common.cmx -output.cmo: syntax.cmi lexgen.cmi compact.cmi common.cmi output.cmi -output.cmx: syntax.cmx lexgen.cmx compact.cmx common.cmx output.cmi -outputbis.cmo: syntax.cmi lexgen.cmi common.cmi outputbis.cmi -outputbis.cmx: syntax.cmx lexgen.cmx common.cmx outputbis.cmi -parser.cmo: syntax.cmi cset.cmi parser.cmi -parser.cmx: syntax.cmx cset.cmx parser.cmi -syntax.cmo: cset.cmi syntax.cmi -syntax.cmx: cset.cmx syntax.cmi -table.cmo: table.cmi -table.cmx: table.cmi +common.cmi : syntax.cmi lexgen.cmi +compact.cmi : lexgen.cmi +cset.cmi : +lexer.cmi : parser.cmi +lexgen.cmi : syntax.cmi +output.cmi : syntax.cmi lexgen.cmi compact.cmi common.cmi +outputbis.cmi : syntax.cmi lexgen.cmi common.cmi +parser.cmi : syntax.cmi +syntax.cmi : cset.cmi +table.cmi : +common.cmo : syntax.cmi lexgen.cmi common.cmi +common.cmx : syntax.cmx lexgen.cmx common.cmi +compact.cmo : table.cmi lexgen.cmi compact.cmi +compact.cmx : table.cmx lexgen.cmx compact.cmi +cset.cmo : cset.cmi +cset.cmx : cset.cmi +lexer.cmo : syntax.cmi parser.cmi lexer.cmi +lexer.cmx : syntax.cmx parser.cmx lexer.cmi +lexgen.cmo : table.cmi syntax.cmi cset.cmi lexgen.cmi +lexgen.cmx : table.cmx syntax.cmx cset.cmx lexgen.cmi +main.cmo : syntax.cmi parser.cmi outputbis.cmi output.cmi lexgen.cmi \ + lexer.cmi cset.cmi compact.cmi common.cmi +main.cmx : syntax.cmx parser.cmx outputbis.cmx output.cmx lexgen.cmx \ + lexer.cmx cset.cmx compact.cmx common.cmx +output.cmo : lexgen.cmi compact.cmi common.cmi output.cmi +output.cmx : lexgen.cmx compact.cmx common.cmx output.cmi +outputbis.cmo : lexgen.cmi common.cmi outputbis.cmi +outputbis.cmx : lexgen.cmx common.cmx outputbis.cmi +parser.cmo : syntax.cmi cset.cmi parser.cmi +parser.cmx : syntax.cmx cset.cmx parser.cmi +syntax.cmo : cset.cmi syntax.cmi +syntax.cmx : cset.cmx syntax.cmi +table.cmo : table.cmi +table.cmx : table.cmi diff -Nru ocaml-3.12.1/lex/.ignore ocaml-4.01.0/lex/.ignore --- ocaml-3.12.1/lex/.ignore 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/lex/.ignore 2012-07-17 15:31:12.000000000 +0000 @@ -0,0 +1,6 @@ +parser.ml +parser.mli +lexer.ml +ocamllex +ocamllex.opt +parser.output diff -Nru ocaml-3.12.1/lex/Makefile ocaml-4.01.0/lex/Makefile --- ocaml-3.12.1/lex/Makefile 2009-12-09 09:52:47.000000000 +0000 +++ ocaml-4.01.0/lex/Makefile 2013-04-18 11:58:59.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -10,25 +10,24 @@ # # ######################################################################### -# $Id: Makefile 9467 2009-12-09 09:52:47Z weis $ - # The lexer generator CAMLC=../boot/ocamlrun ../boot/ocamlc -strict-sequence -nostdlib -I ../boot CAMLOPT=../boot/ocamlrun ../ocamlopt -nostdlib -I ../stdlib -COMPFLAGS=-warn-error A +COMPFLAGS=-w +33..39 -warn-error A CAMLYACC=../boot/ocamlyacc YACCFLAGS=-v CAMLLEX=../boot/ocamlrun ../boot/ocamllex CAMLDEP=../boot/ocamlrun ../tools/ocamldep -OBJS=cset.cmo syntax.cmo parser.cmo lexer.cmo table.cmo lexgen.cmo compact.cmo common.cmo output.cmo outputbis.cmo main.cmo +OBJS=cset.cmo syntax.cmo parser.cmo lexer.cmo table.cmo lexgen.cmo \ + compact.cmo common.cmo output.cmo outputbis.cmo main.cmo all: ocamllex allopt: ocamllex.opt ocamllex: $(OBJS) - $(CAMLC) $(LINKFLAGS) -o ocamllex $(OBJS) + $(CAMLC) $(LINKFLAGS) -compat-32 -o ocamllex $(OBJS) ocamllex.opt: $(OBJS:.cmo=.cmx) $(CAMLOPT) -o ocamllex.opt $(OBJS:.cmo=.cmx) diff -Nru ocaml-3.12.1/lex/Makefile.nt ocaml-4.01.0/lex/Makefile.nt --- ocaml-3.12.1/lex/Makefile.nt 2010-01-20 16:26:46.000000000 +0000 +++ ocaml-4.01.0/lex/Makefile.nt 2013-04-18 11:58:59.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -10,8 +10,6 @@ # # ######################################################################### -# $Id: Makefile.nt 9540 2010-01-20 16:26:46Z doligez $ - # The lexer generator include ../config/Makefile @@ -26,13 +24,14 @@ CAMLDEP=../boot/ocamlrun ../tools/ocamldep DEPFLAGS= -OBJS=cset.cmo syntax.cmo parser.cmo lexer.cmo table.cmo lexgen.cmo compact.cmo common.cmo output.cmo outputbis.cmo main.cmo +OBJS=cset.cmo syntax.cmo parser.cmo lexer.cmo table.cmo lexgen.cmo \ + compact.cmo common.cmo output.cmo outputbis.cmo main.cmo all: ocamllex syntax.cmo allopt: ocamllex.opt ocamllex: $(OBJS) - $(CAMLC) $(LINKFLAGS) -o ocamllex $(OBJS) + $(CAMLC) $(LINKFLAGS) -compat-32 -o ocamllex $(OBJS) ocamllex.opt: $(OBJS:.cmo=.cmx) $(CAMLOPT) -o ocamllex.opt $(OBJS:.cmo=.cmx) diff -Nru ocaml-3.12.1/lex/common.ml ocaml-4.01.0/lex/common.ml --- ocaml-3.12.1/lex/common.ml 2007-01-29 16:44:16.000000000 +0000 +++ ocaml-4.01.0/lex/common.ml 2013-07-11 15:51:25.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Luc Maranget, projet Moscova, *) (* INRIA Rocquencourt *) @@ -58,7 +58,7 @@ done let copy_chars_win32 ic oc start stop = - for i = start to stop - 1 do + for _i = start to stop - 1 do let c = input_char ic in if c <> '\r' then output_char oc c done @@ -68,14 +68,14 @@ "Win32" | "Cygwin" -> copy_chars_win32 | _ -> copy_chars_unix -let copy_chunk sourcefile ic oc trl loc add_parens = +let copy_chunk ic oc trl loc add_parens = if loc.start_pos < loc.end_pos || add_parens then begin - fprintf oc "# %d \"%s\"\n" loc.start_line sourcefile; + fprintf oc "# %d \"%s\"\n" loc.start_line loc.loc_file; if add_parens then begin - for i = 1 to loc.start_col - 1 do output_char oc ' ' done; + for _i = 1 to loc.start_col - 1 do output_char oc ' ' done; output_char oc '('; end else begin - for i = 1 to loc.start_col do output_char oc ' ' done; + for _i = 1 to loc.start_col do output_char oc ' ' done; end; seek_in ic loc.start_pos; copy_chars ic oc loc.start_pos loc.end_pos; @@ -122,7 +122,7 @@ | Sum (a,i) -> fprintf oc "(%a + %d)" output_base_mem a i -let output_env sourcefile ic oc tr env = +let output_env ic oc tr env = let pref = ref "let" in match env with | [] -> () @@ -138,7 +138,7 @@ List.iter (fun ((x,pos),v) -> fprintf oc "%s\n" !pref ; - copy_chunk sourcefile ic oc tr pos false ; + copy_chunk ic oc tr pos false ; begin match v with | Ident_string (o,nstart,nend) -> fprintf oc diff -Nru ocaml-3.12.1/lex/common.mli ocaml-4.01.0/lex/common.mli --- ocaml-3.12.1/lex/common.mli 2007-01-29 16:44:16.000000000 +0000 +++ ocaml-4.01.0/lex/common.mli 2013-07-11 15:51:25.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Damien Doligez, projet Moscova, INRIA Rocquencourt *) (* *) @@ -14,13 +14,12 @@ val open_tracker : string -> out_channel -> line_tracker val close_tracker : line_tracker -> unit val copy_chunk : - string -> in_channel -> out_channel -> line_tracker -> Syntax.location -> bool -> unit val output_mem_access : out_channel -> int -> unit val output_memory_actions : string -> out_channel -> Lexgen.memory_action list -> unit val output_env : - string -> in_channel -> out_channel -> line_tracker -> + in_channel -> out_channel -> line_tracker -> (Lexgen.ident * Lexgen.ident_info) list -> unit val output_args : out_channel -> string list -> unit diff -Nru ocaml-3.12.1/lex/compact.ml ocaml-4.01.0/lex/compact.ml --- ocaml-3.12.1/lex/compact.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/lex/compact.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: compact.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Compaction of an automata *) open Lexgen diff -Nru ocaml-3.12.1/lex/compact.mli ocaml-4.01.0/lex/compact.mli --- ocaml-3.12.1/lex/compact.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/lex/compact.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: compact.mli 9547 2010-01-22 12:48:24Z doligez $ *) - (* Compaction of an automata *) type lex_tables = { tbl_base: int array; (* Perform / Shift *) diff -Nru ocaml-3.12.1/lex/cset.ml ocaml-4.01.0/lex/cset.ml --- ocaml-3.12.1/lex/cset.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/lex/cset.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Luc Maranget, Jerome Vouillon projet Cristal, *) (* INRIA Rocquencourt *) @@ -11,9 +11,6 @@ (* *) (***********************************************************************) -(* $Id: cset.ml 9547 2010-01-22 12:48:24Z doligez $ *) - - exception Bad type t = (int * int) list diff -Nru ocaml-3.12.1/lex/cset.mli ocaml-4.01.0/lex/cset.mli --- ocaml-3.12.1/lex/cset.mli 2010-04-18 09:02:40.000000000 +0000 +++ ocaml-4.01.0/lex/cset.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Luc Maranget, Jerome Vouillon projet Cristal, *) (* INRIA Rocquencourt *) @@ -11,8 +11,6 @@ (* *) (***********************************************************************) -(* $Id: cset.mli 10268 2010-04-18 09:02:40Z xleroy $ *) - (* Set of characters encoded as list of intervals *) type t diff -Nru ocaml-3.12.1/lex/lexer.mli ocaml-4.01.0/lex/lexer.mli --- ocaml-3.12.1/lex/lexer.mli 2004-04-21 23:26:06.000000000 +0000 +++ ocaml-4.01.0/lex/lexer.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: lexer.mli 6244 2004-04-21 23:26:06Z doligez $ *) - val main: Lexing.lexbuf -> Parser.token exception Lexical_error of string * string * int * int diff -Nru ocaml-3.12.1/lex/lexer.mll ocaml-4.01.0/lex/lexer.mll --- ocaml-3.12.1/lex/lexer.mll 2006-01-04 16:55:50.000000000 +0000 +++ ocaml-4.01.0/lex/lexer.mll 2013-07-11 15:51:25.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: lexer.mll 7307 2006-01-04 16:55:50Z doligez $ *) - (* The lexical analyzer for lexer definitions. Bootstrapped! *) { @@ -36,10 +34,10 @@ let get_stored_string () = Buffer.contents string_buff let char_for_backslash = function - 'n' -> '\n' - | 't' -> '\t' - | 'b' -> '\b' - | 'r' -> '\r' + 'n' -> '\010' + | 'r' -> '\013' + | 'b' -> '\008' + | 't' -> '\009' | c -> c let raise_lexical_error lexbuf msg = @@ -114,7 +112,7 @@ let identbody = ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9'] let backslash_escapes = - ['\\' '"' '\'' 'n' 't' 'b' 'r'] + ['\\' '\'' '"' 'n' 't' 'b' 'r' ' '] rule main = parse [' ' '\013' '\009' '\012' ] + @@ -168,12 +166,13 @@ } | '{' { let p = Lexing.lexeme_end_p lexbuf in + let f = p.Lexing.pos_fname in let n1 = p.Lexing.pos_cnum and l1 = p.Lexing.pos_lnum and s1 = p.Lexing.pos_bol in brace_depth := 1; let n2 = handle_lexical_error action lexbuf in - Taction({start_pos = n1; end_pos = n2; + Taction({loc_file = f; start_pos = n1; end_pos = n2; start_line = l1; start_col = n1 - s1}) } | '=' { Tequal } | '|' { Tor } diff -Nru ocaml-3.12.1/lex/lexgen.ml ocaml-4.01.0/lex/lexgen.ml --- ocaml-3.12.1/lex/lexgen.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/lex/lexgen.ml 2013-05-29 18:05:44.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, *) (* Luc Maranget, projet Moscova, *) @@ -12,8 +12,6 @@ (* *) (***********************************************************************) -(* $Id: lexgen.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (* Compiling a lexer definition *) open Syntax @@ -80,7 +78,8 @@ (* A lot of sets and map structures *) -module Ints = Set.Make(struct type t = int let compare = compare end) +module Ints = + Set.Make(struct type t = int let compare (x:t) y = compare x y end) let id_compare (id1,_) (id2,_) = String.compare id1 id2 @@ -508,7 +507,7 @@ chars_count := 0; let entry_list = List.map - (fun {name=entry_name ; args=args ; shortest=shortest ; clauses= casedef} -> + (fun {name=entry_name; args=args; shortest=shortest; clauses=casedef} -> let (re,actions,_,ntags) = encode_casedef casedef in { lex_name = entry_name; lex_regexp = re; @@ -524,8 +523,8 @@ Extension to tagged automata. Confer Ville Larikari - ``NFAs with Tagged Transitions, their Conversion to Deterministic - Automata and Application to Regular Expressions''. + 'NFAs with Tagged Transitions, their Conversion to Deterministic + Automata and Application to Regular Expressions'. Symposium on String Processing and Information Retrieval (SPIRE 2000), http://kouli.iki.fi/~vlaurika/spire2000-tnfa.ps (See also) @@ -606,7 +605,8 @@ fill s r2 | Star r -> fill (TransSet.union (firstpos r) s) r in - List.iter (fun (entry,_,_) -> fill TransSet.empty entry.lex_regexp) entry_list ; + List.iter (fun (entry,_,_) -> fill TransSet.empty entry.lex_regexp) + entry_list; v (************************) @@ -620,7 +620,8 @@ module MemMap = - Map.Make (struct type t = int let compare = Pervasives.compare end) + Map.Make (struct type t = int + let compare (x:t) y = Pervasives.compare x y end) type 'a dfa_state = {final : int * ('a * int TagMap.t) ; diff -Nru ocaml-3.12.1/lex/lexgen.mli ocaml-4.01.0/lex/lexgen.mli --- ocaml-3.12.1/lex/lexgen.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/lex/lexgen.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,9 +10,6 @@ (* *) (***********************************************************************) -(* $Id: lexgen.mli 9547 2010-01-22 12:48:24Z doligez $ *) - - (* raised when there are too many bindings (>= 254 memory cells) *) exception Memory_overflow diff -Nru ocaml-3.12.1/lex/main.ml ocaml-4.01.0/lex/main.ml --- ocaml-3.12.1/lex/main.ml 2010-05-20 14:06:29.000000000 +0000 +++ ocaml-4.01.0/lex/main.ml 2013-03-09 22:38:52.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,12 +10,9 @@ (* *) (***********************************************************************) -(* $Id: main.ml 10444 2010-05-20 14:06:29Z doligez $ *) - (* The lexer generator. Command-line parsing. *) open Syntax -open Lexgen let ml_automata = ref false let source_name = ref None @@ -24,7 +21,7 @@ let usage = "usage: ocamlex [options] sourcefile" let print_version_string () = - print_string "The Objective Caml lexer generator, version "; + print_string "The OCaml lexer generator, version "; print_string Sys.ocaml_version ; print_newline(); exit 0 @@ -35,7 +32,8 @@ let specs = ["-ml", Arg.Set ml_automata, - " Output code that does not use the Lexing module built-in automata interpreter"; + " Output code that does not use the Lexing module built-in automata \ + interpreter"; "-o", Arg.String (fun x -> output_name := Some x), " Set output file name to "; "-q", Arg.Set Common.quiet_mode, " Do not display informational messages"; diff -Nru ocaml-3.12.1/lex/output.ml ocaml-4.01.0/lex/output.ml --- ocaml-3.12.1/lex/output.ml 2010-09-29 16:46:54.000000000 +0000 +++ ocaml-4.01.0/lex/output.ml 2013-07-11 15:51:25.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,12 +10,9 @@ (* *) (***********************************************************************) -(* $Id: output.ml 10695 2010-09-29 16:46:54Z doligez $ *) - (* Output the DFA tables and its entry points *) open Printf -open Syntax open Lexgen open Compact open Common @@ -95,12 +92,12 @@ (fun (num, env, loc) -> fprintf oc " | "; fprintf oc "%d ->\n" num; - output_env sourcefile ic oc oci env; - copy_chunk sourcefile ic oc oci loc true; + output_env ic oc oci env; + copy_chunk ic oc oci loc true; fprintf oc "\n") e.auto_actions; fprintf oc " | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; \ - __ocaml_lex_%s_rec %alexbuf __ocaml_lex_state\n\n" + __ocaml_lex_%s_rec %alexbuf __ocaml_lex_state\n\n" e.auto_name output_args e.auto_args (* Main output function *) @@ -126,7 +123,7 @@ Printf.printf "%d additional bytes used for bindings\n" size_groups ; flush stdout; if Array.length tables.tbl_trans > 0x8000 then raise Table_overflow; - copy_chunk sourcefile ic oc oci header false; + copy_chunk ic oc oci header false; output_tables oc tables; begin match entry_points with [] -> () @@ -137,4 +134,4 @@ entries; output_string oc ";;\n\n"; end; - copy_chunk sourcefile ic oc oci trailer false + copy_chunk ic oc oci trailer false diff -Nru ocaml-3.12.1/lex/output.mli ocaml-4.01.0/lex/output.mli --- ocaml-3.12.1/lex/output.mli 2002-12-09 10:44:46.000000000 +0000 +++ ocaml-4.01.0/lex/output.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: output.mli 5323 2002-12-09 10:44:46Z maranget $ *) - (* Output the DFA tables and its entry points *) val output_lexdef: diff -Nru ocaml-3.12.1/lex/outputbis.ml ocaml-4.01.0/lex/outputbis.ml --- ocaml-3.12.1/lex/outputbis.ml 2010-09-29 16:46:54.000000000 +0000 +++ ocaml-4.01.0/lex/outputbis.ml 2013-07-11 15:51:25.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,12 +10,9 @@ (* *) (***********************************************************************) -(* $Id: outputbis.ml 10695 2010-09-29 16:46:54Z doligez $ *) - (* Output the DFA tables and its entry points *) open Printf -open Syntax open Lexgen open Common @@ -160,7 +157,7 @@ \n let __ocaml_lex_result = __ocaml_lex_state%d lexbuf in\ \n lexbuf.Lexing.lex_start_p <- lexbuf.Lexing.lex_curr_p;\ \n lexbuf.Lexing.lex_curr_p <- {lexbuf.Lexing.lex_curr_p with\ -\n Lexing.pos_cnum = lexbuf.Lexing.lex_abs_pos + lexbuf.Lexing.lex_curr_pos};\ +\n Lexing.pos_cnum = lexbuf.Lexing.lex_abs_pos+lexbuf.Lexing.lex_curr_pos};\ \n match __ocaml_lex_result with\n" e.auto_name output_args e.auto_args e.auto_mem_size (output_memory_actions " ") init_moves init_num ; @@ -168,8 +165,8 @@ (fun (num, env, loc) -> fprintf oc " | "; fprintf oc "%d ->\n" num; - output_env sourcefile ic oc tr env ; - copy_chunk sourcefile ic oc tr loc true; + output_env ic oc tr env ; + copy_chunk ic oc tr loc true; fprintf oc "\n") e.auto_actions; fprintf oc " | _ -> raise (Failure \"lexing: empty token\")\n\n\n" @@ -179,7 +176,7 @@ let output_lexdef sourcefile ic oc tr header entry_points transitions trailer = - copy_chunk sourcefile ic oc tr header false; + copy_chunk ic oc tr header false; output_automata oc transitions ; begin match entry_points with [] -> () @@ -190,4 +187,4 @@ entries; output_string oc ";;\n\n"; end; - copy_chunk sourcefile ic oc tr trailer false + copy_chunk ic oc tr trailer false diff -Nru ocaml-3.12.1/lex/outputbis.mli ocaml-4.01.0/lex/outputbis.mli --- ocaml-3.12.1/lex/outputbis.mli 2002-12-09 10:44:46.000000000 +0000 +++ ocaml-4.01.0/lex/outputbis.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Luc Maranget projet Moscova INRIA Rocquencourt *) (* *) @@ -10,7 +10,6 @@ (* *) (***********************************************************************) -(* $Id: outputbis.mli 5323 2002-12-09 10:44:46Z maranget $ *) val output_lexdef : string -> in_channel -> diff -Nru ocaml-3.12.1/lex/parser.mly ocaml-4.01.0/lex/parser.mly --- ocaml-3.12.1/lex/parser.mly 2010-04-19 12:25:06.000000000 +0000 +++ ocaml-4.01.0/lex/parser.mly 2013-07-11 15:51:25.000000000 +0000 @@ -1,6 +1,6 @@ /***********************************************************************/ /* */ -/* Objective Caml */ +/* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ @@ -10,8 +10,6 @@ /* */ /***********************************************************************/ -/* $Id: parser.mly 10271 2010-04-19 12:25:06Z maranget $ */ - /* The grammar for lexer definitions */ %{ @@ -50,7 +48,8 @@ %token Tchar %token Tstring %token Taction -%token Trule Tparse Tparse_shortest Tand Tequal Tend Tor Tunderscore Teof Tlbracket Trbracket +%token Trule Tparse Tparse_shortest Tand Tequal Tend Tor Tunderscore Teof + Tlbracket Trbracket %token Tstar Tmaybe Tplus Tlparen Trparen Tcaret Tdash Tlet Tas Tsharp %right Tas @@ -75,7 +74,8 @@ Taction { $1 } | /*epsilon*/ - { { start_pos = 0; end_pos = 0; start_line = 1; start_col = 0 } } + { { loc_file = ""; start_pos = 0; end_pos = 0; start_line = 1; + start_col = 0 } } ; named_regexps: named_regexps Tlet Tident Tequal regexp @@ -163,6 +163,7 @@ {let p1 = Parsing.rhs_start_pos 3 and p2 = Parsing.rhs_end_pos 3 in let p = { + loc_file = p1.Lexing.pos_fname ; start_pos = p1.Lexing.pos_cnum ; end_pos = p2.Lexing.pos_cnum ; start_line = p1.Lexing.pos_lnum ; diff -Nru ocaml-3.12.1/lex/syntax.ml ocaml-4.01.0/lex/syntax.ml --- ocaml-3.12.1/lex/syntax.ml 2007-01-29 16:44:16.000000000 +0000 +++ ocaml-4.01.0/lex/syntax.ml 2013-07-11 15:51:25.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,18 +10,18 @@ (* *) (***********************************************************************) -(* $Id: syntax.ml 7815 2007-01-29 16:44:16Z maranget $ *) - -(* This apparently useless implmentation file is in fact required +(* This apparently useless implementation file is in fact required by the pa_ocamllex syntax extension *) (* The shallow abstract syntax *) -type location = - { start_pos: int; - end_pos: int; - start_line: int; - start_col: int } +type location = { + loc_file : string; + start_pos : int; + end_pos : int; + start_line : int; + start_col : int; +} type regular_expression = Epsilon diff -Nru ocaml-3.12.1/lex/syntax.mli ocaml-4.01.0/lex/syntax.mli --- ocaml-3.12.1/lex/syntax.mli 2007-01-29 16:44:16.000000000 +0000 +++ ocaml-4.01.0/lex/syntax.mli 2013-07-11 15:51:25.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) @@ -10,15 +10,15 @@ (* *) (***********************************************************************) -(* $Id: syntax.mli 7815 2007-01-29 16:44:16Z maranget $ *) - (* The shallow abstract syntax *) -type location = - { start_pos: int; - end_pos: int; - start_line: int; - start_col: int } +type location = { + loc_file : string; + start_pos : int; + end_pos : int; + start_line : int; + start_col : int; +} type regular_expression = Epsilon diff -Nru ocaml-3.12.1/lex/table.ml ocaml-4.01.0/lex/table.ml --- ocaml-3.12.1/lex/table.ml 2002-10-28 16:46:50.000000000 +0000 +++ ocaml-4.01.0/lex/table.ml 2012-07-17 15:31:12.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) diff -Nru ocaml-3.12.1/lex/table.mli ocaml-4.01.0/lex/table.mli --- ocaml-3.12.1/lex/table.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/lex/table.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) diff -Nru ocaml-3.12.1/man/Makefile ocaml-4.01.0/man/Makefile --- ocaml-3.12.1/man/Makefile 2002-04-24 09:09:35.000000000 +0000 +++ ocaml-4.01.0/man/Makefile 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Xavier Leroy, projet Cristal, INRIA Rocquencourt # # # @@ -10,8 +10,6 @@ # # ######################################################################### -# $Id: Makefile 4733 2002-04-24 09:09:35Z xleroy $ - include ../config/Makefile DIR=$(MANDIR)/man$(MANEXT) @@ -20,3 +18,4 @@ for i in *.m; do cp $$i $(DIR)/`basename $$i .m`.$(MANEXT); done echo '.so man$(MANEXT)/ocamlc.$(MANEXT)' > $(DIR)/ocamlc.opt.$(MANEXT) echo '.so man$(MANEXT)/ocamlopt.$(MANEXT)' > $(DIR)/ocamlopt.opt.$(MANEXT) + echo '.so man$(MANEXT)/ocamlcp.$(MANEXT)' > $(DIR)/ocamloptp.$(MANEXT) diff -Nru ocaml-3.12.1/man/ocaml.m ocaml-4.01.0/man/ocaml.m --- ocaml-3.12.1/man/ocaml.m 2010-05-20 14:06:29.000000000 +0000 +++ ocaml-4.01.0/man/ocaml.m 2013-09-02 10:03:04.000000000 +0000 @@ -1,9 +1,19 @@ -\" $Id: ocaml.m 10444 2010-05-20 14:06:29Z doligez $ - +.\"*********************************************************************** +.\"* * +.\"* OCaml * +.\"* * +.\"* Xavier Leroy, projet Cristal, INRIA Rocquencourt * +.\"* * +.\"* Copyright 1996 Institut National de Recherche en Informatique et * +.\"* en Automatique. All rights reserved. This file is distributed * +.\"* under the terms of the Q Public License version 1.0. * +.\"* * +.\"*********************************************************************** +.\" .TH OCAML 1 .SH NAME -ocaml \- The Objective Caml interactive toplevel +ocaml \- The OCaml interactive toplevel .SH SYNOPSIS .B ocaml @@ -20,9 +30,9 @@ The .BR ocaml (1) -command is the toplevel system for Objective Caml, -that permits interactive use of the Objective Caml system through a -read-eval-print loop. In this mode, the system repeatedly reads Caml +command is the toplevel system for OCaml, +that permits interactive use of the OCaml system through a +read-eval-print loop. In this mode, the system repeatedly reads OCaml phrases from the input, then typechecks, compiles and evaluates them, then prints the inferred type and result value, if any. The system prints a # (sharp) prompt before reading each phrase. @@ -54,6 +64,9 @@ The following command-line options are recognized by .BR ocaml (1). .TP +.B \-absname +Show absolute filenames in error messages. +.TP .BI \-I \ directory Add the given directory to the list of directories searched for source and compiled files. By default, the current directory is @@ -90,6 +103,12 @@ Labels are not ignored in types, labels may be used in applications, and labelled parameters can be given in any order. This is the default. .TP +.B \-no\-app\-funct +Deactivates the applicative behaviour of functors. With this option, +each functor application generates new types in its result and +applying the same functor twice to the same argument yields two +incompatible structures. +.TP .B \-noassert Do not compile assertion checks. Note that the special form .B assert\ false @@ -102,10 +121,24 @@ .B \-noprompt Do not display any prompt when waiting for input. .TP +.B \-nopromptcont +Do not display the secondary prompt when waiting for continuation lines in +multi-line inputs. This should be used e.g. when running +.BR ocaml (1) +in an +.BR emacs (1) +window. +.TP .B \-nostdlib Do not include the standard library directory in the list of directories searched for source and compiled files. .TP +.BI \-ppx \ command +After parsing, pipe the abstract syntax tree through the preprocessor +.IR command . +The format of the input and ouput of the preprocessor +are not yet documented. +.TP .B \-principal Check information path during type-checking, to make sure that all types are derived in a principal way. When using labelled arguments @@ -124,6 +157,18 @@ only recursive types where the recursion goes through an object type are supported. .TP +.B \-short\-paths +When a type is visible under several module-paths, use the shortest +one when printing the type's name in inferred interfaces and error and +warning messages. +.TP +.B \-stdin +Read the standard input as a script file rather than starting an +interactive session. +.TP +.B \-strict\-sequence +Force the left-hand part of each sequence to have type unit. +.TP .B \-unsafe Turn bound checking off on array and string accesses (the .BR v.(i) and s.[i] @@ -148,9 +193,9 @@ argument. .TP .BI \-warn-error \ warning-list -Treat as errors the warnings described by the argument +Mark as fatal the warnings described by the argument .IR warning\-list . -Note that a warning is not triggered (and not treated as error) if +Note that a warning is not triggered (and does not trigger an error) if it is disabled by the .B \-w option. See @@ -159,6 +204,14 @@ .I warning\-list argument. .TP +.B \-warn\-help +Show the description of all available warning numbers. +.TP +.BI \- \ file +Use +.I file +as a script file name, even when it starts with a hyphen (-). +.TP .BR \-help \ or \ \-\-help Display a short usage summary and exit. @@ -178,5 +231,5 @@ .SH SEE ALSO .BR ocamlc (1), \ ocamlopt (1), \ ocamlrun (1). .br -.IR The\ Objective\ Caml\ user's\ manual , +.IR The\ OCaml\ user's\ manual , chapter "The toplevel system". diff -Nru ocaml-3.12.1/man/ocamlc.m ocaml-4.01.0/man/ocamlc.m --- ocaml-3.12.1/man/ocamlc.m 2010-05-21 12:00:49.000000000 +0000 +++ ocaml-4.01.0/man/ocamlc.m 2013-09-02 10:03:04.000000000 +0000 @@ -1,9 +1,19 @@ -\" $Id: ocamlc.m 10450 2010-05-21 12:00:49Z doligez $ - +.\"*********************************************************************** +.\"* * +.\"* OCaml * +.\"* * +.\"* Xavier Leroy, projet Cristal, INRIA Rocquencourt * +.\"* * +.\"* Copyright 1996 Institut National de Recherche en Informatique et * +.\"* en Automatique. All rights reserved. This file is distributed * +.\"* under the terms of the Q Public License version 1.0. * +.\"* * +.\"*********************************************************************** +.\" .TH OCAMLC 1 .SH NAME -ocamlc \- The Objective Caml bytecode compiler +ocamlc \- The OCaml bytecode compiler .SH SYNOPSIS .B ocamlc @@ -20,9 +30,9 @@ .SH DESCRIPTION -The Objective Caml bytecode compiler +The OCaml bytecode compiler .BR ocamlc (1) -compiles Caml source files to bytecode object files and links +compiles OCaml source files to bytecode object files and links these object files to produce standalone bytecode executable files. These executable files are then run by the bytecode interpreter .BR ocamlrun (1). @@ -78,7 +88,7 @@ Arguments ending in .cmo are taken to be compiled object bytecode. These files are linked together, along with the object files obtained -by compiling .ml arguments (if any), and the Caml Light standard +by compiling .ml arguments (if any), and the OCaml standard library, to produce a standalone executable program. The order in which .cmo and.ml arguments are presented on the command line is relevant: compilation units are initialized in that order at @@ -117,14 +127,14 @@ Arguments ending in .so are assumed to be C shared libraries (DLLs). During linking, they are -searched for external C functions referenced from the Caml code, +searched for external C functions referenced from the OCaml code, and their names are written in the generated bytecode executable. The run-time system .BR ocamlrun (1) then loads them dynamically at program start-up time. The output of the linking phase is a file containing compiled bytecode -that can be executed by the Objective Caml bytecode interpreter: +that can be executed by the OCaml bytecode interpreter: the command .BR ocamlrun (1). If @@ -158,7 +168,7 @@ .BR ocamlc , but compiles faster. .B ocamlc.opt -may not be available in all installations of Objective Caml. +may not be available in all installations of OCaml. .SH OPTIONS @@ -183,6 +193,9 @@ .B -noautolink option is given. .TP +.B \-absname +Show absolute filenames in error messages. +.TP .B \-annot Dump detailed information about the compilation (types, bindings, tail-calls, etc). The information for file @@ -196,6 +209,20 @@ .B emacs/caml\-types.el to display types and other annotations interactively. .TP +.B \-bin\-annot +Dump detailed information about the compilation (types, bindings, +tail-calls, etc) in binary format. The information for file +.IR src .ml +is put into file +.IR src .cmt. +In case of a type error, dump +all the information inferred by the type-checker before the error. +The annotation files produced by +.B \-bin\-annot +contain more information +and are much more compact than the files produced by +.BR \-annot . +.TP .B \-c Compile only. Suppress the linking phase of the compilation. Source code files are turned into compiled files, but no @@ -216,8 +243,10 @@ .B \-custom option). This causes the given C library to be linked with the program. .TP -.B \-ccopt -Pass the given option to the C compiler and linker, when linking in +.BI \-ccopt \ option +Pass the given +.I option +to the C compiler and linker, when linking in "custom runtime" mode (see the .B \-custom option). For instance, @@ -226,6 +255,11 @@ directory .IR dir . .TP +.B \-compat\-32 +Check that the generated bytecode executable can run on 32-bit +platforms and signal an error if it cannot. This is useful when +compiling bytecode on a 64-bit machine. +.TP .B \-config Print the version number of .BR ocamlc (1) @@ -242,7 +276,7 @@ can be executed directly, even if the .BR ocamlrun (1) command is not -installed. Moreover, the "custom runtime" mode enables linking Caml +installed. Moreover, the "custom runtime" mode enables linking OCaml code with user-defined C functions. Never use the @@ -275,6 +309,11 @@ .BR ocamlrun (1) can find it and use it. .TP +.BI \-for\-pack \ ident +This option is accepted for compatibility with +.BR ocamlopt (1) +; it does nothing. +.TP .B \-g Add debugging information while compiling and linking. This option is required in order to be able to debug the program with @@ -352,6 +391,12 @@ .B ocamlc\ \-use\-runtime .IR runtime-name . .TP +.B \-no\-app\-funct +Deactivates the applicative behaviour of functors. With this option, +each functor application generates new types in its result and +applying the same functor twice to the same argument yields two +incompatible structures. +.TP .B \-noassert Do not compile assertion checks. Note that the special form .B assert\ false @@ -372,6 +417,12 @@ Ignore non-optional labels in types. Labels cannot be used in applications, and parameter order becomes strict. .TP +.B \-nostdlib +Do not include the standard library directory in the list of +directories searched for compiled interfaces (see option +.B \-I +). +.TP .BI \-o \ exec\-file Specify the name of the output file produced by the linker. The default output name is @@ -389,10 +440,9 @@ .TP .B \-output\-obj Cause the linker to produce a C object file instead of a bytecode -executable file. This is useful to wrap Caml code as a C library, -callable from any C program. The name of the output object file is -.B camlprog.o -by default; it can be set with the +executable file. This is useful to wrap OCaml code as a C library, +callable from any C program. The name of the output object file +must be set with the .B \-o option. This option can also be used to produce a C source file (.c extension) or @@ -425,6 +475,12 @@ extension .ppi for an interface (.mli) file and .ppo for an implementation (.ml) file. .TP +.BI \-ppx \ command +After parsing, pipe the abstract syntax tree through the preprocessor +.IR command . +The format of the input and ouput of the preprocessor +are not yet documented. +.TP .B \-principal Check information path during type-checking, to make sure that all types are derived in a principal way. When using labelled arguments @@ -444,10 +500,28 @@ are supported. Note that once you have created an interface using this flag, you must use it again for all dependencies. .TP +.BI \-runtime\-variant \ suffix +Add +.I suffix +to the name of the runtime library that will be used by the program. +If OCaml was configured with option +.BR \-with\-debug\-runtime , +then the +.B d +suffix is supported and gives a debug version of the runtime. +.TP +.B \-short\-paths +When a type is visible under several module-paths, use the shortest +one when printing the type's name in inferred interfaces and error and +warning messages. +.TP +.B \-strict\-sequence +Force the left-hand part of each sequence to have type unit. +.TP .B \-thread Compile or link multithreaded programs, in combination with the system "threads" library described in -.IR The\ Objective\ Caml\ user's\ manual . +.IR The\ OCaml\ user's\ manual . .TP .B \-unsafe Turn bound checking off for array and string accesses (the @@ -476,30 +550,29 @@ .B \-custom mode. Useful to debug C library problems. .TP -.BR \-vnum or \-version -Print the version number of the compiler in short form (e.g. "3.11.0"), -then exit. -.TP .B \-vmthread Compile or link multithreaded programs, in combination with the VM-level threads library described in -.IR The\ Objective\ Caml\ user's\ manual . +.IR The\ OCaml\ user's\ manual . +.TP +.BR \-vnum \ or\ \-version +Print the version number of the compiler in short form (e.g. "3.11.0"), +then exit. .TP .BI \-w \ warning\-list -Enable, disable, or mark as errors the warnings specified by the argument +Enable, disable, or mark as fatal the warnings specified by the argument .IR warning\-list . Each warning can be .IR enabled \ or\ disabled , and each warning can be -.I marked -(as error) or -.IR unmarked . +.IR fatal or +.IR non-fatal . If a warning is disabled, it isn't displayed and doesn't affect -compilation in any way (even if it is marked). If a warning is enabled, +compilation in any way (even if it is fatal). If a warning is enabled, it is displayed normally by the compiler whenever the source code -triggers it. If it is enabled and marked, the compiler will stop with -an error after displaying the warnings if the source code triggers it. +triggers it. If it is enabled and fatal, the compiler will also stop +with an error after displaying it. The .I warning\-list @@ -515,9 +588,30 @@ .IR num . .BI @ num -\ \ Enable and mark warning number +\ \ Enable and mark as fatal warning number .IR num . +.BI + num1 .. num2 +\ \ Enable all warnings between +.I num1 +and +.I num2 +(inclusive). + +.BI \- num1 .. num2 +\ \ Disable all warnings between +.I num1 +and +.I num2 +(inclusive). + +.BI @ num1 .. num2 +\ \ Enable and mark as fatal all warnings between +.I num1 +and +.I num2 +(inclusive). + .BI + letter \ \ Enable the set of warnings corresponding to .IR letter . @@ -529,7 +623,7 @@ The letter may be uppercase or lowercase. .BI @ letter -\ \ Enable and mark the set of warnings corresponding to +\ \ Enable and mark as fatal the set of warnings corresponding to .IR letter . The letter may be uppercase or lowercase. @@ -550,7 +644,7 @@ \ \ \ Suspicious-looking end-of-comment mark. 3 -\ \ \ Deprecated syntax. +\ \ \ Deprecated feature. 4 \ \ \ Fragile pattern matching: matching that will remain @@ -565,7 +659,7 @@ \ \ \ Label omitted in function application. 7 -\ \ \ Some methods are overridden in the class where they are defined. +\ \ \ Method overridden without using the "method!" keyword 8 \ \ \ Partial match: missing cases in pattern-matching. @@ -642,9 +736,57 @@ 29 \ \ A non-escaped end-of-line was found in a string constant. This may - cause portability problems between Unix and Windows. +30 +\ \ Two labels or constructors of the same name are defined in two +mutually recursive types. + +31 +\ \ A module is linked twice in the same executable. + +32 +\ \ Unused value declaration. + +33 +\ \ Unused open statement. + +34 +\ \ Unused type declaration. + +35 +\ \ Unused for-loop index. + +36 +\ \ Unused ancestor variable. + +37 +\ \ Unused constructor. + +38 +\ \ Unused exception constructor. + +39 +\ \ Unused rec flag. + +40 +\ \ Constructor or label name used out of scope. + +41 +\ \ Ambiguous constructor or label name. + +42 +\ \ Disambiguated constructor or label name. + +43 +\ \ Nonoptional label applied as optional. + +44 +\ \ Open statement shadows an already defined identifier. + +45 +\ \ Open statement shadows an already defined label or constructor. + The letters stand for the following sets of warnings. Any letter not mentioned here corresponds to the empty set. @@ -663,6 +805,9 @@ .B F \ 5 +.B K +\ 32, 33, 34, 35, 36, 37, 38, 39 + .B L \ 6 @@ -685,7 +830,7 @@ \ 13 .B X -\ 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25 +\ 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 30 .B Y \ 26 @@ -695,7 +840,7 @@ .IP The default setting is -.BR \-w\ +a\-4\-6\-9\-27\-28\-29 . +.BR \-w\ +a\-4\-6\-7\-9\-27\-29\-32..39\-41..42\-44\-45 . Note that warnings .BR 5 \ and \ 10 are not always triggered, depending on the internals of the type checker. @@ -711,21 +856,23 @@ .B \-w option: a .B + -sign (or an uppercase letter) turns the corresponding warnings into errors, a +sign (or an uppercase letter) marks the corresponding warnings as fatal, a .B \- -sign (or a lowercase letter) turns them back into warnings, and a +sign (or a lowercase letter) turns them back into non-fatal warnings, and a .B @ -sign both enables and marks the corresponding warnings. +sign both enables and marks as fatal the corresponding warnings. -Note: it is not recommended to use warning sets (i.e. letters) as -arguments to +Note: it is not recommended to use the .B \-warn\-error -in production code, because this can break your build when future versions -of OCaml add some new warnings. +option in production code, because it will almost certainly prevent +compiling your program with later versions of OCaml when they add new +warnings. The default setting is -.B \-warn\-error\ +a -(none of the warnings is treated as an error). +.B \-warn\-error\ -a (all warnings are non-fatal). +.TP +.B \-warn\-help +Show the description of all available warning numbers. .TP .B \-where Print the location of the standard library, then exit. @@ -741,5 +888,5 @@ .SH SEE ALSO .BR ocamlopt (1), \ ocamlrun (1), \ ocaml (1). .br -.IR "The Objective Caml user's manual" , +.IR "The OCaml user's manual" , chapter "Batch compilation". diff -Nru ocaml-3.12.1/man/ocamlcp.m ocaml-4.01.0/man/ocamlcp.m --- ocaml-3.12.1/man/ocamlcp.m 2008-09-15 14:05:30.000000000 +0000 +++ ocaml-4.01.0/man/ocamlcp.m 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,19 @@ -\" $Id: ocamlcp.m 9025 2008-09-15 14:05:30Z doligez $ - -.TH OCAMLCP 1 +.\"*********************************************************************** +.\"* * +.\"* OCaml * +.\"* * +.\"* Xavier Leroy, projet Cristal, INRIA Rocquencourt * +.\"* * +.\"* Copyright 1996 Institut National de Recherche en Informatique et * +.\"* en Automatique. All rights reserved. This file is distributed * +.\"* under the terms of the Q Public License version 1.0. * +.\"* * +.\"*********************************************************************** +.\" +.TH "OCAMLCP" 1 .SH NAME -ocamlcp \- The Objective Caml profiling compiler +ocamlcp, ocamloptp \- The OCaml profiling compilers .SH SYNOPSIS .B ocamlcp @@ -11,36 +21,62 @@ .I ocamlc options ] [ -.BI \-p \ flags +.BI \-P \ flags +] +.I filename ... + +.B ocamloptp +[ +.I ocamlopt options +] +[ +.BI \-P \ flags ] .I filename ... .SH DESCRIPTION The .B ocamlcp -command is a front-end to +and +.B ocamloptp +commands are front-ends to .BR ocamlc (1) -that instruments the source code, adding code to record how many times -functions are called, branches of conditionals are taken, ... +and +.BR ocamlopt (1) +that instrument the source code, adding code to record how many times +functions are called, branches of conditionals are taken, etc. Execution of instrumented code produces an execution profile in the file ocamlprof.dump, which can be read using .BR ocamlprof (1). .B ocamlcp accepts the same arguments and options as -.BR ocamlc (1). +.BR ocamlc (1) +and +.B ocamloptp +accepts the same arguments and options as +.BR ocamlopt (1). +There is only one exception: in both cases, the +.B \-pp +option is not supported. If you need to preprocess your source files, +you will have to do it separately before calling +.B ocamlcp +or +.BR ocamloptp . .SH OPTIONS In addition to the .BR ocamlc (1) +or +.BR ocamlopt (1) options, .B ocamlcp -accepts the following option controlling the amount of profiling -information: -.TP -.BI \-p \ letters -The +and +.B ocamloptp +accept one option to control the kind of profiling information, the +.BI \-P \ letters +option. The .I letters indicate which parts of the program should be profiled: .TP @@ -57,7 +93,7 @@ branches .TP .B l -\BR while , \ for +.BR while , \ for loops: a count point is set at the beginning of the loop body .TP .B m @@ -72,28 +108,32 @@ .PP For instance, compiling with -.B ocamlcp\ \-pfilm +.B ocamlcp \-P film profiles function calls, .BR if \ ... \ then \ ... \ else \ ..., loops, and pattern matching. Calling .BR ocamlcp (1) +or +.BR ocamloptp (1) without the -.B \-p +.B \-P option defaults to -.B \-p\ fm +.BR \-P\ fm , meaning that only function calls and pattern matching are profiled. -Note: due to the implementation of streams and stream patterns as -syntactic sugar, it is hard to predict what parts of stream expressions -and patterns will be profiled by a given flag. To profile a program with -streams, we recommend using -.BR ocamlcp\ \-p\ a . +Note: for compatibility with previous versions, +.BR ocamlcp (1) +also accepts the option +.B \-p +with the same argument and meaning as +.BR \-P . .SH SEE ALSO .BR ocamlc (1), +.BR ocamlopt (1), .BR ocamlprof (1). .br -.IR "The Objective Caml user's manual" , +.IR "The OCaml user's manual" , chapter "Profiling". diff -Nru ocaml-3.12.1/man/ocamldebug.m ocaml-4.01.0/man/ocamldebug.m --- ocaml-3.12.1/man/ocamldebug.m 2010-05-20 14:06:29.000000000 +0000 +++ ocaml-4.01.0/man/ocamldebug.m 2012-10-15 17:50:56.000000000 +0000 @@ -1,15 +1,25 @@ -\" $Id: ocamldebug.m 10444 2010-05-20 14:06:29Z doligez $ - +.\"*********************************************************************** +.\"* * +.\"* OCaml * +.\"* * +.\"* Xavier Leroy, projet Cristal, INRIA Rocquencourt * +.\"* * +.\"* Copyright 2001 Institut National de Recherche en Informatique et * +.\"* en Automatique. All rights reserved. This file is distributed * +.\"* under the terms of the Q Public License version 1.0. * +.\"* * +.\"*********************************************************************** +.\" .TH OCAMLDEBUG 1 .SH NAME -ocamldebug \- the Objective Caml source-level replay debugger. +ocamldebug \- the OCaml source-level replay debugger. .SH SYNOPSIS .B ocamldebug .RI [\ options \ ]\ program \ [\ arguments \ ] .SH DESCRIPTION .B ocamldebug -is the Objective Caml source-level replay debugger. +is the OCaml source-level replay debugger. Before the debugger can be used, the program must be compiled and linked with the @@ -46,7 +56,7 @@ .TP .B \-emacs Tell the debugger it is executed under Emacs. (See -.I "The Objective Caml user's manual" +.I "The OCaml user's manual" for information on how to run the debugger under Emacs.) .TP .BI \-I \ directory @@ -64,7 +74,7 @@ of the command .B set\ socket in -.I "The Objective Caml user's manual" +.I "The OCaml user's manual" for the format of .IR socket . .TP @@ -79,7 +89,7 @@ .SH SEE ALSO .BR ocamlc (1) .br -.IR "The Objective Caml user's manual" , +.IR "The OCaml user's manual" , chapter "The debugger". .SH AUTHOR This manual page was written by Sven LUTHER , diff -Nru ocaml-3.12.1/man/ocamldep.m ocaml-4.01.0/man/ocamldep.m --- ocaml-3.12.1/man/ocamldep.m 2011-01-04 10:33:49.000000000 +0000 +++ ocaml-4.01.0/man/ocamldep.m 2012-10-15 17:50:56.000000000 +0000 @@ -1,9 +1,19 @@ -\" $Id: ocamldep.m 10914 2011-01-04 10:33:49Z xclerc $ - +.\"*********************************************************************** +.\"* * +.\"* OCaml * +.\"* * +.\"* Xavier Leroy, projet Cristal, INRIA Rocquencourt * +.\"* * +.\"* Copyright 1996 Institut National de Recherche en Informatique et * +.\"* en Automatique. All rights reserved. This file is distributed * +.\"* under the terms of the Q Public License version 1.0. * +.\"* * +.\"*********************************************************************** +.\" .TH OCAMLDEP 1 .SH NAME -ocamldep \- Dependency generator for Objective Caml +ocamldep \- Dependency generator for OCaml .SH SYNOPSIS .B ocamldep @@ -16,7 +26,7 @@ The .BR ocamldep (1) -command scans a set of Objective Caml source files +command scans a set of OCaml source files (.ml and .mli files) for references to external compilation units, and outputs dependency lines in a format suitable for the .BR make (1) @@ -44,6 +54,9 @@ The following command-line options are recognized by .BR ocamldep (1). .TP +.B \-absname +Show absolute filenames in error messages. +.TP .BI \-I \ directory Add the given directory to the list of directories searched for source files. If a source file foo.ml mentions an external @@ -101,6 +114,10 @@ .I command as a preprocessor for each source file. .TP +.BI \-ppx \ command +Pipe abstract syntax tree through preprocessor +.IR command . +.TP .B \-slash Under Unix, this option does nothing. .TP @@ -117,5 +134,5 @@ .BR ocamlc (1), .BR ocamlopt (1). .br -.IR The\ Objective\ Caml\ user's\ manual , +.IR The\ OCaml\ user's\ manual , chapter "Dependency generator". diff -Nru ocaml-3.12.1/man/ocamldoc.m ocaml-4.01.0/man/ocamldoc.m --- ocaml-3.12.1/man/ocamldoc.m 2010-05-21 12:00:49.000000000 +0000 +++ ocaml-4.01.0/man/ocamldoc.m 2012-10-15 17:50:56.000000000 +0000 @@ -1,5 +1,15 @@ -\" $Id: ocamldoc.m 10450 2010-05-21 12:00:49Z doligez $ - +.\"*********************************************************************** +.\"* * +.\"* OCaml * +.\"* * +.\"* Maxence Guesdon, projet Cristal, INRIA Rocquencourt * +.\"* * +.\"* Copyright 2004 Institut National de Recherche en Informatique et * +.\"* en Automatique. All rights reserved. This file is distributed * +.\"* under the terms of the Q Public License version 1.0. * +.\"* * +.\"*********************************************************************** +.\" .TH OCAMLDOC 1 \" .de Sh \" Subsection heading @@ -12,7 +22,7 @@ \" .. .SH NAME -ocamldoc \- The Objective Caml documentation generator +ocamldoc \- The OCaml documentation generator .SH SYNOPSIS @@ -24,15 +34,18 @@ .SH DESCRIPTION -The Objective Caml documentation generator +The OCaml documentation generator .BR ocamldoc (1) generates documentation from special comments embedded in source files. The -comments used by OCamldoc are of the form +comments used by +.B ocamldoc +are of the form .I (** ... *) and follow the format described in the -.IR "The Objective Caml user's manual" . +.IR "The OCaml user's manual" . -OCamldoc can produce documentation in various formats: HTML, LaTeX, TeXinfo, +.B ocamldoc +can produce documentation in various formats: HTML, LaTeX, TeXinfo, Unix man pages, and .BR dot (1) dependency graphs. Moreover, users can add their own @@ -112,7 +125,9 @@ Dynamically load the given file (which extension usually is .cmo or .cma), which defines a custom documentation generator. If the given file is a simple one and does not exist in -the current directory, then ocamldoc looks for it in the custom +the current directory, then +.B ocamldoc +looks for it in the custom generators default directory, and in the directories specified with the .B \-i option. @@ -222,6 +237,10 @@ Pipe sources through preprocessor .IR command . .TP +.BI \-ppx \ command +Pipe abstract syntax tree through preprocessor +.IR command . +.TP .B \-sort Sort the list of top-level modules before generating the documentation. .TP @@ -236,7 +255,9 @@ .BI \-intro \ file Use content of .I file -as ocamldoc text to use as introduction (HTML, LaTeX and TeXinfo only). +as +.B ocamldoc +text to use as introduction (HTML, LaTeX and TeXinfo only). For HTML, the file is used to create the whole "index.html" file. .TP .B \-v @@ -249,16 +270,20 @@ Print short version number and exit. .TP .B \-warn\-error -Treat Ocamldoc warnings as errors. +Treat +.B ocamldoc +warnings as errors. .TP .B \-hide\-warnings -Do not print OCamldoc warnings. +Do not print +.B ocamldoc +warnings. .TP .BR \-help \ or \ \-\-help Display a short usage summary and exit. .SS "Type-checking options" .BR ocamldoc (1) -calls the Objective Caml type-checker to obtain type information. The +calls the OCaml type-checker to obtain type information. The following options impact the type-checking phase. They have the same meaning as for the .BR ocamlc (1)\ and \ ocamlopt (1) @@ -430,5 +455,5 @@ .BR ocamlc (1), .BR ocamlopt (1). .br -.IR "The Objective Caml user's manual", +.IR "The OCaml user's manual", chapter "The documentation generator". diff -Nru ocaml-3.12.1/man/ocamllex.m ocaml-4.01.0/man/ocamllex.m --- ocaml-3.12.1/man/ocamllex.m 2010-05-20 14:06:29.000000000 +0000 +++ ocaml-4.01.0/man/ocamllex.m 2012-10-15 17:50:56.000000000 +0000 @@ -1,8 +1,19 @@ -\" $Id: ocamllex.m 10444 2010-05-20 14:06:29Z doligez $ +.\"*********************************************************************** +.\"* * +.\"* OCaml * +.\"* * +.\"* Xavier Leroy, projet Cristal, INRIA Rocquencourt * +.\"* * +.\"* Copyright 1996 Institut National de Recherche en Informatique et * +.\"* en Automatique. All rights reserved. This file is distributed * +.\"* under the terms of the Q Public License version 1.0. * +.\"* * +.\"*********************************************************************** +.\" .TH OCAMLLEX 1 .SH NAME -ocamllex \- The Objective Caml lexer generator +ocamllex \- The OCaml lexer generator .SH SYNOPSIS .B ocamllex @@ -18,7 +29,7 @@ The .BR ocamllex (1) -command generates Objective Caml lexers from a set of regular +command generates OCaml lexers from a set of regular expressions with associated semantic actions, in the style of .BR lex (1). @@ -26,7 +37,7 @@ .BR ocamllex (1) on the input file .IR lexer \&.mll -produces Caml code for a lexical analyzer in file +produces OCaml code for a lexical analyzer in file .IR lexer \&.ml. This file defines one lexing function per entry point in the lexer @@ -53,7 +64,7 @@ .TP .B \-ml Output code that does not use OCaml's built-in automata -interpreter. Instead, the automaton is encoded by Caml functions. +interpreter. Instead, the automaton is encoded by OCaml functions. This option is mainly useful for debugging .BR ocamllex (1), using it for production lexers is not recommended. @@ -83,5 +94,5 @@ .SH SEE ALSO .BR ocamlyacc (1). .br -.IR "The Objective Caml user's manual" , +.IR "The OCaml user's manual" , chapter "Lexer and parser generators". diff -Nru ocaml-3.12.1/man/ocamlmktop.m ocaml-4.01.0/man/ocamlmktop.m --- ocaml-3.12.1/man/ocamlmktop.m 2010-05-20 14:06:29.000000000 +0000 +++ ocaml-4.01.0/man/ocamlmktop.m 2013-02-26 10:36:33.000000000 +0000 @@ -1,4 +1,15 @@ -\" $Id: ocamlmktop.m 10444 2010-05-20 14:06:29Z doligez $ +.\"*********************************************************************** +.\"* * +.\"* OCaml * +.\"* * +.\"* Xavier Leroy, projet Cristal, INRIA Rocquencourt * +.\"* * +.\"* Copyright 1999 Institut National de Recherche en Informatique et * +.\"* en Automatique. All rights reserved. This file is distributed * +.\"* under the terms of the Q Public License version 1.0. * +.\"* * +.\"*********************************************************************** +.\" .TH OCAMLMKTOP 1 .SH NAME @@ -29,7 +40,7 @@ The .BR ocamlmktop (1) -command builds Objective Caml toplevels that +command builds OCaml toplevels that contain user code preloaded at start-up. The .BR ocamlmktop (1) @@ -37,8 +48,8 @@ .IR x .cmo and .IR x .cma -files, and links them with the object files that implement the Objective -Caml toplevel. If the +files, and links them with the object files that implement the +OCaml toplevel. If the .B \-custom flag is given, C object files and libraries (.o and .a files) can also be given on the command line and are linked in the resulting toplevel. @@ -51,7 +62,7 @@ .B \-v Print the version string of the compiler and exit. .TP -.BR \-vnum or \-version +.BR \-vnum \ or\ \-version Print the version number of the compiler in short form and exit. .TP .BI \-cclib\ \-l libname diff -Nru ocaml-3.12.1/man/ocamlopt.m ocaml-4.01.0/man/ocamlopt.m --- ocaml-3.12.1/man/ocamlopt.m 2010-05-20 14:06:29.000000000 +0000 +++ ocaml-4.01.0/man/ocamlopt.m 2013-09-02 10:03:04.000000000 +0000 @@ -1,10 +1,20 @@ -\" $Id: ocamlopt.m 10444 2010-05-20 14:06:29Z doligez $ - +.\"*********************************************************************** +.\"* * +.\"* OCaml * +.\"* * +.\"* Xavier Leroy, projet Cristal, INRIA Rocquencourt * +.\"* * +.\"* Copyright 1996 Institut National de Recherche en Informatique et * +.\"* en Automatique. All rights reserved. This file is distributed * +.\"* under the terms of the Q Public License version 1.0. * +.\"* * +.\"*********************************************************************** +.\" .TH OCAMLOPT 1 .SH NAME -ocamlopt \- The Objective Caml native-code compiler +ocamlopt \- The OCaml native-code compiler .SH SYNOPSIS @@ -19,10 +29,10 @@ .SH DESCRIPTION -The Objective Caml high-performance +The OCaml high-performance native-code compiler .BR ocamlopt (1) -compiles Caml source files to native code object files and link these +compiles OCaml source files to native code object files and link these object files to produce standalone executables. The @@ -65,7 +75,7 @@ .IR x .cmx (when given a .o file, .BR ocamlopt (1) -assumes that it contains code compiled from C, not from Caml). +assumes that it contains code compiled from C, not from OCaml). The implementation is checked against the interface file .IR x .mli @@ -74,7 +84,7 @@ Arguments ending in .cmx are taken to be compiled object code. These files are linked together, along with the object files obtained -by compiling .ml arguments (if any), and the Caml Light standard +by compiling .ml arguments (if any), and the OCaml standard library, to produce a native-code executable program. The order in which .cmx and .ml arguments are presented on the command line is relevant: compilation units are initialized in that order at @@ -120,7 +130,7 @@ .BR ocamlopt , but compiles faster. .B ocamlopt.opt -is not available in all installations of Objective Caml. +is not available in all installations of OCaml. .SH OPTIONS @@ -139,12 +149,15 @@ options are passed on the command line, these options are stored in the resulting .cmxa library. Then, linking with this library automatically adds back the -\BR \-cclib \ and \ \-ccopt +.BR \-cclib \ and \ \-ccopt options as if they had been provided on the command line, unless the .B \-noautolink option is given. .TP +.B \-absname +Show absolute filenames in error messages. +.TP .B \-annot Dump detailed information about the compilation (types, bindings, tail-calls, etc). The information for file @@ -158,6 +171,20 @@ .B emacs/caml\-types.el to display types and other annotations interactively. .TP +.B \-bin\-annot +Dump detailed information about the compilation (types, bindings, +tail-calls, etc) in binary format. The information for file +.IR src .ml +is put into file +.IR src .cmt. +In case of a type error, dump +all the information inferred by the type-checker before the error. +The annotation files produced by +.B \-bin\-annot +contain more information +and are much more compact than the files produced by +.BR \-annot . +.TP .B \-c Compile only. Suppress the linking phase of the compilation. Source code files are turned into compiled files, but no @@ -236,6 +263,11 @@ .B labltk of the standard library to the search path. .TP +.BI \-impl \ filename +Compile the file +.I filename +as an implementation file, even if its extension is not .ml. +.TP .BI \-inline \ n Set aggressiveness of inlining to .IR n , @@ -279,6 +311,12 @@ subsequent links of programs involving that library to link all the modules contained in the library. .TP +.B \-no\-app\-funct +Deactivates the applicative behaviour of functors. With this option, +each functor application generates new types in its result and +applying the same functor twice to the same argument yields two +incompatible structures. +.TP .B \-noassert Do not compile assertion checks. Note that the special form .B assert\ false @@ -318,9 +356,9 @@ .TP .B \-output\-obj Cause the linker to produce a C object file instead of an executable -file. This is useful to wrap Caml code as a C library, -callable from any C program. The name of the output object file is -camlprog.o by default; it can be set with the +file. This is useful to wrap OCaml code as a C library, +callable from any C program. The name of the output object file +must be set with the .B \-o option. This option can also be used to produce a compiled shared/dynamic @@ -378,7 +416,7 @@ with .BR \-for\-pack . See -.IR "The Objective Caml user's manual" , +.IR "The OCaml user's manual" , chapter "Native-code compilation" for more details. .TP .BI \-pp \ command @@ -390,6 +428,12 @@ an intermediate file, which is compiled. If there are no compilation errors, the intermediate file is deleted afterwards. .TP +.BI \-ppx \ command +After parsing, pipe the abstract syntax tree through the preprocessor +.IR command . +The format of the input and ouput of the preprocessor +are not yet documented. +.TP .B \-principal Check information path during type-checking, to make sure that all types are derived in a principal way. All programs accepted in @@ -403,6 +447,16 @@ are supported. Note that once you have created an interface using this flag, you must use it again for all dependencies. .TP +.BI \-runtime\-variant \ suffix +Add +.I suffix +to the name of the runtime library that will be used by the program. +If OCaml was configured with option +.BR \-with\-debug\-runtime , +then the +.B d +suffix is supported and gives a debug version of the runtime. +.TP .B \-S Keep the assembly code produced during the compilation. The assembly code for the source file @@ -417,21 +471,29 @@ module. The name of the plugin must be set with the .B \-o -option. A plugin can include a number of Caml +option. A plugin can include a number of OCaml modules and libraries, and extra native objects (.o, .a files). Building native plugins is only supported for some operating system. Under some systems (currently, -only Linux AMD 64), all the Caml code linked in a plugin must have +only Linux AMD 64), all the OCaml code linked in a plugin must have been compiled without the .B \-nodynlink flag. Some constraints might also apply to the way the extra native objects have been compiled (under Linux AMD 64, they must contain only position-independent code). .TP +.B \-short\-paths +When a type is visible under several module-paths, use the shortest +one when printing the type's name in inferred interfaces and error and +warning messages. +.TP +.B \-strict\-sequence +The left-hand part of a sequence must have type unit. +.TP .B \-thread Compile or link multithreaded programs, in combination with the system threads library described in -.IR "The Objective Caml user's manual" . +.IR "The OCaml user's manual" . .TP .B \-unsafe Turn bound checking off for array and string accesses (the @@ -462,7 +524,7 @@ then exit. .TP .BI \-w \ warning\-list -Enable, disable, or mark as errors the warnings specified by the argument +Enable, disable, or mark as fatal the warnings specified by the argument .IR warning\-list . See .BR ocamlc (1) @@ -470,7 +532,7 @@ .IR warning-list . .TP .BI \-warn\-error \ warning\-list -Mark as errors the warnings specified in the argument +Mark as fatal the warnings specified in the argument .IR warning\-list . The compiler will stop with an error when one of these warnings is emitted. The @@ -480,21 +542,24 @@ .B \-w option: a .B + -sign (or an uppercase letter) turns the corresponding warnings into errors, a +sign (or an uppercase letter) marks the corresponding warnings as fatal, a .B \- -sign (or a lowercase letter) turns them back into warnings, and a +sign (or a lowercase letter) turns them back into non-fatal warnings, and a .B @ -sign both enables and marks the corresponding warnings. +sign both enables and marks as fatal the corresponding warnings. -Note: it is not recommended to use warning sets (i.e. letters) as -arguments to +Note: it is not recommended to use the .B \-warn\-error -in production code, because this can break your build when future versions -of OCaml add some new warnings. +option in production code, because it will almost certainly prevent +compiling your program with later versions of OCaml when they add new +warnings. The default setting is -.B \-warn\-error\ +a -(none of the warnings is treated as an error). +.B \-warn\-error\ -a (all warnings are non-fatal). +.TP +.B \-warn\-help +Show the description of all available warning numbers. +.TP .TP .B \-where Print the location of the standard library, then exit. @@ -559,5 +624,5 @@ .SH SEE ALSO .BR ocamlc (1). .br -.IR "The Objective Caml user's manual" , +.IR "The OCaml user's manual" , chapter "Native-code compilation". diff -Nru ocaml-3.12.1/man/ocamlprof.m ocaml-4.01.0/man/ocamlprof.m --- ocaml-3.12.1/man/ocamlprof.m 2010-05-20 14:06:29.000000000 +0000 +++ ocaml-4.01.0/man/ocamlprof.m 2012-10-15 17:50:56.000000000 +0000 @@ -1,8 +1,19 @@ -\" $Id: ocamlprof.m 10444 2010-05-20 14:06:29Z doligez $ +.\"*********************************************************************** +.\"* * +.\"* OCaml * +.\"* * +.\"* Xavier Leroy, projet Cristal, INRIA Rocquencourt * +.\"* * +.\"* Copyright 1996 Institut National de Recherche en Informatique et * +.\"* en Automatique. All rights reserved. This file is distributed * +.\"* under the terms of the Q Public License version 1.0. * +.\"* * +.\"*********************************************************************** +.\" .TH OCAMLPROF 1 .SH NAME -ocamlprof \- The Objective Caml profiler +ocamlprof \- The OCaml profiler .SH SYNOPSIS .B ocamlprof @@ -15,7 +26,7 @@ The .B ocamlprof command prints execution counts gathered during the execution of a -Objective Caml program instrumented with +OCaml program instrumented with .BR ocamlcp (1). It produces a source listing of the program modules given as arguments @@ -69,5 +80,5 @@ .SH SEE ALSO .BR ocamlcp (1). .br -.IR "The Objective Caml user's manual" , +.IR "The OCaml user's manual" , chapter "Profiling". diff -Nru ocaml-3.12.1/man/ocamlrun.m ocaml-4.01.0/man/ocamlrun.m --- ocaml-3.12.1/man/ocamlrun.m 2010-05-20 14:06:29.000000000 +0000 +++ ocaml-4.01.0/man/ocamlrun.m 2013-01-03 15:22:11.000000000 +0000 @@ -1,9 +1,19 @@ -\" $Id: ocamlrun.m 10444 2010-05-20 14:06:29Z doligez $ - +.\"*********************************************************************** +.\"* * +.\"* OCaml * +.\"* * +.\"* Xavier Leroy, projet Cristal, INRIA Rocquencourt * +.\"* * +.\"* Copyright 1996 Institut National de Recherche en Informatique et * +.\"* en Automatique. All rights reserved. This file is distributed * +.\"* under the terms of the Q Public License version 1.0. * +.\"* * +.\"*********************************************************************** +.\" .TH OCAMLRUN 1 .SH NAME -ocamlrun \- The Objective Caml bytecode interpreter +ocamlrun \- The OCaml bytecode interpreter .SH SYNOPSIS .B ocamlrun @@ -23,7 +33,7 @@ The first non-option argument is taken to be the name of the file containing the executable bytecode. (That file is searched in the executable path as well as in the current directory.) The remaining -arguments are passed to the Objective Caml program, in the string array +arguments are passed to the OCaml program, in the string array .BR Sys.argv . Element 0 of this array is the name of the bytecode executable file; elements 1 to @@ -60,6 +70,7 @@ Search the directory .I dir for dynamically-loaded libraries, in addition to the standard search path. +.TP .B \-p Print the names of the primitives known to this version of .BR ocamlrun (1) @@ -85,14 +96,14 @@ Additional directories to search for dynamically-loaded libraries. .TP .B OCAMLLIB -The directory containing the Objective Caml standard +The directory containing the OCaml standard library. (If .B OCAMLLIB is not set, .B CAMLLIB will be used instead.) Used to locate the ld.conf configuration file for dynamic loading. If not set, -default to the library directory specified when compiling Objective Caml. +default to the library directory specified when compiling OCaml. .TP .B OCAMLRUNPARAM Set the runtime system options and garbage collection parameters. @@ -101,11 +112,11 @@ A parameter specification is an option letter followed by an = sign, a decimal number (or a hexadecimal number prefixed by .BR 0x ), -and an optional multiplier. There are nine options, six of which -correspond to the fields of the +and an optional multiplier. The options are documented below; the +last six correspond to the fields of the .B control record documented in -.IR "The Objective Caml user's manual", +.IR "The OCaml user's manual", chapter "Standard Library", section "Gc". .TP .B b @@ -120,10 +131,19 @@ the pushdown automaton that executes the parsers prints a trace of its actions. This option takes no argument. .TP +.BR R +Turn on randomization of all hash tables by default (see the +.B Hashtbl +module of the standard library). This option takes no +argument. +.TP +.BR h +The initial size of the major heap (in words). +.TP .BR a \ (allocation_policy) The policy used for allocating in the OCaml heap. Possible values are 0 for the next-fit policy, and 1 for the first-fit -policy. Next-fit is somewhat faster, but first-fit is better for +policy. Next-fit is usually faster, but first-fit is better for avoiding fragmentation and the associated heap compactions. .TP .BR s \ (minor_heap_size) @@ -141,9 +161,6 @@ .BR l \ (stack_limit) The limit (in words) of the stack size. .TP -.BR h -The initial size of the major heap (in words). -.TP .BR v \ (verbose) What GC messages to print to stderr. This is a sum of values selected from the following: @@ -178,7 +195,7 @@ The multiplier is .BR k , -.BR M \ or +.BR M ,\ or .BR G , for multiplication by 2^10, 2^20, and 2^30 respectively. For example, on a 32-bit machine under bash, the command @@ -199,5 +216,5 @@ .SH SEE ALSO .BR ocamlc (1). .br -.IR "The Objective Caml user's manual" , +.IR "The OCaml user's manual" , chapter "Runtime system". diff -Nru ocaml-3.12.1/man/ocamlyacc.m ocaml-4.01.0/man/ocamlyacc.m --- ocaml-3.12.1/man/ocamlyacc.m 2010-05-20 14:06:29.000000000 +0000 +++ ocaml-4.01.0/man/ocamlyacc.m 2012-10-15 17:50:56.000000000 +0000 @@ -1,8 +1,19 @@ -\" $Id: ocamlyacc.m 10444 2010-05-20 14:06:29Z doligez $ +.\"*********************************************************************** +.\"* * +.\"* OCaml * +.\"* * +.\"* Xavier Leroy, projet Cristal, INRIA Rocquencourt * +.\"* * +.\"* Copyright 1996 Institut National de Recherche en Informatique et * +.\"* en Automatique. All rights reserved. This file is distributed * +.\"* under the terms of the Q Public License version 1.0. * +.\"* * +.\"*********************************************************************** +.\" .TH OCAMLYACC 1 .SH NAME -ocamlyacc \- The Objective Caml parser generator +ocamlyacc \- The OCaml parser generator .SH SYNOPSIS .B ocamlyacc @@ -30,7 +41,7 @@ .IR grammar \&.mly, running .B ocamlyacc -produces Caml code for a parser in the file +produces OCaml code for a parser in the file .IR grammar \&.ml, and its interface in file .IR grammar \&.mli. @@ -91,5 +102,5 @@ .SH SEE ALSO .BR ocamllex (1). .br -.IR "The Objective Caml user's manual" , +.IR "The OCaml user's manual" , chapter "Lexer and parser generators". diff -Nru ocaml-3.12.1/myocamlbuild.ml ocaml-4.01.0/myocamlbuild.ml --- ocaml-3.12.1/myocamlbuild.ml 2011-02-08 14:07:47.000000000 +0000 +++ ocaml-4.01.0/myocamlbuild.ml 2013-05-07 09:40:33.000000000 +0000 @@ -1,6 +1,6 @@ (***********************************************************************) (* *) -(* Objective Caml *) +(* OCaml *) (* *) (* Nicolas Pouillard, projet Gallium, INRIA Rocquencourt *) (* *) @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: myocamlbuild.ml 10941 2011-02-08 14:07:47Z xclerc $ *) - open Ocamlbuild_plugin open Command open Arch @@ -22,7 +20,7 @@ let windows = Sys.os_type = "Win32";; if windows then tag_any ["windows"];; let ccomptype = C.ccomptype -let () = if ccomptype <> "cc" then eprintf "ccomptype: %s@." ccomptype;; +(*let () = if ccomptype <> "cc" then eprintf "ccomptype: %s@." ccomptype;;*) let fp_cat oc f = with_input_file ~bin:true f (fun ic -> copy_chan ic oc) @@ -251,7 +249,6 @@ let camlp4_arch = dir "" [ - dir "stdlib" []; dir "camlp4" [ dir "build" []; dir_pack "Camlp4" [ @@ -268,8 +265,7 @@ Pathname.define_context "" ["stdlib"];; Pathname.define_context "utils" [Pathname.current_dir_name; "stdlib"];; -Pathname.define_context "camlp4" ["camlp4"; "stdlib"];; -Pathname.define_context "camlp4/boot" ["camlp4"; "stdlib"];; +Pathname.define_context "camlp4/boot" ["camlp4"];; Pathname.define_context "camlp4/Camlp4Parsers" ["camlp4"; "stdlib"];; Pathname.define_context "camlp4/Camlp4Printers" ["camlp4"; "stdlib"];; Pathname.define_context "camlp4/Camlp4Filters" ["camlp4"; "stdlib"];; @@ -285,11 +281,11 @@ Pathname.define_context "otherlibs/dynlink" ["otherlibs/dynlink"; "bytecomp"; "utils"; "typing"; "parsing"; "stdlib"];; Pathname.define_context "otherlibs/dynlink/nat" ["otherlibs/dynlink/nat"; "asmcomp"; "stdlib"];; Pathname.define_context "asmcomp" ["asmcomp"; "bytecomp"; "parsing"; "typing"; "utils"; "stdlib"];; -Pathname.define_context "ocamlbuild" ["ocamlbuild"; "stdlib"; "."];; +Pathname.define_context "ocamlbuild" ["ocamlbuild"; "."];; Pathname.define_context "lex" ["lex"; "stdlib"];; List.iter (fun x -> let x = "otherlibs"/x in Pathname.define_context x [x; "stdlib"]) - ["bigarray"; "dbm"; "graph"; "num"; "str"; "systhreads"; "unix"; "win32graph"; "win32unix"];; + ["bigarray"; "graph"; "num"; "str"; "systhreads"; "unix"; "win32graph"; "win32unix"];; (* The bootstrap standard library *) copy_rule "The bootstrap standard library" "stdlib/%" "boot/%";; @@ -407,8 +403,6 @@ flag [(* "ocaml" or "c"; *) "ocamlmklib"; "otherlibs_graph"] (S[Sh C.x11_link]);; flag ["c"; "compile"; "otherlibs_graph"] (S[Sh C.x11_includes; A"-I../otherlibs/graph"]);; flag ["c"; "compile"; "otherlibs_win32graph"] (A"-I../otherlibs/win32graph");; -flag ["c"; "compile"; "otherlibs_dbm"] (Sh C.dbm_includes);; -flag [(* "ocaml" oc "c"; *) "ocamlmklib"; "otherlibs_dbm"] (S[A"-oc"; A"otherlibs/dbm/mldbm"; Sh C.dbm_link]);; flag ["ocaml"; "ocamlmklib"; "otherlibs_threads"] (S[A"-oc"; A"otherlibs/threads/vmthreads"]);; flag ["c"; "compile"; "otherlibs_num"] begin S[A("-DBNG_ARCH_"^C.bng_arch); @@ -676,7 +670,6 @@ let camlp4_import_list = ["utils/misc.ml"; "utils/terminfo.ml"; - "parsing/linenum.ml"; "utils/warnings.ml"; "parsing/location.ml"; "parsing/longident.ml"; @@ -1049,7 +1042,7 @@ ~prod:"otherlibs/labltk/lib/labltk" begin fun _ _ -> Echo(["#!/bin/sh\n"; - Printf.sprintf "exec %s -I %s $*\n" (labltk_installdir/"labltktop") labltk_installdir], + Printf.sprintf "exec %s -I %s \"$@\"\n" (labltk_installdir/"labltktop") labltk_installdir], "otherlibs/labltk/lib/labltk") end;; diff -Nru ocaml-3.12.1/myocamlbuild_config.mli ocaml-4.01.0/myocamlbuild_config.mli --- ocaml-3.12.1/myocamlbuild_config.mli 2010-11-18 12:27:11.000000000 +0000 +++ ocaml-4.01.0/myocamlbuild_config.mli 2012-07-17 15:31:12.000000000 +0000 @@ -1,9 +1,22 @@ +(*************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Nicolas Pouillard, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(*************************************************************************) + val prefix : string val bindir : string val libdir : string val manext : string val ranlib : string val ranlibcmd : string +val arcmd : string val sharpbangscripts : bool val bng_arch : string val bng_asm_level : string @@ -11,8 +24,6 @@ val x11_includes : string val x11_link : string val tk_link : string -val dbm_includes : string -val dbm_link : string val bytecc : string val bytecccompopts : string val bytecclinkopts : string @@ -58,3 +69,4 @@ val ccomptype : string val extralibs : string val tk_defs : string +val asm_cfi_supported : bool diff -Nru ocaml-3.12.1/ocamlbuild/.depend ocaml-4.01.0/ocamlbuild/.depend --- ocaml-3.12.1/ocamlbuild/.depend 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/.depend 2013-01-01 00:33:29.000000000 +0000 @@ -0,0 +1,192 @@ +bool.cmi : +command.cmi : tags.cmi signatures.cmi +configuration.cmi : tags.cmi pathname.cmi +digest_cache.cmi : +discard_printf.cmi : +display.cmi : tags.cmi +exit_codes.cmi : +fda.cmi : slurp.cmi +findlib.cmi : signatures.cmi command.cmi +flags.cmi : tags.cmi command.cmi +glob.cmi : signatures.cmi glob_ast.cmi bool.cmi +glob_ast.cmi : bool.cmi +glob_lexer.cmi : glob_ast.cmi +hooks.cmi : +hygiene.cmi : slurp.cmi +lexers.cmi : glob.cmi +log.cmi : tags.cmi signatures.cmi +main.cmi : +my_std.cmi : signatures.cmi +my_unix.cmi : +ocaml_arch.cmi : signatures.cmi command.cmi +ocaml_compiler.cmi : tags.cmi rule.cmi pathname.cmi command.cmi +ocaml_dependencies.cmi : pathname.cmi +ocaml_specific.cmi : +ocaml_tools.cmi : tags.cmi rule.cmi pathname.cmi command.cmi +ocaml_utils.cmi : tags.cmi pathname.cmi command.cmi +ocamlbuild.cmi : +ocamlbuild_executor.cmi : +ocamlbuild_plugin.cmi : +ocamlbuild_unix_plugin.cmi : +ocamlbuild_where.cmi : +ocamlbuildlight.cmi : +options.cmi : slurp.cmi signatures.cmi command.cmi +param_tags.cmi : tags.cmi +pathname.cmi : signatures.cmi +plugin.cmi : +ppcache.cmi : +report.cmi : solver.cmi +resource.cmi : slurp.cmi pathname.cmi my_std.cmi command.cmi +rule.cmi : tags.cmi resource.cmi pathname.cmi my_std.cmi command.cmi +shell.cmi : +signatures.cmi : +slurp.cmi : my_unix.cmi +solver.cmi : pathname.cmi +tags.cmi : signatures.cmi +tools.cmi : tags.cmi pathname.cmi +bool.cmo : bool.cmi +bool.cmx : bool.cmi +command.cmo : tags.cmi shell.cmi param_tags.cmi my_unix.cmi my_std.cmi \ + log.cmi lexers.cmi command.cmi +command.cmx : tags.cmx shell.cmx param_tags.cmx my_unix.cmx my_std.cmx \ + log.cmx lexers.cmi command.cmi +configuration.cmo : tags.cmi param_tags.cmi my_std.cmi log.cmi lexers.cmi \ + glob.cmi configuration.cmi +configuration.cmx : tags.cmx param_tags.cmx my_std.cmx log.cmx lexers.cmi \ + glob.cmx configuration.cmi +digest_cache.cmo : shell.cmi pathname.cmi options.cmi my_unix.cmi my_std.cmi \ + digest_cache.cmi +digest_cache.cmx : shell.cmx pathname.cmx options.cmx my_unix.cmx my_std.cmx \ + digest_cache.cmi +discard_printf.cmo : discard_printf.cmi +discard_printf.cmx : discard_printf.cmi +display.cmo : tags.cmi my_unix.cmi my_std.cmi discard_printf.cmi display.cmi +display.cmx : tags.cmx my_unix.cmx my_std.cmx discard_printf.cmx display.cmi +exit_codes.cmo : exit_codes.cmi +exit_codes.cmx : exit_codes.cmi +fda.cmo : pathname.cmi options.cmi log.cmi hygiene.cmi fda.cmi +fda.cmx : pathname.cmx options.cmx log.cmx hygiene.cmx fda.cmi +findlib.cmo : my_unix.cmi my_std.cmi lexers.cmi command.cmi findlib.cmi +findlib.cmx : my_unix.cmx my_std.cmx lexers.cmi command.cmx findlib.cmi +flags.cmo : tags.cmi param_tags.cmi command.cmi bool.cmi flags.cmi +flags.cmx : tags.cmx param_tags.cmx command.cmx bool.cmx flags.cmi +glob.cmo : my_std.cmi glob_lexer.cmi glob_ast.cmi bool.cmi glob.cmi +glob.cmx : my_std.cmx glob_lexer.cmi glob_ast.cmx bool.cmx glob.cmi +glob_ast.cmo : bool.cmi glob_ast.cmi +glob_ast.cmx : bool.cmx glob_ast.cmi +hooks.cmo : hooks.cmi +hooks.cmx : hooks.cmi +hygiene.cmo : slurp.cmi shell.cmi pathname.cmi options.cmi my_std.cmi \ + log.cmi hygiene.cmi +hygiene.cmx : slurp.cmx shell.cmx pathname.cmx options.cmx my_std.cmx \ + log.cmx hygiene.cmi +log.cmo : my_unix.cmi my_std.cmi display.cmi log.cmi +log.cmx : my_unix.cmx my_std.cmx display.cmx log.cmi +main.cmo : tools.cmi tags.cmi solver.cmi slurp.cmi shell.cmi rule.cmi \ + resource.cmi report.cmi plugin.cmi pathname.cmi param_tags.cmi \ + options.cmi ocaml_utils.cmi ocaml_specific.cmi ocaml_dependencies.cmi \ + my_unix.cmi my_std.cmi log.cmi lexers.cmi hooks.cmi flags.cmi fda.cmi \ + exit_codes.cmi digest_cache.cmi configuration.cmi command.cmi main.cmi +main.cmx : tools.cmx tags.cmx solver.cmx slurp.cmx shell.cmx rule.cmx \ + resource.cmx report.cmx plugin.cmx pathname.cmx param_tags.cmx \ + options.cmx ocaml_utils.cmx ocaml_specific.cmx ocaml_dependencies.cmx \ + my_unix.cmx my_std.cmx log.cmx lexers.cmi hooks.cmx flags.cmx fda.cmx \ + exit_codes.cmx digest_cache.cmx configuration.cmx command.cmx main.cmi +my_std.cmo : my_std.cmi +my_std.cmx : my_std.cmi +my_unix.cmo : my_std.cmi my_unix.cmi +my_unix.cmx : my_std.cmx my_unix.cmi +ocaml_arch.cmo : pathname.cmi my_std.cmi command.cmi ocaml_arch.cmi +ocaml_arch.cmx : pathname.cmx my_std.cmx command.cmx ocaml_arch.cmi +ocaml_compiler.cmo : tools.cmi tags.cmi rule.cmi resource.cmi pathname.cmi \ + options.cmi ocaml_utils.cmi ocaml_dependencies.cmi ocaml_arch.cmi \ + my_std.cmi log.cmi command.cmi ocaml_compiler.cmi +ocaml_compiler.cmx : tools.cmx tags.cmx rule.cmx resource.cmx pathname.cmx \ + options.cmx ocaml_utils.cmx ocaml_dependencies.cmx ocaml_arch.cmx \ + my_std.cmx log.cmx command.cmx ocaml_compiler.cmi +ocaml_dependencies.cmo : tools.cmi resource.cmi pathname.cmi ocaml_utils.cmi \ + my_std.cmi log.cmi ocaml_dependencies.cmi +ocaml_dependencies.cmx : tools.cmx resource.cmx pathname.cmx ocaml_utils.cmx \ + my_std.cmx log.cmx ocaml_dependencies.cmi +ocaml_specific.cmo : tools.cmi tags.cmi rule.cmi pathname.cmi options.cmi \ + ocaml_utils.cmi ocaml_tools.cmi ocaml_compiler.cmi my_std.cmi log.cmi \ + flags.cmi findlib.cmi configuration.cmi command.cmi ocaml_specific.cmi +ocaml_specific.cmx : tools.cmx tags.cmx rule.cmx pathname.cmx options.cmx \ + ocaml_utils.cmx ocaml_tools.cmx ocaml_compiler.cmx my_std.cmx log.cmx \ + flags.cmx findlib.cmx configuration.cmx command.cmx ocaml_specific.cmi +ocaml_tools.cmo : tools.cmi tags.cmi rule.cmi pathname.cmi options.cmi \ + ocaml_utils.cmi ocaml_compiler.cmi my_std.cmi flags.cmi command.cmi \ + ocaml_tools.cmi +ocaml_tools.cmx : tools.cmx tags.cmx rule.cmx pathname.cmx options.cmx \ + ocaml_utils.cmx ocaml_compiler.cmx my_std.cmx flags.cmx command.cmx \ + ocaml_tools.cmi +ocaml_utils.cmo : tools.cmi tags.cmi pathname.cmi param_tags.cmi options.cmi \ + my_std.cmi log.cmi lexers.cmi flags.cmi command.cmi ocaml_utils.cmi +ocaml_utils.cmx : tools.cmx tags.cmx pathname.cmx param_tags.cmx options.cmx \ + my_std.cmx log.cmx lexers.cmi flags.cmx command.cmx ocaml_utils.cmi +ocamlbuild.cmo : ocamlbuild_unix_plugin.cmi ocamlbuild.cmi +ocamlbuild.cmx : ocamlbuild_unix_plugin.cmx ocamlbuild.cmi +ocamlbuild_Myocamlbuild_config.cmo : +ocamlbuild_Myocamlbuild_config.cmx : +ocamlbuild_executor.cmo : ocamlbuild_executor.cmi +ocamlbuild_executor.cmx : ocamlbuild_executor.cmi +ocamlbuild_plugin.cmo : ocamlbuild_plugin.cmi +ocamlbuild_plugin.cmx : ocamlbuild_plugin.cmi +ocamlbuild_unix_plugin.cmo : ocamlbuild_executor.cmi my_unix.cmi my_std.cmi \ + exit_codes.cmi ocamlbuild_unix_plugin.cmi +ocamlbuild_unix_plugin.cmx : ocamlbuild_executor.cmx my_unix.cmx my_std.cmx \ + exit_codes.cmx ocamlbuild_unix_plugin.cmi +ocamlbuild_where.cmo : ocamlbuild_Myocamlbuild_config.cmo \ + ocamlbuild_where.cmi +ocamlbuild_where.cmx : ocamlbuild_Myocamlbuild_config.cmx \ + ocamlbuild_where.cmi +ocamlbuildlight.cmo : ocamlbuildlight.cmi +ocamlbuildlight.cmx : ocamlbuildlight.cmi +options.cmo : shell.cmi ocamlbuild_where.cmi \ + ocamlbuild_Myocamlbuild_config.cmo my_std.cmi log.cmi lexers.cmi \ + command.cmi options.cmi +options.cmx : shell.cmx ocamlbuild_where.cmx \ + ocamlbuild_Myocamlbuild_config.cmx my_std.cmx log.cmx lexers.cmi \ + command.cmx options.cmi +param_tags.cmo : my_std.cmi log.cmi lexers.cmi param_tags.cmi +param_tags.cmx : my_std.cmx log.cmx lexers.cmi param_tags.cmi +pathname.cmo : shell.cmi options.cmi my_unix.cmi my_std.cmi log.cmi glob.cmi \ + pathname.cmi +pathname.cmx : shell.cmx options.cmx my_unix.cmx my_std.cmx log.cmx glob.cmx \ + pathname.cmi +plugin.cmo : tools.cmi tags.cmi shell.cmi rule.cmi pathname.cmi options.cmi \ + ocamlbuild_where.cmi my_unix.cmi my_std.cmi log.cmi command.cmi \ + plugin.cmi +plugin.cmx : tools.cmx tags.cmx shell.cmx rule.cmx pathname.cmx options.cmx \ + ocamlbuild_where.cmx my_unix.cmx my_std.cmx log.cmx command.cmx \ + plugin.cmi +ppcache.cmo : shell.cmi pathname.cmi my_std.cmi log.cmi command.cmi \ + ppcache.cmi +ppcache.cmx : shell.cmx pathname.cmx my_std.cmx log.cmx command.cmx \ + ppcache.cmi +report.cmo : solver.cmi resource.cmi my_std.cmi log.cmi glob.cmi report.cmi +report.cmx : solver.cmx resource.cmx my_std.cmx log.cmx glob.cmx report.cmi +resource.cmo : slurp.cmi shell.cmi pathname.cmi options.cmi my_unix.cmi \ + my_std.cmi log.cmi lexers.cmi glob_ast.cmi glob.cmi digest_cache.cmi \ + command.cmi resource.cmi +resource.cmx : slurp.cmx shell.cmx pathname.cmx options.cmx my_unix.cmx \ + my_std.cmx log.cmx lexers.cmi glob_ast.cmx glob.cmx digest_cache.cmx \ + command.cmx resource.cmi +rule.cmo : tags.cmi shell.cmi resource.cmi pathname.cmi options.cmi \ + my_std.cmi log.cmi digest_cache.cmi command.cmi rule.cmi +rule.cmx : tags.cmx shell.cmx resource.cmx pathname.cmx options.cmx \ + my_std.cmx log.cmx digest_cache.cmx command.cmx rule.cmi +shell.cmo : tags.cmi my_unix.cmi my_std.cmi log.cmi shell.cmi +shell.cmx : tags.cmx my_unix.cmx my_std.cmx log.cmx shell.cmi +slurp.cmo : my_unix.cmi my_std.cmi slurp.cmi +slurp.cmx : my_unix.cmx my_std.cmx slurp.cmi +solver.cmo : rule.cmi resource.cmi pathname.cmi my_std.cmi log.cmi \ + command.cmi solver.cmi +solver.cmx : rule.cmx resource.cmx pathname.cmx my_std.cmx log.cmx \ + command.cmx solver.cmi +tags.cmo : tags.cmi +tags.cmx : tags.cmi +tools.cmo : tags.cmi rule.cmi pathname.cmi my_std.cmi log.cmi \ + configuration.cmi tools.cmi +tools.cmx : tags.cmx rule.cmx pathname.cmx my_std.cmx log.cmx \ + configuration.cmx tools.cmi diff -Nru ocaml-3.12.1/ocamlbuild/ChangeLog ocaml-4.01.0/ocamlbuild/ChangeLog --- ocaml-3.12.1/ocamlbuild/ChangeLog 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ChangeLog 2012-08-02 08:17:59.000000000 +0000 @@ -2302,7 +2302,7 @@ 2006-12-08 Nicolas Pouillard - Ocaml distrib stuffs. + OCaml distrib stuffs. * command.ml, * command.mli: Add a normalization callback. @@ -3619,4 +3619,3 @@ * ocamlbuild.ml: Add some flags -lflag, -ppflag, -cflag, --. Also add a detection mechanism for dependencies. * discard_printf.ml, Makefile: Update. - diff -Nru ocaml-3.12.1/ocamlbuild/Makefile ocaml-4.01.0/ocamlbuild/Makefile --- ocaml-3.12.1/ocamlbuild/Makefile 2010-04-20 15:38:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/Makefile 2012-10-15 17:50:56.000000000 +0000 @@ -1,6 +1,6 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt # # # @@ -10,8 +10,6 @@ # # ######################################################################### -# $Id: Makefile 10286 2010-04-20 15:38:58Z doligez $ - .PHONY: all byte native profile debug ppcache doc ifndef INSTALL_PREFIX diff -Nru ocaml-3.12.1/ocamlbuild/Makefile.noboot ocaml-4.01.0/ocamlbuild/Makefile.noboot --- ocaml-3.12.1/ocamlbuild/Makefile.noboot 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/Makefile.noboot 2013-01-01 00:33:27.000000000 +0000 @@ -0,0 +1,226 @@ +#(***********************************************************************) +#(* *) +#(* ocamlbuild *) +#(* *) +#(* Wojciech Meyer *) +#(* *) +#(* Copyright 2012 Institut National de Recherche en Informatique et *) +#(* en Automatique. All rights reserved. This file is distributed *) +#(* under the terms of the Q Public License version 1.0. *) +#(* *) +#(***********************************************************************) + +# This file removes the dependency on ocamlbuild itself, thus removes need +# for bootstrap. The base for this Makefile was ocamldoc Makefile. + +include ../config/Makefile + +# Various commands and dir +########################## +CAMLRUN = ../boot/ocamlrun +OCAMLC = ../ocamlcomp.sh +OCAMLOPT = ../ocamlcompopt.sh +OCAMLDEP = $(CAMLRUN) ../tools/ocamldep +OCAMLLEX = $(CAMLRUN) ../boot/ocamllex +OCAMLLIB = $(LIBDIR) +OCAMLBIN = $(BINDIR) + +# For installation +############## +MKDIR=mkdir -p +CP=cp -f +OCAMLBUILD=ocamlbuild +OCAMLBUILD_OPT=$(OCAMLBUILD).opt +OCAMLBUILD_LIBCMA=ocamlbuildlib.cma +OCAMLBUILD_LIBCMI=ocamlbuildlib.cmi +OCAMLBUILD_LIBCMXA=ocamlbuild.cmxa +OCAMLBUILD_LIBA=ocamlbuild.$(A) +INSTALL_LIBDIR=$(OCAMLLIB)/ocamlbuild +INSTALL_CUSTOMDIR=$(INSTALL_LIBDIR)/custom +INSTALL_BINDIR=$(OCAMLBIN) +INSTALL_MANODIR=$(MANDIR)/man3 + +INSTALL_MLIS= +INSTALL_CMIS=$(INSTALL_MLIS:.mli=.cmi) + +# Compilation +############# +OCAMLSRCDIR=.. +INCLUDES_DEP= + +INCLUDES_NODEP= -I $(OCAMLSRCDIR)/stdlib \ + -I $(OCAMLSRCDIR)/otherlibs/str \ + -I $(OCAMLSRCDIR)/otherlibs/dynlink \ + -I $(OCAMLSRCDIR)/otherlibs/unix + +INCLUDES=$(INCLUDES_DEP) $(INCLUDES_NODEP) + +COMPFLAGS=$(INCLUDES) -warn-error A +LINKFLAGS=$(INCLUDES) + +CMOFILES_PACK= \ + ocamlbuild_Myocamlbuild_config.cmo \ + discard_printf.cmo \ + my_std.cmo \ + bool.cmo \ + glob_ast.cmo \ + glob_lexer.cmo \ + glob.cmo \ + lexers.cmo \ + my_unix.cmo \ + tags.cmo \ + display.cmo \ + log.cmo \ + param_tags.cmo \ + shell.cmo \ + slurp.cmo \ + ocamlbuild_where.cmo \ + command.cmo \ + options.cmo \ + pathname.cmo \ + digest_cache.cmo \ + resource.cmo \ + rule.cmo \ + flags.cmo \ + solver.cmo \ + report.cmo \ + ocaml_arch.cmo \ + hygiene.cmo \ + configuration.cmo \ + tools.cmo \ + fda.cmo \ + plugin.cmo \ + ocaml_utils.cmo \ + ocaml_dependencies.cmo \ + ocaml_compiler.cmo \ + ocaml_tools.cmo \ + hooks.cmo \ + findlib.cmo \ + ocaml_specific.cmo \ + exit_codes.cmo \ + main.cmo + +BASE_CMOFILES= ocamlbuild_executor.cmo \ + ocamlbuild_unix_plugin.cmo + +INSTALL_LIBFILES = $(BASE_CMOFILES) \ + $(BASE_CMOFILES:.cmo=.cmi) \ + $(OCAMLBUILD_LIBCMA) \ + $(OCAMLBUILD).cmo \ + $(OCAMLBUILD)_pack.cmi + +INSTALL_BINFILES = $(OCAMLBUILD) + +CMXFILES= $(CMOFILES:.cmo=.cmx) + +CMXFILES_PACK= $(CMOFILES_PACK:.cmo=.cmx) +CMIFILES_PACK= $(CMOFILES_PACK:.cmo=.cmi) signatures.cmi + +EXECMOFILES_PACK= $(CMOFILES_PACK) +EXECMXFILES_PACK= $(EXECMOFILES_PACK:.cmo=.cmx) +EXECMIFILES_PACK= $(EXECMOFILES_PACK:.cmo=.cmi) + +LIBCMOFILES_PACK= $(CMOFILES_PACK) +LIBCMXFILES_PACK= $(LIBCMOFILES_PACK:.cmo=.cmx) +LIBCMIFILES_PACK= $(LIBCMOFILES_PACK:.cmo=.cmi) + +# Les cmo et cmx de la distrib OCAML +OCAMLCMOFILES= +OCAMLCMXFILES=$(OCAMLCMOFILES_PACK:.cmo=.cmx) + +all: exe lib +opt: $(OCAMLBUILD).native +exe: $(OCAMLBUILD) +lib: $(OCAMLBUILD_LIBCMA) + +opt.opt: exeopt libopt +exeopt: $(OCAMLBUILD_OPT) +libopt: $(OCAMLBUILD_LIBCMXA) $(OCAMLBUILD_LIBCMI) + +debug: + $(MAKE) OCAMLPP="" + +$(OCAMLBUILD)_pack.cmo: $(CMOFILES_PACK) $(CMIFILES_PACK) + $(OCAMLC) -pack -o $@ $(LINKFLAGS) $(OCAMLCMOFILES_PACK) $(EXECMOFILES_PACK) signatures.mli + +$(OCAMLBUILD)_pack.cmx: $(EXECMXFILES_PACK) + $(OCAMLOPT) -pack -o $@ $(LINKFLAGS) $(OCAMLCMOFILES_PACK) $(EXECMXFILES_PACK) + +$(OCAMLBUILD): $(OCAMLBUILD)_pack.cmo $(CMOFILES) $(OCAMLBUILD).cmo $(BASE_CMOFILES) + $(OCAMLC) -o $@ unix.cma $(LINKFLAGS) $(OCAMLBUILD)_pack.cmo $(CMOFILES) + +$(OCAMLBUILD).native: $(OCAMLBUILD)_pack.cmx $(CMXFILES) + $(OCAMLOPT) -o $@ $(LINKFLAGS) $(CMXFILES) + +$(OCAMLBUILD_LIBCMA): $(LIBCMOFILES_PACK) + $(OCAMLC) -a -o $@ $(LINKFLAGS) $(OCAMLSRCDIR)/tools/depend.cmo $(LIBCMOFILES_PACK) +$(OCAMLBUILD_LIBCMXA): $(LIBCMXFILES) + $(OCAMLOPT) -a -o $@ $(LINKFLAGS) $(OCAMLSRCDIR)/tools/depend.cmx $(LIBCMXFILES) + +# generic rules : +################# + +.SUFFIXES: .mll .mly .ml .mli .cmo .cmi .cmx .cmxs + +.ml.cmo: + $(OCAMLC) $(OCAMLPP) $(COMPFLAGS) -c $< + +.mli.cmi: + $(OCAMLC) $(OCAMLPP) $(COMPFLAGS) -c $< + +.ml.cmx: + $(OCAMLOPT) $(OCAMLPP) $(COMPFLAGS) -c $< + +.ml.cmxs: + $(OCAMLOPT) -shared -o $@ $(OCAMLPP) $(COMPFLAGS) $< + +.mll.ml: + $(OCAMLLEX) $< + +.mly.ml: + $(OCAMLYACC) -v $< + +.mly.mli: + $(OCAMLYACC) -v $< + +# Installation targets +###################### +install: dummy + if test -d $(INSTALL_BINDIR); then : ; else $(MKDIR) $(INSTALL_BINDIR); fi + if test -d $(INSTALL_LIBDIR); then : ; else $(MKDIR) $(INSTALL_LIBDIR); fi + if test -d $(INSTALL_CUSTOMDIR); then : ; else $(MKDIR) $(INSTALL_CUSTOMDIR); fi + $(CP) $(OCAMLBUILD) $(INSTALL_BINDIR)/$(OCAMLBUILD)$(EXE) + $(CP) $(INSTALL_LIBFILES) $(INSTALL_LIBDIR) + $(CP) $(INSTALL_BINFILES) $(INSTALL_BINDIR) + +installopt: + if test -f $(OCAMLBUILD_OPT) ; then $(MAKE) installopt_really ; fi + +installopt_really: + if test -d $(INSTALL_BINDIR); then : ; else $(MKDIR) $(INSTALL_BINDIR); fi + if test -d $(INSTALL_LIBDIR); then : ; else $(MKDIR) $(INSTALL_LIBDIR); fi + $(CP) ocamlbuild.hva $(OCAMLBUILD_LIBA) $(OCAMLBUILD_LIBCMXA) $(INSTALL_LIBDIR) + $(CP) $(INSTALL_MLIS) $(INSTALL_CMIS) $(INSTALL_LIBDIR) + + +# backup, clean and depend : +############################ + +clean:: dummy + @rm -f *~ \#*\# + @rm -f $(OCAMLBUILD) $(OCAMLBUILD_OPT) *.cma *.cmxa *.cmo *.cmi *.cmx *.$(A) *.$(O) + @rm -f glob_lexer.ml lexers.ml + +depend:: + $(OCAMLDEP) $(INCLUDES_DEP) *.mli *.mll *.mly *.ml > .depend + +dummy: + +include .depend + +# Additional rules +glob_lexer.cmo: glob_lexer.cmi +lexers.cmo: lexers.cmi + +glob_lexer.cmx: glob_lexer.cmi +lexers.cmx: lexers.cmi diff -Nru ocaml-3.12.1/ocamlbuild/_tags ocaml-4.01.0/ocamlbuild/_tags --- ocaml-3.12.1/ocamlbuild/_tags 2010-04-20 15:38:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/_tags 2012-07-17 15:31:12.000000000 +0000 @@ -1,10 +1,22 @@ +######################################################################### +# # +# OCaml # +# # +# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# # +# Copyright 2007 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + # OCamlbuild tags file true: debug <*.ml> or <*.mli>: warn_L, warn_R, warn_Z, annot "discard_printf.ml": rectypes "ocamlbuildlib.cma" or "ocamlbuildlightlib.cma": linkall <*.byte> or <*.native> or <*.top>: use_unix -"ocamlbuildlight.byte": -use_unix +"ocamlbuildlight.byte": -use_unix, nopervasives <*.cmx>: for-pack(Ocamlbuild_pack) <{ocamlbuild_{pack,unix_plugin,plugin,executor},ppcache}{,.p}.cmx>: -for-pack(Ocamlbuild_pack) "doc": not_hygienic diff -Nru ocaml-3.12.1/ocamlbuild/bool.ml ocaml-4.01.0/ocamlbuild/bool.ml --- ocaml-3.12.1/ocamlbuild/bool.ml 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/bool.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/bool.mli ocaml-4.01.0/ocamlbuild/bool.mli --- ocaml-3.12.1/ocamlbuild/bool.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/bool.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/command.ml ocaml-4.01.0/ocamlbuild/command.ml --- ocaml-3.12.1/ocamlbuild/command.ml 2010-02-03 13:11:19.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/command.ml 2013-01-01 04:53:51.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -91,10 +92,16 @@ let env_path = lazy begin let path_var = Sys.getenv "PATH" in + let parse_path = + if Sys.os_type = "Win32" then + Lexers.parse_environment_path_w + else + Lexers.parse_environment_path + in let paths = try - Lexers.parse_environment_path (Lexing.from_string path_var) - with Lexers.Error msg -> raise (Lexers.Error ("$PATH: " ^ msg)) + parse_path (Lexing.from_string path_var) + with Lexers.Error (msg,pos) -> raise (Lexers.Error ("$PATH: " ^ msg, pos)) in let norm_current_dir_name path = if path = "" then Filename.current_dir_name else path @@ -119,21 +126,33 @@ failwith (Printf.sprintf "the solver for the virtual command %S \ has failed finding a valid command" virtual_command) +(* On Windows, we need to also check for the ".exe" version of the file. *) +let file_or_exe_exists file = + sys_file_exists file || Sys.os_type = "Win32" && sys_file_exists (file ^ ".exe") -(* FIXME windows *) let search_in_path cmd = + (* Try to find [cmd] in path [path]. *) + let try_path path = + (* Don't know why we're trying to be subtle here... *) + if path = Filename.current_dir_name then file_or_exe_exists cmd + else file_or_exe_exists (filename_concat path cmd) + in if Filename.is_implicit cmd then - let path = List.find begin fun path -> - if path = Filename.current_dir_name then sys_file_exists cmd - else sys_file_exists (filename_concat path cmd) - end !*env_path in + let path = List.find try_path !*env_path in + (* We're not trying to append ".exe" here because all windows shells are + * capable of understanding the command without the ".exe" suffix. *) filename_concat path cmd - else cmd + else + cmd (*** string_of_command_spec{,_with_calls *) let rec string_of_command_spec_with_calls call_with_tags call_with_target resolve_virtuals spec = let self = string_of_command_spec_with_calls call_with_tags call_with_target resolve_virtuals in let b = Buffer.create 256 in + (* The best way to prevent bash from switching to its windows-style + * quote-handling is to prepend an empty string before the command name. *) + if Sys.os_type = "Win32" then + Buffer.add_string b "''"; let first = ref true in let put_space () = if !first then diff -Nru ocaml-3.12.1/ocamlbuild/command.mli ocaml-4.01.0/ocamlbuild/command.mli --- ocaml-3.12.1/ocamlbuild/command.mli 2010-01-22 14:36:57.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/command.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -44,3 +45,5 @@ val dep : Tags.elt list -> pathname list -> unit val pdep : Tags.elt list -> Tags.elt -> (string -> pathname list) -> unit + +val file_or_exe_exists: string -> bool diff -Nru ocaml-3.12.1/ocamlbuild/configuration.ml ocaml-4.01.0/ocamlbuild/configuration.ml --- ocaml-3.12.1/ocamlbuild/configuration.ml 2010-02-03 13:11:20.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/configuration.ml 2013-08-19 07:41:09.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -31,17 +32,17 @@ configs := config :: !configs; Hashtbl.clear cache) -let parse_string s = - let conf = Lexers.conf_lines None 1 (Printf.sprintf "string: %S" s) (Lexing.from_string s) in +let parse_lexbuf ?dir source lexbuf = + lexbuf.Lexing.lex_curr_p <- { lexbuf.Lexing.lex_curr_p with Lexing.pos_fname = source }; + let conf = Lexers.conf_lines dir lexbuf in add_config conf +let parse_string s = parse_lexbuf (Printf.sprintf "String %S" s) (Lexing.from_string s) + let parse_file ?dir file = - try - with_input_file file begin fun ic -> - let conf = Lexers.conf_lines dir 1 (Printf.sprintf "file: %S" file) (Lexing.from_channel ic) in - add_config conf - end - with Lexers.Error msg -> raise (Lexers.Error (file ^ ": " ^ msg)) + with_input_file file begin fun ic -> + parse_lexbuf ?dir (Printf.sprintf "File %S" file) (Lexing.from_channel ic) + end let key_match = Glob.eval @@ -61,7 +62,8 @@ let () = Hashtbl.replace cache s res in res -let has_tag tag = Tags.mem tag (tags_of_filename "") +let global_tags () = tags_of_filename "" +let has_tag tag = Tags.mem tag (global_tags ()) let tag_file file tags = if tags <> [] then parse_string (Printf.sprintf "%S: %s" file (String.concat ", " tags));; diff -Nru ocaml-3.12.1/ocamlbuild/configuration.mli ocaml-4.01.0/ocamlbuild/configuration.mli --- ocaml-3.12.1/ocamlbuild/configuration.mli 2010-01-22 14:36:57.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/configuration.mli 2013-08-19 07:41:09.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -33,3 +34,6 @@ (** [tag_any tag_list] Tag anything with all given tags. *) val tag_any : Tags.elt list -> unit + +(** the tags that apply to any file *) +val global_tags : unit -> Tags.t diff -Nru ocaml-3.12.1/ocamlbuild/digest_cache.ml ocaml-4.01.0/ocamlbuild/digest_cache.ml --- ocaml-3.12.1/ocamlbuild/digest_cache.ml 2007-11-28 16:02:14.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/digest_cache.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -20,7 +21,7 @@ let put = Hashtbl.replace digests -let _digests = lazy (Pathname.pwd / !Options.build_dir / (Pathname.mk "_digests")) +let _digests = lazy (!Options.build_dir / (Pathname.mk "_digests")) let finalize () = with_output_file !*_digests begin fun oc -> diff -Nru ocaml-3.12.1/ocamlbuild/digest_cache.mli ocaml-4.01.0/ocamlbuild/digest_cache.mli --- ocaml-3.12.1/ocamlbuild/digest_cache.mli 2007-11-28 16:02:14.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/digest_cache.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/discard_printf.ml ocaml-4.01.0/ocamlbuild/discard_printf.ml --- ocaml-3.12.1/ocamlbuild/discard_printf.ml 2010-07-06 10:02:03.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/discard_printf.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/discard_printf.mli ocaml-4.01.0/ocamlbuild/discard_printf.mli --- ocaml-3.12.1/ocamlbuild/discard_printf.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/discard_printf.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/display.ml ocaml-4.01.0/ocamlbuild/display.ml --- ocaml-3.12.1/ocamlbuild/display.ml 2010-12-07 14:40:43.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/display.ml 2012-12-22 01:34:16.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -120,7 +121,7 @@ match log_file with | None -> None | Some fn -> - let oc = open_out_gen [Open_text; Open_wronly; Open_creat; Open_trunc] 0o644 fn in + let oc = open_out_gen [Open_text; Open_wronly; Open_creat; Open_trunc] 0o666 fn in let f = Format.formatter_of_out_channel oc in Format.fprintf f "### Starting build.\n"; Some (f, oc) @@ -362,7 +363,11 @@ match di.di_display_line with | Classic -> if pretend then - (if di.di_log_level >= 2 then Format.fprintf di.di_formatter "[cache hit] %s\n%!" command) + begin + (* This should work, even on Windows *) + let command = Filename.basename command in + if di.di_log_level >= 2 then Format.fprintf di.di_formatter "[cache hit] %s\n%!" command + end else (if di.di_log_level >= 1 then Format.fprintf di.di_formatter "%s\n%!" command) | Sophisticated ds -> diff -Nru ocaml-3.12.1/ocamlbuild/display.mli ocaml-4.01.0/ocamlbuild/display.mli --- ocaml-3.12.1/ocamlbuild/display.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/display.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/examples/example1/hello.ml ocaml-4.01.0/ocamlbuild/examples/example1/hello.ml --- ocaml-3.12.1/ocamlbuild/examples/example1/hello.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/examples/example1/hello.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,3 +1,15 @@ +(***********************************************************************) +(* *) +(* ocamlbuild *) +(* *) +(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + let _ = Printf.printf "Hello, %s ! My name is %s\n" (if Array.length Sys.argv > 1 then Sys.argv.(1) else "stranger") diff -Nru ocaml-3.12.1/ocamlbuild/examples/example2/greet.ml ocaml-4.01.0/ocamlbuild/examples/example2/greet.ml --- ocaml-3.12.1/ocamlbuild/examples/example2/greet.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/examples/example2/greet.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,3 +1,15 @@ +(***********************************************************************) +(* *) +(* ocamlbuild *) +(* *) +(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + type how = Nicely | Badly;; let greet how who = diff -Nru ocaml-3.12.1/ocamlbuild/examples/example2/hello.ml ocaml-4.01.0/ocamlbuild/examples/example2/hello.ml --- ocaml-3.12.1/ocamlbuild/examples/example2/hello.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/examples/example2/hello.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,3 +1,15 @@ +(***********************************************************************) +(* *) +(* ocamlbuild *) +(* *) +(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + open Greet let _ = diff -Nru ocaml-3.12.1/ocamlbuild/examples/example3/epoch.ml ocaml-4.01.0/ocamlbuild/examples/example3/epoch.ml --- ocaml-3.12.1/ocamlbuild/examples/example3/epoch.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/examples/example3/epoch.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,3 +1,15 @@ +(***********************************************************************) +(* *) +(* ocamlbuild *) +(* *) +(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + let _ = let s = Num.num_of_string (Printf.sprintf "%.0f" (Unix.gettimeofday ())) in let ps = Num.mult_num (Num.num_of_string "1000000000000") s in diff -Nru ocaml-3.12.1/ocamlbuild/examples/example3/make.sh ocaml-4.01.0/ocamlbuild/examples/example3/make.sh --- ocaml-3.12.1/ocamlbuild/examples/example3/make.sh 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/examples/example3/make.sh 2012-08-01 14:47:00.000000000 +0000 @@ -1,5 +1,17 @@ #!/bin/sh +######################################################################### +# # +# OCaml # +# # +# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# # +# Copyright 2007 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + set -e TARGET=epoch diff -Nru ocaml-3.12.1/ocamlbuild/exit_codes.ml ocaml-4.01.0/ocamlbuild/exit_codes.ml --- ocaml-3.12.1/ocamlbuild/exit_codes.ml 2007-11-22 18:31:22.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/exit_codes.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,3 +1,15 @@ +(***********************************************************************) +(* *) +(* ocamlbuild *) +(* *) +(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + let rc_ok = 0 let rc_usage = 1 let rc_failure = 2 diff -Nru ocaml-3.12.1/ocamlbuild/exit_codes.mli ocaml-4.01.0/ocamlbuild/exit_codes.mli --- ocaml-3.12.1/ocamlbuild/exit_codes.mli 2007-11-22 18:31:22.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/exit_codes.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,3 +1,15 @@ +(***********************************************************************) +(* *) +(* ocamlbuild *) +(* *) +(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + val rc_ok : int val rc_usage : int val rc_failure : int diff -Nru ocaml-3.12.1/ocamlbuild/fda.ml ocaml-4.01.0/ocamlbuild/fda.ml --- ocaml-3.12.1/ocamlbuild/fda.ml 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/fda.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -22,10 +23,10 @@ let laws = [ - { law_name = "Leftover Ocaml compilation files"; + { law_name = "Leftover OCaml compilation files"; law_rules = [Not ".cmo"; Not ".cmi"; Not ".cmx"; Not ".cma"; Not ".cmxa"]; law_penalty = Fail }; - { law_name = "Leftover Ocaml type annotation files"; + { law_name = "Leftover OCaml type annotation files"; law_rules = [Not ".annot"]; law_penalty = Warn }; { law_name = "Leftover object files"; diff -Nru ocaml-3.12.1/ocamlbuild/fda.mli ocaml-4.01.0/ocamlbuild/fda.mli --- ocaml-3.12.1/ocamlbuild/fda.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/fda.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/findlib.ml ocaml-4.01.0/ocamlbuild/findlib.ml --- ocaml-3.12.1/ocamlbuild/findlib.ml 2010-02-03 13:11:20.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/findlib.ml 2013-01-01 04:53:51.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -109,11 +110,27 @@ (* TODO: Improve to differenciate whether ocamlfind cannot be run or is not installed *) error Cannot_run_ocamlfind - | Lexers.Error s -> + | Lexers.Error (s,_) -> error (Cannot_parse_query (name, s)) +let split_nl s = + let x = ref [] in + let rec go s = + let pos = String.index s '\n' in + x := (String.before s pos)::!x; + go (String.after s (pos + 1)) + in + try + go s + with Not_found -> !x + +let before_space s = + try + String.before s (String.index s ' ') + with Not_found -> s + let list () = - run_and_parse Lexers.blank_sep_strings "%s list | cut -d' ' -f1" ocamlfind + List.map before_space (split_nl & run_and_read "%s list" ocamlfind) (* The closure algorithm is easy because the dependencies are already closed and sorted for each package. We only have to make the union. We could also diff -Nru ocaml-3.12.1/ocamlbuild/findlib.mli ocaml-4.01.0/ocamlbuild/findlib.mli --- ocaml-3.12.1/ocamlbuild/findlib.mli 2010-01-25 08:11:53.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/findlib.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/flags.ml ocaml-4.01.0/ocamlbuild/flags.ml --- ocaml-3.12.1/ocamlbuild/flags.ml 2010-01-22 14:36:57.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/flags.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/flags.mli ocaml-4.01.0/ocamlbuild/flags.mli --- ocaml-3.12.1/ocamlbuild/flags.mli 2010-01-22 14:36:57.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/flags.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/glob.ml ocaml-4.01.0/ocamlbuild/glob.ml --- ocaml-3.12.1/ocamlbuild/glob.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/glob.ml 2013-05-28 12:16:10.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -51,7 +52,7 @@ | QEPSILON ;; - module IS = Set.Make(struct type t = int let compare = compare let print = Format.pp_print_int end);; + module IS = Set.Make(struct type t = int let compare (x:t) y = compare x y let print = Format.pp_print_int end);; module ISM = Map.Make(struct type t = IS.t let compare = IS.compare let print = IS.print end);; type machine = { @@ -72,8 +73,8 @@ | QEPSILON -> epsilons := (q1,q2) :: !epsilons; q1 | QCLASS cl -> transitions := (q1,cl,q2) :: !transitions; q1 in - (* Construit les transitions correspondant au motif donné et arrivant - * sur l'état qf. Retourne l'état d'origine. *) + (* Construit les transitions correspondant au motif donne et arrivant + * sur l'etat qf. Retourne l'etat d'origine. *) let rec loop qf = function | Epsilon -> qf | Word u -> @@ -256,7 +257,7 @@ | Word v -> String.length v = n && begin - let rec check j = j = n or (v.[j] = u.[i + j] && check (j + 1)) + let rec check j = j = n || (v.[j] = u.[i + j] && check (j + 1)) in check 0 end diff -Nru ocaml-3.12.1/ocamlbuild/glob.mli ocaml-4.01.0/ocamlbuild/glob.mli --- ocaml-3.12.1/ocamlbuild/glob.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/glob.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/glob_ast.ml ocaml-4.01.0/ocamlbuild/glob_ast.ml --- ocaml-3.12.1/ocamlbuild/glob_ast.ml 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/glob_ast.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/glob_ast.mli ocaml-4.01.0/ocamlbuild/glob_ast.mli --- ocaml-3.12.1/ocamlbuild/glob_ast.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/glob_ast.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/glob_lexer.mli ocaml-4.01.0/ocamlbuild/glob_lexer.mli --- ocaml-3.12.1/ocamlbuild/glob_lexer.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/glob_lexer.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/glob_lexer.mll ocaml-4.01.0/ocamlbuild/glob_lexer.mll --- ocaml-3.12.1/ocamlbuild/glob_lexer.mll 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/glob_lexer.mll 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/hooks.ml ocaml-4.01.0/ocamlbuild/hooks.ml --- ocaml-3.12.1/ocamlbuild/hooks.ml 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/hooks.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/hooks.mli ocaml-4.01.0/ocamlbuild/hooks.mli --- ocaml-3.12.1/ocamlbuild/hooks.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/hooks.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/hygiene.ml ocaml-4.01.0/ocamlbuild/hygiene.ml --- ocaml-3.12.1/ocamlbuild/hygiene.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/hygiene.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -72,7 +73,8 @@ list_collect begin function | File(path, name, _, true) -> - if Filename.check_suffix name suffix then + if Filename.check_suffix name suffix + && not ( Pathname.link_to_dir (filename_concat path name) !Options.build_dir ) then begin remove path name; Some(sf "File %s in %s has suffix %s" name path suffix) @@ -150,7 +152,9 @@ @ or@ use@ other@ options@ (such@ as@ defining@ hygiene@ exceptions\ @ or@ using@ the@ -no-hygiene@ option).@]" m (if m = 1 then "" else "s") fn; - let oc = open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_text] 0o755 fn in + let oc = open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o777 fn in + (* See PR #5338: under mingw, one produces a shell script, which must follow + Unix eol convention; hence Open_binary. *) let fp = Printf.fprintf in fp oc "#!/bin/sh\n\ # File generated by ocamlbuild\n\ diff -Nru ocaml-3.12.1/ocamlbuild/hygiene.mli ocaml-4.01.0/ocamlbuild/hygiene.mli --- ocaml-3.12.1/ocamlbuild/hygiene.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/hygiene.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/lexers.mli ocaml-4.01.0/ocamlbuild/lexers.mli --- ocaml-3.12.1/ocamlbuild/lexers.mli 2010-02-03 13:11:19.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/lexers.mli 2013-01-01 04:53:51.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -11,7 +12,7 @@ (* Original author: Nicolas Pouillard *) -exception Error of string +exception Error of (string * Lexing.position) type conf_values = { plus_tags : string list; @@ -32,8 +33,10 @@ Example: ":aaa:bbb:::ccc:" -> [""; "aaa"; "bbb"; ""; ""; "ccc"; ""] *) val parse_environment_path : Lexing.lexbuf -> string list +(* Same one, for Windows (PATH is ;-separated) *) +val parse_environment_path_w : Lexing.lexbuf -> string list -val conf_lines : string option -> int -> string -> Lexing.lexbuf -> conf +val conf_lines : string option -> Lexing.lexbuf -> conf val path_scheme : bool -> Lexing.lexbuf -> [ `Word of string | `Var of (string * Glob.globber) diff -Nru ocaml-3.12.1/ocamlbuild/lexers.mll ocaml-4.01.0/ocamlbuild/lexers.mll --- ocaml-3.12.1/ocamlbuild/lexers.mll 2010-02-03 13:11:19.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/lexers.mll 2013-01-01 04:53:51.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -12,7 +13,10 @@ (* Original author: Nicolas Pouillard *) { -exception Error of string +exception Error of (string * Lexing.position) + +let error lexbuf fmt = Printf.ksprintf (fun s -> raise (Error (s,Lexing.lexeme_start_p lexbuf))) fmt + open Glob_ast type conf_values = @@ -41,45 +45,54 @@ rule ocamldep_output = parse | ([^ ':' '\n' '\r' ]+ as k) ':' { let x = (k, space_sep_strings_nl lexbuf) in x :: ocamldep_output lexbuf } | eof { [] } - | _ { raise (Error "Expecting colon followed by space-separated module name list") } + | _ { error lexbuf "Expecting colon followed by space-separated module name list" } and space_sep_strings_nl = parse | space* (not_blank+ as word) { word :: space_sep_strings_nl lexbuf } - | space* newline { [] } - | _ { raise (Error "Expecting space-separated strings terminated with newline") } + | space* newline { Lexing.new_line lexbuf; [] } + | _ { error lexbuf "Expecting space-separated strings terminated with newline" } and space_sep_strings = parse | space* (not_blank+ as word) { word :: space_sep_strings lexbuf } | space* newline? eof { [] } - | _ { raise (Error "Expecting space-separated strings") } + | _ { error lexbuf "Expecting space-separated strings" } and blank_sep_strings = parse | blank* '#' not_newline* newline { blank_sep_strings lexbuf } | blank* '#' not_newline* eof { [] } | blank* (not_blank+ as word) { word :: blank_sep_strings lexbuf } | blank* eof { [] } - | _ { raise (Error "Expecting blank-separated strings") } + | _ { error lexbuf "Expecting blank-separated strings" } and comma_sep_strings = parse | space* (not_space_nor_comma+ as word) space* eof { [word] } | space* (not_space_nor_comma+ as word) { word :: comma_sep_strings_aux lexbuf } | space* eof { [] } - | _ { raise (Error "Expecting comma-separated strings (1)") } + | _ { error lexbuf "Expecting comma-separated strings (1)" } and comma_sep_strings_aux = parse | space* ',' space* (not_space_nor_comma+ as word) { word :: comma_sep_strings_aux lexbuf } | space* eof { [] } - | _ { raise (Error "Expecting comma-separated strings (2)") } + | _ { error lexbuf "Expecting comma-separated strings (2)" } and comma_or_blank_sep_strings = parse | space* (not_space_nor_comma+ as word) space* eof { [word] } | space* (not_space_nor_comma+ as word) { word :: comma_or_blank_sep_strings_aux lexbuf } | space* eof { [] } - | _ { raise (Error "Expecting (comma|blank)-separated strings (1)") } + | _ { error lexbuf "Expecting (comma|blank)-separated strings (1)" } and comma_or_blank_sep_strings_aux = parse | space* ',' space* (not_space_nor_comma+ as word) { word :: comma_or_blank_sep_strings_aux lexbuf } | space* (not_space_nor_comma+ as word) { word :: comma_or_blank_sep_strings_aux lexbuf } | space* eof { [] } - | _ { raise (Error "Expecting (comma|blank)-separated strings (2)") } + | _ { error lexbuf "Expecting (comma|blank)-separated strings (2)" } + +and parse_environment_path_w = parse + | ([^ ';']* as word) { word :: parse_environment_path_aux_w lexbuf } + | ';' ([^ ';']* as word) { "" :: word :: parse_environment_path_aux_w lexbuf } + | eof { [] } +and parse_environment_path_aux_w = parse + | ';' ([^ ';']* as word) { word :: parse_environment_path_aux_w lexbuf } + | eof { [] } + | _ { error lexbuf "Impossible: expecting colon-separated strings" } and parse_environment_path = parse | ([^ ':']* as word) { word :: parse_environment_path_aux lexbuf } @@ -88,31 +101,35 @@ and parse_environment_path_aux = parse | ':' ([^ ':']* as word) { word :: parse_environment_path_aux lexbuf } | eof { [] } - | _ { raise (Error "Impossible: expecting colon-separated strings") } + | _ { error lexbuf "Impossible: expecting colon-separated strings" } -and conf_lines dir pos err = parse - | space* '#' not_newline* newline { conf_lines dir (pos + 1) err lexbuf } +and conf_lines dir = parse + | space* '#' not_newline* newline { Lexing.new_line lexbuf; conf_lines dir lexbuf } | space* '#' not_newline* eof { [] } - | space* newline { conf_lines dir (pos + 1) err lexbuf } + | space* newline { Lexing.new_line lexbuf; conf_lines dir lexbuf } | space* eof { [] } | space* (not_newline_nor_colon+ as k) space* ':' space* { - let bexpr = Glob.parse ?dir k in - let v1 = conf_value pos err empty lexbuf in - let v2 = conf_values pos err v1 lexbuf in - let rest = conf_lines dir (pos + 1) err lexbuf in (bexpr, v2) :: rest + let bexpr = + try Glob.parse ?dir k + with exn -> error lexbuf "Invalid globbing pattern %S" k (Printexc.to_string exn) + in + let v1 = conf_value empty lexbuf in + let v2 = conf_values v1 lexbuf in + Lexing.new_line lexbuf; (* FIXME values may have escaped newlines *) + let rest = conf_lines dir lexbuf in (bexpr,v2) :: rest } - | _ { raise (Error(Printf.sprintf "Bad key in configuration line at line %d (from %s)" pos err)) } + | _ { error lexbuf "Invalid line syntax" } -and conf_value pos err x = parse +and conf_value x = parse | '-' (tag as tag) { { (x) with minus_tags = tag :: x.minus_tags } } | '+'? (tag as tag) { { (x) with plus_tags = tag :: x.plus_tags } } - | (_ | eof) { raise (Error(Printf.sprintf "Bad value in configuration line at line %d (from %s)" pos err)) } + | (_ | eof) { error lexbuf "Invalid tag modifier only '+ or '-' are allowed as prefix for tag" } -and conf_values pos err x = parse - | space_or_esc_nl* ',' space_or_esc_nl* { conf_values pos err (conf_value pos err x lexbuf) lexbuf } +and conf_values x = parse + | space_or_esc_nl* ',' space_or_esc_nl* { conf_values (conf_value x lexbuf) lexbuf } | (newline | eof) { x } - | (_ | eof) { raise (Error(Printf.sprintf "Bad values in configuration line at line %d (from %s)" pos err)) } + | (_ | eof) { error lexbuf "Only ',' separated tags are alllowed" } and path_scheme patt_allowed = parse | ([^ '%' ]+ as prefix) @@ -123,14 +140,13 @@ { if patt_allowed then let patt = My_std.String.implode (unescape (Lexing.from_string patt)) in `Var (var, Glob.parse patt) :: path_scheme patt_allowed lexbuf - else raise (Error( - Printf.sprintf "Patterns are not allowed in this pathname (%%(%s:%s) only in ~prod)" - var patt)) } + else + error lexbuf "Patterns are not allowed in this pathname (%%(%s:%s) only in ~prod)" var patt } | '%' { `Var ("", Bool.True) :: path_scheme patt_allowed lexbuf } | eof { [] } - | _ { raise (Error("Bad pathanme scheme")) } + | _ { error lexbuf "Bad pathanme scheme" } and unescape = parse | '\\' (['(' ')'] as c) { c :: unescape lexbuf } @@ -146,11 +162,11 @@ "linkopts:" space* (not_newline* as lo) newline+ "location:" space* (not_newline* as l) newline+ { n, d, v, a, lo, l } - | _ { raise (Error "Bad ocamlfind query") } + | _ { error lexbuf "Bad ocamlfind query" } and trim_blanks = parse | blank* (not_blank* as word) blank* { word } - | _ { raise (Error "Bad input for trim_blanks") } + | _ { error lexbuf "Bad input for trim_blanks" } and tag_gen = parse | (normal+ as name) ('(' ([^')']* as param) ')')? { name, param } diff -Nru ocaml-3.12.1/ocamlbuild/log.ml ocaml-4.01.0/ocamlbuild/log.ml --- ocaml-3.12.1/ocamlbuild/log.ml 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/log.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/log.mli ocaml-4.01.0/ocamlbuild/log.mli --- ocaml-3.12.1/ocamlbuild/log.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/log.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/main.ml ocaml-4.01.0/ocamlbuild/main.ml --- ocaml-3.12.1/ocamlbuild/main.ml 2011-05-30 08:36:32.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/main.ml 2013-08-20 16:02:56.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -37,6 +38,10 @@ ;; let show_tags () = + if List.length !Options.show_tags > 0 then + Log.eprintf "Warning: the following tags do not include \ + dynamically-generated tags, such as link, compile, pack, byte, native, c, \ + pdf... (this list is by no means exhaustive).\n"; List.iter begin fun path -> Log.eprintf "@[<2>Tags for %S:@ {. %a .}@]" path Tags.print (tags_of_pathname path) end !Options.show_tags @@ -61,12 +66,15 @@ Options.init (); if !Options.must_clean then clean (); Hooks.call_hook Hooks.After_options; - Plugin.execute_plugin_if_needed (); - - if !Options.targets = [] - && !Options.show_tags = [] - && not !Options.show_documentation - then raise Exit_silently; + let options_wd = Sys.getcwd () in + let first_run_for_plugin = + (* If we are in the first run before launching the plugin, we + should skip the user-visible operations (hygiene) that may need + information from the plugin to run as the user expects it. + + Note that we don't need to disable the [Hooks] call as they are + no-ops anyway, before any plugin has registered hooks. *) + Plugin.we_need_a_plugin () && not !Options.just_plugin in let target_dirs = List.union [] (List.map Pathname.dirname !Options.targets) in @@ -93,6 +101,10 @@ (fun pkg -> Configuration.tag_any [Param_tags.make "package" pkg]) !Options.ocaml_pkgs; + begin match !Options.ocaml_syntax with + | Some syntax -> Configuration.tag_any [Param_tags.make "syntax" syntax] + | None -> () end; + let newpwd = Sys.getcwd () in Sys.chdir Pathname.pwd; let entry_include_dirs = ref [] in @@ -112,16 +124,20 @@ (List.mem name ["_oasis"] || (String.length name > 0 && name.[0] <> '_')) && (name <> !Options.build_dir && not (List.mem name !Options.exclude_dirs)) && begin - if path_name <> Filename.current_dir_name && Pathname.is_directory path_name then + not (path_name <> Filename.current_dir_name && Pathname.is_directory path_name) + || begin let tags = tags_of_pathname path_name in - if Tags.mem "include" tags - || List.mem path_name !Options.include_dirs then + (if Tags.mem "include" tags + || List.mem path_name !Options.include_dirs then (entry_include_dirs := path_name :: !entry_include_dirs; true) else Tags.mem "traverse" tags || List.exists (Pathname.is_prefix path_name) !Options.include_dirs - || List.exists (Pathname.is_prefix path_name) target_dirs - else true + || List.exists (Pathname.is_prefix path_name) target_dirs) + && ((* beware: !Options.build_dir is an absolute directory *) + Pathname.normalize !Options.build_dir + <> Pathname.normalize (Pathname.pwd/path_name)) + end end end (Slurp.slurp Filename.current_dir_name) @@ -132,7 +148,7 @@ let tags = tags_of_pathname (path/name) in not (Tags.mem "not_hygienic" tags) && not (Tags.mem "precious" tags) end entry in - if !Options.hygiene then + if !Options.hygiene && not first_run_for_plugin then Fda.inspect hygiene_entry else Slurp.force hygiene_entry; @@ -148,6 +164,15 @@ Ocaml_specific.init (); Hooks.call_hook Hooks.After_rules; + Sys.chdir options_wd; + Plugin.execute_plugin_if_needed (); + + (* [Param_tags.init ()] is called *after* the plugin is executed, as + some of the parametrized tags present in the _tags files parsed + will be declared by the plugin, and would therefore result in + "tag X does not expect a parameter" warnings if initialized + before. Note that [Plugin.rebuild_plugin_if_needed] is careful to + partially initialize the tags that it uses for plugin compilation. *) Param_tags.init (); Sys.chdir newpwd; @@ -272,8 +297,9 @@ | Ocaml_utils.Ocamldep_error msg -> Log.eprintf "Ocamldep error: %s" msg; exit rc_ocamldep_error - | Lexers.Error msg -> - Log.eprintf "Lexical analysis error: %s" msg; + | Lexers.Error (msg,pos) -> + let module L = Lexing in + Log.eprintf "%s, line %d, column %d: Lexing error: %s." pos.L.pos_fname pos.L.pos_lnum (pos.L.pos_cnum - pos.L.pos_bol) msg; exit rc_lexing_error | Arg.Bad msg -> Log.eprintf "%s" msg; diff -Nru ocaml-3.12.1/ocamlbuild/main.mli ocaml-4.01.0/ocamlbuild/main.mli --- ocaml-3.12.1/ocamlbuild/main.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/main.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/man/ocamlbuild.1 ocaml-4.01.0/ocamlbuild/man/ocamlbuild.1 --- ocaml-3.12.1/ocamlbuild/man/ocamlbuild.1 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/man/ocamlbuild.1 2012-08-01 14:47:00.000000000 +0000 @@ -1,7 +1,19 @@ +.\"***********************************************************************) +.\"* *) +.\"* ocamlbuild *) +.\"* *) +.\"* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) +.\"* *) +.\"* Copyright 2007 Institut National de Recherche en Informatique et *) +.\"* en Automatique. All rights reserved. This file is distributed *) +.\"* under the terms of the Q Public License version 1.0. *) +.\"* *) +.\"***********************************************************************) +.\" .TH OCAMLBUILD 1 .SH NAME -ocamlbuild \- The Objective Caml project compilation tool +ocamlbuild \- The OCaml project compilation tool .SH SYNOPSIS @@ -57,7 +69,7 @@ .BR base.extension where .BR base -is usually the name of the underlying Ocaml module and +is usually the name of the underlying OCaml module and .BR extension denotes the kind of object to produce from that file -- a byte code executable, a native executable, documentation... @@ -250,4 +262,4 @@ .BR ocaml (1), .BR make (1). .br -.I The Objective Caml user's manual, chapter "Batch compilation". +.I The OCaml user's manual, chapter "Batch compilation". diff -Nru ocaml-3.12.1/ocamlbuild/manual/.cvsignore ocaml-4.01.0/ocamlbuild/manual/.cvsignore --- ocaml-3.12.1/ocamlbuild/manual/.cvsignore 2007-02-17 15:43:29.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/manual/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -*.aux -*.haux -*.html -*.htoc -*.log -*.pdf diff -Nru ocaml-3.12.1/ocamlbuild/manual/Makefile ocaml-4.01.0/ocamlbuild/manual/Makefile --- ocaml-3.12.1/ocamlbuild/manual/Makefile 2007-02-08 16:53:39.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/manual/Makefile 1970-01-01 00:00:00.000000000 +0000 @@ -1,15 +0,0 @@ -# Makefile - -all: manual.pdf manual.html - -%.pdf: %.tex - pdflatex $< - pdflatex $< - -%.html: %.tex manual.hva - hevea -fix -O manual.hva $< - -.PHONY: clean - -clean: - rm -f *.pdf *.log *.aux *.ps *.dvi manual.h{tml,aux,toc} diff -Nru ocaml-3.12.1/ocamlbuild/manual/manual.hva ocaml-4.01.0/ocamlbuild/manual/manual.hva --- ocaml-3.12.1/ocamlbuild/manual/manual.hva 2007-02-08 14:41:57.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/manual/manual.hva 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -\newcommand{\mathscr}[1]{{\mathcal{#1}}} \ No newline at end of file diff -Nru ocaml-3.12.1/ocamlbuild/manual/manual.tex ocaml-4.01.0/ocamlbuild/manual/manual.tex --- ocaml-3.12.1/ocamlbuild/manual/manual.tex 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/manual/manual.tex 1970-01-01 00:00:00.000000000 +0000 @@ -1,1054 +0,0 @@ -% -*- LaTeX -*- -%(*** preamble -\documentclass[9pt]{article} -\usepackage[utf8]{inputenc} -\usepackage{palatino} -\usepackage{mathrsfs} -\usepackage{xspace} -\usepackage[T1]{fontenc} -\usepackage[english]{babel} -\usepackage[a4paper,lmargin=1cm,rmargin=1cm,tmargin=1cm,bmargin=2cm]{geometry} -\newcommand{\ocb}{\texttt{ocamlbuild}\xspace} -\newcommand{\tags}{\texttt{\_tags}\xspace} -%***) -%(*** title -\begin{document} -\title{The \ocb users manual} -\author{Berke \textsc{Durak}, Nicolas \textsc{Pouillard}} -\date{February 2007} -\maketitle -%***) -%(*** abstract -\begin{abstract} -\ocb is a tool automating the compilation of most OCaml projects with minimal -user input. Its use is not restricted to projects having a simple structure -- -the extra effort needed to make it work with the more complex projects is in -reasonable proportion with their added complexity. In practice, one will use a -set of small text files, and, if needed, an OCaml compilation module that can -fine-tune the behaviour and define custom rules. -\end{abstract} -%***) -%(*** Features of ocamlbuild -\section{Features of \ocb} -{\em This section is intended to read like a sales brochure or a datasheet.} - -\begin{itemize} -\item Built-in compilation rules for OCaml projects handle all the nasty cases: -native and byte-code, missing \texttt{.mli} files, preprocessor rules, -libraries, package (-pack) debugging and profiling flags, C stubs. -\item Plugin mechanism for writing compilation rules and actions in a real programming language, -OCaml itself. -\item Automatic inference of dependencies. -\item Correct handling of dynamically discovered dependencies. -\item Object files and other temporary files are created in a specific directory, leaving your main directory uncluttered. -\item Sanity checks ensure that object files are where they are supposed to be: in the build directory. -\item Regular projects are built using a single command with no extra files. -\item Parallel compilation to speed up things on multi-core systems. -\item Sophisticated display mode to keep your screen free of boring and repetitive compilation message -while giving you important progress information in a glimpse, and correctly multiplexing the error messages. -\item Tags and flags provide a concise and convenient mechanism for automatic selection of compilation, preprocessing and -other options. -\item Extended shell-like glob patterns, that can be combined using boolean operators, -allow you to concisely define the tags that apply to a given file. -\item Mechanisms for defining the mutual visibility of subdirectories. -\item Cache mechanism avoiding unnecessary compilations where reasonably computable. -\end{itemize} -%***) -%(*** Limitations -\section{Limitations} -{\em Not perfect nor complete yet, but already pretty damn useful.} - -We were not expecting to write the ultimate compilation tool in a few man-months, however we believe we have -a tool that solves many compilation problems, especially our own, in a satisfactory way. Hence there are a -lot of missing features, incomplete options and hideous bugs lurking in \ocb, and we hope that the OCaml community -will find our first try at \ocb useful and hopefully help it grow into a tool that satisfies most needs of most users -by providing feedback, bug reports and patches. - -The plugin API maybe somewhat lacking in maturity, as it has only been tested -by a few people. We believe a good API can only evolve under pressure from -many peers and the courage to rewrite things cleanly when time is ripe by the -developers. Most of the important functions a user will need are encapsulated -in the plugin API, which is the \texttt{Ocamlbuild\_plugin} module pack. We -intend to keep that API backwards compatible. It may happen that intricate -projects need features not available in that module -- you may then use -functions or values directly from the core \ocb modules. We ask you to report -such usage to the authors so that we may make the necessary changes to the API; -you may also want to isolate calls to the non-API parts of the \ocb library -from the rest of your plugin to be able to keep the later when incompatible -changes arise. - -The way that \ocb handles the command-line options, the \tags file, -the target names, names of the tags, and so on, are not expected to change in -incompatible ways. We intend to keep a project that compiles without a plugin -compilable without modifications in the future. -%***) -%(*** Using ocamlbuild -\section{Using \ocb} -{\em Learn how to use \ocb with short, specific, straight-to-the-point examples.} - -The amount of time and effort spent on the compilation process of a project -should be proportionate to that spent on the project itself. It should be easy -to set up a small project, maybe a little harder for a medium-sized project, -and it may take some more time, but not too much, for a big project. Ideally -setting up a big project would be as easy as setting up a small project. However, -as projects grow, modularization techniques start to be used, and the probability -of using meta programming or multiple programming languages increases, thus making -the compilation process more delicate. - -\ocb is intended to be very easy to use for projects, large or small, with a simple -compilation process: typing -\texttt{ocamlbuild foo.native} should be enough to compile the native version -of a program whose top module is \texttt{foo.ml} and whose dependencies are in -the same directory. As your project gets more complex, you will gradually -start to use command-line options to specify libraries to link with, then -configuration files, ultimately culminating in a custom OCaml plugin for -complex projects with arbitrary dependencies and actions. - -%(*** Hygiene *) -\subsection{Hygiene \& where is my code ?} -Your code is in the \texttt{\_build} directory, but \ocb automatically creates -a symbolic link to the executables it produces in the current directory. -\ocb copies the source files and compiles them in a separate directory -which is \texttt{\_build} by default. - -For \ocb, any file that is not in the build directory is a source file. -It is not unreasonable to think that some users may have bought binary object files -they keep in their project directory. Usually binary files cluttering the project -directory are due to previous builds using other systems. \ocb has so-called -``hygiene'' rules that state that object files (\texttt{.cmo}, \texttt{.cmi}, -or \texttt{.o} files, for instance) must not appear outside of the build -directory. These rules are enforced at startup; any violations will be reported -and \ocb will exit. You must then remove these files by hand or run, with caution, -the script \texttt{sanitize.sh}, which is generated in your source directory. -This script will contain commands to remove them for you. - -To disable these checks, you can use the \texttt{-no-hygiene} flag. If you have -files that must elude the hygiene squad, just tag them with \texttt{precious} -or \texttt{not\_hygienic}. -%***) -%(*** Hello, world ! -\subsection{Hello, world !} -Assuming we are in a directory named \texttt{example1} containing one file \texttt{hello.ml} -whose contents are -\begin{verbatim} -let _ = - Printf.printf "Hello, %s ! My name is %s\n" - (if Array.length Sys.argv > 1 then Sys.argv.(1) else "stranger") - Sys.argv.(0) -;; -\end{verbatim} -we can compile and link it into a native executable by invoking \texttt{ocamlbuild hello.native}. -Here, \texttt{hello} is the basename of the top-level module and \texttt{native} is an extension used -by \ocb to denote native code executables. -\begin{verbatim} -% ls -hello.ml -% ocamlbuild hello.native -Finished, 4 targets (0 cached) in 00:00:00. -% ls -l -total 12 -drwxrwx--- 2 linus gallium 4096 2007-01-17 16:24 _build/ --rw-rw---- 1 linus gallium 43 2007-01-17 16:23 hello.ml -lrwxrwxrwx 1 linus gallium 19 2007-01-17 16:24 hello.native -> _build/hello.native* -\end{verbatim} -What's this funny \texttt{\_build} directory ? Well that's where \ocb does its dirty work -of compiling. You usually won't have to look very often into this directory. Source files are be copied -into \texttt{\_build} and this is where the compilers will be run. Various cache files are also stored -there. Its contents may look like this: -\begin{verbatim} -% ls -l _build -total 208 --rw-rw---- 1 linus gallium 337 2007-01-17 16:24 _digests --rw-rw---- 1 linus gallium 191 2007-01-17 16:24 hello.cmi --rw-rw---- 1 linus gallium 262 2007-01-17 16:24 hello.cmo --rw-rw---- 1 linus gallium 225 2007-01-17 16:24 hello.cmx --rw-rw---- 1 linus gallium 43 2007-01-17 16:23 hello.ml --rw-rw---- 1 linus gallium 17 2007-01-17 16:24 hello.ml.depends --rwxrwx--- 1 linus gallium 173528 2007-01-17 16:24 hello.native* --rw-rw---- 1 linus gallium 936 2007-01-17 16:24 hello.o --rw-rw---- 1 linus gallium 22 2007-01-17 16:24 ocamlc.where -\end{verbatim} -%***) -%(*** Executing my code -\subsection{Executing my code} -You can execute your code the old-fashioned way (\texttt{./hello.native}). -You may also type -\begin{verbatim} -ocamlbuild hello.native -- Caesar -\end{verbatim} -and it will compile and then run \texttt{hello.native} with the arguments following \texttt{-{}-}, -which should display: -\begin{verbatim} -% ocamlbuild hello.native -- Caesar -Finished, 4 targets (0 cached) in 00:00:00. -Hello, Caesar ! My name is _build/hello.native -\end{verbatim} -%***) -%(*** The log file, verbosity and debugging -\subsection{The log file, verbosity and debugging} -By default, if you run \ocb on a terminal, it will use some ANSI escape sequences -to display a nice, one-line progress indicator. To see what commands \ocb has actually run, -you can check the contents of the \texttt{\_build/\_log} file. To change the name of the -log file or to disable logging, use the \texttt{-log } or \texttt{-no-log} options. -Note that the log file is truncated at each execution of \ocb. - -The log file contains all the external commands that \ocb ran or intended to -run along with the target name and the computed tags. With the -\texttt{-verbose } option, \ocb will also write more or less useful -debugging information; a verbosity level of $1$ (which can also be specified -using the \texttt{-verbose} switch) prints generally useful information; higher -levels produce much more output. -%***) -%(*** Cleaning -\subsection{Cleaning} -\ocb may leave a \texttt{\_build} directory and symbolic links to executables in -that directory (unless when using -no-links). All of these can be removed safely -by hand, or by invoking \ocb with the \texttt{-clean} flag. -%***) -%(*** Where and how to run \ocb -\subsection{Where and how to run \ocb ?} -An important point is that \ocb must be invoked from the root of the project, -even if this project has multiple, nested subdirectories. This is because \ocb -likes to store the object files in a single \texttt{\_build} directory. You -can change the name of that directory with the \texttt{-build-dir} option. - -\ocb can be either invoked manually from the UNIX or Windows shell, or -automatically from a build script or a Makefile. Unless run with the -\texttt{-no-hygiene} option, there is the possibility that \ocb will prompt the -user for a response. By default, on UNIX systems, if \ocb senses that the -standard output is a terminal, it will use a nice progress indicator using ANSI -codes, instrumenting the output of the processes it spawns to have a consistent -display. Under non-UNIX systems, or if the standard output is not a terminal, -it will run in classic mode where it will echo the executed commands on its -standard output. This selection can be overridden with the \texttt{-classic-display} option. -%***) -%(*** Dependencies -\subsection{Dependencies} -{\em Dependencies are automatically discovered.} - -Most of the value of \ocb lies in the fact that it often needs no extra -information to compile a project besides the name of the top-level module. -\ocb calls \texttt{ocamldep} to automatically find the dependencies of any -modules it wants to compile. These dependencies are dynamically incorporated -in the dependency graph, something \texttt{make} cannot do. -For instance, let's add a module \texttt{Greet} that implements various ways of -greeting people. -\begin{verbatim} -% cat greet.ml -type how = Nicely | Badly;; - -let greet how who = - match how with Nicely -> Printf.printf "Hello, %s !\n" who - | Badly -> Printf.printf "Oh, here is that %s again.\n" who -;; -% cat hello.ml -open Greet - -let _ = - let name = - if Array.length Sys.argv > 1 then - Sys.argv.(1) - else - "stranger" - in - greet - (if name = "Caesar" then Nicely else Badly) - name; - Printf.printf "My name is %s\n" Sys.argv.(0) -;; -\end{verbatim} -Then the module \texttt{Hello} depends on the module \texttt{Greet} and \ocb can -figure this out for himself -- we still only have to invoke \texttt{\ocb -hello.native}. Needless to say, this works for any number of modules. -%***) -%(*** Native and byte code -\subsection{Native and byte-code} -If we want to compile byte-code instead of native, we just a target name of -\texttt{hello.byte} instead of \texttt{hello.native}, i.e., we type -\texttt{\ocb hello.byte}. -%***) -%(*** Compile flags -\subsection{Compile flags} -To pass a flag to the compiler, such as the \texttt{-rectypes} option, -use the \texttt{-cflag} option as in: -\begin{verbatim} -ocamlbuild -cflag -rectypes hello.native -\end{verbatim} -You can put multiple \texttt{-cflag} options, they will be passed to the compiler -in the same order. You can also given them in a comma-separated list with the -\texttt{-cflags} option (notice the plural): -\begin{verbatim} -ocamlbuild -cflags -I,+lablgtk,-rectypes hello.native -\end{verbatim} -These flags apply when compiling, that is, when producing \texttt{.cmi}, -\texttt{.cmo},\texttt{.cmx} and \texttt{.o} files from \texttt{.ml} or -\texttt{.mli} files. -%***) -%(*** Link flags -\subsection{Link flags} -Link flags apply when the various object files are collected and linked into -one executable. These will typically be include directories for libraries. -They are given using the \texttt{-lflag} and \texttt{-lflags} options, which -work in the same way as the \texttt{-cflag} and \texttt{-cflags} options. -%***) -%(*** Linking with external libraries -\subsection{Linking with external libraries} -In our third example, we use one Unix system call and functions from the \texttt{num} -library: -\begin{verbatim} -% cat epoch.ml -let _ = - let s = Num.num_of_string (Printf.sprintf "%.0f" (Unix.gettimeofday ())) in - let ps = Num.mult_num (Num.num_of_string "1000000000000") s in - Printf.printf "%s picoseconds have passed since January 1st, 1970.\n" - (Num.string_of_num ps) -;; -\end{verbatim} -This requires linking with the \texttt{unix} and \texttt{num} modules, which is accomplished -by using the \texttt{-lib unix} and \texttt{-lib num} flags, or, alternatively, \texttt{-libs unix,num}: -\begin{verbatim} -% ocamlbuild -libs nums,unix epoch.native -- -Finished, 4 targets (4 cached) in 00:00:00. -1169051647000000000000 picoseconds have passed since January 1st, 1970. -\end{verbatim} -You may need to add options such as \texttt{-cflags -I,/usr/local/lib/ocaml/} -and \texttt{-lflags -I,/usr/local/lib/ocaml/} if the libraries you wish to -link with are not in OCaml's default search path. -%***) -%(*** The _tags files -\subsection{The \tags files} -Finer control over the compiler flags applied to each source file, such as -preprocessing, debugging, profiling and linking options, can be gained using -\ocb's tagging mechanism. - -Every source file has a set of tags which tells \ocb what kind of file it is -and what to do with it. A tag is simply a string, usually lowercase, for -example \texttt{ocaml} or \texttt{native}. The set of tags attached to a file -is computed by applying the tagging rules to the filename. Tagging rules are -defined in \tags files in any parent directory of a file, up to the main -project directory. - -Each line in the \tags file is made of a glob pattern (see subsection -\ref{subsec:glob}) and a list of tags. More than one rule can apply to a file -and rules are applied in the order in which they appear in a file. -By preceding a tag with a minus sign, one may remove tags from one or more files. - -\subsubsection{Example: the built-in \tags file} -\begin{verbatim} - <**/*.ml> or <**/*.mli> or <**/*.mlpack> or <**/*.ml.depends>: ocaml - <**/*.byte>: ocaml, byte, program - <**/*.odoc>: ocaml, doc - <**/*.native>: ocaml, native, program - <**/*.cma>: ocaml, byte, library - <**/*.cmxa>: ocaml, native, library - <**/*.cmo>: ocaml, byte - <**/*.cmi>: ocaml, byte, native - <**/*.cmx>: ocaml, native -\end{verbatim} - -A special tag made from the path name of the file relative to the toplevel -of the project is automatically defined for each file. For a file -\texttt{foo/bar.ml} this tag will be \texttt{file:foo/bar.ml}. - -If you do not have subdirectories, you can put \texttt{*.ml} instead of -\texttt{**/*.ml}. -%***) -%(*** Glob patterns and expressions -\subsection{Glob patterns and expressions} -\label{subsec:glob} -Glob patterns have a syntax similar to those used by UNIX shells to select path -names (like \texttt{foo\_*.ba?}). They are used in \ocb to define the files -and directories to which tags apply. Glob expressions are glob patterns -enclosed in brackets \texttt{<} and \texttt{>} combined using the standard -boolean operators \texttt{and}, \texttt{or}, \texttt{not}. This allows one to -describe sets of path names in more concise and more readable ways. - -Please note that file and directory names are supposed to be made of the -following characters: $\texttt{a}$, $\dots$, $\texttt{z}$, $\texttt{A}$, -$\dots$, $\texttt{Z}$, $\texttt{0}$, $\dots$, $\texttt{9}$, $\texttt{\_}$, -$\texttt{-}$ and $\texttt{.}$. This is called the pathname alphabet $P$. - -\begin{table}[h] - \begin{center} - \small - \begin{tabular}{|p{3cm}|l|p{3cm}|p{3cm}|p{5cm}|} - \hline - {\em Formal syntax} & - {\em Example} & {\em Matches} & {\em Does not match} & - {\em Meaning (formal meaning)} \\ - \hline - \hline -%% - {$u$ \vspace*{0.5em} A string of pathname characters} & - \texttt{foo.ml} & - \texttt{foo.ml} & - \texttt{fo.ml}, \texttt{bar/foo.ml} & - The exact string $u$ - ($\{ u \}$, where $u \in P^*$) \\ - \hline -%% - {\texttt{*} \vspace*{0.5em} The wild-card star}& - \texttt{*}& - $\varepsilon$, \texttt{foo}, \texttt{bar} & - \texttt{foo/bar}, \texttt{/bar} & - Any string not containing a slash - ($P^*$) \\ - \hline -%% - {\texttt{?} \vspace*{0.5em} The joker}& - \texttt{?}& - \texttt{a}, \texttt{b}, \texttt{z} & - \texttt{/}, \texttt{bar} & - Any one-letter string, excluding the slash \\ - \hline -%% - {\texttt{**/} \vspace*{0.5em} The prefix inter-directory star}& - \texttt{**/foo.ml}& - \texttt{foo.ml}, \texttt{bar/foo.ml}, \texttt{bar/baz/foo.ml} & - \texttt{foo/bar}, \texttt{/bar} & - The empty string, or any string ending with a slash - ($\varepsilon \cup P^*\mathtt{/}$) \\ - \hline -%% - {\texttt{/**} \vspace*{0.5em} The suffix inter-directory star}& - \texttt{foo/**}& - \texttt{foo}, \texttt{foo/bar} & - \texttt{bar/foo} & - Any string starting with a slash, or the empty string - ($\varepsilon \cup \mathtt{/}P^*$) \\ - \hline -%% - {\texttt{/**/} \vspace*{0.5em} The infix inter-directory star}& - \texttt{bar/**/foo.ml}& - \texttt{bar/foo.ml}, \texttt{bar/baz/foo.ml} & - \texttt{foo.ml} & - Any string starting and ending with a slash - ($\varepsilon \cup \mathtt{/}P^*\mathtt{/}$) \\ - \hline -%% - {$\mathtt{[} r_1 r_2 \cdots r_k \mathtt{]}$ - where $r_i$ is either $c$ or $c_1-c_2$ $(1 \leq i \leq k)$ - \vspace*{0.5em} The positive character class}& - \texttt{[a-fA-F0-9\_.]}& - \texttt{3}, \texttt{F}, \texttt{.} & - \texttt{z}, \texttt{bar} & - Any one-letter string made of characters from one of the ranges - $r_i$ ($1 \leq i \leq n$). - ($\mathscr L(r_1) \cup \cdots \cup \mathscr L(r_n)$) \\ - \hline -%% - {\texttt{[\char`\^}$r_1 r_2 \cdots r_k \mathtt{]}$ - where $r_i$ is either $c$ or $c_1-c_2$ $(1 \leq i \leq k)$ - \vspace*{0.5em} The negative character class}& - \texttt{[\char`\^a-fA-F0-9\_.]}& - \texttt{z}, \texttt{bar} & - \texttt{3}, \texttt{F}, \texttt{.} & - Any one-letter string NOT made of characters from one of the ranges - $r_i$ ($1 \leq i \leq n$). - ($\Sigma^* \setminus \left(\mathscr L(r_1) \cup \cdots \cup \mathscr L(r_n)\right)$) \\ - \hline -%% - {$p_1 p_2$ \vspace*{0.5em} A concatenation of patterns}& - \texttt{foo*}& - \texttt{foo}, \texttt{foob}, \texttt{foobar} & - \texttt{fo}, \texttt{bar} & - Any string with a prefix matching $p_1$ and the corresponding suffix - matching $p_2$, - ($\{ uv \mid u \in \mathscr L(p_1), v \in \mathscr L(p_2) \}$) \\ - \hline -%% - {$\mathtt{\{} p_1 \mathtt{,} p_2 \mathtt{,} \cdots \mathtt{,} p_k \mathtt{\}}$ \vspace*{0.5em} A union of patterns}& - \texttt{toto.\{ml,mli\}}& - \texttt{toto.ml}, \texttt{toto.mli} & - \texttt{toto.} & - Any string matching one of the patterns $p_i$ for $1 \leq i \leq k$. - ($\mathscr L(p_1) \cup \cdots \cup \mathscr L(p_k)$) \\ - \hline -%% - \end{tabular} - \end{center} - \caption{ - Syntax and semantics of glob patterns. - } -\end{table} -\begin{table} - \begin{center} - \small - \begin{tabular}{|p{2cm}|l|p{7cm}|} - \hline - {\em Formal syntax} & - {\em Example} & - {\em Meaning (formal meaning)} \\ - \hline - \hline - {$\mathtt{<}p\mathtt{>}$} & - \texttt{} & - Pathnames matching the pattern $p$ \\ - \hline - {$e_1 \; \mathtt{or} \; e_2$} & - \texttt{<*.ml> or } & - Pathnames matching at least one of the expressions $e_1$ and $e_2$ \\ - \hline - {$e_1 \; \mathtt{and} \; e_2$} & - \texttt{<*.ml> and } & - Pathnames matching both expressions $e_1$ and $e_2$ \\ - \hline - {$\mathtt{not} \; e$} & - \texttt{not <*.mli>} & - Pathnames not matching the expression $e$ \\ - \hline - {$\mathtt{true}$} & - \texttt{true} & - All pathnames \\ - \hline - {$\mathtt{false}$} & - \texttt{false} & - No pathnames \\ - \hline - \end{tabular} - \end{center} - \caption{ - Syntax and semantics of glob expressions. - } -\end{table} -%***) -%(*** Subdirectories -\subsection{Subdirectories} -If the files of your project are held in one or more subdirectories, -\ocb must be made aware of that fact using the \texttt{-I} or \texttt{-Is} options -or by adding an \texttt{include} tag. For instance, assume your project is made -of three subdirectories, \texttt{foo}, \texttt{bar} and \texttt{baz} containing -various \texttt{.ml} files, the main file being \texttt{foo/main.ml}. Then you can -either type: -\begin{verbatim} -% ocamlbuild -Is foo,bar,baz foo/main.native -\end{verbatim} -or add the following line in the \tags file -\begin{verbatim} - or or : include -\end{verbatim} -and call -\begin{verbatim} -% ocamlbuild foo/main.native -\end{verbatim} - -There are then two cases. If no other modules named \texttt{Bar} or -\texttt{Baz} exist elsewhere in the project, then you are done. Just use -\texttt{Foo}, \texttt{Foo.Bar} and \texttt{Foo.Baz} in your code. -Otherwise, you will need to use the plugin mechanism and define the mutual -visibility of the subdirectories using the \texttt{Pathname.define\_context} -function. - -\subsubsection{Note on subdirectory traversal} -\ocb used to traverse by default any subdirectory not explicitly excluded. -This is no longer the case. Note that you can still have a fine grained -control using your \tags file and the \texttt{traverse} tag. - -There is no longer the \texttt{true: traverse} tag declaration by default. To -make \ocb recursive use one of these: -\begin{enumerate} -\item Give the \texttt{-r} flag to ocamlbuild. -\item Have a \tags or myocamlbuild.ml file in your top directory. -\end{enumerate} - -%***) -%(*** Grouping targets -\subsection{Grouping targets with \texttt{.itarget}} -You can create a file named \texttt{foo.itarget} containing -a list of targets, one per line, such as -\begin{verbatim} -main.native -main.byte -stuff.docdir/index.html -\end{verbatim} -Requesting the target \texttt{foo.otarget} will then build every target -listed in the file \texttt{foo.itarget}. Blank lines and lines starting -with a sharp (\texttt{\#}) are ignored. -%***) -%(*** Packing subdirectories into modules -\subsection{Packing subdirectories into modules} -OCaml's \texttt{-pack} option allows you to structure the contents of a -module in a subdirectory. For instance, assume you have a directory -\texttt{foo} containing two modules \texttt{bar.ml} and \texttt{baz.ml}. -You want from these to build a module \texttt{Foo} containing \texttt{Bar} -and \texttt{Baz} as submodules. In the case where no modules named -\texttt{Bar} or \texttt{Baz} exist outside of \texttt{Foo}, to do this you -must write a file \texttt{foo.mlpack}, preferably sitting in the same -directory as the directory \texttt{Foo} and containing the list of modules -(one per line) it must contain: -\begin{verbatim} -Bar -Baz -\end{verbatim} -Then when you will request for building \texttt{foo.cmo} the package will be -made from \texttt{bar.cmo} and \texttt{baz.cmo}. -%***) -%(*** Making an OCaml library -\subsection{Making an OCaml library} -In a similar way than for packaged modules you can make a library by putting -it's contents in a file (with the mllib extension). For instance, assume you -have a two modules \texttt{bar.ml} and \texttt{baz.ml}. You want from these to -build a library \texttt{foo.cmx?a} containing \texttt{Bar} and \texttt{Baz} -modules. To do this you must write a file \texttt{foo.mllib} containing the -list of modules (one per line) it must contain: -\begin{verbatim} -Bar -Baz -\end{verbatim} -Then when you will request for building \texttt{foo.cma} the library will be -made from \texttt{bar.cmo} and \texttt{baz.cmo}. -%***) -%(*** Making an OCaml toplevel -\subsection{Making an OCaml toplevel} -Making a toplevel is almost the same thing than making a packaged module or a -library. Just write a file with the \texttt{mltop} extension (like -\texttt{foo.mltop}) and request for building the toplevel using the -\texttt{top} extension (\texttt{foo.top} in this example). -%***) -%(*** Preprocessor options -\subsection{Preprocessor options and tags} -You can specify preprocessor options with \texttt{-pp} followed by the -preprocessor string, for instance \texttt{ocamlbuild -pp "camlp4o.opt -unsafe"} -would run your sources thru CamlP4 with the \texttt{-unsafe} option. -Another way is to use the tags file. -\begin{center} - \begin{tabular}{|l|l|l|} - \hline - \textbf{Tag} & \textbf{Preprocessor command} & \textbf{Remark} \\ - \hline - \hline - \texttt{pp(cmd...)} & \texttt{cmd...} & Arbitrary - preprocessor command\footnote{The command must not contain newlines or parentheses.} \\ - \hline - \texttt{camlp4o} & \texttt{camlp4o} & Original OCaml syntax \\ - \hline - \texttt{camlp4r} & \texttt{camlp4r} & Revised OCaml syntax \\ - \hline - \texttt{camlp4of} & \texttt{camlp4of} & Original OCaml syntax with extensions \\ - \hline - \texttt{camlp4rf} & \texttt{camlp4rf} & Revised OCaml syntax with extensions \\ - \hline - \end{tabular} -\end{center} - -%%%%% \subsubsection{An example, dealing with some configuration variables} -%%%%% -%%%%% It's quite common to have in your sources some files that you want to access -%%%%% when your program is running. One often uses some variables that are setup by -%%%%% the end user. Now suppose that there is only two files that use these variables -%%%%% (mylib.ml and parseopt.ml). -%%%%% -%%%%% In the \tags file: -%%%%% \begin{verbatim} -%%%%% "mylib.ml" or "parseopt.ml": pp(sed -e "s,LIBDIR,/usr/local/lib/FOO,g") -%%%%% \end{verbatim} -%%%%% -%%%%% In fact that solution is not really acceptable, since the variable is hardcoded -%%%%% in the \tags file. Trying to workaround this issue by using some shell variable -%%%%% does not work either since the -pp argument will be escaped in simple quotes. -%%%%% Note also that using some script shell that will do that sed and use \verb'$LIBDIR' -%%%%% as a shell variable is not a good idea since \ocb don't know this dependency on that -%%%%% shell script. -%%%%% -%%%%% There is in fact at least two good solutions. The first is to tell that dependency -%%%%% using the \texttt{dep} function in your plugin. The second is simpler it just consist -%%%%% on generating some OCaml file at configure time. By naming this configuration file -%%%%% \texttt{myocamlbuild_config.ml} \ocb will make it also available to your plugin. -%%%%% -%%%%% In your \texttt{myocamlbuild_config.mli} interface: -%%%%% \begin{verbotim} -%%%%% val prefix : string -%%%%% val libdir : string -%%%%% \end{verbotim} -%%%%% -%%%%% And in your \texttt{configure} script -%%%%% \begin{verbatim} -%%%%% #!/bin/sh -%%%%% -%%%%% # Setting defaults values -%%%%% PREFIX=/usr/local -%%%%% LIBDIR=$PREFIX/lib/FOO -%%%%% CONF=myocamlbuild_config.ml -%%%%% -%%%%% # ... some shell to parse option and check configuration ... -%%%%% -%%%%% # Dumping the configuration as an OCaml file. -%%%%% rm -f $CONF -%%%%% echo "let prefix = \"$PREFIX\";;" >> $CONF -%%%%% echo "let libdir = \"$LIBDIR\";;" >> $CONF -%%%%% chmod -w $CONF -%%%%% \end{verbatim} - -%***) -%(*** Debugging and profiling -\subsection{Debugging byte code and profiling native code} -The preferred way of compiling code suitable for debugging with \texttt{ocamldebug} or -profiling native code with \texttt{ocamlprof} is to use the appropriate target -extensions, \texttt{.d.byte} for debugging or \texttt{.p.native}. - -Another way is to add use the \texttt{debug} or \texttt{profile} tags. -Note that these tags must be applied at the compilation and linking stages. -Hence you must either use \texttt{-tag debug} or \texttt{-tag profile} -on the command line, or add a -\begin{verbatim} -true: debug -\end{verbatim} -line to your \tags file. -Please note that the byte-code profiler works in a wholly different way -and is not supported by \ocb. -%***) -%(*** Generating documentation using \texttt{ocamldoc} -\subsection{Generating documentation using \texttt{ocamldoc}} -Write the names of the modules whose interfaces will be documented in a file -whose extension is \texttt{.odocl}, for example \texttt{foo.odocl}, then invoke -\ocb on the target \texttt{foo.docdir/index.html}. This will collect all the -documentation from the interfaces (which will be build, if necessary) using -\texttt{ocamldoc} and generate a set of HTML files under the directory -\texttt{foo.docdir/}, which is actually a link to \texttt{\_build/foo.docdir/}. -As for packing subdirectories into modules, the module names must be written -one per line, without extensions and correctly capitalized. Note that -generating documentation in formats other than HTML or from implementations is -not supported. -%***) -%(*** The display line -\subsection{The display line} -Provided \ocb runs in a terminal under a POSIX environment, it will -display a sophisticated progress-indicator line that graciously interacts -with the output of subcommands. This line looks like this: -\begin{verbatim} -00:00:02 210 (180 ) main.cmx ONbp--il / -\end{verbatim} -Here, 00:00:02 is the elapsed time in hour:minute:second format since \ocb has -been invoked; 210 is the number of external commands, typically calls to the -compiler or the like, that may or may not have been invoked; 180 is the number -of external commands that have not been invoked since their result is already -in the build directory; \texttt{main.cmx} is the name of the last target built; -\texttt{ONbp--il} is a short string that describes the tags that have been -encountered and the slash at the end is a frame from a rotating ticker. Hence, -the display line has the following structure: -\begin{verbatim} -HH:MM:SS JOBS (CACHED) PATHNAME TAGS TICKER -\end{verbatim} - -The tag string is made of 8 indicators which each monitor a tag. These tags -are \texttt{ocaml}, \texttt{native}, \texttt{byte}, \texttt{program}, -\texttt{pp}, \texttt{debug}, \texttt{interf} and \texttt{link}. Initially, -each indicator displays a dash \texttt{-}. If the current target has the -monitored tag, then the indicator displays the corresponding character -(see table \ref{tab:tag-chars}) in uppercase. Otherwise, it displays that -character in lowercase. This allows you to see the set of tags that have -been applied to files in your project during the current invocation of \ocb. - -Hence the tag string \texttt{ONbp--il} means that the current target -\texttt{main.cmx} has the tags \texttt{ocaml} and \texttt{native}, and that -the tags \texttt{ocaml}, \texttt{native}, \texttt{byte}, \texttt{program}, -\texttt{interf} and \texttt{link} have already been seen. - -\begin{table} - \begin{center} - \begin{tabular}{|l|c|} - \hline - \textbf{Tag} & \textbf{Display character} \\ - \hline - \hline - ocaml & O \\ - \hline - native & N \\ - \hline - byte & B \\ - \hline - program & P \\ - \hline - pp & R \\ - \hline - debug & D \\ - \hline - interf & I \\ - \hline - link & L \\ - \hline - \end{tabular} - \end{center} - \caption{\label{tab:tag-chars} Relation between the characters displayed in - the tag string and the tags.} -\end{table} -%***) -%(*** ocamllex, ocamlyacc and menhir -\subsection{\texttt{ocamllex}, \texttt{ocamlyacc} and \texttt{menhir}} -\ocb knows how to run the standard lexer and parser generator tools -\texttt{ocamllex} and \texttt{ocamlyacc} when your files have the -standard \texttt{.mll} and \texttt{.mly} extensions. If you want to -use \texttt{menhir} instead of \texttt{ocamlyacc}, you can either -launch \ocb with the \texttt{-use-menhir} option or add a -\begin{verbatim} -true: use_menhir -\end{verbatim} -line to your \tags file. Note that there is currently no way -of using \texttt{menhir} and \texttt{ocamlyacc} in the same execution -of \ocb. -%***) -%(*** Changing the compilers -\subsection{Changing the compilers or tools} -As \ocb is part of your OCaml distribution, it knows if it can call the -native compilers and tools (\texttt{ocamlc.opt}, \texttt{ocamlopt.opt}...) -or not. However you may want \ocb to use another \texttt{ocaml} compiler -for different reasons (such as cross-compiling or using a wrapper such as -\texttt{ocamlfind}). Here is the list of relevant options: -\begin{itemize} - \item \texttt{-ocamlc } - \item \texttt{-ocamlopt } - \item \texttt{-ocamldep } - \item \texttt{-ocamlyacc } - \item \texttt{-menhir } - \item \texttt{-ocamllex } - \item \texttt{-ocamlmktop } - \item \texttt{-ocamlrun } -\end{itemize} - -%***) -\subsection{Writing a \texttt{myocamlbuild.ml} plugin} -%(*** Interaction with version control systems -\subsection{Interaction with version control systems} -Here are tips for configuring your version control system to ignore the files -and directories generated by \ocb. - -The directory \texttt{\_build} and any symbolic links -pointing into \texttt{\_build} should be ignored. -To do this, you must add the following ignore patterns to your version -control system's ignore set: -\begin{verbatim} -_build -*.native -*.byte -*.d.native -*.p.byte -\end{verbatim} - -For CVS, add the above lines to the \texttt{.cvsignore} file. -For Subversion (SVN), type \texttt{svn propedit svn:ignore .} and add the -above lines. -%***) -%(*** A shell script for driving it all? -\subsection{A shell script for driving it all?} -{\em To shell or to make ?} -Traditionally, makefiles have two major functions. The first one -is the dependency-ordering, rule-matching logic used for compiling. -The second one is as a dispatcher for various actions defined using -phony targets with shell script actions. These actions include cleaning, -cleaning really well, archiving, uploading and so on. Their characteristic -is that they rely little or not on the building process -- they either need -the building to have been completed, or they don't need anything. -As \texttt{/bin/sh} scripts have been here for three to four decades and are -not going anywhere, why not replace that functionality of makefiles with a -shell script ? We have thought of three bad reasons: -\begin{itemize} - \item Typing \texttt{make} to compile is now an automatism, - \item We need to share variable definitions between rules and actions, - \item Escaping already way too special-character-sensitive shell code with - invisible tabs and backslashes is a dangerously fun game. -\end{itemize} -We also have bad reasons for not using an OCaml script to drive everything: -\begin{itemize} - \item \texttt{Sys.command} calls the \texttt{/bin/sh} anyway, - \item Shell scripts can execute partial commands or commands with badly formed arguments. - \item Shell scripts are more concise for expressing... shell scripts. -\end{itemize} -Anyway you are of course free to use a makefile or an OCaml script to call ocamlbuild. -Here is an example shell driver script: -\begin{verbatim} -#!/bin/sh - -set -e - -TARGET=epoch -FLAGS="-libs unix,nums" -OCAMLBUILD=ocamlbuild - -ocb() -{ - $OCAMLBUILD $FLAGS $* -} - -rule() { - case $1 in - clean) ocb -clean;; - native) ocb $TARGET.native;; - byte) ocb $TARGET.byte;; - all) ocb $TARGET.native $TARGET.byte;; - depend) echo "Not needed.";; - *) echo "Unknown action $1";; - esac; -} - -if [ $# -eq 0 ]; then - rule all -else - while [ $# -gt 0 ]; do - rule $1; - shift - done -fi -\end{verbatim} -%***) -%\subsection{Common errors} -%***) -\appendix -%(*** Motivations -\section{Motivations} -{\em This inflammatory appendix describes the frustration that led us to write \ocb.} - -Many people have painfully found that the utilities of the \texttt{make} -family, namely GNU Make, BSD Make, and their derivatives, fail to scale to -large projects, especially when using multi-stage compilation rules, such as -custom pre-processors, unless dependencies are hand-defined. But as your -project gets larger, more modular, and uses more diverse pre-processing tools, -it becomes increasingly difficult to correctly define dependencies by hand. -Hence people tend to use language-specific tools that attempt to extract -dependencies. However another problem then appears: \texttt{make} was designed -with the idea of a static dependency graph. Dependency extracting tools, -however, are typically run by a rule in \texttt{make} itself; this means that -make has to reload the dependency information. This is the origin of the -\texttt{make clean; make depend; make} mantra. This approach tends to work -quite well as long as all the files sit in a single directory and there is only -one stage of pre-processing. If there are two or more stages, then dependency -extracting tools must be run two or more times - and this means multiple -invocations of \texttt{make}. Also, if one distributes the modules of a large -project into multiple subdirectories, it becomes difficult to distribute the -makefiles themselves, because the language of \texttt{make} was not conceived -to be modular; the only two mechanisms permitted, inclusion of makefile -fragments, and invocation of other make instances, must be skillfully -coordinated with phony target names (\texttt{depend1, depend2...}) to insure -inclusion of generated dependencies with multi-stage programming; changes in -the structure of the project must be reflected by hand and the order of -variable definitions must be well-thought ahead to avoid long afternoons spent -combinatorially fiddling makefiles until it works but no one understands why. - -These problems become especially apparent with OCaml: to ensure type safety and -to allow a small amount of cross-unit optimization when compiling native code, -interface and object files include cryptographical digests of interfaces they -are to be linked with. This means that linking is safer, but that makefile sloppiness -leads to messages such as: -\begin{verbatim} -Files foo.cmo and bar.cmo -make inconsistent assumptions over interface Bar -\end{verbatim} - -The typical reaction is then to issue the mantra \texttt{make clean; make -depend; make} and everything compiles just fine... from the beginning. Hence -on medium projects, the programmer often has to wait for minutes instead of the -few seconds that would be taken if \texttt{make} could correctly guess the -small number of files that really had to be recompiled. - -It is not surprising that hacking a build tool such as \texttt{make} to include -a programming language while retaining the original syntax and semantics gives -an improvised and cumbersome macro language of dubious expressive power. For -example, using GNU make, suppose you have a list of \texttt{.ml}s that you want -to convert into a list including both \texttt{.cmo}s and \texttt{.cmi}s, that -is you want to transform \texttt{a.ml b.ml c.ml} into \texttt{a.cmi a.cmo b.cmi -b.cmo c.cmi c.cmo} while preserving the dependency order which must be hand -specified for linking \footnote{By the way, what's the point of having a -declarative language if \texttt{make} can't sort the dependencies in -topological order for giving them to \texttt{gcc} or whatever ?}. -Unfortunately \texttt{\$patsubst \%.ml, \%.cmi \%.cmo, a.ml b.ml c.ml} won't -work since the \%-sign in the right-hand of a \texttt{patsubst} gets -substituted only once. You then have to delve into something that is hardly -lambda calculus: an intricate network of \texttt{foreach}, \texttt{eval}, -\texttt{call} and \texttt{define}s may get you the job done, unless you chicken -out and opt for an external \texttt{awk}, \texttt{sed} or \texttt{perl} call. -People who at this point have not lost their temper or sanity usually resort to -metaprogramming by writing Makefile generators using a mixture of shell and m4. -One such an attempt gave something that is the nightmare of wannabe package -maintainers: it's called \texttt{autotools}. - -Note that it is also difficult to write \texttt{Makefiles} to build object -files in a separate directory. It is not impossible since the language of -\texttt{make} is Turing-complete, a proof of which is left as an exercise. -Note that building things in a separate directory is not necessarily a young -enthusiast's way of giving a different look and feel to his projects -- it may -be a good way of telling the computer that \texttt{foo.mli} is generated by -\texttt{ocamlyacc} using \texttt{foo.mly} and can thus be removed. -%***) -%(*** Default rules -\section{Summary of default rules} -The contents of this table give a summary of the most important default rules. -To get the most accurate and up-to-date information, launch \ocb with the -\texttt{-documentation} option. -\begin{center} -\small -\begin{tabular}{|l|l|p{5cm}|} - \hline - \textbf{Tags} & \textbf{Dependencies} & \textbf{Targets} \\ - \hline - \hline - & \%.itarget & \%.otarget \\ - \hline - ocaml & \%.mli \%.mli.depends & \%.cmi \\ - \hline - byte, debug, ocaml & \%.mlpack \%.cmi & \%.d.cmo \\ - \hline - byte, ocaml & \%.mlpack & \%.cmo \%.cmi \\ - \hline - byte, ocaml & \%.mli \%.ml \%.ml.depends \%.cmi & \%.d.cmo \\ - \hline - byte, ocaml & \%.mli \%.ml \%.ml.depends \%.cmi & \%.cmo \\ - \hline - native, ocaml, profile & \%.mlpack \%.cmi & \%.p.cmx \%.p.o \\ - \hline - native, ocaml & \%.mlpack \%.cmi & \%.cmx \%.o \\ - \hline - native, ocaml, profile & \%.ml \%.ml.depends \%.cmi & \%.p.cmx \%.p.o \\ - \hline - native, ocaml & \%.ml \%.ml.depends \%.cmi & \%.cmx \%.o \\ - \hline - debug, ocaml & \%.ml \%.ml.depends \%.cmi & \%.d.cmo \\ - \hline - ocaml & \%.ml \%.ml.depends & \%.cmo \%.cmi \\ - \hline - byte, debug, ocaml, program & \%.d.cmo & \%.d.byte \\ - \hline - byte, ocaml, program & \%.cmo & \%.byte \\ - \hline - native, ocaml, profile, program & \%.p.cmx \%.p.o & \%.p.native \\ - \hline - native, ocaml, program & \%.cmx \%.o & \%.native \\ - \hline - byte, debug, library, ocaml & \%.mllib & \%.d.cma \\ - \hline - byte, library, ocaml & \%.mllib & \%.cma \\ - \hline - byte, debug, library, ocaml & \%.d.cmo & \%.d.cma \\ - \hline - byte, library, ocaml & \%.cmo & \%.cma \\ - \hline - & lib\%(libname).clib & lib\%(libname).a dll\%(libname).so \\ - \hline - & \%(path)/lib\%(libname).clib & \%(path)/lib\%(libname).a \%(path)/dll\%(libname).so \\ - \hline - library, native, ocaml, profile & \%.mllib & \%.p.cmxa \%.p.a \\ - \hline - library, native, ocaml & \%.mllib & \%.cmxa \%.a \\ - \hline - library, native, ocaml, profile & \%.p.cmx \%.p.o & \%.p.cmxa \%.p.a \\ - \hline - library, native, ocaml & \%.cmx \%.o & \%.cmxa \%.a \\ - \hline - & \%.ml & \%.ml.depends \\ - \hline - & \%.mli & \%.mli.depends \\ - \hline - ocaml & \%.mll & \%.ml \\ - \hline - doc, ocaml & \%.mli \%.mli.depends & \%.odoc \\ - \hline - & \%.odocl & \%.docdir/index.html \\ - \hline - ocaml & \%.mly & \%.ml \%.mli \\ - \hline - & \%.c & \%.o \\ - \hline - & \%.ml \%.ml.depends & \%.inferred.mli \\ - \hline -\end{tabular} -\end{center} -%***) -\end{document} diff -Nru ocaml-3.12.1/ocamlbuild/manual/myocamlbuild.ml ocaml-4.01.0/ocamlbuild/manual/myocamlbuild.ml --- ocaml-3.12.1/ocamlbuild/manual/myocamlbuild.ml 2007-02-16 10:40:25.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/manual/myocamlbuild.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,119 +0,0 @@ -(*p - \usepackage{xspace} - \newcommand{\ocb}{\texttt{ocamlbuild}\xspace} - \newcommand{\tags}{\texttt{\_tags}\xspace} -*) -let main = let module M = struct - -open Ocamlbuild_plugin;; -open Command;; - -let pdflatex = ref (A"pdflatex");; -let ocamlweb = ref (A"ocamlweb");; - -(*c dispatch is the main call of an \ocb plugin *) -dispatch begin function - - (*c Here one can change the default value of options, they can still be updated by a command line option. *) - | Before_options -> - - (*c This will put all warnings to \texttt{ocaml\{c,opt\}} by default. *) - Options.ocaml_cflags := ["-w";"A"] - - (*c Here one can change the final value of options. *) - | After_options -> - - (*c This avoids the creation of symbolic links to the build directory. *) - Options.make_links := false - - (*c This hook is called before the hygiene phase. - This phase also serve as collecting all the information about the - source tree. *) - | Before_hygiene -> - - (*c Here you can dynamically tag some files or directories. *) - (*c This is done here by checking the [SOME_COND] variable which is - impossible in the \tags file. *) - if getenv "SOME_COND" ~default:"false" = "true" then - - (*c By setting foo\_dir as not\_hygienic one say that the foo directory - can contains non hygienic files (such as \texttt{.cmi}, \texttt{.cmo}\ldots). *) - tag_file "foo_dir" ["not_hygienic"] - - (*c One can also do things after the hygiene step. *) - | After_hygiene -> () - - (*c One can setup rules before the standard ones but that's not recommended. *) - | Before_rules -> () - - (*c Here one can add or override new rules *) - | After_rules -> - - (*c Rules can be declared by a call of the form - [rule name ~prod ~dep action]. - The first argument is the name of the rule. - [~prod:string] specifies the product of the rule. - Note that [~prods:string list] also exists. - [~dep] and [~deps] are for dependencies *) - rule "LaTeX to PDF conversion rule" - ~prod:"%.pdf" - ~dep:"%.tex" - begin fun env _build -> - - (*c The action is a function that receive two arguments: - [env] is a conversion function that substitutes `\%' occurrences - according to the targets to which the rule applies. - [_build] can be called to build new things (dynamic dependencies). *) - let tex = env "%.tex" and _pdf = env "%.pdf" in - - (*c Here we say: ``We compile the file tex form \LaTeX\xspace to PDF''. - Note that in fact that is a set of tags, thus the order does not - matter. But you got the idea. *) - let tags = tags_of_pathname tex++"compile"++"LaTeX"++"pdf" in - - (*c Here we produce the command to run. - [S] is for giving a sequence of command pieces. - [A] is for atoms. - [P] is for pathnames. - [Px] is a special pathname that should be the main product of the - rule (for display purposes). - [T] is for tags. - - The other constructors are given in the documentation of the - [Command] module in [Signatures.COMMAND]. *) - let cmd = Cmd(S[!pdflatex; T tags; P tex; Sh"< /dev/null"]) in - (*c Hoping that \LaTeX will converge in two iterations *) - Seq[cmd; cmd] - end; - - (*c Here we make an extension of any rule that produces a command - containing these tags. *) - flag ["compile"; "LaTeX"; "pdf"; "safe"] (A"-halt-on-error"); - - (*c Here we give an exception: the file ``manual.tex'' is tagged ``safe''.\ocweol - With this tag we add the -halt-on-error flag during the \LaTeX - compilation. *) - tag_file "manual.tex" ["safe"]; - - (*c The generic \LaTeX rule could look at the file searching for some - \verb'\input{}' command, but \LaTeX is so complex that it will - be hard to make this solution complete. - Here we manually inject some dependencies at one particular point. *) - - (*c The [dep] function takes tags and pathnames. This will build pathnames - if a command contains these tags. Note that every file [some_file_name] is - tagged [file:some_file_name]. *) - dep ["compile"; "LaTeX"; "pdf"; "file:manual.tex"] - ["ocamlweb.sty"; "myocamlbuild.tex"]; - - rule "OCaml to LaTeX conversion rule (using ocamlweb)" - ~prod:"%.tex" - ~dep:"%.ml" - begin fun env _build -> - let tex = env "%.tex" and ml = env "%.ml" in - let tags = tags_of_pathname ml++"ocamlweb"++"LaTeX" in - Cmd(S[!ocamlweb; T tags; P ml; A"-o"; Px tex]) - end; -end;; - -end in ();; \ No newline at end of file diff -Nru ocaml-3.12.1/ocamlbuild/manual/trace.out ocaml-4.01.0/ocamlbuild/manual/trace.out --- ocaml-3.12.1/ocamlbuild/manual/trace.out 2007-11-21 18:20:41.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/manual/trace.out 1970-01-01 00:00:00.000000000 +0000 @@ -1,83 +0,0 @@ -00:00:00 0 (0) STARTING -------- | -00:00:00 1 (0) back.ml.depends O------- | -00:00:00 8 (0) keyword.mli.depends O-b---i- | -00:00:00 16 (0) mark.cmi O-B---I- / -00:00:00 20 (0) stringSet.cmi O-B---I- / -00:00:00 24 (0) time.mli.depends O-b---i- / -00:00:00 32 (0) stdlib.ml.depends O-b---i- - -00:00:00 35 (0) stringSet.cmx ONb---i- - -00:00:00 37 (0) settings.cmx ONb---i- - -00:00:00 44 (0) lineCount.cmx ONb---i- \ -00:00:00 45 (0) interface.ml.depends Onb---i- \ -00:00:00 45 (0) interface.ml.depends Onb---i- \ -00:00:01 52 (0) stringMap.ml.depends Onb---i- | -00:00:01 53 (0) printer.cmx ONb---i- | -00:00:01 53 (0) printer.cmx ONb---i- | -00:00:01 57 (0) time.cmx ONb---i- / -00:00:01 64 (0) partialGrammar.cmi OnB---I- / -00:00:01 67 (0) parameters.ml.depends Onb---i- / -00:00:01 72 (0) misc.ml.depends Onb---i- - -00:00:01 74 (0) keyword.ml.depends Onb---i- - -00:00:01 77 (0) error.cmi OnB---I- - -00:00:01 82 (0) parameters.cmx ONb---i- \ -00:00:01 84 (0) action.cmx ONb---i- \ -00:00:01 87 (0) parser.mli.depends Onb---i- \ -00:00:02 96 (0) parserAux.cmx ONb---i- | -00:00:02 103 (0) tarjan.ml.depends Onb---i- | -00:00:02 106 (0) unionFind.cmx ONb---i- | -00:00:02 108 (0) lexer.mll Onb---i- / -00:00:02 108 (0) lexer.mll Onb---i- / -00:00:02 110 (0) lexer.cmo OnB---i- - -00:00:02 111 (0) parser.cmx ONb---i- - -00:00:02 112 (0) partialGrammar.cmx ONb---i- - -00:00:02 114 (0) lexer.cmx ONb---i- \ -00:00:02 116 (0) codeBits.mli.depends Onb---i- \ -00:00:03 118 (0) preFront.cmx ONb---i- | -00:00:03 120 (0) tokenType.cmx ONb---i- | -00:00:03 123 (0) inliner.cmi OnB---I- | -00:00:03 126 (0) traverse.cmx ONb---i- / -00:00:03 126 (0) traverse.cmx ONb---i- / -00:00:03 129 (0) code.cmi OnB---I- / -00:00:03 131 (0) lr1.mli.depends Onb---i- / -00:00:03 134 (0) lookahead.mli.depends Onb---i- - -00:00:03 137 (0) gMap.ml.depends Onb---i- - -00:00:03 144 (0) lr1.cmi OnB---I- - -00:00:03 146 (0) item.ml.depends Onb---i- - -00:00:03 149 (0) patricia.cmi OnB---I- \ -00:00:03 151 (0) patricia.cmx ONb---i- \ -00:00:03 151 (0) patricia.cmx ONb---i- \ -00:00:04 154 (0) front.cmi OnB---I- | -00:00:04 164 (0) listMonad.ml.depends Onb---i- | -00:00:04 167 (0) listMonad.cmx ONb---i- | -00:00:04 170 (0) infer.cmi OnB---I- / -00:00:04 171 (0) lexmli.mll Onb---i- / -00:00:04 172 (0) lexmli.ml.depends Onb---i- / -00:00:04 174 (0) lexdep.mll Onb---i- - -00:00:04 177 (0) interface.cmx ONb---i- - -00:00:04 178 (0) IO.ml.depends Onb---i- \ -00:00:04 181 (0) lexmli.cmx ONb---i- \ -00:00:04 183 (0) IO.cmx ONb---i- \ -00:00:05 187 (0) infer.cmx ONb---i- | -00:00:05 190 (0) dot.cmi OnB---I- | -00:00:05 193 (0) compressedBitSet.cmi OnB---I- / -00:00:05 195 (0) dot.cmx ONb---i- / -00:00:05 197 (0) grammar.cmx ONb---i- / -00:00:05 197 (0) grammar.cmx ONb---i- / -00:00:05 197 (0) grammar.cmx ONb---i- - -00:00:05 200 (0) infiniteArray.cmi OnB---I- - -00:00:05 201 (0) item.cmx ONb---i- - -00:00:05 204 (0) breadth.mli.depends Onb---i- \ -00:00:05 208 (0) invariant.ml.depends Onb---i- \ -00:00:06 212 (0) invariant.cmx ONb---i- | -00:00:06 213 (0) inliner.cmx ONb---i- | -00:00:06 214 (0) code.cmx ONb---i- / -00:00:06 216 (0) back.native ONbP--iL - -Finished, 216 targets (0 cached) in 00:00:06. -Finished, 216 targets (0 cached) in 00:00:06. -Finished, 216 targets (0 cached) in 00:00:06. -Finished, 216 targets (0 cached) in 00:00:06. -Finished, 216 targets (0 cached) in 00:00:06. -Finished, 216 targets (0 cached) in 00:00:06. -Finished, 216 targets (0 cached) in 00:00:06. -Finished, 216 targets (0 cached) in 00:00:06. -Finished, 216 targets (0 cached) in 00:00:06. diff -Nru ocaml-3.12.1/ocamlbuild/misc/opentracer.ml ocaml-4.01.0/ocamlbuild/misc/opentracer.ml --- ocaml-3.12.1/ocamlbuild/misc/opentracer.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/misc/opentracer.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/my_std.ml ocaml-4.01.0/ocamlbuild/my_std.ml --- ocaml-3.12.1/ocamlbuild/my_std.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/my_std.ml 2013-05-28 12:16:10.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -61,7 +62,7 @@ module type S = sig include Set.S - val find : (elt -> bool) -> t -> elt + val find_elt : (elt -> bool) -> t -> elt val map : (elt -> elt) -> t -> t val of_list : elt list -> t val print : formatter -> t -> unit @@ -70,7 +71,7 @@ module Make (M : OrderedTypePrintable) : S with type elt = M.t = struct include Set.Make(M) exception Found of elt - let find p set = + let find_elt p set = try iter begin fun elt -> if p elt then raise (Found elt) @@ -119,6 +120,21 @@ let union a b = rev (rev_append_uniq (rev_append_uniq [] a) b) + let ordered_unique (type el) (lst : el list) = + let module Set = Set.Make(struct + type t = el + let compare = Pervasives.compare + let print _ _ = () + end) + in + let _, lst = + List.fold_left (fun (set,acc) el -> + if Set.mem el set + then set, acc + else Set.add el set, el :: acc) (Set.empty,[]) lst + in + List.rev lst + end module String = struct @@ -179,7 +195,7 @@ and n = String.length v in m <= n && - let rec loop i = i = m or u.[i] = v.[i] && loop (i + 1) in + let rec loop i = i = m || u.[i] = v.[i] && loop (i + 1) in loop 0 (* ***) @@ -189,7 +205,7 @@ and n = String.length v in n <= m && - let rec loop i = i = n or u.[m - 1 - i] = v.[n - 1 - i] && loop (i + 1) in + let rec loop i = i = n || u.[m - 1 - i] = v.[n - 1 - i] && loop (i + 1) in loop 0 (* ***) @@ -249,18 +265,17 @@ | "Win32" -> fun cmd -> if cmd = "" then 0 else let cmd = "bash -c "^Filename.quote cmd in - (* FIXME fix Filename.quote for windows *) - let cmd = String.subst "\"&\"\"&\"" "&&" cmd in Sys.command cmd | _ -> fun cmd -> if cmd = "" then 0 else Sys.command cmd (* FIXME warning fix and use Filename.concat *) let filename_concat x y = if x = Filename.current_dir_name || x = "" then y else - if x.[String.length x - 1] = '/' then + if Sys.os_type = "Win32" && (x.[String.length x - 1] = '\\') || x.[String.length x - 1] = '/' then if y = "" then x else x ^ y - else x ^ "/" ^ y + else + x ^ "/" ^ y (* let reslash = match Sys.os_type with @@ -333,7 +348,7 @@ (* USEFUL FOR DIGEST DEBUGING let digest_log_hash = Hashtbl.create 103;; let digest_log = "digest.log";; - let digest_log_oc = open_out_gen [Open_append;Open_wronly;Open_text;Open_creat] 0o644 digest_log;; + let digest_log_oc = open_out_gen [Open_append;Open_wronly;Open_text;Open_creat] 0o666 digest_log;; let my_to_hex x = to_hex x ^ ";";; if sys_file_exists digest_log then with_input_file digest_log begin fun ic -> @@ -388,3 +403,19 @@ with Not_found -> let res = f x in (Hashtbl.add cache x res; res) + +let memo2 f = + let cache = Hashtbl.create 103 in + fun x y -> + try Hashtbl.find cache (x,y) + with Not_found -> + let res = f x y in + (Hashtbl.add cache (x,y) res; res) + +let memo3 f = + let cache = Hashtbl.create 103 in + fun x y z -> + try Hashtbl.find cache (x,y,z) + with Not_found -> + let res = f x y z in + (Hashtbl.add cache (x,y,z) res; res) diff -Nru ocaml-3.12.1/ocamlbuild/my_std.mli ocaml-4.01.0/ocamlbuild/my_std.mli --- ocaml-3.12.1/ocamlbuild/my_std.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/my_std.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/my_unix.ml ocaml-4.01.0/ocamlbuild/my_unix.ml --- ocaml-3.12.1/ocamlbuild/my_unix.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/my_unix.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/my_unix.mli ocaml-4.01.0/ocamlbuild/my_unix.mli --- ocaml-3.12.1/ocamlbuild/my_unix.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/my_unix.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/ocaml_arch.ml ocaml-4.01.0/ocamlbuild/ocaml_arch.ml --- ocaml-3.12.1/ocamlbuild/ocaml_arch.ml 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocaml_arch.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/ocaml_arch.mli ocaml-4.01.0/ocamlbuild/ocaml_arch.mli --- ocaml-3.12.1/ocamlbuild/ocaml_arch.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocaml_arch.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/ocaml_compiler.ml ocaml-4.01.0/ocamlbuild/ocaml_compiler.ml --- ocaml-3.12.1/ocamlbuild/ocaml_compiler.ml 2010-11-25 15:09:29.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocaml_compiler.ml 2013-06-30 08:36:23.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -144,6 +145,12 @@ (if Pathname.exists (ml-.-"depends") then path_dependencies_of ml else []) (if Pathname.exists (mli-.-"depends") then path_dependencies_of mli else []) in + let modules = + if (modules = []) && (Pathname.exists (ml^"pack")) then + List.map (fun s -> (`mandatory, s)) (string_list_of_file (ml^"pack")) + else + modules + in if modules <> [] && not (Hashtbl.mem cache_prepare_link key) then let () = Hashtbl.add cache_prepare_link key true in let modules' = List.map (fun (_, x) -> expand_module include_dirs x extensions) modules in @@ -224,6 +231,9 @@ let byte_link = byte_link_gen ocamlc_link_prog (fun tags -> tags++"ocaml"++"link"++"byte"++"program") +let byte_output_obj = byte_link_gen ocamlc_link_prog + (fun tags -> tags++"ocaml"++"link"++"byte"++"output_obj") + let byte_library_link = byte_link_gen byte_lib_linker byte_lib_linker_tags let byte_debug_link_gen = @@ -241,6 +251,9 @@ let native_link x = native_link_gen ocamlopt_link_prog (fun tags -> tags++"ocaml"++"link"++"native"++"program") x +let native_output_obj x = native_link_gen ocamlopt_link_prog + (fun tags -> tags++"ocaml"++"link"++"native"++"output_obj") x + let native_library_link x = native_link_gen native_lib_linker native_lib_linker_tags x diff -Nru ocaml-3.12.1/ocamlbuild/ocaml_compiler.mli ocaml-4.01.0/ocamlbuild/ocaml_compiler.mli --- ocaml-3.12.1/ocamlbuild/ocaml_compiler.mli 2010-04-17 16:15:42.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocaml_compiler.mli 2013-06-30 08:36:23.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -40,10 +41,12 @@ (Tags.t -> Tags.t) -> string -> string -> Rule.action val byte_link : string -> string -> Rule.action +val byte_output_obj : string -> string -> Rule.action val byte_library_link : string -> string -> Rule.action val byte_debug_link : string -> string -> Rule.action val byte_debug_library_link : string -> string -> Rule.action val native_link : string -> string -> Rule.action +val native_output_obj : string -> string -> Rule.action val native_library_link : string -> string -> Rule.action val native_shared_library_link : ?tags:(string list) -> string -> string -> Rule.action val native_profile_link : string -> string -> Rule.action diff -Nru ocaml-3.12.1/ocamlbuild/ocaml_dependencies.ml ocaml-4.01.0/ocamlbuild/ocaml_dependencies.ml --- ocaml-3.12.1/ocamlbuild/ocaml_dependencies.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocaml_dependencies.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/ocaml_dependencies.mli ocaml-4.01.0/ocamlbuild/ocaml_dependencies.mli --- ocaml-3.12.1/ocamlbuild/ocaml_dependencies.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocaml_dependencies.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -11,7 +12,7 @@ (* Original author: Nicolas Pouillard *) -(** Ocaml dependencies *) +(** OCaml dependencies *) exception Circular_dependencies of string list * string diff -Nru ocaml-3.12.1/ocamlbuild/ocaml_specific.ml ocaml-4.01.0/ocamlbuild/ocaml_specific.ml --- ocaml-3.12.1/ocamlbuild/ocaml_specific.ml 2011-02-10 15:16:31.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocaml_specific.ml 2013-07-26 19:44:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -159,6 +160,18 @@ ~dep:"%.cmo" (Ocaml_compiler.byte_link "%.cmo" "%.byte");; +rule "ocaml: cmo* -> byte.o" + ~tags:["ocaml"; "byte"; "link"; "output_obj" ] + ~prod:"%.byte.o" + ~dep:"%.cmo" + (Ocaml_compiler.byte_output_obj "%.cmo" "%.byte.o");; + +rule "ocaml: cmo* -> byte.c" + ~tags:["ocaml"; "byte"; "link"; "output_obj" ] + ~prod:"%.byte.c" + ~dep:"%.cmo" + (Ocaml_compiler.byte_output_obj "%.cmo" "%.byte.c");; + rule "ocaml: p.cmx* & p.o* -> p.native" ~tags:["ocaml"; "native"; "profile"; "program"] ~prod:"%.p.native" @@ -171,6 +184,12 @@ ~deps:["%.cmx"; x_o] (Ocaml_compiler.native_link "%.cmx" "%.native");; +rule "ocaml: cmx* & o* -> native.o" + ~tags:["ocaml"; "native"; "output_obj" ] + ~prod:"%.native.o" + ~deps:["%.cmx"; x_o] + (Ocaml_compiler.native_output_obj "%.cmx" "%.native.o");; + rule "ocaml: mllib & d.cmo* -> d.cma" ~tags:["ocaml"; "byte"; "debug"; "library"] ~prod:"%.d.cma" @@ -196,8 +215,11 @@ (Ocaml_compiler.byte_library_link "%.cmo" "%.cma");; rule "ocaml C stubs: clib & (o|obj)* -> (a|lib) & (so|dll)" - ~prods:["%(path:<**/>)lib%(libname:<*> and not <*.*>)"-.-ext_lib; - "%(path:<**/>)dll%(libname:<*> and not <*.*>)"-.-ext_dll] + ~prods:(["%(path:<**/>)lib%(libname:<*> and not <*.*>)"-.-ext_lib] @ + if Ocamlbuild_Myocamlbuild_config.supports_shared_libraries then + ["%(path:<**/>)dll%(libname:<*> and not <*.*>)"-.-ext_dll] + else + []) ~dep:"%(path)lib%(libname).clib" (C_tools.link_C_library "%(path)lib%(libname).clib" ("%(path)lib%(libname)"-.-ext_lib) "%(path)%(libname)");; @@ -382,12 +404,21 @@ atomize !Options.ocaml_cflags end;; +flag ["c"; "compile"] begin + atomize !Options.ocaml_cflags +end;; + flag ["ocaml"; "link"] begin atomize !Options.ocaml_lflags end;; +flag ["c"; "link"] begin + atomize !Options.ocaml_lflags +end;; + flag ["ocaml"; "ocamlyacc"] (atomize !Options.ocaml_yaccflags);; flag ["ocaml"; "menhir"] (atomize !Options.ocaml_yaccflags);; +flag ["ocaml"; "doc"] (atomize !Options.ocaml_docflags);; (* Tell menhir to explain conflicts *) flag [ "ocaml" ; "menhir" ; "explain" ] (S[A "--explain"]);; @@ -434,7 +465,7 @@ (* tags package(X), predicate(X) and syntax(X) *) List.iter begin fun tags -> pflag tags "package" (fun pkg -> S [A "-package"; A pkg]); - pflag tags "predicate" (fun pkg -> S [A "-predicate"; A pkg]); + pflag tags "predicate" (fun pkg -> S [A "-predicates"; A pkg]); pflag tags "syntax" (fun pkg -> S [A "-syntax"; A pkg]) end all_tags end else begin @@ -453,6 +484,8 @@ let () = pflag ["ocaml"; "native"; "compile"] "for-pack" (fun param -> S [A "-for-pack"; A param]); + pflag ["ocaml"; "native"; "pack"] "for-pack" + (fun param -> S [A "-for-pack"; A param]); pflag ["ocaml"; "native"; "compile"] "inline" (fun param -> S [A "-inline"; A param]); pflag ["ocaml"; "compile"] "pp" @@ -462,14 +495,20 @@ pflag ["ocaml"; "doc"] "pp" (fun param -> S [A "-pp"; A param]); pflag ["ocaml"; "infer_interface"] "pp" - (fun param -> S [A "-pp"; A param]) + (fun param -> S [A "-pp"; A param]); + pflag ["ocaml";"compile";] "warn" + (fun param -> S [A "-w"; A param]) let camlp4_flags camlp4s = List.iter begin fun camlp4 -> flag ["ocaml"; "pp"; camlp4] (A camlp4) end camlp4s;; -camlp4_flags ["camlp4o"; "camlp4r"; "camlp4of"; "camlp4rf"; "camlp4orf"; "camlp4oof"];; +let p4_series = ["camlp4o"; "camlp4r"; "camlp4of"; "camlp4rf"; "camlp4orf"; "camlp4oof"];; +let p4_opt_series = List.map (fun f -> f ^ ".opt") p4_series;; + +camlp4_flags p4_series;; +camlp4_flags p4_opt_series;; let camlp4_flags' camlp4s = List.iter begin fun (camlp4, flags) -> @@ -513,9 +552,15 @@ flag ["ocaml"; "link"; "byte"; "output_obj"] (A"-output-obj");; flag ["ocaml"; "dtypes"; "compile"] (A "-dtypes");; flag ["ocaml"; "annot"; "compile"] (A "-annot");; +flag ["ocaml"; "bin_annot"; "compile"] (A "-bin-annot");; +flag ["ocaml"; "short_paths"; "compile"] (A "-short-paths");; +flag ["ocaml"; "short_paths"; "infer_interface"] (A "-short-paths");; flag ["ocaml"; "rectypes"; "compile"] (A "-rectypes");; flag ["ocaml"; "rectypes"; "infer_interface"] (A "-rectypes");; flag ["ocaml"; "rectypes"; "doc"] (A "-rectypes");; +flag ["ocaml"; "rectypes"; "pack"] (A "-rectypes");; +flag ["ocaml"; "principal"; "compile"] (A "-principal");; +flag ["ocaml"; "principal"; "infer_interface"] (A "-principal");; flag ["ocaml"; "linkall"; "link"] (A "-linkall");; flag ["ocaml"; "link"; "profile"; "native"] (A "-p");; flag ["ocaml"; "link"; "program"; "custom"; "byte"] (A "-custom");; @@ -524,12 +569,13 @@ (* threads, with or without findlib *) flag ["ocaml"; "compile"; "thread"] (A "-thread");; +flag ["ocaml"; "link"; "thread"] (A "-thread");; if not !Options.use_ocamlfind then begin flag ["ocaml"; "doc"; "thread"] (S[A"-I"; A"+threads"]); - flag ["ocaml"; "link"; "thread"; "native"; "program"] (S[A "threads.cmxa"; A "-thread"]); - flag ["ocaml"; "link"; "thread"; "byte"; "program"] (S[A "threads.cma"; A "-thread"]) -end else begin - flag ["ocaml"; "link"; "thread"; "program"] (A "-thread") + flag ["ocaml"; "link"; "thread"; "native"; "program"] (A "threads.cmxa"); + flag ["ocaml"; "link"; "thread"; "byte"; "program"] (A "threads.cma"); + flag ["ocaml"; "link"; "thread"; "native"; "toplevel"] (A "threads.cmxa"); + flag ["ocaml"; "link"; "thread"; "byte"; "toplevel"] (A "threads.cma"); end;; flag ["ocaml"; "compile"; "nopervasives"] (A"-nopervasives");; @@ -548,7 +594,10 @@ flag ["ocaml"; "compile"; sprintf "warn_error_%c" (Char.lowercase c)] (S[A"-warn-error"; A (sprintf "%c" (Char.lowercase c))]);; -List.iter ocaml_warn_flag ['A'; 'C'; 'D'; 'E'; 'F'; 'L'; 'M'; 'P'; 'R'; 'S'; 'U'; 'V'; 'Y'; 'Z'; 'X'];; +List.iter ocaml_warn_flag ['A'; 'C'; 'D'; 'E'; 'F'; 'K'; 'L'; 'M'; 'P'; 'R'; 'S'; 'U'; 'V'; 'X'; 'Y'; 'Z'];; + +flag ["ocaml"; "compile"; "strict-sequence"] (A "-strict-sequence");; +flag ["ocaml"; "compile"; "strict_sequence"] (A "-strict-sequence");; flag ["ocaml"; "doc"; "docdir"; "extension:html"] (A"-html");; flag ["ocaml"; "doc"; "docdir"; "manpage"] (A"-man");; diff -Nru ocaml-3.12.1/ocamlbuild/ocaml_specific.mli ocaml-4.01.0/ocamlbuild/ocaml_specific.mli --- ocaml-3.12.1/ocamlbuild/ocaml_specific.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocaml_specific.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/ocaml_tools.ml ocaml-4.01.0/ocamlbuild/ocaml_tools.ml --- ocaml-3.12.1/ocamlbuild/ocaml_tools.ml 2010-11-29 10:55:22.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocaml_tools.ml 2012-09-21 15:16:24.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -93,16 +94,19 @@ let tags = tags_of_pathname ml++"ocaml" in Ocaml_compiler.prepare_compile build ml; Cmd(S[!Options.ocamlc; ocaml_ppflags tags; ocaml_include_flags ml; A"-i"; + (if Tags.mem "thread" tags then A"-thread" else N); T(tags++"infer_interface"); P ml; Sh">"; Px mli]) let menhir mly env build = let mly = env mly in let menhir = if !Options.ocamlyacc = N then V"MENHIR" else !Options.ocamlyacc in + let tags = tags_of_pathname mly in + let ocamlc_tags = tags++"ocaml"++"byte"++"compile" in + let menhir_tags = tags++"ocaml"++"parser"++"menhir" in Ocaml_compiler.prepare_compile build mly; Cmd(S[menhir; - A"--ocamlc"; Quote(S[!Options.ocamlc; ocaml_include_flags mly]); - T(tags_of_pathname mly++"ocaml"++"parser"++"menhir"); - A"--infer"; Px mly]) + A"--ocamlc"; Quote(S[!Options.ocamlc; T ocamlc_tags; ocaml_include_flags mly]); + T menhir_tags; A"--infer"; Px mly]) let ocamldoc_c tags arg odoc = let tags = tags++"ocaml" in diff -Nru ocaml-3.12.1/ocamlbuild/ocaml_tools.mli ocaml-4.01.0/ocamlbuild/ocaml_tools.mli --- ocaml-3.12.1/ocamlbuild/ocaml_tools.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocaml_tools.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/ocaml_utils.ml ocaml-4.01.0/ocamlbuild/ocaml_utils.ml --- ocaml-3.12.1/ocamlbuild/ocaml_utils.ml 2010-01-22 14:36:57.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocaml_utils.ml 2013-01-16 07:36:07.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -29,8 +30,7 @@ dep tags ps let stdlib_dir = lazy begin - (* FIXME *) - let ocamlc_where = sprintf "%s/ocamlc.where" (Pathname.pwd / !Options.build_dir) in + let ocamlc_where = !Options.build_dir / (Pathname.mk "ocamlc.where") in let () = Command.execute ~quiet:true (Cmd(S[!Options.ocamlc; A"-where"; Sh">"; P ocamlc_where])) in String.chomp (read_file ocamlc_where) end @@ -65,17 +65,18 @@ end else if ignore_stdlib x then `just_try else `mandatory -let expand_module include_dirs module_name exts = - let dirname = Pathname.dirname module_name in - let basename = Pathname.basename module_name in - let module_name_cap = dirname/(String.capitalize basename) in - let module_name_uncap = dirname/(String.uncapitalize basename) in - List.fold_right begin fun include_dir -> - List.fold_right begin fun ext acc -> - include_dir/(module_name_uncap-.-ext) :: - include_dir/(module_name_cap-.-ext) :: acc - end exts - end include_dirs [] +let expand_module = + memo3 (fun include_dirs module_name exts -> + let dirname = Pathname.dirname module_name in + let basename = Pathname.basename module_name in + let module_name_cap = dirname/(String.capitalize basename) in + let module_name_uncap = dirname/(String.uncapitalize basename) in + List.fold_right begin fun include_dir -> + List.fold_right begin fun ext acc -> + include_dir/(module_name_uncap-.-ext) :: + include_dir/(module_name_cap-.-ext) :: acc + end exts + end include_dirs []) let string_list_of_file file = with_input_file file begin fun ic -> @@ -145,7 +146,7 @@ with_input_file depends begin fun ic -> let ocamldep_output = try Lexers.ocamldep_output (Lexing.from_channel ic) - with Lexers.Error msg -> raise (Ocamldep_error(Printf.sprintf "Ocamldep.ocamldep: bad output (%s)" msg)) in + with Lexers.Error (msg,_) -> raise (Ocamldep_error(Printf.sprintf "Ocamldep.ocamldep: bad output (%s)" msg)) in let deps = List.fold_right begin fun (path, deps) acc -> let module_name' = module_name_of_pathname path in diff -Nru ocaml-3.12.1/ocamlbuild/ocaml_utils.mli ocaml-4.01.0/ocamlbuild/ocaml_utils.mli --- ocaml-3.12.1/ocamlbuild/ocaml_utils.mli 2010-01-22 14:36:57.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocaml_utils.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/ocamlbuild-presentation.rslide ocaml-4.01.0/ocamlbuild/ocamlbuild-presentation.rslide --- ocaml-3.12.1/ocamlbuild/ocamlbuild-presentation.rslide 2010-01-20 16:26:46.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocamlbuild-presentation.rslide 1970-01-01 00:00:00.000000000 +0000 @@ -1,350 +0,0 @@ -# Works with rslide revision 8 -# http://gallium.inria.fr/~pouillar/rslide/rslide -documentclass :beamer, :t, :compress, :red -usepackage :inputenc, :utf8 - -words "**OCaml**", "**ocamlbuild**", "_Makefile_" - -title "ocamlbuild" -subtitle "a compilation manager for OCaml projects" -authors "Berke Durak", "Nicolas Pouillard" -institute do - > @@Berke.Durak@inria.fr@@ - hfill - > @@Nicolas.Pouillard@inria.fr@@ -end - -usetheme :JuanLesPins -usefonttheme :serif -beamer_header '\setbeamercolor*{titlelike}{parent=structure}' -at_begin_section do - slide "Outline" do - tableofcontents 'sectionstyle=show/shaded', - 'subsectionstyle=show/shaded/hide' - end -end -beamer_footline 50, 0 - -extend do - def code_caml *a, &b - latex_only.small.code_inline(*a, &b) - html_only.code(*a, &b) - end - def code_tags *a, &b - latex_only.small.code_inline(*a, &b) - html_only.code(*a, &b) - end -end - -html_only do - paragraph.huge1 "Warning: this presentation has a degraded style compared to the Beamer/PDF version" -end - -short_version = true - -maketitle - -h1 "Introduction" - -slide "Why such a tool?", '<+->' do - * To make our OCaml life easier - * To stop writing poor MakefileS - * To have a tool that Just worksâ„¢ -end - -slide "What does ocamlbuild handle?", '<+->' do - - box "Regular OCaml projects of arbitrary size" do - > Trivially handled using the command line options. - end - - box "Mostly regular OCaml projects with common exceptions" do - > Requires writing one tag file (__tags_) that declares those exceptions. - end - - box "Almost any project" do - > Accomplished by writing an ocamlbuild plugin. - end - -end - -slide "What does ocamlbuild provide?" do - list do - overlay 1,2 do - * Automated whole-project compilation - * Minimal recompilation - * Lots of useful targets (doc, debugging, profiling...) - * Supports multiple build directories - * Automatic and safe cleaning - * A source directory uncluttered by object files - * A portable tool shipped with OCaml - end - overlay 2 do - * Saves time and money! - end - end -end - -h1 "Regular OCaml projects" - -slide "What's a regular OCaml project?" do - box "It's a project that needs no exceptions from the standard rules:" do - * Has compilation units (_ml_ and _mli_ files) - * May have parsers and lexers (_mly_ and _mll_ files) - * May use packages, libraries and toplevels (_ml{pack,lib,top}_) - * May link with external libraries - * Has one main OCaml unit from which these units are reachable - end -end - -slide "How difficult is it to build regular projects by hand?" do - box "OCaml has subtle compilation rules" do - * Interfaces (_.mli_) can be absent, yet buildable (_.mly_) - * Native and bytecode suffixes and settings differ - * Native packages are difficult to do (_-for-pack_) - * Linkage order must be correctly computed - * Include directories must be ordered - * _ocamldep_ gives partial information (too conservative) - end -end - -slide "How does ocamlbuild manage all that?" do - > It has a lot of hand-crafted Ocaml-specific compilation logic! - box "A dynamic exploration approach", '<2>' do - * Start from the given targets - * Attempt to discover dependencies using _ocamldep_ - * _ocamldep_ cannot always be trusted: backtrack if necessary - * Launch compilations and discover more dependencies - end -end - -unless short_version -slide "Demo..." do - box "Many projects can be compiled with a single command:" do - * Menhir: _ocamlbuild -lib unix back.native_ - * Hevea: _ocamlbuild latexmain.native_ - * Ergo: _ocamlbuild main.native_ - * Ocamlgraph: _ocamlbuild -cflags -for-pack,Ocamlgraph demo.native_ - * ... - end - box "To be fair..." do - > Some of these projects require that a _version.ml_ - or _stdlib.ml_ file be generated beforehand. - end -end -end - -h1 "Dealing with exceptions to standard rules" - -slide "What's an exception?" do - box "Files that need specific flags" do - * Warnings to be enabled or disabled - * Debugging (_-g_), profiling (_-p_), type annotation, - recursive types, _-linkall_, _-thread_, _-custom_... - end - list do - * Units that need external C libraries - * Binaries that need external OCaml libraries - * Directories that must be included or excluded - * Dependencies that cannot be discovered - end -end - -slide "_Make_ and exceptions" do - * The _make_ tool can't handle exceptions very well - * Needs exceptions to be encoded as specific rules - * This generally makes rules and exceptions tightly bound by variables - * This creates non-modular makefiles that don't *scale* -end - -slide "The tags, our way to specify exceptions", 'fragile=singleslide' do - list do - * Tagging is made in _tags files - * Each line is made of a pattern and a list of signed tags - * A line adds or removes tags from matching files - * Patterns are boolean combinations of shell-like globbing expressions - end - code_tags do - : "funny.ml": rectypes - ~<**/*.ml*>~: warn_A, warn_error_A, debug, annot - "foo.ml" or "bar.ml": warn_v, warn_error_v - "vendor.ml": -warn_A, -warn_error_A - : use_unix - "main.byte": use_dynlink, linkall - "test": not_hygienic - : precious - end -end - -slide "How tags and rules give commands", 'fragile=singleslide' do - box "Files are tagged using tagging rules" do - code_tags do - : "foo/bar.ml": rectypes - end - end - box "Rules then produce commands with *tagged holes*" do - code_caml do - : let tagged_hole = - tags_for(ml)++"ocaml"++"compile"++"byte" in - Cmd(S[A"ocamlc";A"-c";T tagged_hole;P ml;A"-o";P cmo]) - end - end - box "These holes are filled by command fragments (such as flags)" do - code_caml do - : flag ["ocaml"; "compile"; "byte"; "rectypes"] - (A"-rectypes") - end - end -end - -slide "Tags and dependencies", 'fragile=singleslide' do - box "One can define dependencies triggered by combinations of tags" do - code_caml do - : dep ["ocaml"; "link"; "byte"; "program"; "plugin:foo"] - ["plugin/pluginlib.cma"; "plugin/plugin_foo.cmo"] - end - end - box "By tagging files we make things happen" do - code_tags do - : "test.byte": plugin:foo - end - end -end - -h1 "Writing an ocamlbuild plugin" - -slide "Not a specific language, but plain OCaml code" do - list do - * Plugins are compiled on the fly - * Dynamic configuration is feasible - end - box "With a plugin one can:" do - * Extend rules (add new ones, override old ones) - * Add flags and dependencies based on tags - * Tag files - * Change options - * Define the directory structure precisely - * Help _ocamldep_ - * Specify external libraries - end -end - -unless short_version -slide "A plugin example" do - > Let's read it in live... -end -end - -# slide "ocamlbuild scales" do -# > Indeed ocamlbuild is used as an experimental replacement in OCaml itself. -# end - -h1 "General features" - -slide "Parallel execution where applicable" do - * You select the maximum number of jobs (_-j N_) - * Rules know how to ask for parallel targets - * The system keeps things scheduled correctly - * Example: Separate compilation of byte code - * (Optimal scheduling would require a static graph) -end - -unless short_version -slide "A status bar for your visual comfort" do - list do - * Compilation tools echo commands and their output - * This creates a long and boring output that scrolls too fast - * Here you can keep an eye on what is going on! - * It succinctly displays time, number of targets, and tags - * Command outputs are correctly multiplexed - * A trace of the commands executed is kept in a log file - * This log file can be used as the basis of a shell script - end - latex_only.example do - invisible_join do - count = 0 - mod = 1 - File.read("manual/trace.out").each do |line| - count += 1 - next if count % mod != 0 - line.gsub!("\\", "|") - line.latex_encode! - line.gsub!(/( +)/) { "\\hspace{#{0.49 * $1.size}em}" } - line.chomp! - s = "\\only<#{count / mod}>{\\tt #{line}}%\n" - verbatim_text s - end - end - end -end - -slide "Hygiene and sterilization" do - > ocamlbuild has a Hygiene Squad (HS) that checks your source tree for cleanliness - box "It has preconceived but useful cleanliness notions", '<1->' do - * Files dirty by default: _.cmi_, _.cmo_, _.cma_, _.cmx_... - * _ocamllex_/_ocamlyacc_ files: _.ml_ *if* _.mll_, _.ml_&_.mli_ *if* _.mly_... - end - box "If unsatisfied, the HS produces a sterilization script", '<2->' do - * Read it carefully (or work with versioning) - * Run at your own risks - end - box "HS can be told of exceptions", '<3->' do - > Files or directories tagged as __not_hygienic__ or _precious_. - end -end -end - -slide "Some supported tools" do - box "_Menhir_ as an _ocamlyacc_ replacement", '<1->' do - * Enabled with the __use_menhir__ global tag or the __-use-menhir__ option - * Handles implicit dependencies using _--infer_ - end - box "_Ocamldoc_ to build your doc", '<2->' do - * Separated construction using (_-dump_/_-load_) - * Handles ??HTML??, ??LaTeX??, ??Man??, ??Dot??, ??TeXi?? - end - # box "_ocamlmklib_, _ocamlmktop_" do - # > Basic support using _.mllib_ and _.mltop_ files - # end - box "_Camlp4_ aware", '<3->' do - * Tags allow to setup any installed _Camlp4_ preprocessor - * Fine grained dependencies help a lot... - end -end - -h1 "Conclusion" - -slide "Resume" do - box "ocamlbuild can be used in three ways:", '<1->' do - * With only command-line options for fully regular projects - * With the __tags_ file for intermediate projects - * With a plugin for the most complex projects - end - box "ocamlbuild saves your time by:", '<2->' do - * Building your project gently - * Compiling only as necessary - * Running commands in parallel - * Keeping your house clean - * Letting you concentrate on your code! - end -end - -unless short_version -slide "Acknowledgments" do - box "For enlightening discussions about OCaml internals:", '<1->' do - * Xavier Leroy - * Damien Doligez - end - box "For his insights about OCaml dependencies:", '<2->' do - * Alain Frisch - end - box "For letting this happen:", '<3->' do - * Michel Mauny - end -end - -slide "Conclusion", '<+->' do - * ocamlbuild is not perfect but already damn useful - * Try it now! It's in OCaml 3.10! -end -end diff -Nru ocaml-3.12.1/ocamlbuild/ocamlbuild.ml ocaml-4.01.0/ocamlbuild/ocamlbuild.ml --- ocaml-3.12.1/ocamlbuild/ocamlbuild.ml 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocamlbuild.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/ocamlbuild.mli ocaml-4.01.0/ocamlbuild/ocamlbuild.mli --- ocaml-3.12.1/ocamlbuild/ocamlbuild.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocamlbuild.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/ocamlbuild.odocl ocaml-4.01.0/ocamlbuild/ocamlbuild.odocl --- ocaml-3.12.1/ocamlbuild/ocamlbuild.odocl 2010-02-03 10:25:51.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocamlbuild.odocl 2013-01-01 00:33:26.000000000 +0000 @@ -1,7 +1,6 @@ Log My_unix My_std -Std_signatures Signatures Shell Display @@ -39,4 +38,4 @@ Exit_codes Digest_cache Ocamlbuild_plugin -Findlib \ No newline at end of file +Findlib diff -Nru ocaml-3.12.1/ocamlbuild/ocamlbuild_executor.ml ocaml-4.01.0/ocamlbuild/ocamlbuild_executor.ml --- ocaml-3.12.1/ocamlbuild/ocamlbuild_executor.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocamlbuild_executor.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/ocamlbuild_executor.mli ocaml-4.01.0/ocamlbuild/ocamlbuild_executor.mli --- ocaml-3.12.1/ocamlbuild/ocamlbuild_executor.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocamlbuild_executor.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/ocamlbuild_pack.mlpack ocaml-4.01.0/ocamlbuild/ocamlbuild_pack.mlpack --- ocaml-3.12.1/ocamlbuild/ocamlbuild_pack.mlpack 2011-05-30 09:07:12.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocamlbuild_pack.mlpack 2012-07-30 18:04:46.000000000 +0000 @@ -38,4 +38,4 @@ Exit_codes Digest_cache Findlib -Param_tags \ No newline at end of file +Param_tags diff -Nru ocaml-3.12.1/ocamlbuild/ocamlbuild_plugin.ml ocaml-4.01.0/ocamlbuild/ocamlbuild_plugin.ml --- ocaml-3.12.1/ocamlbuild/ocamlbuild_plugin.ml 2010-01-22 14:46:27.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocamlbuild_plugin.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/ocamlbuild_plugin.mli ocaml-4.01.0/ocamlbuild/ocamlbuild_plugin.mli --- ocaml-3.12.1/ocamlbuild/ocamlbuild_plugin.mli 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocamlbuild_plugin.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,3 +1,15 @@ +(***********************************************************************) +(* *) +(* ocamlbuild *) +(* *) +(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + include Ocamlbuild_pack.Signatures.PLUGIN with module Pathname = Ocamlbuild_pack.Pathname and module Outcome = Ocamlbuild_pack.My_std.Outcome diff -Nru ocaml-3.12.1/ocamlbuild/ocamlbuild_unix_plugin.ml ocaml-4.01.0/ocamlbuild/ocamlbuild_unix_plugin.ml --- ocaml-3.12.1/ocamlbuild/ocamlbuild_unix_plugin.ml 2010-06-12 07:49:14.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocamlbuild_unix_plugin.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/ocamlbuild_unix_plugin.mli ocaml-4.01.0/ocamlbuild/ocamlbuild_unix_plugin.mli --- ocaml-3.12.1/ocamlbuild/ocamlbuild_unix_plugin.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocamlbuild_unix_plugin.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/ocamlbuild_where.ml ocaml-4.01.0/ocamlbuild/ocamlbuild_where.ml --- ocaml-3.12.1/ocamlbuild/ocamlbuild_where.ml 2009-05-24 09:11:39.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocamlbuild_where.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,3 +1,15 @@ +(***********************************************************************) +(* *) +(* ocamlbuild *) +(* *) +(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + let bindir = ref Ocamlbuild_Myocamlbuild_config.bindir;; let libdir = ref begin Filename.concat diff -Nru ocaml-3.12.1/ocamlbuild/ocamlbuild_where.mli ocaml-4.01.0/ocamlbuild/ocamlbuild_where.mli --- ocaml-3.12.1/ocamlbuild/ocamlbuild_where.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocamlbuild_where.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/ocamlbuildlight.ml ocaml-4.01.0/ocamlbuild/ocamlbuildlight.ml --- ocaml-3.12.1/ocamlbuild/ocamlbuildlight.ml 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocamlbuildlight.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/ocamlbuildlight.mli ocaml-4.01.0/ocamlbuild/ocamlbuildlight.mli --- ocaml-3.12.1/ocamlbuild/ocamlbuildlight.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ocamlbuildlight.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/options.ml ocaml-4.01.0/ocamlbuild/options.ml --- ocaml-3.12.1/ocamlbuild/options.ml 2011-02-15 13:42:34.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/options.ml 2013-08-24 20:46:22.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -22,7 +23,7 @@ open Command let entry = ref None -let build_dir = ref "_build" +let build_dir = ref (Filename.concat (Sys.getcwd ()) "_build") let include_dirs = ref [] let exclude_dirs = ref [] let nothing_should_be_rebuilt = ref false @@ -39,24 +40,42 @@ let catch_errors = ref true let use_ocamlfind = ref false -let mk_virtual_solvers = +(* Currently only ocamlfind and menhir is defined as no-core tool, + perhaps later we need something better *) +let is_core_tool = function "ocamlfind" | "menhir" -> false | _ -> true + +let find_tool cmd = let dir = Ocamlbuild_where.bindir in + let core_tool = is_core_tool cmd in + let opt = cmd ^ ".opt" in + let search_in_path = memo Command.search_in_path in + if sys_file_exists !dir then + let long = filename_concat !dir cmd in + let long_opt = long ^ ".opt" in + (* This defines how the command will be found *) + let choices = + [(fun () -> if file_or_exe_exists long_opt then Some long_opt else None); + (fun () -> if file_or_exe_exists long then Some long else None)] in + (* For non core tool the preference is too look at PATH first *) + let choices' = + [fun () -> + try let _ = search_in_path opt in Some opt + with Not_found -> Some cmd] + in + let choices = if core_tool then choices @ choices' else choices' @ choices in + try + match (List.find (fun choice -> not (choice () = None)) choices) () with + Some cmd -> cmd + | None -> raise Not_found + with Not_found -> failwith (Printf.sprintf "Can't find tool: %s" cmd) + else + try let _ = search_in_path opt in opt + with Not_found -> cmd + +let mk_virtual_solvers = List.iter begin fun cmd -> - let opt = cmd ^ ".opt" in - let a_opt = A opt in - let a_cmd = A cmd in - let search_in_path = memo Command.search_in_path in let solver () = - if sys_file_exists !dir then - let long = filename_concat !dir cmd in - let long_opt = long ^ ".opt" in - if sys_file_exists long_opt then A long_opt - else if sys_file_exists long then A long - else try let _ = search_in_path opt in a_opt - with Not_found -> a_cmd - else - try let _ = search_in_path opt in a_opt - with Not_found -> a_cmd + A (find_tool cmd) in Command.setup_virtual_command_solver (String.uppercase cmd) solver end @@ -87,8 +106,10 @@ let ocaml_libs_internal = ref [] let ocaml_mods_internal = ref [] let ocaml_pkgs_internal = ref [] +let ocaml_syntax = ref None let ocaml_lflags_internal = ref [] let ocaml_cflags_internal = ref [] +let ocaml_docflags_internal = ref [] let ocaml_ppflags_internal = ref [] let ocaml_yaccflags_internal = ref [] let ocaml_lexflags_internal = ref [] @@ -97,6 +118,7 @@ let tags_internal = ref [["quiet"]] let tag_lines_internal = ref [] let show_tags_internal = ref [] +let plugin_tags_internal = ref [] let log_file_internal = ref "_log" let my_include_dirs = ref [[Filename.current_dir_name]] @@ -126,7 +148,12 @@ else () let set_cmd rcmd = String (fun s -> rcmd := Sh s) -let set_build_dir s = make_links := false; build_dir := s +let set_build_dir s = + make_links := false; + if Filename.is_relative s then + build_dir := Filename.concat (Sys.getcwd ()) s + else + build_dir := s let spec = ref ( Arg.align [ @@ -134,7 +161,7 @@ "-vnum", Unit (fun () -> print_endline Sys.ocaml_version; raise Exit_OK), " Display the version number"; "-quiet", Unit (fun () -> Log.level := 0), " Make as quiet as possible"; - "-verbose", Int (fun i -> Log.level := i + 2), " Set the verbosity level"; + "-verbose", Int (fun i -> Log.classic_display := true; Log.level := i + 2), " Set the verbosity level"; "-documentation", Set show_documentation, " Show rules and flags"; "-log", Set_string log_file_internal, " Set log file"; "-no-log", Unit (fun () -> log_file_internal := ""), " No log file"; @@ -153,10 +180,13 @@ "-pkg", String (add_to' ocaml_pkgs_internal), " Link to this ocaml findlib package"; "-pkgs", String (add_to ocaml_pkgs_internal), " (idem)"; "-package", String (add_to' ocaml_pkgs_internal), " (idem)"; + "-syntax", String (fun syntax -> ocaml_syntax := Some syntax), " Specify syntax using ocamlfind"; "-lflag", String (add_to' ocaml_lflags_internal), " Add to ocamlc link flags"; "-lflags", String (add_to ocaml_lflags_internal), " (idem)"; "-cflag", String (add_to' ocaml_cflags_internal), " Add to ocamlc compile flags"; "-cflags", String (add_to ocaml_cflags_internal), " (idem)"; + "-docflag", String (add_to' ocaml_docflags_internal), " Add to ocamldoc flags"; + "-docflags", String (add_to ocaml_docflags_internal), " (idem)"; "-yaccflag", String (add_to' ocaml_yaccflags_internal), " Add to ocamlyacc flags"; "-yaccflags", String (add_to ocaml_yaccflags_internal), " (idem)"; "-lexflag", String (add_to' ocaml_lexflags_internal), " Add to ocamllex flags"; @@ -165,6 +195,8 @@ "-pp", String (add_to ocaml_ppflags_internal), " (idem)"; "-tag", String (add_to' tags_internal), " Add to default tags"; "-tags", String (add_to tags_internal), " (idem)"; + "-plugin-tag", String (add_to' plugin_tags_internal), " Use this tag when compiling the myocamlbuild.ml plugin"; + "-plugin-tags", String (add_to plugin_tags_internal), " (idem)"; "-tag-line", String (add_to' tag_lines_internal), " Use this line of tags (as in _tags)"; "-show-tags", String (add_to' show_tags_internal), " Show tags that applies on that pathname"; @@ -192,7 +224,7 @@ "-install-lib-dir", Set_string Ocamlbuild_where.libdir, " Set the install library directory"; "-install-bin-dir", Set_string Ocamlbuild_where.bindir, " Set the install binary directory"; "-where", Unit (fun () -> print_endline !Ocamlbuild_where.libdir; raise Exit_OK), " Display the install library directory"; - + "-which", String (fun cmd -> print_endline (find_tool cmd); raise Exit_OK), " Display path to the tool command"; "-ocamlc", set_cmd ocamlc, " Set the OCaml bytecode compiler"; "-ocamlopt", set_cmd ocamlopt, " Set the OCaml native compiler"; "-ocamldep", set_cmd ocamldep, " Set the OCaml dependency tool"; @@ -219,6 +251,7 @@ let ocaml_lflags = ref [] let ocaml_cflags = ref [] let ocaml_ppflags = ref [] +let ocaml_docflags = ref [] let ocaml_yaccflags = ref [] let ocaml_lexflags = ref [] let program_args = ref [] @@ -226,6 +259,7 @@ let tags = ref [] let tag_lines = ref [] let show_tags = ref [] +let plugin_tags = ref [] let init () = let anon_fun = add_to' targets_internal in @@ -267,6 +301,7 @@ reorder ocaml_cflags ocaml_cflags_internal; reorder ocaml_lflags ocaml_lflags_internal; reorder ocaml_ppflags ocaml_ppflags_internal; + reorder ocaml_docflags ocaml_docflags_internal; reorder ocaml_yaccflags ocaml_yaccflags_internal; reorder ocaml_lexflags ocaml_lexflags_internal; reorder program_args program_args_internal; @@ -274,6 +309,7 @@ reorder tag_lines tag_lines_internal; reorder ignore_list ignore_list_internal; reorder show_tags show_tags_internal; + reorder plugin_tags plugin_tags_internal; let check_dir dir = if Filename.is_implicit dir then diff -Nru ocaml-3.12.1/ocamlbuild/options.mli ocaml-4.01.0/ocamlbuild/options.mli --- ocaml-3.12.1/ocamlbuild/options.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/options.mli 2013-08-24 20:46:22.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -14,5 +15,12 @@ include Signatures.OPTIONS with type command_spec = Command.spec +(* this option is not in Signatures.OPTIONS yet because adding tags to + the compilation of the plugin is a recent feature that may still be + subject to change, so the interface may not be stable; besides, + there is obviously little to gain from tweaking that option from + inside the plugin itself... *) +val plugin_tags : string list ref + val entry : bool Slurp.entry option ref val init : unit -> unit diff -Nru ocaml-3.12.1/ocamlbuild/param_tags.ml ocaml-4.01.0/ocamlbuild/param_tags.ml --- ocaml-3.12.1/ocamlbuild/param_tags.ml 2010-01-25 08:16:23.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/param_tags.ml 2013-08-19 07:41:09.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -13,15 +14,11 @@ (* Original author: Romain Bardou *) module StringSet = Set.Make(String) -module SSOSet = Set.Make(struct - type t = string * string option - let compare = Pervasives.compare -end) (* tag name -> tag action (string -> unit) *) let declared_tags = Hashtbl.create 17 -let acknowledged_tags = ref SSOSet.empty +let acknowledged_tags = ref [] let only_once f = let instances = ref StringSet.empty in @@ -35,22 +32,27 @@ let declare name action = Hashtbl.add declared_tags name (only_once action) +let parse tag = Lexers.tag_gen (Lexing.from_string tag) + let acknowledge tag = - let tag = Lexers.tag_gen (Lexing.from_string tag) in - acknowledged_tags := SSOSet.add tag !acknowledged_tags + acknowledged_tags := parse tag :: !acknowledged_tags -let really_acknowledge (name, param) = +let really_acknowledge ?(quiet=false) (name, param) = match param with | None -> - if Hashtbl.mem declared_tags name then + if Hashtbl.mem declared_tags name && not quiet then Log.eprintf "Warning: tag %S expects a parameter" name | Some param -> let actions = List.rev (Hashtbl.find_all declared_tags name) in - if actions = [] then - Log.eprintf "Warning: tag %S does not expect a parameter, but is used with parameter %S" name param; + if actions = [] && not quiet then + Log.eprintf "Warning: tag %S does not expect a parameter, \ + but is used with parameter %S" name param; List.iter (fun f -> f param) actions +let partial_init ?quiet tags = + Tags.iter (fun tag -> really_acknowledge ?quiet (parse tag)) tags + let init () = - SSOSet.iter really_acknowledge !acknowledged_tags + List.iter really_acknowledge (My_std.List.ordered_unique !acknowledged_tags) let make = Printf.sprintf "%s(%s)" diff -Nru ocaml-3.12.1/ocamlbuild/param_tags.mli ocaml-4.01.0/ocamlbuild/param_tags.mli --- ocaml-3.12.1/ocamlbuild/param_tags.mli 2010-01-25 08:16:23.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/param_tags.mli 2013-08-19 07:41:09.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -31,10 +32,17 @@ val init: unit -> unit (** Initialize parameterized tags. - -Call this function once all tags have been [declare]d and [acknowledge]d. -If you [declare] or [acknowledge] a tag after having called [init], this will -have no effect. [init] should only be called once. *) + +This will make effective all instantiations [foo(bar)] such that the +parametrized tag [foo] has been [declare]d and [foo(bar)] has been +[acknowledge]d after the last [init] call. *) + +val partial_init: ?quiet:bool -> Tags.t -> unit +(** Initialize a list of tags + +This will make effective the instances [foo(bar)] appearing +in the given tag list, instead of those that have been +[acknowledged] previously. This is for system use only. *) val make: Tags.elt -> string -> Tags.elt (** Make a parameterized tag instance. diff -Nru ocaml-3.12.1/ocamlbuild/pathname.ml ocaml-4.01.0/ocamlbuild/pathname.ml --- ocaml-3.12.1/ocamlbuild/pathname.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/pathname.ml 2013-03-19 07:22:12.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -23,7 +24,7 @@ let concat = filename_concat -let compare = compare +let compare (x:t) y = compare x y let print = pp_print_string diff -Nru ocaml-3.12.1/ocamlbuild/pathname.mli ocaml-4.01.0/ocamlbuild/pathname.mli --- ocaml-3.12.1/ocamlbuild/pathname.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/pathname.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/plugin.ml ocaml-4.01.0/ocamlbuild/plugin.ml --- ocaml-3.12.1/ocamlbuild/plugin.ml 2011-02-15 13:42:34.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/plugin.ml 2013-09-06 11:36:18.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -21,18 +22,22 @@ open Command ;; + +let plugin = "myocamlbuild" +let plugin_file = plugin^".ml" +let plugin_config_file = plugin^"_config.ml" +let plugin_config_file_interface = plugin^"_config.mli" +let we_need_a_plugin () = !Options.plugin && sys_file_exists plugin_file +let we_have_a_plugin () = sys_file_exists ((!Options.build_dir/plugin)^(!Options.exe)) +let we_have_a_config_file () = sys_file_exists plugin_config_file +let we_have_a_config_file_interface () = sys_file_exists plugin_config_file_interface + module Make(U:sig end) = struct - let plugin = "myocamlbuild" - let plugin_file = plugin^".ml" - let plugin_config_file = plugin^"_config.ml" - let plugin_config_file_interface = plugin^"_config.mli" - - let we_have_a_config_file = sys_file_exists plugin_config_file - let we_need_a_plugin = !Options.plugin && sys_file_exists plugin_file - let we_have_a_plugin = sys_file_exists ((!Options.build_dir/plugin)^(!Options.exe)) - let we_have_a_config_file_interface = sys_file_exists plugin_config_file_interface - + let we_need_a_plugin = we_need_a_plugin () + let we_have_a_plugin = we_have_a_plugin () + let we_have_a_config_file = we_have_a_config_file () + let we_have_a_config_file_interface = we_have_a_config_file_interface () let up_to_date_or_copy fn = let fn' = !Options.build_dir/fn in Pathname.exists fn && @@ -44,14 +49,10 @@ end end - let profiling = Tags.mem "profile" (tags_of_pathname plugin_file) - - let debugging = Tags.mem "debug" (tags_of_pathname plugin_file) - let rebuild_plugin_if_needed () = let a = up_to_date_or_copy plugin_file in - let b = (not we_have_a_config_file) or up_to_date_or_copy plugin_config_file in - let c = (not we_have_a_config_file_interface) or up_to_date_or_copy plugin_config_file_interface in + let b = (not we_have_a_config_file) || up_to_date_or_copy plugin_config_file in + let c = (not we_have_a_config_file_interface) || up_to_date_or_copy plugin_config_file_interface in if a && b && c && we_have_a_plugin then () (* Up to date *) (* FIXME: remove ocamlbuild_config.ml in _build/ if removed in parent *) @@ -68,32 +69,169 @@ S[P plugin_config_file_interface; P plugin_config_file] else P plugin_config_file else N in - let cma, cmo, more_options, compiler = + + let cma, cmo, compiler, byte_or_native = if !Options.native_plugin then - "cmxa", "cmx", (if profiling then A"-p" else N), !Options.ocamlopt + "cmxa", "cmx", !Options.ocamlopt, "native" else - "cma", "cmo", (if debugging then A"-g" else N), !Options.ocamlc + "cma", "cmo", !Options.ocamlc, "byte" in - let ocamlbuildlib, ocamlbuild, libs = - if (not !Options.native_plugin) && !*My_unix.is_degraded then - "ocamlbuildlightlib", "ocamlbuildlight", N - else - "ocamlbuildlib", "ocamlbuild", A("unix"-.-cma) + + + let (unix_spec, ocamlbuild_lib_spec, ocamlbuild_module_spec) = + + let use_light_mode = + not !Options.native_plugin && !*My_unix.is_degraded in + let use_ocamlfind_pkgs = + !Options.use_ocamlfind && !Options.plugin_tags <> [] in + (* The plugin has the following dependencies that must be + included during compilation: + + - unix.cmxa, if it is available + - ocamlbuildlib.cm{a,xa}, the library part of ocamlbuild + - ocamlbuild.cm{o,x}, the module that performs the + initialization work of the ocamlbuild executable, using + modules of ocamlbuildlib.cmxa + + We pass all this stuff to the compilation command for the + plugin, with two independent important details to handle: + + (1) ocamlbuild is designed to still work in environments + where Unix is not available for some reason; in this + case, we should not link unix, and use the + "ocamlbuildlight.cmo" initialization module, which runs + a "light" version of ocamlbuild without unix. There is + also an ocamlbuildlightlib.cma archive to be used in that + case. + + The boolean variable [use_light_mode] tells us whether we + are in this unix-deprived scenario. + + (2) there are risks of compilation error due to + double-linking of native modules when the user passes its + own tags to the plugin compilation process (as was added + to support modular construction of + ocamlbuild plugins). Indeed, if we hard-code linking to + unix.cmxa in all cases, and the user + enables -use-ocamlfind and + passes -plugin-tag "package(unix)" (or package(foo) for + any foo which depends on unix), the command-line finally + executed will be + + ocamlfind ocamlopt unix.cmxa -package unix myocamlbuild.ml + + which fails with a compilation error due to doubly-passed + native modules. + + To sanest way to solve this problem at the ocamlbuild level + is to pass "-package unix" instead of unix.cmxa when we + detect that such a situation may happen. OCamlfind will see + that the same package is demanded twice, and only request + it once to the compiler. Similarly, we use "-package + ocamlbuild" instead of linking ocamlbuildlib.cmxa[1]. + + We switch to this behavior when two conditions, embodied in + the boolean variable [use_ocamlfind_pkgs], are met: + (a) use-ocamlfind is enabled + (b) the user is passing some plugin tags + + Condition (a) is overly conservative as the double-linking + issue may also happen in non-ocamlfind situations, such as + "-plugin-tags use_unix" -- but it's unclear how one would + avoid the issue in that case, except by documenting that + people should not do that, or getting rid of the + hard-linking logic entirely, with the corresponding risks + of regression. + + Condition (b) should not be necessary (we expect using + ocamlfind packages to work whenever ocamlfind + is available), but allows the behavior in absence + of -plugin-tags to be completely unchanged, to reassure us + about potential regressions introduced by this option. + + [1]: we may wonder whether to use "-package ocamlbuildlight" + in unix-deprived situations, but currently ocamlfind + doesn't know about the ocamlbuildlight library. As + a compromise we always use "-package ocamlbuild" when + use_ocamlfind_pkgs is set. An ocamlfind and -plugin-tags + user in unix-deprived environment may want to mutate the + META of ocamlbuild to point to ocamlbuildlightlib instead + of ocamlbuildlib. + *) + + let unix_lib = + if use_ocamlfind_pkgs then `Package "unix" + else if use_light_mode then `Nothing + else `Lib "unix" in + + let ocamlbuild_lib = + if use_ocamlfind_pkgs then `Package "ocamlbuild" + else if use_light_mode then `Local_lib "ocamlbuildlightlib" + else `Local_lib "ocamlbuildlib" in + + let ocamlbuild_module = + if use_light_mode then `Local_mod "ocamlbuildlight" + else `Local_mod "ocamlbuild" in + + let dir = !Ocamlbuild_where.libdir in + let dir = if Pathname.is_implicit dir then Pathname.pwd/dir else dir in + + let in_dir file = + let path = dir/file in + if not (sys_file_exists path) then failwith + (sprintf "Cannot find %S in ocamlbuild -where directory" file); + path in + + let spec = function + | `Nothing -> N + | `Package pkg -> S[A "-package"; A pkg] + | `Lib lib -> P (lib -.- cma) + | `Local_lib llib -> S [A "-I"; A dir; P (in_dir (llib -.- cma))] + | `Local_mod lmod -> P (in_dir (lmod -.- cmo)) in + + (spec unix_lib, spec ocamlbuild_lib, spec ocamlbuild_module) in - let ocamlbuildlib = ocamlbuildlib-.-cma in - let ocamlbuild = ocamlbuild-.-cmo in - let dir = !Ocamlbuild_where.libdir in - if not (sys_file_exists (dir/ocamlbuildlib)) then - failwith (sprintf "Cannot find %S in ocamlbuild -where directory" ocamlbuildlib); - let dir = if Pathname.is_implicit dir then Pathname.pwd/dir else dir in + + let plugin_tags = + Tags.of_list !Options.plugin_tags + ++ "ocaml" ++ "program" ++ "link" ++ byte_or_native in + + (* The plugin is compiled before [Param_tags.init()] is called + globally, which means that parametrized tags have not been + made effective yet. The [partial_init] calls below initializes + precisely those that will be used during the compilation of + the plugin, and no more. + *) + Param_tags.partial_init plugin_tags; + let cmd = - Cmd(S[compiler; A"-I"; P dir; libs; more_options; - P(dir/ocamlbuildlib); plugin_config; P plugin_file; - P(dir/ocamlbuild); A"-o"; Px (plugin^(!Options.exe))]) + (* The argument order is important: we carefully put the + plugin source files before the ocamlbuild.cm{o,x} module + doing the main initialization, so that user global + side-effects (setting options, installing flags..) are + performed brefore ocamlbuild's main routine. This is + a fragile thing to rely upon and we insist that our users + use the more robust [dispatch] registration instead, but + we still aren't going to break that now. + + For the same reason we place the user plugin-tags after + the plugin libraries (in case a tag would, say, inject + a .cmo that also relies on them), but before the main + plugin source file and ocamlbuild's initialization. *) + Cmd(S[compiler; + unix_spec; ocamlbuild_lib_spec; + T plugin_tags; + plugin_config; P plugin_file; + ocamlbuild_module_spec; + A"-o"; Px (plugin^(!Options.exe))]) in Shell.chdir !Options.build_dir; Shell.rm_f (plugin^(!Options.exe)); - Command.execute cmd + Command.execute cmd; + if !Options.just_plugin then begin + Log.finish (); + raise Exit_OK; + end; end let execute_plugin_if_needed () = @@ -101,13 +239,14 @@ begin rebuild_plugin_if_needed (); Shell.chdir Pathname.pwd; - if not !Options.just_plugin then - let runner = if !Options.native_plugin then N else !Options.ocamlrun in - let argv = List.tl (Array.to_list Sys.argv) in - let spec = S[runner; P(!Options.build_dir/plugin^(!Options.exe)); - A"-no-plugin"; atomize (List.filter (fun s -> s <> "-plugin-option") argv)] in - let () = Log.finish () in - raise (Exit_silently_with_code (sys_command (Command.string_of_command_spec spec))) + let runner = if !Options.native_plugin then N else !Options.ocamlrun in + let argv = List.tl (Array.to_list Sys.argv) in + let passed_argv = List.filter (fun s -> s <> "-plugin-option") argv in + let spec = S[runner; P(!Options.build_dir/plugin^(!Options.exe)); + A"-no-plugin"; atomize passed_argv] in + Log.finish (); + let rc = sys_command (Command.string_of_command_spec spec) in + raise (Exit_silently_with_code rc); end else () diff -Nru ocaml-3.12.1/ocamlbuild/plugin.mli ocaml-4.01.0/ocamlbuild/plugin.mli --- ocaml-3.12.1/ocamlbuild/plugin.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/plugin.mli 2013-08-13 11:39:25.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -14,3 +15,4 @@ (* Plugin *) val execute_plugin_if_needed : unit -> unit +val we_need_a_plugin : unit -> bool diff -Nru ocaml-3.12.1/ocamlbuild/ppcache.ml ocaml-4.01.0/ocamlbuild/ppcache.ml --- ocaml-3.12.1/ocamlbuild/ppcache.ml 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ppcache.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/ppcache.mli ocaml-4.01.0/ocamlbuild/ppcache.mli --- ocaml-3.12.1/ocamlbuild/ppcache.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/ppcache.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/report.ml ocaml-4.01.0/ocamlbuild/report.ml --- ocaml-3.12.1/ocamlbuild/report.ml 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/report.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/report.mli ocaml-4.01.0/ocamlbuild/report.mli --- ocaml-3.12.1/ocamlbuild/report.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/report.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/resource.ml ocaml-4.01.0/ocamlbuild/resource.ml --- ocaml-3.12.1/ocamlbuild/resource.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/resource.ml 2012-10-10 13:59:47.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -376,7 +377,7 @@ List.map begin fun x -> match x with | A atom -> atom - | V(var, _) -> List.assoc var env + | V(var, _) -> try List.assoc var env with Not_found -> (* unbound variable *) "" end s end end diff -Nru ocaml-3.12.1/ocamlbuild/resource.mli ocaml-4.01.0/ocamlbuild/resource.mli --- ocaml-3.12.1/ocamlbuild/resource.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/resource.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/rule.ml ocaml-4.01.0/ocamlbuild/rule.ml --- ocaml-3.12.1/ocamlbuild/rule.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/rule.ml 2013-08-13 11:34:03.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -160,7 +161,7 @@ begin match exists2 List.find Resource.Cache.resource_has_changed r.deps with | Some r -> (`cache_miss_changed_dep r, false) | _ -> - begin match exists2 Resources.find Resource.Cache.resource_has_changed dyndeps with + begin match exists2 Resources.find_elt Resource.Cache.resource_has_changed dyndeps with | Some r -> (`cache_miss_changed_dyn_dep r, false) | _ -> begin match cached_digest r with @@ -261,11 +262,11 @@ List.fold_right begin fun x acc -> let r = import x in if List.mem r acc then - failwith (sprintf "in rule %s, multiple occurences of the resource %s" name x) + failwith (sprintf "in rule %s, multiple occurrences of the resource %s" name x) else r :: acc end xs init in - if prods = [] && prod = None && stamp = None then raise (Exit_rule_error "Can't make a rule that produce nothing"); + if prods = [] && prod = None && stamp = None then raise (Exit_rule_error "Can't make a rule that produces nothing"); let stamp, prods = match stamp with | None -> None, prods diff -Nru ocaml-3.12.1/ocamlbuild/rule.mli ocaml-4.01.0/ocamlbuild/rule.mli --- ocaml-3.12.1/ocamlbuild/rule.mli 2010-01-20 16:26:46.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/rule.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/shell.ml ocaml-4.01.0/ocamlbuild/shell.ml --- ocaml-3.12.1/ocamlbuild/shell.ml 2010-02-03 10:27:46.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/shell.ml 2012-10-17 21:03:19.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -23,7 +24,12 @@ | _ -> false in loop 0 let quote_filename_if_needed s = - if is_simple_filename s then s else Filename.quote s + if is_simple_filename s then s + (* We should probably be using [Filename.unix_quote] except that function + * isn't exported. Users on Windows will have to live with not being able to + * install OCaml into c:\o'caml. Too bad. *) + else if Sys.os_type = "Win32" then Printf.sprintf "'%s'" s + else Filename.quote s let chdir dir = reset_filesys_cache (); Sys.chdir dir @@ -60,9 +66,9 @@ reset_filesys_cache_for_file dest; run["cp";"-pf";src;dest] dest -(* L'Arrêté du 2007-03-07 prend en consideration +(* L'Arrete du 2007-03-07 prend en consideration differement les archives. Pour les autres fichiers - le décret du 2007-02-01 est toujours valable :-) *) + le decret du 2007-02-01 est toujours valable :-) *) let cp src dst = if Filename.check_suffix src ".a" && Filename.check_suffix dst ".a" diff -Nru ocaml-3.12.1/ocamlbuild/shell.mli ocaml-4.01.0/ocamlbuild/shell.mli --- ocaml-3.12.1/ocamlbuild/shell.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/shell.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -9,10 +10,14 @@ (* *) (***********************************************************************) - (* Original author: Nicolas Pouillard *) + val is_simple_filename : string -> bool + val quote_filename_if_needed : string -> string +(** This will quote using Unix conventions, even on Windows, because commands are + * always run through bash -c on Windows. *) + val chdir : string -> unit val rm : string -> unit val rm_f : string -> unit diff -Nru ocaml-3.12.1/ocamlbuild/signatures.mli ocaml-4.01.0/ocamlbuild/signatures.mli --- ocaml-3.12.1/ocamlbuild/signatures.mli 2011-05-30 09:07:12.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/signatures.mli 2013-06-16 17:03:19.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) @@ -22,7 +23,7 @@ module type SET = sig include Set.S - val find : (elt -> bool) -> t -> elt + val find_elt : (elt -> bool) -> t -> elt val map : (elt -> elt) -> t -> t val of_list : elt list -> t val print : Format.formatter -> t -> unit @@ -33,7 +34,7 @@ val print : (Format.formatter -> 'a -> 'b) -> Format.formatter -> 'a list -> unit val filter_opt : ('a -> 'b option) -> 'a list -> 'b list val union : 'a list -> 'a list -> 'a list - + val ordered_unique : 'a list -> 'a list (* Original functions *) include module type of List end @@ -94,6 +95,12 @@ module type TAGS = sig include Set.S with type elt = string + (** [Tags.elt] represents a tag, which is simply a string, usually + lowercase, for example "ocaml" or "native". The set of tags + attached to a file is computed by applying the tagging rules to + the filename. Tagging rules are defined in _tags files in any + parent directory of a file, up to the main project directory. *) + val of_list : string list -> t val print : Format.formatter -> t -> unit val does_match : t -> t -> bool @@ -152,8 +159,8 @@ end end -(** Provides an abstract type for easily building complex shell commands without making - quotation mistakes. *) +(** Provides an abstract type for easily building complex shell + commands without making quotation mistakes. *) module type COMMAND = sig type tags type pathname @@ -161,27 +168,33 @@ (** The type [t] provides some basic combinators and command primitives. Other commands can be made of command specifications ([spec]). *) type t = - | Seq of t list (** A sequence of commands (like the `;' in shell) *) - | Cmd of spec (** A command is made of command specifications ([spec]) *) - | Echo of string list * pathname (** Write the given strings (w/ any formatting) to the given file *) - | Nop (** The command that does nothing *) + | Seq of t list (** A sequence of commands (like the `;' in shell) *) + | Cmd of spec (** A command is made of command specifications ([spec]) *) + | Echo of string list * pathname + (** Write the given strings (w/ any formatting) to the given file *) + | Nop (** The command that does nothing *) (** The type for command specifications. That is pieces of command. *) and spec = - | N (** No operation. *) - | S of spec list (** A sequence. This gets flattened in the last stages *) - | A of string (** An atom. *) - | P of pathname (** A pathname. *) - | Px of pathname (** A pathname, that will also be given to the call_with_target hook. *) - | Sh of string (** A bit of raw shell code, that will not be escaped. *) - | T of tags (** A set of tags, that describe properties and some semantics - information about the command, afterward these tags will be - replaced by command [spec]s (flags for instance). *) - | V of string (** A virtual command, that will be resolved at execution using [resolve_virtuals] *) - | Quote of spec (** A string that should be quoted like a filename but isn't really one. *) + | N (** No operation. *) + | S of spec list (** A sequence. This gets flattened in the last stages *) + | A of string (** An atom. *) + | P of pathname (** A pathname. *) + | Px of pathname (** A pathname, that will also be given to the + call_with_target hook. *) + | Sh of string (** A bit of raw shell code, that will not be escaped. *) + | T of tags (** A set of tags, that describe properties and + some semantics information about the + command, afterward these tags will be + replaced by command [spec]s (flags for + instance). *) + | V of string (** A virtual command, that will be resolved at + execution using [resolve_virtuals] *) + | Quote of spec (** A string that should be quoted like a + filename but isn't really one. *) (*type v = [ `Seq of v list | `Cmd of vspec | `Nop ] - and vspec = + and vspec = [ `N | `S of vspec list | `A of string @@ -190,10 +203,10 @@ | `Sh of string | `Quote of vspec ] - val spec_of_vspec : vspec -> spec - val vspec_of_spec : spec -> vspec - val t_of_v : v -> t - val v_of_t : t -> v*) + val spec_of_vspec : vspec -> spec + val vspec_of_spec : spec -> vspec + val t_of_v : v -> t + val v_of_t : t -> v*) (** Will convert a string list to a list of atoms by adding [A] constructors. *) val atomize : string list -> spec @@ -347,6 +360,10 @@ val ( @:= ) : 'a list ref -> 'a list -> unit val memo : ('a -> 'b) -> ('a -> 'b) + + val memo2 : ('a -> 'b -> 'c) -> ('a -> 'b -> 'c) + + val memo3 : ('a -> 'b -> 'c -> 'd) -> ('a -> 'b -> 'c -> 'd) end module type OPTIONS = sig @@ -386,9 +403,11 @@ val ocaml_libs : string list ref val ocaml_mods : string list ref val ocaml_pkgs : string list ref + val ocaml_syntax : string option ref val ocaml_cflags : string list ref val ocaml_lflags : string list ref val ocaml_ppflags : string list ref + val ocaml_docflags : string list ref val ocaml_yaccflags : string list ref val ocaml_lexflags : string list ref val program_args : string list ref @@ -501,7 +520,8 @@ (** Same as [link_flags_byte] but for native mode. *) end -(** This module contains the functions and values that can be used by plugins. *) +(** This module contains the functions and values that can be used by + plugins. *) module type PLUGIN = sig module Pathname : PATHNAME module Tags : TAGS @@ -515,8 +535,14 @@ module Findlib : FINDLIB with type command_spec = Command.spec include MISC - (** See [COMMAND] for the description of these types. *) - type command = Command.t = Seq of command list | Cmd of spec | Echo of string list * Pathname.t | Nop + (** See {!COMMAND.t} for the description of this type. *) + type command = Command.t = + | Seq of command list + | Cmd of spec + | Echo of string list * Pathname.t + | Nop + + (** See {!COMMAND.spec} for the description of this type. *) and spec = Command.spec = | N | S of spec list | A of string | P of string | Px of string | Sh of string | T of Tags.t | V of string | Quote of spec @@ -537,8 +563,8 @@ if the given option is Some. *) val ( +++ ) : Tags.t -> Tags.elt option -> Tags.t - (** [tags---optional_tag] Remove the given optional tag to the given set of tags - if the given option is Some. *) + (** [tags---optional_tag] Remove the given optional tag to the given + set of tags if the given option is Some. *) val ( --- ) : Tags.t -> Tags.elt option -> Tags.t (** The type of the builder environments. Here an environment is just the @@ -554,9 +580,10 @@ type builder = Pathname.t list list -> (Pathname.t, exn) Outcome.t list (** This is the type for rule actions. An action receive as argument, the - environment lookup function (see [env]), and a function to dynamically - build more targets (see [builder]). An action should return the command - to run in order to build the rule productions using the rule dependencies. *) + environment lookup function (see {!env}), and a function to dynamically + build more targets (see {!builder}). An action should return the command + to run in order to build the rule productions using the rule dependencies. + *) type action = env -> builder -> Command.t (** This is the main function for adding a rule to the ocamlbuild engine. @@ -593,12 +620,14 @@ (** Empties the list of rules of the ocamlbuild engine. *) val clear_rules : unit -> unit - (** [dep tags deps] Will build [deps] when all [tags] will be activated. *) + (** [dep tags deps] Will build [deps] when all [tags] will be activated. + If you do not know which tags to use, have a look to the file + _build/_log after trying to compile your code. *) val dep : Tags.elt list -> Pathname.t list -> unit - (** [pdep tags ptag deps] is equivalent to [dep tags deps], with an additional - parameterized tag [ptag]. [deps] is now a function which takes the - parameter of the tag [ptag] as an argument. + (** [pdep tags ptag deps] is equivalent to [dep tags deps], with an + additional parameterized tag [ptag]. [deps] is now a function + which takes the parameter of the tag [ptag] as an argument. Example: [pdep ["ocaml"; "compile"] "autodep" (fun param -> param)] @@ -607,7 +636,9 @@ val pdep : Tags.elt list -> Tags.elt -> (string -> Pathname.t list) -> unit (** [flag tags command_spec] Will inject the given piece of command - ([command_spec]) when all [tags] will be activated. *) + ([command_spec]) when all [tags] will be activated. + If you do not know which tags to use, have a look to the file + _build/_log after trying to compile your code. *) val flag : Tags.elt list -> Command.spec -> unit (** Allows to use [flag] with a parameterized tag (as [pdep] for [dep]). @@ -633,26 +664,30 @@ (string -> Command.spec) -> unit (** [non_dependency module_path module_name] - Example: + Example: [non_dependency "foo/bar/baz" "Goo"] - Says that the module [Baz] in the file [foo/bar/baz.*] does not depend on [Goo]. *) + Says that the module [Baz] in the file [foo/bar/baz.*] does + not depend on [Goo]. *) val non_dependency : Pathname.t -> string -> unit (** [use_lib module_path lib_path]*) val use_lib : Pathname.t -> Pathname.t -> unit - (** [ocaml_lib library_pathname] - Declare an ocaml library. + (** [ocaml_lib library_pathname] Declare an ocaml library. + This informs ocamlbuild and produce tags to use the library; + they are named by default use_#{library_name}. - Example: ocaml_lib "foo/bar" - This will setup the tag use_bar tag. + Example: [ocaml_lib "foo/bar"] will setup the tag use_bar. At link time it will include: foo/bar.cma or foo/bar.cmxa - If you supply the ~dir:"boo" option -I boo - will be added at link and compile time. - Use ~extern:true for non-ocamlbuild handled libraries. - Use ~byte:false or ~native:false to disable byte or native mode. - Use ~tag_name:"usebar" to override the default tag name. *) + @param dir supply the [~dir:"boo"] option to add '-I boo' + at link and compile time. + @param extern use ~extern:true for non-ocamlbuild handled libraries. + Set this to add libraries whose sources are not in your project. + @param byte use ~byte:false to disable byte mode. + @param native use ~native:false to disable native mode. + @param tag_name Use ~tag_name:"usebar" to override the default + tag name. *) val ocaml_lib : ?extern:bool -> ?byte:bool -> @@ -663,10 +698,10 @@ (** [expand_module include_dirs module_name extensions] Example: - [expand_module ["a";"b";"c"] "Foo" ["cmo";"cmi"] = - ["a/foo.cmo"; "a/Foo.cmo"; "a/foo.cmi"; "a/Foo.cmi"; - "b/foo.cmo"; "b/Foo.cmo"; "b/foo.cmi"; "b/Foo.cmi"; - "c/foo.cmo"; "c/Foo.cmo"; "c/foo.cmi"; "c/Foo.cmi"]] *) + [expand_module ["a";"b";"c"] "Foo" ["cmo";"cmi"] = + ["a/foo.cmo"; "a/Foo.cmo"; "a/foo.cmi"; "a/Foo.cmi"; + "b/foo.cmo"; "b/Foo.cmo"; "b/foo.cmi"; "b/Foo.cmi"; + "c/foo.cmo"; "c/Foo.cmo"; "c/foo.cmi"; "c/Foo.cmi"]] *) val expand_module : Pathname.t list -> Pathname.t -> string list -> Pathname.t list @@ -705,7 +740,12 @@ this package even if it contains that module. *) val hide_package_contents : string -> unit - (** [tag_file filename tag_list] Tag the given filename with all given tags. *) + (** [tag_file filename tag_list] Tag the given filename with all + given tags. Prefix a tag with the minus sign to remove it. + This is usually used as an [After_rules] hook. + For example [tag_file "bla.ml" ["use_unix"]] tags the file + "bla.ml" with "use_unix" and [tag_file "bla.ml" ["-use_unix"]] + removes the tag "use_unix" from the file "bla.ml". *) val tag_file : Pathname.t -> Tags.elt list -> unit (** [tag_any tag_list] Tag anything with all given tags. *) diff -Nru ocaml-3.12.1/ocamlbuild/slurp.ml ocaml-4.01.0/ocamlbuild/slurp.ml --- ocaml-3.12.1/ocamlbuild/slurp.ml 2010-05-19 12:53:40.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/slurp.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/slurp.mli ocaml-4.01.0/ocamlbuild/slurp.mli --- ocaml-3.12.1/ocamlbuild/slurp.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/slurp.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/solver.ml ocaml-4.01.0/ocamlbuild/solver.ml --- ocaml-3.12.1/ocamlbuild/solver.ml 2010-02-03 13:33:19.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/solver.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/solver.mli ocaml-4.01.0/ocamlbuild/solver.mli --- ocaml-3.12.1/ocamlbuild/solver.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/solver.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/start.sh ocaml-4.01.0/ocamlbuild/start.sh --- ocaml-3.12.1/ocamlbuild/start.sh 2010-05-20 09:44:25.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/start.sh 2013-01-01 00:33:26.000000000 +0000 @@ -2,7 +2,7 @@ ######################################################################### # # -# Objective Caml # +# OCaml # # # # Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # # # @@ -28,7 +28,6 @@ let so = "so";; let exe = "";; EOF -ocamlc -c std_signatures.mli ocamlc -c signatures.mli ocamlc -c tags.mli ocamlc -c ocamlbuild_Myocamlbuild_config.ml diff -Nru ocaml-3.12.1/ocamlbuild/tags.ml ocaml-4.01.0/ocamlbuild/tags.ml --- ocaml-3.12.1/ocamlbuild/tags.ml 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/tags.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/tags.mli ocaml-4.01.0/ocamlbuild/tags.mli --- ocaml-3.12.1/ocamlbuild/tags.mli 2009-03-03 16:54:58.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/tags.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/test/good-output ocaml-4.01.0/ocamlbuild/test/good-output --- ocaml-3.12.1/ocamlbuild/test/good-output 2007-11-28 15:52:01.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/good-output 1970-01-01 00:00:00.000000000 +0000 @@ -1,1090 +0,0 @@ - _____ _ ____ -|_ _|__ ___| |_|___ \ - | |/ _ \/ __| __| __) | - | | __/\__ \ |_ / __/ - |_|\___||___/\__|_____| - -+ CMDOPTS='-- -help' -+ BUILD='../../_build/ocamlbuild.native toto.byte toto.native -no-skip -classic-display ' -+ BUILD1='../../_build/ocamlbuild.native toto.byte toto.native -no-skip -classic-display -- -help' -+ BUILD2='../../_build/ocamlbuild.native toto.byte toto.native -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt -- -help' -+ rm -rf _build -+ cp vivi1.ml vivi.ml -+ ../../_build/ocamlbuild.native toto.byte toto.native -no-skip -classic-display -- -help -ocamldep.opt -modules toto.ml > toto.ml.depends -ocamldep.opt -modules tata.mli > tata.mli.depends -ocamldep.opt -modules titi.ml > titi.ml.depends -ocamldep.opt -modules tutu.mli > tutu.mli.depends -ocamlc.opt -c -o tata.cmi tata.mli -ocamlc.opt -c -o titi.cmo titi.ml -ocamlc.opt -c -o tutu.cmi tutu.mli -ocamlc.opt -c -o toto.cmo toto.ml -ocamldep.opt -modules tata.ml > tata.ml.depends -ocamldep.opt -modules tutu.ml > tutu.ml.depends -ocamldep.opt -modules tyty.mli > tyty.mli.depends -ocamldep.opt -pp camlp4o -modules vivi.ml > vivi.ml.depends -ocamlc.opt -c -o tyty.cmi tyty.mli -ocamlc.opt -c -pp camlp4o -o vivi.cmo vivi.ml -ocamlc.opt -c -o tata.cmo tata.ml -ocamlc.opt -c -o tutu.cmo tutu.ml -ocamlc.opt tata.cmo titi.cmo vivi.cmo tutu.cmo toto.cmo -o toto.byte -ocamlopt.opt -c -pp camlp4o -o vivi.cmx vivi.ml -ocamlopt.opt -c -o tata.cmx tata.ml -ocamlopt.opt -c -o titi.cmx titi.ml -ocamlopt.opt -c -o tutu.cmx tutu.ml -ocamlopt.opt -c -o toto.cmx toto.ml -ocamlopt.opt tata.cmx titi.cmx vivi.cmx tutu.cmx toto.cmx -o toto.native -Warning: Using -- only run the last target -toto.native: _build/toto.native: Hello world!!! -Tutu.tutu => 1 -Tata.tata => "TATA2" -+ ../../_build/ocamlbuild.native toto.byte toto.native -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt -- -help -[cache hit] ocamldep.opt -modules toto.ml > toto.ml.depends -[cache hit] ocamldep.opt -modules tata.mli > tata.mli.depends -[cache hit] ocamlc.opt -c -o tata.cmi tata.mli -[cache hit] ocamldep.opt -modules titi.ml > titi.ml.depends -[cache hit] ocamlc.opt -c -o titi.cmo titi.ml -[cache hit] ocamldep.opt -modules tutu.mli > tutu.mli.depends -[cache hit] ocamlc.opt -c -o tutu.cmi tutu.mli -[cache hit] ocamlc.opt -c -o toto.cmo toto.ml -[cache hit] ocamldep.opt -modules tata.ml > tata.ml.depends -[cache hit] ocamlc.opt -c -o tata.cmo tata.ml -[cache hit] ocamldep.opt -modules tutu.ml > tutu.ml.depends -[cache hit] ocamldep.opt -modules tyty.mli > tyty.mli.depends -[cache hit] ocamlc.opt -c -o tyty.cmi tyty.mli -[cache hit] ocamldep.opt -pp camlp4o -modules vivi.ml > vivi.ml.depends -[cache hit] ocamlc.opt -c -pp camlp4o -o vivi.cmo vivi.ml -[cache hit] ocamlc.opt -c -o tutu.cmo tutu.ml -[cache hit] ocamlc.opt tata.cmo titi.cmo vivi.cmo tutu.cmo toto.cmo -o toto.byte -[cache hit] ocamlopt.opt -c -o tata.cmx tata.ml -[cache hit] ocamlopt.opt -c -o titi.cmx titi.ml -[cache hit] ocamlopt.opt -c -pp camlp4o -o vivi.cmx vivi.ml -[cache hit] ocamlopt.opt -c -o tutu.cmx tutu.ml -[cache hit] ocamlopt.opt -c -o toto.cmx toto.ml -[cache hit] ocamlopt.opt tata.cmx titi.cmx vivi.cmx tutu.cmx toto.cmx -o toto.native -Warning: Using -- only run the last target -toto.native: _build/toto.native: Hello world!!! -Tutu.tutu => 1 -Tata.tata => "TATA2" -+ cp vivi2.ml vivi.ml -+ ../../_build/ocamlbuild.native toto.byte toto.native -no-skip -classic-display -- -help -ocamldep.opt -pp camlp4o -modules vivi.ml > vivi.ml.depends -ocamlc.opt -c -pp camlp4o -o vivi.cmo vivi.ml -ocamlc.opt tata.cmo titi.cmo vivi.cmo tutu.cmo toto.cmo -o toto.byte -ocamlopt.opt -c -pp camlp4o -o vivi.cmx vivi.ml -ocamlopt.opt tata.cmx titi.cmx vivi.cmx tutu.cmx toto.cmx -o toto.native -Warning: Using -- only run the last target -toto.native: _build/toto.native: Hello world!!! -Tutu.tutu => 1 -Tata.tata => "TATA2" -+ ../../_build/ocamlbuild.native toto.byte toto.native -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt -- -help -[cache hit] ocamldep.opt -modules toto.ml > toto.ml.depends -[cache hit] ocamldep.opt -modules tata.mli > tata.mli.depends -[cache hit] ocamlc.opt -c -o tata.cmi tata.mli -[cache hit] ocamldep.opt -modules titi.ml > titi.ml.depends -[cache hit] ocamlc.opt -c -o titi.cmo titi.ml -[cache hit] ocamldep.opt -modules tutu.mli > tutu.mli.depends -[cache hit] ocamlc.opt -c -o tutu.cmi tutu.mli -[cache hit] ocamlc.opt -c -o toto.cmo toto.ml -[cache hit] ocamldep.opt -modules tata.ml > tata.ml.depends -[cache hit] ocamlc.opt -c -o tata.cmo tata.ml -[cache hit] ocamldep.opt -modules tutu.ml > tutu.ml.depends -[cache hit] ocamldep.opt -modules tyty.mli > tyty.mli.depends -[cache hit] ocamlc.opt -c -o tyty.cmi tyty.mli -[cache hit] ocamldep.opt -pp camlp4o -modules vivi.ml > vivi.ml.depends -[cache hit] ocamlc.opt -c -pp camlp4o -o vivi.cmo vivi.ml -[cache hit] ocamlc.opt -c -o tutu.cmo tutu.ml -[cache hit] ocamlc.opt tata.cmo titi.cmo vivi.cmo tutu.cmo toto.cmo -o toto.byte -[cache hit] ocamlopt.opt -c -o tata.cmx tata.ml -[cache hit] ocamlopt.opt -c -o titi.cmx titi.ml -[cache hit] ocamlopt.opt -c -pp camlp4o -o vivi.cmx vivi.ml -[cache hit] ocamlopt.opt -c -o tutu.cmx tutu.ml -[cache hit] ocamlopt.opt -c -o toto.cmx toto.ml -[cache hit] ocamlopt.opt tata.cmx titi.cmx vivi.cmx tutu.cmx toto.cmx -o toto.native -Warning: Using -- only run the last target -toto.native: _build/toto.native: Hello world!!! -Tutu.tutu => 1 -Tata.tata => "TATA2" -+ cp vivi3.ml vivi.ml -+ ../../_build/ocamlbuild.native toto.byte toto.native -no-skip -classic-display -- -help -ocamldep.opt -pp camlp4o -modules vivi.ml > vivi.ml.depends -ocamlc.opt -c -pp camlp4o -o vivi.cmo vivi.ml -ocamlc.opt -c -o tutu.cmo tutu.ml -ocamlc.opt tata.cmo titi.cmo vivi.cmo tutu.cmo toto.cmo -o toto.byte -ocamlopt.opt -c -pp camlp4o -o vivi.cmx vivi.ml -ocamlopt.opt -c -o tutu.cmx tutu.ml -ocamlopt.opt -c -o toto.cmx toto.ml -ocamlopt.opt tata.cmx titi.cmx vivi.cmx tutu.cmx toto.cmx -o toto.native -Warning: Using -- only run the last target -toto.native: _build/toto.native: Hello world!!! -Tutu.tutu => 2 -Tata.tata => "TATA2" -+ ../../_build/ocamlbuild.native toto.byte toto.native -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt -- -help -[cache hit] ocamldep.opt -modules toto.ml > toto.ml.depends -[cache hit] ocamldep.opt -modules tata.mli > tata.mli.depends -[cache hit] ocamlc.opt -c -o tata.cmi tata.mli -[cache hit] ocamldep.opt -modules titi.ml > titi.ml.depends -[cache hit] ocamlc.opt -c -o titi.cmo titi.ml -[cache hit] ocamldep.opt -modules tutu.mli > tutu.mli.depends -[cache hit] ocamlc.opt -c -o tutu.cmi tutu.mli -[cache hit] ocamlc.opt -c -o toto.cmo toto.ml -[cache hit] ocamldep.opt -modules tata.ml > tata.ml.depends -[cache hit] ocamlc.opt -c -o tata.cmo tata.ml -[cache hit] ocamldep.opt -modules tutu.ml > tutu.ml.depends -[cache hit] ocamldep.opt -modules tyty.mli > tyty.mli.depends -[cache hit] ocamlc.opt -c -o tyty.cmi tyty.mli -[cache hit] ocamldep.opt -pp camlp4o -modules vivi.ml > vivi.ml.depends -[cache hit] ocamlc.opt -c -pp camlp4o -o vivi.cmo vivi.ml -[cache hit] ocamlc.opt -c -o tutu.cmo tutu.ml -[cache hit] ocamlc.opt tata.cmo titi.cmo vivi.cmo tutu.cmo toto.cmo -o toto.byte -[cache hit] ocamlopt.opt -c -o tata.cmx tata.ml -[cache hit] ocamlopt.opt -c -o titi.cmx titi.ml -[cache hit] ocamlopt.opt -c -pp camlp4o -o vivi.cmx vivi.ml -[cache hit] ocamlopt.opt -c -o tutu.cmx tutu.ml -[cache hit] ocamlopt.opt -c -o toto.cmx toto.ml -[cache hit] ocamlopt.opt tata.cmx titi.cmx vivi.cmx tutu.cmx toto.cmx -o toto.native -Warning: Using -- only run the last target -toto.native: _build/toto.native: Hello world!!! -Tutu.tutu => 2 -Tata.tata => "TATA2" - _____ _ _____ -|_ _|__ ___| |_|___ / - | |/ _ \/ __| __| |_ \ - | | __/\__ \ |_ ___) | - |_|\___||___/\__|____/ - -+ CMDOTPS= -+ BUILD='../../_build/ocamlbuild.native a.byte a.native proj.docdir/index.html -no-skip -classic-display ' -+ BUILD1='../../_build/ocamlbuild.native a.byte a.native proj.docdir/index.html -no-skip -classic-display ' -+ BUILD2='../../_build/ocamlbuild.native a.byte a.native proj.docdir/index.html -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt ' -+ rm -rf _build -+ ../../_build/ocamlbuild.native a.byte a.native proj.docdir/index.html -no-skip -classic-display -ocamldep.opt -modules a.mli > a.mli.depends -ocamlc.opt -c -o a.cmi a.mli -ocamldep.opt -modules a.ml > a.ml.depends -ocamldep.opt -modules b.mli > b.mli.depends -ocamlc.opt -c -o b.cmi b.mli -ocamlc.opt -c -o a.cmo a.ml -ocamldep.opt -modules b.ml > b.ml.depends -ocamldep.opt -modules c.mli > c.mli.depends -ocamlc.opt -c -o c.cmi c.mli -ocamlc.opt -c -o b.cmo b.ml -ocamldep.opt -modules c.ml > c.ml.depends -ocamldep.opt -modules d.mli > d.mli.depends -ocamlc.opt -c -o d.cmi d.mli -ocamlc.opt -c -o c.cmo c.ml -ocamldep.opt -modules d.ml > d.ml.depends -ocamldep.opt -modules e.mli > e.mli.depends -ocamlc.opt -c -o e.cmi e.mli -ocamlc.opt -c -o d.cmo d.ml -ocamldep.opt -modules e.ml > e.ml.depends -ocamldep.opt -modules f.mli > f.mli.depends -ocamlc.opt -c -o f.cmi f.mli -ocamlc.opt -c -o e.cmo e.ml -ocamldep.opt -modules f.ml > f.ml.depends -ocamlc.opt -c -o f.cmo f.ml -ocamlc.opt unix.cma f.cmo e.cmo d.cmo c.cmo b.cmo a.cmo -o a.byte -ocamlopt.opt -c -o f.cmx f.ml -ocamlopt.opt -c -o e.cmx e.ml -ocamlopt.opt -c -o d.cmx d.ml -ocamlopt.opt -c -o c.cmx c.ml -ocamlopt.opt -c -o b.cmx b.ml -ocamlopt.opt -c -o a.cmx a.ml -ocamlopt.opt unix.cmxa f.cmx e.cmx d.cmx c.cmx b.cmx a.cmx -o a.native -ocamldoc.opt -dump a.odoc a.mli -ocamldoc.opt -dump b.odoc b.mli -ocamldoc.opt -dump c.odoc c.mli -ocamldoc.opt -dump d.odoc d.mli -ocamldoc.opt -dump e.odoc e.mli -ocamldoc.opt -dump f.odoc f.mli -rm -rf proj.docdir -mkdir -p proj.docdir -ocamldoc.opt -load a.odoc -load b.odoc -load c.odoc -load d.odoc -load e.odoc -load f.odoc -html -d proj.docdir -+ ../../_build/ocamlbuild.native a.byte a.native proj.docdir/index.html -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt -[cache hit] ocamldep.opt -modules a.mli > a.mli.depends -[cache hit] ocamlc.opt -c -o a.cmi a.mli -[cache hit] ocamldep.opt -modules a.ml > a.ml.depends -[cache hit] ocamldep.opt -modules b.mli > b.mli.depends -[cache hit] ocamlc.opt -c -o b.cmi b.mli -[cache hit] ocamlc.opt -c -o a.cmo a.ml -[cache hit] ocamldep.opt -modules b.ml > b.ml.depends -[cache hit] ocamldep.opt -modules c.mli > c.mli.depends -[cache hit] ocamlc.opt -c -o c.cmi c.mli -[cache hit] ocamlc.opt -c -o b.cmo b.ml -[cache hit] ocamldep.opt -modules c.ml > c.ml.depends -[cache hit] ocamldep.opt -modules d.mli > d.mli.depends -[cache hit] ocamlc.opt -c -o d.cmi d.mli -[cache hit] ocamlc.opt -c -o c.cmo c.ml -[cache hit] ocamldep.opt -modules d.ml > d.ml.depends -[cache hit] ocamldep.opt -modules e.mli > e.mli.depends -[cache hit] ocamlc.opt -c -o e.cmi e.mli -[cache hit] ocamlc.opt -c -o d.cmo d.ml -[cache hit] ocamldep.opt -modules e.ml > e.ml.depends -[cache hit] ocamldep.opt -modules f.mli > f.mli.depends -[cache hit] ocamlc.opt -c -o f.cmi f.mli -[cache hit] ocamlc.opt -c -o e.cmo e.ml -[cache hit] ocamldep.opt -modules f.ml > f.ml.depends -[cache hit] ocamlc.opt -c -o f.cmo f.ml -[cache hit] ocamlc.opt unix.cma f.cmo e.cmo d.cmo c.cmo b.cmo a.cmo -o a.byte -[cache hit] ocamlopt.opt -c -o f.cmx f.ml -[cache hit] ocamlopt.opt -c -o e.cmx e.ml -[cache hit] ocamlopt.opt -c -o d.cmx d.ml -[cache hit] ocamlopt.opt -c -o c.cmx c.ml -[cache hit] ocamlopt.opt -c -o b.cmx b.ml -[cache hit] ocamlopt.opt -c -o a.cmx a.ml -[cache hit] ocamlopt.opt unix.cmxa f.cmx e.cmx d.cmx c.cmx b.cmx a.cmx -o a.native -[cache hit] ocamldoc.opt -dump a.odoc a.mli -[cache hit] ocamldoc.opt -dump b.odoc b.mli -[cache hit] ocamldoc.opt -dump c.odoc c.mli -[cache hit] ocamldoc.opt -dump d.odoc d.mli -[cache hit] ocamldoc.opt -dump e.odoc e.mli -[cache hit] ocamldoc.opt -dump f.odoc f.mli -[cache hit] rm -rf proj.docdir -[cache hit] mkdir -p proj.docdir -[cache hit] ocamldoc.opt -load a.odoc -load b.odoc -load c.odoc -load d.odoc -load e.odoc -load f.odoc -html -d proj.docdir - _____ _ _ _ -|_ _|__ ___| |_| || | - | |/ _ \/ __| __| || |_ - | | __/\__ \ |_|__ _| - |_|\___||___/\__| |_| - -+ CMDOTPS= -+ BUILD='../../_build/ocamlbuild.native -I a -I b aa.byte aa.native -no-skip -classic-display ' -+ BUILD1='../../_build/ocamlbuild.native -I a -I b aa.byte aa.native -no-skip -classic-display ' -+ BUILD2='../../_build/ocamlbuild.native -I a -I b aa.byte aa.native -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt ' -+ rm -rf _build -+ ../../_build/ocamlbuild.native -I a -I b aa.byte aa.native -no-skip -classic-display -ocamldep.opt -modules a/aa.mli > a/aa.mli.depends -ocamlc.opt -c -I a -I b -o a/aa.cmi a/aa.mli -ocamldep.opt -modules a/aa.ml > a/aa.ml.depends -ocamldep.opt -modules b/bb.ml > b/bb.ml.depends -ocamlc.opt -c -I b -I a -o b/bb.cmo b/bb.ml -ocamlc.opt -c -I a -I b -o a/aa.cmo a/aa.ml -ocamlc.opt str.cma b/bb.cmo a/aa.cmo -o a/aa.byte -ocamlopt.opt -c -I b -I a -o b/bb.cmx b/bb.ml -ocamlopt.opt -c -I a -I b -o a/aa.cmx a/aa.ml -ocamlopt.opt str.cmxa b/bb.cmx a/aa.cmx -o a/aa.native -+ ../../_build/ocamlbuild.native -I a -I b aa.byte aa.native -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt -[cache hit] ocamldep.opt -modules a/aa.mli > a/aa.mli.depends -[cache hit] ocamlc.opt -c -I a -I b -o a/aa.cmi a/aa.mli -[cache hit] ocamldep.opt -modules a/aa.ml > a/aa.ml.depends -[cache hit] ocamldep.opt -modules b/bb.ml > b/bb.ml.depends -[cache hit] ocamlc.opt -c -I b -I a -o b/bb.cmo b/bb.ml -[cache hit] ocamlc.opt -c -I a -I b -o a/aa.cmo a/aa.ml -[cache hit] ocamlc.opt str.cma b/bb.cmo a/aa.cmo -o a/aa.byte -[cache hit] ocamlopt.opt -c -I b -I a -o b/bb.cmx b/bb.ml -[cache hit] ocamlopt.opt -c -I a -I b -o a/aa.cmx a/aa.ml -[cache hit] ocamlopt.opt str.cmxa b/bb.cmx a/aa.cmx -o a/aa.native - _____ _ ____ -|_ _|__ ___| |_| ___| - | |/ _ \/ __| __|___ \ - | | __/\__ \ |_ ___) | - |_|\___||___/\__|____/ - -+ CMDOPTS= -+ BUILD='../../_build/ocamlbuild.native d.byte d.native -no-skip -classic-display ' -+ BUILD1='../../_build/ocamlbuild.native d.byte d.native -no-skip -classic-display ' -+ BUILD2='../../_build/ocamlbuild.native d.byte d.native -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt ' -+ rm -rf _build -+ ../../_build/ocamlbuild.native d.byte d.native -no-skip -classic-display -ocamldep.opt -modules d.ml > d.ml.depends -ocamldep.opt -modules a.mli > a.mli.depends -ocamlc.opt -c -o a.cmi a.mli -ocamldep.opt -modules a.ml > a.ml.depends -ocamldep.opt -modules stack.ml > stack.ml.depends -ocamlc.opt -c -o stack.cmo stack.ml -ocamldep.opt -modules b.ml > b.ml.depends -ocamlc.opt -c -o a.cmo a.ml -ocamlc.opt -c -o b.cmo b.ml -ocamlc.opt -pack a.cmo b.cmo -o c.cmo -ocamlc.opt -c -o d.cmo d.ml -ocamlc.opt stack.cmo c.cmo d.cmo -o d.byte -ocamlopt.opt -c -o stack.cmx stack.ml -ocamlopt.opt -c -for-pack C -o a.cmx a.ml -ocamlopt.opt -c -for-pack C -o b.cmx b.ml -touch c.mli ; if ocamlopt.opt -pack a.cmx b.cmx -o c.cmx ; then rm -f c.mli ; else rm -f c.mli ; exit 1; fi -ocamlopt.opt -c -o d.cmx d.ml -ocamlopt.opt stack.cmx c.cmx d.cmx -o d.native -+ ../../_build/ocamlbuild.native d.byte d.native -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt -[cache hit] ocamldep.opt -modules d.ml > d.ml.depends -[cache hit] ocamldep.opt -modules a.mli > a.mli.depends -[cache hit] ocamlc.opt -c -o a.cmi a.mli -[cache hit] ocamldep.opt -modules a.ml > a.ml.depends -[cache hit] ocamldep.opt -modules stack.ml > stack.ml.depends -[cache hit] ocamlc.opt -c -o stack.cmo stack.ml -[cache hit] ocamlc.opt -c -o a.cmo a.ml -[cache hit] ocamldep.opt -modules b.ml > b.ml.depends -[cache hit] ocamlc.opt -c -o b.cmo b.ml -[cache hit] ocamlc.opt -pack a.cmo b.cmo -o c.cmo -[cache hit] ocamlc.opt -c -o d.cmo d.ml -[cache hit] ocamlc.opt stack.cmo c.cmo d.cmo -o d.byte -[cache hit] ocamlopt.opt -c -o stack.cmx stack.ml -[cache hit] ocamlopt.opt -c -for-pack C -o a.cmx a.ml -[cache hit] ocamlopt.opt -c -for-pack C -o b.cmx b.ml -[cache hit] touch c.mli ; if ocamlopt.opt -pack a.cmx b.cmx -o c.cmx ; then rm -f c.mli ; else rm -f c.mli ; exit 1; fi -[cache hit] ocamlopt.opt -c -o d.cmx d.ml -[cache hit] ocamlopt.opt stack.cmx c.cmx d.cmx -o d.native - _____ _ __ -|_ _|__ ___| |_ / /_ - | |/ _ \/ __| __| '_ \ - | | __/\__ \ |_| (_) | - |_|\___||___/\__|\___/ - -+ rm -rf _build -+ CMDOPTS= -+ BUILD='../../_build/ocamlbuild.native -no-skip main.byte -classic-display ' -+ BUILD1='../../_build/ocamlbuild.native -no-skip main.byte -classic-display ' -+ BUILD2='../../_build/ocamlbuild.native -no-skip main.byte -classic-display -verbose 0 -nothing-should-be-rebuilt ' -+ cp b.mli.v1 b.mli -+ cp d.mli.v1 d.mli -+ ../../_build/ocamlbuild.native -no-skip main.byte -classic-display -ocamldep.opt -modules main.mli > main.mli.depends -ocamlc.opt -c -o main.cmi main.mli -ocamldep.opt -modules main.ml > main.ml.depends -ocamldep.opt -modules a.mli > a.mli.depends -ocamldep.opt -modules d.mli > d.mli.depends -ocamlc.opt -c -o a.cmi a.mli -ocamlc.opt -c -o d.cmi d.mli -ocamlc.opt -c -o main.cmo main.ml -ocamldep.opt -modules a.ml > a.ml.depends -ocamldep.opt -modules b.mli > b.mli.depends -ocamlc.opt -c -o b.cmi b.mli -ocamldep.opt -modules d.ml > d.ml.depends -ocamlc.opt -c -o a.cmo a.ml -ocamlc.opt -c -o d.cmo d.ml -ocamldep.opt -modules b.ml > b.ml.depends -ocamlc.opt -c -o b.cmo b.ml -ocamlc.opt d.cmo b.cmo a.cmo main.cmo -o main.byte -+ ../../_build/ocamlbuild.native -no-skip main.byte -classic-display -verbose 0 -nothing-should-be-rebuilt -[cache hit] ocamldep.opt -modules main.mli > main.mli.depends -[cache hit] ocamlc.opt -c -o main.cmi main.mli -[cache hit] ocamldep.opt -modules main.ml > main.ml.depends -[cache hit] ocamldep.opt -modules a.mli > a.mli.depends -[cache hit] ocamlc.opt -c -o a.cmi a.mli -[cache hit] ocamldep.opt -modules d.mli > d.mli.depends -[cache hit] ocamlc.opt -c -o d.cmi d.mli -[cache hit] ocamlc.opt -c -o main.cmo main.ml -[cache hit] ocamldep.opt -modules a.ml > a.ml.depends -[cache hit] ocamldep.opt -modules b.mli > b.mli.depends -[cache hit] ocamlc.opt -c -o b.cmi b.mli -[cache hit] ocamlc.opt -c -o a.cmo a.ml -[cache hit] ocamldep.opt -modules d.ml > d.ml.depends -[cache hit] ocamlc.opt -c -o d.cmo d.ml -[cache hit] ocamldep.opt -modules b.ml > b.ml.depends -[cache hit] ocamlc.opt -c -o b.cmo b.ml -[cache hit] ocamlc.opt d.cmo b.cmo a.cmo main.cmo -o main.byte -+ cp b.mli.v2 b.mli -+ cp d.mli.v2 d.mli -+ ../../_build/ocamlbuild.native -no-skip main.byte -classic-display -ocamldep.opt -modules d.mli > d.mli.depends -ocamlc.opt -c -o d.cmi d.mli -ocamlc.opt -c -o main.cmo main.ml -ocamldep.opt -modules b.mli > b.mli.depends -+ ocamldep.opt -modules b.mli > b.mli.depends -File "b.mli", line 1, characters 0-2: -Syntax error -Command exited with code 2. -+ cp b.mli.v1 b.mli -+ ../../_build/ocamlbuild.native -no-skip main.byte -classic-display -ocamldep.opt -modules b.mli > b.mli.depends -ocamlc.opt -c -o b.cmi b.mli -ocamlc.opt -c -o d.cmo d.ml -ocamlc.opt -c -o b.cmo b.ml -ocamlc.opt d.cmo b.cmo a.cmo main.cmo -o main.byte -+ ../../_build/ocamlbuild.native -no-skip main.byte -classic-display -verbose 0 -nothing-should-be-rebuilt -[cache hit] ocamldep.opt -modules main.mli > main.mli.depends -[cache hit] ocamlc.opt -c -o main.cmi main.mli -[cache hit] ocamldep.opt -modules main.ml > main.ml.depends -[cache hit] ocamldep.opt -modules a.mli > a.mli.depends -[cache hit] ocamlc.opt -c -o a.cmi a.mli -[cache hit] ocamldep.opt -modules d.mli > d.mli.depends -[cache hit] ocamlc.opt -c -o d.cmi d.mli -[cache hit] ocamlc.opt -c -o main.cmo main.ml -[cache hit] ocamldep.opt -modules a.ml > a.ml.depends -[cache hit] ocamldep.opt -modules b.mli > b.mli.depends -[cache hit] ocamlc.opt -c -o b.cmi b.mli -[cache hit] ocamlc.opt -c -o a.cmo a.ml -[cache hit] ocamldep.opt -modules d.ml > d.ml.depends -[cache hit] ocamlc.opt -c -o d.cmo d.ml -[cache hit] ocamldep.opt -modules b.ml > b.ml.depends -[cache hit] ocamlc.opt -c -o b.cmo b.ml -[cache hit] ocamlc.opt d.cmo b.cmo a.cmo main.cmo -o main.byte -+ echo PASS -PASS - _____ _ _____ -|_ _|__ ___| ||___ | - | |/ _ \/ __| __| / / - | | __/\__ \ |_ / / - |_|\___||___/\__/_/ - -+ CMDOPTS= -+ BUILD='../../_build/ocamlbuild.native bbcc.cma main.byte bbcc.cmxa main.native -no-skip -classic-display ' -+ BUILD1='../../_build/ocamlbuild.native bbcc.cma main.byte bbcc.cmxa main.native -no-skip -classic-display ' -+ BUILD2='../../_build/ocamlbuild.native bbcc.cma main.byte bbcc.cmxa main.native -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt ' -+ rm -rf _build -+ cp bb1.ml bb.ml -+ ../../_build/ocamlbuild.native bbcc.cma main.byte bbcc.cmxa main.native -no-skip -classic-display -ocamlopt.opt -I /Users/ertai/l/ocaml/ocamlbuild-unstable/ocamlbuild/_install/lib/ocamlbuild unix.cmxa /Users/ertai/l/ocaml/ocamlbuild-unstable/ocamlbuild/_install/lib/ocamlbuild/ocamlbuildlib.cmxa myocamlbuild.ml /Users/ertai/l/ocaml/ocamlbuild-unstable/ocamlbuild/_install/lib/ocamlbuild/ocamlbuild.cmx -o myocamlbuild -ocamldep.opt -modules bb.mli > bb.mli.depends -ocamlc.opt -c -o bb.cmi bb.mli -ocamldep.opt -modules bb.ml > bb.ml.depends -ocamldep.opt -modules cc.ml > cc.ml.depends -ocamldep.opt -modules aa.ml > aa.ml.depends -ocamldep.opt -modules c2.mli > c2.mli.depends -ocamlc.opt -c -o aa.cmo aa.ml -ocamlc.opt -c -o c2.cmi c2.mli -ocamlc.opt -c -o bb.cmo bb.ml -ocamlc.opt -c -o cc.cmo cc.ml -ocamlc.opt -a bb.cmo cc.cmo -o bbcc.cma -ocamldep.opt -modules main.ml > main.ml.depends -ocamldep.opt -modules c3.ml > c3.ml.depends -ocamlc.opt -c -o c3.cmo c3.ml -ocamlc.opt -c -o main.cmo main.ml -ocamldep.opt -modules cool_plugin.ml > cool_plugin.ml.depends -ocamlc.opt -c -o cool_plugin.cmo cool_plugin.ml -ocamldep.opt -modules c2.ml > c2.ml.depends -ocamlc.opt -c -o c2.cmo c2.ml -ocamlc.opt aa.cmo c2.cmo bbcc.cma c3.cmo main.cmo cool_plugin.cmo -o main.byte -ocamlopt.opt -c -o bb.cmx bb.ml -ocamlopt.opt -c -o aa.cmx aa.ml -ocamlopt.opt -c -o c2.cmx c2.ml -ocamlopt.opt -c -o cc.cmx cc.ml -ocamlopt.opt -a bb.cmx cc.cmx -o bbcc.cmxa -ocamlopt.opt -c -o c3.cmx c3.ml -ocamlopt.opt -c -o main.cmx main.ml -ocamlopt.opt aa.cmx c2.cmx bbcc.cmxa c3.cmx main.cmx -o main.native -+ ../../_build/ocamlbuild.native bbcc.cma main.byte bbcc.cmxa main.native -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt -[cache hit] ocamldep.opt -modules bb.mli > bb.mli.depends -[cache hit] ocamlc.opt -c -o bb.cmi bb.mli -[cache hit] ocamldep.opt -modules bb.ml > bb.ml.depends -[cache hit] ocamlc.opt -c -o bb.cmo bb.ml -[cache hit] ocamldep.opt -modules cc.ml > cc.ml.depends -[cache hit] ocamldep.opt -modules aa.ml > aa.ml.depends -[cache hit] ocamlc.opt -c -o aa.cmo aa.ml -[cache hit] ocamldep.opt -modules c2.mli > c2.mli.depends -[cache hit] ocamlc.opt -c -o c2.cmi c2.mli -[cache hit] ocamlc.opt -c -o cc.cmo cc.ml -[cache hit] ocamlc.opt -a bb.cmo cc.cmo -o bbcc.cma -[cache hit] ocamldep.opt -modules main.ml > main.ml.depends -[cache hit] ocamldep.opt -modules c3.ml > c3.ml.depends -[cache hit] ocamlc.opt -c -o c3.cmo c3.ml -[cache hit] ocamlc.opt -c -o main.cmo main.ml -[cache hit] ocamldep.opt -modules cool_plugin.ml > cool_plugin.ml.depends -[cache hit] ocamlc.opt -c -o cool_plugin.cmo cool_plugin.ml -[cache hit] ocamldep.opt -modules c2.ml > c2.ml.depends -[cache hit] ocamlc.opt -c -o c2.cmo c2.ml -[cache hit] ocamlc.opt aa.cmo c2.cmo bbcc.cma c3.cmo main.cmo cool_plugin.cmo -o main.byte -[cache hit] ocamlopt.opt -c -o bb.cmx bb.ml -[cache hit] ocamlopt.opt -c -o aa.cmx aa.ml -[cache hit] ocamlopt.opt -c -o c2.cmx c2.ml -[cache hit] ocamlopt.opt -c -o cc.cmx cc.ml -[cache hit] ocamlopt.opt -a bb.cmx cc.cmx -o bbcc.cmxa -[cache hit] ocamlopt.opt -c -o c3.cmx c3.ml -[cache hit] ocamlopt.opt -c -o main.cmx main.ml -[cache hit] ocamlopt.opt aa.cmx c2.cmx bbcc.cmxa c3.cmx main.cmx -o main.native -+ cp bb2.ml bb.ml -+ ../../_build/ocamlbuild.native bbcc.cma main.byte bbcc.cmxa main.native -no-skip -classic-display -verbose 0 -[cache hit] ocamldep.opt -modules bb.mli > bb.mli.depends -[cache hit] ocamlc.opt -c -o bb.cmi bb.mli -ocamldep.opt -modules bb.ml > bb.ml.depends -[cache hit] ocamldep.opt -modules cc.ml > cc.ml.depends -[cache hit] ocamldep.opt -modules aa.ml > aa.ml.depends -[cache hit] ocamlc.opt -c -o aa.cmo aa.ml -[cache hit] ocamldep.opt -modules c2.mli > c2.mli.depends -[cache hit] ocamlc.opt -c -o c2.cmi c2.mli -[cache hit] ocamlc.opt -c -o cc.cmo cc.ml -ocamlc.opt -c -o bb.cmo bb.ml -ocamlc.opt -a bb.cmo cc.cmo -o bbcc.cma -[cache hit] ocamldep.opt -modules main.ml > main.ml.depends -[cache hit] ocamldep.opt -modules c3.ml > c3.ml.depends -[cache hit] ocamlc.opt -c -o c3.cmo c3.ml -[cache hit] ocamlc.opt -c -o main.cmo main.ml -[cache hit] ocamldep.opt -modules cool_plugin.ml > cool_plugin.ml.depends -[cache hit] ocamlc.opt -c -o cool_plugin.cmo cool_plugin.ml -[cache hit] ocamldep.opt -modules c2.ml > c2.ml.depends -[cache hit] ocamlc.opt -c -o c2.cmo c2.ml -ocamlc.opt aa.cmo c2.cmo bbcc.cma c3.cmo main.cmo cool_plugin.cmo -o main.byte -[cache hit] ocamlopt.opt -c -o aa.cmx aa.ml -ocamlopt.opt -c -o bb.cmx bb.ml -[cache hit] ocamlopt.opt -c -o c2.cmx c2.ml -ocamlopt.opt -c -o cc.cmx cc.ml -ocamlopt.opt -a bb.cmx cc.cmx -o bbcc.cmxa -ocamlopt.opt -c -o c3.cmx c3.ml -ocamlopt.opt -c -o main.cmx main.ml -ocamlopt.opt aa.cmx c2.cmx bbcc.cmxa c3.cmx main.cmx -o main.native -+ ../../_build/ocamlbuild.native bbcc.cma main.byte bbcc.cmxa main.native -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt -[cache hit] ocamldep.opt -modules bb.mli > bb.mli.depends -[cache hit] ocamlc.opt -c -o bb.cmi bb.mli -[cache hit] ocamldep.opt -modules bb.ml > bb.ml.depends -[cache hit] ocamlc.opt -c -o bb.cmo bb.ml -[cache hit] ocamldep.opt -modules cc.ml > cc.ml.depends -[cache hit] ocamldep.opt -modules aa.ml > aa.ml.depends -[cache hit] ocamlc.opt -c -o aa.cmo aa.ml -[cache hit] ocamldep.opt -modules c2.mli > c2.mli.depends -[cache hit] ocamlc.opt -c -o c2.cmi c2.mli -[cache hit] ocamlc.opt -c -o cc.cmo cc.ml -[cache hit] ocamlc.opt -a bb.cmo cc.cmo -o bbcc.cma -[cache hit] ocamldep.opt -modules main.ml > main.ml.depends -[cache hit] ocamldep.opt -modules c3.ml > c3.ml.depends -[cache hit] ocamlc.opt -c -o c3.cmo c3.ml -[cache hit] ocamlc.opt -c -o main.cmo main.ml -[cache hit] ocamldep.opt -modules cool_plugin.ml > cool_plugin.ml.depends -[cache hit] ocamlc.opt -c -o cool_plugin.cmo cool_plugin.ml -[cache hit] ocamldep.opt -modules c2.ml > c2.ml.depends -[cache hit] ocamlc.opt -c -o c2.cmo c2.ml -[cache hit] ocamlc.opt aa.cmo c2.cmo bbcc.cma c3.cmo main.cmo cool_plugin.cmo -o main.byte -[cache hit] ocamlopt.opt -c -o bb.cmx bb.ml -[cache hit] ocamlopt.opt -c -o aa.cmx aa.ml -[cache hit] ocamlopt.opt -c -o c2.cmx c2.ml -[cache hit] ocamlopt.opt -c -o cc.cmx cc.ml -[cache hit] ocamlopt.opt -a bb.cmx cc.cmx -o bbcc.cmxa -[cache hit] ocamlopt.opt -c -o c3.cmx c3.ml -[cache hit] ocamlopt.opt -c -o main.cmx main.ml -[cache hit] ocamlopt.opt aa.cmx c2.cmx bbcc.cmxa c3.cmx main.cmx -o main.native -+ cp bb3.ml bb.ml -+ ../../_build/ocamlbuild.native bbcc.cma main.byte bbcc.cmxa main.native -no-skip -classic-display -verbose 0 -[cache hit] ocamldep.opt -modules bb.mli > bb.mli.depends -[cache hit] ocamlc.opt -c -o bb.cmi bb.mli -ocamldep.opt -modules bb.ml > bb.ml.depends -[cache hit] ocamldep.opt -modules cc.ml > cc.ml.depends -[cache hit] ocamldep.opt -modules aa.ml > aa.ml.depends -[cache hit] ocamlc.opt -c -o aa.cmo aa.ml -[cache hit] ocamldep.opt -modules c2.mli > c2.mli.depends -[cache hit] ocamlc.opt -c -o c2.cmi c2.mli -[cache hit] ocamlc.opt -c -o cc.cmo cc.ml -ocamlc.opt -c -o bb.cmo bb.ml -ocamlc.opt -a bb.cmo cc.cmo -o bbcc.cma -[cache hit] ocamldep.opt -modules main.ml > main.ml.depends -[cache hit] ocamldep.opt -modules c3.ml > c3.ml.depends -[cache hit] ocamlc.opt -c -o c3.cmo c3.ml -[cache hit] ocamlc.opt -c -o main.cmo main.ml -[cache hit] ocamldep.opt -modules cool_plugin.ml > cool_plugin.ml.depends -[cache hit] ocamlc.opt -c -o cool_plugin.cmo cool_plugin.ml -[cache hit] ocamldep.opt -modules c2.ml > c2.ml.depends -[cache hit] ocamlc.opt -c -o c2.cmo c2.ml -ocamlc.opt aa.cmo c2.cmo bbcc.cma c3.cmo main.cmo cool_plugin.cmo -o main.byte -[cache hit] ocamlopt.opt -c -o aa.cmx aa.ml -ocamlopt.opt -c -o bb.cmx bb.ml -[cache hit] ocamlopt.opt -c -o c2.cmx c2.ml -[cache hit] ocamlopt.opt -c -o cc.cmx cc.ml -ocamlopt.opt -a bb.cmx cc.cmx -o bbcc.cmxa -[cache hit] ocamlopt.opt -c -o c3.cmx c3.ml -[cache hit] ocamlopt.opt -c -o main.cmx main.ml -ocamlopt.opt aa.cmx c2.cmx bbcc.cmxa c3.cmx main.cmx -o main.native -+ ../../_build/ocamlbuild.native bbcc.cma main.byte bbcc.cmxa main.native -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt -[cache hit] ocamldep.opt -modules bb.mli > bb.mli.depends -[cache hit] ocamlc.opt -c -o bb.cmi bb.mli -[cache hit] ocamldep.opt -modules bb.ml > bb.ml.depends -[cache hit] ocamlc.opt -c -o bb.cmo bb.ml -[cache hit] ocamldep.opt -modules cc.ml > cc.ml.depends -[cache hit] ocamldep.opt -modules aa.ml > aa.ml.depends -[cache hit] ocamlc.opt -c -o aa.cmo aa.ml -[cache hit] ocamldep.opt -modules c2.mli > c2.mli.depends -[cache hit] ocamlc.opt -c -o c2.cmi c2.mli -[cache hit] ocamlc.opt -c -o cc.cmo cc.ml -[cache hit] ocamlc.opt -a bb.cmo cc.cmo -o bbcc.cma -[cache hit] ocamldep.opt -modules main.ml > main.ml.depends -[cache hit] ocamldep.opt -modules c3.ml > c3.ml.depends -[cache hit] ocamlc.opt -c -o c3.cmo c3.ml -[cache hit] ocamlc.opt -c -o main.cmo main.ml -[cache hit] ocamldep.opt -modules cool_plugin.ml > cool_plugin.ml.depends -[cache hit] ocamlc.opt -c -o cool_plugin.cmo cool_plugin.ml -[cache hit] ocamldep.opt -modules c2.ml > c2.ml.depends -[cache hit] ocamlc.opt -c -o c2.cmo c2.ml -[cache hit] ocamlc.opt aa.cmo c2.cmo bbcc.cma c3.cmo main.cmo cool_plugin.cmo -o main.byte -[cache hit] ocamlopt.opt -c -o bb.cmx bb.ml -[cache hit] ocamlopt.opt -c -o aa.cmx aa.ml -[cache hit] ocamlopt.opt -c -o c2.cmx c2.ml -[cache hit] ocamlopt.opt -c -o cc.cmx cc.ml -[cache hit] ocamlopt.opt -a bb.cmx cc.cmx -o bbcc.cmxa -[cache hit] ocamlopt.opt -c -o c3.cmx c3.ml -[cache hit] ocamlopt.opt -c -o main.cmx main.ml -[cache hit] ocamlopt.opt aa.cmx c2.cmx bbcc.cmxa c3.cmx main.cmx -o main.native - _____ _ ___ -|_ _|__ ___| |_( _ ) - | |/ _ \/ __| __/ _ \ - | | __/\__ \ || (_) | - |_|\___||___/\__\___/ - -+ CMDOPTS= -+ BUILD='../../_build/ocamlbuild.native a.byte a.native a a.opt bin/a bin/a.opt -no-skip -classic-display ' -+ BUILD1='../../_build/ocamlbuild.native a.byte a.native a a.opt bin/a bin/a.opt -no-skip -classic-display ' -+ BUILD2='../../_build/ocamlbuild.native a.byte a.native a a.opt bin/a bin/a.opt -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt ' -+ rm -rf _build -+ ../../_build/ocamlbuild.native a.byte a.native a a.opt bin/a bin/a.opt -no-skip -classic-display -ocamlopt.opt -I /Users/ertai/l/ocaml/ocamlbuild-unstable/ocamlbuild/_install/lib/ocamlbuild unix.cmxa /Users/ertai/l/ocaml/ocamlbuild-unstable/ocamlbuild/_install/lib/ocamlbuild/ocamlbuildlib.cmxa myocamlbuild.ml /Users/ertai/l/ocaml/ocamlbuild-unstable/ocamlbuild/_install/lib/ocamlbuild/ocamlbuild.cmx -o myocamlbuild -ocamldep.opt -modules a.ml > a.ml.depends -ocamldep.opt -modules myconfig.ml > myconfig.ml.depends -ocamlc.opt -c -o myconfig.cmo myconfig.ml -ocamlc.opt -c -o a.cmo a.ml -ocamlc.opt myconfig.cmo a.cmo -o a.byte -ocamlopt.opt -c -o myconfig.cmx myconfig.ml -ocamlopt.opt -c -o a.cmx a.ml -ocamlopt.opt myconfig.cmx a.cmx -o a.native -cp -p a.byte a -cp -p a.native a.opt -cp -p a.byte bin/a.byte -cp -p bin/a.byte bin/a -cp -p a.native bin/a.native -cp -p bin/a.native bin/a.opt -+ ../../_build/ocamlbuild.native a.byte a.native a a.opt bin/a bin/a.opt -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt -[cache hit] ocamldep.opt -modules a.ml > a.ml.depends -[cache hit] ocamldep.opt -modules myconfig.ml > myconfig.ml.depends -[cache hit] ocamlc.opt -c -o myconfig.cmo myconfig.ml -[cache hit] ocamlc.opt -c -o a.cmo a.ml -[cache hit] ocamlc.opt myconfig.cmo a.cmo -o a.byte -[cache hit] ocamlopt.opt -c -o myconfig.cmx myconfig.ml -[cache hit] ocamlopt.opt -c -o a.cmx a.ml -[cache hit] ocamlopt.opt myconfig.cmx a.cmx -o a.native -[cache hit] cp -p a.byte a -[cache hit] cp -p a.native a.opt -[cache hit] cp -p a.byte bin/a.byte -[cache hit] cp -p bin/a.byte bin/a -[cache hit] cp -p a.native bin/a.native -[cache hit] cp -p bin/a.native bin/a.opt - _____ _ ___ -|_ _|__ ___| |_ / _ \ - | |/ _ \/ __| __| (_) | - | | __/\__ \ |_ \__, | - |_|\___||___/\__| /_/ - -++ dirname ./test9/test.sh -+ cd ./test9/../.. -+ ./_build/ocamlbuild.native -quiet -build-dir _buildtest -no-links test/test9/testglob.native -+ ./_buildtest/test/test9/testglob.native -Globexp for "\"hello\"" OK -Globexp for "" OK -Globexp for "" OK -Globexp for " and or " OK -Globexp for " titi" OK -Glob.eval "<[a]>" "a" = true OK -Glob.eval "<[a]>" "b" = false OK -Glob.eval "<[a]>" "a" = true OK -Glob.eval "<[a]>" "b" = false OK -Glob.eval "<[a]>" "a" = true OK -Glob.eval "<[a]>" "b" = false OK -Glob.eval "<[a-z]>" "a" = true OK -Glob.eval "<[a-z]>" "e" = true OK -Glob.eval "<[a-z]>" "k" = true OK -Glob.eval "<[a-z]>" "z" = true OK -Glob.eval "<[a-z]>" "0" = false OK -Glob.eval "<[a-z]>" "A" = false OK -Glob.eval "<[a-z]>" "~" = false OK -Glob.eval "<[a-z]>" "a" = true OK -Glob.eval "<[a-z]>" "e" = true OK -Glob.eval "<[a-z]>" "k" = true OK -Glob.eval "<[a-z]>" "z" = true OK -Glob.eval "<[a-z]>" "0" = false OK -Glob.eval "<[a-z]>" "A" = false OK -Glob.eval "<[a-z]>" "~" = false OK -Glob.eval "<[a-z]>" "a" = true OK -Glob.eval "<[a-z]>" "e" = true OK -Glob.eval "<[a-z]>" "k" = true OK -Glob.eval "<[a-z]>" "z" = true OK -Glob.eval "<[a-z]>" "0" = false OK -Glob.eval "<[a-z]>" "A" = false OK -Glob.eval "<[a-z]>" "~" = false OK -Glob.eval "<[a-z][0-9]>" "a0" = true OK -Glob.eval "<[a-z][0-9]>" "b9" = true OK -Glob.eval "<[a-z][0-9]>" "a00" = false OK -Glob.eval "<[a-z][0-9]>" "a0a" = false OK -Glob.eval "<[a-z][0-9]>" "b0a" = false OK -Glob.eval "<[a-z][0-9]>" "isduis" = false OK -Glob.eval "<[a-z][0-9]>" "" = false OK -Glob.eval "<[a-z][0-9]>" "a0" = true OK -Glob.eval "<[a-z][0-9]>" "b9" = true OK -Glob.eval "<[a-z][0-9]>" "a00" = false OK -Glob.eval "<[a-z][0-9]>" "a0a" = false OK -Glob.eval "<[a-z][0-9]>" "b0a" = false OK -Glob.eval "<[a-z][0-9]>" "isduis" = false OK -Glob.eval "<[a-z][0-9]>" "" = false OK -Glob.eval "<[a-z][0-9]>" "a0" = true OK -Glob.eval "<[a-z][0-9]>" "b9" = true OK -Glob.eval "<[a-z][0-9]>" "a00" = false OK -Glob.eval "<[a-z][0-9]>" "a0a" = false OK -Glob.eval "<[a-z][0-9]>" "b0a" = false OK -Glob.eval "<[a-z][0-9]>" "isduis" = false OK -Glob.eval "<[a-z][0-9]>" "" = false OK -Glob.eval "" "hello" = true OK -Glob.eval "" "helli" = false OK -Glob.eval "" "hello" = true OK -Glob.eval "" "helli" = false OK -Glob.eval "" "hello" = true OK -Glob.eval "" "helli" = false OK -Glob.eval "\"hello\"" "hello" = true OK -Glob.eval "\"hello\"" "heidi" = false OK -Glob.eval "\"hello\"" "hello" = true OK -Glob.eval "\"hello\"" "heidi" = false OK -Glob.eval "\"hello\"" "hello" = true OK -Glob.eval "\"hello\"" "heidi" = false OK -Glob.eval "<*>" "" = true OK -Glob.eval "<*>" "a" = true OK -Glob.eval "<*>" "ax" = true OK -Glob.eval "<*>" "" = true OK -Glob.eval "<*>" "a" = true OK -Glob.eval "<*>" "ax" = true OK -Glob.eval "<*>" "" = true OK -Glob.eval "<*>" "a" = true OK -Glob.eval "<*>" "ax" = true OK -Glob.eval "" "ab" = true OK -Glob.eval "" "acb" = true OK -Glob.eval "" "axxxxxb" = true OK -Glob.eval "" "ababbababb" = true OK -Glob.eval "" "abx" = false OK -Glob.eval "" "xxxxxab" = false OK -Glob.eval "" "xab" = false OK -Glob.eval "" "ab" = true OK -Glob.eval "" "acb" = true OK -Glob.eval "" "axxxxxb" = true OK -Glob.eval "" "ababbababb" = true OK -Glob.eval "" "abx" = false OK -Glob.eval "" "xxxxxab" = false OK -Glob.eval "" "xab" = false OK -Glob.eval "" "ab" = true OK -Glob.eval "" "acb" = true OK -Glob.eval "" "axxxxxb" = true OK -Glob.eval "" "ababbababb" = true OK -Glob.eval "" "abx" = false OK -Glob.eval "" "xxxxxab" = false OK -Glob.eval "" "xab" = false OK -Glob.eval "<*.ml>" "hello.ml" = true OK -Glob.eval "<*.ml>" ".ml" = true OK -Glob.eval "<*.ml>" "ml" = false OK -Glob.eval "<*.ml>" "" = false OK -Glob.eval "<*.ml>" "toto.mli" = false OK -Glob.eval "<*.ml>" "hello.ml" = true OK -Glob.eval "<*.ml>" ".ml" = true OK -Glob.eval "<*.ml>" "ml" = false OK -Glob.eval "<*.ml>" "" = false OK -Glob.eval "<*.ml>" "toto.mli" = false OK -Glob.eval "<*.ml>" "hello.ml" = true OK -Glob.eval "<*.ml>" ".ml" = true OK -Glob.eval "<*.ml>" "ml" = false OK -Glob.eval "<*.ml>" "" = false OK -Glob.eval "<*.ml>" "toto.mli" = false OK -Glob.eval "" "a" = true OK -Glob.eval "" "" = false OK -Glob.eval "" "aa" = false OK -Glob.eval "" "ba" = false OK -Glob.eval "" "ab" = false OK -Glob.eval "" "abaa" = false OK -Glob.eval "" "a" = true OK -Glob.eval "" "" = false OK -Glob.eval "" "aa" = false OK -Glob.eval "" "ba" = false OK -Glob.eval "" "ab" = false OK -Glob.eval "" "abaa" = false OK -Glob.eval "" "a" = true OK -Glob.eval "" "" = false OK -Glob.eval "" "aa" = false OK -Glob.eval "" "ba" = false OK -Glob.eval "" "ab" = false OK -Glob.eval "" "abaa" = false OK -Glob.eval "" "ab" = true OK -Glob.eval "" "" = false OK -Glob.eval "" "abab" = false OK -Glob.eval "" "aba" = false OK -Glob.eval "" "abx" = false OK -Glob.eval "" "ab" = true OK -Glob.eval "" "" = false OK -Glob.eval "" "abab" = false OK -Glob.eval "" "aba" = false OK -Glob.eval "" "abx" = false OK -Glob.eval "" "ab" = true OK -Glob.eval "" "" = false OK -Glob.eval "" "abab" = false OK -Glob.eval "" "aba" = false OK -Glob.eval "" "abx" = false OK -Glob.eval "" "abac" = true OK -Glob.eval "" "abxc" = true OK -Glob.eval "" "abab" = false OK -Glob.eval "" "ababab" = false OK -Glob.eval "" "ababa" = false OK -Glob.eval "" "abac" = true OK -Glob.eval "" "abxc" = true OK -Glob.eval "" "abab" = false OK -Glob.eval "" "ababab" = false OK -Glob.eval "" "ababa" = false OK -Glob.eval "" "abac" = true OK -Glob.eval "" "abxc" = true OK -Glob.eval "" "abab" = false OK -Glob.eval "" "ababab" = false OK -Glob.eval "" "ababa" = false OK -Glob.eval "<*ab?cd*>" "123abecd345" = true OK -Glob.eval "<*ab?cd*>" "abccd" = true OK -Glob.eval "<*ab?cd*>" "abccd345" = true OK -Glob.eval "<*ab?cd*>" "ababcababccdab" = true OK -Glob.eval "<*ab?cd*>" "abcd" = false OK -Glob.eval "<*ab?cd*>" "aaaaabcdababcd" = false OK -Glob.eval "<*ab?cd*>" "123abecd345" = true OK -Glob.eval "<*ab?cd*>" "abccd" = true OK -Glob.eval "<*ab?cd*>" "abccd345" = true OK -Glob.eval "<*ab?cd*>" "ababcababccdab" = true OK -Glob.eval "<*ab?cd*>" "abcd" = false OK -Glob.eval "<*ab?cd*>" "aaaaabcdababcd" = false OK -Glob.eval "<*ab?cd*>" "123abecd345" = true OK -Glob.eval "<*ab?cd*>" "abccd" = true OK -Glob.eval "<*ab?cd*>" "abccd345" = true OK -Glob.eval "<*ab?cd*>" "ababcababccdab" = true OK -Glob.eval "<*ab?cd*>" "abcd" = false OK -Glob.eval "<*ab?cd*>" "aaaaabcdababcd" = false OK -Glob.eval "<*this*is*a*test*>" "this is a test" = true OK -Glob.eval "<*this*is*a*test*>" "You know this is a test really" = true OK -Glob.eval "<*this*is*a*test*>" "thisisatest" = true OK -Glob.eval "<*this*is*a*test*>" "thisatest" = false OK -Glob.eval "<*this*is*a*test*>" "this is a test" = true OK -Glob.eval "<*this*is*a*test*>" "You know this is a test really" = true OK -Glob.eval "<*this*is*a*test*>" "thisisatest" = true OK -Glob.eval "<*this*is*a*test*>" "thisatest" = false OK -Glob.eval "<*this*is*a*test*>" "this is a test" = true OK -Glob.eval "<*this*is*a*test*>" "You know this is a test really" = true OK -Glob.eval "<*this*is*a*test*>" "thisisatest" = true OK -Glob.eval "<*this*is*a*test*>" "thisatest" = false OK -Glob.eval "" "bxx" = true OK -Glob.eval "" "bx" = true OK -Glob.eval "" "aaab" = false OK -Glob.eval "" "" = false OK -Glob.eval "" "bxx" = true OK -Glob.eval "" "bx" = true OK -Glob.eval "" "aaab" = false OK -Glob.eval "" "" = false OK -Glob.eval "" "bxx" = true OK -Glob.eval "" "bx" = true OK -Glob.eval "" "aaab" = false OK -Glob.eval "" "" = false OK -Glob.eval "<*>" "" = true OK -Glob.eval "<*>" "a" = true OK -Glob.eval "<*>" "aaa" = true OK -Glob.eval "<*>" "aaaaa" = true OK -Glob.eval "<*>" "" = true OK -Glob.eval "<*>" "a" = true OK -Glob.eval "<*>" "aaa" = true OK -Glob.eval "<*>" "aaaaa" = true OK -Glob.eval "<*>" "" = true OK -Glob.eval "<*>" "a" = true OK -Glob.eval "<*>" "aaa" = true OK -Glob.eval "<*>" "aaaaa" = true OK -Glob.eval "" "a" = true OK -Glob.eval "" "" = false OK -Glob.eval "" "aaa" = false OK -Glob.eval "" "aaaaa" = false OK -Glob.eval "" "a" = true OK -Glob.eval "" "" = false OK -Glob.eval "" "aaa" = false OK -Glob.eval "" "aaaaa" = false OK -Glob.eval "" "a" = true OK -Glob.eval "" "" = false OK -Glob.eval "" "aaa" = false OK -Glob.eval "" "aaaaa" = false OK -Glob.eval "<{a,b}>" "a" = true OK -Glob.eval "<{a,b}>" "b" = true OK -Glob.eval "<{a,b}>" "" = false OK -Glob.eval "<{a,b}>" "aa" = false OK -Glob.eval "<{a,b}>" "ab" = false OK -Glob.eval "<{a,b}>" "ba" = false OK -Glob.eval "<{a,b}>" "bb" = false OK -Glob.eval "<{a,b}>" "c" = false OK -Glob.eval "<{a,b}>" "a" = true OK -Glob.eval "<{a,b}>" "b" = true OK -Glob.eval "<{a,b}>" "" = false OK -Glob.eval "<{a,b}>" "aa" = false OK -Glob.eval "<{a,b}>" "ab" = false OK -Glob.eval "<{a,b}>" "ba" = false OK -Glob.eval "<{a,b}>" "bb" = false OK -Glob.eval "<{a,b}>" "c" = false OK -Glob.eval "<{a,b}>" "a" = true OK -Glob.eval "<{a,b}>" "b" = true OK -Glob.eval "<{a,b}>" "" = false OK -Glob.eval "<{a,b}>" "aa" = false OK -Glob.eval "<{a,b}>" "ab" = false OK -Glob.eval "<{a,b}>" "ba" = false OK -Glob.eval "<{a,b}>" "bb" = false OK -Glob.eval "<{a,b}>" "c" = false OK -Glob.eval "" "toto.ml" = true OK -Glob.eval "" "toto.mli" = true OK -Glob.eval "" "toto." = false OK -Glob.eval "" "toto.mll" = false OK -Glob.eval "" "toto.ml" = true OK -Glob.eval "" "toto.mli" = true OK -Glob.eval "" "toto." = false OK -Glob.eval "" "toto.mll" = false OK -Glob.eval "" "toto.ml" = true OK -Glob.eval "" "toto.mli" = true OK -Glob.eval "" "toto." = false OK -Glob.eval "" "toto.mll" = false OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "acf" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "acg" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "adf" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "adg" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "aef" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "aeg" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "bcf" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "bcg" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "bdf" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "bdg" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "bef" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "beg" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "afg" = false OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "af" = false OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "aee" = false OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "acf" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "acg" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "adf" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "adg" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "aef" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "aeg" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "bcf" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "bcg" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "bdf" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "bdg" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "bef" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "beg" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "afg" = false OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "af" = false OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "aee" = false OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "acf" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "acg" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "adf" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "adg" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "aef" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "aeg" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "bcf" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "bcg" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "bdf" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "bdg" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "bef" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "beg" = true OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "afg" = false OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "af" = false OK -Glob.eval "<{a,b}{c,[de]}{f,g}>" "aee" = false OK -Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.ml" = true OK -Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "b.ml" = true OK -Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.mli" = true OK -Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "hello.ml" = false OK -Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.mli.x" = false OK -Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.ml" = true OK -Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "b.ml" = true OK -Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.mli" = true OK -Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "hello.ml" = false OK -Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.mli.x" = false OK -Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.ml" = true OK -Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "b.ml" = true OK -Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.mli" = true OK -Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "hello.ml" = false OK -Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.mli.x" = false OK -Glob.eval "<*>" "alpha" = true OK -Glob.eval "<*>" "beta" = true OK -Glob.eval "<*>" "alpha/beta" = false OK -Glob.eval "<*>" "gamma/delta" = false OK -Glob.eval "<*>" "alpha" = true OK -Glob.eval "<*>" "beta" = true OK -Glob.eval "<*>" "alpha/beta" = false OK -Glob.eval "<*>" "gamma/delta" = false OK -Glob.eval "<*>" "alpha" = true OK -Glob.eval "<*>" "beta" = true OK -Glob.eval "<*>" "alpha/beta" = false OK -Glob.eval "<*>" "gamma/delta" = false OK -Glob.eval "" "alpha/beta" = true OK -Glob.eval "" "alpha/gamma/beta" = true OK -Glob.eval "" "alpha/gamma/delta/beta" = true OK -Glob.eval "" "alpha" = false OK -Glob.eval "" "beta" = false OK -Glob.eval "" "gamma/delta" = false OK -Glob.eval "" "alpha/beta" = true OK -Glob.eval "" "alpha/gamma/beta" = true OK -Glob.eval "" "alpha/gamma/delta/beta" = true OK -Glob.eval "" "alpha" = false OK -Glob.eval "" "beta" = false OK -Glob.eval "" "gamma/delta" = false OK -Glob.eval "" "alpha/beta" = true OK -Glob.eval "" "alpha/gamma/beta" = true OK -Glob.eval "" "alpha/gamma/delta/beta" = true OK -Glob.eval "" "alpha" = false OK -Glob.eval "" "beta" = false OK -Glob.eval "" "gamma/delta" = false OK -Glob.eval "<**/*.ml>" "toto.ml" = true OK -Glob.eval "<**/*.ml>" "toto/tata.ml" = true OK -Glob.eval "<**/*.ml>" "alpha/gamma/delta/beta.ml" = true OK -Glob.eval "<**/*.ml>" "toto.mli" = false OK -Glob.eval "<**/*.ml>" "toto.ml" = true OK -Glob.eval "<**/*.ml>" "toto/tata.ml" = true OK -Glob.eval "<**/*.ml>" "alpha/gamma/delta/beta.ml" = true OK -Glob.eval "<**/*.ml>" "toto.mli" = false OK -Glob.eval "<**/*.ml>" "toto.ml" = true OK -Glob.eval "<**/*.ml>" "toto/tata.ml" = true OK -Glob.eval "<**/*.ml>" "alpha/gamma/delta/beta.ml" = true OK -Glob.eval "<**/*.ml>" "toto.mli" = false OK -Glob.eval "" "toto/" = true OK -Glob.eval "" "toto/tata" = true OK -Glob.eval "" "toto/alpha/gamma/delta/beta.ml" = true OK -Glob.eval "" "toto" = true OK -Glob.eval "" "toto2/tata" = false OK -Glob.eval "" "tata/titi" = false OK -Glob.eval "" "toto/" = true OK -Glob.eval "" "toto/tata" = true OK -Glob.eval "" "toto/alpha/gamma/delta/beta.ml" = true OK -Glob.eval "" "toto" = true OK -Glob.eval "" "toto2/tata" = false OK -Glob.eval "" "tata/titi" = false OK -Glob.eval "" "toto/" = true OK -Glob.eval "" "toto/tata" = true OK -Glob.eval "" "toto/alpha/gamma/delta/beta.ml" = true OK -Glob.eval "" "toto" = true OK -Glob.eval "" "toto2/tata" = false OK -Glob.eval "" "tata/titi" = false OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo.a" OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "src/bar/libfoo.a" OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "otherlibs/unix/libunix.a" OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "otherlibsliblib/unlibix/libunix.a" OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo/libbar.a" OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "src/libfoo/boo/libbar.a" OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "bar" = None OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libbar/foo.a" = None OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo.b.a" = None OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo.a" OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "src/bar/libfoo.a" OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "otherlibs/unix/libunix.a" OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "otherlibsliblib/unlibix/libunix.a" OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo/libbar.a" OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "src/libfoo/boo/libbar.a" OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "bar" = None OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libbar/foo.a" = None OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo.b.a" = None OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo.a" OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "src/bar/libfoo.a" OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "otherlibs/unix/libunix.a" OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "otherlibsliblib/unlibix/libunix.a" OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo/libbar.a" OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "src/libfoo/boo/libbar.a" OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "bar" = None OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libbar/foo.a" = None OK -Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo.b.a" = None OK - _____ _ __ ___ _ _ -|_ _|__ ___| |_ \ \ / (_)_ __| |_ _ _ __ _| | - | |/ _ \/ __| __| \ \ / /| | '__| __| | | |/ _` | | - | | __/\__ \ |_ \ V / | | | | |_| |_| | (_| | | - |_|\___||___/\__| \_/ |_|_| \__|\__,_|\__,_|_| - - _____ _ -|_ _|_ _ _ __ __ _ ___| |_ ___ - | |/ _` | '__/ _` |/ _ \ __/ __| - | | (_| | | | (_| | __/ |_\__ \ - |_|\__,_|_| \__, |\___|\__|___/ - |___/ -+ CMDOPTS= -+ BUILD='../../_build/ocamlbuild.native bar -no-skip -classic-display ' -+ BUILD1='../../_build/ocamlbuild.native bar -no-skip -classic-display ' -+ BUILD2='../../_build/ocamlbuild.native bar -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt ' -+ rm -rf _build -+ cp foo1 foo -+ ../../_build/ocamlbuild.native bar -no-skip -classic-display -ocamlopt.opt -I /Users/ertai/l/ocaml/ocamlbuild-unstable/ocamlbuild/_install/lib/ocamlbuild unix.cmxa /Users/ertai/l/ocaml/ocamlbuild-unstable/ocamlbuild/_install/lib/ocamlbuild/ocamlbuildlib.cmxa myocamlbuild.ml /Users/ertai/l/ocaml/ocamlbuild-unstable/ocamlbuild/_install/lib/ocamlbuild/ocamlbuild.cmx -o myocamlbuild -cp foo bar -+ ../../_build/ocamlbuild.native bar -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt -[cache hit] cp foo bar -+ cp foo2 foo -+ ../../_build/ocamlbuild.native bar -no-skip -classic-display -verbose 0 -cp foo bar -+ ../../_build/ocamlbuild.native bar -no-skip -classic-display -verbose 0 -nothing-should-be-rebuilt -[cache hit] cp foo bar -+ rm foo diff -Nru ocaml-3.12.1/ocamlbuild/test/runtest.sh ocaml-4.01.0/ocamlbuild/test/runtest.sh --- ocaml-3.12.1/ocamlbuild/test/runtest.sh 2007-11-21 21:16:47.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/runtest.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,36 +0,0 @@ -#!/bin/sh -set -e -cd `dirname $0` - -myfiglet() { - figlet $@ | sed 's/ *$//' -} - -if figlet ""; then - BANNER=myfiglet -else - echo "Install figlet to have a better output, press enter to continue with echo" - read - BANNER=echo -fi - -HERE=`pwd` - -$BANNER Test2 -./test2/test.sh $@ -$BANNER Test3 -./test3/test.sh $@ -$BANNER Test4 -./test4/test.sh $@ -$BANNER Test5 -./test5/test.sh $@ -$BANNER Test6 -./test6/test.sh $@ -$BANNER Test7 -./test7/test.sh $@ -$BANNER Test8 -./test8/test.sh $@ -$BANNER Test9 -./test9/test.sh $@ -$BANNER Test Virtual Targets -./test_virtual/test.sh $@ diff -Nru ocaml-3.12.1/ocamlbuild/test/test1/foo.ml ocaml-4.01.0/ocamlbuild/test/test1/foo.ml --- ocaml-3.12.1/ocamlbuild/test/test1/foo.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test1/foo.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -module MA1 = A1 diff -Nru ocaml-3.12.1/ocamlbuild/test/test10/dbdi ocaml-4.01.0/ocamlbuild/test/test10/dbdi --- ocaml-3.12.1/ocamlbuild/test/test10/dbdi 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test10/dbdi 1970-01-01 00:00:00.000000000 +0000 @@ -1,12 +0,0 @@ -#load "discard_printf.cmo";; -#load "debug.cmo";; -#load "unix.cma";; -#load "str.cma";; -#load "my_unix.cmo";; -#load "bool.cmo";; -#load "glob_ast.cmo";; -#load "glob_lexer.cmo";; -#load "glob.cmo";; -#load "lexers.cmo";; -#load "my_std.cmo";; -#load "tags.cmo";; diff -Nru ocaml-3.12.1/ocamlbuild/test/test10/test.sh ocaml-4.01.0/ocamlbuild/test/test10/test.sh --- ocaml-3.12.1/ocamlbuild/test/test10/test.sh 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test10/test.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -#!/bin/sh -set -e -set -x -cd `dirname $0`/../.. -./_build/ocamlbuild.native -quiet -build-dir _buildtest -no-links test/test9/testglob.native -./_buildtest/test/test9/testglob.native diff -Nru ocaml-3.12.1/ocamlbuild/test/test11/_tags ocaml-4.01.0/ocamlbuild/test/test11/_tags --- ocaml-3.12.1/ocamlbuild/test/test11/_tags 2008-07-25 14:53:21.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test11/_tags 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -# a comment -"a/aa.byte" or "a/aa.native": use_libb diff -Nru ocaml-3.12.1/ocamlbuild/test/test11/a/aa.ml ocaml-4.01.0/ocamlbuild/test/test11/a/aa.ml --- ocaml-3.12.1/ocamlbuild/test/test11/a/aa.ml 2008-07-25 14:53:21.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test11/a/aa.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -let bar = 3 + List.length Bb.foo diff -Nru ocaml-3.12.1/ocamlbuild/test/test11/a/aa.mli ocaml-4.01.0/ocamlbuild/test/test11/a/aa.mli --- ocaml-3.12.1/ocamlbuild/test/test11/a/aa.mli 2008-07-25 14:53:21.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test11/a/aa.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -val bar : int diff -Nru ocaml-3.12.1/ocamlbuild/test/test11/b/bb.ml ocaml-4.01.0/ocamlbuild/test/test11/b/bb.ml --- ocaml-3.12.1/ocamlbuild/test/test11/b/bb.ml 2008-07-25 14:53:21.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test11/b/bb.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -let foo = [2.2] diff -Nru ocaml-3.12.1/ocamlbuild/test/test11/b/libb.mllib ocaml-4.01.0/ocamlbuild/test/test11/b/libb.mllib --- ocaml-3.12.1/ocamlbuild/test/test11/b/libb.mllib 2008-07-25 14:53:21.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test11/b/libb.mllib 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -Bb diff -Nru ocaml-3.12.1/ocamlbuild/test/test11/myocamlbuild.ml ocaml-4.01.0/ocamlbuild/test/test11/myocamlbuild.ml --- ocaml-3.12.1/ocamlbuild/test/test11/myocamlbuild.ml 2008-07-25 14:53:21.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test11/myocamlbuild.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,5 +0,0 @@ -open Ocamlbuild_plugin;; -dispatch begin function -| After_rules -> ocaml_lib "b/libb" -| _ -> () -end diff -Nru ocaml-3.12.1/ocamlbuild/test/test11/test.sh ocaml-4.01.0/ocamlbuild/test/test11/test.sh --- ocaml-3.12.1/ocamlbuild/test/test11/test.sh 2008-07-25 14:53:21.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test11/test.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,13 +0,0 @@ -#!/bin/sh -cd `dirname $0` -set -e -set -x -CMDOTPS="" # -- command args -BUILD="../../_build/ocamlbuild.native -I a -I b aa.byte aa.native -no-skip -classic-display $@" -BUILD1="$BUILD $CMDOPTS" -BUILD2="$BUILD -verbose 0 -nothing-should-be-rebuilt $CMDOPTS" -rm -rf _build -$BUILD1 -echo looks if libs are there -ls _build/b/libb.cma _build/b/libb.cmxa _build/b/libb.a -$BUILD2 diff -Nru ocaml-3.12.1/ocamlbuild/test/test2/_tags ocaml-4.01.0/ocamlbuild/test/test2/_tags --- ocaml-3.12.1/ocamlbuild/test/test2/_tags 2008-07-25 15:02:45.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test2/_tags 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -"vivi.ml": camlp4o - -# , some_useless_tag, \ more_useless_tags diff -Nru ocaml-3.12.1/ocamlbuild/test/test2/tata.ml ocaml-4.01.0/ocamlbuild/test/test2/tata.ml --- ocaml-3.12.1/ocamlbuild/test/test2/tata.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test2/tata.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -let tata = "TATA2" diff -Nru ocaml-3.12.1/ocamlbuild/test/test2/tata.mli ocaml-4.01.0/ocamlbuild/test/test2/tata.mli --- ocaml-3.12.1/ocamlbuild/test/test2/tata.mli 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test2/tata.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -(* a comment *) -val tata : string diff -Nru ocaml-3.12.1/ocamlbuild/test/test2/test.sh ocaml-4.01.0/ocamlbuild/test/test2/test.sh --- ocaml-3.12.1/ocamlbuild/test/test2/test.sh 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test2/test.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,18 +0,0 @@ -#!/bin/sh -cd `dirname $0` -set -e -set -x -CMDOPTS="-- -help" -BUILD="../../_build/ocamlbuild.native toto.byte toto.native -no-skip -classic-display $@" -BUILD1="$BUILD $CMDOPTS" -BUILD2="$BUILD -verbose 0 -nothing-should-be-rebuilt $CMDOPTS" -rm -rf _build -cp vivi1.ml vivi.ml -$BUILD1 -$BUILD2 -cp vivi2.ml vivi.ml -$BUILD1 -$BUILD2 -cp vivi3.ml vivi.ml -$BUILD1 -$BUILD2 diff -Nru ocaml-3.12.1/ocamlbuild/test/test2/titi.ml ocaml-4.01.0/ocamlbuild/test/test2/titi.ml --- ocaml-3.12.1/ocamlbuild/test/test2/titi.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test2/titi.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -let titi = [] diff -Nru ocaml-3.12.1/ocamlbuild/test/test2/toto.ml ocaml-4.01.0/ocamlbuild/test/test2/toto.ml --- ocaml-3.12.1/ocamlbuild/test/test2/toto.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test2/toto.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,5 +0,0 @@ -let i = Tutu.tutu + 10 -let s = Tata.tata ^ ".ml" -let l = 3 :: Titi.titi -let () = Format.printf "toto.native: %s: Hello world!!!@." Sys.argv.(0) -let () = Format.printf "Tutu.tutu => %d@.Tata.tata => %S@." Tutu.tutu Tata.tata diff -Nru ocaml-3.12.1/ocamlbuild/test/test2/tutu.ml ocaml-4.01.0/ocamlbuild/test/test2/tutu.ml --- ocaml-3.12.1/ocamlbuild/test/test2/tutu.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test2/tutu.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -let tutu = (Array.length Vivi.vivi : Tyty.t) -let tutu' = 2.0 +. float_of_int tutu diff -Nru ocaml-3.12.1/ocamlbuild/test/test2/tutu.mli ocaml-4.01.0/ocamlbuild/test/test2/tutu.mli --- ocaml-3.12.1/ocamlbuild/test/test2/tutu.mli 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test2/tutu.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -(* a comment *) -val tutu : int -val tutu' : float diff -Nru ocaml-3.12.1/ocamlbuild/test/test2/tyty.mli ocaml-4.01.0/ocamlbuild/test/test2/tyty.mli --- ocaml-3.12.1/ocamlbuild/test/test2/tyty.mli 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test2/tyty.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -type t = int diff -Nru ocaml-3.12.1/ocamlbuild/test/test2/vivi1.ml ocaml-4.01.0/ocamlbuild/test/test2/vivi1.ml --- ocaml-3.12.1/ocamlbuild/test/test2/vivi1.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test2/vivi1.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -let rec p i = [< '1; '2; p (i + 1) >] -let vivi = [|2|] diff -Nru ocaml-3.12.1/ocamlbuild/test/test2/vivi2.ml ocaml-4.01.0/ocamlbuild/test/test2/vivi2.ml --- ocaml-3.12.1/ocamlbuild/test/test2/vivi2.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test2/vivi2.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -let rec p i = [< '1; '2; p (i + 1) >] -let vivi = [|3|] diff -Nru ocaml-3.12.1/ocamlbuild/test/test2/vivi3.ml ocaml-4.01.0/ocamlbuild/test/test2/vivi3.ml --- ocaml-3.12.1/ocamlbuild/test/test2/vivi3.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test2/vivi3.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -let rec p i = [< '1; '2; p (i + 1) >] -let vivi = [|2.1; 1.1|] diff -Nru ocaml-3.12.1/ocamlbuild/test/test3/_tags ocaml-4.01.0/ocamlbuild/test/test3/_tags --- ocaml-3.12.1/ocamlbuild/test/test3/_tags 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test3/_tags 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -"a.byte" or "a.native": use_unix diff -Nru ocaml-3.12.1/ocamlbuild/test/test3/a.ml ocaml-4.01.0/ocamlbuild/test/test3/a.ml --- ocaml-3.12.1/ocamlbuild/test/test3/a.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test3/a.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -module X = B diff -Nru ocaml-3.12.1/ocamlbuild/test/test3/a.mli ocaml-4.01.0/ocamlbuild/test/test3/a.mli --- ocaml-3.12.1/ocamlbuild/test/test3/a.mli 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test3/a.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -(* Nothing *) diff -Nru ocaml-3.12.1/ocamlbuild/test/test3/b.ml ocaml-4.01.0/ocamlbuild/test/test3/b.ml --- ocaml-3.12.1/ocamlbuild/test/test3/b.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test3/b.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -module X = C diff -Nru ocaml-3.12.1/ocamlbuild/test/test3/b.mli ocaml-4.01.0/ocamlbuild/test/test3/b.mli --- ocaml-3.12.1/ocamlbuild/test/test3/b.mli 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test3/b.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -(* nothing *) diff -Nru ocaml-3.12.1/ocamlbuild/test/test3/c.ml ocaml-4.01.0/ocamlbuild/test/test3/c.ml --- ocaml-3.12.1/ocamlbuild/test/test3/c.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test3/c.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -module X = D diff -Nru ocaml-3.12.1/ocamlbuild/test/test3/c.mli ocaml-4.01.0/ocamlbuild/test/test3/c.mli --- ocaml-3.12.1/ocamlbuild/test/test3/c.mli 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test3/c.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -(* nothing *) diff -Nru ocaml-3.12.1/ocamlbuild/test/test3/d.ml ocaml-4.01.0/ocamlbuild/test/test3/d.ml --- ocaml-3.12.1/ocamlbuild/test/test3/d.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test3/d.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -module X = E diff -Nru ocaml-3.12.1/ocamlbuild/test/test3/d.mli ocaml-4.01.0/ocamlbuild/test/test3/d.mli --- ocaml-3.12.1/ocamlbuild/test/test3/d.mli 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test3/d.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -(* nothing *) diff -Nru ocaml-3.12.1/ocamlbuild/test/test3/e.ml ocaml-4.01.0/ocamlbuild/test/test3/e.ml --- ocaml-3.12.1/ocamlbuild/test/test3/e.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test3/e.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -module X = F diff -Nru ocaml-3.12.1/ocamlbuild/test/test3/e.mli ocaml-4.01.0/ocamlbuild/test/test3/e.mli --- ocaml-3.12.1/ocamlbuild/test/test3/e.mli 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test3/e.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -(* nothing *) diff -Nru ocaml-3.12.1/ocamlbuild/test/test3/f.ml ocaml-4.01.0/ocamlbuild/test/test3/f.ml --- ocaml-3.12.1/ocamlbuild/test/test3/f.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test3/f.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -(* nothing *) -let _ = Unix.stat diff -Nru ocaml-3.12.1/ocamlbuild/test/test3/f.mli ocaml-4.01.0/ocamlbuild/test/test3/f.mli --- ocaml-3.12.1/ocamlbuild/test/test3/f.mli 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test3/f.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -(* nothing *) diff -Nru ocaml-3.12.1/ocamlbuild/test/test3/proj.odocl ocaml-4.01.0/ocamlbuild/test/test3/proj.odocl --- ocaml-3.12.1/ocamlbuild/test/test3/proj.odocl 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test3/proj.odocl 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -A B C D E F diff -Nru ocaml-3.12.1/ocamlbuild/test/test3/test.sh ocaml-4.01.0/ocamlbuild/test/test3/test.sh --- ocaml-3.12.1/ocamlbuild/test/test3/test.sh 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test3/test.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,11 +0,0 @@ -#!/bin/sh -cd `dirname $0` -set -e -set -x -CMDOTPS="" # -- command args -BUILD="../../_build/ocamlbuild.native a.byte a.native proj.docdir/index.html -no-skip -classic-display $@" -BUILD1="$BUILD $CMDOPTS" -BUILD2="$BUILD -verbose 0 -nothing-should-be-rebuilt $CMDOPTS" -rm -rf _build -$BUILD1 -$BUILD2 diff -Nru ocaml-3.12.1/ocamlbuild/test/test4/_tags ocaml-4.01.0/ocamlbuild/test/test4/_tags --- ocaml-3.12.1/ocamlbuild/test/test4/_tags 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test4/_tags 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -# a comment -"a/aa.byte" or "a/aa.native": use_str diff -Nru ocaml-3.12.1/ocamlbuild/test/test4/a/aa.ml ocaml-4.01.0/ocamlbuild/test/test4/a/aa.ml --- ocaml-3.12.1/ocamlbuild/test/test4/a/aa.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test4/a/aa.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -let bar = 3 + List.length Bb.foo diff -Nru ocaml-3.12.1/ocamlbuild/test/test4/a/aa.mli ocaml-4.01.0/ocamlbuild/test/test4/a/aa.mli --- ocaml-3.12.1/ocamlbuild/test/test4/a/aa.mli 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test4/a/aa.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -val bar : int diff -Nru ocaml-3.12.1/ocamlbuild/test/test4/b/bb.ml ocaml-4.01.0/ocamlbuild/test/test4/b/bb.ml --- ocaml-3.12.1/ocamlbuild/test/test4/b/bb.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test4/b/bb.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -let r = Str.regexp "r" -let foo = [2.2] diff -Nru ocaml-3.12.1/ocamlbuild/test/test4/test.sh ocaml-4.01.0/ocamlbuild/test/test4/test.sh --- ocaml-3.12.1/ocamlbuild/test/test4/test.sh 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test4/test.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,11 +0,0 @@ -#!/bin/sh -cd `dirname $0` -set -e -set -x -CMDOTPS="" # -- command args -BUILD="../../_build/ocamlbuild.native -I a -I b aa.byte aa.native -no-skip -classic-display $@" -BUILD1="$BUILD $CMDOPTS" -BUILD2="$BUILD -verbose 0 -nothing-should-be-rebuilt $CMDOPTS" -rm -rf _build -$BUILD1 -$BUILD2 diff -Nru ocaml-3.12.1/ocamlbuild/test/test5/_tags ocaml-4.01.0/ocamlbuild/test/test5/_tags --- ocaml-3.12.1/ocamlbuild/test/test5/_tags 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test5/_tags 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -"a.cmx" or "b.cmx": for-pack(C) diff -Nru ocaml-3.12.1/ocamlbuild/test/test5/a.ml ocaml-4.01.0/ocamlbuild/test/test5/a.ml --- ocaml-3.12.1/ocamlbuild/test/test5/a.ml 2007-02-08 16:53:39.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test5/a.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -let a = 42 + Stack.stack diff -Nru ocaml-3.12.1/ocamlbuild/test/test5/a.mli ocaml-4.01.0/ocamlbuild/test/test5/a.mli --- ocaml-3.12.1/ocamlbuild/test/test5/a.mli 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test5/a.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -val a : int diff -Nru ocaml-3.12.1/ocamlbuild/test/test5/b.ml ocaml-4.01.0/ocamlbuild/test/test5/b.ml --- ocaml-3.12.1/ocamlbuild/test/test5/b.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test5/b.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -let b = A.a + 1 diff -Nru ocaml-3.12.1/ocamlbuild/test/test5/c.mlpack ocaml-4.01.0/ocamlbuild/test/test5/c.mlpack --- ocaml-3.12.1/ocamlbuild/test/test5/c.mlpack 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test5/c.mlpack 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -A B diff -Nru ocaml-3.12.1/ocamlbuild/test/test5/d.ml ocaml-4.01.0/ocamlbuild/test/test5/d.ml --- ocaml-3.12.1/ocamlbuild/test/test5/d.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test5/d.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -Format.printf "C.B.b = %d@." C.B.b diff -Nru ocaml-3.12.1/ocamlbuild/test/test5/stack.ml ocaml-4.01.0/ocamlbuild/test/test5/stack.ml --- ocaml-3.12.1/ocamlbuild/test/test5/stack.ml 2007-02-08 16:54:43.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test5/stack.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -let stack = 42 diff -Nru ocaml-3.12.1/ocamlbuild/test/test5/test.sh ocaml-4.01.0/ocamlbuild/test/test5/test.sh --- ocaml-3.12.1/ocamlbuild/test/test5/test.sh 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test5/test.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,11 +0,0 @@ -#!/bin/sh -cd `dirname $0` -set -e -set -x -CMDOPTS="" # -- command args -BUILD="../../_build/ocamlbuild.native d.byte d.native -no-skip -classic-display $@" -BUILD1="$BUILD $CMDOPTS" -BUILD2="$BUILD -verbose 0 -nothing-should-be-rebuilt $CMDOPTS" -rm -rf _build -$BUILD1 -$BUILD2 diff -Nru ocaml-3.12.1/ocamlbuild/test/test6/a.ml ocaml-4.01.0/ocamlbuild/test/test6/a.ml --- ocaml-3.12.1/ocamlbuild/test/test6/a.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test6/a.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -let a = B.b diff -Nru ocaml-3.12.1/ocamlbuild/test/test6/a.mli ocaml-4.01.0/ocamlbuild/test/test6/a.mli --- ocaml-3.12.1/ocamlbuild/test/test6/a.mli 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test6/a.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -val a : 'a -> 'a diff -Nru ocaml-3.12.1/ocamlbuild/test/test6/b.ml ocaml-4.01.0/ocamlbuild/test/test6/b.ml --- ocaml-3.12.1/ocamlbuild/test/test6/b.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test6/b.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -let b = D.d diff -Nru ocaml-3.12.1/ocamlbuild/test/test6/b.mli ocaml-4.01.0/ocamlbuild/test/test6/b.mli --- ocaml-3.12.1/ocamlbuild/test/test6/b.mli 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test6/b.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -val b : 'a -> 'a diff -Nru ocaml-3.12.1/ocamlbuild/test/test6/b.mli.v1 ocaml-4.01.0/ocamlbuild/test/test6/b.mli.v1 --- ocaml-3.12.1/ocamlbuild/test/test6/b.mli.v1 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test6/b.mli.v1 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -val b : 'a -> 'a diff -Nru ocaml-3.12.1/ocamlbuild/test/test6/b.mli.v2 ocaml-4.01.0/ocamlbuild/test/test6/b.mli.v2 --- ocaml-3.12.1/ocamlbuild/test/test6/b.mli.v2 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test6/b.mli.v2 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -.... -val b : 'a -> 'a diff -Nru ocaml-3.12.1/ocamlbuild/test/test6/d.ml ocaml-4.01.0/ocamlbuild/test/test6/d.ml --- ocaml-3.12.1/ocamlbuild/test/test6/d.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test6/d.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -type t -let d x = x diff -Nru ocaml-3.12.1/ocamlbuild/test/test6/d.mli ocaml-4.01.0/ocamlbuild/test/test6/d.mli --- ocaml-3.12.1/ocamlbuild/test/test6/d.mli 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test6/d.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -val d : 'a -> 'a diff -Nru ocaml-3.12.1/ocamlbuild/test/test6/d.mli.v1 ocaml-4.01.0/ocamlbuild/test/test6/d.mli.v1 --- ocaml-3.12.1/ocamlbuild/test/test6/d.mli.v1 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test6/d.mli.v1 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -type t -val d : 'a -> 'a diff -Nru ocaml-3.12.1/ocamlbuild/test/test6/d.mli.v2 ocaml-4.01.0/ocamlbuild/test/test6/d.mli.v2 --- ocaml-3.12.1/ocamlbuild/test/test6/d.mli.v2 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test6/d.mli.v2 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -val d : 'a -> 'a diff -Nru ocaml-3.12.1/ocamlbuild/test/test6/main.ml ocaml-4.01.0/ocamlbuild/test/test6/main.ml --- ocaml-3.12.1/ocamlbuild/test/test6/main.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test6/main.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -A.a 2. +. D.d 1. diff -Nru ocaml-3.12.1/ocamlbuild/test/test6/main.mli ocaml-4.01.0/ocamlbuild/test/test6/main.mli --- ocaml-3.12.1/ocamlbuild/test/test6/main.mli 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test6/main.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -(* nothing *) diff -Nru ocaml-3.12.1/ocamlbuild/test/test6/test.sh ocaml-4.01.0/ocamlbuild/test/test6/test.sh --- ocaml-3.12.1/ocamlbuild/test/test6/test.sh 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test6/test.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,26 +0,0 @@ -#!/bin/sh -cd `dirname $0` -set -x -rm -rf _build -CMDOPTS="" # -- command args -BUILD="../../_build/ocamlbuild.native -no-skip main.byte -classic-display $@" -BUILD1="$BUILD $CMDOPTS" -BUILD2="$BUILD -verbose 0 -nothing-should-be-rebuilt $CMDOPTS" -cp b.mli.v1 b.mli -cp d.mli.v1 d.mli -$BUILD1 -$BUILD2 -cp b.mli.v2 b.mli -cp d.mli.v2 d.mli -$BUILD1 -cp b.mli.v1 b.mli -if $BUILD1; then - if $BUILD2; then - echo PASS - else - echo "FAIL (-nothing-should-be-rebuilt)" - fi -else - echo FAIL -fi - diff -Nru ocaml-3.12.1/ocamlbuild/test/test7/_tags ocaml-4.01.0/ocamlbuild/test/test7/_tags --- ocaml-3.12.1/ocamlbuild/test/test7/_tags 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test7/_tags 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -"main.byte": my_cool_plugin diff -Nru ocaml-3.12.1/ocamlbuild/test/test7/aa.ml ocaml-4.01.0/ocamlbuild/test/test7/aa.ml --- ocaml-3.12.1/ocamlbuild/test/test7/aa.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test7/aa.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -let aa = "aa" diff -Nru ocaml-3.12.1/ocamlbuild/test/test7/bb.mli ocaml-4.01.0/ocamlbuild/test/test7/bb.mli --- ocaml-3.12.1/ocamlbuild/test/test7/bb.mli 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test7/bb.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -val bb : int diff -Nru ocaml-3.12.1/ocamlbuild/test/test7/bb1.ml ocaml-4.01.0/ocamlbuild/test/test7/bb1.ml --- ocaml-3.12.1/ocamlbuild/test/test7/bb1.ml 2007-11-21 16:38:34.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test7/bb1.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -let bb = 43 diff -Nru ocaml-3.12.1/ocamlbuild/test/test7/bb2.ml ocaml-4.01.0/ocamlbuild/test/test7/bb2.ml --- ocaml-3.12.1/ocamlbuild/test/test7/bb2.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test7/bb2.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -let bb = 43 -let f x = x + 1 -let () = incr (ref 0) diff -Nru ocaml-3.12.1/ocamlbuild/test/test7/bb3.ml ocaml-4.01.0/ocamlbuild/test/test7/bb3.ml --- ocaml-3.12.1/ocamlbuild/test/test7/bb3.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test7/bb3.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -let bb = 43 -let f x = x + 1 -let () = incr (ref 1) diff -Nru ocaml-3.12.1/ocamlbuild/test/test7/bbcc.mllib ocaml-4.01.0/ocamlbuild/test/test7/bbcc.mllib --- ocaml-3.12.1/ocamlbuild/test/test7/bbcc.mllib 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test7/bbcc.mllib 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -Bb Cc diff -Nru ocaml-3.12.1/ocamlbuild/test/test7/c2.ml ocaml-4.01.0/ocamlbuild/test/test7/c2.ml --- ocaml-3.12.1/ocamlbuild/test/test7/c2.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test7/c2.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -let c2 = 12 diff -Nru ocaml-3.12.1/ocamlbuild/test/test7/c2.mli ocaml-4.01.0/ocamlbuild/test/test7/c2.mli --- ocaml-3.12.1/ocamlbuild/test/test7/c2.mli 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test7/c2.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -val c2 : int diff -Nru ocaml-3.12.1/ocamlbuild/test/test7/c3.ml ocaml-4.01.0/ocamlbuild/test/test7/c3.ml --- ocaml-3.12.1/ocamlbuild/test/test7/c3.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test7/c3.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -let c3 = Bb.bb + 13 diff -Nru ocaml-3.12.1/ocamlbuild/test/test7/cc.ml ocaml-4.01.0/ocamlbuild/test/test7/cc.ml --- ocaml-3.12.1/ocamlbuild/test/test7/cc.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test7/cc.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -let cc = (String.length Aa.aa) + Bb.bb + C2.c2 diff -Nru ocaml-3.12.1/ocamlbuild/test/test7/cool_plugin.ml ocaml-4.01.0/ocamlbuild/test/test7/cool_plugin.ml --- ocaml-3.12.1/ocamlbuild/test/test7/cool_plugin.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test7/cool_plugin.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -print_endline "I am a cool plugin" diff -Nru ocaml-3.12.1/ocamlbuild/test/test7/main.ml ocaml-4.01.0/ocamlbuild/test/test7/main.ml --- ocaml-3.12.1/ocamlbuild/test/test7/main.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test7/main.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -let main = String.length Aa.aa - Bb.bb - C3.c3 - Cc.cc - 1 diff -Nru ocaml-3.12.1/ocamlbuild/test/test7/myocamlbuild.ml ocaml-4.01.0/ocamlbuild/test/test7/myocamlbuild.ml --- ocaml-3.12.1/ocamlbuild/test/test7/myocamlbuild.ml 2007-11-22 18:51:13.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test7/myocamlbuild.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,7 +0,0 @@ -open Ocamlbuild_plugin;; -dispatch begin function -| After_rules -> - use_lib "main" "bbcc"; - dep ["ocaml"; "link"; "byte"; "my_cool_plugin"] ["cool_plugin.cmo"]; -| _ -> () -end diff -Nru ocaml-3.12.1/ocamlbuild/test/test7/test.sh ocaml-4.01.0/ocamlbuild/test/test7/test.sh --- ocaml-3.12.1/ocamlbuild/test/test7/test.sh 2007-11-21 16:38:34.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test7/test.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,18 +0,0 @@ -#!/bin/sh -cd `dirname $0` -set -e -set -x -CMDOPTS="" # -- command args -BUILD="../../_build/ocamlbuild.native bbcc.cma main.byte bbcc.cmxa main.native -no-skip -classic-display $@" -BUILD1="$BUILD $CMDARGS" -BUILD2="$BUILD -verbose 0 -nothing-should-be-rebuilt $CMDARGS" -rm -rf _build -cp bb1.ml bb.ml -$BUILD1 -$BUILD2 -cp bb2.ml bb.ml -$BUILD1 -verbose 0 -$BUILD2 -cp bb3.ml bb.ml -$BUILD1 -verbose 0 -$BUILD2 diff -Nru ocaml-3.12.1/ocamlbuild/test/test8/a.ml ocaml-4.01.0/ocamlbuild/test/test8/a.ml --- ocaml-3.12.1/ocamlbuild/test/test8/a.ml 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test8/a.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -print_endline Myconfig.version;; diff -Nru ocaml-3.12.1/ocamlbuild/test/test8/myocamlbuild.ml ocaml-4.01.0/ocamlbuild/test/test8/myocamlbuild.ml --- ocaml-3.12.1/ocamlbuild/test/test8/myocamlbuild.ml 2007-11-28 16:19:35.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test8/myocamlbuild.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,16 +0,0 @@ -open Ocamlbuild_plugin;; -let version = "0.1";; -dispatch begin function - | After_rules -> - rule "myconfig.ml" - ~prod:"myconfig.ml" - begin fun _ _ -> - Echo(["let version = \""; version; "\";;\n"], "myconfig.ml") - end; - - copy_rule "copy byte-code executables" "%(path).byte" "%(path:not <**/*.*>)"; - copy_rule "copy native executables" "%(path).native" "%(path:not <**/*.*>).opt"; - copy_rule "copy binaries to bin" "%(basename).%(extension)" - "bin/%(basename).%(extension:<{byte,native}>)"; - | _ -> () -end diff -Nru ocaml-3.12.1/ocamlbuild/test/test8/test.sh ocaml-4.01.0/ocamlbuild/test/test8/test.sh --- ocaml-3.12.1/ocamlbuild/test/test8/test.sh 2007-11-21 21:03:52.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test8/test.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,11 +0,0 @@ -#!/bin/sh -cd `dirname $0` -set -e -set -x -CMDOPTS="" # -- command args -BUILD="../../_build/ocamlbuild.native a.byte a.native a a.opt bin/a bin/a.opt -no-skip -classic-display $@" -BUILD1="$BUILD $CMDOPTS" -BUILD2="$BUILD -verbose 0 -nothing-should-be-rebuilt $CMDOPTS" -rm -rf _build -$BUILD1 -$BUILD2 diff -Nru ocaml-3.12.1/ocamlbuild/test/test9/dbgl ocaml-4.01.0/ocamlbuild/test/test9/dbgl --- ocaml-3.12.1/ocamlbuild/test/test9/dbgl 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test9/dbgl 1970-01-01 00:00:00.000000000 +0000 @@ -1,10 +0,0 @@ -#load "unix.cma";; -#load "str.cma";; -#load "discard_printf.cmo";; -#load "debug.cmo";; -#load "bool.cmo";; -#load "glob_ast.cmo";; -#load "glob_lexer.cmo";; -#load "my_unix.cmo";; -#use "glob.ml";; -#install_printer print_is;; diff -Nru ocaml-3.12.1/ocamlbuild/test/test9/test.sh ocaml-4.01.0/ocamlbuild/test/test9/test.sh --- ocaml-3.12.1/ocamlbuild/test/test9/test.sh 2007-02-07 08:59:16.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test9/test.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -#!/bin/sh -set -e -set -x -cd `dirname $0`/../.. -./_build/ocamlbuild.native -quiet -build-dir _buildtest -no-links test/test9/testglob.native $@ -./_buildtest/test/test9/testglob.native diff -Nru ocaml-3.12.1/ocamlbuild/test/test9/testglob.ml ocaml-4.01.0/ocamlbuild/test/test9/testglob.ml --- ocaml-3.12.1/ocamlbuild/test/test9/testglob.ml 2007-11-26 13:29:54.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test9/testglob.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,134 +0,0 @@ -(* Testglob *) - -open Bool;; -open Glob;; - -let yep f x = - try - ignore (f x); - true - with - | _ -> false -;; - -let tests1 = [ - "\"hello\"", true; - "", true; - "", true; - " and or ", true; - " titi", false -];; - -let tests2 = [ - "<[a]>", ["a"], ["b"]; - "<[a-z]>", ["a";"e";"k";"z"], ["0";"A";"~"]; - "<[a-z][0-9]>", ["a0";"b9"], ["a00";"a0a";"b0a";"isduis";""]; - "", ["hello"], ["helli"]; - "\"hello\"", ["hello"], ["heidi"]; - "<*>", ["";"a";"ax"], []; - "", ["ab";"acb";"axxxxxb";"ababbababb"], ["abx";"xxxxxab";"xab"]; - "<*.ml>", ["hello.ml";".ml"], ["ml"; ""; "toto.mli"]; - "", ["a"], ["";"aa";"ba";"ab";"abaa"]; - "", ["ab"], ["";"abab";"aba";"abx"]; - "", ["abac";"abxc"], ["abab";"ababab";"ababa"]; - "<*ab?cd*>", ["123abecd345";"abccd";"abccd345";"ababcababccdab"], ["abcd";"aaaaabcdababcd"]; - "<*this*is*a*test*>", ["this is a test";"You know this is a test really";"thisisatest"], ["thisatest"]; - "", ["bxx";"bx"], ["aaab";""]; - "<*>", ["";"a";"aaa";"aaaaa"], []; - "", ["a"],["";"aaa";"aaaaa"]; - "<{a,b}>", ["a";"b"],["";"aa";"ab";"ba";"bb";"c"]; - "", ["toto.ml";"toto.mli"],["toto.";"toto.mll"]; - "<{a,b}{c,[de]}{f,g}>", ["acf";"acg";"adf";"adg";"aef";"aeg";"bcf";"bcg";"bdf";"bdg";"bef";"beg"], - ["afg";"af";"aee"]; - "(<*.ml> or <*.mli>) and not \"hello.ml\"", - ["a.ml"; "b.ml"; "a.mli"], - ["hello.ml"; "a.mli.x"]; - "<*>", ["alpha";"beta"], ["alpha/beta";"gamma/delta"]; - "", ["alpha/beta";"alpha/gamma/beta";"alpha/gamma/delta/beta"], - ["alpha";"beta";"gamma/delta"]; - "<**/*.ml>", ["toto.ml";"toto/tata.ml";"alpha/gamma/delta/beta.ml"], - ["toto.mli"]; - "", ["toto/";"toto/tata";"toto/alpha/gamma/delta/beta.ml";"toto"], - ["toto2/tata"; "tata/titi"] -];; - -let tests3 = [ - "%(path:<**/>)lib%(libname:<*> and not <*.*>).a", - ["libfoo.a","","foo"; - "src/bar/libfoo.a","src/bar/","foo"; - "otherlibs/unix/libunix.a","otherlibs/unix/","unix"; - "otherlibsliblib/unlibix/libunix.a","otherlibsliblib/unlibix/","unix"; - "libfoo/libbar.a","libfoo/","bar"; - "src/libfoo/boo/libbar.a","src/libfoo/boo/","bar"; - ], - ["bar"; "libbar/foo.a"; "libfoo.b.a"] -];; - -let _ = - let times = 3 in - List.iter - begin fun (str, ast) -> - let ast' = yep Glob.parse str in - if ast <> ast' then - begin - Printf.printf "Globexp parsing failed for %S.\n%!" str; - exit 1 - end - else - Printf.printf "Globexp for %S OK\n%!" str - end - tests1; - List.iter - begin fun (gstr, yes, no) -> - let globber = Glob.parse gstr in - let check polarity = - List.iter - begin fun y -> - if Glob.eval globber y = polarity then - Printf.printf "Glob.eval %S %S = %b OK\n%!" gstr y polarity - else - begin - Printf.printf "Glob.eval %S %S = %b FAIL\n%!" gstr y (not polarity); - exit 1 - end - end - in - for k = 1 to times do - check true yes; - check false no - done - end - tests2; - List.iter begin fun (str, yes, no) -> - let resource = Resource.import_pattern str in - for k = 1 to times do - List.iter begin fun (y, path, libname) -> - let resource' = Resource.import y in - match Resource.matchit resource resource' with - | Some env -> - let path' = Resource.subst env "%(path)" in - let libname' = Resource.subst env "%(libname)" in - if path' = path && libname = libname' then - Printf.printf "Resource.matchit %S %S OK\n%!" str y - else begin - Printf.printf "Resource.matchit %S %S FAIL\n%!" str y; - exit 1 - end - | None -> - begin - Printf.printf "Resource.matchit %S %S = None FAIL\n%!" str y; - exit 1 - end - end yes; - List.iter begin fun y -> - let resource' = Resource.import y in - if Resource.matchit resource resource' = None then - Printf.printf "Resource.matchit %S %S = None OK\n%!" str y - else begin - Printf.printf "Resource.matchit %S %S <> None FAIL\n%!" str y; - exit 1 - end - end no - done - end tests3 -;; diff -Nru ocaml-3.12.1/ocamlbuild/test/test_virtual/foo.itarget ocaml-4.01.0/ocamlbuild/test/test_virtual/foo.itarget --- ocaml-3.12.1/ocamlbuild/test/test_virtual/foo.itarget 2007-11-21 21:16:47.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test_virtual/foo.itarget 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -foo diff -Nru ocaml-3.12.1/ocamlbuild/test/test_virtual/foo1 ocaml-4.01.0/ocamlbuild/test/test_virtual/foo1 --- ocaml-3.12.1/ocamlbuild/test/test_virtual/foo1 2007-11-21 21:16:47.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test_virtual/foo1 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -foo1 diff -Nru ocaml-3.12.1/ocamlbuild/test/test_virtual/foo2 ocaml-4.01.0/ocamlbuild/test/test_virtual/foo2 --- ocaml-3.12.1/ocamlbuild/test/test_virtual/foo2 2007-11-21 21:16:47.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test_virtual/foo2 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -foo2 diff -Nru ocaml-3.12.1/ocamlbuild/test/test_virtual/myocamlbuild.ml ocaml-4.01.0/ocamlbuild/test/test_virtual/myocamlbuild.ml --- ocaml-3.12.1/ocamlbuild/test/test_virtual/myocamlbuild.ml 2007-11-22 18:51:48.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test_virtual/myocamlbuild.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,11 +0,0 @@ -open Ocamlbuild_plugin;; -dispatch begin function - | After_rules -> - rule "copy foo" - ~prod:"bar" - ~dep:"foo.otarget" - begin fun _env _build -> - cp "foo" "bar" - end - | _ -> () -end diff -Nru ocaml-3.12.1/ocamlbuild/test/test_virtual/test.sh ocaml-4.01.0/ocamlbuild/test/test_virtual/test.sh --- ocaml-3.12.1/ocamlbuild/test/test_virtual/test.sh 2007-11-21 21:32:43.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/test/test_virtual/test.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,16 +0,0 @@ -#!/bin/sh -cd `dirname $0` -set -e -set -x -CMDOPTS="" # -- command args -BUILD="../../_build/ocamlbuild.native bar -no-skip -classic-display $@" -BUILD1="$BUILD $CMDOPTS" -BUILD2="$BUILD -verbose 0 -nothing-should-be-rebuilt $CMDOPTS" -rm -rf _build -cp foo1 foo -$BUILD1 -$BUILD2 -cp foo2 foo -$BUILD1 -verbose 0 -$BUILD2 -rm foo diff -Nru ocaml-3.12.1/ocamlbuild/testsuite/level0.ml ocaml-4.01.0/ocamlbuild/testsuite/level0.ml --- ocaml-3.12.1/ocamlbuild/testsuite/level0.ml 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/testsuite/level0.ml 2013-08-24 20:46:24.000000000 +0000 @@ -0,0 +1,230 @@ +#load "unix.cma";; + +let ocamlbuild = try Sys.getenv "OCAMLBUILD" with Not_found -> "ocamlbuild";; + +#use "ocamlbuild_test.ml";; + +module M = Match;; +module T = Tree;; + +let _build = M.d "_build";; + +test "BasicNativeTree" + ~description:"Output tree for native compilation" + ~tree:[T.f "dummy.ml"] + ~matching:[M.Exact + (_build + (M.lf + ["_digests"; + "dummy.cmi"; + "dummy.cmo"; + "dummy.cmx"; + "dummy.ml"; + "dummy.ml.depends"; + "dummy.native"; + "dummy.o"; + "_log"]))] + ~targets:("dummy.native",[]) ();; + +test "BasicByteTree" + ~description:"Output tree for byte compilation" + ~tree:[T.f "dummy.ml"] + ~matching:[M.Exact + (_build + (M.lf + ["_digests"; + "dummy.cmi"; + "dummy.cmo"; + "dummy.ml"; + "dummy.ml.depends"; + "dummy.byte"; + "_log"]))] + ~targets:("dummy.byte",[]) ();; + +test "SeveralTargets" + ~description:"Several targets" + ~tree:[T.f "dummy.ml"] + ~matching:[_build (M.lf ["dummy.byte"; "dummy.native"])] + ~targets:("dummy.byte",["dummy.native"]) ();; + +let alt_build_dir = "BuIlD2";; + +test "BuildDir" + ~options:[`build_dir alt_build_dir] + ~description:"Different build directory" + ~tree:[T.f "dummy.ml"] + ~matching:[M.d alt_build_dir (M.lf ["dummy.byte"])] + ~targets:("dummy.byte",[]) ();; + +test "camlp4.opt" + ~description:"Fixes PR#5652" + ~options:[`use_ocamlfind; `package "camlp4.macro";`tags ["camlp4o.opt"; "syntax\\(camp4o\\)"]; + `ppflag "camlp4o.opt"; `ppflag "-parser"; `ppflag "macro"; `ppflag "-DTEST"] + ~tree:[T.f "dummy.ml" ~content:"IFDEF TEST THEN\nprint_endline \"Hello\";;\nENDIF;;"] + ~matching:[M.x "dummy.native" ~output:"Hello"] + ~targets:("dummy.native",[]) ();; + +test "ThreadAndArchive" + ~description:"Fixes PR#6058" + ~options:[`use_ocamlfind; `package "threads"; `tag "thread"] + ~tree:[T.f "t.ml" ~content:""] + ~matching:[M.f "_build/t.cma"] + ~targets:("t.cma",[]) ();; + +let tag_pat_msgs = + ["*:a", "File \"_tags\", line 1, column 0: Lexing error: Invalid globbing pattern \"*\"."; + "\n<*{>:a", "File \"_tags\", line 2, column 0: Lexing error: Invalid globbing pattern \"<*{>\"."; + "<*>: ~@a,# ~a", "File \"_tags\", line 1, column 10: Lexing error: Only ',' separated tags are alllowed."];; + +List.iteri (fun i (content,failing_msg) -> + test (Printf.sprintf "TagsErrorMessage_%d" (i+1)) + ~description:"Confirm relevance of an error message due to erronous _tags" + ~failing_msg + ~tree:[T.f "_tags" ~content; T.f "dummy.ml"] + ~targets:("dummy.native",[]) ()) tag_pat_msgs;; + +test "SubtoolOptions" + ~description:"Options that come from tags that needs to be spliced to the subtool invocation (PR#5763)" + ~options:[`use_menhir; `use_ocamlfind; `tags["package\\(camlp4.fulllib\\)"]] + ~tree:[T.f "parser.mly" ~content:"%{\n%}\n%token DUMMY\n%start test%%test: {None}\n\n"] + ~matching:[M.f "parser.native"; M.f "parser.byte"] + ~targets:("parser.native",["parser.byte"]) + ();; + +test "Itarget" + ~description:".itarget building with dependencies between the modules (PR#5686)" + ~tree:[T.f "foo.itarget" ~content:"a.cma\nb.byte\n"; T.f "a.ml"; T.f "b.ml" ~content:"open A\n"] + ~matching:[M.f "a.cma"; M.f "b.byte"] + ~targets:("foo.otarget",[]) ();; + +test "PackAcross" + ~description:"Pack using a module from the other tree (PR#4592)" + ~tree:[T.f "main.ml" ~content:"let _ = Pack.Packed.g ()\n"; + T.f "Pack.mlpack" ~content:"pack/Packed"; + T.f "_tags" ~content:": include\n: for-pack(Pack)\n"; + T.d "lib" [T.f "Lib.ml" ~content:"let f()=()"; + T.f "Lib.mli" ~content:"val f : unit -> unit"]; + T.d "pack" [T.f "Packed.ml" ~content:"let g() = Lib.f ()"]] + ~matching:[M.f "main.byte"; M.f "main.native"] + ~targets:("main.byte", ["main.native"]) + ();; + +test "PackAcross2" + ~description:"Pack using a module from the other tree (PR#4592)" + ~tree:[T.f "a2.mli" ~content:"val f : unit -> unit"; + T.f "a2.ml" ~content:"let f _ = ()"; + T.f "lib.ml" ~content:"module A = A2"; + T.f "b.ml" ~content:"let g = Lib.A.f"; + T.f "sup.mlpack" ~content:"B"; + T.f "prog.ml" ~content:"Sup.B.g"] + ~matching:[M.f "prog.byte"] + ~targets:("prog.byte",[]) ();; + +test "PackAcross3" + ~description:"Pack using a module from the other tree (PR#4592)" + ~tree:[T.d "foo" [ T.f "bar.ml" ~content:"let baz = Quux.xyzzy"]; + T.f "foo.mlpack" ~content:"foo/Bar"; + T.f "main.ml" ~content:"prerr_endline Foo.Bar.baz"; + T.f "myocamlbuild.ml"; + T.f "quux.ml" ~content:"let xyzzy = \"xyzzy\""; + T.f "quux.mli" ~content:"val xyzzy : string"] + ~matching:[M.f "main.byte"] + ~targets:("main.byte",[]) ();; + +test "SyntaxFlag" + ~description:"-syntax for ocamlbuild" + ~options:[`use_ocamlfind; `package "camlp4.macro"; `syntax "camlp4o"] + ~tree:[T.f "dummy.ml" ~content:"IFDEF TEST THEN\nprint_endline \"Hello\";;\nENDIF;;"] + ~matching:[M.f "dummy.native"] + ~targets:("dummy.native",[]) ();; + +test "NoIncludeNoHygiene1" + ~description:"check that hygiene checks are only done in traversed directories\ + (PR#4502)" + ~tree:[T.d "must_ignore" [ T.f "dirty.mli" ~content:"val bug : int"]; + T.f "hello.ml" ~content:"print_endline \"Hello, World!\""; + T.f "_tags" ~content:": -traverse"] + ~pre_cmd:"ocamlc -c must_ignore/dirty.mli" + (* will make hygiene fail if must_ignore/ is checked *) + ~targets:("hello.byte",[]) ();; + +test "NoIncludeNoHygiene2" + ~description:"check that hygiene checks are not done on the -build-dir \ + (PR#4502)" + ~tree:[T.d "must_ignore" [ T.f "dirty.mli" ~content:"val bug : int"]; + T.f "hello.ml" ~content:"print_endline \"Hello, World!\""; + T.f "_tags" ~content:""] + ~options:[`build_dir "must_ignore"] + ~pre_cmd:"ocamlc -c must_ignore/dirty.mli" + (* will make hygiene fail if must_ignore/ is checked *) + ~targets:("hello.byte",[]) ();; + +test "NoIncludeNoHygiene3" + ~description:"check that hygiene checks are not done on excluded dirs (PR#4502)" + ~tree:[T.d "must_ignore" [ T.f "dirty.mli" ~content:"val bug : int"]; + T.f "hello.ml" ~content:"print_endline \"Hello, World!\""; + T.f "_tags" ~content:""] + ~options:[`X "must_ignore"] + ~pre_cmd:"ocamlc -c must_ignore/dirty.mli" + (* will make hygiene fail if must_ignore/ is checked *) + ~targets:("hello.byte",[]) ();; + +test "OutputObj" + ~description:"output_obj targets for native and bytecode (PR #6049)" + ~tree:[T.f "hello.ml" ~content:"print_endline \"Hello, World!\""] + ~targets:("hello.byte.o",["hello.byte.c";"hello.native.o"]) ();; + +test "StrictSequenceFlag" + ~description:"-strict_sequence tag" + ~tree:[T.f "hello.ml" ~content:"let () = 1; ()"; + T.f "_tags" ~content:"true: strict_sequence\n"] + ~options:[`quiet] + ~failing_msg:"File \"hello.ml\", line 1, characters 9-10: +Error: This expression has type int but an expression was expected of type + unit\nCommand exited with code 2." + ~targets:("hello.byte",[]) ();; + +test "PrincipalFlag" + ~description:"-principal tag" + ~tree:[T.f "hello.ml" ~content:"type s={foo:int;bar:unit} type t={foo:int} let f x = x.bar;x.foo"; + T.f "_tags" ~content:"true: principal\n"] + ~options:[`quiet] + ~failing_msg:"File \"hello.ml\", line 1, characters 61-64: +Warning 18: this type-based field disambiguation is not principal." + ~targets:("hello.byte",[]) ();; + +test "ModularPlugin1" + ~options:[`quiet; `plugin_tag "use_str"] + ~description:"test a plugin with dependency on external libraries" + ~tree:[T.f "main.ml" ~content:"let x = 1"; + T.f "myocamlbuild.ml" ~content:"ignore (Str.quote \"\");;"] + ~matching:[M.f "main.byte"] + ~targets:("main.byte",[]) ();; + +test "ModularPlugin2" + ~description:"check that parametrized tags defined by the plugin + do not warn at plugin-compilation time" + ~options:[`quiet] + ~tree:[T.f "main.ml" ~content:"let x = 1"; + T.f "_tags" ~content:": toto(-g)"; + T.f "myocamlbuild.ml" + ~content:"open Ocamlbuild_plugin;; + pflag [\"link\"] \"toto\" (fun arg -> A arg);;"] + ~failing_msg:"" + ~matching:[M.f "main.byte"] + ~targets:("main.byte",[]) ();; + +test "ModularPlugin3" + ~description:"check that unknown parametrized tags encountered + during plugin compilation still warn" + ~options:[`quiet; `plugin_tag "'toto(-g)'"] + ~tree:[T.f "main.ml" ~content:"let x = 1"; + T.f "myocamlbuild.ml" + ~content:"open Ocamlbuild_plugin;; + pflag [\"link\"] \"toto\" (fun arg -> A arg);;"] + ~failing_msg:"Warning: tag \"toto\" does not expect a parameter, \ + but is used with parameter \"-g\"" + ~matching:[M.f "main.byte"] + ~targets:("main.byte",[]) ();; + +run ~root:"_test";; diff -Nru ocaml-3.12.1/ocamlbuild/testsuite/ocamlbuild_test.ml ocaml-4.01.0/ocamlbuild/testsuite/ocamlbuild_test.ml --- ocaml-3.12.1/ocamlbuild/testsuite/ocamlbuild_test.ml 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/testsuite/ocamlbuild_test.ml 2013-08-24 20:46:22.000000000 +0000 @@ -0,0 +1,471 @@ +(***********************************************************************) +(* *) +(* ocamlbuild *) +(* *) +(* Wojciech Meyer *) +(* *) +(* Copyright 2012 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +open Format + +external (|>) : 'a -> ('a -> 'b) -> 'b = "%revapply" + +let print_list ~sep f ppf = function +| [] -> () +| x :: [] -> f ppf x +| x :: xs -> f ppf x; List.iter (fun x -> sep ppf (); f ppf x) xs + +let print_list_com f = print_list ~sep:(fun ppf () -> pp_print_string ppf ",") f +let print_list_blank f = print_list ~sep:(fun ppf () -> pp_print_string ppf " ") f +let print_string_list = print_list_com pp_print_string +let print_string_list_com = print_list_com pp_print_string +let print_string_list_blank = print_list_blank pp_print_string + +let exists filename = + try ignore(Unix.stat filename); true + with Unix.Unix_error ((Unix.ENOENT),_,_) -> false + +let execute cmd = + let ic = Unix.open_process_in cmd and lst = ref [] in + try while true do lst := input_line ic :: !lst done; assert false + with End_of_file -> + let ret_code = Unix.close_process_in ic + in ret_code, List.rev !lst + +let rm f = + if exists f then + ignore(Sys.command (Printf.sprintf "rm -r %s" f)) + +module Match = struct + + type atts = unit + + (* File consists of file attribute and name *) + type file = atts * string + + (* Result is an outcome of execution, if consists of returned exit code, + and stream from stdout *) + type result = int * string + + type t = + (* Represents file in the tree *) + | F of file + (* Directory, consists of name and sub entries *) + | D of file * t list + (* Like file, but will be executed, and the result will compared *) + | X of file * result + (* Symlink *) + | L of file * file + (* We request that everything below should match exactly *) + | Exact of t + (* Here we want just the tree contained entities but we allow some + other stuff to be there too *) + | Contains of t + (* Any means that we match anything *) + | Any + (* Empty a tree leaf that don't match at all *) + | Empty + + (* Type of error, we either expect something or something is un-expected *) + type error = + Expected of string + | Unexpected of string + | Structure of string * string list + | Output of string * string + + (* This will print the tree *) + let print ppf tree = + let rec lines ppf lst = + List.iter (fun line -> pp_print_space ppf (); item ppf line) lst + and item ppf = function + | F (_, name) -> fprintf ppf "@[%s@]" name + | D ((_, name), children) -> fprintf ppf "@[@[%s/@]%a@]" name lines children + | X ((_,name), _) -> fprintf ppf "@[%s@]" name + | L ((_,src), (_,dst)) -> fprintf ppf "@[%s->%s@]@" src dst + | Exact content -> fprintf ppf "{%a}" item content + | Contains content -> fprintf ppf "<%a>" item content + | Any -> pp_print_char ppf '*' + | Empty -> pp_print_char ppf '#' + in + pp_open_vbox ppf 0; + item ppf tree; + pp_close_box ppf () + + let f ?(atts=()) name = F (atts, name) + let d ?(atts=()) name children = D ((atts, name), children) + let lf ?(atts=()) lst = List.map (fun nm -> F (atts,nm)) lst + let x ?(atts=()) name ~output = X ((atts,name), (0,output)) + + let match_with_fs ~root m = + + let errors = ref [] in + + let rec visit ~exact path m = + let file name = + "./" ^ (List.rev (name :: path) |> String.concat "/") + + in + + let exists_assert filename = + if not (exists (file filename)) then + errors := Expected filename :: !errors; + in + + let take_name = function + | F (_, name) + | D ((_, name),_) -> [name] + | _ -> [] + in + + match m with + | F ((),name) -> + exists_assert name + | D (((),name), sub) -> + exists_assert name; + let lst = List.flatten (List.map take_name sub) in + let lst' = Sys.readdir name |> Array.to_list in + let lst' = List.filter (fun x -> not (List.mem x lst)) lst' in + (if exact && lst' <> [] then + errors := Structure ((file name), lst') :: !errors); + List.iter (visit ~exact (name :: path)) sub + | X (((), name), (retcode, output)) -> + let _,output' = execute (file name) in + let output' = String.concat "\n" output' in + if output <> output' then + errors := Output (output, output') :: !errors + | Exact sub -> visit ~exact:true path sub + | Contains sub -> visit ~exact:false path sub + | _ -> assert false + in + let dir = Sys.getcwd () in + Unix.chdir root; + visit ~exact:false [] m; + Unix.chdir dir; + List.rev !errors + + let string_of_error = function + | Expected s -> Printf.sprintf "expected '%s' on a file system" s + | Unexpected s -> Printf.sprintf "un-expected '%s' on a file system" s + | Structure (s,l) -> Printf.sprintf "directory structure '%s' has un-expected files %s" s (String.concat ", " l) + | Output (e, p) -> Printf.sprintf "not matching output '%s' expected but got %s" e p +end + +module Option = struct + + type flag = string + type path = string + type level = int + type package = string + type file = string + type command = string + type _module = string + type tag = string + + type t = + [ `version + | `vnum + | `quiet + | `verbose of level + | `documentation + | `log of file + | `no_log + | `clean + | `r + | `I of path + | `Is of path list + | `X of path + | `Xs of path list + | `lib of flag + | `libs of flag list + | `_mod of _module + | `mods of _module list + | `pkg of package + | `pkgs of package list + | `package of package + | `syntax of string + | `lflag of flag + | `lflags of flag list + | `cflag of flag + | `cflags of flag list + | `docflag of flag + | `docflags of flag list + | `yaccflag of flag + | `yaccflags of flag list + | `lexflag of flag + | `lexflags of flag list + | `ppflag of flag + | `pp of flag list + | `tag of tag + | `tags of tag list + | `plugin_tag of tag + | `plugin_tags of tag list + | `tag_line of tag + | `show_tags of path + | `ignore of _module list + | `no_links + | `no_skip + | `no_hygiene + | `no_plugin + | `no_stdlib + | `dont_catch_errors + | `just_plugin + | `byte_plugin + | `plugin_option + | `sanitization_script + | `no_sanitize + | `nothing_should_be_rebuilt + | `classic_display + | `use_menhir + | `use_jocaml + | `use_ocamlfind + | `j of level + | `build_dir of path + | `install_lib_dir of path + | `install_bin_dir of path + | `where + | `ocamlc of command + | `ocamlopt of command + | `ocamldep of command + | `ocamldoc of command + | `ocamlyacc of command + | `menhir of command + | `ocamllex of command + | `ocamlmktop of command + | `ocamlrun of command + | `help ] + + type arg = string * string list + + let print_level = pp_print_int + let print_flag = pp_print_string + let print_package = pp_print_string + let print_tag = pp_print_string + let print_tags = print_string_list_com + let print_path = pp_print_string + let print_paths = print_string_list_com + let print_flags = print_string_list_com + let print_module = pp_print_string + let print_modules = print_string_list_com + let print_packages = print_string_list_com + let print_command = pp_print_string + + let print_opt ppf o = + fprintf ppf "-"; + match o with + | `version -> fprintf ppf "version" + | `vnum -> fprintf ppf "vnum" + | `quiet -> fprintf ppf "quiet" + | `verbose level -> fprintf ppf "verbose %a" print_level level + | `documentation -> fprintf ppf "documentation" + | `log file -> fprintf ppf "log" + | `no_log -> fprintf ppf "no-log" + | `clean -> fprintf ppf "clean" + | `r -> fprintf ppf "r" + | `I path -> fprintf ppf "I %a" print_path path + | `Is paths -> fprintf ppf "Is %a" print_paths paths + | `X path -> fprintf ppf "X %a" print_path path + | `Xs paths -> fprintf ppf "Xs %a" print_paths paths + | `lib flag -> fprintf ppf "lib %a" print_flag flag + | `libs flags -> fprintf ppf "libs %a" print_flags flags + | `_mod _module -> fprintf ppf "mod %a" print_module _module + | `mods _modules -> fprintf ppf "mods %a" print_modules _modules + | `pkg package -> fprintf ppf "pkg %a" print_package package + | `pkgs packages -> fprintf ppf "pkgs %a" print_packages packages + | `package package -> fprintf ppf "package %a" print_package package + | `syntax syntax -> fprintf ppf "syntax %a" pp_print_string syntax + | `lflag flag -> fprintf ppf "lflag %a" print_flag flag + | `lflags flags -> fprintf ppf "lflags %a" print_flags flags + | `cflag flag -> fprintf ppf "cflag %a" print_flag flag + | `cflags flags -> fprintf ppf "cflags %a" print_flags flags + | `docflag flag -> fprintf ppf "docflag %a" print_flag flag + | `docflags flags -> fprintf ppf "docflags %a" print_flags flags + | `yaccflag flag -> fprintf ppf "yaccflag %a" print_flag flag + | `yaccflags flags -> fprintf ppf "yaccflags %a" print_flags flags + | `lexflag flag -> fprintf ppf "lexflag %a" print_flag flag + | `lexflags flags -> fprintf ppf "lexflags %a" print_flags flags + | `ppflag flag -> fprintf ppf "ppflag %a" print_flag flag + | `pp flags -> fprintf ppf "pp %a" print_flags flags + | `tag tag -> fprintf ppf "tag %a" print_tag tag + | `tags tags -> fprintf ppf "tags %a" print_tags tags + | `plugin_tag tag -> fprintf ppf "plugin-tag %a" print_tag tag + | `plugin_tags tags -> fprintf ppf "plugin-tags %a" print_tags tags + | `tag_line tag -> fprintf ppf "tag-line %a" print_tag tag + | `show_tags path -> fprintf ppf "show-tags %a" print_path path + | `ignore _modules -> fprintf ppf "ignore %a" print_modules _modules + | `no_links -> fprintf ppf "no-links" + | `no_skip -> fprintf ppf "no-skip" + | `no_hygiene -> fprintf ppf "no-hygiene" + | `no_plugin -> fprintf ppf "no-pluging" + | `no_stdlib -> fprintf ppf "no-stdlib" + | `dont_catch_errors -> fprintf ppf "dont" + | `just_plugin -> fprintf ppf "just-plugin" + | `byte_plugin -> fprintf ppf "byte-plugin" + | `plugin_option -> fprintf ppf "plugin-option" + | `sanitization_script -> fprintf ppf "sanitization-script" + | `no_sanitize -> fprintf ppf "no-sanitze" + | `nothing_should_be_rebuilt -> fprintf ppf "nothing_should_be_rebuilt" + | `classic_display -> fprintf ppf "classic-display" + | `use_menhir -> fprintf ppf "use-menhir" + | `use_jocaml -> fprintf ppf "use-jocaml" + | `use_ocamlfind -> fprintf ppf "use-ocamlfind" + | `j level -> fprintf ppf "j %a" print_level level + | `build_dir path -> fprintf ppf "build-dir %a" print_path path + | `install_lib_dir path -> fprintf ppf "install %a" print_path path + | `install_bin_dir path -> fprintf ppf "install %a" print_path path + | `where -> fprintf ppf "where" + | `ocamlc command -> fprintf ppf "ocamlc %a" print_command command + | `ocamlopt command -> fprintf ppf "ocamlopt %a" print_command command + | `ocamldep command -> fprintf ppf "ocamldep %a" print_command command + | `ocamldoc command -> fprintf ppf "ocamldoc %a" print_command command + | `ocamlyacc command -> fprintf ppf "ocamlyacc %a" print_command command + | `menhir command -> fprintf ppf "menhir %a" print_command command + | `ocamllex command -> fprintf ppf "ocamllex %a" print_command command + | `ocamlmktop command -> fprintf ppf "ocamlmktop %a" print_command command + | `ocamlrun command -> fprintf ppf "ocamlrun %a" print_command command + | `help -> fprintf ppf "help" + +end + +module Tree = struct + + type name = string + type content = string + + type t = + F of name * content + | D of name * t list + | E + + let f ?(content="") name = F (name, content) + let d name children = D (name, children) + + let create_on_fs ~root f = + + let rec visit path f = + let file name = + List.rev (name :: path) + |> String.concat "/" + in + match f with + | F (name, content) -> + let ch = file name |> open_out in + output_string ch content; + close_out ch + | D (name, sub) -> + (* print_endline ("mking " ^ (file name)); *) + Unix.mkdir (file name) 0o750; + List.iter (visit (name :: path)) sub + | E -> () + in + + let dir = Sys.getcwd () in + Unix.chdir root; + visit [] f; + Unix.chdir dir + +end + +type content = string +type filename = string +type run = filename * content + +type test = { name : string + ; description : string + ; tree : Tree.t list + ; matching : Match.t list + ; options : Option.t list + ; targets : string * string list + ; pre_cmd : string option + ; failing_msg : string option + ; run : run list } + +let tests = ref [] + +let test name + ~description + ?(options=[]) ?(run=[]) ?pre_cmd ?failing_msg + ?(tree=[]) + ?(matching=[]) + ~targets () + = + tests := !tests @ [{ name; description; tree; matching; options; targets; pre_cmd; failing_msg; run }] + +let run ~root = + let dir = Sys.getcwd () in + let root = dir ^ "/" ^ root in + rm root; + Unix.mkdir root 0o750; + + let command opts args = + let b = Buffer.create 127 in + let f = Format.formatter_of_buffer b in + fprintf f "%s %a %a" ocamlbuild (print_list_blank Option.print_opt) opts (print_list_blank pp_print_string) args; + Format.pp_print_flush f (); + Buffer.contents b + in + + let one_test + { name + ; description + ; tree + ; matching + ; options + ; targets + ; failing_msg + ; pre_cmd + ; run } = + + let full_name = root ^ "/" ^ name in + rm full_name; + Unix.mkdir full_name 0o750; + List.iter (Tree.create_on_fs ~root:full_name) tree; + Unix.chdir full_name; + + (match pre_cmd with + | None -> () + | Some str -> ignore(Sys.command str)); + + let log_name = full_name ^ ".log" in + + let cmd = command options (fst targets :: snd targets) in + let allow_failure = failing_msg <> None in + + Unix.(match execute cmd with + | WEXITED n,lines + | WSIGNALED n,lines + | WSTOPPED n,lines when allow_failure || n <> 0 -> + begin match failing_msg with + | None -> + let ch = open_out log_name in + List.iter (fun l -> output_string ch l; output_string ch "\n") lines; + close_out ch; + Printf.printf "\x1b[0;31m\x1b[1m[FAILED]\x1b[0m \x1b[1m%-20s\x1b[0;33m%s.\n\x1b[m%!" name + (Printf.sprintf "Command '%s' with error code %n output written to %s" cmd n log_name); + | Some failing_msg -> + let starts_with_plus s = String.length s > 0 && s.[0] = '+' in + let lines = List.filter (fun s -> not (starts_with_plus s)) lines in + let msg = String.concat "\n" lines in + if failing_msg = msg then + Printf.printf "\x1b[0;32m\x1b[1m[PASSED]\x1b[0m \x1b[1m%-20s\x1b[0;36m%s.\n\x1b[m%!" name description + else + Printf.printf "\x1b[0;31m\x1b[1m[FAILED]\x1b[0m \x1b[1m%-20s\x1b[0;33m%s.\n\x1b[m%!" name ((Printf.sprintf "Failure with not matching message:\n%s\n!=\n%s\n") msg failing_msg) + end; + | _ -> + let errors = List.concat (List.map (Match.match_with_fs ~root:full_name) matching) in + begin if errors == [] then + Printf.printf "\x1b[0;32m\x1b[1m[PASSED]\x1b[0m \x1b[1m%-20s\x1b[0;36m%s.\n\x1b[m%!" name description + else begin + let ch = open_out log_name in + output_string ch ("Run '" ^ cmd ^ "'\n"); + List.iter (fun e -> output_string ch (Match.string_of_error e); output_string ch ".\n") errors; + close_out ch; + Printf.printf "\x1b[0;31m\x1b[1m[FAILED]\x1b[0m \x1b[1m%-20s\x1b[0;33m%s.\n\x1b[m%!" name + (Printf.sprintf "Some system checks failed, output written to %s" log_name) + end + end) + + in List.iter one_test !tests diff -Nru ocaml-3.12.1/ocamlbuild/tools.ml ocaml-4.01.0/ocamlbuild/tools.ml --- ocaml-3.12.1/ocamlbuild/tools.ml 2010-01-22 14:36:57.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/tools.ml 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamlbuild/tools.mli ocaml-4.01.0/ocamlbuild/tools.mli --- ocaml-3.12.1/ocamlbuild/tools.mli 2010-01-22 14:36:57.000000000 +0000 +++ ocaml-4.01.0/ocamlbuild/tools.mli 2012-08-01 14:47:00.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* ocamlbuild *) (* *) (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) diff -Nru ocaml-3.12.1/ocamldoc/.cvsignore ocaml-4.01.0/ocamldoc/.cvsignore --- ocaml-3.12.1/ocamldoc/.cvsignore 2010-01-20 16:26:46.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/.cvsignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,17 +0,0 @@ -ocamldoc -ocamldoc.opt -odoc_crc.ml -odoc_lexer.ml -odoc_ocamlhtml.ml -odoc_parser.ml -odoc_parser.mli -odoc_see_lexer.ml -odoc_text_lexer.ml -odoc_text_parser.ml -odoc_text_parser.mli -stdlib_man -*.output -test_stdlib -test_latex -test -*.a diff -Nru ocaml-3.12.1/ocamldoc/.depend ocaml-4.01.0/ocamldoc/.depend --- ocaml-3.12.1/ocamldoc/.depend 2010-07-23 15:30:37.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/.depend 2013-08-15 16:13:16.000000000 +0000 @@ -1,245 +1,256 @@ -odoc.cmo: ../typing/typedtree.cmi odoc_texi.cmo odoc_messages.cmo \ - odoc_man.cmo odoc_latex.cmo odoc_info.cmi odoc_html.cmo odoc_global.cmi \ - odoc_dot.cmo odoc_config.cmi odoc_args.cmi odoc_analyse.cmi \ - ../utils/misc.cmi ../utils/config.cmi ../utils/clflags.cmi -odoc.cmx: ../typing/typedtree.cmx odoc_texi.cmx odoc_messages.cmx \ - odoc_man.cmx odoc_latex.cmx odoc_info.cmx odoc_html.cmx odoc_global.cmx \ - odoc_dot.cmx odoc_config.cmx odoc_args.cmx odoc_analyse.cmx \ - ../utils/misc.cmx ../utils/config.cmx ../utils/clflags.cmx -odoc_analyse.cmo: ../utils/warnings.cmi ../typing/typetexp.cmi \ +odoc.cmo : ../typing/typedtree.cmi odoc_messages.cmo odoc_info.cmi \ + odoc_global.cmi odoc_gen.cmi odoc_config.cmi odoc_args.cmi \ + odoc_analyse.cmi ../utils/misc.cmi ../utils/config.cmi \ + ../utils/clflags.cmi +odoc.cmx : ../typing/typedtree.cmx odoc_messages.cmx odoc_info.cmx \ + odoc_global.cmx odoc_gen.cmx odoc_config.cmx odoc_args.cmx \ + odoc_analyse.cmx ../utils/misc.cmx ../utils/config.cmx \ + ../utils/clflags.cmx +odoc_analyse.cmo : ../utils/warnings.cmi ../typing/typetexp.cmi \ ../typing/types.cmi ../typing/typemod.cmi ../typing/typedtree.cmi \ ../typing/typedecl.cmi ../typing/typecore.cmi ../typing/typeclass.cmi \ ../bytecomp/translcore.cmi ../bytecomp/translclass.cmi \ - ../parsing/syntaxerr.cmi ../parsing/parse.cmi odoc_types.cmi \ - odoc_text.cmi odoc_sig.cmi odoc_module.cmo odoc_misc.cmi \ + ../parsing/syntaxerr.cmi ../driver/pparse.cmi ../parsing/parse.cmi \ + odoc_types.cmi odoc_text.cmi odoc_sig.cmi odoc_module.cmo odoc_misc.cmi \ odoc_messages.cmo odoc_merge.cmi odoc_global.cmi odoc_dep.cmo \ odoc_cross.cmi odoc_comments.cmi odoc_class.cmo odoc_ast.cmi \ - odoc_args.cmi ../utils/misc.cmi ../parsing/location.cmi \ - ../parsing/lexer.cmi ../typing/includemod.cmi ../typing/env.cmi \ - ../typing/ctype.cmi ../utils/config.cmi ../utils/clflags.cmi \ - ../utils/ccomp.cmi odoc_analyse.cmi -odoc_analyse.cmx: ../utils/warnings.cmx ../typing/typetexp.cmx \ + ../utils/misc.cmi ../parsing/location.cmi ../parsing/lexer.cmi \ + ../typing/includemod.cmi ../typing/env.cmi ../typing/ctype.cmi \ + ../utils/config.cmi ../typing/cmi_format.cmi ../utils/clflags.cmi \ + odoc_analyse.cmi +odoc_analyse.cmx : ../utils/warnings.cmx ../typing/typetexp.cmx \ ../typing/types.cmx ../typing/typemod.cmx ../typing/typedtree.cmx \ ../typing/typedecl.cmx ../typing/typecore.cmx ../typing/typeclass.cmx \ ../bytecomp/translcore.cmx ../bytecomp/translclass.cmx \ - ../parsing/syntaxerr.cmx ../parsing/parse.cmx odoc_types.cmx \ - odoc_text.cmx odoc_sig.cmx odoc_module.cmx odoc_misc.cmx \ + ../parsing/syntaxerr.cmx ../driver/pparse.cmx ../parsing/parse.cmx \ + odoc_types.cmx odoc_text.cmx odoc_sig.cmx odoc_module.cmx odoc_misc.cmx \ odoc_messages.cmx odoc_merge.cmx odoc_global.cmx odoc_dep.cmx \ odoc_cross.cmx odoc_comments.cmx odoc_class.cmx odoc_ast.cmx \ - odoc_args.cmx ../utils/misc.cmx ../parsing/location.cmx \ - ../parsing/lexer.cmx ../typing/includemod.cmx ../typing/env.cmx \ - ../typing/ctype.cmx ../utils/config.cmx ../utils/clflags.cmx \ - ../utils/ccomp.cmx odoc_analyse.cmi -odoc_args.cmo: odoc_types.cmi odoc_module.cmo odoc_messages.cmo \ - odoc_global.cmi odoc_config.cmi ../utils/misc.cmi ../utils/config.cmi \ - ../utils/clflags.cmi odoc_args.cmi -odoc_args.cmx: odoc_types.cmx odoc_module.cmx odoc_messages.cmx \ - odoc_global.cmx odoc_config.cmx ../utils/misc.cmx ../utils/config.cmx \ - ../utils/clflags.cmx odoc_args.cmi -odoc_ast.cmo: ../typing/types.cmi ../typing/typedtree.cmi \ + ../utils/misc.cmx ../parsing/location.cmx ../parsing/lexer.cmx \ + ../typing/includemod.cmx ../typing/env.cmx ../typing/ctype.cmx \ + ../utils/config.cmx ../typing/cmi_format.cmx ../utils/clflags.cmx \ + odoc_analyse.cmi +odoc_args.cmo : odoc_types.cmi odoc_texi.cmo odoc_messages.cmo odoc_man.cmo \ + odoc_latex.cmo odoc_html.cmo odoc_global.cmi odoc_gen.cmi odoc_dot.cmo \ + odoc_config.cmi ../utils/misc.cmi ../utils/config.cmi odoc_args.cmi +odoc_args.cmx : odoc_types.cmx odoc_texi.cmx odoc_messages.cmx odoc_man.cmx \ + odoc_latex.cmx odoc_html.cmx odoc_global.cmx odoc_gen.cmx odoc_dot.cmx \ + odoc_config.cmx ../utils/misc.cmx ../utils/config.cmx odoc_args.cmi +odoc_ast.cmo : ../typing/types.cmi ../typing/typedtree.cmi \ ../typing/predef.cmi ../typing/path.cmi ../parsing/parsetree.cmi \ odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_sig.cmi \ odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_messages.cmo \ odoc_global.cmi odoc_exception.cmo odoc_env.cmi odoc_class.cmo \ - odoc_args.cmi ../utils/misc.cmi ../parsing/location.cmi \ - ../typing/ident.cmi ../parsing/asttypes.cmi odoc_ast.cmi -odoc_ast.cmx: ../typing/types.cmx ../typing/typedtree.cmx \ + ../utils/misc.cmi ../parsing/location.cmi ../typing/ident.cmi \ + ../parsing/asttypes.cmi odoc_ast.cmi +odoc_ast.cmx : ../typing/types.cmx ../typing/typedtree.cmx \ ../typing/predef.cmx ../typing/path.cmx ../parsing/parsetree.cmi \ odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_sig.cmx \ odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_messages.cmx \ odoc_global.cmx odoc_exception.cmx odoc_env.cmx odoc_class.cmx \ - odoc_args.cmx ../utils/misc.cmx ../parsing/location.cmx \ - ../typing/ident.cmx ../parsing/asttypes.cmi odoc_ast.cmi -odoc_class.cmo: ../typing/types.cmi odoc_value.cmo odoc_types.cmi \ + ../utils/misc.cmx ../parsing/location.cmx ../typing/ident.cmx \ + ../parsing/asttypes.cmi odoc_ast.cmi +odoc_class.cmo : ../typing/types.cmi odoc_value.cmo odoc_types.cmi \ odoc_parameter.cmo odoc_name.cmi -odoc_class.cmx: ../typing/types.cmx odoc_value.cmx odoc_types.cmx \ +odoc_class.cmx : ../typing/types.cmx odoc_value.cmx odoc_types.cmx \ odoc_parameter.cmx odoc_name.cmx -odoc_comments.cmo: odoc_types.cmi odoc_text.cmi odoc_see_lexer.cmo \ +odoc_comments.cmo : odoc_types.cmi odoc_text.cmi odoc_see_lexer.cmo \ odoc_parser.cmi odoc_misc.cmi odoc_messages.cmo odoc_merge.cmi \ odoc_lexer.cmo odoc_global.cmi odoc_cross.cmi odoc_comments_global.cmi \ odoc_comments.cmi -odoc_comments.cmx: odoc_types.cmx odoc_text.cmx odoc_see_lexer.cmx \ +odoc_comments.cmx : odoc_types.cmx odoc_text.cmx odoc_see_lexer.cmx \ odoc_parser.cmx odoc_misc.cmx odoc_messages.cmx odoc_merge.cmx \ odoc_lexer.cmx odoc_global.cmx odoc_cross.cmx odoc_comments_global.cmx \ odoc_comments.cmi -odoc_comments_global.cmo: odoc_comments_global.cmi -odoc_comments_global.cmx: odoc_comments_global.cmi -odoc_config.cmo: ../utils/config.cmi odoc_config.cmi -odoc_config.cmx: ../utils/config.cmx odoc_config.cmi -odoc_control.cmo: -odoc_control.cmx: -odoc_cross.cmo: odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_search.cmi \ +odoc_comments_global.cmo : odoc_comments_global.cmi +odoc_comments_global.cmx : odoc_comments_global.cmi +odoc_config.cmo : ../utils/config.cmi odoc_config.cmi +odoc_config.cmx : ../utils/config.cmx odoc_config.cmi +odoc_control.cmo : +odoc_control.cmx : +odoc_cross.cmo : odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_search.cmi \ odoc_scan.cmo odoc_parameter.cmo odoc_name.cmi odoc_module.cmo \ - odoc_misc.cmi odoc_messages.cmo odoc_exception.cmo odoc_class.cmo \ - odoc_cross.cmi -odoc_cross.cmx: odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_search.cmx \ + odoc_misc.cmi odoc_messages.cmo odoc_global.cmi odoc_exception.cmo \ + odoc_class.cmo odoc_cross.cmi +odoc_cross.cmx : odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_search.cmx \ odoc_scan.cmx odoc_parameter.cmx odoc_name.cmx odoc_module.cmx \ - odoc_misc.cmx odoc_messages.cmx odoc_exception.cmx odoc_class.cmx \ - odoc_cross.cmi -odoc_dag2html.cmo: odoc_info.cmi odoc_dag2html.cmi -odoc_dag2html.cmx: odoc_info.cmx odoc_dag2html.cmi -odoc_dep.cmo: ../parsing/parsetree.cmi odoc_type.cmo odoc_print.cmi \ + odoc_misc.cmx odoc_messages.cmx odoc_global.cmx odoc_exception.cmx \ + odoc_class.cmx odoc_cross.cmi +odoc_dag2html.cmo : odoc_info.cmi odoc_dag2html.cmi +odoc_dag2html.cmx : odoc_info.cmx odoc_dag2html.cmi +odoc_dep.cmo : ../parsing/parsetree.cmi odoc_type.cmo odoc_print.cmi \ odoc_module.cmo ../tools/depend.cmi -odoc_dep.cmx: ../parsing/parsetree.cmi odoc_type.cmx odoc_print.cmx \ +odoc_dep.cmx : ../parsing/parsetree.cmi odoc_type.cmx odoc_print.cmx \ odoc_module.cmx ../tools/depend.cmx -odoc_dot.cmo: odoc_info.cmi -odoc_dot.cmx: odoc_info.cmx -odoc_env.cmo: ../typing/types.cmi ../typing/printtyp.cmi ../typing/predef.cmi \ - ../typing/path.cmi odoc_name.cmi ../typing/btype.cmi odoc_env.cmi -odoc_env.cmx: ../typing/types.cmx ../typing/printtyp.cmx ../typing/predef.cmx \ - ../typing/path.cmx odoc_name.cmx ../typing/btype.cmx odoc_env.cmi -odoc_exception.cmo: ../typing/types.cmi odoc_types.cmi odoc_name.cmi -odoc_exception.cmx: ../typing/types.cmx odoc_types.cmx odoc_name.cmx -odoc_global.cmo: ../utils/clflags.cmi odoc_global.cmi -odoc_global.cmx: ../utils/clflags.cmx odoc_global.cmi -odoc_html.cmo: odoc_text.cmi odoc_ocamlhtml.cmo odoc_messages.cmo \ - odoc_info.cmi odoc_dag2html.cmi odoc_args.cmi ../parsing/asttypes.cmi -odoc_html.cmx: odoc_text.cmx odoc_ocamlhtml.cmx odoc_messages.cmx \ - odoc_info.cmx odoc_dag2html.cmx odoc_args.cmx ../parsing/asttypes.cmi -odoc_info.cmo: ../typing/printtyp.cmi odoc_value.cmo odoc_types.cmi \ +odoc_dot.cmo : odoc_messages.cmo odoc_info.cmi +odoc_dot.cmx : odoc_messages.cmx odoc_info.cmx +odoc_env.cmo : ../typing/types.cmi ../typing/printtyp.cmi \ + ../typing/predef.cmi ../typing/path.cmi odoc_name.cmi ../typing/btype.cmi \ + odoc_env.cmi +odoc_env.cmx : ../typing/types.cmx ../typing/printtyp.cmx \ + ../typing/predef.cmx ../typing/path.cmx odoc_name.cmx ../typing/btype.cmx \ + odoc_env.cmi +odoc_exception.cmo : ../typing/types.cmi odoc_types.cmi odoc_name.cmi +odoc_exception.cmx : ../typing/types.cmx odoc_types.cmx odoc_name.cmx +odoc_gen.cmo : odoc_texi.cmo odoc_module.cmo odoc_man.cmo odoc_latex.cmo \ + odoc_html.cmo odoc_dot.cmo odoc_gen.cmi +odoc_gen.cmx : odoc_texi.cmx odoc_module.cmx odoc_man.cmx odoc_latex.cmx \ + odoc_html.cmx odoc_dot.cmx odoc_gen.cmi +odoc_global.cmo : odoc_types.cmi odoc_messages.cmo odoc_config.cmi \ + ../utils/clflags.cmi odoc_global.cmi +odoc_global.cmx : odoc_types.cmx odoc_messages.cmx odoc_config.cmx \ + ../utils/clflags.cmx odoc_global.cmi +odoc_html.cmo : odoc_text.cmi odoc_ocamlhtml.cmo odoc_messages.cmo \ + odoc_info.cmi odoc_global.cmi odoc_dag2html.cmi ../parsing/asttypes.cmi +odoc_html.cmx : odoc_text.cmx odoc_ocamlhtml.cmx odoc_messages.cmx \ + odoc_info.cmx odoc_global.cmx odoc_dag2html.cmx ../parsing/asttypes.cmi +odoc_info.cmo : ../typing/printtyp.cmi odoc_value.cmo odoc_types.cmi \ odoc_type.cmo odoc_text.cmi odoc_str.cmi odoc_search.cmi odoc_scan.cmo \ odoc_print.cmi odoc_parameter.cmo odoc_name.cmi odoc_module.cmo \ - odoc_misc.cmi odoc_messages.cmo odoc_global.cmi odoc_exception.cmo \ - odoc_dep.cmo odoc_config.cmi odoc_comments.cmi odoc_class.cmo \ - odoc_args.cmi odoc_analyse.cmi odoc_info.cmi -odoc_info.cmx: ../typing/printtyp.cmx odoc_value.cmx odoc_types.cmx \ + odoc_misc.cmi odoc_global.cmi odoc_exception.cmo odoc_dep.cmo \ + odoc_config.cmi odoc_comments.cmi odoc_class.cmo odoc_analyse.cmi \ + ../parsing/location.cmi odoc_info.cmi +odoc_info.cmx : ../typing/printtyp.cmx odoc_value.cmx odoc_types.cmx \ odoc_type.cmx odoc_text.cmx odoc_str.cmx odoc_search.cmx odoc_scan.cmx \ odoc_print.cmx odoc_parameter.cmx odoc_name.cmx odoc_module.cmx \ - odoc_misc.cmx odoc_messages.cmx odoc_global.cmx odoc_exception.cmx \ - odoc_dep.cmx odoc_config.cmx odoc_comments.cmx odoc_class.cmx \ - odoc_args.cmx odoc_analyse.cmx odoc_info.cmi -odoc_inherit.cmo: -odoc_inherit.cmx: -odoc_latex.cmo: odoc_to_text.cmo odoc_messages.cmo odoc_latex_style.cmo \ + odoc_misc.cmx odoc_global.cmx odoc_exception.cmx odoc_dep.cmx \ + odoc_config.cmx odoc_comments.cmx odoc_class.cmx odoc_analyse.cmx \ + ../parsing/location.cmx odoc_info.cmi +odoc_inherit.cmo : +odoc_inherit.cmx : +odoc_latex.cmo : odoc_to_text.cmo odoc_messages.cmo odoc_latex_style.cmo \ + odoc_info.cmi ../parsing/asttypes.cmi +odoc_latex.cmx : odoc_to_text.cmx odoc_messages.cmx odoc_latex_style.cmx \ + odoc_info.cmx ../parsing/asttypes.cmi +odoc_latex_style.cmo : +odoc_latex_style.cmx : +odoc_lexer.cmo : odoc_parser.cmi odoc_messages.cmo odoc_global.cmi \ + odoc_comments_global.cmi +odoc_lexer.cmx : odoc_parser.cmx odoc_messages.cmx odoc_global.cmx \ + odoc_comments_global.cmx +odoc_man.cmo : odoc_str.cmi odoc_print.cmi odoc_misc.cmi odoc_messages.cmo \ odoc_info.cmi ../parsing/asttypes.cmi -odoc_latex.cmx: odoc_to_text.cmx odoc_messages.cmx odoc_latex_style.cmx \ +odoc_man.cmx : odoc_str.cmx odoc_print.cmx odoc_misc.cmx odoc_messages.cmx \ odoc_info.cmx ../parsing/asttypes.cmi -odoc_latex_style.cmo: -odoc_latex_style.cmx: -odoc_lexer.cmo: odoc_parser.cmi odoc_messages.cmo odoc_comments_global.cmi \ - odoc_args.cmi -odoc_lexer.cmx: odoc_parser.cmx odoc_messages.cmx odoc_comments_global.cmx \ - odoc_args.cmx -odoc_man.cmo: odoc_str.cmi odoc_print.cmi odoc_misc.cmi odoc_messages.cmo \ - odoc_info.cmi odoc_args.cmi ../parsing/asttypes.cmi -odoc_man.cmx: odoc_str.cmx odoc_print.cmx odoc_misc.cmx odoc_messages.cmx \ - odoc_info.cmx odoc_args.cmx ../parsing/asttypes.cmi -odoc_merge.cmo: odoc_value.cmo odoc_types.cmi odoc_type.cmo \ +odoc_merge.cmo : odoc_value.cmo odoc_types.cmi odoc_type.cmo \ odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_messages.cmo \ - odoc_exception.cmo odoc_class.cmo odoc_args.cmi odoc_merge.cmi -odoc_merge.cmx: odoc_value.cmx odoc_types.cmx odoc_type.cmx \ + odoc_global.cmi odoc_exception.cmo odoc_class.cmo odoc_merge.cmi +odoc_merge.cmx : odoc_value.cmx odoc_types.cmx odoc_type.cmx \ odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_messages.cmx \ - odoc_exception.cmx odoc_class.cmx odoc_args.cmx odoc_merge.cmi -odoc_messages.cmo: odoc_global.cmi odoc_config.cmi ../utils/config.cmi -odoc_messages.cmx: odoc_global.cmx odoc_config.cmx ../utils/config.cmx -odoc_misc.cmo: ../typing/types.cmi ../typing/predef.cmi ../typing/path.cmi \ + odoc_global.cmx odoc_exception.cmx odoc_class.cmx odoc_merge.cmi +odoc_messages.cmo : ../utils/config.cmi +odoc_messages.cmx : ../utils/config.cmx +odoc_misc.cmo : ../typing/types.cmi ../typing/predef.cmi ../typing/path.cmi \ odoc_types.cmi odoc_messages.cmo ../parsing/longident.cmi \ ../typing/ctype.cmi ../typing/btype.cmi odoc_misc.cmi -odoc_misc.cmx: ../typing/types.cmx ../typing/predef.cmx ../typing/path.cmx \ +odoc_misc.cmx : ../typing/types.cmx ../typing/predef.cmx ../typing/path.cmx \ odoc_types.cmx odoc_messages.cmx ../parsing/longident.cmx \ ../typing/ctype.cmx ../typing/btype.cmx odoc_misc.cmi -odoc_module.cmo: ../typing/types.cmi odoc_value.cmo odoc_types.cmi \ +odoc_module.cmo : ../typing/types.cmi odoc_value.cmo odoc_types.cmi \ odoc_type.cmo odoc_name.cmi odoc_exception.cmo odoc_class.cmo -odoc_module.cmx: ../typing/types.cmx odoc_value.cmx odoc_types.cmx \ +odoc_module.cmx : ../typing/types.cmx odoc_value.cmx odoc_types.cmx \ odoc_type.cmx odoc_name.cmx odoc_exception.cmx odoc_class.cmx -odoc_name.cmo: ../typing/path.cmi odoc_misc.cmi ../typing/ident.cmi \ +odoc_name.cmo : ../typing/path.cmi odoc_misc.cmi ../typing/ident.cmi \ odoc_name.cmi -odoc_name.cmx: ../typing/path.cmx odoc_misc.cmx ../typing/ident.cmx \ +odoc_name.cmx : ../typing/path.cmx odoc_misc.cmx ../typing/ident.cmx \ odoc_name.cmi -odoc_ocamlhtml.cmo: -odoc_ocamlhtml.cmx: -odoc_parameter.cmo: ../typing/types.cmi odoc_types.cmi -odoc_parameter.cmx: ../typing/types.cmx odoc_types.cmx -odoc_parser.cmo: odoc_types.cmi odoc_comments_global.cmi odoc_parser.cmi -odoc_parser.cmx: odoc_types.cmx odoc_comments_global.cmx odoc_parser.cmi -odoc_print.cmo: ../typing/types.cmi ../typing/printtyp.cmi odoc_print.cmi -odoc_print.cmx: ../typing/types.cmx ../typing/printtyp.cmx odoc_print.cmi -odoc_scan.cmo: odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_module.cmo \ +odoc_ocamlhtml.cmo : +odoc_ocamlhtml.cmx : +odoc_parameter.cmo : ../typing/types.cmi odoc_types.cmi +odoc_parameter.cmx : ../typing/types.cmx odoc_types.cmx +odoc_parser.cmo : odoc_types.cmi odoc_comments_global.cmi odoc_parser.cmi +odoc_parser.cmx : odoc_types.cmx odoc_comments_global.cmx odoc_parser.cmi +odoc_print.cmo : ../typing/types.cmi ../typing/printtyp.cmi odoc_print.cmi +odoc_print.cmx : ../typing/types.cmx ../typing/printtyp.cmx odoc_print.cmi +odoc_scan.cmo : odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_module.cmo \ odoc_exception.cmo odoc_class.cmo -odoc_scan.cmx: odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_module.cmx \ +odoc_scan.cmx : odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_module.cmx \ odoc_exception.cmx odoc_class.cmx -odoc_search.cmo: odoc_value.cmo odoc_types.cmi odoc_type.cmo \ +odoc_search.cmo : odoc_value.cmo odoc_types.cmi odoc_type.cmo \ odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_exception.cmo \ odoc_class.cmo odoc_search.cmi -odoc_search.cmx: odoc_value.cmx odoc_types.cmx odoc_type.cmx \ +odoc_search.cmx : odoc_value.cmx odoc_types.cmx odoc_type.cmx \ odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_exception.cmx \ odoc_class.cmx odoc_search.cmi -odoc_see_lexer.cmo: odoc_parser.cmi -odoc_see_lexer.cmx: odoc_parser.cmx -odoc_sig.cmo: ../typing/types.cmi ../typing/typedtree.cmi ../typing/path.cmi \ - ../parsing/parsetree.cmi odoc_value.cmo odoc_types.cmi odoc_type.cmo \ - odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_misc.cmi \ - odoc_messages.cmo odoc_merge.cmi odoc_global.cmi odoc_exception.cmo \ - odoc_env.cmi odoc_class.cmo odoc_args.cmi ../utils/misc.cmi \ - ../parsing/location.cmi ../typing/btype.cmi ../parsing/asttypes.cmi \ - odoc_sig.cmi -odoc_sig.cmx: ../typing/types.cmx ../typing/typedtree.cmx ../typing/path.cmx \ - ../parsing/parsetree.cmi odoc_value.cmx odoc_types.cmx odoc_type.cmx \ - odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_misc.cmx \ - odoc_messages.cmx odoc_merge.cmx odoc_global.cmx odoc_exception.cmx \ - odoc_env.cmx odoc_class.cmx odoc_args.cmx ../utils/misc.cmx \ - ../parsing/location.cmx ../typing/btype.cmx ../parsing/asttypes.cmi \ - odoc_sig.cmi -odoc_str.cmo: ../typing/types.cmi ../typing/printtyp.cmi odoc_value.cmo \ +odoc_see_lexer.cmo : odoc_parser.cmi +odoc_see_lexer.cmx : odoc_parser.cmx +odoc_sig.cmo : ../typing/types.cmi ../typing/typedtree.cmi \ + ../typing/path.cmi ../parsing/parsetree.cmi odoc_value.cmo odoc_types.cmi \ + odoc_type.cmo odoc_parameter.cmo odoc_name.cmi odoc_module.cmo \ + odoc_misc.cmi odoc_messages.cmo odoc_merge.cmi odoc_global.cmi \ + odoc_exception.cmo odoc_env.cmi odoc_class.cmo ../utils/misc.cmi \ + ../parsing/location.cmi ../typing/ident.cmi ../typing/btype.cmi \ + ../parsing/asttypes.cmi odoc_sig.cmi +odoc_sig.cmx : ../typing/types.cmx ../typing/typedtree.cmx \ + ../typing/path.cmx ../parsing/parsetree.cmi odoc_value.cmx odoc_types.cmx \ + odoc_type.cmx odoc_parameter.cmx odoc_name.cmx odoc_module.cmx \ + odoc_misc.cmx odoc_messages.cmx odoc_merge.cmx odoc_global.cmx \ + odoc_exception.cmx odoc_env.cmx odoc_class.cmx ../utils/misc.cmx \ + ../parsing/location.cmx ../typing/ident.cmx ../typing/btype.cmx \ + ../parsing/asttypes.cmi odoc_sig.cmi +odoc_str.cmo : ../typing/types.cmi ../typing/printtyp.cmi odoc_value.cmo \ odoc_type.cmo odoc_print.cmi odoc_name.cmi odoc_misc.cmi \ odoc_messages.cmo odoc_exception.cmo odoc_class.cmo \ ../parsing/asttypes.cmi odoc_str.cmi -odoc_str.cmx: ../typing/types.cmx ../typing/printtyp.cmx odoc_value.cmx \ +odoc_str.cmx : ../typing/types.cmx ../typing/printtyp.cmx odoc_value.cmx \ odoc_type.cmx odoc_print.cmx odoc_name.cmx odoc_misc.cmx \ odoc_messages.cmx odoc_exception.cmx odoc_class.cmx \ ../parsing/asttypes.cmi odoc_str.cmi -odoc_test.cmo: odoc_info.cmi -odoc_test.cmx: odoc_info.cmx -odoc_texi.cmo: odoc_to_text.cmo odoc_messages.cmo odoc_info.cmi \ - ../parsing/asttypes.cmi -odoc_texi.cmx: odoc_to_text.cmx odoc_messages.cmx odoc_info.cmx \ - ../parsing/asttypes.cmi -odoc_text.cmo: odoc_types.cmi odoc_text_parser.cmi odoc_text_lexer.cmo \ +odoc_test.cmo : odoc_info.cmi odoc_gen.cmi odoc_args.cmi +odoc_test.cmx : odoc_info.cmx odoc_gen.cmx odoc_args.cmx +odoc_texi.cmo : ../typing/types.cmi odoc_to_text.cmo odoc_messages.cmo \ + odoc_info.cmi ../parsing/asttypes.cmi +odoc_texi.cmx : ../typing/types.cmx odoc_to_text.cmx odoc_messages.cmx \ + odoc_info.cmx ../parsing/asttypes.cmi +odoc_text.cmo : odoc_types.cmi odoc_text_parser.cmi odoc_text_lexer.cmo \ odoc_text.cmi -odoc_text.cmx: odoc_types.cmx odoc_text_parser.cmx odoc_text_lexer.cmx \ +odoc_text.cmx : odoc_types.cmx odoc_text_parser.cmx odoc_text_lexer.cmx \ odoc_text.cmi -odoc_text_lexer.cmo: odoc_text_parser.cmi odoc_misc.cmi -odoc_text_lexer.cmx: odoc_text_parser.cmx odoc_misc.cmx -odoc_text_parser.cmo: odoc_types.cmi odoc_misc.cmi odoc_text_parser.cmi -odoc_text_parser.cmx: odoc_types.cmx odoc_misc.cmx odoc_text_parser.cmi -odoc_to_text.cmo: odoc_module.cmo odoc_messages.cmo odoc_info.cmi -odoc_to_text.cmx: odoc_module.cmx odoc_messages.cmx odoc_info.cmx -odoc_type.cmo: ../typing/types.cmi odoc_types.cmi odoc_name.cmi \ +odoc_text_lexer.cmo : odoc_text_parser.cmi odoc_misc.cmi +odoc_text_lexer.cmx : odoc_text_parser.cmx odoc_misc.cmx +odoc_text_parser.cmo : odoc_types.cmi odoc_misc.cmi odoc_text_parser.cmi +odoc_text_parser.cmx : odoc_types.cmx odoc_misc.cmx odoc_text_parser.cmi +odoc_to_text.cmo : odoc_module.cmo odoc_messages.cmo odoc_info.cmi +odoc_to_text.cmx : odoc_module.cmx odoc_messages.cmx odoc_info.cmx +odoc_type.cmo : ../typing/types.cmi odoc_types.cmi odoc_name.cmi \ ../parsing/asttypes.cmi -odoc_type.cmx: ../typing/types.cmx odoc_types.cmx odoc_name.cmx \ +odoc_type.cmx : ../typing/types.cmx odoc_types.cmx odoc_name.cmx \ ../parsing/asttypes.cmi -odoc_types.cmo: odoc_messages.cmo odoc_types.cmi -odoc_types.cmx: odoc_messages.cmx odoc_types.cmi -odoc_value.cmo: ../typing/types.cmi ../typing/printtyp.cmi odoc_types.cmi \ +odoc_types.cmo : odoc_messages.cmo ../parsing/location.cmi odoc_types.cmi +odoc_types.cmx : odoc_messages.cmx ../parsing/location.cmx odoc_types.cmi +odoc_value.cmo : ../typing/types.cmi ../typing/printtyp.cmi odoc_types.cmi \ odoc_parameter.cmo odoc_name.cmi -odoc_value.cmx: ../typing/types.cmx ../typing/printtyp.cmx odoc_types.cmx \ +odoc_value.cmx : ../typing/types.cmx ../typing/printtyp.cmx odoc_types.cmx \ odoc_parameter.cmx odoc_name.cmx -odoc_analyse.cmi: odoc_module.cmo odoc_args.cmi -odoc_args.cmi: odoc_types.cmi odoc_module.cmo -odoc_ast.cmi: ../typing/types.cmi ../typing/typedtree.cmi ../typing/path.cmi \ - ../parsing/parsetree.cmi odoc_sig.cmi odoc_name.cmi odoc_module.cmo -odoc_comments.cmi: odoc_types.cmi odoc_module.cmo -odoc_comments_global.cmi: -odoc_config.cmi: -odoc_cross.cmi: odoc_types.cmi odoc_module.cmo -odoc_dag2html.cmi: odoc_info.cmi -odoc_env.cmi: ../typing/types.cmi odoc_name.cmi -odoc_global.cmi: -odoc_info.cmi: ../typing/types.cmi odoc_value.cmo odoc_types.cmi \ +odoc_analyse.cmi : odoc_module.cmo odoc_global.cmi +odoc_args.cmi : odoc_gen.cmi +odoc_ast.cmi : ../typing/types.cmi ../typing/typedtree.cmi \ + ../typing/path.cmi ../parsing/parsetree.cmi odoc_sig.cmi odoc_name.cmi \ + odoc_module.cmo +odoc_comments.cmi : odoc_types.cmi odoc_module.cmo +odoc_comments_global.cmi : +odoc_config.cmi : +odoc_cross.cmi : odoc_types.cmi odoc_module.cmo +odoc_dag2html.cmi : odoc_info.cmi +odoc_env.cmi : ../typing/types.cmi odoc_name.cmi +odoc_gen.cmi : odoc_texi.cmo odoc_module.cmo odoc_man.cmo odoc_latex.cmo \ + odoc_html.cmo odoc_dot.cmo +odoc_global.cmi : odoc_types.cmi +odoc_info.cmi : ../typing/types.cmi odoc_value.cmo odoc_types.cmi \ odoc_type.cmo odoc_search.cmi odoc_parameter.cmo odoc_module.cmo \ - odoc_exception.cmo odoc_class.cmo -odoc_merge.cmi: odoc_types.cmi odoc_module.cmo -odoc_misc.cmi: ../typing/types.cmi odoc_types.cmi ../parsing/longident.cmi -odoc_name.cmi: ../typing/path.cmi ../parsing/longident.cmi \ + odoc_global.cmi odoc_exception.cmo odoc_class.cmo ../parsing/location.cmi +odoc_merge.cmi : odoc_types.cmi odoc_module.cmo +odoc_misc.cmi : ../typing/types.cmi odoc_types.cmi ../parsing/longident.cmi +odoc_name.cmi : ../typing/path.cmi ../parsing/longident.cmi \ ../typing/ident.cmi -odoc_parser.cmi: odoc_types.cmi -odoc_print.cmi: ../typing/types.cmi -odoc_search.cmi: odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_module.cmo \ - odoc_exception.cmo odoc_class.cmo -odoc_sig.cmi: ../typing/types.cmi ../parsing/parsetree.cmi odoc_types.cmi \ +odoc_parser.cmi : odoc_types.cmi +odoc_print.cmi : ../typing/types.cmi +odoc_search.cmi : odoc_value.cmo odoc_types.cmi odoc_type.cmo \ + odoc_module.cmo odoc_exception.cmo odoc_class.cmo +odoc_sig.cmi : ../typing/types.cmi ../parsing/parsetree.cmi odoc_types.cmi \ odoc_type.cmo odoc_name.cmi odoc_module.cmo odoc_env.cmi odoc_class.cmo -odoc_str.cmi: ../typing/types.cmi odoc_value.cmo odoc_type.cmo \ +odoc_str.cmi : ../typing/types.cmi odoc_value.cmo odoc_type.cmo \ odoc_exception.cmo odoc_class.cmo -odoc_text.cmi: odoc_types.cmi -odoc_text_parser.cmi: odoc_types.cmi -odoc_types.cmi: +odoc_text.cmi : odoc_types.cmi +odoc_text_parser.cmi : odoc_types.cmi +odoc_types.cmi : ../parsing/location.cmi diff -Nru ocaml-3.12.1/ocamldoc/.ignore ocaml-4.01.0/ocamldoc/.ignore --- ocaml-3.12.1/ocamldoc/.ignore 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/.ignore 2012-07-17 15:31:12.000000000 +0000 @@ -0,0 +1,16 @@ +ocamldoc +ocamldoc.opt +odoc_crc.ml +odoc_lexer.ml +odoc_ocamlhtml.ml +odoc_parser.ml +odoc_parser.mli +odoc_see_lexer.ml +odoc_text_lexer.ml +odoc_text_parser.ml +odoc_text_parser.mli +stdlib_man +*.output +test_stdlib +test_latex +test diff -Nru ocaml-3.12.1/ocamldoc/Changes.txt ocaml-4.01.0/ocamldoc/Changes.txt --- ocaml-3.12.1/ocamldoc/Changes.txt 2009-03-11 07:04:39.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/Changes.txt 2012-08-02 08:17:59.000000000 +0000 @@ -6,8 +6,8 @@ module type M = sig type u end module N : sig include M val f: u -> unit end Here, in html for example, f in displayed being of type Foo.u instead of Foo.M.u - - latex: types variant polymorphes dépassent de la page quand ils sont trop longs - - utilisation nouvelles infos de Xavier: "début de rec", etc. + - latex: types variant polymorphes depassent de la page quand ils sont trop longs + - utilisation nouvelles infos de Xavier: "debut de rec", etc. - xml generator ===== @@ -61,12 +61,12 @@ Release 3.08.0: - fix: method parameters names in signature are now retrieved correctly (fix of Odoc_value.parameter_list_from_arrows to handle Tpoly for methods) - - ajout à la doc de Module_list et Index_list (utilisé dans le html seulement) - - ajout à la doc: fichier de l'option -intro utilisé pour l'index en html + - ajout a la doc de Module_list et Index_list (utilise dans le html seulement) + - ajout a la doc: fichier de l'option -intro utilise pour l'index en html - fix: create a Module_with instead of a Module_alias when we encounter module A : Foo in a signature - latex: style latex pour indenter dans les module kind et les class kind - - latex: il manque la génération des paramètres de classe + - latex: il manque la generation des parametres de classe - parse des {!modules: } et {!indexlist} - gestion des Module_list et Index_list - no need to Dynlink.add_available_units any more diff -Nru ocaml-3.12.1/ocamldoc/Makefile ocaml-4.01.0/ocamldoc/Makefile --- ocaml-3.12.1/ocamldoc/Makefile 2011-05-02 13:14:14.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/Makefile 2012-10-15 17:50:56.000000000 +0000 @@ -1,5 +1,6 @@ #(***********************************************************************) -#(* OCamldoc *) +#(* *) +#(* OCamldoc *) #(* *) #(* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) #(* *) @@ -9,8 +10,6 @@ #(* *) #(***********************************************************************) -# $Id: Makefile 11020 2011-05-02 13:14:14Z guesdon $ - include ../config/Makefile # Various commands and dir @@ -36,7 +35,7 @@ OCAMLDOC_LIBCMA=odoc_info.cma OCAMLDOC_LIBCMI=odoc_info.cmi OCAMLDOC_LIBCMXA=odoc_info.cmxa -OCAMLDOC_LIBA=odoc_info.a +OCAMLDOC_LIBA=odoc_info.$(A) INSTALL_LIBDIR=$(OCAMLLIB)/ocamldoc INSTALL_CUSTOMDIR=$(INSTALL_LIBDIR)/custom INSTALL_BINDIR=$(OCAMLBIN) @@ -47,6 +46,13 @@ ODOC_TEST=odoc_test.cmo +GENERATORS_CMOS= \ + generators/odoc_todo.cmo \ + generators/odoc_literate.cmo +true = $(GENERATORS_CMOS:.cmo=.cmxs) +false = +GENERATORS_CMXS := $($(NATDYNLINK)) + # Compilation ############# @@ -72,8 +78,8 @@ LINKFLAGS=$(INCLUDES) -nostdlib CMOFILES= odoc_config.cmo \ - odoc_global.cmo\ odoc_messages.cmo\ + odoc_global.cmo\ odoc_types.cmo\ odoc_misc.cmo\ odoc_text_parser.cmo\ @@ -88,7 +94,6 @@ odoc_module.cmo\ odoc_print.cmo \ odoc_str.cmo\ - odoc_args.cmo\ odoc_comments_global.cmo\ odoc_parser.cmo\ odoc_lexer.cmo\ @@ -121,6 +126,8 @@ odoc_latex.cmo \ odoc_texi.cmo \ odoc_dot.cmo \ + odoc_gen.cmo \ + odoc_args.cmo \ odoc.cmo EXECMXFILES= $(EXECMOFILES:.cmo=.cmx) @@ -140,7 +147,6 @@ $(OCAMLSRCDIR)/utils/warnings.cmo \ $(OCAMLSRCDIR)/utils/ccomp.cmo \ $(OCAMLSRCDIR)/utils/consistbl.cmo \ - $(OCAMLSRCDIR)/parsing/linenum.cmo\ $(OCAMLSRCDIR)/parsing/location.cmo\ $(OCAMLSRCDIR)/parsing/longident.cmo \ $(OCAMLSRCDIR)/parsing/syntaxerr.cmo \ @@ -153,6 +159,7 @@ $(OCAMLSRCDIR)/typing/predef.cmo \ $(OCAMLSRCDIR)/typing/datarepr.cmo \ $(OCAMLSRCDIR)/typing/subst.cmo \ + $(OCAMLSRCDIR)/typing/cmi_format.cmo \ $(OCAMLSRCDIR)/typing/env.cmo \ $(OCAMLSRCDIR)/typing/ctype.cmo \ $(OCAMLSRCDIR)/typing/primitive.cmo \ @@ -163,6 +170,8 @@ $(OCAMLSRCDIR)/typing/typedtree.cmo \ $(OCAMLSRCDIR)/typing/parmatch.cmo \ $(OCAMLSRCDIR)/typing/stypes.cmo \ + $(OCAMLSRCDIR)/typing/typedtreeMap.cmo \ + $(OCAMLSRCDIR)/typing/cmt_format.cmo \ $(OCAMLSRCDIR)/typing/typecore.cmo \ $(OCAMLSRCDIR)/typing/includeclass.cmo \ $(OCAMLSRCDIR)/typing/typedecl.cmo \ @@ -178,7 +187,8 @@ $(OCAMLSRCDIR)/bytecomp/translobj.cmo \ $(OCAMLSRCDIR)/bytecomp/translcore.cmo \ $(OCAMLSRCDIR)/bytecomp/translclass.cmo \ - $(OCAMLSRCDIR)/tools/depend.cmo + $(OCAMLSRCDIR)/tools/depend.cmo \ + $(OCAMLSRCDIR)/driver/pparse.cmo OCAMLCMXFILES=$(OCAMLCMOFILES:.cmo=.cmx) @@ -188,26 +198,29 @@ ../otherlibs/bigarray/bigarray.mli \ ../otherlibs/num/num.mli -all: exe lib manpages +all: exe lib generators manpages exe: $(OCAMLDOC) lib: $(OCAMLDOC_LIBCMA) $(OCAMLDOC_LIBCMI) $(ODOC_TEST) +generators: $(GENERATORS_CMOS) -opt.opt: exeopt libopt +opt.opt: exeopt libopt generatorsopt exeopt: $(OCAMLDOC_OPT) libopt: $(OCAMLDOC_LIBCMXA) $(OCAMLDOC_LIBCMI) +generatorsopt: $(GENERATORS_CMXS) + debug: - make OCAMLPP="" + $(MAKE) OCAMLPP="" $(OCAMLDOC): $(EXECMOFILES) $(OCAMLC) -o $@ -linkall unix.cma str.cma dynlink.cma $(LINKFLAGS) $(OCAMLCMOFILES) $(EXECMOFILES) $(OCAMLDOC_OPT): $(EXECMXFILES) - $(OCAMLOPT) -o $@ unix.cmxa str.cmxa dynlink.cmxa $(LINKFLAGS) $(OCAMLCMXFILES) $(EXECMXFILES) + $(OCAMLOPT) -o $@ -linkall unix.cmxa str.cmxa dynlink.cmxa $(LINKFLAGS) $(OCAMLCMXFILES) $(EXECMXFILES) $(OCAMLDOC_LIBCMA): $(LIBCMOFILES) - $(OCAMLC) -a -o $@ $(LINKFLAGS) $(OCAMLCMOFILES) $(LIBCMOFILES) + $(OCAMLC) -a -o $@ $(LINKFLAGS) $(OCAMLSRCDIR)/tools/depend.cmo $(LIBCMOFILES) $(OCAMLDOC_LIBCMXA): $(LIBCMXFILES) - $(OCAMLOPT) -a -o $@ $(LINKFLAGS) $(OCAMLCMXFILES) $(LIBCMXFILES) + $(OCAMLOPT) -a -o $@ $(LINKFLAGS) $(OCAMLSRCDIR)/tools/depend.cmx $(LIBCMXFILES) manpages: stdlib_man/Pervasives.3o @@ -235,7 +248,7 @@ # generic rules : ################# -.SUFFIXES: .mll .mly .ml .mli .cmo .cmi .cmx +.SUFFIXES: .mll .mly .ml .mli .cmo .cmi .cmx .cmxs .ml.cmo: $(OCAMLC) $(OCAMLPP) $(COMPFLAGS) -c $< @@ -246,6 +259,9 @@ .ml.cmx: $(OCAMLOPT) $(OCAMLPP) $(COMPFLAGS) -c $< +.ml.cmxs: + $(OCAMLOPT) -shared -o $@ $(OCAMLPP) $(COMPFLAGS) $< + .mll.ml: $(OCAMLLEX) $< @@ -282,6 +298,10 @@ test: dummy $(MKDIR) $@ $(OCAMLDOC_RUN) -html -colorize-code -sort -d $@ $(INCLUDES) -dump $@/ocamldoc.odoc odoc*.ml odoc*.mli -v + $(MKDIR) $@-custom + $(OCAMLDOC_RUN) -colorize-code -sort -d $@-custom $(INCLUDES) \ + -g generators/odoc_literate.cmo -g generators/odoc_todo.cmo \ + -load $@/ocamldoc.odoc -v test_stdlib: dummy $(MKDIR) $@ @@ -290,6 +310,13 @@ ../otherlibs/unix/unix.mli \ ../otherlibs/str/str.mli +test_stdlib_code: dummy + $(MKDIR) $@ + $(OCAMLDOC_RUN) -html -colorize-code -sort -d $@ $(INCLUDES) -dump $@/stdlib.odoc -keep-code \ + `ls ../stdlib/*.ml | grep -v Labels` \ + ../otherlibs/unix/unix.ml \ + ../otherlibs/str/str.ml + test_framed: dummy $(MKDIR) $@ $(OCAMLDOC_RUN) -g odoc_fhtml.cmo -sort -colorize-code -d $@ $(INCLUDES) odoc*.ml odoc*.mli @@ -334,11 +361,12 @@ clean:: dummy @rm -f *~ \#*\# - @rm -f $(OCAMLDOC) $(OCAMLDOC_OPT) *.cma *.cmxa *.cmo *.cmi *.cmx *.a *.o + @rm -f $(OCAMLDOC) $(OCAMLDOC_OPT) *.cma *.cmxa *.cmo *.cmi *.cmx *.$(A) *.$(O) @rm -f odoc_parser.output odoc_text_parser.output @rm -f odoc_lexer.ml odoc_text_lexer.ml odoc_see_lexer.ml odoc_ocamlhtml.ml @rm -f odoc_parser.ml odoc_parser.mli odoc_text_parser.ml odoc_text_parser.mli @rm -rf stdlib_man + @rm -f generators/*.cm[aiox] generators/*.$(A) generators/*.$(O) generators/*.cmx[as] depend:: $(OCAMLYACC) odoc_text_parser.mly diff -Nru ocaml-3.12.1/ocamldoc/Makefile.nt ocaml-4.01.0/ocamldoc/Makefile.nt --- ocaml-3.12.1/ocamldoc/Makefile.nt 2010-05-28 11:21:46.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/Makefile.nt 2012-10-15 17:50:56.000000000 +0000 @@ -1,5 +1,6 @@ #(***********************************************************************) -#(* OCamldoc *) +#(* *) +#(* OCamldoc *) #(* *) #(* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) #(* *) @@ -9,16 +10,16 @@ #(* *) #(***********************************************************************) -# $Id: Makefile.nt 10472 2010-05-28 11:21:46Z garrigue $ - include ../config/Makefile -CAMLRUN =../boot/ocamlrun +# Various commands and dir +########################## +CAMLRUN=../boot/ocamlrun OCAMLC = ../ocamlcomp.sh OCAMLOPT = ../ocamlcompopt.sh -OCAMLLEX =$(CAMLRUN) ../boot/ocamllex -OCAMLYACC=../boot/ocamlyacc - +OCAMLDEP = $(CAMLRUN) ../tools/ocamldep +OCAMLLEX = $(CAMLRUN) ../boot/ocamllex +OCAMLYACC= ../boot/ocamlyacc OCAMLLIB = $(LIBDIR) OCAMLBIN = $(BINDIR) @@ -62,12 +63,12 @@ INCLUDES=$(INCLUDES_DEP) $(INCLUDES_NODEP) -COMPFLAGS=$(INCLUDES) +COMPFLAGS=$(INCLUDES) -warn-error A LINKFLAGS=$(INCLUDES) -nostdlib CMOFILES= odoc_config.cmo \ - odoc_global.cmo\ odoc_messages.cmo\ + odoc_global.cmo\ odoc_types.cmo\ odoc_misc.cmo\ odoc_text_parser.cmo\ @@ -82,7 +83,6 @@ odoc_module.cmo\ odoc_print.cmo \ odoc_str.cmo\ - odoc_args.cmo\ odoc_comments_global.cmo\ odoc_parser.cmo\ odoc_lexer.cmo\ @@ -105,16 +105,18 @@ CMXFILES= $(CMOFILES:.cmo=.cmx) CMIFILES= $(CMOFILES:.cmo=.cmi) -EXECMOFILES=$(CMOFILES)\ - odoc_dag2html.cmo\ - odoc_to_text.cmo\ - odoc_ocamlhtml.cmo\ - odoc_html.cmo\ - odoc_man.cmo\ +EXECMOFILES=$(CMOFILES) \ + odoc_dag2html.cmo \ + odoc_to_text.cmo \ + odoc_ocamlhtml.cmo \ + odoc_html.cmo \ + odoc_man.cmo \ odoc_latex_style.cmo \ - odoc_latex.cmo\ - odoc_texi.cmo\ - odoc_dot.cmo\ + odoc_latex.cmo \ + odoc_texi.cmo \ + odoc_dot.cmo \ + odoc_gen.cmo \ + odoc_args.cmo \ odoc.cmo @@ -135,7 +137,6 @@ $(OCAMLSRCDIR)/utils/warnings.cmo \ $(OCAMLSRCDIR)/utils/ccomp.cmo \ $(OCAMLSRCDIR)/utils/consistbl.cmo \ - $(OCAMLSRCDIR)/parsing/linenum.cmo\ $(OCAMLSRCDIR)/parsing/location.cmo\ $(OCAMLSRCDIR)/parsing/longident.cmo \ $(OCAMLSRCDIR)/parsing/syntaxerr.cmo \ @@ -148,6 +149,7 @@ $(OCAMLSRCDIR)/typing/predef.cmo \ $(OCAMLSRCDIR)/typing/datarepr.cmo \ $(OCAMLSRCDIR)/typing/subst.cmo \ + $(OCAMLSRCDIR)/typing/cmi_format.cmo \ $(OCAMLSRCDIR)/typing/env.cmo \ $(OCAMLSRCDIR)/typing/ctype.cmo \ $(OCAMLSRCDIR)/typing/primitive.cmo \ @@ -155,9 +157,11 @@ $(OCAMLSRCDIR)/typing/printtyp.cmo \ $(OCAMLSRCDIR)/typing/includecore.cmo \ $(OCAMLSRCDIR)/typing/typetexp.cmo \ - $(OCAMLSRCDIR)/typing/parmatch.cmo \ $(OCAMLSRCDIR)/typing/typedtree.cmo \ + $(OCAMLSRCDIR)/typing/parmatch.cmo \ $(OCAMLSRCDIR)/typing/stypes.cmo \ + $(OCAMLSRCDIR)/typing/typedtreeMap.cmo \ + $(OCAMLSRCDIR)/typing/cmt_format.cmo \ $(OCAMLSRCDIR)/typing/typecore.cmo \ $(OCAMLSRCDIR)/typing/includeclass.cmo \ $(OCAMLSRCDIR)/typing/typedecl.cmo \ @@ -173,7 +177,8 @@ $(OCAMLSRCDIR)/bytecomp/translobj.cmo \ $(OCAMLSRCDIR)/bytecomp/translcore.cmo \ $(OCAMLSRCDIR)/bytecomp/translclass.cmo \ - $(OCAMLSRCDIR)/tools/depend.cmo + $(OCAMLSRCDIR)/tools/depend.cmo \ + $(OCAMLSRCDIR)/driver/pparse.cmo OCAMLCMXFILES=$(OCAMLCMOFILES:.cmo=.cmx) @@ -185,7 +190,7 @@ exeopt: $(OCAMLDOC_OPT) libopt: $(OCAMLDOC_LIBCMXA) $(OCAMLDOC_LIBCMI) debug: - make OCAMLPP="" + $(MAKE) OCAMLPP="" $(OCAMLDOC): $(EXECMOFILES) $(OCAMLC) -o $@ -linkall unix.cma str.cma dynlink.cma $(LINKFLAGS) $(OCAMLCMOFILES) $(EXECMOFILES) @@ -197,44 +202,55 @@ $(OCAMLDOC_LIBCMXA): $(LIBCMXFILES) $(OCAMLOPT) -a -o $@ $(LINKFLAGS) $(OCAMLCMXFILES) $(LIBCMXFILES) +# Parsers and lexers dependencies : +################################### +odoc_text_parser.ml: odoc_text_parser.mly +odoc_text_parser.mli: odoc_text_parser.mly + +odoc_parser.ml: odoc_parser.mly +odoc_parser.mli:odoc_parser.mly + +odoc_text_lexer.ml: odoc_text_lexer.mll + +odoc_lexer.ml:odoc_lexer.mll + +odoc_ocamlhtml.ml: odoc_ocamlhtml.mll + +odoc_see_lexer.ml: odoc_see_lexer.mll + + # generic rules : ################# -.SUFFIXES: .mli .ml .cmi .cmo .cmx +.SUFFIXES: .mll .mly .ml .mli .cmo .cmi .cmx .cmxs -.mli.cmi: +.ml.cmo: $(OCAMLC) $(OCAMLPP) $(COMPFLAGS) -c $< -.ml.cmo: +.mli.cmi: $(OCAMLC) $(OCAMLPP) $(COMPFLAGS) -c $< .ml.cmx: $(OCAMLOPT) $(OCAMLPP) $(COMPFLAGS) -c $< -odoc_text_parser.ml odoc_text_parser.mli: odoc_text_parser.mly - $(OCAMLYACC) odoc_text_parser.mly +.ml.cmxs: + $(OCAMLOPT) -shared -o $@ $(OCAMLPP) $(COMPFLAGS) $< -odoc_parser.ml odoc_parser.mli: odoc_parser.mly - $(OCAMLYACC) odoc_parser.mly +.mll.ml: + $(OCAMLLEX) $< -odoc_text_lexer.ml: odoc_text_lexer.mll - $(OCAMLLEX) odoc_text_lexer.mll +.mly.ml: + $(OCAMLYACC) -v $< -odoc_lexer.ml: odoc_lexer.mll - $(OCAMLLEX) odoc_lexer.mll - -odoc_ocamlhtml.ml: odoc_ocamlhtml.mll - $(OCAMLLEX) odoc_ocamlhtml.mll - -odoc_see_lexer.ml: odoc_see_lexer.mll - $(OCAMLLEX) odoc_see_lexer.mll +.mly.mli: + $(OCAMLYACC) -v $< # Installation targets ###################### install: dummy $(MKDIR) -p $(INSTALL_BINDIR) $(MKDIR) -p $(INSTALL_LIBDIR) - $(CP) $(OCAMLDOC) $(INSTALL_BINDIR)/$(OCAMLDOC).exe + $(CP) $(OCAMLDOC) $(INSTALL_BINDIR)/$(OCAMLDOC)$(EXE) $(CP) ocamldoc.hva *.cmi $(OCAMLDOC_LIBCMA) $(INSTALL_LIBDIR) $(CP) $(INSTALL_MLIS) $(INSTALL_CMIS) $(INSTALL_LIBDIR) @@ -244,7 +260,7 @@ installopt_really: $(MKDIR) -p $(INSTALL_BINDIR) $(MKDIR) -p $(INSTALL_LIBDIR) - $(CP) $(OCAMLDOC_OPT) $(INSTALL_BINDIR)/$(OCAMLDOC_OPT).exe + $(CP) $(OCAMLDOC_OPT) $(INSTALL_BINDIR)/$(OCAMLDOC_OPT)$(EXE) $(CP) ocamldoc.hva $(OCAMLDOC_LIBA) $(OCAMLDOC_LIBCMXA) $(INSTALL_LIBDIR) $(CP) $(INSTALL_MLIS) $(INSTALL_CMIS) $(INSTALL_LIBDIR) @@ -258,13 +274,16 @@ @rm -f odoc_parser.output odoc_text_parser.output @rm -f odoc_lexer.ml odoc_text_lexer.ml odoc_see_lexer.ml odoc_ocamlhtml.ml @rm -f odoc_parser.ml odoc_parser.mli odoc_text_parser.ml odoc_text_parser.mli + @rm -rf stdlib_man + @rm -f generators/*.cm[aiox] generators/*.$(A) generators/*.$(O) generators/*.cmx[as] depend:: - rm -f .depend $(OCAMLYACC) odoc_text_parser.mly $(OCAMLYACC) odoc_parser.mly $(OCAMLLEX) odoc_text_lexer.mll $(OCAMLLEX) odoc_lexer.mll + $(OCAMLLEX) odoc_ocamlhtml.mll + $(OCAMLLEX) odoc_see_lexer.mll $(OCAMLDEP) $(INCLUDES_DEP) *.mll *.mly *.ml *.mli > .depend dummy: diff -Nru ocaml-3.12.1/ocamldoc/generators/odoc_literate.ml ocaml-4.01.0/ocamldoc/generators/odoc_literate.ml --- ocaml-3.12.1/ocamldoc/generators/odoc_literate.ml 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/generators/odoc_literate.ml 2012-10-15 17:50:56.000000000 +0000 @@ -0,0 +1,206 @@ +(***********************************************************************) +(* *) +(* OCamldoc *) +(* *) +(* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2001 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +open Odoc_info +module Naming = Odoc_html.Naming +open Odoc_info.Value +open Odoc_info.Module + +let p = Printf.bprintf +let bp = Printf.bprintf +let bs = Buffer.add_string + +module Html = + (val + ( + match !Odoc_args.current_generator with + None -> (module Odoc_html.Generator : Odoc_html.Html_generator) + | Some (Odoc_gen.Html m) -> m + | _ -> + failwith + "A non-html generator is already set. Cannot install the Todo-list html generator" + ) : Odoc_html.Html_generator) +;; + +module Generator = +struct +class html = + object (self) + inherit Html.html as html + + method private html_of_module_comment b text = + let br1, br2 = + match text with + [(Odoc_info.Title (n, l_opt, t))] -> false, false + | (Odoc_info.Title (n, l_opt, t)) :: _ -> false, true + | _ -> true, true + in + if br1 then p b "
"; + self#html_of_text b text; + if br2 then p b "

\n" + + method private html_of_Title b n l_opt t = + let label1 = self#create_title_label (n, l_opt, t) in + p b "\n" (Naming.label_target label1); + p b "" n; + self#html_of_text b t; + p b "" n + + val mutable code_id = 0 + method private code_block b code = + code_id <- code_id + 1; + Printf.bprintf b + "\"+/-\"/" code_id code_id code_id; + Printf.bprintf b "
" code_id; + self#html_of_code b code; + Printf.bprintf b "
" + + (** Print html code for a value. *) + method private html_of_value b v = + Odoc_info.reset_type_names (); + self#html_of_info b v.val_info; + bs b "
";
+      bs b (self#keyword "val");
+      bs b " ";
+      (* html mark *)
+      bp b "" (Naming.value_target v);
+      bs b (self#escape (Name.simple v.val_name));
+      bs b " : ";
+      self#html_of_type_expr b (Name.father v.val_name) v.val_type;
+      bs b "
"; + ( + if !Odoc_html.with_parameter_list then + self#html_of_parameter_list b (Name.father v.val_name) v.val_parameters + else + self#html_of_described_parameter_list b (Name.father v.val_name) v.val_parameters + ); + ( + match v.val_code with + None -> () + | Some code -> + self#code_block b code + ) +(* + (** Print html code for a module. *) + method private html_of_module b ?(info=true) ?(complete=true) ?(with_link=true) m = + let (html_file, _) = Naming.html_files m.m_name in + let father = Name.father m.m_name in + bs b "
";
+      bs b ((self#keyword "module")^" ");
+      (
+       if with_link then
+         bp b "%s" html_file (Name.simple m.m_name)
+       else
+         bs b (Name.simple m.m_name)
+      );
+(*      A remettre quand on compilera avec ocaml 3.10
+         (
+       match m.m_kind with
+         Module_functor _ when !Odoc_info.Args.html_short_functors  ->
+           ()
+
+       | _ -> *) bs b ": ";
+      (*
+      );
+      *)
+      self#html_of_module_kind b father ~modu: m m.m_kind;
+      bs b "
"; + if info && complete then + self#html_of_info ~indent: false b m.m_info + +*) + initializer + default_style_options <- + ["a:visited {color : #416DFF; text-decoration : none; }" ; + "a:link {color : #416DFF; text-decoration : none;}" ; + "a:hover {color : Red; text-decoration : none; background-color: #5FFF88}" ; + "a:active {color : Red; text-decoration : underline; }" ; + ".keyword { font-weight : bold ; color : Red }" ; + ".keywordsign { color : #C04600 }" ; + ".superscript { font-size : 4 }" ; + ".subscript { font-size : 4 }" ; + ".comment { color : Green }" ; + ".constructor { color : Blue }" ; + ".type { color : #5C6585 }" ; + ".string { color : Maroon }" ; + ".warning { color : Red ; font-weight : bold }" ; + ".info { margin-top: 8px; }"; + ".param_info { margin-top: 4px; margin-left : 3em; margin-right : 3em }" ; + ".code { color : #465F91 ; }" ; + "h1 { font-size : 20pt ; text-align: center; }" ; + + "h2 { font-size : 20pt ; border: 1px solid #000000; "^ + "margin-top: 5px; margin-bottom: 2px;"^ + "text-align: center; background-color: #90BDFF ;"^ + "padding: 2px; }" ; + + "h3 { font-size : 20pt ; border: 1px solid #000000; "^ + "margin-top: 5px; margin-bottom: 2px;"^ + "text-align: center; background-color: #90DDFF ;"^ + "padding: 2px; }" ; + + "h4 { font-size : 20pt ; border: 1px solid #000000; "^ + "margin-top: 5px; margin-bottom: 2px;"^ + "text-align: center; background-color: #90EDFF ;"^ + "padding: 2px; }" ; + + "h5 { font-size : 20pt ; border: 1px solid #000000; "^ + "margin-top: 5px; margin-bottom: 2px;"^ + "text-align: center; background-color: #90FDFF ;"^ + "padding: 2px; }" ; + + "h6 { font-size : 20pt ; border: 1px solid #000000; "^ + "margin-top: 5px; margin-bottom: 2px;"^ + "text-align: center; background-color: #C0FFFF ; "^ + "padding: 2px; }" ; + + "div.h7 { font-size : 20pt ; border: 1px solid #000000; "^ + "margin-top: 5px; margin-bottom: 2px;"^ + "text-align: center; background-color: #E0FFFF ; "^ + "padding: 2px; }" ; + + "div.h8 { font-size : 20pt ; border: 1px solid #000000; "^ + "margin-top: 5px; margin-bottom: 2px;"^ + "text-align: center; background-color: #F0FFFF ; "^ + "padding: 2px; }" ; + + "div.h9 { font-size : 20pt ; border: 1px solid #000000; "^ + "margin-top: 5px; margin-bottom: 2px;"^ + "text-align: center; background-color: #FFFFFF ; "^ + "padding: 2px; }" ; + + ".typetable { border-style : hidden }" ; + ".indextable { border-style : hidden }" ; + ".paramstable { border-style : hidden ; padding: 5pt 5pt}" ; + "body { background-color : White }" ; + "tr { background-color : White }" ; + "td.typefieldcomment { background-color : #FFFFFF ; font-size: smaller ;}" ; + "pre { margin-bottom: 4px ; margin-left: 1em; "^ + "border-color: #27408b; border-style: solid; "^ + "border-width: 1px 1px 1px 3px; "^ + "padding: 4px; }" ; + "div.sig_block {margin-left: 2em}" ; + + "div.codeblock { "^ + "margin-left: 2em; margin-right: 1em; padding: 6px; "^ + "margin-bottom: 8px; display: none; "^ + "border-width: 1px 1px 1px 3px; border-style: solid; border-color: grey; }" ; + + "span.code_expand { color: blue; text-decoration: underline; cursor: pointer; "^ + "margin-left: 1em ; } "; + ]; + end +end + +let _ = Odoc_args.set_generator + (Odoc_gen.Html (module Generator : Odoc_html.Html_generator)) + ;; diff -Nru ocaml-3.12.1/ocamldoc/generators/odoc_todo.ml ocaml-4.01.0/ocamldoc/generators/odoc_todo.ml --- ocaml-3.12.1/ocamldoc/generators/odoc_todo.ml 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/generators/odoc_todo.ml 2012-10-15 17:50:56.000000000 +0000 @@ -0,0 +1,224 @@ +(***********************************************************************) +(* *) +(* OCamldoc *) +(* *) +(* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2010 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +(** An OCamldoc generator to retrieve information in "todo" tags and + generate an html page with all todo items. *) + +open Odoc_info +module Naming = Odoc_html.Naming +open Odoc_info.Value +open Odoc_info.Module +open Odoc_info.Type +open Odoc_info.Exception +open Odoc_info.Class + +let p = Printf.bprintf + +module Html = + (val + ( + match !Odoc_args.current_generator with + None -> (module Odoc_html.Generator : Odoc_html.Html_generator) + | Some (Odoc_gen.Html m) -> m + | _ -> + failwith + "A non-html generator is already set. Cannot install the Todo-list html generator" + ) : Odoc_html.Html_generator) +;; + +module Generator = +struct + class scanner html = + object (self) + inherit Odoc_info.Scan.scanner + + val b = Buffer.create 256 + method buffer = b + + method private gen_if_tag name target info_opt = + match info_opt with + None -> () + | Some i -> + let l = + List.fold_left + (fun acc (t, text) -> + match t with + "todo" -> + begin + match text with + (Odoc_info.Code s) :: q -> + ( + try + let n = int_of_string s in + let head = + Odoc_info.Code (Printf.sprintf "[%d] " n) + in + (Some n, head::q) :: acc + with _ -> (None, text) :: acc + ) + | _ -> (None, text) :: acc + + end + | _ -> acc + ) + [] + i.i_custom + in + match l with + [] -> () + | _ -> + let l = List.sort + (fun a b -> + match a, b with + (None, _), _ -> -1 + | _, (None, _) -> 1 + | (Some n1, _), (Some n2, _) -> compare n1 n2 + ) + l + in + p b "
%s
" + target name; + let col = function + None -> "#000000" + | Some 1 -> "#FF0000" + | Some 2 -> "#AA5555" + | Some 3 -> "#44BB00" + | Some n -> Printf.sprintf "#%2x0000" (0xAA - (n * 0x10)) + in + List.iter + (fun (n, e) -> + Printf.bprintf b "" (col n); + html#html_of_text b e; + p b "
\n"; + ) + l; + p b "
" + + method scan_value v = + self#gen_if_tag + v.val_name + (Odoc_html.Naming.complete_value_target v) + v.val_info + + method scan_type t = + self#gen_if_tag + t.ty_name + (Odoc_html.Naming.complete_type_target t) + t.ty_info + + method scan_exception e = + self#gen_if_tag + e.ex_name + (Odoc_html.Naming.complete_exception_target e) + e.ex_info + + method scan_attribute a = + self#gen_if_tag + a.att_value.val_name + (Odoc_html.Naming.complete_attribute_target a) + a.att_value.val_info + + method scan_method m = + self#gen_if_tag + m.met_value.val_name + (Odoc_html.Naming.complete_method_target m) + m.met_value.val_info + + (** This method scan the elements of the given module. *) + method scan_module_elements m = + List.iter + (fun ele -> + match ele with + Odoc_module.Element_module m -> self#scan_module m + | Odoc_module.Element_module_type mt -> self#scan_module_type mt + | Odoc_module.Element_included_module im -> self#scan_included_module im + | Odoc_module.Element_class c -> self#scan_class c + | Odoc_module.Element_class_type ct -> self#scan_class_type ct + | Odoc_module.Element_value v -> self#scan_value v + | Odoc_module.Element_exception e -> self#scan_exception e + | Odoc_module.Element_type t -> self#scan_type t + | Odoc_module.Element_module_comment t -> self#scan_module_comment t + ) + (Odoc_module.module_elements ~trans: false m) + + method scan_included_module _ = () + + method scan_class_pre c = + self#gen_if_tag + c.cl_name + (fst (Odoc_html.Naming.html_files c.cl_name)) + c.cl_info; + true + + method scan_class_type_pre ct = + self#gen_if_tag + ct.clt_name + (fst (Odoc_html.Naming.html_files ct.clt_name)) + ct.clt_info; + true + + method scan_module_pre m = + self#gen_if_tag + m.m_name + (fst (Odoc_html.Naming.html_files m.m_name)) + m.m_info; + true + + method scan_module_type_pre mt = + self#gen_if_tag + mt.mt_name + (fst (Odoc_html.Naming.html_files mt.mt_name)) + mt.mt_info; + true + end + + class html : Html.html = + object (self) + inherit Html.html as html + + (** we have to hack a little because we cannot inherit from + scanner, since public method cannot be hidden and + our html class must respect the type of the default + html generator class *) + val mutable scanner = new scanner (new Html.html ) + + method generate modules = + (* prevent having the 'todo' tag signaled as not handled *) + tag_functions <- ("todo", (fun _ -> "")) :: tag_functions; + (* generate doc as usual *) + html#generate modules; + (* then retrieve the todo tags and generate the todo.html page *) + let title = + match !Odoc_info.Global.title with + None -> "" + | Some s -> s + in + let b = Buffer.create 512 in + p b ""; + self#print_header b title ; + p b "

%s

" title; + scanner#scan_module_list modules; + Buffer.add_buffer b scanner#buffer; + let oc = open_out + (Filename.concat !Odoc_info.Global.target_dir "todo.html") + in + Buffer.output_buffer oc b; + close_out oc + + initializer + scanner <- new scanner self + end +end + +let _ = Odoc_args.set_generator + (Odoc_gen.Html (module Generator : Odoc_html.Html_generator)) + ;; diff -Nru ocaml-3.12.1/ocamldoc/ocamldoc.hva ocaml-4.01.0/ocamldoc/ocamldoc.hva --- ocaml-3.12.1/ocamldoc/ocamldoc.hva 2004-07-13 12:25:21.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/ocamldoc.hva 2012-08-01 12:09:31.000000000 +0000 @@ -1,3 +1,15 @@ +%(***********************************************************************) +%(* *) +%(* OCamldoc *) +%(* *) +%(* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) +%(* *) +%(* Copyright 2001 Institut National de Recherche en Informatique et *) +%(* en Automatique. All rights reserved. This file is distributed *) +%(* under the terms of the Q Public License version 1.0. *) +%(* *) +%(***********************************************************************) + \usepackage{alltt} \newenvironment{ocamldoccode}{\begin{alltt}}{\end{alltt}} \newenvironment{ocamldocdescription}{\begin{quote}}{\end{quote}} diff -Nru ocaml-3.12.1/ocamldoc/odoc.ml ocaml-4.01.0/ocamldoc/odoc.ml --- ocaml-3.12.1/ocamldoc/odoc.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc.ml 2013-05-28 11:04:11.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,9 +10,8 @@ (* *) (***********************************************************************) -(* $Id: odoc.ml 9547 2010-01-22 12:48:24Z doligez $ *) - -(** Main module for bytecode. *) +(** Main module for bytecode. +@todo coucou le todo*) open Config open Clflags @@ -25,21 +25,20 @@ (* we check if we must load a module given on the command line *) let arg_list = Array.to_list Sys.argv -let (cm_opt, paths) = - let rec iter (f_opt, inc) = function - [] | _ :: [] -> (f_opt, inc) +let (plugins, paths) = + let rec iter (files, incs) = function + [] | _ :: [] -> (List.rev files, List.rev incs) | "-g" :: file :: q when - ((Filename.check_suffix file "cmo") or - (Filename.check_suffix file "cma") or - (Filename.check_suffix file "cmxs")) & - (f_opt = None) -> - iter (Some file, inc) q + ((Filename.check_suffix file "cmo") || + (Filename.check_suffix file "cma") || + (Filename.check_suffix file "cmxs")) -> + iter (file :: files, incs) q | "-i" :: dir :: q -> - iter (f_opt, inc @ [dir]) q + iter (files, dir :: incs) q | _ :: q -> - iter (f_opt, inc) q + iter (files, incs) q in - iter (None, []) arg_list + iter ([], []) arg_list let _ = print_DEBUG "Fin analyse des arguments pour le dynamic load" @@ -63,41 +62,29 @@ failwith (M.file_not_found_in_paths paths name) ) -let _ = - match cm_opt with - None -> - () - | Some file -> - let file = Dynlink.adapt_filename file in - Dynlink.allow_unsafe_modules true; - try - let real_file = get_real_filename file in - ignore(Dynlink.loadfile real_file) - with - Dynlink.Error e -> - prerr_endline (Odoc_messages.load_file_error file (Dynlink.error_message e)) ; - exit 1 - | Not_found -> - prerr_endline (Odoc_messages.load_file_error file "Not_found"); - exit 1 - | Sys_error s - | Failure s -> - prerr_endline (Odoc_messages.load_file_error file s); - exit 1 - -let _ = print_DEBUG "Fin du chargement dynamique eventuel" - -let default_html_generator = new Odoc_html.html -let default_latex_generator = new Odoc_latex.latex -let default_texi_generator = new Odoc_texi.texi -let default_man_generator = new Odoc_man.man -let default_dot_generator = new Odoc_dot.dot -let _ = Odoc_args.parse - (default_html_generator :> Odoc_args.doc_generator) - (default_latex_generator :> Odoc_args.doc_generator) - (default_texi_generator :> Odoc_args.doc_generator) - (default_man_generator :> Odoc_args.doc_generator) - (default_dot_generator :> Odoc_args.doc_generator) +let load_plugin file = + let file = Dynlink.adapt_filename file in + Dynlink.allow_unsafe_modules true; + try + let real_file = get_real_filename file in + ignore(Dynlink.loadfile real_file) + with + Dynlink.Error e -> + prerr_endline (Odoc_messages.load_file_error file (Dynlink.error_message e)) ; + exit 1 + | Not_found -> + prerr_endline (Odoc_messages.load_file_error file "Not_found"); + exit 1 + | Sys_error s + | Failure s -> + prerr_endline (Odoc_messages.load_file_error file s); + exit 1 +;; +List.iter load_plugin plugins;; + +let () = print_DEBUG "Fin du chargement dynamique eventuel" + +let () = Odoc_args.parse () let loaded_modules = @@ -114,13 +101,13 @@ incr Odoc_global.errors ; [] ) - !Odoc_args.load + !Odoc_global.load ) -let modules = Odoc_analyse.analyse_files ~init: loaded_modules !Odoc_args.files +let modules = Odoc_analyse.analyse_files ~init: loaded_modules !Odoc_global.files let _ = - match !Odoc_args.dump with + match !Odoc_global.dump with None -> () | Some f -> try Odoc_analyse.dump_modules f modules @@ -128,13 +115,15 @@ prerr_endline s ; incr Odoc_global.errors + let _ = - match !Odoc_args.doc_generator with + match !Odoc_args.current_generator with None -> () | Some gen -> + let generator = Odoc_gen.get_minimal_generator gen in Odoc_info.verbose Odoc_messages.generating_doc; - gen#generate modules; + generator#generate modules; Odoc_info.verbose Odoc_messages.ok let _ = diff -Nru ocaml-3.12.1/ocamldoc/odoc_analyse.ml ocaml-4.01.0/ocamldoc/odoc_analyse.ml --- ocaml-3.12.1/ocamldoc/odoc_analyse.ml 2010-05-03 15:06:17.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_analyse.ml 2013-08-20 15:32:13.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_analyse.ml 10355 2010-05-03 15:06:17Z guesdon $ *) - (** Analysis of source files. This module is strongly inspired from driver/main.ml :-) *) @@ -43,63 +42,12 @@ (** Optionally preprocess a source file *) let preprocess sourcefile = - match !Clflags.preprocessor with - None -> sourcefile - | Some pp -> - let tmpfile = Filename.temp_file "camlpp" "" in - let comm = Printf.sprintf "%s %s > %s" pp sourcefile tmpfile in - if Ccomp.command comm <> 0 then begin - remove_file tmpfile; - Printf.eprintf "Preprocessing error\n"; - exit 2 - end; - tmpfile - -(** Remove the input file if this file was the result of a preprocessing.*) -let remove_preprocessed inputfile = - match !Clflags.preprocessor with - None -> () - | Some _ -> remove_file inputfile - -let remove_preprocessed_if_ast inputfile = - match !Clflags.preprocessor with - None -> () - | Some _ -> if inputfile <> !Location.input_name then remove_file inputfile - -exception Outdated_version - -(** Parse a file or get a dumped syntax tree in it *) -let parse_file inputfile parse_fun ast_magic = - let ic = open_in_bin inputfile in - let is_ast_file = - try - let buffer = String.create (String.length ast_magic) in - really_input ic buffer 0 (String.length ast_magic); - if buffer = ast_magic then true - else if String.sub buffer 0 9 = String.sub ast_magic 0 9 then - raise Outdated_version - else false - with - Outdated_version -> - fatal_error "Ocaml and preprocessor have incompatible versions" - | _ -> false - in - let ast = - try - if is_ast_file then begin - Location.input_name := input_value ic; - input_value ic - end else begin - seek_in ic 0; - Location.input_name := inputfile; - let lexbuf = Lexing.from_channel ic in - Location.init lexbuf inputfile; - parse_fun lexbuf - end - with x -> close_in ic; raise x - in - close_in ic; - ast + try + Pparse.preprocess sourcefile + with Pparse.Error err -> + Format.eprintf "Preprocessing error@.%a@." + Pparse.report_error err; + exit 2 let (++) x f = f x @@ -113,8 +61,11 @@ let inputfile = preprocess sourcefile in let env = initial_env () in try - let parsetree = parse_file inputfile Parse.implementation ast_impl_magic_number in - let typedtree = Typemod.type_implementation sourcefile prefixname modulename env parsetree in + let parsetree = Pparse.file Format.err_formatter inputfile Parse.implementation ast_impl_magic_number in + let typedtree = + Typemod.type_implementation + sourcefile prefixname modulename env parsetree + in (Some (parsetree, typedtree), inputfile) with e -> @@ -138,7 +89,7 @@ let modulename = String.capitalize(Filename.basename prefixname) in Env.set_unit_name modulename; let inputfile = preprocess sourcefile in - let ast = parse_file inputfile Parse.interface ast_intf_magic_number in + let ast = Pparse.file Format.err_formatter inputfile Parse.interface ast_intf_magic_number in let sg = Typemod.transl_signature (initial_env()) ast in Warnings.check_fatal (); (ast, sg, inputfile) @@ -165,34 +116,37 @@ | Env.Error err -> Location.print_error_cur_file ppf; Env.report_error ppf err + | Cmi_format.Error err -> + Location.print_error_cur_file ppf; + Cmi_format.report_error ppf err | Ctype.Tags(l, l') -> Location.print_error_cur_file ppf; fprintf ppf "In this program,@ variant constructors@ `%s and `%s@ \ have the same hash value." l l' - | Typecore.Error(loc, err) -> - Location.print_error ppf loc; Typecore.report_error ppf err - | Typetexp.Error(loc, err) -> - Location.print_error ppf loc; Typetexp.report_error ppf err + | Typecore.Error(loc, env, err) -> + Location.print_error ppf loc; Typecore.report_error env ppf err + | Typetexp.Error(loc, env, err) -> + Location.print_error ppf loc; Typetexp.report_error env ppf err | Typedecl.Error(loc, err) -> Location.print_error ppf loc; Typedecl.report_error ppf err | Includemod.Error err -> Location.print_error_cur_file ppf; Includemod.report_error ppf err - | Typemod.Error(loc, err) -> - Location.print_error ppf loc; Typemod.report_error ppf err + | Typemod.Error(loc, env, err) -> + Location.print_error ppf loc; Typemod.report_error env ppf err | Translcore.Error(loc, err) -> Location.print_error ppf loc; Translcore.report_error ppf err | Sys_error msg -> Location.print_error_cur_file ppf; fprintf ppf "I/O error: %s" msg - | Typeclass.Error(loc, err) -> - Location.print_error ppf loc; Typeclass.report_error ppf err + | Typeclass.Error(loc, env, err) -> + Location.print_error ppf loc; Typeclass.report_error env ppf err | Translclass.Error(loc, err) -> Location.print_error ppf loc; Translclass.report_error ppf err | Warnings.Errors (n) -> Location.print_error_cur_file ppf; - fprintf ppf "Error-enabled warnings (%d occurrences)" n + fprintf ppf "Some fatal warnings were triggered (%d occurrences)" n | x -> fprintf ppf "@]"; fprintf ppf @@ -203,18 +157,18 @@ (** Process the given file, according to its extension. Return the Module.t created, if any.*) let process_file ppf sourcefile = - if !Odoc_args.verbose then + if !Odoc_global.verbose then ( let f = match sourcefile with - Odoc_args.Impl_file f - | Odoc_args.Intf_file f -> f - | Odoc_args.Text_file f -> f + Odoc_global.Impl_file f + | Odoc_global.Intf_file f -> f + | Odoc_global.Text_file f -> f in print_string (Odoc_messages.analysing f) ; print_newline (); ); match sourcefile with - Odoc_args.Impl_file file -> + Odoc_global.Impl_file file -> ( Location.input_name := file; try @@ -228,12 +182,12 @@ in file_module.Odoc_module.m_top_deps <- Odoc_dep.impl_dependencies parsetree ; - if !Odoc_args.verbose then + if !Odoc_global.verbose then ( print_string Odoc_messages.ok; print_newline () ); - remove_preprocessed input_file; + Pparse.remove_preprocessed input_file; Some file_module with | Sys_error s @@ -246,23 +200,23 @@ incr Odoc_global.errors ; None ) - | Odoc_args.Intf_file file -> + | Odoc_global.Intf_file file -> ( Location.input_name := file; try let (ast, signat, input_file) = process_interface_file ppf file in let file_module = Sig_analyser.analyse_signature file - !Location.input_name ast signat + !Location.input_name ast signat.sig_type in file_module.Odoc_module.m_top_deps <- Odoc_dep.intf_dependencies ast ; - if !Odoc_args.verbose then + if !Odoc_global.verbose then ( print_string Odoc_messages.ok; print_newline () ); - remove_preprocessed input_file; + Pparse.remove_preprocessed input_file; Some file_module with | Sys_error s @@ -275,11 +229,15 @@ incr Odoc_global.errors ; None ) - | Odoc_args.Text_file file -> + | Odoc_global.Text_file file -> Location.input_name := file; try let mod_name = - String.capitalize (Filename.basename (Filename.chop_extension file)) + let s = + try Filename.chop_extension file + with _ -> file + in + String.capitalize (Filename.basename s) in let txt = try Odoc_text.Texter.text_of_string (Odoc_misc.input_file_as_string file) @@ -289,7 +247,7 @@ let m = { Odoc_module.m_name = mod_name ; - Odoc_module.m_type = Types.Tmty_signature [] ; + Odoc_module.m_type = Types.Mty_signature [] ; Odoc_module.m_info = None ; Odoc_module.m_is_interface = true ; Odoc_module.m_file = file ; @@ -297,7 +255,7 @@ [Odoc_module.Element_module_comment txt] ; Odoc_module.m_loc = { Odoc_types.loc_impl = None ; - Odoc_types.loc_inter = Some (file, 0) } ; + Odoc_types.loc_inter = Some (Location.in_file file) } ; Odoc_module.m_top_deps = [] ; Odoc_module.m_code = None ; Odoc_module.m_code_intf = None ; @@ -474,20 +432,20 @@ in (* Remove elements between the stop special comments, if needed. *) let modules = - if !Odoc_args.no_stop then + if !Odoc_global.no_stop then modules_pre else remove_elements_between_stop modules_pre in - if !Odoc_args.verbose then + if !Odoc_global.verbose then ( print_string Odoc_messages.merging; print_newline () ); - let merged_modules = Odoc_merge.merge !Odoc_args.merge_options modules in - if !Odoc_args.verbose then + let merged_modules = Odoc_merge.merge !Odoc_global.merge_options modules in + if !Odoc_global.verbose then ( print_string Odoc_messages.ok; print_newline (); @@ -499,20 +457,20 @@ merged_modules ) in - if !Odoc_args.verbose then + if !Odoc_global.verbose then ( print_string Odoc_messages.cross_referencing; print_newline () ); let _ = Odoc_cross.associate modules_list in - if !Odoc_args.verbose then + if !Odoc_global.verbose then ( print_string Odoc_messages.ok; print_newline (); ); - if !Odoc_args.sort_modules then + if !Odoc_global.sort_modules then Sort.list (fun m1 -> fun m2 -> m1.Odoc_module.m_name < m2.Odoc_module.m_name) merged_modules else merged_modules diff -Nru ocaml-3.12.1/ocamldoc/odoc_analyse.mli ocaml-4.01.0/ocamldoc/odoc_analyse.mli --- ocaml-3.12.1/ocamldoc/odoc_analyse.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_analyse.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_analyse.mli 9547 2010-01-22 12:48:24Z doligez $ *) - (** Analysis of source files. *) (** This function builds the top modules from the analysis of the @@ -19,7 +18,7 @@ *) val analyse_files : ?init: Odoc_module.t_module list -> - Odoc_args.source_file list -> + Odoc_global.source_file list -> Odoc_module.t_module list (** Dump of a list of modules into a file. diff -Nru ocaml-3.12.1/ocamldoc/odoc_args.ml ocaml-4.01.0/ocamldoc/odoc_args.ml --- ocaml-3.12.1/ocamldoc/odoc_args.ml 2011-05-09 07:29:55.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_args.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,44 +10,101 @@ (* *) (***********************************************************************) -(* cvsid $Id: odoc_args.ml 11029 2011-05-09 07:29:55Z xclerc $ *) - (** Command-line arguments. *) -open Clflags - module M = Odoc_messages -type source_file = - Impl_file of string - | Intf_file of string - | Text_file of string - -let include_dirs = Clflags.include_dirs - -class type doc_generator = - object - method generate : Odoc_module.t_module list -> unit - end - -let doc_generator = ref (None : doc_generator option) - -let merge_options = ref ([] : Odoc_types.merge_option list) - -let out_file = ref M.default_out_file - -let dot_include_all = ref false - -let dot_types = ref false - -let dot_reduce = ref false - -let dot_colors = ref (List.flatten M.default_dot_colors) - -let man_suffix = ref M.default_man_suffix -let man_section = ref M.default_man_section +let current_generator = ref (None : Odoc_gen.generator option) -let man_mini = ref false +let get_html_generator () = + match !current_generator with + None -> (module Odoc_html.Generator : Odoc_html.Html_generator) + | Some (Odoc_gen.Html m) -> m + | Some _ -> failwith (M.current_generator_is_not "html") +;; + +let get_latex_generator () = + match !current_generator with + None -> (module Odoc_latex.Generator : Odoc_latex.Latex_generator) + | Some (Odoc_gen.Latex m) -> m + | Some _ -> failwith (M.current_generator_is_not "latex") +;; + +let get_texi_generator () = + match !current_generator with + None -> (module Odoc_texi.Generator : Odoc_texi.Texi_generator) + | Some (Odoc_gen.Texi m) -> m + | Some _ -> failwith (M.current_generator_is_not "texi") +;; + +let get_man_generator () = + match !current_generator with + None -> (module Odoc_man.Generator : Odoc_man.Man_generator) + | Some (Odoc_gen.Man m) -> m + | Some _ -> failwith (M.current_generator_is_not "man") +;; + +let get_dot_generator () = + match !current_generator with + None -> (module Odoc_dot.Generator : Odoc_dot.Dot_generator) + | Some (Odoc_gen.Dot m) -> m + | Some _ -> failwith (M.current_generator_is_not "dot") +;; + +let get_base_generator () = + match !current_generator with + None -> (module Odoc_gen.Base_generator : Odoc_gen.Base) + | Some (Odoc_gen.Base m) -> m + | Some _ -> failwith (M.current_generator_is_not "base") +;; + +let extend_html_generator f = + let current = get_html_generator () in + let module Current = (val current : Odoc_html.Html_generator) in + let module F = (val f : Odoc_gen.Html_functor) in + let module M = F(Current) in + current_generator := Some (Odoc_gen.Html (module M : Odoc_html.Html_generator)) +;; + +let extend_latex_generator f = + let current = get_latex_generator () in + let module Current = (val current : Odoc_latex.Latex_generator) in + let module F = (val f : Odoc_gen.Latex_functor) in + let module M = F(Current) in + current_generator := Some(Odoc_gen.Latex (module M : Odoc_latex.Latex_generator)) +;; + +let extend_texi_generator f = + let current = get_texi_generator () in + let module Current = (val current : Odoc_texi.Texi_generator) in + let module F = (val f : Odoc_gen.Texi_functor) in + let module M = F(Current) in + current_generator := Some(Odoc_gen.Texi (module M : Odoc_texi.Texi_generator)) +;; + +let extend_man_generator f = + let current = get_man_generator () in + let module Current = (val current : Odoc_man.Man_generator) in + let module F = (val f : Odoc_gen.Man_functor) in + let module M = F(Current) in + current_generator := Some(Odoc_gen.Man (module M : Odoc_man.Man_generator)) +;; + +let extend_dot_generator f = + let current = get_dot_generator () in + let module Current = (val current : Odoc_dot.Dot_generator) in + let module F = (val f : Odoc_gen.Dot_functor) in + let module M = F(Current) in + current_generator := Some (Odoc_gen.Dot (module M : Odoc_dot.Dot_generator)) +;; + +let extend_base_generator f = + let current = get_base_generator () in + let module Current = (val current : Odoc_gen.Base) in + let module F = (val f : Odoc_gen.Base_functor) in + let module M = F(Current) in + current_generator := Some (Odoc_gen.Base (module M : Odoc_gen.Base)) +;; (** Analysis of a string defining options. Return the list of options according to the list giving associations between @@ -81,79 +139,6 @@ in analyse_option_string l s -let classic = Clflags.classic - -let dump = ref (None : string option) - -let load = ref ([] : string list) - -(** Allow arbitrary recursive types. *) -let recursive_types = Clflags.recursive_types - -let verbose = ref false - -(** Optional preprocessor command. *) -let preprocessor = Clflags.preprocessor - -let sort_modules = ref false - -let no_custom_tags = ref false - -let no_stop = ref false - -let remove_stars = ref false - -let keep_code = ref false - -let inverse_merge_ml_mli = ref false - -let filter_with_module_constraints = ref true - -let title = ref (None : string option) - -let intro_file = ref (None : string option) - -let with_parameter_list = ref false - -let hidden_modules = ref ([] : string list) - -let target_dir = ref Filename.current_dir_name - -let css_style = ref None - -let index_only = ref false - -let colorize_code = ref false - -let html_short_functors = ref false - -let charset = ref "iso-8859-1" - -let with_header = ref true - -let with_trailer = ref true - -let separate_files = ref false - -let latex_titles = ref [ - 1, "section" ; - 2, "subsection" ; - 3, "subsubsection" ; - 4, "paragraph" ; - 5, "subparagraph" ; -] - -let with_toc = ref true - -let with_index = ref true - -let esc_8bits = ref false - -let info_section = ref "Objective Caml" - -let info_entry = ref [] - -let files = ref [] let f_latex_title s = try @@ -161,8 +146,8 @@ let n = int_of_string (String.sub s 0 pos) in let len = String.length s in let command = String.sub s (pos + 1) (len - pos - 1) in - latex_titles := List.remove_assoc n !latex_titles ; - latex_titles := (n, command) :: !latex_titles + Odoc_latex.latex_titles := List.remove_assoc n !Odoc_latex.latex_titles ; + Odoc_latex.latex_titles := (n, command) :: !Odoc_latex.latex_titles with Not_found | Invalid_argument _ -> @@ -178,83 +163,78 @@ "" -> () | _ -> match name.[0] with - 'A'..'Z' -> hidden_modules := name :: !hidden_modules + 'A'..'Z' -> Odoc_global.hidden_modules := name :: !Odoc_global.hidden_modules | _ -> incr Odoc_global.errors; prerr_endline (M.not_a_module_name name) ) l -let latex_value_prefix = ref M.default_latex_value_prefix -let latex_type_prefix = ref M.default_latex_type_prefix -let latex_exception_prefix = ref M.default_latex_exception_prefix -let latex_module_prefix = ref M.default_latex_module_prefix -let latex_module_type_prefix = ref M.default_latex_module_type_prefix -let latex_class_prefix = ref M.default_latex_class_prefix -let latex_class_type_prefix = ref M.default_latex_class_type_prefix -let latex_attribute_prefix = ref M.default_latex_attribute_prefix -let latex_method_prefix = ref M.default_latex_method_prefix - -let set_doc_generator (dg_opt : doc_generator option) = doc_generator := dg_opt - -(** The default html generator. Initialized in the parse function, to be used during the command line analysis.*) -let default_html_generator = ref (None : doc_generator option) - -(** The default latex generator. Initialized in the parse function, to be used during the command line analysis.*) -let default_latex_generator = ref (None : doc_generator option) - -(** The default texinfo generator. Initialized in the parse function, to be used during the command line analysis.*) -let default_texi_generator = ref (None : doc_generator option) - -(** The default man pages generator. Initialized in the parse function, to be used during the command line analysis.*) -let default_man_generator = ref (None : doc_generator option) - -(** The default dot generator. Initialized in the parse function, to be used during the command line analysis.*) -let default_dot_generator = ref (None : doc_generator option) +let set_generator (g : Odoc_gen.generator) = current_generator := Some g (** The default option list *) let default_options = [ "-version", Arg.Unit (fun () -> print_string M.message_version ; print_newline () ; exit 0) , M.option_version ; "-vnum", Arg.Unit (fun () -> print_string M.config_version ; print_newline () ; exit 0) , M.option_version ; - "-v", Arg.Unit (fun () -> verbose := true), M.verbose_mode ; - "-I", Arg.String (fun s -> include_dirs := (Misc.expand_directory Config.standard_library s) :: !include_dirs), M.include_dirs ; - "-pp", Arg.String (fun s -> preprocessor := Some s), M.preprocess ; - "-impl", Arg.String (fun s -> files := !files @ [Impl_file s]), M.option_impl ; - "-intf", Arg.String (fun s -> files := !files @ [Intf_file s]), M.option_intf ; - "-text", Arg.String (fun s -> files := !files @ [Text_file s]), M.option_text ; - "-rectypes", Arg.Set recursive_types, M.rectypes ; - "-nolabels", Arg.Unit (fun () -> classic := true), M.nolabels ; + "-v", Arg.Unit (fun () -> Odoc_global.verbose := true), M.verbose_mode ; + "-I", Arg.String (fun s -> + Odoc_global.include_dirs := + (Misc.expand_directory Config.standard_library s) :: !Odoc_global.include_dirs), + M.include_dirs ; + "-pp", Arg.String (fun s -> Odoc_global.preprocessor := Some s), M.preprocess ; + "-ppx", Arg.String (fun s -> Odoc_global.ppx := s :: !Odoc_global.ppx), M.ppx ; + "-impl", Arg.String (fun s -> + Odoc_global.files := !Odoc_global.files @ [Odoc_global.Impl_file s]), + M.option_impl ; + "-intf", Arg.String (fun s -> + Odoc_global.files := !Odoc_global.files @ [Odoc_global.Intf_file s]), + M.option_intf ; + "-text", Arg.String (fun s -> + Odoc_global.files := !Odoc_global.files @ [Odoc_global.Text_file s]), + M.option_text ; + "-rectypes", Arg.Set Odoc_global.recursive_types, M.rectypes ; + "-nolabels", Arg.Unit (fun () -> Odoc_global.classic := true), M.nolabels ; "-warn-error", Arg.Set Odoc_global.warn_error, M.werr ; "-hide-warnings", Arg.Clear Odoc_config.print_warnings, M.hide_warnings ; - "-o", Arg.String (fun s -> out_file := s), M.out_file ; - "-d", Arg.String (fun s -> target_dir := s), M.target_dir ; - "-sort", Arg.Unit (fun () -> sort_modules := true), M.sort_modules ; - "-no-stop", Arg.Set no_stop, M.no_stop ; - "-no-custom-tags", Arg.Set no_custom_tags, M.no_custom_tags ; - "-stars", Arg.Set remove_stars, M.remove_stars ; - "-inv-merge-ml-mli", Arg.Set inverse_merge_ml_mli, M.inverse_merge_ml_mli ; - "-no-module-constraint-filter", Arg.Clear filter_with_module_constraints, + "-o", Arg.String (fun s -> Odoc_global.out_file := s), M.out_file ; + "-d", Arg.String (fun s -> Odoc_global.target_dir := s), M.target_dir ; + "-sort", Arg.Unit (fun () -> Odoc_global.sort_modules := true), M.sort_modules ; + "-no-stop", Arg.Set Odoc_global.no_stop, M.no_stop ; + "-no-custom-tags", Arg.Set Odoc_global.no_custom_tags, M.no_custom_tags ; + "-stars", Arg.Set Odoc_global.remove_stars, M.remove_stars ; + "-inv-merge-ml-mli", Arg.Set Odoc_global.inverse_merge_ml_mli, M.inverse_merge_ml_mli ; + "-no-module-constraint-filter", Arg.Clear Odoc_global.filter_with_module_constraints, M.no_filter_with_module_constraints ; - "-keep-code", Arg.Set keep_code, M.keep_code^"\n" ; + "-keep-code", Arg.Set Odoc_global.keep_code, M.keep_code^"\n" ; - "-dump", Arg.String (fun s -> dump := Some s), M.dump ; - "-load", Arg.String (fun s -> load := !load @ [s]), M.load^"\n" ; + "-dump", Arg.String (fun s -> Odoc_global.dump := Some s), M.dump ; + "-load", Arg.String (fun s -> Odoc_global.load := !Odoc_global.load @ [s]), M.load^"\n" ; - "-t", Arg.String (fun s -> title := Some s), M.option_title ; - "-intro", Arg.String (fun s -> intro_file := Some s), M.option_intro ; + "-t", Arg.String (fun s -> Odoc_global.title := Some s), M.option_title ; + "-intro", Arg.String (fun s -> Odoc_global.intro_file := Some s), M.option_intro ; "-hide", Arg.String add_hidden_modules, M.hide_modules ; - "-m", Arg.String (fun s -> merge_options := !merge_options @ (analyse_merge_options s)), + "-m", Arg.String (fun s -> Odoc_global.merge_options := !Odoc_global.merge_options @ (analyse_merge_options s)), M.merge_options ^ "\n\n *** choosing a generator ***\n"; (* generators *) - "-html", Arg.Unit (fun () -> set_doc_generator !default_html_generator), M.generate_html ; - "-latex", Arg.Unit (fun () -> set_doc_generator !default_latex_generator), M.generate_latex ; - "-texi", Arg.Unit (fun () -> set_doc_generator !default_texi_generator), M.generate_texinfo ; - "-man", Arg.Unit (fun () -> set_doc_generator !default_man_generator), M.generate_man ; - "-dot", Arg.Unit (fun () -> set_doc_generator !default_dot_generator), M.generate_dot ; + "-html", Arg.Unit (fun () -> set_generator + (Odoc_gen.Html (module Odoc_html.Generator : Odoc_html.Html_generator))), + M.generate_html ; + "-latex", Arg.Unit (fun () -> set_generator + (Odoc_gen.Latex (module Odoc_latex.Generator : Odoc_latex.Latex_generator))), + M.generate_latex ; + "-texi", Arg.Unit (fun () -> set_generator + (Odoc_gen.Texi (module Odoc_texi.Generator : Odoc_texi.Texi_generator))), + M.generate_texinfo ; + "-man", Arg.Unit (fun () -> set_generator + (Odoc_gen.Man (module Odoc_man.Generator : Odoc_man.Man_generator))), + M.generate_man ; + "-dot", Arg.Unit (fun () -> set_generator + (Odoc_gen.Dot (module Odoc_dot.Generator : Odoc_dot.Dot_generator))), + M.generate_dot ; "-customdir", Arg.Unit (fun () -> Printf.printf "%s\n" Odoc_config.custom_generators_path; exit 0), M.display_custom_generators_dir ; "-i", Arg.String (fun s -> ()), M.add_load_dir ; @@ -262,51 +242,59 @@ "\n\n *** HTML options ***\n"; (* html only options *) - "-all-params", Arg.Set with_parameter_list, M.with_parameter_list ; - "-css-style", Arg.String (fun s -> css_style := Some s), M.css_style ; - "-index-only", Arg.Set index_only, M.index_only ; - "-colorize-code", Arg.Set colorize_code, M.colorize_code ; - "-short-functors", Arg.Set html_short_functors, M.html_short_functors ; - "-charset", Arg.Set_string charset, (M.charset !charset)^ + "-all-params", Arg.Set Odoc_html.with_parameter_list, M.with_parameter_list ; + "-css-style", Arg.String (fun s -> Odoc_html.css_style := Some s), M.css_style ; + "-index-only", Arg.Set Odoc_html.index_only, M.index_only ; + "-colorize-code", Arg.Set Odoc_html.colorize_code, M.colorize_code ; + "-short-functors", Arg.Set Odoc_html.html_short_functors, M.html_short_functors ; + "-charset", Arg.Set_string Odoc_html.charset, (M.charset !Odoc_html.charset)^ "\n\n *** LaTeX options ***\n"; (* latex only options *) - "-noheader", Arg.Unit (fun () -> with_header := false), M.no_header ; - "-notrailer", Arg.Unit (fun () -> with_trailer := false), M.no_trailer ; - "-sepfiles", Arg.Set separate_files, M.separate_files ; - "-latextitle", Arg.String f_latex_title, M.latex_title latex_titles ; - "-latex-value-prefix", Arg.String (fun s -> latex_value_prefix := s), M.latex_value_prefix ; - "-latex-type-prefix", Arg.String (fun s -> latex_type_prefix := s), M.latex_type_prefix ; - "-latex-exception-prefix", Arg.String (fun s -> latex_exception_prefix := s), M.latex_exception_prefix ; - "-latex-attribute-prefix", Arg.String (fun s -> latex_attribute_prefix := s), M.latex_attribute_prefix ; - "-latex-method-prefix", Arg.String (fun s -> latex_method_prefix := s), M.latex_method_prefix ; - "-latex-module-prefix", Arg.String (fun s -> latex_module_prefix := s), M.latex_module_prefix ; - "-latex-module-type-prefix", Arg.String (fun s -> latex_module_type_prefix := s), M.latex_module_type_prefix ; - "-latex-class-prefix", Arg.String (fun s -> latex_class_prefix := s), M.latex_class_prefix ; - "-latex-class-type-prefix", Arg.String (fun s -> latex_class_type_prefix := s), M.latex_class_type_prefix ; - "-notoc", Arg.Unit (fun () -> with_toc := false), - M.no_toc ^ + "-noheader", Arg.Unit (fun () -> Odoc_global.with_header := false), M.no_header ; + "-notrailer", Arg.Unit (fun () -> Odoc_global.with_trailer := false), M.no_trailer ; + "-sepfiles", Arg.Set Odoc_latex.separate_files, M.separate_files ; + "-latextitle", Arg.String f_latex_title, M.latex_title Odoc_latex.latex_titles ; + "-latex-value-prefix", + Arg.String (fun s -> Odoc_latex.latex_value_prefix := s), M.latex_value_prefix ; + "-latex-type-prefix", + Arg.String (fun s -> Odoc_latex.latex_type_prefix := s), M.latex_type_prefix ; + "-latex-exception-prefix", + Arg.String (fun s -> Odoc_latex.latex_exception_prefix := s), M.latex_exception_prefix ; + "-latex-attribute-prefix", + Arg.String (fun s -> Odoc_latex.latex_attribute_prefix := s), M.latex_attribute_prefix ; + "-latex-method-prefix", + Arg.String (fun s -> Odoc_latex.latex_method_prefix := s), M.latex_method_prefix ; + "-latex-module-prefix", + Arg.String (fun s -> Odoc_latex.latex_module_prefix := s), M.latex_module_prefix ; + "-latex-module-type-prefix", + Arg.String (fun s -> Odoc_latex.latex_module_type_prefix := s), M.latex_module_type_prefix ; + "-latex-class-prefix", + Arg.String (fun s -> Odoc_latex.latex_class_prefix := s), M.latex_class_prefix ; + "-latex-class-type-prefix", + Arg.String (fun s -> Odoc_latex.latex_class_type_prefix := s), M.latex_class_type_prefix ; + "-notoc", Arg.Unit (fun () -> Odoc_global.with_toc := false), M.no_toc ^ "\n\n *** texinfo options ***\n"; -(* tex only options *) - "-noindex", Arg.Clear with_index, M.no_index ; - "-esc8", Arg.Set esc_8bits, M.esc_8bits ; - "-info-section", Arg.String ((:=) info_section), M.info_section ; - "-info-entry", Arg.String (fun s -> info_entry := !info_entry @ [ s ]), +(* texi only options *) + "-noindex", Arg.Clear Odoc_global.with_index, M.no_index ; + "-esc8", Arg.Set Odoc_texi.esc_8bits, M.esc_8bits ; + "-info-section", Arg.String ((:=) Odoc_texi.info_section), M.info_section ; + "-info-entry", Arg.String (fun s -> Odoc_texi.info_entry := !Odoc_texi.info_entry @ [ s ]), M.info_entry ^ "\n\n *** dot options ***\n"; (* dot only options *) - "-dot-colors", Arg.String (fun s -> dot_colors := Str.split (Str.regexp_string ",") s), M.dot_colors ; - "-dot-include-all", Arg.Set dot_include_all, M.dot_include_all ; - "-dot-types", Arg.Set dot_types, M.dot_types ; - "-dot-reduce", Arg.Set dot_reduce, M.dot_reduce^ + "-dot-colors", Arg.String (fun s -> Odoc_dot.dot_colors := Str.split (Str.regexp_string ",") s), M.dot_colors ; + "-dot-include-all", Arg.Set Odoc_dot.dot_include_all, M.dot_include_all ; + "-dot-types", Arg.Set Odoc_dot.dot_types, M.dot_types ; + "-dot-reduce", Arg.Set Odoc_dot.dot_reduce, M.dot_reduce^ "\n\n *** man pages options ***\n"; (* man only options *) - "-man-mini", Arg.Set man_mini, M.man_mini ; - "-man-suffix", Arg.String (fun s -> man_suffix := s), M.man_suffix ; - "-man-section", Arg.String (fun s -> man_section := s), M.man_section ; + "-man-mini", Arg.Set Odoc_man.man_mini, M.man_mini ; + "-man-suffix", Arg.String (fun s -> Odoc_man.man_suffix := s), M.man_suffix ; + "-man-section", Arg.String (fun s -> Odoc_man.man_section := s), M.man_section ; ] @@ -327,7 +315,7 @@ let msg = Arg.usage_string (!options @ !help_options) - (M.usage ^ M.options_are) in + (M.usage ^ M.options_are) in print_string msg let () = help_options := [ @@ -349,27 +337,22 @@ in options := iter !options -let parse ~html_generator ~latex_generator ~texi_generator ~man_generator ~dot_generator = +let parse () = let anonymous f = let sf = if Filename.check_suffix f "ml" then - Impl_file f + Odoc_global.Impl_file f else if Filename.check_suffix f "mli" then - Intf_file f + Odoc_global.Intf_file f else if Filename.check_suffix f "txt" then - Text_file f + Odoc_global.Text_file f else failwith (Odoc_messages.unknown_extension f) in - files := !files @ [sf] + Odoc_global.files := !Odoc_global.files @ [sf] in - default_html_generator := Some html_generator ; - default_latex_generator := Some latex_generator ; - default_texi_generator := Some texi_generator ; - default_man_generator := Some man_generator ; - default_dot_generator := Some dot_generator ; if modified_options () then append_last_doc "\n"; let options = !options @ !help_options in let _ = Arg.parse options @@ -379,4 +362,5 @@ (* we sort the hidden modules by name, to be sure that for example, A.B is before A, so we will match against A.B before A in Odoc_name.hide_modules.*) - hidden_modules := List.sort (fun a -> fun b -> - (compare a b)) !hidden_modules + Odoc_global.hidden_modules := + List.sort (fun a -> fun b -> - (compare a b)) !Odoc_global.hidden_modules diff -Nru ocaml-3.12.1/ocamldoc/odoc_args.mli ocaml-4.01.0/ocamldoc/odoc_args.mli --- ocaml-3.12.1/ocamldoc/odoc_args.mli 2011-05-05 11:28:57.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_args.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,187 +10,41 @@ (* *) (***********************************************************************) -(* $Id: odoc_args.mli 11027 2011-05-05 11:28:57Z doligez $ *) - (** Analysis of the command line arguments. *) -(** The kind of source file in arguments. *) -type source_file = - Impl_file of string - | Intf_file of string - | Text_file of string - -(** The include_dirs in the OCaml compiler. *) -val include_dirs : string list ref - -(** The class type of documentation generators. *) -class type doc_generator = - object method generate : Odoc_module.t_module list -> unit end - -(** The function to be used to create a generator. *) -val doc_generator : doc_generator option ref - -(** The merge options to be used. *) -val merge_options : Odoc_types.merge_option list ref - -(** Classic mode or not. *) -val classic : bool ref - -(** The file used by the generators outputting only one file. *) -val out_file : string ref - -(** The optional file name to dump the collected information into.*) -val dump : string option ref - -(** The list of information files to load. *) -val load : string list ref - -(** Verbose mode or not. *) -val verbose : bool ref - -(** We must sort the list of top modules or not.*) -val sort_modules : bool ref - -(** We must not stop at the stop special comments. Default is false (we stop).*) -val no_stop : bool ref - -(** We must raise an exception when we find an unknown @-tag. *) -val no_custom_tags : bool ref - -(** We must remove the the first characters of each comment line, until the first asterisk '*'. *) -val remove_stars : bool ref - -(** To keep the code while merging, when we have both .ml and .mli files for a module. *) -val keep_code : bool ref - -(** To inverse implementation and interface files when merging. *) -val inverse_merge_ml_mli : bool ref - -(** To filter module elements according to module type constraints. *) -val filter_with_module_constraints : bool ref - -(** The optional title to use in the generated documentation. *) -val title : string option ref - -(** The optional file whose content can be used as intro text. *) -val intro_file : string option ref - -(** Flag to indicate whether we must display the complete list of parameters - for functions and methods. *) -val with_parameter_list : bool ref - -(** The list of module names to hide. *) -val hidden_modules : string list ref - -(** The directory where files have to be generated. *) -val target_dir : string ref - -(** An optional file to use where a CSS style is defined (for HTML). *) -val css_style : string option ref - -(** Generate only index files. (for HTML). *) -val index_only : bool ref - -(** To colorize code in HTML generated documentation pages, not code pages. *) -val colorize_code : bool ref - -(** To display functors in short form rather than with "functor ... -> ", - in HTML generated documentation. *) -val html_short_functors : bool ref - -(** Encoding used in HTML pages header. *) -val charset : string ref - -(** The flag which indicates if we must generate a header (for LaTeX). *) -val with_header : bool ref - -(** The flag which indicates if we must generate a trailer (for LaTeX). *) -val with_trailer : bool ref - -(** The flag to indicate if we must generate one file per module (for LaTeX). *) -val separate_files : bool ref - -(** The list of pairs (title level, sectionning style). *) -val latex_titles : (int * string) list ref - -(** The prefix to use for value labels in LaTeX. *) -val latex_value_prefix : string ref - -(** The prefix to use for type labels in LaTeX. *) -val latex_type_prefix : string ref - -(** The prefix to use for exception labels in LaTeX. *) -val latex_exception_prefix : string ref - -(** The prefix to use for module labels in LaTeX. *) -val latex_module_prefix : string ref - -(** The prefix to use for module type labels in LaTeX. *) -val latex_module_type_prefix : string ref - -(** The prefix to use for class labels in LaTeX. *) -val latex_class_prefix : string ref - -(** The prefix to use for class type labels in LaTeX. *) -val latex_class_type_prefix : string ref - -(** The prefix to use for attribute labels in LaTeX. *) -val latex_attribute_prefix : string ref - -(** The prefix to use for method labels in LaTeX. *) -val latex_method_prefix : string ref - -(** The flag which indicates if we must generate a table of contents (for LaTeX). *) -val with_toc : bool ref - -(** The flag which indicates if we must generate an index (for TeXinfo). *) -val with_index : bool ref - -(** The flag which indicates if we must escape accentuated characters (for TeXinfo).*) -val esc_8bits : bool ref - -(** The Info directory section *) -val info_section : string ref - -(** The Info directory entries to insert *) -val info_entry : string list ref - -(** Include all modules or only the ones on the command line, for the dot output. *) -val dot_include_all : bool ref - -(** Generate dependency graph for types. *) -val dot_types : bool ref - -(** Perform transitive reduction before dot output. *) -val dot_reduce : bool ref - -(** The colors used in the dot output. *) -val dot_colors : string list ref - -(** The suffix for man pages. *) -val man_suffix : string ref - -(** The section for man pages. *) -val man_section : string ref - -(** The flag to generate all man pages or only for modules and classes.*) -val man_mini : bool ref - -(** The files to be analysed. *) -val files : source_file list ref +(** The current module defining the generator to use. *) +val current_generator : Odoc_gen.generator option ref (** To set the documentation generator. *) -val set_doc_generator : doc_generator option -> unit +val set_generator : Odoc_gen.generator -> unit + +(** Extend current HTML generator. + @raise Failure if another kind of generator is already set.*) +val extend_html_generator : (module Odoc_gen.Html_functor) -> unit + +(** Extend current LaTeX generator. + @raise Failure if another kind of generator is already set.*) +val extend_latex_generator : (module Odoc_gen.Latex_functor) -> unit + +(** Extend current Texi generator. + @raise Failure if another kind of generator is already set.*) +val extend_texi_generator : (module Odoc_gen.Texi_functor) -> unit + +(** Extend current man generator. + @raise Failure if another kind of generator is already set.*) +val extend_man_generator : (module Odoc_gen.Man_functor) -> unit + +(** Extend current dot generator. + @raise Failure if another kind of generator is already set.*) +val extend_dot_generator : (module Odoc_gen.Dot_functor) -> unit + +(** Extend current base generator. + @raise Failure if another kind of generator is already set.*) +val extend_base_generator : (module Odoc_gen.Base_functor) -> unit (** Add an option specification. *) val add_option : string * Arg.spec * string -> unit (** Parse the args. [byte] indicate if we are in bytecode mode (default is [true]).*) -val parse : - html_generator:doc_generator -> - latex_generator:doc_generator -> - texi_generator:doc_generator -> - man_generator:doc_generator -> - dot_generator:doc_generator -> - unit +val parse : unit -> unit diff -Nru ocaml-3.12.1/ocamldoc/odoc_ast.ml ocaml-4.01.0/ocamldoc/odoc_ast.ml --- ocaml-3.12.1/ocamldoc/odoc_ast.ml 2010-05-03 15:06:17.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_ast.ml 2013-05-16 13:34:53.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_ast.ml 10355 2010-05-03 15:06:17Z guesdon $ *) - (** Analysis of implementation files. *) open Misc open Asttypes @@ -54,50 +53,50 @@ | P of string | IM of string - type tab = (ele, Typedtree.structure_item) Hashtbl.t + type tab = (ele, Typedtree.structure_item_desc) Hashtbl.t type tab_values = (Odoc_module.Name.t, Typedtree.pattern * Typedtree.expression) Hashtbl.t let iter_val_pattern = function | Typedtree.Tpat_any -> None - | Typedtree.Tpat_var name -> Some (Name.from_ident name) + | Typedtree.Tpat_var (name, _) -> Some (Name.from_ident name) | Typedtree.Tpat_tuple _ -> None (* A VOIR quand on traitera les tuples *) | _ -> None let add_to_hashes table table_values tt = match tt with - | Typedtree.Tstr_module (ident, _) -> + | Typedtree.Tstr_module (ident, _, _) -> Hashtbl.add table (M (Name.from_ident ident)) tt | Typedtree.Tstr_recmodule mods -> List.iter - (fun (ident,mod_expr) -> + (fun (ident,ident_loc, _, mod_expr) -> Hashtbl.add table (M (Name.from_ident ident)) - (Typedtree.Tstr_module (ident,mod_expr)) + (Typedtree.Tstr_module (ident,ident_loc, mod_expr)) ) mods - | Typedtree.Tstr_modtype (ident, _) -> + | Typedtree.Tstr_modtype (ident, _, _) -> Hashtbl.add table (MT (Name.from_ident ident)) tt - | Typedtree.Tstr_exception (ident, _) -> + | Typedtree.Tstr_exception (ident, _, _) -> Hashtbl.add table (E (Name.from_ident ident)) tt - | Typedtree.Tstr_exn_rebind (ident, _) -> + | Typedtree.Tstr_exn_rebind (ident, _, _, _) -> Hashtbl.add table (ER (Name.from_ident ident)) tt | Typedtree.Tstr_type ident_type_decl_list -> List.iter - (fun (id, e) -> + (fun (id, id_loc, e) -> Hashtbl.add table (T (Name.from_ident id)) - (Typedtree.Tstr_type [(id,e)])) + (Typedtree.Tstr_type [(id,id_loc,e)])) ident_type_decl_list | Typedtree.Tstr_class info_list -> List.iter - (fun ((id,_,_,_,_) as ci) -> - Hashtbl.add table (C (Name.from_ident id)) - (Typedtree.Tstr_class [ci])) + (fun (ci, m, s) -> + Hashtbl.add table (C (Name.from_ident ci.ci_id_class)) + (Typedtree.Tstr_class [ci, m, s])) info_list - | Typedtree.Tstr_cltype info_list -> + | Typedtree.Tstr_class_type info_list -> List.iter - (fun ((id,_) as ci) -> + (fun ((id,id_loc,_) as ci) -> Hashtbl.add table (CT (Name.from_ident id)) - (Typedtree.Tstr_cltype [ci])) + (Typedtree.Tstr_class_type [ci])) info_list | Typedtree.Tstr_value (_, pat_exp_list) -> List.iter @@ -107,7 +106,7 @@ | Some n -> Hashtbl.add table_values n (pat,exp) ) pat_exp_list - | Typedtree.Tstr_primitive (ident, _) -> + | Typedtree.Tstr_primitive (ident, _, _) -> Hashtbl.add table (P (Name.from_ident ident)) tt | Typedtree.Tstr_open _ -> () | Typedtree.Tstr_include _ -> () @@ -116,41 +115,42 @@ let tables typedtree = let t = Hashtbl.create 13 in let t_values = Hashtbl.create 13 in - List.iter (add_to_hashes t t_values) typedtree; + List.iter (fun str -> add_to_hashes t t_values str.str_desc) typedtree; (t, t_values) let search_module table name = match Hashtbl.find table (M name) with - (Typedtree.Tstr_module (_, module_expr)) -> module_expr + (Typedtree.Tstr_module (_, _, module_expr)) -> module_expr | _ -> assert false let search_module_type table name = match Hashtbl.find table (MT name) with - | (Typedtree.Tstr_modtype (_, module_type)) -> module_type + | (Typedtree.Tstr_modtype (_, _, module_type)) -> module_type | _ -> assert false let search_exception table name = match Hashtbl.find table (E name) with - | (Typedtree.Tstr_exception (_, excep_decl)) -> excep_decl + | (Typedtree.Tstr_exception (_, _, excep_decl)) -> excep_decl | _ -> assert false let search_exception_rebind table name = match Hashtbl.find table (ER name) with - | (Typedtree.Tstr_exn_rebind (_, p)) -> p + | (Typedtree.Tstr_exn_rebind (_, _, p, _)) -> p | _ -> assert false let search_type_declaration table name = match Hashtbl.find table (T name) with - | (Typedtree.Tstr_type [(_,decl)]) -> decl + | (Typedtree.Tstr_type [(_,_, decl)]) -> decl | _ -> assert false let search_class_exp table name = match Hashtbl.find table (C name) with - | (Typedtree.Tstr_class [(_,_,_,ce,_)]) -> + | (Typedtree.Tstr_class [(ci, _, _ )]) -> + let ce = ci.ci_expr in ( try let type_decl = search_type_declaration table name in - (ce, type_decl.Types.type_params) + (ce, type_decl.typ_type.Types.type_params) with Not_found -> (ce, []) @@ -159,63 +159,60 @@ let search_class_type_declaration table name = match Hashtbl.find table (CT name) with - | (Typedtree.Tstr_cltype [(_,cltype_decl)]) -> cltype_decl + | (Typedtree.Tstr_class_type [(_,_,cltype_decl)]) -> cltype_decl | _ -> assert false let search_value table name = Hashtbl.find table name let search_primitive table name = match Hashtbl.find table (P name) with - Tstr_primitive (ident, val_desc) -> val_desc.Types.val_type + Tstr_primitive (ident, _, val_desc) -> val_desc.val_val.Types.val_type | _ -> assert false let get_nth_inherit_class_expr cls n = let rec iter cpt = function | [] -> raise Not_found - | Typedtree.Cf_inher (clexp, _, _) :: q -> + | { cf_desc = Typedtree.Tcf_inher (_, clexp, _, _, _) } :: q -> if n = cpt then clexp else iter (cpt+1) q | _ :: q -> iter cpt q in - iter 0 cls.Typedtree.cl_field + iter 0 cls.Typedtree.cstr_fields let search_attribute_type cls name = let rec iter = function | [] -> raise Not_found - | Typedtree.Cf_val (_, ident, Some exp, _) :: q + | { cf_desc = Typedtree.Tcf_val (_, _, _, ident, Tcfk_concrete exp, _) } :: q when Name.from_ident ident = name -> exp.Typedtree.exp_type + | { cf_desc = Typedtree.Tcf_val (_, _, _, ident, Tcfk_virtual typ, _) } :: q + when Name.from_ident ident = name -> + typ.Typedtree.ctyp_type | _ :: q -> iter q in - iter cls.Typedtree.cl_field + iter cls.Typedtree.cstr_fields let class_sig_of_cltype_decl = let rec iter = function - Types.Tcty_constr (_, _, cty) -> iter cty - | Types.Tcty_signature s -> s - | Types.Tcty_fun (_,_, cty) -> iter cty + Types.Cty_constr (_, _, cty) -> iter cty + | Types.Cty_signature s -> s + | Types.Cty_fun (_,_, cty) -> iter cty in fun ct_decl -> iter ct_decl.Types.clty_type - let search_virtual_attribute_type table ctname name = - let ct_decl = search_class_type_declaration table ctname in - let cls_sig = class_sig_of_cltype_decl ct_decl in - let (_,_,texp) = Types.Vars.find name cls_sig.cty_vars in - texp - let search_method_expression cls name = let rec iter = function | [] -> raise Not_found - | Typedtree.Cf_meth (label, exp) :: q when label = name -> + | { cf_desc = Typedtree.Tcf_meth (label, _, _, Tcfk_concrete exp, _) } :: q when label = name -> exp | _ :: q -> iter q in - iter cls.Typedtree.cl_field + iter cls.Typedtree.cstr_fields end module Analyser = @@ -253,14 +250,14 @@ let tt_param_info_from_pattern env f_desc pat = let rec iter_pattern pat = match pat.pat_desc with - Typedtree.Tpat_var ident -> + Typedtree.Tpat_var (ident, _) -> let name = Name.from_ident ident in Simple_name { sn_name = name ; sn_text = f_desc name ; sn_type = Odoc_env.subst_type env pat.pat_type } - | Typedtree.Tpat_alias (pat, _) -> + | Typedtree.Tpat_alias (pat, _, _) -> iter_pattern pat | Typedtree.Tpat_tuple patlist -> @@ -268,7 +265,7 @@ (List.map iter_pattern patlist, Odoc_env.subst_type env pat.pat_type) - | Typedtree.Tpat_construct (cons_desc, _) when + | Typedtree.Tpat_construct (_, cons_desc, _, _) when (* we give a name to the parameter only if it unit *) (match cons_desc.cstr_res.desc with Tconstr (p, _, _) -> @@ -322,7 +319,7 @@ ( ( match func_body.exp_desc with - Typedtree.Texp_let (_, ({pat_desc = Typedtree.Tpat_var id } , exp) :: _, func_body2) -> + Typedtree.Texp_let (_, ({pat_desc = Typedtree.Tpat_var (id, _) } , exp) :: _, func_body2) -> let name = Name.from_ident id in let new_param = Simple_name { sn_name = name ; @@ -341,7 +338,7 @@ in (* continue if the body is still a function *) match next_exp.exp_desc with - Texp_function (pat_exp_list, _) -> + Texp_function (_, pat_exp_list, _) -> p :: (tt_analyse_function_parameters env current_comment_opt pat_exp_list) | _ -> (* something else ; no more parameter *) @@ -352,11 +349,18 @@ let tt_analyse_value env current_module_name comment_opt loc pat_exp rec_flag = let (pat, exp) = pat_exp in match (pat.pat_desc, exp.exp_desc) with - (Typedtree.Tpat_var ident, Typedtree.Texp_function (pat_exp_list2, partial)) -> + (Typedtree.Tpat_var (ident, _), Typedtree.Texp_function (_, pat_exp_list2, partial)) -> (* a new function is defined *) let name_pre = Name.from_ident ident in let name = Name.parens_if_infix name_pre in let complete_name = Name.concat current_module_name name in + let code = + if !Odoc_global.keep_code then + Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum + loc.Location.loc_end.Lexing.pos_cnum) + else + None + in (* create the value *) let new_value = { val_name = complete_name ; @@ -364,25 +368,32 @@ val_type = Odoc_env.subst_type env pat.Typedtree.pat_type ; val_recursive = rec_flag = Asttypes.Recursive ; val_parameters = tt_analyse_function_parameters env comment_opt pat_exp_list2 ; - val_code = Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum loc.Location.loc_end.Lexing.pos_cnum) ; - val_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ; + val_code = code ; + val_loc = { loc_impl = Some loc ; loc_inter = None } ; } in [ new_value ] - | (Typedtree.Tpat_var ident, _) -> + | (Typedtree.Tpat_var (ident, _), _) -> (* a new value is defined *) let name_pre = Name.from_ident ident in let name = Name.parens_if_infix name_pre in let complete_name = Name.concat current_module_name name in + let code = + if !Odoc_global.keep_code then + Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum + loc.Location.loc_end.Lexing.pos_cnum) + else + None + in let new_value = { val_name = complete_name ; val_info = comment_opt ; val_type = Odoc_env.subst_type env pat.Typedtree.pat_type ; val_recursive = rec_flag = Asttypes.Recursive ; val_parameters = [] ; - val_code = Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum loc.Location.loc_end.Lexing.pos_cnum) ; - val_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ; + val_code = code ; + val_loc = { loc_impl = Some loc ; loc_inter = None } ; } in [ new_value ] @@ -411,9 +422,9 @@ ); *) match clexp.Typedtree.cl_desc with - Typedtree.Tclass_ident p -> Name.from_path p - | Typedtree.Tclass_constraint (class_expr, _, _, _) - | Typedtree.Tclass_apply (class_expr, _) -> tt_name_of_class_expr class_expr + Typedtree.Tcl_ident (p, _, _) -> Name.from_path p + | Typedtree.Tcl_constraint (class_expr, _, _, _, _) + | Typedtree.Tcl_apply (class_expr, _) -> tt_name_of_class_expr class_expr (* | Typedtree.Tclass_fun (_, _, class_expr, _) -> tt_name_of_class_expr class_expr | Typedtree.Tclass_let (_,_,_, class_expr) -> tt_name_of_class_expr class_expr @@ -427,7 +438,7 @@ *) let rec tt_analyse_method_expression env current_method_name comment_opt ?(first=true) exp = match exp.Typedtree.exp_desc with - Typedtree.Texp_function (pat_exp_list, _) -> + Typedtree.Texp_function (_, pat_exp_list, _) -> ( match pat_exp_list with [] -> @@ -437,7 +448,7 @@ | l -> match l with [] -> - (* cas impossible, on l'a filtré avant *) + (* cas impossible, on l'a filtre avant *) assert false | (pattern_param, exp) :: second_ele :: q -> (* implicit pattern matching -> anonymous parameter *) @@ -467,7 +478,7 @@ ( ( match body.exp_desc with - Typedtree.Texp_let (_, ({pat_desc = Typedtree.Tpat_var id } , exp) :: _, body2) -> + Typedtree.Texp_let (_, ({pat_desc = Typedtree.Tpat_var (id, _) } , exp) :: _, body2) -> let name = Name.from_ident id in let new_param = Simple_name { sn_name = name ; @@ -513,8 +524,10 @@ ele_coms in (acc_inher, acc_fields @ ele_comments) - - | (Parsetree.Pcf_inher (_, p_clexp, _)) :: q -> + | item :: q -> + let loc = item.Parsetree.pcf_loc in + match item.Parsetree.pcf_desc with + | (Parsetree.Pcf_inher (_, p_clexp, _)) -> let tt_clexp = let n = List.length acc_inher in try Typedtree_search.get_nth_inherit_class_expr tt_cls n @@ -541,38 +554,40 @@ p_clexp.Parsetree.pcl_loc.Location.loc_end.Lexing.pos_cnum q - | ((Parsetree.Pcf_val (label, mutable_flag, _, _, loc) | - Parsetree.Pcf_valvirt (label, mutable_flag, _, loc) ) as x) :: q -> + | ((Parsetree.Pcf_val ({ txt = label }, mutable_flag, _, _) | + Parsetree.Pcf_valvirt ({ txt = label }, mutable_flag, _) ) as x) -> let virt = match x with Parsetree.Pcf_val _ -> false | _ -> true in let complete_name = Name.concat current_class_name label in let (info_opt, ele_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in let type_exp = - try - if virt then - Typedtree_search.search_virtual_attribute_type table - (Name.simple current_class_name) label - else - Typedtree_search.search_attribute_type tt_cls label - with Not_found -> + try Typedtree_search.search_attribute_type tt_cls label + with Not_found -> raise (Failure (Odoc_messages.attribute_not_found_in_typedtree complete_name)) - in - let att = - { - att_value = { val_name = complete_name ; - val_info = info_opt ; - val_type = Odoc_env.subst_type env type_exp ; - val_recursive = false ; - val_parameters = [] ; - val_code = Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum loc.Location.loc_end.Lexing.pos_cnum) ; - val_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ; - } ; - att_mutable = mutable_flag = Asttypes.Mutable ; - att_virtual = virt ; - } - in - iter acc_inher (acc_fields @ ele_comments @ [ Class_attribute att ]) loc.Location.loc_end.Lexing.pos_cnum q + in + let code = + if !Odoc_global.keep_code then + Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum + loc.Location.loc_end.Lexing.pos_cnum) + else + None + in + let att = + { + att_value = { val_name = complete_name ; + val_info = info_opt ; + val_type = Odoc_env.subst_type env type_exp ; + val_recursive = false ; + val_parameters = [] ; + val_code = code ; + val_loc = { loc_impl = Some loc ; loc_inter = None } ; + } ; + att_mutable = mutable_flag = Asttypes.Mutable ; + att_virtual = virt ; + } + in + iter acc_inher (acc_fields @ ele_comments @ [ Class_attribute att ]) loc.Location.loc_end.Lexing.pos_cnum q - | (Parsetree.Pcf_virt (label, private_flag, _, loc)) :: q -> + | (Parsetree.Pcf_virt ({ txt = label }, private_flag, _)) -> let complete_name = Name.concat current_class_name label in let (info_opt, ele_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in let met_type = @@ -581,77 +596,88 @@ in let real_type = match met_type.Types.desc with - Tarrow (_, _, t, _) -> - t - | _ -> + Tarrow (_, _, t, _) -> + t + | _ -> (* ?!? : not an arrow type ! return the original type *) - met_type - in - let met = - { - met_value = { val_name = complete_name ; - val_info = info_opt ; - val_type = Odoc_env.subst_type env real_type ; - val_recursive = false ; - val_parameters = [] ; - val_code = Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum loc.Location.loc_end.Lexing.pos_cnum) ; - val_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ; - } ; - met_private = private_flag = Asttypes.Private ; - met_virtual = true ; - } - in - (* update the parameter description *) - Odoc_value.update_value_parameters_text met.met_value; + met_type + in + let code = + if !Odoc_global.keep_code then + Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum + loc.Location.loc_end.Lexing.pos_cnum) + else + None + in + let met = + { + met_value = { + val_name = complete_name ; + val_info = info_opt ; + val_type = Odoc_env.subst_type env real_type ; + val_recursive = false ; + val_parameters = [] ; + val_code = code ; + val_loc = { loc_impl = Some loc ; loc_inter = None } ; + } ; + met_private = private_flag = Asttypes.Private ; + met_virtual = true ; + } + in + (* update the parameter description *) + Odoc_value.update_value_parameters_text met.met_value; - iter acc_inher (acc_fields @ ele_comments @ [ Class_method met ]) loc.Location.loc_end.Lexing.pos_cnum q + iter acc_inher (acc_fields @ ele_comments @ [ Class_method met ]) loc.Location.loc_end.Lexing.pos_cnum q - | (Parsetree.Pcf_meth (label, private_flag, _, _, loc)) :: q -> + | (Parsetree.Pcf_meth ({ txt = label }, private_flag, _, _)) -> let complete_name = Name.concat current_class_name label in let (info_opt, ele_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in let exp = try Typedtree_search.search_method_expression tt_cls label - with Not_found -> raise (Failure (Odoc_messages.method_not_found_in_typedtree complete_name)) - in - let real_type = - match exp.exp_type.desc with - Tarrow (_, _, t,_) -> - t - | _ -> + with Not_found -> raise (Failure (Odoc_messages.method_not_found_in_typedtree complete_name)) + in + let real_type = + match exp.exp_type.desc with + Tarrow (_, _, t,_) -> + t + | _ -> (* ?!? : not an arrow type ! return the original type *) - exp.Typedtree.exp_type - in - let met = - { - met_value = { val_name = complete_name ; - val_info = info_opt ; - val_type = Odoc_env.subst_type env real_type ; - val_recursive = false ; - val_parameters = tt_analyse_method_expression env complete_name info_opt exp ; - val_code = Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum loc.Location.loc_end.Lexing.pos_cnum) ; - val_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ; - } ; - met_private = private_flag = Asttypes.Private ; - met_virtual = false ; + exp.Typedtree.exp_type + in + let code = + if !Odoc_global.keep_code then + Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum + loc.Location.loc_end.Lexing.pos_cnum) + else + None + in + let met = + { + met_value = { val_name = complete_name ; + val_info = info_opt ; + val_type = Odoc_env.subst_type env real_type ; + val_recursive = false ; + val_parameters = tt_analyse_method_expression env complete_name info_opt exp ; + val_code = code ; + val_loc = { loc_impl = Some loc ; loc_inter = None } ; + } ; + met_private = private_flag = Asttypes.Private ; + met_virtual = false ; } - in - (* update the parameter description *) - Odoc_value.update_value_parameters_text met.met_value; + in + (* update the parameter description *) + Odoc_value.update_value_parameters_text met.met_value; - iter acc_inher (acc_fields @ ele_comments @ [ Class_method met ]) loc.Location.loc_end.Lexing.pos_cnum q + iter acc_inher (acc_fields @ ele_comments @ [ Class_method met ]) loc.Location.loc_end.Lexing.pos_cnum q - | Parsetree.Pcf_cstr (_, _, loc) :: q -> + | Parsetree.Pcf_constr (_, _) -> (* don't give a $*%@ ! *) iter acc_inher acc_fields loc.Location.loc_end.Lexing.pos_cnum q - | Parsetree.Pcf_let (_, _, loc) :: q -> - (* don't give a $*%@ ! *) - iter acc_inher acc_fields loc.Location.loc_end.Lexing.pos_cnum q - - | (Parsetree.Pcf_init exp) :: q -> + | (Parsetree.Pcf_init exp) -> iter acc_inher acc_fields exp.Parsetree.pexp_loc.Location.loc_end.Lexing.pos_cnum q in - iter [] [] last_pos (snd p_cls) + iter [] [] last_pos (p_cls.Parsetree.pcstr_fields) (** Analysis of a [Parsetree.class_expr] and a [Typedtree.class_expr] to get a a couple (class parameters, class kind). *) let rec analyse_class_kind env current_class_name comment_opt last_pos p_class_expr tt_class_exp table = @@ -659,17 +685,17 @@ (Parsetree.Pcl_constr (lid, _), tt_class_exp_desc ) -> let name = match tt_class_exp_desc with - Typedtree.Tclass_ident p -> Name.from_path p + Typedtree.Tcl_ident (p,_,_) -> Name.from_path p | _ -> (* we try to get the name from the environment. *) - (* A VOIR : dommage qu'on n'ait pas un Tclass_ident :-( même quand on a class tutu = toto *) - Name.from_longident lid + (* A VOIR : dommage qu'on n'ait pas un Tclass_ident :-( meme quand on a class tutu = toto *) + Name.from_longident lid.txt in - (* On n'a pas ici les paramètres de type sous forme de Types.type_expr, + (* On n'a pas ici les parametres de type sous forme de Types.type_expr, par contre on peut les trouver dans le class_type *) let params = match tt_class_exp.Typedtree.cl_type with - Types.Tcty_constr (p2, type_exp_list, cltyp) -> + Types.Cty_constr (p2, type_exp_list, cltyp) -> (* cltyp is the class type for [type_exp_list] p *) type_exp_list | _ -> @@ -683,11 +709,11 @@ cco_type_parameters = List.map (Odoc_env.subst_type env) params ; } ) - | (Parsetree.Pcl_structure p_class_structure, Typedtree.Tclass_structure tt_class_structure) -> + | (Parsetree.Pcl_structure p_class_structure, Typedtree.Tcl_structure tt_class_structure) -> (* we need the class signature to get the type of methods in analyse_class_structure *) let tt_class_sig = match tt_class_exp.Typedtree.cl_type with - Types.Tcty_signature class_sig -> class_sig + Types.Cty_signature class_sig -> class_sig | _ -> raise (Failure "analyse_class_kind: no class signature for a class structure.") in let (inherited_classes, class_elements) = analyse_class_structure @@ -704,16 +730,16 @@ Class_structure (inherited_classes, class_elements) ) | (Parsetree.Pcl_fun (label, expression_opt, pattern, p_class_expr2), - Typedtree.Tclass_fun (pat, ident_exp_list, tt_class_expr2, partial)) -> + Typedtree.Tcl_fun (_, pat, ident_exp_list, tt_class_expr2, partial)) -> (* we check that this is not an optional parameter with a default value. In this case, we look for the good parameter pattern *) let (parameter, next_tt_class_exp) = match pat.Typedtree.pat_desc with - Typedtree.Tpat_var ident when Name.from_ident ident = "*opt*" -> + Typedtree.Tpat_var (ident, _) when Name.from_ident ident = "*opt*" -> ( - (* there must be a Tclass_let just after *) + (* there must be a Tcl_let just after *) match tt_class_expr2.Typedtree.cl_desc with - Typedtree.Tclass_let (_, ({pat_desc = Typedtree.Tpat_var id } , exp) :: _, _, tt_class_expr3) -> + Typedtree.Tcl_let (_, ({pat_desc = Typedtree.Tpat_var (id,_) } , exp) :: _, _, tt_class_expr3) -> let name = Name.from_ident id in let new_param = Simple_name { sn_name = name ; @@ -743,23 +769,23 @@ in (parameter :: params, k) - | (Parsetree.Pcl_apply (p_class_expr2, _), Tclass_apply (tt_class_expr2, exp_opt_optional_list)) -> + | (Parsetree.Pcl_apply (p_class_expr2, _), Tcl_apply (tt_class_expr2, exp_opt_optional_list)) -> let applied_name = (* we want an ident, or else the class applied will appear in the form object ... end, because if the class applied has no name, the code is kinda ugly, isn't it ? *) match tt_class_expr2.Typedtree.cl_desc with - Typedtree.Tclass_ident p -> Name.from_path p (* A VOIR : obtenir le nom complet *) + Typedtree.Tcl_ident (p,_,_) -> Name.from_path p (* A VOIR : obtenir le nom complet *) | _ -> - (* A VOIR : dommage qu'on n'ait pas un Tclass_ident :-( même quand on a class tutu = toto *) + (* A VOIR : dommage qu'on n'ait pas un Tclass_ident :-( meme quand on a class tutu = toto *) match p_class_expr2.Parsetree.pcl_desc with Parsetree.Pcl_constr (lid, _) -> (* we try to get the name from the environment. *) - Name.from_longident lid + Name.from_longident lid.txt | _ -> Odoc_messages.object_end in let param_exps = List.fold_left - (fun acc -> fun (exp_opt, _) -> + (fun acc -> fun (_, exp_opt, _) -> match exp_opt with None -> acc | Some e -> acc @ [e]) @@ -782,14 +808,14 @@ capp_params_code = params_code ; } ) - | (Parsetree.Pcl_let (_, _, p_class_expr2), Typedtree.Tclass_let (_, _, _, tt_class_expr2)) -> + | (Parsetree.Pcl_let (_, _, p_class_expr2), Typedtree.Tcl_let (_, _, _, tt_class_expr2)) -> (* we don't care about these lets *) analyse_class_kind env current_class_name comment_opt last_pos p_class_expr2 tt_class_expr2 table | (Parsetree.Pcl_constraint (p_class_expr2, p_class_type2), - Typedtree.Tclass_constraint (tt_class_expr2, _, _, _)) -> + Typedtree.Tcl_constraint (tt_class_expr2, _, _, _, _)) -> let (l, class_kind) = analyse_class_kind env current_class_name comment_opt last_pos p_class_expr2 tt_class_expr2 table @@ -814,8 +840,9 @@ (** Analysis of a [Parsetree.class_declaration] and a [Typedtree.class_expr] to return a [t_class].*) let analyse_class env current_module_name comment_opt p_class_decl tt_type_params tt_class_exp table = let name = p_class_decl.Parsetree.pci_name in - let complete_name = Name.concat current_module_name name in - let pos_start = p_class_decl.Parsetree.pci_expr.Parsetree.pcl_loc.Location.loc_start.Lexing.pos_cnum in + let complete_name = Name.concat current_module_name name.txt in + let loc = p_class_decl.Parsetree.pci_expr.Parsetree.pcl_loc in + let pos_start = loc.Location.loc_start.Lexing.pos_cnum in let type_parameters = tt_type_params in let virt = p_class_decl.Parsetree.pci_virt = Asttypes.Virtual in let cltype = Odoc_env.subst_class_type env tt_class_exp.Typedtree.cl_type in @@ -837,7 +864,7 @@ cl_type_parameters = type_parameters ; cl_kind = kind ; cl_parameters = parameters ; - cl_loc = { loc_impl = Some (!file_name, pos_start) ; loc_inter = None } ; + cl_loc = { loc_impl = Some loc ; loc_inter = None } ; } in cl @@ -846,8 +873,8 @@ is not an ident of a constraint on an ident. *) let rec tt_name_from_module_expr mod_expr = match mod_expr.Typedtree.mod_desc with - Typedtree.Tmod_ident p -> Name.from_path p - | Typedtree.Tmod_constraint (m_exp, _, _) -> tt_name_from_module_expr m_exp + Typedtree.Tmod_ident (p,_) -> Name.from_path p + | Typedtree.Tmod_constraint (m_exp, _, _, _) -> tt_name_from_module_expr m_exp | Typedtree.Tmod_structure _ | Typedtree.Tmod_functor _ | Typedtree.Tmod_apply _ @@ -857,7 +884,7 @@ (** Get the list of included modules in a module structure of a typed tree. *) let tt_get_included_module_list tt_structure = let f acc item = - match item with + match item.str_desc with Typedtree.Tstr_include (mod_expr, _) -> acc @ [ { (* A VOIR : chercher dans les modules et les module types, avec quel env ? *) @@ -869,7 +896,7 @@ | _ -> acc in - List.fold_left f [] tt_structure + List.fold_left f [] tt_structure.str_items (** This function takes a [module element list] of a module and replaces the "dummy" included modules with the ones found in typed tree structure of the module. *) @@ -892,7 +919,7 @@ and the module has a "structure" kind. *) let rec filter_module_with_module_type_constraint m mt = match m.m_kind, mt with - Module_struct l, Types.Tmty_signature lsig -> + Module_struct l, Types.Mty_signature lsig -> m.m_kind <- Module_struct (filter_module_elements_with_module_type_constraint l lsig); m.m_type <- mt; | _ -> () @@ -902,7 +929,7 @@ and the module type has a "structure" kind. *) and filter_module_type_with_module_type_constraint mtyp mt = match mtyp.mt_kind, mt with - Some Module_type_struct l, Types.Tmty_signature lsig -> + Some Module_type_struct l, Types.Mty_signature lsig -> mtyp.mt_kind <- Some (Module_type_struct (filter_module_elements_with_module_type_constraint l lsig)); mtyp.mt_type <- Some mt; | _ -> () @@ -912,7 +939,7 @@ let f = match ele with Element_module m -> (function - Types.Tsig_module (ident,t,_) -> + Types.Sig_module (ident,t,_) -> let n1 = Name.simple m.m_name and n2 = Ident.name ident in ( @@ -923,7 +950,7 @@ | _ -> false) | Element_module_type mt -> (function - Types.Tsig_modtype (ident,Types.Tmodtype_manifest t) -> + Types.Sig_modtype (ident,Types.Modtype_manifest t) -> let n1 = Name.simple mt.mt_name and n2 = Ident.name ident in ( @@ -934,36 +961,36 @@ | _ -> false) | Element_value v -> (function - Types.Tsig_value (ident,_) -> + Types.Sig_value (ident,_) -> let n1 = Name.simple v.val_name and n2 = Ident.name ident in n1 = n2 | _ -> false) | Element_type t -> (function - Types.Tsig_type (ident,_,_) -> - (* A VOIR: il est possible que le détail du type soit caché *) + Types.Sig_type (ident,_,_) -> + (* A VOIR: il est possible que le detail du type soit cache *) let n1 = Name.simple t.ty_name and n2 = Ident.name ident in n1 = n2 | _ -> false) | Element_exception e -> (function - Types.Tsig_exception (ident,_) -> + Types.Sig_exception (ident,_) -> let n1 = Name.simple e.ex_name and n2 = Ident.name ident in n1 = n2 | _ -> false) | Element_class c -> (function - Types.Tsig_class (ident,_,_) -> + Types.Sig_class (ident,_,_) -> let n1 = Name.simple c.cl_name and n2 = Ident.name ident in n1 = n2 | _ -> false) | Element_class_type ct -> (function - Types.Tsig_cltype (ident,_,_) -> + Types.Sig_class_type (ident,_,_) -> let n1 = Name.simple ct.clt_name and n2 = Ident.name ident in n1 = n2 @@ -978,7 +1005,7 @@ (** Analysis of a parse tree structure with a typed tree, to return module elements.*) let rec analyse_structure env current_module_name last_pos pos_limit parsetree typedtree = print_DEBUG "Odoc_ast:analyse_struture"; - let (table, table_values) = Typedtree_search.tables typedtree in + let (table, table_values) = Typedtree_search.tables typedtree.str_items in let rec iter env last_pos = function [] -> let s = get_string_of_file last_pos pos_limit in @@ -1051,7 +1078,7 @@ iter new_last_pos acc_env acc q | Some name -> try - let pat_exp = Typedtree_search.search_value table_values name in + let pat_exp = Typedtree_search.search_value table_values name.txt in let (info_opt, ele_comments) = (* we already have the optional comment for the first value. *) if first then @@ -1089,31 +1116,38 @@ let (new_env, l_ele) = iter ~first: true loc.Location.loc_start.Lexing.pos_cnum env [] pat_exp_list in (0, new_env, l_ele) - | Parsetree.Pstr_primitive (name_pre, val_desc) -> - (* of string * value_description *) - print_DEBUG ("Parsetree.Pstr_primitive ("^name_pre^", ["^(String.concat ", " val_desc.Parsetree.pval_prim)^"]"); - let typ = Typedtree_search.search_primitive table name_pre in - let name = Name.parens_if_infix name_pre in - let complete_name = Name.concat current_module_name name in - let new_value = { - val_name = complete_name ; - val_info = comment_opt ; - val_type = Odoc_env.subst_type env typ ; - val_recursive = false ; - val_parameters = [] ; - val_code = Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum loc.Location.loc_end.Lexing.pos_cnum) ; - val_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ; - } - in - let new_env = Odoc_env.add_value env new_value.val_name in - (0, new_env, [Element_value new_value]) + | Parsetree.Pstr_primitive ({ txt = name_pre }, val_desc) -> + (* of string * value_description *) + print_DEBUG ("Parsetree.Pstr_primitive ("^name_pre^", ["^(String.concat ", " val_desc.Parsetree.pval_prim)^"]"); + let typ = Typedtree_search.search_primitive table name_pre in + let name = Name.parens_if_infix name_pre in + let complete_name = Name.concat current_module_name name in + let code = + if !Odoc_global.keep_code then + Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum + loc.Location.loc_end.Lexing.pos_cnum) + else + None + in + let new_value = { + val_name = complete_name ; + val_info = comment_opt ; + val_type = Odoc_env.subst_type env typ ; + val_recursive = false ; + val_parameters = [] ; + val_code = code ; + val_loc = { loc_impl = Some loc ; loc_inter = None } ; + } + in + let new_env = Odoc_env.add_value env new_value.val_name in + (0, new_env, [Element_value new_value]) | Parsetree.Pstr_type name_typedecl_list -> (* of (string * type_declaration) list *) (* we start by extending the environment *) let new_env = List.fold_left - (fun acc_env -> fun (name, _) -> + (fun acc_env -> fun ({ txt = name }, _) -> let complete_name = Name.concat current_module_name name in Odoc_env.add_type acc_env complete_name ) @@ -1123,82 +1157,83 @@ let rec f ?(first=false) maybe_more_acc last_pos name_type_decl_list = match name_type_decl_list with [] -> (maybe_more_acc, []) - | (name, type_decl) :: q -> + | ({ txt = name }, type_decl) :: q -> let complete_name = Name.concat current_module_name name in - let loc_start = type_decl.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum in - let loc_end = type_decl.Parsetree.ptype_loc.Location.loc_end.Lexing.pos_cnum in + let loc = type_decl.Parsetree.ptype_loc in + let loc_start = loc.Location.loc_start.Lexing.pos_cnum in + let loc_end = loc.Location.loc_end.Lexing.pos_cnum in let pos_limit2 = match q with - [] -> pos_limit - | (_, td) :: _ -> td.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum - in - let (maybe_more, name_comment_list) = + [] -> pos_limit + | (_, td) :: _ -> td.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum + in + let (maybe_more, name_comment_list) = Sig.name_comment_from_type_kind - loc_end - pos_limit2 - type_decl.Parsetree.ptype_kind - in - let tt_type_decl = - try Typedtree_search.search_type_declaration table name - with Not_found -> raise (Failure (Odoc_messages.type_not_found_in_typedtree complete_name)) - in - let (com_opt, ele_comments) = (* the comment for the first type was already retrieved *) - if first then - (comment_opt , []) - else - get_comments_in_module last_pos loc_start - in - let kind = Sig.get_type_kind + loc_end + pos_limit2 + type_decl.Parsetree.ptype_kind + in + let tt_type_decl = + try Typedtree_search.search_type_declaration table name + with Not_found -> raise (Failure (Odoc_messages.type_not_found_in_typedtree complete_name)) + in + let tt_type_decl = tt_type_decl.Typedtree.typ_type in + let (com_opt, ele_comments) = (* the comment for the first type was already retrieved *) + if first then + (comment_opt , []) + else + get_comments_in_module last_pos loc_start + in + let kind = Sig.get_type_kind new_env name_comment_list tt_type_decl.Types.type_kind - in - let new_end = loc_end + maybe_more in - let t = - { - ty_name = complete_name ; - ty_info = com_opt ; - ty_parameters = + in + let new_end = loc_end + maybe_more in + let t = + { + ty_name = complete_name ; + ty_info = com_opt ; + ty_parameters = List.map2 - (fun p (co,cn,_) -> - (Odoc_env.subst_type new_env p, - co, cn) - ) - tt_type_decl.Types.type_params - tt_type_decl.Types.type_variance ; - ty_kind = kind ; - ty_private = tt_type_decl.Types.type_private; - ty_manifest = - (match tt_type_decl.Types.type_manifest with - None -> None - | Some t -> Some (Odoc_env.subst_type new_env t)); - ty_loc = { loc_impl = Some (!file_name, loc_start) ; loc_inter = None } ; - ty_code = + (fun p v -> + let (co, cn) = Types.Variance.get_upper v in + (Odoc_env.subst_type new_env p, co, cn)) + tt_type_decl.Types.type_params + tt_type_decl.Types.type_variance ; + ty_kind = kind ; + ty_private = tt_type_decl.Types.type_private; + ty_manifest = + (match tt_type_decl.Types.type_manifest with + None -> None + | Some t -> Some (Odoc_env.subst_type new_env t)); + ty_loc = { loc_impl = Some loc ; loc_inter = None } ; + ty_code = ( - if !Odoc_args.keep_code then + if !Odoc_global.keep_code then Some (get_string_of_file loc_start new_end) else None ) ; - } - in - let (maybe_more2, info_after_opt) = - My_ir.just_after_special + } + in + let (maybe_more2, info_after_opt) = + My_ir.just_after_special !file_name (get_string_of_file new_end pos_limit2) - in - t.ty_info <- Sig.merge_infos t.ty_info info_after_opt ; - let (maybe_more3, eles) = f (maybe_more + maybe_more2) (new_end + maybe_more2) q in - (maybe_more3, ele_comments @ ((Element_type t) :: eles)) - in - let (maybe_more, eles) = f ~first: true 0 loc.Location.loc_start.Lexing.pos_cnum name_typedecl_list in - (maybe_more, new_env, eles) + in + t.ty_info <- Sig.merge_infos t.ty_info info_after_opt ; + let (maybe_more3, eles) = f (maybe_more + maybe_more2) (new_end + maybe_more2) q in + (maybe_more3, ele_comments @ ((Element_type t) :: eles)) + in + let (maybe_more, eles) = f ~first: true 0 loc.Location.loc_start.Lexing.pos_cnum name_typedecl_list in + (maybe_more, new_env, eles) | Parsetree.Pstr_exception (name, excep_decl) -> (* a new exception is defined *) - let complete_name = Name.concat current_module_name name in + let complete_name = Name.concat current_module_name name.txt in (* we get the exception declaration in the typed tree *) let tt_excep_decl = - try Typedtree_search.search_exception table name + try Typedtree_search.search_exception table name.txt with Not_found -> raise (Failure (Odoc_messages.exception_not_found_in_typedtree complete_name)) in @@ -1209,12 +1244,14 @@ { ex_name = complete_name ; ex_info = comment_opt ; - ex_args = List.map (Odoc_env.subst_type new_env) tt_excep_decl ; + ex_args = List.map (fun ctyp -> + Odoc_env.subst_type new_env ctyp.ctyp_type) + tt_excep_decl.exn_params ; ex_alias = None ; - ex_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ; + ex_loc = { loc_impl = Some loc ; loc_inter = None } ; ex_code = ( - if !Odoc_args.keep_code then + if !Odoc_global.keep_code then Some (get_string_of_file loc_start loc_end) else None @@ -1223,12 +1260,12 @@ in (0, new_env, [ Element_exception new_ex ]) - | Parsetree.Pstr_exn_rebind (name, _) -> + | Parsetree.Pstr_exn_rebind (name, _) -> (* a new exception is defined *) - let complete_name = Name.concat current_module_name name in + let complete_name = Name.concat current_module_name name.txt in (* we get the exception rebind in the typed tree *) let tt_path = - try Typedtree_search.search_exception_rebind table name + try Typedtree_search.search_exception_rebind table name.txt with Not_found -> raise (Failure (Odoc_messages.exception_not_found_in_typedtree complete_name)) in @@ -1240,7 +1277,7 @@ ex_args = [] ; ex_alias = Some { ea_name = (Odoc_env.full_exception_name env (Name.from_path tt_path)) ; ea_ex = None ; } ; - ex_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ; + ex_loc = { loc_impl = Some loc ; loc_inter = None } ; ex_code = None ; } in @@ -1250,17 +1287,17 @@ ( (* of string * module_expr *) try - let tt_module_expr = Typedtree_search.search_module table name in + let tt_module_expr = Typedtree_search.search_module table name.txt in let new_module_pre = analyse_module env current_module_name - name + name.txt comment_opt module_expr tt_module_expr in let code = - if !Odoc_args.keep_code then + if !Odoc_global.keep_code then let loc = module_expr.Parsetree.pmod_loc in let st = loc.Location.loc_start.Lexing.pos_cnum in let en = loc.Location.loc_end.Lexing.pos_cnum in @@ -1274,8 +1311,8 @@ let new_env = Odoc_env.add_module env new_module.m_name in let new_env2 = match new_module.m_type with - (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on aurait pas la signature *) - Types.Tmty_signature s -> + (* A VOIR : cela peut-il etre Tmty_ident ? dans ce cas, on aurait pas la signature *) + Types.Mty_signature s -> Odoc_env.add_signature new_env new_module.m_name ~rel: (Name.simple new_module.m_name) s | _ -> @@ -1284,7 +1321,7 @@ (0, new_env2, [ Element_module new_module ]) with Not_found -> - let complete_name = Name.concat current_module_name name in + let complete_name = Name.concat current_module_name name.txt in raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name)) ) @@ -1294,22 +1331,22 @@ let new_env = List.fold_left (fun acc_env (name, _, mod_exp) -> - let complete_name = Name.concat current_module_name name in + let complete_name = Name.concat current_module_name name.txt in let e = Odoc_env.add_module acc_env complete_name in let tt_mod_exp = - try Typedtree_search.search_module table name + try Typedtree_search.search_module table name.txt with Not_found -> raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name)) in let new_module = analyse_module e current_module_name - name + name.txt None mod_exp tt_mod_exp in match new_module.m_type with - Types.Tmty_signature s -> + Types.Mty_signature s -> Odoc_env.add_signature e new_module.m_name ~rel: (Name.simple new_module.m_name) s | _ -> @@ -1322,11 +1359,11 @@ match name_mod_exp_list with [] -> [] | (name, _, mod_exp) :: q -> - let complete_name = Name.concat current_module_name name in + let complete_name = Name.concat current_module_name name.txt in let loc_start = mod_exp.Parsetree.pmod_loc.Location.loc_start.Lexing.pos_cnum in let loc_end = mod_exp.Parsetree.pmod_loc.Location.loc_end.Lexing.pos_cnum in let tt_mod_exp = - try Typedtree_search.search_module table name + try Typedtree_search.search_module table name.txt with Not_found -> raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name)) in let (com_opt, ele_comments) = (* the comment for the first type was already retrieved *) @@ -1338,7 +1375,7 @@ let new_module = analyse_module new_env current_module_name - name + name.txt com_opt mod_exp tt_mod_exp @@ -1350,38 +1387,38 @@ (0, new_env, eles) | Parsetree.Pstr_modtype (name, modtype) -> - let complete_name = Name.concat current_module_name name in + let complete_name = Name.concat current_module_name name.txt in let tt_module_type = - try Typedtree_search.search_module_type table name + try Typedtree_search.search_module_type table name.txt with Not_found -> raise (Failure (Odoc_messages.module_type_not_found_in_typedtree complete_name)) in let kind = Sig.analyse_module_type_kind env complete_name - modtype tt_module_type + modtype tt_module_type.mty_type in let mt = { mt_name = complete_name ; mt_info = comment_opt ; - mt_type = Some tt_module_type ; + mt_type = Some tt_module_type.mty_type ; mt_is_interface = false ; mt_file = !file_name ; mt_kind = Some kind ; - mt_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ; + mt_loc = { loc_impl = Some loc ; loc_inter = None } ; } in let new_env = Odoc_env.add_module_type env mt.mt_name in let new_env2 = - match tt_module_type with - (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on n'aurait pas la signature *) - Types.Tmty_signature s -> + match tt_module_type.mty_type with + (* A VOIR : cela peut-il etre Tmty_ident ? dans ce cas, on n'aurait pas la signature *) + Types.Mty_signature s -> Odoc_env.add_signature new_env mt.mt_name ~rel: (Name.simple mt.mt_name) s | _ -> new_env in (0, new_env2, [ Element_module_type mt ]) - | Parsetree.Pstr_open longident -> + | Parsetree.Pstr_open (_, longident) -> (* A VOIR : enrichir l'environnement quand open ? *) let ele_comments = match comment_opt with None -> [] @@ -1397,7 +1434,7 @@ let new_env = List.fold_left (fun acc_env -> fun class_decl -> - let complete_name = Name.concat current_module_name class_decl.Parsetree.pci_name in + let complete_name = Name.concat current_module_name class_decl.Parsetree.pci_name.txt in Odoc_env.add_class acc_env complete_name ) env @@ -1409,9 +1446,9 @@ [] | class_decl :: q -> let (tt_class_exp, tt_type_params) = - try Typedtree_search.search_class_exp table class_decl.Parsetree.pci_name + try Typedtree_search.search_class_exp table class_decl.Parsetree.pci_name.txt with Not_found -> - let complete_name = Name.concat current_module_name class_decl.Parsetree.pci_name in + let complete_name = Name.concat current_module_name class_decl.Parsetree.pci_name.txt in raise (Failure (Odoc_messages.class_not_found_in_typedtree complete_name)) in let (com_opt, ele_comments) = @@ -1439,7 +1476,7 @@ let new_env = List.fold_left (fun acc_env -> fun class_type_decl -> - let complete_name = Name.concat current_module_name class_type_decl.Parsetree.pci_name in + let complete_name = Name.concat current_module_name class_type_decl.Parsetree.pci_name.txt in Odoc_env.add_class_type acc_env complete_name ) env @@ -1451,13 +1488,14 @@ [] | class_type_decl :: q -> let name = class_type_decl.Parsetree.pci_name in - let complete_name = Name.concat current_module_name name in + let complete_name = Name.concat current_module_name name.txt in let virt = class_type_decl.Parsetree.pci_virt = Asttypes.Virtual in let tt_cltype_declaration = - try Typedtree_search.search_class_type_declaration table name + try Typedtree_search.search_class_type_declaration table name.txt with Not_found -> raise (Failure (Odoc_messages.class_type_not_found_in_typedtree complete_name)) - in + in + let tt_cltype_declaration = tt_cltype_declaration.ci_type_decl in let type_params = tt_cltype_declaration.Types.clty_params in let kind = Sig.analyse_class_type_kind new_env @@ -1482,7 +1520,7 @@ clt_type_parameters = List.map (Odoc_env.subst_type new_env) type_params ; clt_virtual = virt ; clt_kind = kind ; - clt_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; + clt_loc = { loc_impl = Some loc ; loc_inter = None } ; } in @@ -1501,13 +1539,14 @@ im_info = comment_opt ; } in - (0, env, [ Element_included_module im ]) (* A VOIR : étendre l'environnement ? avec quoi ? *) + (0, env, [ Element_included_module im ]) (* A VOIR : etendre l'environnement ? avec quoi ? *) (** Analysis of a [Parsetree.module_expr] and a name to return a [t_module].*) and analyse_module env current_module_name module_name comment_opt p_module_expr tt_module_expr = let complete_name = Name.concat current_module_name module_name in - let pos_start = p_module_expr.Parsetree.pmod_loc.Location.loc_start.Lexing.pos_cnum in - let pos_end = p_module_expr.Parsetree.pmod_loc.Location.loc_end.Lexing.pos_cnum in + let loc = p_module_expr.Parsetree.pmod_loc in + let pos_start = loc.Location.loc_start.Lexing.pos_cnum in + let pos_end = loc.Location.loc_end.Lexing.pos_cnum in let modtype = (* A VOIR : Odoc_env.subst_module_type env ? *) tt_module_expr.Typedtree.mod_type @@ -1529,7 +1568,7 @@ m_is_interface = false ; m_file = !file_name ; m_kind = Module_struct [] ; - m_loc = { loc_impl = Some (!file_name, pos_start) ; loc_inter = None } ; + m_loc = { loc_impl = Some loc ; loc_inter = None } ; m_top_deps = [] ; m_code = None ; (* code is set by the caller, after the module is created *) m_code_intf = m_code_intf ; @@ -1537,7 +1576,7 @@ } in match (p_module_expr.Parsetree.pmod_desc, tt_module_expr.Typedtree.mod_desc) with - (Parsetree.Pmod_ident longident, Typedtree.Tmod_ident path) -> + (Parsetree.Pmod_ident longident, Typedtree.Tmod_ident (path, _)) -> let alias_name = Odoc_env.full_module_name env (Name.from_path path) in { m_base with m_kind = Module_alias { ma_name = alias_name ; ma_module = None ; } } @@ -1550,19 +1589,19 @@ { m_base with m_kind = Module_struct elements2 } | (Parsetree.Pmod_functor (_, pmodule_type, p_module_expr2), - Typedtree.Tmod_functor (ident, mtyp, tt_module_expr2)) -> + Typedtree.Tmod_functor (ident, _, mtyp, tt_module_expr2)) -> let loc_start = pmodule_type.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in let loc_end = pmodule_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in let mp_type_code = get_string_of_file loc_start loc_end in print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code); let mp_name = Name.from_ident ident in let mp_kind = Sig.analyse_module_type_kind env - current_module_name pmodule_type mtyp + current_module_name pmodule_type mtyp.mty_type in let param = { mp_name = mp_name ; - mp_type = Odoc_env.subst_module_type env mtyp ; + mp_type = Odoc_env.subst_module_type env mtyp.mty_type ; mp_type_code = mp_type_code ; mp_kind = mp_kind ; } @@ -1585,7 +1624,7 @@ Typedtree.Tmod_apply (tt_module_expr1, tt_module_expr2, _)) | (Parsetree.Pmod_apply (p_module_expr1, p_module_expr2), Typedtree.Tmod_constraint - ({ Typedtree.mod_desc = Typedtree.Tmod_apply (tt_module_expr1, tt_module_expr2, _)}, + ({ Typedtree.mod_desc = Typedtree.Tmod_apply (tt_module_expr1, tt_module_expr2, _)}, _, _, _) ) -> let m1 = analyse_module @@ -1607,7 +1646,7 @@ { m_base with m_kind = Module_apply (m1.m_kind, m2.m_kind) } | (Parsetree.Pmod_constraint (p_module_expr2, p_modtype), - Typedtree.Tmod_constraint (tt_module_expr2, tt_modtype, _)) -> + Typedtree.Tmod_constraint (tt_module_expr2, tt_modtype, _, _)) -> print_DEBUG ("Odoc_ast: case Parsetree.Pmod_constraint + Typedtree.Tmod_constraint "^module_name); let m_base2 = analyse_module env @@ -1622,7 +1661,7 @@ p_modtype tt_modtype in let tt_modtype = Odoc_env.subst_module_type env tt_modtype in - if !Odoc_args.filter_with_module_constraints then + if !Odoc_global.filter_with_module_constraints then filter_module_with_module_type_constraint m_base2 tt_modtype; { m_base with @@ -1633,7 +1672,7 @@ | (Parsetree.Pmod_structure p_structure, Typedtree.Tmod_constraint ({ Typedtree.mod_desc = Typedtree.Tmod_structure tt_structure}, - tt_modtype, _) + tt_modtype, _, _) ) -> (* needed for recursive modules *) @@ -1647,7 +1686,7 @@ m_kind = Module_struct elements2 ; } - | (Parsetree.Pmod_unpack (p_exp, pkg_type), + | (Parsetree.Pmod_unpack p_exp, Typedtree.Tmod_unpack (t_exp, tt_modtype)) -> print_DEBUG ("Odoc_ast: case Parsetree.Pmod_unpack + Typedtree.Tmod_unpack "^module_name); let code = @@ -1658,7 +1697,13 @@ let s = get_string_of_file exp_loc_end loc_end in Printf.sprintf "(val ...%s" s in - let name = Odoc_env.full_module_type_name env (Name.from_longident (fst pkg_type)) in + (* let name = Odoc_env.full_module_type_name env (Name.from_path (fst pkg_type)) in *) + let name = + match tt_modtype with + | Mty_ident p -> + Odoc_env.full_module_type_name env (Name.from_path p) + | _ -> "" + in let alias = { mta_name = name ; mta_module = None } in { m_base with m_type = Odoc_env.subst_module_type env tt_modtype ; @@ -1718,14 +1763,14 @@ let kind = Module_struct elements2 in { m_name = mod_name ; - m_type = Types.Tmty_signature [] ; + m_type = Types.Mty_signature [] ; m_info = info_opt ; m_is_interface = false ; m_file = !file_name ; m_kind = kind ; - m_loc = { loc_impl = Some (!file_name, 0) ; loc_inter = None } ; + m_loc = { loc_impl = Some (Location.in_file !file_name) ; loc_inter = None } ; m_top_deps = [] ; - m_code = (if !Odoc_args.keep_code then Some !file else None) ; + m_code = (if !Odoc_global.keep_code then Some !file else None) ; m_code_intf = None ; m_text_only = false ; } diff -Nru ocaml-3.12.1/ocamldoc/odoc_ast.mli ocaml-4.01.0/ocamldoc/odoc_ast.mli --- ocaml-3.12.1/ocamldoc/odoc_ast.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_ast.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_ast.mli 9547 2010-01-22 12:48:24Z doligez $ *) - (** The module for analysing the typed abstract syntax tree and source code and creating modules, classes, ..., elements.*) type typedtree = Typedtree.structure * Typedtree.module_coercion @@ -20,7 +19,7 @@ sig type ele - type tab = (ele, Typedtree.structure_item) Hashtbl.t + type tab = (ele, Typedtree.structure_item_desc) Hashtbl.t type tab_values = (Odoc_name.t, Typedtree.pattern * Typedtree.expression) Hashtbl.t (** Create hash tables used to search by some of the functions below. *) @@ -34,12 +33,12 @@ (** This function returns the [Types.module_type] associated to the given module type name, in the given table. @raise Not_found if the module type was not found.*) - val search_module_type : tab -> string -> Types.module_type + val search_module_type : tab -> string -> Typedtree.module_type (** This function returns the [Types.exception_declaration] associated to the given exception name, in the given table. @raise Not_found if the exception was not found.*) - val search_exception : tab -> string -> Types.exception_declaration + val search_exception : tab -> string -> Typedtree.exception_declaration (** This function returns the [Path.t] associated to the given exception rebind name, in the table. @@ -49,7 +48,7 @@ (** This function returns the [Typedtree.type_declaration] associated to the given type name, in the given table. @raise Not_found if the type was not found. *) - val search_type_declaration : tab -> string -> Types.type_declaration + val search_type_declaration : tab -> string -> Typedtree.type_declaration (** This function returns the [Typedtree.class_expr] and type parameters associated to the given class name, in the given table. @@ -59,7 +58,7 @@ (** This function returns the [Types.cltype_declaration] associated to the given class type name, in the given table. @raise Not_found if the class type was not found. *) - val search_class_type_declaration : tab -> string -> Types.cltype_declaration + val search_class_type_declaration : tab -> string -> Typedtree.class_type_declaration (** This function returns the couple (pat, exp) for the given value name, in the given table of values. diff -Nru ocaml-3.12.1/ocamldoc/odoc_class.ml ocaml-4.01.0/ocamldoc/odoc_class.ml --- ocaml-3.12.1/ocamldoc/odoc_class.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_class.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_class.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (** Representation and manipulation of classes and class types.*) module Name = Odoc_name @@ -115,7 +114,7 @@ | Class_constraint (c_kind, ct_kind) -> iter_kind c_kind (* A VOIR : utiliser le c_kind ou le ct_kind ? - Pour l'instant, comme le ct_kind n'est pas analysé, + Pour l'instant, comme le ct_kind n'est pas analyse, on cherche dans le c_kind class_type_elements ~trans: trans { clt_name = "" ; clt_info = None ; @@ -248,6 +247,3 @@ with Not_found -> None - - -(* eof $Id: odoc_class.ml 9547 2010-01-22 12:48:24Z doligez $ *) diff -Nru ocaml-3.12.1/ocamldoc/odoc_comments.ml ocaml-4.01.0/ocamldoc/odoc_comments.ml --- ocaml-3.12.1/ocamldoc/odoc_comments.ml 2010-05-31 11:52:13.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_comments.ml 2013-08-05 07:42:13.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_comments.ml 10480 2010-05-31 11:52:13Z guesdon $ *) - (** Analysis of comments. *) open Odoc_types @@ -38,7 +37,7 @@ | Odoc_text.Text_syntax (l, c, s) -> raise (Failure (Odoc_messages.text_parse_error l c s)) | _ -> - raise (Failure ("Erreur inconnue lors du parse de see : "^s)) + raise (Failure ("Unknown error while parsing @see tag: "^s)) let retrieve_info fun_lex file (s : string) = try @@ -91,7 +90,7 @@ with Failure s -> incr Odoc_global.errors ; - prerr_endline (file^" : "^s^"\n"); + Printf.eprintf "File %S, line %d:\n%s\n%!" file (!Odoc_lexer.line_number + 1) s; (0, None) | Odoc_text.Text_syntax (l, c, s) -> incr Odoc_global.errors ; @@ -181,7 +180,7 @@ | (len, Some d) -> (* we check if the comment we got was really attached to the constructor, i.e. that there was no blank line or any special comment "(**" before *) - if (not strict) or (nothing_before_simple_comment s) then + if (not strict) || (nothing_before_simple_comment s) then (* ok, we attach the comment to the constructor *) (len, Some d) else @@ -261,7 +260,7 @@ (* if the special comment is the stop comment (**/**), then we must not associate it. *) let pos = Str.search_forward (Str.regexp_string "(**") s 0 in - if blank_line (String.sub s 0 pos) or + if blank_line (String.sub s 0 pos) || d.Odoc_types.i_desc = Some [Odoc_types.Raw "/*"] then (0, None) @@ -294,7 +293,7 @@ | h :: q -> if (blank_line_outside_simple file (String.sub s len ((String.length s) - len)) ) - or h.Odoc_types.i_desc = Some [Odoc_types.Raw "/*"] + || h.Odoc_types.i_desc = Some [Odoc_types.Raw "/*"] then (None, special_coms) else diff -Nru ocaml-3.12.1/ocamldoc/odoc_comments.mli ocaml-4.01.0/ocamldoc/odoc_comments.mli --- ocaml-3.12.1/ocamldoc/odoc_comments.mli 2006-09-20 11:14:37.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_comments.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_comments.mli 7619 2006-09-20 11:14:37Z doligez $ *) - (** Analysis of comments. *) val simple_blank : string diff -Nru ocaml-3.12.1/ocamldoc/odoc_comments_global.ml ocaml-4.01.0/ocamldoc/odoc_comments_global.ml --- ocaml-3.12.1/ocamldoc/odoc_comments_global.ml 2010-05-31 11:52:13.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_comments_global.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_comments_global.ml 10480 2010-05-31 11:52:13Z guesdon $ *) - (** The global variables used by the special comment parser.*) let nb_chars = ref 0 @@ -47,5 +46,3 @@ raised_exceptions := []; return_value := None ; customs := [] - -(* eof $Id: odoc_comments_global.ml 10480 2010-05-31 11:52:13Z guesdon $ *) diff -Nru ocaml-3.12.1/ocamldoc/odoc_comments_global.mli ocaml-4.01.0/ocamldoc/odoc_comments_global.mli --- ocaml-3.12.1/ocamldoc/odoc_comments_global.mli 2010-05-31 11:52:13.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_comments_global.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_comments_global.mli 10480 2010-05-31 11:52:13Z guesdon $ *) - (** The global variables used by the special comment parser.*) (** the number of chars used in the lexer. *) diff -Nru ocaml-3.12.1/ocamldoc/odoc_config.ml ocaml-4.01.0/ocamldoc/odoc_config.ml --- ocaml-3.12.1/ocamldoc/odoc_config.ml 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_config.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_config.ml 8416 2007-10-08 14:19:34Z doligez $ *) - let custom_generators_path = Filename.concat Config.standard_library (Filename.concat "ocamldoc" "custom") diff -Nru ocaml-3.12.1/ocamldoc/odoc_config.mli ocaml-4.01.0/ocamldoc/odoc_config.mli --- ocaml-3.12.1/ocamldoc/odoc_config.mli 2007-10-08 14:19:34.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_config.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_config.mli 8416 2007-10-08 14:19:34Z doligez $ *) - (** Ocamldoc configuration contants. *) (** Default path to search for custom generators and to install them. *) diff -Nru ocaml-3.12.1/ocamldoc/odoc_control.ml ocaml-4.01.0/ocamldoc/odoc_control.ml --- ocaml-3.12.1/ocamldoc/odoc_control.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_control.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -8,5 +9,3 @@ (* under the terms of the Q Public License version 1.0. *) (* *) (***********************************************************************) - -(* $Id: odoc_control.ml 9547 2010-01-22 12:48:24Z doligez $ *) diff -Nru ocaml-3.12.1/ocamldoc/odoc_cross.ml ocaml-4.01.0/ocamldoc/odoc_cross.ml --- ocaml-3.12.1/ocamldoc/odoc_cross.ml 2010-06-14 11:13:29.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_cross.ml 2013-05-28 11:04:11.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_cross.ml 10565 2010-06-14 11:13:29Z guesdon $ *) - (** Cross referencing. *) module Name = Odoc_name @@ -58,7 +57,9 @@ let p_class c _ = (false, false) let p_class_type ct _ = (false, false) let p_value v _ = false - let p_type t _ = false + let p_recfield _ _ _ = false + let p_const _ _ _ = false + let p_type t _ = (false, false) let p_exception e _ = e.ex_alias <> None let p_attribute a _ = false let p_method m _ = false @@ -154,7 +155,7 @@ module Map_ord = struct type t = string - let compare = Pervasives.compare + let compare (x:t) y = Pervasives.compare x y end module Ele_map = Map.Make (Map_ord) @@ -178,7 +179,7 @@ match kind with RK_module -> (fun e -> match e with Odoc_search.Res_module _ -> true | _ -> false) | RK_module_type -> (fun e -> match e with Odoc_search.Res_module_type _ -> true | _ -> false) - | RK_class -> (fun e -> match e with Odoc_search.Res_class_type _ -> true | _ -> false) + | RK_class -> (fun e -> match e with Odoc_search.Res_class _ -> true | _ -> false) | RK_class_type -> (fun e -> match e with Odoc_search.Res_class_type _ -> true | _ -> false) | RK_value -> (fun e -> match e with Odoc_search.Res_value _ -> true | _ -> false) | RK_type -> (fun e -> match e with Odoc_search.Res_type _ -> true | _ -> false) @@ -186,6 +187,8 @@ | RK_attribute -> (fun e -> match e with Odoc_search.Res_attribute _ -> true | _ -> false) | RK_method -> (fun e -> match e with Odoc_search.Res_method _ -> true | _ -> false) | RK_section _ -> assert false + | RK_recfield -> (fun e -> match e with Odoc_search.Res_recfield _ -> true | _ -> false) + | RK_const -> (fun e -> match e with Odoc_search.Res_const _ -> true | _ -> false) in fun name -> try List.exists pred (get_known_elements name) @@ -200,6 +203,8 @@ let exception_exists = kind_name_exists RK_exception let attribute_exists = kind_name_exists RK_attribute let method_exists = kind_name_exists RK_method +let recfield_exists = kind_name_exists RK_recfield +let const_exists = kind_name_exists RK_const let lookup_module name = match List.find @@ -246,8 +251,17 @@ inherit Odoc_scan.scanner method! scan_value v = add_known_element v.val_name (Odoc_search.Res_value v) - method! scan_type t = - add_known_element t.ty_name (Odoc_search.Res_type t) + method! scan_type_recfield t f = + add_known_element + (Printf.sprintf "%s.%s" t.ty_name f.rf_name) + (Odoc_search.Res_recfield (t, f)) + method! scan_type_const t f = + add_known_element + (Printf.sprintf "%s.%s" t.ty_name f.vc_name) + (Odoc_search.Res_const (t, f)) + method! scan_type_pre t = + add_known_element t.ty_name (Odoc_search.Res_type t); + true method! scan_exception e = add_known_element e.ex_name (Odoc_search.Res_exception e) method! scan_attribute a = @@ -313,7 +327,7 @@ None -> (acc_b, (Name.head m.m_name) :: acc_inc, (* we don't want to output warning messages for "sig ... end" or "struct ... end" modules not found *) - (if ma.ma_name = Odoc_messages.struct_end or + (if ma.ma_name = Odoc_messages.struct_end || ma.ma_name = Odoc_messages.sig_end then acc_names else @@ -361,7 +375,7 @@ None -> (acc_b, (Name.head m.m_name) :: acc_inc, (* we don't want to output warning messages for "sig ... end" or "struct ... end" modules not found *) - (if mta.mta_name = Odoc_messages.struct_end or + (if mta.mta_name = Odoc_messages.struct_end || mta.mta_name = Odoc_messages.sig_end then acc_names else @@ -403,7 +417,7 @@ None -> (acc_b, (Name.head mt.mt_name) :: acc_inc, (* we don't want to output warning messages for "sig ... end" or "struct ... end" modules not found *) - (if mta.mta_name = Odoc_messages.struct_end or + (if mta.mta_name = Odoc_messages.struct_end || mta.mta_name = Odoc_messages.sig_end then acc_names else @@ -439,7 +453,7 @@ None -> (acc_b_modif, (Name.head m_name) :: acc_incomplete_top_module_names, (* we don't want to output warning messages for "sig ... end" or "struct ... end" modules not found *) - (if im.im_name = Odoc_messages.struct_end or + (if im.im_name = Odoc_messages.struct_end || im.im_name = Odoc_messages.sig_end then acc_names_not_found else @@ -620,6 +634,8 @@ | RK_attribute -> Odoc_messages.cross_attribute_not_found | RK_method -> Odoc_messages.cross_method_not_found | RK_section _ -> Odoc_messages.cross_section_not_found + | RK_recfield -> Odoc_messages.cross_recfield_not_found + | RK_const -> Odoc_messages.cross_const_not_found ) name let rec assoc_comments_text_elements parent_name module_list t_ele = @@ -675,6 +691,10 @@ | Odoc_search.Res_attribute a -> (a.att_value.val_name, RK_attribute) | Odoc_search.Res_method m -> (m.met_value.val_name, RK_method) | Odoc_search.Res_section (_ ,t)-> assert false + | Odoc_search.Res_recfield (t, f) -> + (Printf.sprintf "%s.%s" t.ty_name f.rf_name, RK_recfield) + | Odoc_search.Res_const (t, f) -> + (Printf.sprintf "%s.%s" t.ty_name f.vc_name, RK_const) in add_verified (name, Some kind) ; (name, Some kind) @@ -684,7 +704,7 @@ | (_, None) -> match parent_name with None -> - Odoc_messages.pwarning (Odoc_messages.cross_element_not_found initial_name); + Odoc_global.pwarning (Odoc_messages.cross_element_not_found initial_name); Ref (initial_name, None, text_option) | Some p -> let parent_name = @@ -731,6 +751,8 @@ | RK_attribute -> attribute_exists | RK_method -> method_exists | RK_section _ -> assert false + | RK_recfield -> recfield_exists + | RK_const -> const_exists in if f name then ( @@ -745,7 +767,7 @@ | (_, None) -> match parent_name with None -> - Odoc_messages.pwarning (not_found_of_kind kind initial_name); + Odoc_global.pwarning (not_found_of_kind kind initial_name); Ref (initial_name, None, text_option) | Some p -> let parent_name = @@ -987,7 +1009,7 @@ | l -> List.iter (fun nf -> - Odoc_messages.pwarning + Odoc_global.pwarning ( match nf with NF_m n -> Odoc_messages.cross_module_not_found n diff -Nru ocaml-3.12.1/ocamldoc/odoc_cross.mli ocaml-4.01.0/ocamldoc/odoc_cross.mli --- ocaml-3.12.1/ocamldoc/odoc_cross.mli 2006-09-20 11:14:37.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_cross.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_cross.mli 7619 2006-09-20 11:14:37Z doligez $ *) - (** Cross-referencing. *) val associate : Odoc_module.t_module list -> unit diff -Nru ocaml-3.12.1/ocamldoc/odoc_dag2html.ml ocaml-4.01.0/ocamldoc/odoc_dag2html.ml --- ocaml-3.12.1/ocamldoc/odoc_dag2html.ml 2004-12-03 14:42:09.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_dag2html.ml 2013-03-19 07:22:12.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_dag2html.ml 6723 2004-12-03 14:42:09Z guesdon $ *) - (** The types and functions to create a html table representing a dag. Thanks to Daniel De Rauglaudre. *) type 'a dag = { mutable dag : 'a node array } @@ -349,7 +348,7 @@ ;; let group_by_common_children d list = - let module O = struct type t = idag;; let compare = compare;; end + let module O = struct type t = idag;; let compare (x:t) y = compare x y;; end in let module S = Set.Make (O) in @@ -605,7 +604,7 @@ if A and B have common children *) let group_span_by_common_children d t = - let module O = struct type t = idag;; let compare = compare;; end + let module O = struct type t = idag;; let compare (x:t) y = compare x y;; end in let module S = Set.Make (O) in diff -Nru ocaml-3.12.1/ocamldoc/odoc_dag2html.mli ocaml-4.01.0/ocamldoc/odoc_dag2html.mli --- ocaml-3.12.1/ocamldoc/odoc_dag2html.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_dag2html.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_dag2html.mli 9547 2010-01-22 12:48:24Z doligez $ *) - (** The types and functions to create a html table representing a dag. Thanks to Daniel de Rauglaudre. *) diff -Nru ocaml-3.12.1/ocamldoc/odoc_dep.ml ocaml-4.01.0/ocamldoc/odoc_dep.ml --- ocaml-3.12.1/ocamldoc/odoc_dep.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_dep.ml 2013-03-19 07:22:12.000000000 +0000 @@ -1,5 +1,6 @@ (***********************************************************************) -(* OCamldoc *) +(* *) +(* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) (* *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_dep.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (** Top modules dependencies. *) module StrS = Depend.StringSet @@ -37,7 +36,10 @@ struct type id = string - module S = Set.Make (struct type t = string let compare = compare end) + module S = Set.Make (struct + type t = string + let compare (x:t) y = compare x y + end) let set_to_list s = let l = ref [] in diff -Nru ocaml-3.12.1/ocamldoc/odoc_dot.ml ocaml-4.01.0/ocamldoc/odoc_dot.ml --- ocaml-3.12.1/ocamldoc/odoc_dot.ml 2006-09-20 11:14:37.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_dot.ml 2013-05-28 11:04:11.000000000 +0000 @@ -1,5 +1,6 @@ (***********************************************************************) -(* Ocamldoc *) +(* *) +(* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) (* *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_dot.ml 7619 2006-09-20 11:14:37Z doligez $ *) - (** Definition of a class which outputs a dot file showing top modules dependencies.*) @@ -18,6 +17,17 @@ module F = Format +let dot_include_all = ref false + +let dot_types = ref false + +let dot_reduce = ref false + +let dot_colors = ref (List.flatten Odoc_messages.default_dot_colors) + +module Generator = +struct + (** This class generates a dot file showing the top modules dependencies. *) class dot = object (self) @@ -29,7 +39,7 @@ val mutable modules = [] (** Colors to use when finding new locations of modules. *) - val mutable colors = !Args.dot_colors + val mutable colors = !dot_colors (** Graph header. *) method header = @@ -73,7 +83,7 @@ method generate_for_module fmt m = let l = List.filter (fun n -> - !Args.dot_include_all or + !dot_include_all || (List.exists (fun m -> m.Module.m_name = n) modules)) m.Module.m_top_deps in @@ -88,11 +98,11 @@ method generate_types types = try - let oc = open_out !Args.out_file in + let oc = open_out !Global.out_file in let fmt = F.formatter_of_out_channel oc in F.fprintf fmt "%s" self#header; let graph = Odoc_info.Dep.deps_of_types - ~kernel: !Args.dot_reduce + ~kernel: !dot_reduce types in List.iter (self#generate_for_type fmt) graph; @@ -106,11 +116,11 @@ method generate_modules modules_list = try modules <- modules_list ; - let oc = open_out !Args.out_file in + let oc = open_out !Global.out_file in let fmt = F.formatter_of_out_channel oc in F.fprintf fmt "%s" self#header; - if !Args.dot_reduce then + if !dot_reduce then Odoc_info.Dep.kernel_deps_of_modules modules_list; List.iter (self#generate_for_module fmt) modules_list; @@ -123,9 +133,12 @@ (** Generate the dot code in the file {!Odoc_info.Args.out_file}. *) method generate (modules_list : Odoc_info.Module.t_module list) = - colors <- !Args.dot_colors; - if !Args.dot_types then + colors <- !dot_colors; + if !dot_types then self#generate_types (Odoc_info.Search.types modules_list) else self#generate_modules modules_list end +end + +module type Dot_generator = module type of Generator diff -Nru ocaml-3.12.1/ocamldoc/odoc_env.ml ocaml-4.01.0/ocamldoc/odoc_env.ml --- ocaml-3.12.1/ocamldoc/odoc_env.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_env.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_env.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (** Environment for finding complete names from relative names. *) let print_DEBUG s = print_string s ; print_newline ();; @@ -51,30 +50,30 @@ in let f env item = match item with - Types.Tsig_value (ident, _) -> { env with env_values = (rel_name ident, qualify ident) :: env.env_values } - | Types.Tsig_type (ident,_,_) -> { env with env_types = (rel_name ident, qualify ident) :: env.env_types } - | Types.Tsig_exception (ident, _) -> { env with env_exceptions = (rel_name ident, qualify ident) :: env.env_exceptions } - | Types.Tsig_module (ident, modtype, _) -> + Types.Sig_value (ident, _) -> { env with env_values = (rel_name ident, qualify ident) :: env.env_values } + | Types.Sig_type (ident,_,_) -> { env with env_types = (rel_name ident, qualify ident) :: env.env_types } + | Types.Sig_exception (ident, _) -> { env with env_exceptions = (rel_name ident, qualify ident) :: env.env_exceptions } + | Types.Sig_module (ident, modtype, _) -> let env2 = - match modtype with (* A VOIR : le cas où c'est un identificateur, dans ce cas on n'a pas de signature *) - Types.Tmty_signature s -> add_signature env (qualify ident) ~rel: (rel_name ident) s + match modtype with (* A VOIR : le cas ou c'est un identificateur, dans ce cas on n'a pas de signature *) + Types.Mty_signature s -> add_signature env (qualify ident) ~rel: (rel_name ident) s | _ -> env in { env2 with env_modules = (rel_name ident, qualify ident) :: env2.env_modules } - | Types.Tsig_modtype (ident, modtype_decl) -> + | Types.Sig_modtype (ident, modtype_decl) -> let env2 = match modtype_decl with - Types.Tmodtype_abstract -> + Types.Modtype_abstract -> env - | Types.Tmodtype_manifest modtype -> + | Types.Modtype_manifest modtype -> match modtype with - (* A VOIR : le cas où c'est un identificateur, dans ce cas on n'a pas de signature *) - Types.Tmty_signature s -> add_signature env (qualify ident) ~rel: (rel_name ident) s + (* A VOIR : le cas ou c'est un identificateur, dans ce cas on n'a pas de signature *) + Types.Mty_signature s -> add_signature env (qualify ident) ~rel: (rel_name ident) s | _ -> env in { env2 with env_module_types = (rel_name ident, qualify ident) :: env2.env_module_types } - | Types.Tsig_class (ident, _, _) -> { env with env_classes = (rel_name ident, qualify ident) :: env.env_classes } - | Types.Tsig_cltype (ident, _, _) -> { env with env_class_types = (rel_name ident, qualify ident) :: env.env_class_types } + | Types.Sig_class (ident, _, _) -> { env with env_classes = (rel_name ident, qualify ident) :: env.env_classes } + | Types.Sig_class_type (ident, _, _) -> { env with env_class_types = (rel_name ident, qualify ident) :: env.env_class_types } in List.fold_left f env signat @@ -218,32 +217,30 @@ let subst_module_type env t = let rec iter t = match t with - Types.Tmty_ident p -> + Types.Mty_ident p -> let new_p = Odoc_name.to_path (full_module_type_name env (Odoc_name.from_path p)) in - Types.Tmty_ident new_p - | Types.Tmty_signature _ -> + Types.Mty_ident new_p + | Types.Mty_signature _ -> t - | Types.Tmty_functor (id, mt1, mt2) -> - Types.Tmty_functor (id, iter mt1, iter mt2) + | Types.Mty_functor (id, mt1, mt2) -> + Types.Mty_functor (id, iter mt1, iter mt2) in iter t let subst_class_type env t = let rec iter t = match t with - Types.Tcty_constr (p,texp_list,ct) -> + Types.Cty_constr (p,texp_list,ct) -> let new_p = Odoc_name.to_path (full_type_name env (Odoc_name.from_path p)) in let new_texp_list = List.map (subst_type env) texp_list in let new_ct = iter ct in - Types.Tcty_constr (new_p, new_texp_list, new_ct) - | Types.Tcty_signature cs -> + Types.Cty_constr (new_p, new_texp_list, new_ct) + | Types.Cty_signature cs -> (* on ne s'occupe pas des vals et methods *) t - | Types.Tcty_fun (l, texp, ct) -> + | Types.Cty_fun (l, texp, ct) -> let new_texp = subst_type env texp in let new_ct = iter ct in - Types.Tcty_fun (l, new_texp, new_ct) + Types.Cty_fun (l, new_texp, new_ct) in iter t - -(* eof $Id: odoc_env.ml 9547 2010-01-22 12:48:24Z doligez $ *) diff -Nru ocaml-3.12.1/ocamldoc/odoc_env.mli ocaml-4.01.0/ocamldoc/odoc_env.mli --- ocaml-3.12.1/ocamldoc/odoc_env.mli 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_env.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_env.mli 9547 2010-01-22 12:48:24Z doligez $ *) - (** Environment for finding complete names from relative names. *) (** An environment of known names, diff -Nru ocaml-3.12.1/ocamldoc/odoc_exception.ml ocaml-4.01.0/ocamldoc/odoc_exception.ml --- ocaml-3.12.1/ocamldoc/odoc_exception.ml 2010-01-22 12:48:24.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_exception.ml 2012-10-15 17:50:56.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_exception.ml 9547 2010-01-22 12:48:24Z doligez $ *) - (** Representation and manipulation of exceptions. *) module Name = Odoc_name diff -Nru ocaml-3.12.1/ocamldoc/odoc_gen.ml ocaml-4.01.0/ocamldoc/odoc_gen.ml --- ocaml-3.12.1/ocamldoc/odoc_gen.ml 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_gen.ml 2012-08-01 12:09:31.000000000 +0000 @@ -0,0 +1,61 @@ +(***********************************************************************) +(* *) +(* OCamldoc *) +(* *) +(* Maxence Guesdon, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2010 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +(** *) + +class type doc_generator = + object method generate : Odoc_module.t_module list -> unit end;; + +module type Base = sig + class generator : doc_generator + end;; + +module Base_generator : Base = struct + class generator : doc_generator = object method generate l = () end + end;; + +module type Base_functor = functor (G: Base) -> Base +module type Html_functor = functor (G: Odoc_html.Html_generator) -> Odoc_html.Html_generator +module type Latex_functor = functor (G: Odoc_latex.Latex_generator) -> Odoc_latex.Latex_generator +module type Texi_functor = functor (G: Odoc_texi.Texi_generator) -> Odoc_texi.Texi_generator +module type Man_functor = functor (G: Odoc_man.Man_generator) -> Odoc_man.Man_generator +module type Dot_functor = functor (G: Odoc_dot.Dot_generator) -> Odoc_dot.Dot_generator + +type generator = + | Html of (module Odoc_html.Html_generator) + | Latex of (module Odoc_latex.Latex_generator) + | Texi of (module Odoc_texi.Texi_generator) + | Man of (module Odoc_man.Man_generator) + | Dot of (module Odoc_dot.Dot_generator) + | Base of (module Base) +;; + +let get_minimal_generator = function + Html m -> + let module M = (val m : Odoc_html.Html_generator) in + (new M.html :> doc_generator) +| Latex m -> + let module M = (val m : Odoc_latex.Latex_generator) in + (new M.latex :> doc_generator) +| Man m -> + let module M = (val m : Odoc_man.Man_generator) in + (new M.man :> doc_generator) +| Texi m -> + let module M = (val m : Odoc_texi.Texi_generator) in + (new M.texi :> doc_generator) +| Dot m -> + let module M = (val m : Odoc_dot.Dot_generator) in + (new M.dot :> doc_generator) +| Base m -> + let module M = (val m : Base) in + new M.generator + ;; diff -Nru ocaml-3.12.1/ocamldoc/odoc_gen.mli ocaml-4.01.0/ocamldoc/odoc_gen.mli --- ocaml-3.12.1/ocamldoc/odoc_gen.mli 1970-01-01 00:00:00.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_gen.mli 2012-08-01 12:09:31.000000000 +0000 @@ -0,0 +1,43 @@ +(***********************************************************************) +(* *) +(* OCamldoc *) +(* *) +(* Maxence Guesdon, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2010 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +(** The types of generators. *) + +(** The minimal class type of documentation generators. *) +class type doc_generator = + object method generate : Odoc_module.t_module list -> unit end;; + +(** The module type of minimal generators. *) +module type Base = sig + class generator : doc_generator + end;; + +module Base_generator : Base + +module type Base_functor = functor (P: Base) -> Base +module type Html_functor = functor (G: Odoc_html.Html_generator) -> Odoc_html.Html_generator +module type Latex_functor = functor (G: Odoc_latex.Latex_generator) -> Odoc_latex.Latex_generator +module type Texi_functor = functor (G: Odoc_texi.Texi_generator) -> Odoc_texi.Texi_generator +module type Man_functor = functor (G: Odoc_man.Man_generator) -> Odoc_man.Man_generator +module type Dot_functor = functor (G: Odoc_dot.Dot_generator) -> Odoc_dot.Dot_generator + +(** Various ways to create a generator. *) +type generator = + | Html of (module Odoc_html.Html_generator) + | Latex of (module Odoc_latex.Latex_generator) + | Texi of (module Odoc_texi.Texi_generator) + | Man of (module Odoc_man.Man_generator) + | Dot of (module Odoc_dot.Dot_generator) + | Base of (module Base) +;; + +val get_minimal_generator : generator -> doc_generator diff -Nru ocaml-3.12.1/ocamldoc/odoc_global.ml ocaml-4.01.0/ocamldoc/odoc_global.ml --- ocaml-3.12.1/ocamldoc/odoc_global.ml 2003-11-24 10:44:07.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_global.ml 2013-06-05 16:34:40.000000000 +0000 @@ -1,5 +1,6 @@ (***********************************************************************) -(* OCamldoc *) +(* *) +(* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) (* *) @@ -9,14 +10,77 @@ (* *) (***********************************************************************) -(* $Id: odoc_global.ml 5973 2003-11-24 10:44:07Z starynke $ *) - (** Global variables. *) +(* Tell ocaml compiler not to generate files. *) +let _ = Clflags.dont_write_files := true + +open Clflags + +type source_file = + Impl_file of string + | Intf_file of string + | Text_file of string + +let include_dirs = Clflags.include_dirs + let errors = ref 0 let warn_error = ref false +let pwarning s = + if !Odoc_config.print_warnings then prerr_endline (Odoc_messages.warning^": "^s); + if !warn_error then incr errors -(* Tell ocaml compiler not to generate files. *) -let _ = Clflags.dont_write_files := true +let merge_options = ref ([] : Odoc_types.merge_option list) + +let classic = Clflags.classic + +let dump = ref (None : string option) + +let load = ref ([] : string list) + +(** Allow arbitrary recursive types. *) +let recursive_types = Clflags.recursive_types + +(** Optional preprocessor command. *) +let preprocessor = Clflags.preprocessor +let ppx = Clflags.all_ppx + +let sort_modules = ref false + +let no_custom_tags = ref false + +let no_stop = ref false + +let remove_stars = ref false + +let keep_code = ref false + +let inverse_merge_ml_mli = ref false + +let filter_with_module_constraints = ref true + +let hidden_modules = ref ([] : string list) + +let files = ref [] + + + +let out_file = ref Odoc_messages.default_out_file + +let verbose = ref false + +let target_dir = ref Filename.current_dir_name + +let title = ref (None : string option) + +let intro_file = ref (None : string option) + +let with_header = ref true + +let with_trailer = ref true + +let with_toc = ref true + +let with_index = ref true diff -Nru ocaml-3.12.1/ocamldoc/odoc_global.mli ocaml-4.01.0/ocamldoc/odoc_global.mli --- ocaml-3.12.1/ocamldoc/odoc_global.mli 2003-11-24 10:44:07.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_global.mli 2012-10-15 17:50:56.000000000 +0000 @@ -1,5 +1,6 @@ (***********************************************************************) -(* Ocamldoc *) +(* *) +(* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) (* *) @@ -9,12 +10,95 @@ (* *) (***********************************************************************) -(* $Id: odoc_global.mli 5973 2003-11-24 10:44:07Z starynke $ *) - (** Global variables. *) +(** The kind of source file in arguments. *) +type source_file = + Impl_file of string + | Intf_file of string + | Text_file of string + +(** The include_dirs in the OCaml compiler. *) +val include_dirs : string list ref + +(** Optional preprocessor command to pass to ocaml compiler. *) +val preprocessor : string option ref (* -pp *) +val ppx : string list ref (* -ppx *) + +(** Recursive types flag to passe to ocaml compiler. *) +val recursive_types : bool ref + +(** The merge options to be used. *) +val merge_options : Odoc_types.merge_option list ref + +(** Classic mode or not. *) +val classic : bool ref + +(** The optional file name to dump the collected information into.*) +val dump : string option ref + +(** The list of information files to load. *) +val load : string list ref + +(** We must sort the list of top modules or not.*) +val sort_modules : bool ref + +(** We must not stop at the stop special comments. Default is false (we stop).*) +val no_stop : bool ref + +(** We must raise an exception when we find an unknown @-tag. *) +val no_custom_tags : bool ref + +(** We must remove the the first characters of each comment line, until the first asterisk '*'. *) +val remove_stars : bool ref + +(** To keep the code while merging, when we have both .ml and .mli files for a module. *) +val keep_code : bool ref + +(** To inverse implementation and interface files when merging. *) +val inverse_merge_ml_mli : bool ref + +(** To filter module elements according to module type constraints. *) +val filter_with_module_constraints : bool ref + +(** The list of module names to hide. *) +val hidden_modules : string list ref + +(** The files to be analysed. *) +val files : source_file list ref (** A counter for errors. *) val errors : int ref (** Indicate if a warning is an error. *) val warn_error : bool ref + +(** Print the given warning, adding it to the list of {!errors} +if {!warn_error} is [true]. *) +val pwarning : string -> unit + +(** The file used by the generators outputting only one file. *) +val out_file : string ref + +(** Verbose mode or not. *) +val verbose : bool ref + +(** The optional file whose content can be used as intro text. *) +val intro_file : string option ref + +(** The optional title to use in the generated documentation. *) +val title : string option ref + +(** The directory where files have to be generated. *) +val target_dir : string ref + +(** The flag which indicates if we must generate a table of contents. *) +val with_toc : bool ref + +(** The flag which indicates if we must generate an index. *) +val with_index : bool ref + +(** The flag which indicates if we must generate a header.*) +val with_header : bool ref + +(** The flag which indicates if we must generate a trailer.*) +val with_trailer : bool ref diff -Nru ocaml-3.12.1/ocamldoc/odoc_html.ml ocaml-4.01.0/ocamldoc/odoc_html.ml --- ocaml-3.12.1/ocamldoc/odoc_html.ml 2011-05-02 13:55:00.000000000 +0000 +++ ocaml-4.01.0/ocamldoc/odoc_html.ml 2013-08-12 06:34:15.000000000 +0000 @@ -1,4 +1,5 @@ (***********************************************************************) +(* *) (* OCamldoc *) (* *) (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) @@ -9,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: odoc_html.ml 11023 2011-05-02 13:55:00Z guesdon $ *) - (** Generation of html documentation.*) let print_DEBUG s = print_string s ; print_newline () @@ -23,6 +22,13 @@ open Class open Module +let with_parameter_list = ref false +let css_style = ref None +let index_only = ref false +let colorize_code = ref false +let html_short_functors = ref false +let charset = ref "iso-8859-1" + (** The functions used for naming files and html marks.*) module Naming = @@ -30,6 +36,9 @@ (** The prefix for types marks. *) let mark_type = "TYPE" + (** The prefix for types elements (record fields or constructors). *) + let mark_type_elt = "TYPEELT" + (** The prefix for functions marks. *) let mark_function = "FUN" @@ -82,9 +91,25 @@ (** Return the link target for the given type. *) let type_target t = target mark_type (Name.simple t.ty_name) + (** Return the link target for the given variant constructor. *) + let const_target t f = + let name = Printf.sprintf "%s.%s" (Name.simple t.ty_name) f.vc_name in + target mark_type_elt name + + (** Return the link target for the given record field. *) + let recfield_target t f = target mark_type_elt + (Printf.sprintf "%s.%s" (Name.simple t.ty_name) f.rf_name) + (** Return the complete link target for the given type. *) let complete_type_target t = complete_target mark_type t.ty_name + let complete_recfield_target name = + let typ = Name.father name in + let field = Name.simple name in + Printf.sprintf "%s.%s" (complete_target mark_type_elt typ) field + + let complete_const_target = complete_recfield_target + (** Return the link target for the given exception. *) let exception_target e = target mark_exception (Name.simple e.ex_name) @@ -179,7 +204,10 @@ f end -module StringSet = Set.Make (struct type t = string let compare = compare end) +module StringSet = Set.Make (struct + type t = string + let compare (x:t) y = compare x y +end) (** A class with a method to colorize a string which represents OCaml code. *) class ocaml_code = @@ -270,7 +298,7 @@ method html_of_Raw b s = bs b (self#escape s) method html_of_Code b s = - if !Args.colorize_code then + if !colorize_code then self#html_of_code b ~with_pre: false s else ( @@ -308,15 +336,15 @@ | Some last -> String.sub s first ((last-first)+1) in fun b s -> - if !Args.colorize_code then - ( - bs b "
";
-         self#html_of_code b (remove_useless_newlines s);
-         bs b "
"
-        )
+      if !colorize_code then
+          (
+           bs b "
";
+           self#html_of_code b (remove_useless_newlines s);
+           bs b "
"
+          )
       else
         (
-         bs b "
" ;
          bs b (self#escape (remove_useless_newlines s));
@@ -324,7 +352,7 @@
         )
 
     method html_of_Verbatim b s =
-      bs b "
";
+      bs b "
";
       bs b (self#escape s);
       bs b "
"
 
@@ -381,7 +409,6 @@
 
     method html_of_Title b n label_opt t =
       let label1 = self#create_title_label (n, label_opt, t) in
-      bp b "" (Naming.label_target label1);
       let (tag_o, tag_c) =
         if n > 6 then
           (Printf.sprintf "div class=\"h%d\"" n, "div")
@@ -389,13 +416,12 @@
           let t = Printf.sprintf "h%d" n in (t, t)
       in
       bs b "<";
-      bs b tag_o;
+      bp b "%s id=\"%s\"" tag_o (Naming.label_target label1);
       bs b ">";
       self#html_of_text b t;
       bs b "";
-      bs b ""
+      bs b ">"
 
     method html_of_Latex b _ = ()
       (* don't care about LaTeX stuff in HTML. *)
@@ -433,6 +459,8 @@
             | Odoc_info.RK_method -> (Naming.complete_target Naming.mark_method name, h name)
             | Odoc_info.RK_section t -> (Naming.complete_label_target name,
                                          Odoc_info.Italic [Raw (Odoc_info.string_of_text t)])
+            | Odoc_info.RK_recfield -> (Naming.complete_recfield_target name, h name)
+            | Odoc_info.RK_const -> (Naming.complete_const_target name, h name)
           in
           let text =
             match text_opt with
@@ -459,7 +487,7 @@
       bs b "
\n\n";
       List.iter
         (fun name ->
-          bs b "\n"
@@ -483,8 +511,9 @@
       let index_if_not_empty l url m =
         match l with
           [] -> ()
-        | _ -> bp b "%s
\n" url m
+        | _ -> bp b "
  • %s
    • \n" url m
       in
+      bp b "
      \n";
       index_if_not_empty self#list_types self#index_types Odoc_messages.index_of_types;
       index_if_not_empty self#list_exceptions self#index_exceptions Odoc_messages.index_of_exceptions;
       index_if_not_empty self#list_values self#index_values Odoc_messages.index_of_values;
@@ -493,7 +522,8 @@
       index_if_not_empty self#list_classes self#index_classes Odoc_messages.index_of_classes;
       index_if_not_empty self#list_class_types self#index_class_types Odoc_messages.index_of_class_types;
       index_if_not_empty self#list_modules self#index_modules Odoc_messages.index_of_modules;
-      index_if_not_empty self#list_module_types self#index_module_types Odoc_messages.index_of_module_types
+      index_if_not_empty self#list_module_types self#index_module_types Odoc_messages.index_of_module_types;
+      bp b "
    \n"
 
     method virtual list_types : Odoc_info.Type.t_type list
     method virtual index_types : string
@@ -641,13 +671,13 @@
        @param indent can be specified not to use the style of info comments;
        default is [true].
     *)
-    method html_of_info ?(indent=true) b info_opt =
+    method html_of_info ?(cls="") ?(indent=true) b info_opt =
       match info_opt with
         None ->
           ()
       | Some info ->
           let module M = Odoc_info in
-          if indent then bs b "
    \n";
+          if indent then bs b ("
    \n");
           (
            match info.M.i_deprecated with
             None -> ()
@@ -683,7 +713,7 @@
           let module M = Odoc_info in
           let dep = info.M.i_deprecated <> None in
           bs b "
    \n";
-          if dep then bs b "";
+          if dep then bs b "";
           (
            match info.M.i_desc with
              None -> ()
@@ -694,7 +724,7 @@
                     (Odoc_info.first_sentence_of_text d));
                bs b "\n"
           );
-          if dep then bs b "";
+          if dep then bs b "";
           bs b "
    \n"
 
   end
@@ -724,6 +754,8 @@
   done;
   Buffer.contents b
 
+module Generator =
+  struct
 (** This class is used to create objects which can generate a simple html documentation. *)
 class html =
   object (self)
@@ -735,15 +767,11 @@
     method character_encoding () =
       Printf.sprintf
         "\n"
-        !Odoc_info.Args.charset
+        !charset
 
     (** The default style options. *)
     val mutable default_style_options =
-      ["a:visited {color : #416DFF; text-decoration : none; }" ;
-        "a:link {color : #416DFF; text-decoration : none;}" ;
-        "a:hover {color : Red; text-decoration : none; background-color: #5FFF88}" ;
-        "a:active {color : Red; text-decoration : underline; }" ;
-        ".keyword { font-weight : bold ; color : Red }" ;
+      [ ".keyword { font-weight : bold ; color : Red }" ;
         ".keywordsign { color : #C04600 }" ;
         ".superscript { font-size : 4 }" ;
         ".subscript { font-size : 4 }" ;
@@ -752,9 +780,18 @@
         ".type { color : #5C6585 }" ;
         ".string { color : Maroon }" ;
         ".warning { color : Red ; font-weight : bold }" ;
-        ".info { margin-left : 3em; margin-right : 3em }" ;
+        ".info { margin-left : 3em; margin-right: 3em }" ;
         ".param_info { margin-top: 4px; margin-left : 3em; margin-right : 3em }" ;
         ".code { color : #465F91 ; }" ;
+        ".typetable { border-style : hidden }" ;
+        ".paramstable { border-style : hidden ; padding: 5pt 5pt}" ;
+        "tr { background-color : White }" ;
+        "td.typefieldcomment { background-color : #FFFFFF ; font-size: smaller ;}" ;
+        "div.sig_block {margin-left: 2em}" ;
+        "*:target { background: yellow; }" ;
+
+        "body {font: 13px sans-serif; color: black; text-align: left; padding: 5px; margin: 0}";
+
         "h1 { font-size : 20pt ; text-align: center; }" ;
 
         "h2 { font-size : 20pt ; border: 1px solid #000000; "^
@@ -779,7 +816,7 @@
 
         "h6 { font-size : 20pt ; border: 1px solid #000000; "^
         "margin-top: 5px; margin-bottom: 2px;"^
-        "text-align: center; background-color: #C0FFFF ; "^
+        "text-align: center; background-color: #90BDFF ; "^
         "padding: 2px; }" ;
 
         "div.h7 { font-size : 20pt ; border: 1px solid #000000; "^
@@ -797,17 +834,22 @@
         "text-align: center; background-color: #FFFFFF ; "^
         "padding: 2px; }" ;
 
-        ".typetable { border-style : hidden }" ;
-        ".indextable { border-style : hidden }" ;
-        ".paramstable { border-style : hidden ; padding: 5pt 5pt}" ;
-        "body { background-color : White }" ;
-        "tr { background-color : White }" ;
-        "td.typefieldcomment { background-color : #FFFFFF ; font-size: smaller ;}" ;
-        "pre { margin-bottom: 4px }" ;
+        "a {color: #416DFF; text-decoration: none}";
+        "a:hover {background-color: #ddd; text-decoration: underline}";
+        "pre { margin-bottom: 4px; font-family: monospace; }" ;
+        "pre.verbatim, pre.codepre { }";
+
+        ".indextable {border: 1px #ddd solid; border-collapse: collapse}";
+        ".indextable td, .indextable th {border: 1px #ddd solid; min-width: 80px}";
+        ".indextable td.module {background-color: #eee ;  padding-left: 2px; padding-right: 2px}";
+        ".indextable td.module a {color: 4E6272; text-decoration: none; display: block; width: 100%}";
+        ".indextable td.module a:hover {text-decoration: underline; background-color: transparent}";
+        ".deprecated {color: #888; font-style: italic}" ;
 
-        "div.sig_block {margin-left: 2em}" ;
+        ".indextable tr td div.info { margin-left: 2px; margin-right: 2px }" ;
 
-        "*:target { background: yellow; } " ;
+        "ul.indexlist { margin-left: 0; padding-left: 0;}";
+        "ul.indexlist li { list-style-type: none ; margin-left: 0; padding-left: 0; }";
       ]
 
     (** The style file for all pages. *)
@@ -832,10 +874,10 @@
     val mutable known_modules_names = StringSet.empty
 
     method index_prefix =
-      if !Odoc_args.out_file = Odoc_messages.default_out_file then
+      if !Odoc_global.out_file = Odoc_messages.default_out_file then
         "index"
       else
-        Filename.basename !Odoc_args.out_file
+        Filename.basename !Odoc_global.out_file
 
     (** The main file. *)
     method index =
@@ -895,12 +937,12 @@
 
     (** Init the style. *)
     method init_style =
-      (match !Args.css_style with
+      (match !css_style with
         None ->
           let default_style = String.concat "\n" default_style_options in
           (
            try
-             let file = Filename.concat !Args.target_dir style_file in
+             let file = Filename.concat !Global.target_dir style_file in
              if Sys.file_exists file then
                Odoc_info.verbose (Odoc_messages.file_exists_dont_generate file)
              else
@@ -922,7 +964,7 @@
       style <- "\n"
 
     (** Get the title given by the user *)
-    method title = match !Args.title with None -> "" | Some t -> self#escape t
+    method title = match !Global.title with None -> "" | Some t -> self#escape t
 
     (** Get the title given by the user completed with the given subtitle. *)
     method inner_title s =
@@ -1043,21 +1085,24 @@
        match pre with
          None -> ()
        | Some name ->
-           bp b "%s\n"
+           bp b "%s\n"
              (fst (Naming.html_files name))
+             name
              Odoc_messages.previous
       );
       bs b " ";
       let father = Name.father name in
       let href = if father = "" then self#index else fst (Naming.html_files father) in
-      bp b "%s\n" href Odoc_messages.up;
+      let father_name = if father = "" then "Index" else father in
+      bp b "%s\n" href father_name Odoc_messages.up;
       bs b " ";
       (
        match post with
          None -> ()
        | Some name ->
-           bp b "%s\n"
+           bp b "%s\n"
              (fst (Naming.html_files name))
+             name
              Odoc_messages.next
       );
       bs b "
    \n"
@@ -1212,7 +1257,7 @@
           bs b (self#create_fully_qualified_module_idents_links father a.ma_name);
           bs b ""
       | Module_functor (p, k) ->
-          if !Odoc_info.Args.html_short_functors then
+          if !html_short_functors then
             bs b " "
           else
             bs b "
    ";
@@ -1220,12 +1265,12 @@
           (
            match k with
              Module_functor _ -> ()
-           | _ when !Odoc_info.Args.html_short_functors ->
+           | _ when !html_short_functors ->
                bs b ": "
            | _ -> ()
           );
           self#html_of_module_kind b father ?modu k;
-          if not !Odoc_info.Args.html_short_functors then
+          if not !html_short_functors then
             bs b "
    "
       | Module_apply (k1, k2) ->
           (* TODO: l'application n'est pas correcte dans un .mli.
@@ -1235,7 +1280,7 @@
           self#html_of_module_kind b father k2;
           self#html_of_text b [Code ")"]
       | Module_with (k, s) ->
-          (* TODO: à modifier quand Module_with sera plus détaillé *)
+          (* TODO: modify when Module_with will be more detailed *)
           self#html_of_module_type_kind b father ?modu k;
           bs b " ";
           bs b (self#create_fully_qualified_module_idents_links father s);
@@ -1262,7 +1307,7 @@
 
     method html_of_module_parameter b father p =
       let (s_functor,s_arrow) =
-        if !Odoc_info.Args.html_short_functors then
+        if !html_short_functors then
           "", ""
         else
           "functor ", "-> "
@@ -1354,7 +1399,7 @@
     (** Print html code for a value. *)
     method html_of_value b v =
       Odoc_info.reset_type_names ();
-      bs b "
    " ;
+      bs b "\n
    " ;
       bp b "" (Naming.value_target v);
       bs b (self#keyword "val");
       bs b " ";
@@ -1363,7 +1408,7 @@
          None -> bs b (self#escape (Name.simple v.val_name))
        | Some c ->
            let file = Naming.file_code_value_complete_target v in
-           self#output_code v.val_name (Filename.concat !Args.target_dir file) c;
+           self#output_code v.val_name (Filename.concat !Global.target_dir file) c;
            bp b "%s" file (self#escape (Name.simple v.val_name))
       );
       bs b "";
@@ -1372,7 +1417,7 @@
       bs b "
    ";
       self#html_of_info b v.val_info;
       (
-       if !Args.with_parameter_list then
+       if !with_parameter_list then
          self#html_of_parameter_list b (Name.father v.val_name) v.val_parameters
        else
          self#html_of_described_parameter_list b (Name.father v.val_name) v.val_parameters
@@ -1381,7 +1426,7 @@
     (** Print html code for an exception. *)
     method html_of_exception b e =
       Odoc_info.reset_type_names ();
-      bs b "
    ";
+      bs b "\n
    ";
       bp b "" (Naming.exception_target e);
       bs b (self#keyword "exception");
       bs b " ";
@@ -1416,12 +1461,12 @@
       let father = Name.father t.ty_name in
       bs b
         (match t.ty_manifest, t.ty_kind with
-          None, Type_abstract -> "
    "
+          None, Type_abstract -> "\n
    "
         | None, Type_variant _
-        | None, Type_record _ -> "
    "
-        | Some _, Type_abstract -> "
    "
+        | None, Type_record _ -> "\n
    "
+        | Some _, Type_abstract -> "\n
    "
         | Some _, Type_variant _
-        | Some _, Type_record _ -> "
    "
+        | Some _, Type_record _ -> "\n
    "
         );
       bp b "" (Naming.type_target t);
       bs b ((self#keyword "type")^" ");
@@ -1447,7 +1492,7 @@
           bs b
             (
              match t.ty_manifest with
-               None -> ""
+               None -> "
    "
              | Some _ -> "
    "
             );
           bs b "
    ";
+          bs b "
    ";
           (
            try
              let m =
@@ -471,7 +499,7 @@
              self#html_of_info_first_sentence b m.m_info;
            with
              Not_found ->
-               Odoc_messages.pwarning (Odoc_messages.cross_module_not_found name);
+               Odoc_global.pwarning (Odoc_messages.cross_module_not_found name);
                bp b "%s" name
           );
           bs b "
    \n";
@@ -1457,13 +1502,23 @@
             bs b (self#keyword "|");
             bs b "\n\n";
             (
@@ -1494,7 +1549,7 @@
           bs b
             (
              match t.ty_manifest with
-               None -> ""
+               None -> ""
              | Some _ -> ""
             );
           bs b "
    \n";
             bs b "";
-            bs b (self#constructor constr.vc_name);
+            bp b "%s"
+              (Naming.const_target t constr)
+              (self#constructor constr.vc_name);
             (
-             match constr.vc_args with
-               [] -> ()
-             | l ->
+             match constr.vc_args, constr.vc_ret with
+               [], None -> ()
+             | l,None ->
                  bs b (" " ^ (self#keyword "of") ^ " ");
                  self#html_of_type_expr_list ~par: false b father " * " l;
+             | [],Some r ->
+                 bs b (" " ^ (self#keyword ":") ^ " ");
+                 self#html_of_type_expr b father r;
+             | l,Some r ->
+                 bs b (" " ^ (self#keyword ":") ^ " ");
+                 self#html_of_type_expr_list ~par: false b father " * " l;
+                 bs b (" " ^ (self#keyword "->") ^ " ");
+                 self#html_of_type_expr b father r;
             );
             bs b "
    \n" ;
@@ -1504,7 +1559,9 @@
             bs b "\n\n";
             (
@@ -1532,7 +1589,7 @@
     (** Print html code for a class attribute. *)
     method html_of_attribute b a =
       let module_name = Name.father (Name.father a.att_value.val_name) in
-      bs b "
    " ;
+      bs b "\n
    " ;
       bp b "" (Naming.attribute_target a);
       bs b (self#keyword "val");
       bs b " ";
@@ -1552,7 +1609,7 @@
          None -> bs b (Name.simple a.att_value.val_name)
        | Some c ->
            let file = Naming.file_code_attribute_complete_target a in
-           self#output_code a.att_value.val_name (Filename.concat !Args.target_dir file) c;
+           self#output_code a.att_value.val_name (Filename.concat !Global.target_dir file) c;
            bp b "%s" file (Name.simple a.att_value.val_name);
       );
       bs b "";
@@ -1564,7 +1621,7 @@
     (** Print html code for a class method. *)
     method html_of_method b m =
       let module_name = Name.father (Name.father m.met_value.val_name) in
-      bs b "
    ";
+      bs b "\n
    ";
       (* html mark *)
       bp b "" (Naming.method_target m);
      bs b ((self#keyword "method")^" ");
@@ -1575,7 +1632,7 @@
          None -> bs b  (Name.simple m.met_value.val_name)
        | Some c ->
            let file = Naming.file_code_method_complete_target m in
-           self#output_code m.met_value.val_name (Filename.concat !Args.target_dir file) c;
+           self#output_code m.met_value.val_name (Filename.concat !Global.target_dir file) c;
            bp b "%s" file (Name.simple m.met_value.val_name);
       );
       bs b "";
@@ -1584,7 +1641,7 @@
       bs b "
    ";
       self#html_of_info b m.met_value.val_info;
       (
-       if !Args.with_parameter_list then
+       if !with_parameter_list then
          self#html_of_parameter_list b
            module_name m.met_value.val_parameters
        else
@@ -1708,7 +1765,7 @@
     method html_of_module b ?(info=true) ?(complete=true) ?(with_link=true) m =
       let (html_file, _) = Naming.html_files m.m_name in
       let father = Name.father m.m_name in
-      bs b "
    ";
+      bs b "\n
    ";
       bs b ((self#keyword "module")^" ");
       (
        if with_link then
@@ -1718,7 +1775,7 @@
       );
       (
        match m.m_kind with
-         Module_functor _ when !Odoc_info.Args.html_short_functors  ->
+         Module_functor _ when !html_short_functors  ->
            ()
        | _ -> bs b ": "
       );
@@ -1727,7 +1784,7 @@
       if info then
         (
          if complete then
-           self#html_of_info ~indent: false
+           self#html_of_info ~cls: "module top" ~indent: true
          else
            self#html_of_info_first_sentence
         ) b m.m_info
@@ -1738,7 +1795,7 @@
     method html_of_modtype b ?(info=true) ?(complete=true) ?(with_link=true) mt =
       let (html_file, _) = Naming.html_files mt.mt_name in
       let father = Name.father mt.mt_name in
-      bs b "
    ";
+      bs b "\n
    ";
       bs b ((self#keyword "module type")^" ");
       (
        if with_link then
@@ -1756,7 +1813,7 @@
       if info then
         (
          if complete then
-           self#html_of_info ~indent: false
+           self#html_of_info ~cls: "modtype top" ~indent: true
          else
            self#html_of_info_first_sentence
         ) b mt.mt_info
@@ -1765,7 +1822,7 @@
 
     (** Print html code for an included module. *)
     method html_of_included_module b im =
-      bs b "
    ";
+      bs b "\n
    ";
       bs b ((self#keyword "include")^" ");
       (
        match im.im_module with
@@ -1817,7 +1874,7 @@
           self#html_of_text b [Code "end"]
 
       | Class_apply capp ->
-          (* TODO: afficher le type final à partir du typedtree *)
+          (* TODO: display final type from typedtree *)
           self#html_of_text b [Raw "class application not handled yet"]
 
       | Class_constr cco ->
@@ -1876,7 +1933,7 @@
       let father = Name.father c.cl_name in
       Odoc_info.reset_type_names ();
       let (html_file, _) = Naming.html_files c.cl_name in
-      bs b "
    ";
+      bs b "\n
    ";
       (* we add a html id, the same as for a type so we can
          go directly here when the class name is used as a type name *)
       bp b ""
@@ -1913,7 +1970,7 @@
       print_DEBUG "html#html_of_class : info" ;
       (
        if complete then
-         self#html_of_info ~indent: false
+         self#html_of_info ~cls: "class top" ~indent: true
        else
          self#html_of_info_first_sentence
       ) b c.cl_info
@@ -1923,7 +1980,7 @@
       Odoc_info.reset_type_names ();
       let father = Name.father ct.clt_name in
       let (html_file, _) = Naming.html_files ct.clt_name in
-      bs b "
    ";
+      bs b "\n
    ";
       (* we add a html id, the same as for a type so we can
          go directly here when the class type name is used as a type name *)
       bp b ""
@@ -1956,7 +2013,7 @@
       bs b "
    ";
       (
        if complete then
-         self#html_of_info ~indent: false
+         self#html_of_info ~cls: "classtype top" ~indent: true
        else
          self#html_of_info_first_sentence
       ) b ct.clt_info
@@ -2064,13 +2121,15 @@
               ('a -> string) -> string -> string -> unit =
     fun elements name info target title simple_file ->
       try
-        let chanout = open_out (Filename.concat !Args.target_dir simple_file) in
+        let chanout = open_out (Filename.concat !Global.target_dir simple_file) in
         let b = new_buf () in
         bs b "\n";
         self#print_header b (self#inner_title title);
-        bs b "\n
    ";
+        bs b "\n";
+        self#print_navbar b None None "";
+        bs b "
    ";
         bs b title;
-        bs b "
    \n" ;
+        bs b "\n" ;
 
         let sorted_elements = List.sort
             (fun e1 e2 -> compare (Name.simple (name e1)) (Name.simple (name e2)))
@@ -2103,7 +2162,7 @@
         in
         bs b "
    \n";
             bs b "";
             if r.rf_mutable then bs b (self#keyword "mutable ") ;
-            bs b (r.rf_name ^ " : ") ;
+            bp b "%s : "
+              (Naming.recfield_target t r)
+              r.rf_name;
             self#html_of_type_expr b father r.rf_type;
             bs b ";
    \n";
         List.iter f_group groups ;
-        bs b "

    \n" ;
+        bs b "\n" ;
         bs b "\n";
         Buffer.output_buffer chanout b;
         close_out chanout
@@ -2130,7 +2189,7 @@
       let (html_file, _) = Naming.html_files cl.cl_name in
       let type_file = Naming.file_type_class_complete_target cl.cl_name in
       try
-        let chanout = open_out (Filename.concat !Args.target_dir html_file) in
+        let chanout = open_out (Filename.concat !Global.target_dir html_file) in
         let b = new_buf () in
         let pre_name = opt (fun c -> c.cl_name) pre in
         let post_name = opt (fun c -> c.cl_name) post in
@@ -2142,11 +2201,11 @@
           (self#inner_title cl.cl_name);
         bs b "\n";
         self#print_navbar b pre_name post_name cl.cl_name;
-        bs b "
    ";
+        bs b "
    ";
         bs b (Odoc_messages.clas^" ");
         if cl.cl_virtual then bs b "virtual " ;
         bp b "%s" type_file cl.cl_name;
-        bs b "
    \n
    \n";
+        bs b "\n";
         self#html_of_class b ~with_link: false cl;
         (* parameters *)
         self#html_of_described_parameter_list b
@@ -2165,7 +2224,7 @@
         (* generate the file with the complete class type *)
         self#output_class_type
           cl.cl_name
-          (Filename.concat !Args.target_dir type_file)
+          (Filename.concat !Global.target_dir type_file)
           cl.cl_type
       with
         Sys_error s ->
@@ -2177,7 +2236,7 @@
       let (html_file, _) = Naming.html_files clt.clt_name in
       let type_file = Naming.file_type_class_complete_target clt.clt_name in
       try
-        let chanout = open_out (Filename.concat !Args.target_dir html_file) in
+        let chanout = open_out (Filename.concat !Global.target_dir html_file) in
         let b = new_buf () in
         let pre_name = opt (fun ct -> ct.clt_name) pre in
         let post_name = opt (fun ct -> ct.clt_name) post in
@@ -2190,11 +2249,11 @@
 
         bs b "\n";
         self#print_navbar b pre_name post_name clt.clt_name;
-        bs b "
    ";
+        bs b "
    ";
         bs b (Odoc_messages.class_type^" ");
         if clt.clt_virtual then bs b "virtual ";
         bp b "%s" type_file clt.clt_name;
-        bs b "
    \n
    \n";
+        bs b "\n";
         self#html_of_class_type b ~with_link: false clt;
 
         (* class inheritance *)
@@ -2211,7 +2270,7 @@
         (* generate the file with the complete class type *)
         self#output_class_type
           clt.clt_name
-          (Filename.concat !Args.target_dir type_file)
+          (Filename.concat !Global.target_dir type_file)
           clt.clt_type
       with
         Sys_error s ->
@@ -2223,7 +2282,7 @@
       try
         let (html_file, _) = Naming.html_files mt.mt_name in
         let type_file = Naming.file_type_module_complete_target mt.mt_name in
-        let chanout = open_out (Filename.concat !Args.target_dir html_file) in
+        let chanout = open_out (Filename.concat !Global.target_dir html_file) in
         let b = new_buf () in
         let pre_name = opt (fun mt -> mt.mt_name) pre in
         let post_name = opt (fun mt -> mt.mt_name) post in
@@ -2235,14 +2294,14 @@
           (self#inner_title mt.mt_name);
         bs b "\n";
         self#print_navbar b pre_name post_name mt.mt_name;
-        bp b "
    ";
+        bp b "
    ";
         bs b (Odoc_messages.module_type^" ");
         (
          match mt.mt_type with
            Some _ -> bp b "%s" type_file mt.mt_name
          | None-> bs b mt.mt_name
         );
-        bs b "
    \n
    \n" ;
+        bs b "\n" ;
         self#html_of_modtype b ~with_link: false mt;
 
         (* parameters for functors *)
@@ -2276,7 +2335,7 @@
          | Some mty ->
              self#output_module_type
                mt.mt_name
-               (Filename.concat !Args.target_dir type_file)
+               (Filename.concat !Global.target_dir type_file)
                mty
         )
       with
@@ -2291,7 +2350,7 @@
         let (html_file, _) = Naming.html_files modu.m_name in
         let type_file = Naming.file_type_module_complete_target modu.m_name in
         let code_file = Naming.file_code_module_complete_target modu.m_name in
-        let chanout = open_out (Filename.concat !Args.target_dir html_file) in
+        let chanout = open_out (Filename.concat !Global.target_dir html_file) in
         let b = new_buf () in
         let pre_name = opt (fun m -> m.m_name) pre in
         let post_name = opt (fun m -> m.m_name) post in
@@ -2303,7 +2362,7 @@
           (self#inner_title modu.m_name);
         bs b "\n" ;
         self#print_navbar b pre_name post_name modu.m_name ;
-        bs b "
    ";
+        bs b "
    ";
         if modu.m_text_only then
           bs b modu.m_name
         else
@@ -2322,7 +2381,7 @@
             | Some _ -> bp b " (.ml)" code_file
            )
           );
-        bs b "
    \n
    \n";
+        bs b "\n";
 
         if not modu.m_text_only then self#html_of_module b ~with_link: false modu;
 
@@ -2355,7 +2414,7 @@
         (* generate the file with the complete module type *)
         self#output_module_type
           modu.m_name
-          (Filename.concat !Args.target_dir type_file)
+          (Filename.concat !Global.target_dir type_file)
           modu.m_type;
 
         match modu.m_code with
@@ -2363,7 +2422,7 @@
         | Some code ->
             self#output_code
               modu.m_name
-              (Filename.concat !Args.target_dir code_file)
+              (Filename.concat !Global.target_dir code_file)
               code
       with
         Sys_error s ->
@@ -2373,19 +2432,20 @@
        @raise Failure if an error occurs.*)
     method generate_index module_list =
       try
-        let chanout = open_out (Filename.concat !Args.target_dir self#index) in
+        let chanout = open_out (Filename.concat !Global.target_dir self#index) in
         let b = new_buf () in
-        let title = match !Args.title with None -> "" | Some t -> self#escape t in
+        let title = match !Global.title with None -> "" | Some t -> self#escape t in
         bs b doctype ;
         bs b "\n";
         self#print_header b self#title;
         bs b "\n";
-        bs b "
    ";
+
+        bs b "
    ";
         bs b title;
-        bs b "
    \n" ;
+        bs b "\n" ;
         let info = Odoc_info.apply_opt
             (Odoc_info.info_of_comment_file module_list)
-            !Odoc_info.Args.intro_file
+            !Odoc_info.Global.intro_file
         in
         (
          match info with
@@ -2545,7 +2605,7 @@
           known_modules_names
           module_types ;
       (* generate html for each module *)
-      if not !Args.index_only then
+      if not !index_only then
         self#generate_elements self#generate_for_module module_list ;
 
       try
@@ -2572,3 +2632,6 @@
           Buffer.contents b
         )
   end
+end
+
+module type Html_generator = module type of Generator
diff -Nru ocaml-3.12.1/ocamldoc/odoc_info.ml ocaml-4.01.0/ocamldoc/odoc_info.ml
--- ocaml-3.12.1/ocamldoc/odoc_info.ml	2010-05-31 11:52:13.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_info.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_info.ml 10480 2010-05-31 11:52:13Z guesdon $ *)
-
 (** Interface for analysing documented OCaml source files and to the collected information. *)
 
 type ref_kind = Odoc_types.ref_kind =
@@ -24,6 +23,8 @@
   | RK_attribute
   | RK_method
   | RK_section of text
+  | RK_recfield
+  | RK_const
 
 and text_element = Odoc_types.text_element =
   | Raw of string
@@ -81,8 +82,8 @@
   }
 
 type location = Odoc_types.location = {
-    loc_impl : (string * int) option ;
-    loc_inter : (string * int) option ;
+    loc_impl : Location.t option ;
+    loc_inter : Location.t option ;
   }
 
 let dummy_loc = { loc_impl = None ; loc_inter = None }
@@ -104,11 +105,11 @@
     ?(no_stop=false)
     ?(init=[])
     files =
-  Odoc_args.merge_options := merge_options;
-  Odoc_args.include_dirs := include_dirs;
-  Odoc_args.classic := not labels;
-  Odoc_args.sort_modules := sort_modules;
-  Odoc_args.no_stop := no_stop;
+  Odoc_global.merge_options := merge_options;
+  Odoc_global.include_dirs := include_dirs;
+  Odoc_global.classic := not labels;
+  Odoc_global.sort_modules := sort_modules;
+  Odoc_global.no_stop := no_stop;
   Odoc_analyse.analyse_files ~init: init files
 
 let dump_modules = Odoc_analyse.dump_modules
@@ -168,15 +169,15 @@
 let label_name = Odoc_misc.label_name
 
 let use_hidden_modules n =
-  Odoc_name.hide_given_modules !Odoc_args.hidden_modules n
+  Odoc_name.hide_given_modules !Odoc_global.hidden_modules n
 
 let verbose s =
-  if !Odoc_args.verbose then
+  if !Odoc_global.verbose then
     (print_string s ; print_newline ())
   else
     ()
 
-let warning s = Odoc_messages.pwarning s
+let warning s = Odoc_global.pwarning s
 let print_warnings = Odoc_config.print_warnings
 
 let errors = Odoc_global.errors
@@ -213,12 +214,12 @@
    | Some t -> p b "%s" (escape_arobas (text_string_of_text t))
   );
   List.iter
-    (fun s -> p b "\n@author %s" (escape_arobas s))
+    (fun s -> p b "\n@@author %s" (escape_arobas s))
     i.i_authors;
   (
    match i.i_version with
      None -> ()
-   | Some s -> p b "\n@version %s" (escape_arobas s)
+   | Some s -> p b "\n@@version %s" (escape_arobas s)
   );
   (
    (* TODO: escape characters ? *)
@@ -229,7 +230,7 @@
    in
    List.iter
      (fun (sref, t) ->
-       p b "\n@see %s %s"
+       p b "\n@@see %s %s"
          (escape_arobas (f_see_ref sref))
          (escape_arobas (text_string_of_text t))
      )
@@ -238,25 +239,25 @@
   (
    match i.i_since with
      None -> ()
-   | Some s -> p b "\n@since %s" (escape_arobas s)
+   | Some s -> p b "\n@@since %s" (escape_arobas s)
   );
   (
    match i.i_deprecated with
      None -> ()
    | Some t ->
-       p b "\n@deprecated %s"
+       p b "\n@@deprecated %s"
          (escape_arobas (text_string_of_text t))
   );
   List.iter
     (fun (s, t) ->
-      p b "\n@param %s %s"
+      p b "\n@@param %s %s"
         (escape_arobas s)
         (escape_arobas (text_string_of_text t))
     )
     i.i_params;
   List.iter
     (fun (s, t) ->
-      p b "\n@raise %s %s"
+      p b "\n@@raise %s %s"
         (escape_arobas s)
         (escape_arobas (text_string_of_text t))
     )
@@ -265,12 +266,12 @@
    match i.i_return_value with
      None -> ()
    | Some t ->
-       p b "\n@return %s"
+       p b "\n@@return %s"
          (escape_arobas (text_string_of_text t))
   );
   List.iter
     (fun (s, t) ->
-      p b "\n@%s %s" s
+      p b "\n@@%s %s" s
         (escape_arobas (text_string_of_text t))
     )
     i.i_custom;
@@ -293,6 +294,8 @@
         | Res_attribute of Value.t_attribute
         | Res_method of Value.t_method
         | Res_section of string * text
+        | Res_recfield of Type.t_type * Type.record_field
+        | Res_const of Type.t_type * Type.variant_constructor
 
     type search_result = result_element list
 
@@ -320,4 +323,4 @@
     let deps_of_types = Odoc_dep.deps_of_types
   end
 
-module Args = Odoc_args
+module Global = Odoc_global
diff -Nru ocaml-3.12.1/ocamldoc/odoc_info.mli ocaml-4.01.0/ocamldoc/odoc_info.mli
--- ocaml-3.12.1/ocamldoc/odoc_info.mli	2011-05-05 11:28:57.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_info.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_info.mli 11027 2011-05-05 11:28:57Z doligez $ *)
-
 (** Interface to the information collected in source files. *)
 
 (** The differents kinds of element references. *)
@@ -25,6 +24,8 @@
   | RK_attribute
   | RK_method
   | RK_section of text
+  | RK_recfield
+  | RK_const
 
 and text_element = Odoc_types.text_element =
   | Raw of string (** Raw text. *)
@@ -98,8 +99,8 @@
 
 (** Location of elements in implementation and interface files. *)
 type location = Odoc_types.location = {
-    loc_impl : (string * int) option ; (** implementation file name and position *)
-    loc_inter : (string * int) option ; (** interface file name and position *)
+    loc_impl : Location.t option ; (** implementation location *)
+    loc_inter : Location.t option ; (** interface location *)
   }
 
 (** A dummy location. *)
@@ -201,6 +202,7 @@
         {
           vc_name : string ; (** Name of the constructor. *)
           vc_args : Types.type_expr list ; (** Arguments of the constructor. *)
+          vc_ret : Types.type_expr option ;
           mutable vc_text : text option ; (** Optional description in the associated comment. *)
         }
 
@@ -791,6 +793,8 @@
         | Res_attribute of Value.t_attribute
         | Res_method of Value.t_method
         | Res_section of string  * text
+        | Res_recfield of Type.t_type * Type.record_field
+        | Res_const of Type.t_type * Type.variant_constructor
 
       (** The type representing a research result.*)
       type search_result = result_element list
@@ -835,6 +839,10 @@
       (** Scan of 'leaf elements'. *)
 
         method scan_value : Value.t_value -> unit
+
+        method scan_type_pre : Type.t_type -> bool
+        method scan_type_const : Type.t_type -> Type.variant_constructor -> unit
+        method scan_type_recfield : Type.t_type -> Type.record_field -> unit
         method scan_type : Type.t_type -> unit
         method scan_exception : Exception.t_exception -> unit
         method scan_attribute : Value.t_attribute -> unit
@@ -931,152 +939,40 @@
     val deps_of_types : ?kernel: bool -> Type.t_type list -> (Type.t_type * (Name.t list)) list
   end
 
-(** {2 Command line arguments} *)
-
-(**  You can use this module to create custom generators.*)
-module Args :
-    sig
-      (** The kind of source file in arguments. *)
-      type source_file =
-          Impl_file of string
-        | Intf_file of string
-        | Text_file of string
-
-      (** The class type of documentation generators. *)
-      class type doc_generator =
-        object method generate : Module.t_module list -> unit end
-
-      (** The file used by the generators outputting only one file. *)
-      val out_file : string ref
-
-      (** Verbose mode or not. *)
-      val verbose : bool ref
-
-      (** The optional title to use in the generated documentation. *)
-      val title : string option ref
-
-      (** To inverse [.ml] and [.mli] files while merging comments. *)
-      val inverse_merge_ml_mli : bool ref
-
-      (** To filter module elements according to module type constraints. *)
-      val filter_with_module_constraints : bool ref
-
-      (** To keep the code while merging, when we have both .ml and .mli files for a module. *)
-      val keep_code : bool ref
-
-      (** The optional file whose content can be used as intro text. *)
-      val intro_file : string option ref
-
-      (** Flag to indicate whether we must display the complete list of parameters
-         for functions and methods. *)
-      val with_parameter_list : bool ref
-
-      (** The list of module names to hide. *)
-      val hidden_modules : string list ref
-
-      (** The directory where files have to be generated. *)
-      val target_dir : string ref
-
-      (** An optional file to use where a CSS style is defined (for HTML). *)
-      val css_style : string option ref
-
-      (** Generate only index files. (for HTML). *)
-      val index_only : bool ref
-
-      (** To colorize code in HTML generated documentation pages, not code pages. *)
-      val colorize_code : bool ref
-
-      (** To display functors in short form rather than with "functor ... -> ",
-         in HTML generated documentation. *)
-      val html_short_functors : bool ref
-
-      (** Character encoding used in HTML pages header. *)
-      val charset : string ref
+(** {2 Some global variables} *)
 
-      (** The flag which indicates if we must generate a header (for LaTeX). *)
-      val with_header : bool ref
-
-      (** The flag which indicates if we must generate a trailer (for LaTeX). *)
-      val with_trailer : bool ref
-
-      (** The flag to indicate if we must generate one file per module (for LaTeX). *)
-      val separate_files : bool ref
-
-      (** The list of pairs (title level, sectionning style). *)
-      val latex_titles : (int * string) list ref
-
-      (** The prefix to use for value labels in LaTeX. *)
-      val latex_value_prefix : string ref
-
-      (** The prefix to use for type labels in LaTeX. *)
-      val latex_type_prefix : string ref
-
-      (** The prefix to use for exception labels in LaTeX. *)
-      val latex_exception_prefix : string ref
-
-      (** The prefix to use for module labels in LaTeX. *)
-      val latex_module_prefix : string ref
-
-      (** The prefix to use for module type labels in LaTeX. *)
-      val latex_module_type_prefix : string ref
-
-      (** The prefix to use for class labels in LaTeX. *)
-      val latex_class_prefix : string ref
-
-      (** The prefix to use for class type labels in LaTeX. *)
-      val latex_class_type_prefix : string ref
-
-      (** The prefix to use for attribute labels in LaTeX. *)
-      val latex_attribute_prefix : string ref
-
-      (** The prefix to use for method labels in LaTeX. *)
-      val latex_method_prefix : string ref
-
-      (** The flag which indicates if we must generate a table of contents (for LaTeX). *)
-      val with_toc : bool ref
-
-      (** The flag which indicates if we must generate an index (for TeXinfo). *)
-      val with_index : bool ref
-
-      (** The flag which indicates if we must escape accentuated characters (for TeXinfo).*)
-      val esc_8bits : bool ref
-
-      (** The Info directory section *)
-      val info_section : string ref
-
-      (** The Info directory entries to insert *)
-      val info_entry : string list ref
-
-      (** Include all modules or only the ones on the command line, for the dot output. *)
-      val dot_include_all : bool ref
+module Global :
+  sig
+    val errors : int ref
+    val warn_error : bool ref
 
-      (** Generate dependency graph for types. *)
-      val dot_types : bool ref
+    (** The file used by the generators outputting only one file. *)
+    val out_file : string ref
 
-      (** Perform transitive reduction before dot output. *)
-      val dot_reduce : bool ref
+    (** Verbose mode or not. *)
+    val verbose : bool ref
 
-      (** The colors used in the dot output. *)
-      val dot_colors : string list ref
+    (** The directory where files have to be generated. *)
+    val target_dir : string ref
 
-      (** The suffix for man pages. *)
-      val man_suffix : string ref
+    (** The optional title to use in the generated documentation. *)
+    val title : string option ref
 
-      (** The section for man pages. *)
-      val man_section : string ref
+    (** The optional file whose content can be used as intro text. *)
+    val intro_file : string option ref
 
-      (** The flag to generate all man pages or only for modules and classes.*)
-      val man_mini : bool ref
+    (** The flag which indicates if we must generate a table of contents. *)
+    val with_toc : bool ref
 
-      (** The files to be analysed. *)
-      val files : source_file list ref
+    (** The flag which indicates if we must generate an index. *)
+    val with_index : bool ref
 
-      (** To set the documentation generator. *)
-      val set_doc_generator : doc_generator option -> unit
+    (** The flag which indicates if we must generate a header.*)
+    val with_header : bool ref
 
-      (** Add an option specification. *)
-      val add_option : string * Arg.spec * string -> unit
-    end
+    (** The flag which indicates if we must generate a trailer.*)
+    val with_trailer : bool ref
+end
 
 (** Analysis of the given source files.
    @param init is the list of modules already known from a previous analysis.
@@ -1088,7 +984,7 @@
           ?sort_modules:bool ->
             ?no_stop:bool ->
               ?init: Odoc_module.t_module list ->
-                Args.source_file list ->
+                Odoc_global.source_file list ->
                   Module.t_module list
 
 (** Dump of a list of modules into a file.
diff -Nru ocaml-3.12.1/ocamldoc/odoc_inherit.ml ocaml-4.01.0/ocamldoc/odoc_inherit.ml
--- ocaml-3.12.1/ocamldoc/odoc_inherit.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_inherit.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -8,5 +9,3 @@
 (*  under the terms of the Q Public License version 1.0.               *)
 (*                                                                     *)
 (***********************************************************************)
-
-(* $Id: odoc_inherit.ml 9547 2010-01-22 12:48:24Z doligez $ *)
diff -Nru ocaml-3.12.1/ocamldoc/odoc_latex.ml ocaml-4.01.0/ocamldoc/odoc_latex.ml
--- ocaml-3.12.1/ocamldoc/odoc_latex.ml	2010-05-03 15:06:17.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_latex.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_latex.ml 10355 2010-05-03 15:06:17Z guesdon $ *)
-
 (** Generation of LaTeX documentation. *)
 
 let print_DEBUG s = print_string s ; print_newline ()
@@ -23,6 +22,29 @@
 open Class
 open Module
 
+
+
+let separate_files = ref false
+
+let latex_titles = ref [
+  1, "section" ;
+  2, "subsection" ;
+  3, "subsubsection" ;
+  4, "paragraph" ;
+  5, "subparagraph" ;
+]
+
+let latex_value_prefix = ref Odoc_messages.default_latex_value_prefix
+let latex_type_prefix = ref Odoc_messages.default_latex_type_prefix
+let latex_type_elt_prefix = ref Odoc_messages.default_latex_type_elt_prefix
+let latex_exception_prefix = ref Odoc_messages.default_latex_exception_prefix
+let latex_module_prefix = ref Odoc_messages.default_latex_module_prefix
+let latex_module_type_prefix = ref Odoc_messages.default_latex_module_type_prefix
+let latex_class_prefix = ref Odoc_messages.default_latex_class_prefix
+let latex_class_type_prefix = ref Odoc_messages.default_latex_class_type_prefix
+let latex_attribute_prefix = ref Odoc_messages.default_latex_attribute_prefix
+let latex_method_prefix = ref Odoc_messages.default_latex_method_prefix
+
 let new_buf () = Buffer.create 1024
 let new_fmt () =
   let b = new_buf () in
@@ -60,81 +82,91 @@
        and with the given latex code. *)
     method section_style level s =
       try
-        let sec = List.assoc level !Args.latex_titles in
+        let sec = List.assoc level !latex_titles in
         "\\"^sec^"{"^s^"}\n"
       with Not_found -> s
 
-    (** Associations of strings to subsitute in latex code. *)
-    val mutable subst_strings = [
-      ("MAXENCE"^"ZZZ", "\\$");
-      ("MAXENCE"^"YYY", "\\&");
-      ("MAXENCE"^"XXX", "{\\textbackslash}") ;
-      ("à", "\\`a") ;
-      ("â", "\\^a") ;
-      ("é", "\\'e") ;
-      ("è", "\\`e") ;
-      ("ê", "\\^e") ;
-      ("ë", "\\\"e") ;
-      ("ç", "\\c{c}") ;
-      ("ô", "\\^o") ;
-      ("ö", "\\\"o") ;
-      ("î", "\\^i") ;
-      ("ï", "\\\"i") ;
-      ("ù", "\\`u") ;
-      ("û", "\\^u") ;
-      ("%", "\\%") ;
-      ("_", "\\_");
-      ("\\.\\.\\.", "$\\ldots$");
-      ("~", "\\~{}");
-      ("#", "\\verb`#`");
-      ("}", "\\}");
-      ("{", "\\{");
-      ("&", "\\&");
-      (">", "$>$");
-      ("<", "$<$");
-      ("=", "$=$");
-      (">=", "$\\geq$");
-      ("<=", "$\\leq$");
-      ("->", "$\\rightarrow$") ;
-      ("<-", "$\\leftarrow$");
-      ("|", "\\textbar ");
-      ("\\^", "\\textasciicircum ") ;
-      ("\\.\\.\\.", "$\\ldots$");
-      ("\\\\", "MAXENCE"^"XXX") ;
-      ("&", "MAXENCE"^"YYY") ;
-      ("\\$", "MAXENCE"^"ZZZ");
-    ]
+    (** Associations of strings to substitute in latex code. *)
+    val subst_strings = List.map (fun (x, y) -> (Str.regexp x, y))
+      [
+        "\001", "\001\002";
+        "\\\\", "\001b";
+
+        "{", "\\\\{";
+        "}", "\\\\}";
+        "\\$", "\\\\$";
+        "\\^", "{\\\\textasciicircum}";
+        "\xE0", "\\\\`a";
+        "\xE2", "\\\\^a";
+        "\xE9", "\\\\'e";
+        "\xE8", "\\\\`e";
+        "\xEA", "\\\\^e";
+        "\xEB", "\\\\\"e";
+        "\xE7", "\\\\c{c}";
+        "\xF4", "\\\\^o";
+        "\xF6", "\\\\\"o";
+        "\xEE", "\\\\^i";
+        "\xEF", "\\\\\"i";
+        "\xF9", "\\\\`u";
+        "\xFB", "\\\\^u";
+        "%", "\\\\%";
+        "_", "\\\\_";
+        "~", "\\\\~{}";
+        "#", "{\\char35}";
+        "->", "$\\\\rightarrow$";
+        "<-", "$\\\\leftarrow$";
+        ">=", "$\\\\geq$";
+        "<=", "$\\\\leq$";
+        ">", "$>$";
+        "<", "$<$";
+        "=", "$=$";
+        "|", "{\\\\textbar}";
+        "\\.\\.\\.", "$\\\\ldots$";
+        "&", "\\\\&";
 
-    val mutable subst_strings_simple =
+        "\001b", "{\\\\char92}";
+        "\001\002", "\001";
+      ]
+
+    val subst_strings_simple = List.map (fun (x, y) -> (Str.regexp x, y))
       [
-        ("MAXENCE"^"XXX", "{\\textbackslash}") ;
-        "}", "\\}" ;
-        "{", "\\{" ;
-        ("\\\\", "MAXENCE"^"XXX") ;
+        "\001", "\001\002";
+        "\\\\", "\001b";
+        "{", "\001l";
+
+        "}", "{\\\\char125}";
+        "'", "{\\\\textquotesingle}";
+        "`", "{\\\\textasciigrave}";
+
+        "\001b", "{\\\\char92}";
+        "\001l", "{\\\\char123}";
+        "\001\002", "\001";
       ]
 
-    val mutable subst_strings_code = [
-      ("MAXENCE"^"ZZZ", "\\$");
-      ("MAXENCE"^"YYY", "\\&");
-      ("MAXENCE"^"XXX", "{\\textbackslash}") ;
-      ("%", "\\%") ;
-      ("_", "\\_");
-      ("~", "\\~{}");
-      ("#", "\\verb`#`");
-      ("}", "\\}");
-      ("{", "\\{");
-      ("&", "\\&");
-      ("\\^", "\\textasciicircum ") ;
-      ("&", "MAXENCE"^"YYY") ;
-      ("\\$", "MAXENCE"^"ZZZ") ;
-      ("\\\\", "MAXENCE"^"XXX") ;
-     ]
+    val subst_strings_code = List.map (fun (x, y) -> (Str.regexp x, y))
+      [
+        "\001", "\001\002";
+        "\\\\", "\001b";
+        "{", "\001l";
+
+        "}", "{\\\\char125}";
+        "'", "{\\\\textquotesingle}";
+        "`", "{\\\\textasciigrave}";
+        "%", "\\\\%";
+        "_", "\\\\_";
+        "~", "{\\\\char126}";
+        "#", "{\\\\char35}";
+        "&", "\\\\&";
+        "\\$", "\\\\$";
+        "\\^", "{\\\\char94}";
+
+        "\001b", "{\\\\char92}";
+        "\001l", "{\\\\char123}";
+        "\001\002", "\001";
+      ]
 
     method subst l s =
-      List.fold_right
-        (fun (s, s2) -> fun acc -> Str.global_replace (Str.regexp s) s2 acc)
-        l
-        s
+      List.fold_left (fun acc (re, st) -> Str.global_replace re st acc) s l
 
     (** Escape the strings which would clash with LaTeX syntax. *)
     method escape s = self#subst subst_strings s
@@ -182,31 +214,37 @@
       Buffer.contents buf
 
     (** Make a correct label from a value name. *)
-    method value_label ?no_ name = !Args.latex_value_prefix^(self#label ?no_ name)
+    method value_label ?no_ name = !latex_value_prefix^(self#label ?no_ name)
 
     (** Make a correct label from an attribute name. *)
-    method attribute_label ?no_ name = !Args.latex_attribute_prefix^(self#label ?no_ name)
+    method attribute_label ?no_ name = !latex_attribute_prefix^(self#label ?no_ name)
 
     (** Make a correct label from a method name. *)
-    method method_label ?no_ name = !Args.latex_method_prefix^(self#label ?no_ name)
+    method method_label ?no_ name = !latex_method_prefix^(self#label ?no_ name)
 
     (** Make a correct label from a class name. *)
-    method class_label ?no_ name = !Args.latex_class_prefix^(self#label ?no_ name)
+    method class_label ?no_ name = !latex_class_prefix^(self#label ?no_ name)
 
     (** Make a correct label from a class type name. *)
-    method class_type_label ?no_ name = !Args.latex_class_type_prefix^(self#label ?no_ name)
+    method class_type_label ?no_ name = !latex_class_type_prefix^(self#label ?no_ name)
 
     (** Make a correct label from a module name. *)
-    method module_label ?no_ name = !Args.latex_module_prefix^(self#label ?no_ name)
+    method module_label ?no_ name = !latex_module_prefix^(self#label ?no_ name)
 
     (** Make a correct label from a module type name. *)
-    method module_type_label ?no_ name = !Args.latex_module_type_prefix^(self#label ?no_ name)
+    method module_type_label ?no_ name = !latex_module_type_prefix^(self#label ?no_ name)
 
     (** Make a correct label from an exception name. *)
-    method exception_label ?no_ name = !Args.latex_exception_prefix^(self#label ?no_ name)
+    method exception_label ?no_ name = !latex_exception_prefix^(self#label ?no_ name)
 
     (** Make a correct label from a type name. *)
-    method type_label ?no_ name = !Args.latex_type_prefix^(self#label ?no_ name)
+    method type_label ?no_ name = !latex_type_prefix^(self#label ?no_ name)
+
+    (** Make a correct label from a record field. *)
+    method recfield_label ?no_ name = !latex_type_elt_prefix^(self#label ?no_ name)
+
+    (** Make a correct label from a variant constructor. *)
+    method const_label ?no_ name = !latex_type_elt_prefix^(self#label ?no_ name)
 
     (** Return latex code for the label of a given label. *)
     method make_label label = "\\label{"^label^"}"
@@ -269,9 +307,9 @@
       ps fmt "\n\\end{ocamldoccode}\n"
 
     method latex_of_Verbatim fmt s =
-      ps fmt "\\begin{verbatim}";
+      ps fmt "\n\\begin{verbatim}\n";
       ps fmt s;
-      ps fmt "\\end{verbatim}"
+      ps fmt "\n\\end{verbatim}\n"
 
     method latex_of_Bold fmt t =
       ps fmt "{\\bf ";
@@ -377,6 +415,8 @@
             | Odoc_info.RK_attribute -> self#attribute_label
             | Odoc_info.RK_method -> self#method_label
             | Odoc_info.RK_section _ -> assert false
+            | Odoc_info.RK_recfield -> self#recfield_label
+            | Odoc_info.RK_const -> self#const_label
           in
           let text =
             match text_opt with
@@ -413,6 +453,8 @@
         (self#text_of_info ~block info_opt)
   end
 
+module Generator =
+struct
 (** This class is used to create objects which can generate a simple LaTeX documentation. *)
 class latex =
   object (self)
@@ -517,12 +559,22 @@
                     let s_cons =
                       p fmt2 "@[  | %s" constr.vc_name;
                       (
-                       match constr.vc_args with
-                         [] -> ()
-                       | l ->
+                       match constr.vc_args, constr.vc_ret with
+                         [], None -> ()
+                       | l, None ->
                            p fmt2 " %s@ %s"
                              "of"
                              (self#normal_type_list ~par: false mod_name " * " l)
+                       | [], Some r ->
+                           p fmt2 " %s@ %s"
+                             ":"
+                             (self#normal_type mod_name r)
+                       | l, Some r ->
+                           p fmt2 " %s@ %s@ %s@ %s"
+                             ":"
+                             (self#normal_type_list ~par: false mod_name " * " l)
+                             "->"
+                             (self#normal_type mod_name r)
                       );
                       flush2 ()
                     in
@@ -650,7 +702,7 @@
           self#latex_of_module_kind fmt father k2;
           self#latex_of_text fmt [Code ")"]
       | Module_with (k, s) ->
-          (* TODO: à modifier quand Module_with sera plus détaillé *)
+          (* TODO: a modifier quand Module_with sera plus detaille *)
           self#latex_of_module_type_kind fmt father k;
           self#latex_of_text fmt
             [ Code " ";
@@ -679,7 +731,7 @@
           self#latex_of_text fmt [Latex "\\end{ocamldocobjectend}\n"]
 
       | Class_apply capp ->
-          (* TODO: afficher le type final à partir du typedtree *)
+          (* TODO: afficher le type final a partir du typedtree *)
           self#latex_of_text fmt [Raw "class application not handled yet"]
 
       | Class_constr cco ->
@@ -1078,11 +1130,12 @@
       ps fmt "\\documentclass[11pt]{article} \n";
       ps fmt "\\usepackage[latin1]{inputenc} \n";
       ps fmt "\\usepackage[T1]{fontenc} \n";
+      ps fmt "\\usepackage{textcomp}\n";
       ps fmt "\\usepackage{fullpage} \n";
       ps fmt "\\usepackage{url} \n";
       ps fmt "\\usepackage{ocamldoc}\n";
       (
-       match !Args.title with
+       match !Global.title with
          None -> ()
        | Some s ->
            ps fmt "\\title{";
@@ -1090,15 +1143,15 @@
            ps fmt "}\n"
       );
       ps fmt "\\begin{document}\n";
-      (match !Args.title with
+      (match !Global.title with
         None -> () |
         Some _ -> ps fmt "\\maketitle\n"
       );
-      if !Args.with_toc then ps fmt "\\tableofcontents\n";
+      if !Global.with_toc then ps fmt "\\tableofcontents\n";
       (
        let info = Odoc_info.apply_opt
            (Odoc_info.info_of_comment_file module_list)
-           !Odoc_info.Args.intro_file
+           !Odoc_info.Global.intro_file
        in
        (match info with None -> () | Some _ -> ps fmt "\\vspace{0.2cm}");
        self#latex_of_info fmt info;
@@ -1109,7 +1162,7 @@
     (** Generate the LaTeX style file, if it does not exists. *)
     method generate_style_file =
       try
-        let dir = Filename.dirname !Args.out_file in
+        let dir = Filename.dirname !Global.out_file in
         let file = Filename.concat dir "ocamldoc.sty" in
         if Sys.file_exists file then
           Odoc_info.verbose (Odoc_messages.file_exists_dont_generate file)
@@ -1126,12 +1179,12 @@
           prerr_endline s ;
           incr Odoc_info.errors ;
 
-    (** Generate the LaTeX file from a module list, in the {!Odoc_info.Args.out_file} file. *)
+    (** Generate the LaTeX file from a module list, in the {!Odoc_info.Global.out_file} file. *)
     method generate module_list =
       self#generate_style_file ;
-      let main_file = !Args.out_file in
+      let main_file = !Global.out_file in
       let dir = Filename.dirname main_file in
-      if !Args.separate_files then
+      if !separate_files then
         (
          let f m =
            try
@@ -1154,16 +1207,16 @@
       try
         let chanout = open_out main_file in
         let fmt = Format.formatter_of_out_channel chanout in
-        if !Args.with_header then self#latex_header fmt module_list;
+        if !Global.with_header then self#latex_header fmt module_list;
         List.iter
           (fun m ->
-            if !Args.separate_files then
+            if !separate_files then
               ps fmt ("\\input{"^((Name.simple m.m_name))^".tex}\n")
             else
               self#generate_for_top_module fmt m
           )
           module_list ;
-        if !Args.with_trailer then ps fmt "\\end{document}";
+        if !Global.with_trailer then ps fmt "\\end{document}";
         Format.pp_print_flush fmt ();
         close_out chanout
       with
@@ -1172,3 +1225,6 @@
           prerr_endline s ;
           incr Odoc_info.errors
   end
+end
+
+module type Latex_generator = module type of Generator
diff -Nru ocaml-3.12.1/ocamldoc/odoc_latex_style.ml ocaml-4.01.0/ocamldoc/odoc_latex_style.ml
--- ocaml-3.12.1/ocamldoc/odoc_latex_style.ml	2010-09-29 16:46:54.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_latex_style.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -11,8 +12,6 @@
 
 (** The content of the LaTeX style to generate when generating LaTeX code. *)
 
-(* $Id: odoc_latex_style.ml 10695 2010-09-29 16:46:54Z doligez $ *)
-
 let content ="\
 \n%% Support macros for LaTeX documentation generated by ocamldoc.\
 \n%% This file is in the public domain; do what you want with it.\
diff -Nru ocaml-3.12.1/ocamldoc/odoc_lexer.mll ocaml-4.01.0/ocamldoc/odoc_lexer.mll
--- ocaml-3.12.1/ocamldoc/odoc_lexer.mll	2010-05-31 11:52:13.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_lexer.mll	2013-08-05 07:56:27.000000000 +0000
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_lexer.mll 10480 2010-05-31 11:52:13Z guesdon $ *)
-
 (** The lexer for special comments. *)
 
 open Lexing
@@ -22,10 +20,10 @@
 
 let string_buffer = Buffer.create 32
 
-(** Fonction de remise à zéro de la chaine de caractères tampon *)
+(** Fonction de remise a zero de la chaine de caracteres tampon *)
 let reset_string_buffer () = Buffer.reset string_buffer
 
-(** Fonction d'ajout d'un caractère dans la chaine de caractères tampon *)
+(** Fonction d'ajout d'un caractere dans la chaine de caracteres tampon *)
 let ajout_char_string = Buffer.add_char string_buffer
 
 (** Add a string to the buffer. *)
@@ -178,7 +176,7 @@
            let s2 = lecture_string () in
            let s3 = remove_blanks s2 in
            let s4 =
-             if !Odoc_args.remove_stars then
+             if !Odoc_global.remove_stars then
                remove_stars s3
              else
                s3
@@ -244,14 +242,14 @@
         if !comments_level = 1 then
           (* finally we return the description we kept *)
           let desc =
-            if !Odoc_args.remove_stars then
+            if !Odoc_global.remove_stars then
               remove_stars !description
              else
               !description
           in
           let remain = lecture_string () in
           let remain2 =
-            if !Odoc_args.remove_stars then
+            if !Odoc_global.remove_stars then
               remove_stars remain
              else
                remain
@@ -295,6 +293,10 @@
         incr Odoc_comments_global.nb_chars;
         print_DEBUG2 "newline";
         elements lexbuf }
+  | "@"
+      {
+        raise (Failure (Odoc_messages.should_escape_at_sign))
+      }
 
   | "@"lowercase+
       {
@@ -322,7 +324,7 @@
          | "return" ->
              T_RETURN
          | s ->
-             if !Odoc_args.no_custom_tags then
+             if !Odoc_global.no_custom_tags then
                raise (Failure (Odoc_messages.not_a_valid_tag s))
              else
                T_CUSTOM s
@@ -341,6 +343,10 @@
       {
         EOF
       }
+  | _ {
+        let s = Lexing.lexeme lexbuf in
+        failwith ("Unexpected character '"^s^"'")
+      }
 
 
 and simple = parse
diff -Nru ocaml-3.12.1/ocamldoc/odoc_man.ml ocaml-4.01.0/ocamldoc/odoc_man.ml
--- ocaml-3.12.1/ocamldoc/odoc_man.ml	2010-05-31 11:52:13.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_man.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_man.ml 10480 2010-05-31 11:52:13Z guesdon $ *)
-
 (** The man pages generator. *)
 open Odoc_info
 open Parameter
@@ -21,6 +20,11 @@
 open Module
 open Search
 
+let man_suffix = ref Odoc_messages.default_man_suffix
+let man_section = ref Odoc_messages.default_man_section
+
+let man_mini = ref false
+
 let new_buf () = Buffer.create 1024
 let bp = Printf.bprintf
 let bs = Buffer.add_string
@@ -202,6 +206,9 @@
           self#man_of_custom b info.M.i_custom
   end
 
+module Generator =
+struct
+
 (** This class is used to create objects which can generate a simple html documentation. *)
 class man =
   let re_slash = Str.regexp_string "/" in
@@ -210,7 +217,7 @@
 
     (** Get a file name from a complete name. *)
     method file_name name =
-      let s = Printf.sprintf "%s.%s" name !Args.man_suffix in
+      let s = Printf.sprintf "%s.%s" name !man_suffix in
       Str.global_replace re_slash "slash" s
 
     (** Escape special sequences of characters in a string. *)
@@ -229,7 +236,7 @@
 
     (** Open a file for output. Add the target directory.*)
     method open_out file =
-      let f = Filename.concat !Args.target_dir file in
+      let f = Filename.concat !Global.target_dir file in
       open_out f
 
     (** Print groff string for a text, without correction of blanks. *)
@@ -453,23 +460,49 @@
             (fun constr ->
               bs b ("| "^constr.vc_name);
               (
-               match constr.vc_args, constr.vc_text with
-                 [], None -> bs b "\n "
-               | [], (Some t) ->
+               match constr.vc_args, constr.vc_text,constr.vc_ret with
+               | [], None, None -> bs b "\n "
+               | [], (Some t), None ->
                    bs b "  (* ";
                    self#man_of_text b t;
                    bs b " *)\n "
-               | l, None ->
+               | l, None, None ->
                    bs b "\n.B of ";
                    self#man_of_type_expr_list ~par: false b father " * " l;
                    bs b " "
-               | l, (Some t) ->
+               | l, (Some t), None ->
                    bs b "\n.B of ";
                    self#man_of_type_expr_list ~par: false b father " * " l;
                    bs b ".I \"  \"\n";
                    bs b "(* ";
                    self#man_of_text b t;
                    bs b " *)\n "
+               | [], None, Some r ->
+                   bs b "\n.B : ";
+                   self#man_of_type_expr b father r;
+                   bs b " "
+               | [], (Some t), Some r ->
+                   bs b "\n.B : ";
+                   self#man_of_type_expr b father r;
+                   bs b ".I \"  \"\n";
+                   bs b "(* ";
+                   self#man_of_text b t;
+                   bs b " *)\n "
+               | l, None, Some r ->
+                   bs b "\n.B : ";
+                   self#man_of_type_expr_list ~par: false b father " * " l;
+                   bs b ".B -> ";
+                   self#man_of_type_expr b father r;
+                   bs b " "
+               | l, (Some t), Some r ->
+                   bs b "\n.B of ";
+                   self#man_of_type_expr_list ~par: false b father " * " l;
+                   bs b ".B -> ";
+                   self#man_of_type_expr b father r;
+                   bs b ".I \"  \"\n";
+                   bs b "(* ";
+                   self#man_of_text b t;
+                   bs b " *)\n "
               )
             )
             l
@@ -693,10 +726,10 @@
         let chanout = self#open_out file in
         let b = new_buf () in
         bs b (".TH \""^cl.cl_name^"\" ");
-        bs b !Odoc_args.man_section ;
+        bs b !man_section ;
         bs b (" "^(Odoc_misc.string_of_date ~hour: false date)^" ");
         bs b "OCamldoc ";
-        bs b ("\""^(match !Args.title with Some t -> t | None -> "")^"\"\n");
+        bs b ("\""^(match !Global.title with Some t -> t | None -> "")^"\"\n");
 
         let abstract =
           match cl.cl_info with
@@ -752,10 +785,10 @@
         let chanout = self#open_out file in
         let b = new_buf () in
         bs b (".TH \""^ct.clt_name^"\" ");
-        bs b !Odoc_args.man_section ;
+        bs b !man_section ;
         bs b (" "^(Odoc_misc.string_of_date ~hour: false date)^" ");
         bs b "OCamldoc ";
-        bs b ("\""^(match !Args.title with Some t -> t | None -> "")^"\"\n");
+        bs b ("\""^(match !Global.title with Some t -> t | None -> "")^"\"\n");
 
         let abstract =
           match ct.clt_info with
@@ -809,10 +842,10 @@
         let chanout = self#open_out file in
         let b = new_buf () in
         bs b (".TH \""^mt.mt_name^"\" ");
-        bs b !Odoc_args.man_section ;
+        bs b !man_section ;
         bs b (" "^(Odoc_misc.string_of_date ~hour: false date)^" ");
         bs b "OCamldoc ";
-        bs b ("\""^(match !Args.title with Some t -> t | None -> "")^"\"\n");
+        bs b ("\""^(match !Global.title with Some t -> t | None -> "")^"\"\n");
 
         let abstract =
           match mt.mt_info with
@@ -887,10 +920,10 @@
         let chanout = self#open_out file in
         let b = new_buf () in
         bs b (".TH \""^m.m_name^"\" ");
-        bs b !Odoc_args.man_section ;
+        bs b !man_section ;
         bs b (" "^(Odoc_misc.string_of_date ~hour: false date)^" ");
         bs b "OCamldoc ";
-        bs b ("\""^(match !Args.title with Some t -> t | None -> "")^"\"\n");
+        bs b ("\""^(match !Global.title with Some t -> t | None -> "")^"\"\n");
 
         let abstract =
           match m.m_info with
@@ -965,6 +998,8 @@
         | Res_attribute a -> Name.simple a.att_value.val_name
         | Res_method m -> Name.simple m.met_value.val_name
         | Res_section _ -> assert false
+        | Res_recfield (_,f) -> f.rf_name
+        | Res_const (_,f) -> f.vc_name
       in
       let all_items_pre = Odoc_info.Search.search_by_name module_list (Str.regexp ".*")  in
       let all_items = List.filter
@@ -1006,6 +1041,8 @@
           | Res_attribute a -> a.att_value.val_name
           | Res_method m -> m.met_value.val_name
           | Res_section (s,_) -> s
+          | Res_recfield (_,f) -> f.rf_name
+          | Res_const (_,f) -> f.vc_name
          )
      in
      let date = Unix.time () in
@@ -1014,10 +1051,10 @@
         let chanout = self#open_out file in
         let b = new_buf () in
         bs b (".TH \""^name^"\" ");
-        bs b !Odoc_args.man_section ;
+        bs b !man_section ;
         bs b (" "^(Odoc_misc.string_of_date ~hour: false date)^" ");
         bs b "OCamldoc ";
-        bs b ("\""^(match !Args.title with Some t -> t | None -> "")^"\"\n");
+        bs b ("\""^(match !Global.title with Some t -> t | None -> "")^"\"\n");
         bs b ".SH NAME\n";
         bs b (name^" \\- all "^name^" elements\n\n");
 
@@ -1069,10 +1106,13 @@
         | [Res_class cl] -> self#generate_for_class cl
         | [Res_class_type ct] -> self#generate_for_class_type ct
         | l ->
-            if !Args.man_mini then
+            if !man_mini then
               ()
             else
               self#generate_for_group l
       in
       List.iter f groups
   end
+end
+
+module type Man_generator = module type of Generator
diff -Nru ocaml-3.12.1/ocamldoc/odoc_merge.ml ocaml-4.01.0/ocamldoc/odoc_merge.ml
--- ocaml-3.12.1/ocamldoc/odoc_merge.ml	2010-11-30 08:08:24.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_merge.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_merge.ml 10871 2010-11-30 08:08:24Z xclerc $ *)
-
 (** Merge of information from [.ml] and [.mli] for a module.*)
 
 open Odoc_types
@@ -253,7 +252,7 @@
           cons.vc_text <- new_desc
         with
           Not_found ->
-            if !Odoc_args.inverse_merge_ml_mli then
+            if !Odoc_global.inverse_merge_ml_mli then
               ()
             else
               raise (Failure (Odoc_messages.different_types mli.ty_name))
@@ -281,7 +280,7 @@
           record.rf_text <- new_desc
         with
           Not_found ->
-            if !Odoc_args.inverse_merge_ml_mli then
+            if !Odoc_global.inverse_merge_ml_mli then
               ()
             else
               raise (Failure (Odoc_messages.different_types mli.ty_name))
@@ -289,7 +288,7 @@
       List.iter f l1
 
   | _ ->
-      if !Odoc_args.inverse_merge_ml_mli then
+      if !Odoc_global.inverse_merge_ml_mli then
         ()
       else
         raise (Failure (Odoc_messages.different_types mli.ty_name))
@@ -357,7 +356,7 @@
                      a.att_value.val_info <- merge_info_opt merge_options
                          a.att_value.val_info a2.att_value.val_info;
                      a.att_value.val_loc <- { a.att_value.val_loc with loc_impl = a2.att_value.val_loc.loc_impl } ;
-                     if !Odoc_args.keep_code then
+                     if !Odoc_global.keep_code then
                        a.att_value.val_code <- a2.att_value.val_code;
                      true
                     )
@@ -396,7 +395,7 @@
                         parameters because the associated comment of a parameter may have been changed by the merge.*)
                      Odoc_value.update_value_parameters_text m.met_value;
 
-                     if !Odoc_args.keep_code then
+                     if !Odoc_global.keep_code then
                        m.met_value.val_code <- m2.met_value.val_code;
 
                      true
@@ -434,7 +433,7 @@
                      a.att_value.val_info <- merge_info_opt merge_options
                          a.att_value.val_info a2.att_value.val_info;
                      a.att_value.val_loc <- { a.att_value.val_loc with loc_impl = a2.att_value.val_loc.loc_impl } ;
-                     if !Odoc_args.keep_code then
+                     if !Odoc_global.keep_code then
                        a.att_value.val_code <- a2.att_value.val_code;
 
                      true
@@ -473,7 +472,7 @@
                         parameters because the associated comment of a parameter may have been changed y the merge.*)
                      Odoc_value.update_value_parameters_text m.met_value;
 
-                     if !Odoc_args.keep_code then
+                     if !Odoc_global.keep_code then
                        m.met_value.val_code <- m2.met_value.val_code;
 
                      true
@@ -637,7 +636,7 @@
                         parameters because the associated comment of a parameter may have been changed y the merge.*)
                      Odoc_value.update_value_parameters_text v;
 
-                     if !Odoc_args.keep_code then
+                     if !Odoc_global.keep_code then
                        v.val_code <- v2.val_code;
 
                      true
@@ -727,7 +726,7 @@
   mli.m_top_deps <- remove_doubles mli.m_top_deps ml.m_top_deps ;
 
   let code =
-    if !Odoc_args.keep_code then
+    if !Odoc_global.keep_code then
       match mli.m_code, ml.m_code with
         Some s, _ -> Some s
       | _, Some s -> Some s
@@ -736,7 +735,7 @@
       None
   in
   let code_intf =
-    if !Odoc_args.keep_code then
+    if !Odoc_global.keep_code then
       match mli.m_code_intf, ml.m_code_intf with
         Some s, _ -> Some s
       | _, Some s -> Some s
@@ -883,7 +882,7 @@
                     parameters because the associated comment of a parameter may have been changed y the merge.*)
                  Odoc_value.update_value_parameters_text v;
 
-                 if !Odoc_args.keep_code then
+                 if !Odoc_global.keep_code then
                    v.val_code <- v2.val_code;
                  true
                 )
@@ -975,19 +974,19 @@
             (
              (* we can merge m with m2 if there is an implementation
                 and an interface.*)
-             let f b = if !Odoc_args.inverse_merge_ml_mli then not b else b in
+             let f b = if !Odoc_global.inverse_merge_ml_mli then not b else b in
              match f m.m_is_interface, f m2.m_is_interface with
                true, false -> (merge_modules merge_options m m2) :: (iter l_others)
              | false, true -> (merge_modules merge_options m2 m) :: (iter l_others)
              | false, false ->
-                 if !Odoc_args.inverse_merge_ml_mli then
+                 if !Odoc_global.inverse_merge_ml_mli then
                    (* two Module.ts for the .mli ! *)
                    raise (Failure (Odoc_messages.two_interfaces m.m_name))
                  else
                    (* two Module.t for the .ml ! *)
                    raise (Failure (Odoc_messages.two_implementations m.m_name))
              | true, true ->
-                 if !Odoc_args.inverse_merge_ml_mli then
+                 if !Odoc_global.inverse_merge_ml_mli then
                    (* two Module.t for the .ml ! *)
                    raise (Failure (Odoc_messages.two_implementations m.m_name))
                  else
@@ -995,7 +994,7 @@
                    raise (Failure (Odoc_messages.two_interfaces m.m_name))
             )
         | _ ->
-            (* two many Module.t ! *)
+            (* too many Module.t ! *)
             raise (Failure (Odoc_messages.too_many_module_objects m.m_name))
 
   in
diff -Nru ocaml-3.12.1/ocamldoc/odoc_merge.mli ocaml-4.01.0/ocamldoc/odoc_merge.mli
--- ocaml-3.12.1/ocamldoc/odoc_merge.mli	2010-05-31 11:52:13.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_merge.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,11 +10,9 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_merge.mli 10480 2010-05-31 11:52:13Z guesdon $ *)
-
 (** Merge of information from [.ml] and [.mli] for a module.*)
 
-(** Merging \@before tags. *)
+(** Merging \@before tags. *)
 val merge_before_tags :
     (string * Odoc_types.text) list -> (string * Odoc_types.text) list
 
diff -Nru ocaml-3.12.1/ocamldoc/odoc_messages.ml ocaml-4.01.0/ocamldoc/odoc_messages.ml
--- ocaml-3.12.1/ocamldoc/odoc_messages.ml	2011-05-05 11:28:57.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_messages.ml	2013-08-05 07:56:27.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_messages.ml 11027 2011-05-05 11:28:57Z doligez $ *)
-
 (** The messages of the application. *)
 
 let ok = "Ok"
@@ -35,6 +34,7 @@
 let include_dirs = "\tAdd  to the list of include directories"
 let rectypes = "\tAllow arbitrary recursive types"
 let preprocess = "\tPipe sources through preprocessor "
+let ppx = "\n\t\tPipe abstract syntax tree through preprocessor "
 let option_impl ="\tConsider  as a .ml file"
 let option_intf ="\tConsider  as a .mli file"
 let option_text ="\tConsider  as a .txt file"
@@ -127,6 +127,11 @@
   "\n\t\tUse  as prefix for the LaTeX labels of types.\n"^
   "\t\t(default is \""^default_latex_type_prefix^"\")"
 
+let default_latex_type_elt_prefix = "typeelt:"
+let latex_type_elt_prefix =
+  "\n\t\tUse  as prefix for the LaTeX labels of type elements.\n"^
+  "\t\t(default is \""^default_latex_type_elt_prefix^"\")"
+
 let default_latex_exception_prefix = "exception:"
 let latex_exception_prefix =
   "\n\t\tUse  as prefix for the LaTeX labels of exceptions.\n"^
@@ -218,9 +223,6 @@
 (** Error and warning messages *)
 
 let warning = "Warning"
-let pwarning s =
-  if !Odoc_config.print_warnings then prerr_endline (warning^": "^s);
-  if !Odoc_global.warn_error then incr Odoc_global.errors
 
 let bad_magic_number =
   "Bad magic number for this ocamldoc dump!\n"^
@@ -244,17 +246,18 @@
     (String.concat "\n" paths)
 
 let tag_not_handled tag = "Tag @"^tag^" not handled by this generator"
+let should_escape_at_sign = "The character @ has a special meaning in ocamldoc comments, for commands such as @raise or @since. If you want to write a single @, you must escape it as \\@."
 let bad_tree = "Incorrect tree structure."
 let not_a_valid_tag s = s^" is not a valid tag."
 let fun_without_param f = "Function "^f^" has no parameter.";;
-let method_without_param f = "Méthode "^f^" has no parameter.";;
+let method_without_param f = "Method "^f^" has no parameter.";;
 let anonymous_parameters f = "Function "^f^" has anonymous parameters."
 let function_colon f = "Function "^f^": "
 let implicit_match_in_parameter = "Parameters contain implicit pattern matching."
 let unknown_extension f = "Unknown extension for file "^f^"."
 let two_implementations name = "There are two implementations of module "^name^"."
 let two_interfaces name = "There are two interfaces of module "^name^"."
-let too_many_module_objects name = "There are two many interfaces/implementation of module "^name^"."
+let too_many_module_objects name = "There are too many interfaces/implementation of module "^name^"."
 let exception_not_found_in_implementation exc m = "Exception "^exc^" was not found in implementation of module "^m^"."
 let type_not_found_in_implementation exc m = "Type "^exc^" was not found in implementation of module "^m^"."
 let module_not_found_in_implementation m m2 = "Module "^m^" was not found in implementation of module "^m2^"."
@@ -297,11 +300,17 @@
 let cross_section_not_found n = "Section "^n^" not found"
 let cross_value_not_found n = "Value "^n^" not found"
 let cross_type_not_found n = "Type "^n^" not found"
+let cross_recfield_not_found n = Printf.sprintf "Record field %s not found" n
+let cross_const_not_found n = Printf.sprintf "Constructor %s not found" n
 
 let object_end = "object ... end"
 let struct_end = "struct ... end"
 let sig_end = "sig ... end"
 
+let current_generator_is_not kind =
+  Printf.sprintf "Current generator is not a %s generator" kind
+;;
+
 (** Messages for verbose mode. *)
 
 let analysing f = "Analysing file "^f^"..."
diff -Nru ocaml-3.12.1/ocamldoc/odoc_misc.ml ocaml-4.01.0/ocamldoc/odoc_misc.ml
--- ocaml-3.12.1/ocamldoc/odoc_misc.ml	2010-03-08 16:54:13.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_misc.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_misc.ml 9638 2010-03-08 16:54:13Z guesdon $ *)
-
 let no_blanks s =
   let len = String.length s in
   let buf = Buffer.create len in
@@ -334,7 +333,7 @@
     let len = String.length s in
     let n = String.index s '.' in
     if n + 1 >= len then
-      (* le point est le dernier caractère *)
+      (* le point est le dernier caractere *)
       (true, s, "")
     else
       match s.[n+1] with
@@ -478,8 +477,8 @@
     match t with
     | Types.Tconstr(path, [ty], _) when Path.same path Predef.path_option -> ty.Types.desc
     | Types.Tconstr _
-    | Types.Tvar
-    | Types.Tunivar
+    | Types.Tvar _
+    | Types.Tunivar _
     | Types.Tpoly _
     | Types.Tarrow _
     | Types.Ttuple _
diff -Nru ocaml-3.12.1/ocamldoc/odoc_misc.mli ocaml-4.01.0/ocamldoc/odoc_misc.mli
--- ocaml-3.12.1/ocamldoc/odoc_misc.mli	2006-01-04 16:55:50.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_misc.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,9 +10,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_misc.mli 7307 2006-01-04 16:55:50Z doligez $ *)
-
-(** Miscelaneous functions *)
+(** Miscellaneous functions *)
 
 (** [no_blanks s] returns the given string without any blank
    characters, i.e. '\n' '\r' ' ' '\t'.
diff -Nru ocaml-3.12.1/ocamldoc/odoc_module.ml ocaml-4.01.0/ocamldoc/odoc_module.ml
--- ocaml-3.12.1/ocamldoc/odoc_module.ml	2010-05-03 15:06:17.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_module.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_module.ml 10355 2010-05-03 15:06:17Z guesdon $ *)
-
 (** Representation and manipulation of modules and module types. *)
 
 let print_DEBUG s = print_string s ; print_newline ()
@@ -238,7 +237,7 @@
         module_elements ~trans: trans
           { m_name = "" ;
             m_info = None ;
-            m_type = Types.Tmty_signature [] ;
+            m_type = Types.Mty_signature [] ;
             m_is_interface = false ; m_file = "" ; m_kind = k ;
             m_loc = Odoc_types.dummy_loc ;
             m_top_deps = [] ;
diff -Nru ocaml-3.12.1/ocamldoc/odoc_name.ml ocaml-4.01.0/ocamldoc/odoc_name.ml
--- ocaml-3.12.1/ocamldoc/odoc_name.ml	2010-06-14 11:13:29.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_name.ml	2013-05-28 11:04:11.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_name.ml 10565 2010-06-14 11:13:29Z guesdon $ *)
-
 (** Representation of element names. *)
 
 let infix_chars = [ '|' ;
@@ -52,11 +51,11 @@
         else
           match s.[n] with
             ' ' | '\t' | '\n' | '\r' -> iter_last (n-1)
-          |	_ -> Some n
+          | _ -> Some n
       in
       match iter_last (len-1) with
         None -> String.sub s first 1
-      |	Some last -> String.sub s first ((last-first)+1)
+      | Some last -> String.sub s first ((last-first)+1)
 
 let parens_if_infix name =
   match strip_string name with
@@ -151,10 +150,10 @@
     _ -> 1
 
 let prefix n1 n2 =
-  (n1 <> n2) &
+  (n1 <> n2) &&
   (try
     let len1 = String.length n1 in
-    ((String.sub n2 0 len1) = n1) &
+    ((String.sub n2 0 len1) = n1) &&
     (n2.[len1] = '.')
   with _ -> false)
 
@@ -162,10 +161,10 @@
   let (f1,s1) = head_and_tail n1 in
   let (f2,s2) = head_and_tail n2 in
   if f1 = f2 then
-    if f2 = s2 or s2 = "" then
+    if f2 = s2 || s2 = "" then
       s2
     else
-      if f1 = s1 or s1 = "" then
+      if f1 = s1 || s1 = "" then
         s2
       else
         get_relative_raw s1 s2
@@ -215,3 +214,9 @@
   | Some p -> p
 
 let from_longident = Odoc_misc.string_of_longident
+
+module Set = Set.Make (struct
+  type z = t
+  type t = z
+  let compare = String.compare
+end)
diff -Nru ocaml-3.12.1/ocamldoc/odoc_name.mli ocaml-4.01.0/ocamldoc/odoc_name.mli
--- ocaml-3.12.1/ocamldoc/odoc_name.mli	2010-06-14 11:13:29.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_name.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_name.mli 10565 2010-06-14 11:13:29Z guesdon $ *)
-
 (** Representation of element names. *)
 
 type t = string
@@ -67,3 +66,6 @@
 
 (** Get a name from a [Longident.t].*)
 val from_longident : Longident.t -> t
+
+(** Set of Name.t *)
+module Set : Set.S with type elt = t
diff -Nru ocaml-3.12.1/ocamldoc/odoc_ocamlhtml.mll ocaml-4.01.0/ocamldoc/odoc_ocamlhtml.mll
--- ocaml-3.12.1/ocamldoc/odoc_ocamlhtml.mll	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_ocamlhtml.mll	2012-10-15 17:50:56.000000000 +0000
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_ocamlhtml.mll 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** Generation of html code to display OCaml code. *)
 open Lexing
 
diff -Nru ocaml-3.12.1/ocamldoc/odoc_parameter.ml ocaml-4.01.0/ocamldoc/odoc_parameter.ml
--- ocaml-3.12.1/ocamldoc/odoc_parameter.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_parameter.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_parameter.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** Representation and manipulation of method / function / class parameters. *)
 
 let print_DEBUG s = print_string s ; print_newline ()
diff -Nru ocaml-3.12.1/ocamldoc/odoc_parser.mly ocaml-4.01.0/ocamldoc/odoc_parser.mly
--- ocaml-3.12.1/ocamldoc/odoc_parser.mly	2010-05-31 11:52:13.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_parser.mly	2012-10-15 17:50:56.000000000 +0000
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_parser.mly 10480 2010-05-31 11:52:13Z guesdon $ *)
-
 open Odoc_types
 open Odoc_comments_global
 
diff -Nru ocaml-3.12.1/ocamldoc/odoc_print.ml ocaml-4.01.0/ocamldoc/odoc_print.ml
--- ocaml-3.12.1/ocamldoc/odoc_print.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_print.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_print.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 open Format
 
 let new_fmt () =
@@ -55,15 +54,15 @@
 let simpl_module_type ?code t =
   let rec iter t =
     match t with
-      Types.Tmty_ident p -> t
-    | Types.Tmty_signature _ ->
+      Types.Mty_ident p -> t
+    | Types.Mty_signature _ ->
         (
          match code with
-           None -> Types.Tmty_signature []
+           None -> Types.Mty_signature []
          | Some s -> raise (Use_code s)
         )
-    | Types.Tmty_functor (id, mt1, mt2) ->
-        Types.Tmty_functor (id, iter mt1, iter mt2)
+    | Types.Mty_functor (id, mt1, mt2) ->
+        Types.Mty_functor (id, iter mt1, iter mt2)
   in
   iter t
 
@@ -80,20 +79,20 @@
 let simpl_class_type t =
   let rec iter t =
     match t with
-      Types.Tcty_constr (p,texp_list,ct) -> t
-    | Types.Tcty_signature cs ->
-        (* on vire les vals et methods pour ne pas qu'elles soient imprimées
+      Types.Cty_constr (p,texp_list,ct) -> t
+    | Types.Cty_signature cs ->
+        (* on vire les vals et methods pour ne pas qu'elles soient imprimees
            quand on affichera le type *)
         let tnil = { Types.desc = Types.Tnil ; Types.level = 0; Types.id = 0 } in
-        Types.Tcty_signature { Types.cty_self = { cs.Types.cty_self with
+        Types.Cty_signature { Types.cty_self = { cs.Types.cty_self with
                                                   Types.desc = Types.Tobject (tnil, ref None) };
                                Types.cty_vars = Types.Vars.empty ;
                                Types.cty_concr = Types.Concr.empty ;
                                Types.cty_inher = []
                              }
-    | Types.Tcty_fun (l, texp, ct) ->
+    | Types.Cty_fun (l, texp, ct) ->
         let new_ct = iter ct in
-        Types.Tcty_fun (l, texp, new_ct)
+        Types.Cty_fun (l, texp, new_ct)
   in
   iter t
 
diff -Nru ocaml-3.12.1/ocamldoc/odoc_print.mli ocaml-4.01.0/ocamldoc/odoc_print.mli
--- ocaml-3.12.1/ocamldoc/odoc_print.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_print.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_print.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** Printing functions. *)
 
 (** This function takes a Types.type_expr and returns a string.
diff -Nru ocaml-3.12.1/ocamldoc/odoc_scan.ml ocaml-4.01.0/ocamldoc/odoc_scan.ml
--- ocaml-3.12.1/ocamldoc/odoc_scan.ml	2010-05-21 12:00:49.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_scan.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_scan.ml 10450 2010-05-21 12:00:49Z doligez $ *)
-
 (** Scanning of modules and elements.
 
    The class scanner defined in this module can be used to
@@ -28,7 +27,18 @@
   (** Scan of 'leaf elements'. *)
 
     method scan_value (v : Odoc_value.t_value) = ()
-    method scan_type (t : Odoc_type.t_type) = ()
+
+    method scan_type_pre (t : Odoc_type.t_type) = true
+
+    method scan_type_recfield t (f : Odoc_type.record_field) = ()
+    method scan_type_const t (f : Odoc_type.variant_constructor) = ()
+    method scan_type (t : Odoc_type.t_type) =
+      if self#scan_type_pre t then
+        match t.Odoc_type.ty_kind with
+          Odoc_type.Type_abstract -> ()
+        | Odoc_type.Type_variant l -> List.iter (self#scan_type_const t) l
+        | Odoc_type.Type_record l -> List.iter (self#scan_type_recfield t) l
+
     method scan_exception (e : Odoc_exception.t_exception) = ()
     method scan_attribute (a : Odoc_value.t_attribute) = ()
     method scan_method (m : Odoc_value.t_method) = ()
@@ -45,7 +55,7 @@
     method scan_class_pre (c : Odoc_class.t_class) = true
 
     (** This method scan the elements of the given class.
-       A VOIR : scan des classes héritées.*)
+       A VOIR : scan des classes heritees.*)
     method scan_class_elements c =
       List.iter
         (fun ele ->
@@ -71,7 +81,7 @@
     method scan_class_type_pre (ct : Odoc_class.t_class_type) = true
 
     (** This method scan the elements of the given class type.
-       A VOIR : scan des classes héritées.*)
+       A VOIR : scan des classes heritees.*)
     method scan_class_type_elements ct =
       List.iter
         (fun ele ->
diff -Nru ocaml-3.12.1/ocamldoc/odoc_search.ml ocaml-4.01.0/ocamldoc/odoc_search.ml
--- ocaml-3.12.1/ocamldoc/odoc_search.ml	2010-03-08 16:54:13.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_search.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_search.ml 9638 2010-03-08 16:54:13Z guesdon $ *)
-
 (** Research of elements through modules. *)
 
 module Name = Odoc_name
@@ -32,6 +31,8 @@
   | Res_attribute of t_attribute
   | Res_method of t_method
   | Res_section of string * Odoc_types.text
+  | Res_recfield of t_type * record_field
+  | Res_const of t_type * variant_constructor
 
 type result = result_element list
 
@@ -43,7 +44,9 @@
     val p_class : t_class -> t -> bool * bool
     val p_class_type : t_class_type -> t -> bool * bool
     val p_value : t_value -> t -> bool
-    val p_type : t_type -> t -> bool
+    val p_recfield : t_type -> record_field -> t -> bool
+    val p_const : t_type -> variant_constructor -> t -> bool
+    val p_type : t_type -> t -> (bool * bool)
     val p_exception : t_exception -> t -> bool
     val p_attribute : t_attribute -> t -> bool
     val p_method : t_method -> t -> bool
@@ -92,7 +95,26 @@
 
     let search_value va v = if P.p_value va v then [Res_value va] else []
 
-    let search_type t v = if P.p_type t v then [Res_type t] else []
+    let search_recfield t f v =
+      if P.p_recfield t f v then [Res_recfield (t,f)] else []
+
+    let search_const t f v =
+      if P.p_const t f v then [Res_const (t,f)] else []
+
+    let search_type t v =
+      let (go_deeper, ok) = P.p_type t v in
+      let l =
+        match go_deeper with
+          false -> []
+        | true ->
+            match t.ty_kind with
+              Type_abstract -> []
+            | Type_record l ->
+                List.flatten (List.map (fun rf -> search_recfield t rf v) l)
+            | Type_variant l ->
+                List.flatten (List.map (fun rf -> search_const t rf v) l)
+      in
+      if ok then (Res_type t) :: l else l
 
     let search_exception e v = if P.p_exception e v then [Res_exception e] else []
 
@@ -305,7 +327,13 @@
     let p_class c r = (true, c.cl_name =~ r)
     let p_class_type ct r = (true, ct.clt_name =~ r)
     let p_value v r = v.val_name =~ r
-    let p_type t r = t.ty_name =~ r
+    let p_recfield t f r =
+      let name = Printf.sprintf "%s.%s" t.ty_name f.rf_name in
+      name =~ r
+    let p_const t f r =
+      let name = Printf.sprintf "%s.%s" t.ty_name f.vc_name in
+      name =~ r
+    let p_type t r = (true, t.ty_name =~ r)
     let p_exception e r = e.ex_name =~ r
     let p_attribute a r = a.att_value.val_name =~ r
     let p_method m r = m.met_value.val_name =~ r
@@ -322,7 +350,9 @@
     let p_class _ _ = (false, false)
     let p_class_type _ _ = (false, false)
     let p_value _ _ = true
-    let p_type _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
     let p_exception _ _ = false
     let p_attribute _ _ = false
     let p_method _ _ = false
@@ -347,7 +377,9 @@
     let p_class _ _ = (false, false)
     let p_class_type _ _ = (false, false)
     let p_value _ _ = false
-    let p_type _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
     let p_exception _ _ = true
     let p_attribute _ _ = false
     let p_method _ _ = false
@@ -372,7 +404,9 @@
     let p_class _ _ = (false, false)
     let p_class_type _ _ = (false, false)
     let p_value _ _ = false
-    let p_type _ _ = true
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, true)
     let p_exception _ _ = false
     let p_attribute _ _ = false
     let p_method _ _ = false
@@ -397,7 +431,9 @@
     let p_class _ _ = (true, false)
     let p_class_type _ _ = (true, false)
     let p_value _ _ = false
-    let p_type _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
     let p_exception _ _ = false
     let p_attribute _ _ = true
     let p_method _ _ = false
@@ -422,7 +458,9 @@
     let p_class _ _ = (true, false)
     let p_class_type _ _ = (true, false)
     let p_value _ _ = false
-    let p_type _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
     let p_exception _ _ = false
     let p_attribute _ _ = false
     let p_method _ _ = true
@@ -447,7 +485,9 @@
     let p_class _ _ = (false, true)
     let p_class_type _ _ = (false, false)
     let p_value _ _ = false
-    let p_type _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
     let p_exception _ _ = false
     let p_attribute _ _ = false
     let p_method _ _ = false
@@ -472,7 +512,9 @@
     let p_class _ _ = (false, false)
     let p_class_type _ _ = (false, true)
     let p_value _ _ = false
-    let p_type _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
     let p_exception _ _ = false
     let p_attribute _ _ = false
     let p_method _ _ = false
@@ -497,7 +539,9 @@
     let p_class _ _ = (false, false)
     let p_class_type _ _ = (false, false)
     let p_value _ _ = false
-    let p_type _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
     let p_exception _ _ = false
     let p_attribute _ _ = false
     let p_method _ _ = false
@@ -522,7 +566,9 @@
     let p_class _ _ = (false, false)
     let p_class_type _ _ = (false, false)
     let p_value _ _ = false
-    let p_type _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
     let p_exception _ _ = false
     let p_attribute _ _ = false
     let p_method _ _ = false
@@ -632,5 +678,3 @@
   with
     Res_section (_,t) -> t
   | _ -> assert false
-
-(* eof $Id: odoc_search.ml 9638 2010-03-08 16:54:13Z guesdon $ *)
diff -Nru ocaml-3.12.1/ocamldoc/odoc_search.mli ocaml-4.01.0/ocamldoc/odoc_search.mli
--- ocaml-3.12.1/ocamldoc/odoc_search.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_search.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_search.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** Research of elements through modules. *)
 
 (** The type for an element of the result of a research. *)
@@ -25,6 +24,8 @@
   | Res_attribute of Odoc_value.t_attribute
   | Res_method of Odoc_value.t_method
   | Res_section of string * Odoc_types.text
+  | Res_recfield of  Odoc_type.t_type * Odoc_type.record_field
+  | Res_const of  Odoc_type.t_type * Odoc_type.variant_constructor
 
 (** The type representing a research result.*)
 type result = result_element list
@@ -42,7 +43,9 @@
     val p_class : Odoc_class.t_class -> t -> bool * bool
     val p_class_type : Odoc_class.t_class_type -> t -> bool * bool
     val p_value : Odoc_value.t_value -> t -> bool
-    val p_type : Odoc_type.t_type -> t -> bool
+    val p_recfield : Odoc_type.t_type -> Odoc_type.record_field -> t -> bool
+    val p_const : Odoc_type.t_type -> Odoc_type.variant_constructor -> t -> bool
+    val p_type : Odoc_type.t_type -> t -> (bool * bool)
     val p_exception : Odoc_exception.t_exception -> t -> bool
     val p_attribute : Odoc_value.t_attribute -> t -> bool
     val p_method : Odoc_value.t_method -> t -> bool
@@ -59,6 +62,14 @@
       (** search in a value *)
       val search_value : Odoc_value.t_value -> P.t -> result_element list
 
+      (** search in a record field *)
+      val search_recfield :
+        Odoc_type.t_type -> Odoc_type.record_field -> P.t -> result_element list
+
+      (** search in a variant constructor *)
+      val search_const :
+        Odoc_type.t_type -> Odoc_type.variant_constructor -> P.t -> result_element list
+
       (** search in a type *)
       val search_type : Odoc_type.t_type -> P.t -> result_element list
 
@@ -102,7 +113,9 @@
     val p_class : Odoc_class.t_class -> Str.regexp -> bool * bool
     val p_class_type : Odoc_class.t_class_type -> Str.regexp -> bool * bool
     val p_value : Odoc_value.t_value -> Str.regexp -> bool
-    val p_type : Odoc_type.t_type -> Str.regexp -> bool
+    val p_recfield : Odoc_type.t_type -> Odoc_type.record_field -> Str.regexp -> bool
+    val p_const : Odoc_type.t_type -> Odoc_type.variant_constructor -> Str.regexp -> bool
+    val p_type : Odoc_type.t_type -> Str.regexp -> (bool * bool)
     val p_exception : Odoc_exception.t_exception -> Str.regexp -> bool
     val p_attribute : Odoc_value.t_attribute -> Str.regexp -> bool
     val p_method : Odoc_value.t_method -> Str.regexp -> bool
@@ -113,6 +126,8 @@
   sig
     val search_section : Odoc_types.text -> string -> P_name.t -> result_element list
     val search_value : Odoc_value.t_value -> P_name.t -> result_element list
+    val search_recfield : Odoc_type.t_type -> Odoc_type.record_field -> P_name.t -> result_element list
+    val search_const : Odoc_type.t_type -> Odoc_type.variant_constructor -> P_name.t -> result_element list
     val search_type : Odoc_type.t_type -> P_name.t -> result_element list
     val search_exception :
       Odoc_exception.t_exception -> P_name.t -> result_element list
diff -Nru ocaml-3.12.1/ocamldoc/odoc_see_lexer.mll ocaml-4.01.0/ocamldoc/odoc_see_lexer.mll
--- ocaml-3.12.1/ocamldoc/odoc_see_lexer.mll	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_see_lexer.mll	2012-10-15 17:50:56.000000000 +0000
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_see_lexer.mll 9547 2010-01-22 12:48:24Z doligez $ *)
-
 let print_DEBUG2 s = print_string s ; print_newline ()
 
 (** the lexer for special comments. *)
diff -Nru ocaml-3.12.1/ocamldoc/odoc_sig.ml ocaml-4.01.0/ocamldoc/odoc_sig.ml
--- ocaml-3.12.1/ocamldoc/odoc_sig.ml	2010-04-19 16:59:55.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_sig.ml	2013-05-03 13:38:30.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_sig.ml 10282 2010-04-19 16:59:55Z guesdon $ *)
-
 (** Analysis of interface files. *)
 
 open Misc
@@ -47,19 +46,19 @@
 
     let add_to_hash table signat =
       match signat with
-        Types.Tsig_value (ident, _) ->
+        Types.Sig_value (ident, _) ->
           Hashtbl.add table (V (Name.from_ident ident)) signat
-      | Types.Tsig_exception (ident, _) ->
+      | Types.Sig_exception (ident, _) ->
           Hashtbl.add table (E (Name.from_ident ident)) signat
-      | Types.Tsig_type (ident, _, _) ->
+      | Types.Sig_type (ident, _, _) ->
           Hashtbl.add table (T (Name.from_ident ident)) signat
-      | Types.Tsig_class (ident, _, _) ->
+      | Types.Sig_class (ident, _, _) ->
           Hashtbl.add table (C (Name.from_ident ident)) signat
-      | Types.Tsig_cltype (ident, _, _) ->
+      | Types.Sig_class_type (ident, _, _) ->
           Hashtbl.add table (CT (Name.from_ident ident)) signat
-      | Types.Tsig_module (ident, _, _) ->
+      | Types.Sig_module (ident, _, _) ->
           Hashtbl.add table (M (Name.from_ident ident)) signat
-      | Types.Tsig_modtype (ident,_) ->
+      | Types.Sig_modtype (ident,_) ->
           Hashtbl.add table (MT (Name.from_ident ident)) signat
 
     let table signat =
@@ -69,40 +68,40 @@
 
     let search_value table name =
       match Hashtbl.find table (V name) with
-      | (Types.Tsig_value (_, val_desc)) ->  val_desc.Types.val_type
+      | (Types.Sig_value (_, val_desc)) ->  val_desc.Types.val_type
       | _ -> assert false
 
     let search_exception table name =
       match Hashtbl.find table (E name) with
-      | (Types.Tsig_exception (_, type_expr_list)) ->
+      | (Types.Sig_exception (_, type_expr_list)) ->
           type_expr_list
       | _ -> assert false
 
     let search_type table name =
       match Hashtbl.find table (T name) with
-      | (Types.Tsig_type (_, type_decl, _)) -> type_decl
+      | (Types.Sig_type (_, type_decl, _)) -> type_decl
       | _ -> assert false
 
     let search_class table name =
       match Hashtbl.find table (C name) with
-      | (Types.Tsig_class (_, class_decl, _)) -> class_decl
+      | (Types.Sig_class (_, class_decl, _)) -> class_decl
       | _ -> assert false
 
     let search_class_type table name =
       match Hashtbl.find table (CT name) with
-      | (Types.Tsig_cltype (_, cltype_decl, _)) -> cltype_decl
+      | (Types.Sig_class_type (_, cltype_decl, _)) -> cltype_decl
       | _ -> assert false
 
     let search_module table name =
       match Hashtbl.find table (M name) with
-      | (Types.Tsig_module (ident, module_type, _)) -> module_type
+      | (Types.Sig_module (ident, module_type, _)) -> module_type
       | _ -> assert false
 
     let search_module_type table name =
       match Hashtbl.find table (MT name) with
-      | (Types.Tsig_modtype (_, Types.Tmodtype_manifest module_type)) ->
+      | (Types.Sig_modtype (_, Types.Modtype_manifest module_type)) ->
           Some module_type
-      | (Types.Tsig_modtype (_, Types.Tmodtype_abstract)) ->
+      | (Types.Sig_modtype (_, Types.Modtype_abstract)) ->
           None
       | _ -> assert false
 
@@ -179,21 +178,21 @@
             match cons_core_type_list_list with
               [] ->
                 (0, acc)
-            | (name, core_type_list, loc) :: [] ->
+            | (name, _, _, loc) :: [] ->
                 let s = get_string_of_file
                     loc.Location.loc_end.Lexing.pos_cnum
                     pos_limit
                 in
                 let (len, comment_opt) =  My_ir.just_after_special !file_name s in
-                (len, acc @ [ (name, comment_opt) ])
-            | (name, core_type_list, loc) :: (name2, core_type_list2, loc2)
+                (len, acc @ [ (name.txt, comment_opt) ])
+            | (name, _, _, loc) :: (name2, core_type_list2, ret_type2, loc2)
               :: q ->
                 let pos_end_first = loc.Location.loc_end.Lexing.pos_cnum in
                 let pos_start_second = loc2.Location.loc_start.Lexing.pos_cnum in
                 let s = get_string_of_file pos_end_first pos_start_second in
                 let (_,comment_opt) = My_ir.just_after_special !file_name  s in
-                f (acc @ [name, comment_opt])
-                  ((name2, core_type_list2, loc2) :: q)
+                f (acc @ [name.txt, comment_opt])
+                  ((name2, core_type_list2, ret_type2, loc2) :: q)
           in
           f [] cons_core_type_list_list
 
@@ -205,13 +204,13 @@
                 let pos = ct.Parsetree.ptyp_loc.Location.loc_end.Lexing.pos_cnum in
                 let s = get_string_of_file pos pos_end in
                 let (_,comment_opt) =  My_ir.just_after_special !file_name s in
-                [name, comment_opt]
+                [name.txt, comment_opt]
             | (name,_,ct,xxloc) :: ((name2,_,ct2,xxloc2) as ele2) :: q ->
                 let pos = ct.Parsetree.ptyp_loc.Location.loc_end.Lexing.pos_cnum in
                 let pos2 = ct2.Parsetree.ptyp_loc.Location.loc_start.Lexing.pos_cnum in
                 let s = get_string_of_file pos pos2 in
                 let (_,comment_opt) =  My_ir.just_after_special !file_name s in
-                (name, comment_opt) :: (f (ele2 :: q))
+                (name.txt, comment_opt) :: (f (ele2 :: q))
           in
           (0, f name_mutable_type_list)
 
@@ -219,9 +218,9 @@
       match type_kind with
         Types.Type_abstract ->
           Odoc_type.Type_abstract
-
       | Types.Type_variant l ->
-          let f (constructor_name, type_expr_list) =
+          let f (constructor_name, type_expr_list, ret_type) =
+            let constructor_name = Ident.name constructor_name in
             let comment_opt =
               try
                 match List.assoc constructor_name name_comment_list with
@@ -232,6 +231,7 @@
             {
               vc_name = constructor_name ;
               vc_args = List.map (Odoc_env.subst_type env) type_expr_list ;
+              vc_ret =  may_map (Odoc_env.subst_type env) ret_type;
               vc_text = comment_opt
             }
           in
@@ -239,6 +239,7 @@
 
       | Types.Type_record (l, _) ->
           let f (field_name, mutable_flag, type_expr) =
+            let field_name = Ident.name field_name in
             let comment_opt =
               try
                 match List.assoc field_name name_comment_list with
@@ -255,6 +256,38 @@
           in
           Odoc_type.Type_record (List.map f l)
 
+    let erased_names_of_constraints constraints acc =
+      List.fold_right (fun (longident, constraint_) acc ->
+        match constraint_ with
+        | Parsetree.Pwith_type _ | Parsetree.Pwith_module _ -> acc
+        | Parsetree.Pwith_typesubst _ | Parsetree.Pwith_modsubst _ ->
+          Name.Set.add (Name.from_longident longident.txt) acc)
+        constraints acc
+
+    let filter_out_erased_items_from_signature erased signature =
+      if Name.Set.is_empty erased then signature
+      else List.fold_right (fun sig_item acc ->
+        let take_item psig_desc = { sig_item with Parsetree.psig_desc } :: acc in
+        match sig_item.Parsetree.psig_desc with
+        | Parsetree.Psig_value (_, _)
+        | Parsetree.Psig_exception (_, _)
+        | Parsetree.Psig_open _
+        | Parsetree.Psig_include _
+        | Parsetree.Psig_class _
+        | Parsetree.Psig_class_type _ as tp -> take_item tp
+        | Parsetree.Psig_type types ->
+          (match List.filter (fun (name, _) -> not (Name.Set.mem name.txt erased)) types with
+          | [] -> acc
+          | types -> take_item (Parsetree.Psig_type types))
+        | Parsetree.Psig_module (name, _)
+        | Parsetree.Psig_modtype (name, _) as m ->
+          if Name.Set.mem name.txt erased then acc else take_item m
+        | Parsetree.Psig_recmodule mods ->
+          (match List.filter (fun (name, _) -> not (Name.Set.mem name.txt erased)) mods with
+          | [] -> acc
+          | mods -> take_item (Parsetree.Psig_recmodule mods)))
+        signature []
+
     (** Analysis of the elements of a class, from the information in the parsetree and in the class
        signature. @return the couple (inherited_class list, elements).*)
     let analyse_class_elements env current_class_name last_pos pos_limit
@@ -262,12 +295,13 @@
       let get_pos_limit2 q =
         match q with
           [] -> pos_limit
-        | ele2 :: _ ->
-            match ele2 with
-              Parsetree.Pctf_val (_, _, _, _, loc)
-            | Parsetree.Pctf_virt (_, _, _, loc)
-            | Parsetree.Pctf_meth (_, _, _, loc)
-            | Parsetree.Pctf_cstr (_, _, loc) -> loc.Location.loc_start.Lexing.pos_cnum
+          | ele2 :: _ ->
+              let loc = ele2.Parsetree.pctf_loc in
+            match ele2.Parsetree.pctf_desc with
+              Parsetree.Pctf_val (_, _, _, _)
+            | Parsetree.Pctf_virt (_, _, _)
+            | Parsetree.Pctf_meth (_, _, _)
+            | Parsetree.Pctf_cstr (_, _) -> loc.Location.loc_start.Lexing.pos_cnum
             | Parsetree.Pctf_inher class_type ->
                 class_type.Parsetree.pcty_loc.Location.loc_start.Lexing.pos_cnum
       in
@@ -289,7 +323,7 @@
               val_recursive = false ;
               val_parameters = Odoc_value.dummy_parameter_list subst_typ ;
               val_code = None ;
-              val_loc = { loc_impl = None ; loc_inter = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) };
+              val_loc = { loc_impl = None ; loc_inter = Some loc };
             } ;
             met_private = private_flag = Asttypes.Private ;
             met_virtual = false ;
@@ -325,7 +359,11 @@
             in
             ([], ele_comments)
 
-        | Parsetree.Pctf_val (name, mutable_flag, virtual_flag, _, loc) :: q ->
+          | item :: q ->
+              let loc = item.Parsetree.pctf_loc in
+              match item.Parsetree.pctf_desc with
+
+        | Parsetree.Pctf_val (name, mutable_flag, virtual_flag, _) ->
             (* of (string * mutable_flag * core_type option * Location.t)*)
             let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
             let complete_name = Name.concat current_class_name name in
@@ -345,7 +383,7 @@
                   val_recursive = false ;
                   val_parameters = [] ;
                   val_code = None ;
-                  val_loc = { loc_impl = None ; loc_inter = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum)} ;
+                  val_loc = { loc_impl = None ; loc_inter = Some loc} ;
                 } ;
                 att_mutable = mutable_flag = Asttypes.Mutable ;
                 att_virtual = virtual_flag = Asttypes.Virtual ;
@@ -362,7 +400,7 @@
             let (inher_l, eles) = f (pos_end + maybe_more) q in
             (inher_l, eles_comments @ ((Class_attribute att) :: eles))
 
-        | Parsetree.Pctf_virt (name, private_flag, _, loc) :: q ->
+        | Parsetree.Pctf_virt (name, private_flag, _) ->
             (* of (string * private_flag * core_type * Location.t) *)
             let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
             let (met, maybe_more) = get_method name comment_opt private_flag loc q in
@@ -370,21 +408,21 @@
             let (inher_l, eles) = f (loc.Location.loc_end.Lexing.pos_cnum + maybe_more) q in
             (inher_l, eles_comments @ ((Class_method met2) :: eles))
 
-        | Parsetree.Pctf_meth (name, private_flag, _, loc) :: q ->
+        | Parsetree.Pctf_meth (name, private_flag, _) ->
             (* of (string * private_flag * core_type * Location.t) *)
             let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
             let (met, maybe_more) = get_method name comment_opt private_flag loc q in
             let (inher_l, eles) = f (loc.Location.loc_end.Lexing.pos_cnum + maybe_more) q in
             (inher_l, eles_comments @ ((Class_method met) :: eles))
 
-        | (Parsetree.Pctf_cstr (_, _, loc)) :: q ->
+        | (Parsetree.Pctf_cstr (_, _)) ->
             (* of (core_type * core_type * Location.t) *)
             (* A VOIR : cela correspond aux contraintes, non ? on ne les garde pas pour l'instant *)
             let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
             let (inher_l, eles) = f loc.Location.loc_end.Lexing.pos_cnum q in
             (inher_l, eles_comments @ eles)
 
-        | Parsetree.Pctf_inher class_type :: q ->
+        | Parsetree.Pctf_inher class_type ->
             let loc = class_type.Parsetree.pcty_loc in
             let (comment_opt, eles_comments) =
               get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum
@@ -402,7 +440,7 @@
               match class_type.Parsetree.pcty_desc with
                 Parsetree.Pcty_constr (longident, _) ->
                   (*of Longident.t * core_type list*)
-                  let name = Name.from_longident longident in
+                  let name = Name.from_longident longident.txt in
                   let ic =
                     {
                       ic_name = Odoc_env.full_class_or_class_type_name env name ;
@@ -414,7 +452,7 @@
 
               | Parsetree.Pcty_signature _
               | Parsetree.Pcty_fun _ ->
-                  (* we don't have a name for the class signature, so we call it "object ... end"  *)
+                    (* we don't have a name for the class signature, so we call it "object ... end"  *)
                   {
                     ic_name = Odoc_messages.object_end ;
                     ic_class = None ;
@@ -459,6 +497,7 @@
                 signat
                 table
                 current_module_name
+                ele.Parsetree.psig_loc
                 ele.Parsetree.psig_loc.Location.loc_start.Lexing.pos_cnum
                 ele.Parsetree.psig_loc.Location.loc_end.Lexing.pos_cnum
                 (match q with
@@ -481,15 +520,15 @@
     (** Analyse the given signature_item_desc to create the corresponding module element
        (with the given attached comment).*)
     and analyse_signature_item_desc env signat table current_module_name
-        pos_start_ele pos_end_ele pos_limit comment_opt sig_item_desc =
+        sig_item_loc pos_start_ele pos_end_ele pos_limit comment_opt sig_item_desc =
         match sig_item_desc with
           Parsetree.Psig_value (name_pre, value_desc) ->
             let type_expr =
-              try Signature_search.search_value table name_pre
+              try Signature_search.search_value table name_pre.txt
               with Not_found ->
-                raise (Failure (Odoc_messages.value_not_found current_module_name name_pre))
+                raise (Failure (Odoc_messages.value_not_found current_module_name name_pre.txt))
             in
-            let name = Name.parens_if_infix name_pre in
+            let name = Name.parens_if_infix name_pre.txt in
             let subst_typ = Odoc_env.subst_type env type_expr in
             let v =
               {
@@ -499,7 +538,7 @@
                 val_recursive = false ;
                 val_parameters = Odoc_value.dummy_parameter_list subst_typ ;
                 val_code = None ;
-                val_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele)}
+                val_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ;
               }
             in
             let (maybe_more, info_after_opt) =
@@ -516,20 +555,20 @@
 
         | Parsetree.Psig_exception (name, exception_decl) ->
             let types_excep_decl =
-              try Signature_search.search_exception table name
+              try Signature_search.search_exception table name.txt
               with Not_found ->
-                raise (Failure (Odoc_messages.exception_not_found current_module_name name))
+                raise (Failure (Odoc_messages.exception_not_found current_module_name name.txt))
             in
             let e =
               {
-                ex_name = Name.concat current_module_name name ;
+                ex_name = Name.concat current_module_name name.txt ;
                 ex_info = comment_opt ;
-                ex_args = List.map (Odoc_env.subst_type env) types_excep_decl ;
+                ex_args = List.map (Odoc_env.subst_type env) types_excep_decl.exn_args ;
                 ex_alias = None ;
-                ex_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ;
+                ex_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ;
                 ex_code =
                    (
-                    if !Odoc_args.keep_code then
+                    if !Odoc_global.keep_code then
                       Some (get_string_of_file pos_start_ele pos_end_ele)
                     else
                       None
@@ -550,7 +589,7 @@
             let new_env =
               List.fold_left
                 (fun acc_env -> fun (name, _) ->
-                  let complete_name = Name.concat current_module_name name in
+                  let complete_name = Name.concat current_module_name name.txt in
                   Odoc_env.add_type acc_env complete_name
                 )
                 env
@@ -572,7 +611,7 @@
                   let pos_limit2 =
                     match q with
                       [] -> pos_limit
-                    | (_, td) :: _ -> td.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum
+                    | ( _, td) :: _ -> td.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum
                   in
                   let (maybe_more, name_comment_list) =
                     name_comment_from_type_kind
@@ -580,14 +619,14 @@
                       pos_limit2
                       type_decl.Parsetree.ptype_kind
                   in
-                  print_DEBUG ("Type "^name^" : "^(match assoc_com with None -> "sans commentaire" | Some c -> Odoc_misc.string_of_info c));
+                  print_DEBUG ("Type "^name.txt^" : "^(match assoc_com with None -> "sans commentaire" | Some c -> Odoc_misc.string_of_info c));
                   let f_DEBUG (name, c_opt) = print_DEBUG ("constructor/field "^name^": "^(match c_opt with None -> "sans commentaire" | Some c -> Odoc_misc.string_of_info c)) in
                   List.iter f_DEBUG name_comment_list;
                   (* get the information for the type in the signature *)
                   let sig_type_decl =
-                    try Signature_search.search_type table name
+                    try Signature_search.search_type table name.txt
                     with Not_found ->
-                      raise (Failure (Odoc_messages.type_not_found current_module_name name))
+                      raise (Failure (Odoc_messages.type_not_found current_module_name name.txt))
                   in
                   (* get the type kind with the associated comments *)
                   let type_kind = get_type_kind new_env name_comment_list sig_type_decl.Types.type_kind in
@@ -596,13 +635,12 @@
                   (* associate the comments to each constructor and build the [Type.t_type] *)
                   let new_type =
                     {
-                      ty_name = Name.concat current_module_name name ;
+                      ty_name = Name.concat current_module_name name.txt ;
                       ty_info = assoc_com ;
                       ty_parameters =
-                        List.map2 (fun p (co,cn,_) ->
-                                     (Odoc_env.subst_type new_env p,
-                                      co, cn)
-                                  )
+                        List.map2 (fun p v ->
+                          let (co, cn) = Types.Variance.get_upper v in
+                          (Odoc_env.subst_type new_env p,co, cn))
                         sig_type_decl.Types.type_params
                         sig_type_decl.Types.type_variance;
                       ty_kind = type_kind;
@@ -611,13 +649,10 @@
                       (match sig_type_decl.Types.type_manifest with
                         None -> None
                       | Some t -> Some (Odoc_env.subst_type new_env t));
-                      ty_loc =
-                      { loc_impl = None ;
-                        loc_inter = Some (!file_name,loc_start) ;
-                      };
+                      ty_loc = { loc_impl = None ;  loc_inter = Some sig_item_loc } ;
                       ty_code =
                         (
-                         if !Odoc_args.keep_code then
+                         if !Odoc_global.keep_code then
                            Some (get_string_of_file loc_start new_end)
                          else
                            None
@@ -651,16 +686,16 @@
             (0, env, ele_comments)
 
         | Parsetree.Psig_module (name, module_type) ->
-            let complete_name = Name.concat current_module_name name in
+            let complete_name = Name.concat current_module_name name.txt in
             (* get the the module type in the signature by the module name *)
             let sig_module_type =
-              try Signature_search.search_module table name
+              try Signature_search.search_module table name.txt
               with Not_found ->
-                raise (Failure (Odoc_messages.module_not_found current_module_name name))
+                raise (Failure (Odoc_messages.module_not_found current_module_name name.txt))
             in
             let module_kind = analyse_module_kind env complete_name module_type sig_module_type in
             let code_intf =
-              if !Odoc_args.keep_code then
+              if !Odoc_global.keep_code then
                 let loc = module_type.Parsetree.pmty_loc in
                 let st = loc.Location.loc_start.Lexing.pos_cnum in
                 let en = loc.Location.loc_end.Lexing.pos_cnum in
@@ -676,7 +711,7 @@
                 m_is_interface = true ;
                 m_file = !file_name ;
                 m_kind = module_kind ;
-                m_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ;
+                m_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ;
                 m_top_deps = [] ;
                 m_code = None ;
                 m_code_intf = code_intf ;
@@ -691,8 +726,8 @@
             new_module.m_info <- merge_infos new_module.m_info info_after_opt ;
             let new_env = Odoc_env.add_module env new_module.m_name in
             let new_env2 =
-              match new_module.m_type with (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on aurait pas la signature *)
-                Types.Tmty_signature s -> Odoc_env.add_signature new_env new_module.m_name ~rel: (Name.simple new_module.m_name) s
+              match new_module.m_type with (* A VOIR : cela peut-il etre Tmty_ident ? dans ce cas, on aurait pas la signature *)
+                Types.Mty_signature s -> Odoc_env.add_signature new_env new_module.m_name ~rel: (Name.simple new_module.m_name) s
               | _ -> new_env
             in
             (maybe_more, new_env2, [ Element_module new_module ])
@@ -701,7 +736,7 @@
             (* we start by extending the environment *)
             let new_env =
               List.fold_left
-                (fun acc_env -> fun (name, _) ->
+                (fun acc_env -> fun ({ txt = name }, _) ->
                   let complete_name = Name.concat current_module_name name in
                   let e = Odoc_env.add_module acc_env complete_name in
                   (* get the information for the module in the signature *)
@@ -711,8 +746,8 @@
                       raise (Failure (Odoc_messages.module_not_found current_module_name name))
                   in
                   match sig_module_type with
-                    (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on aurait pas la signature *)
-                    Types.Tmty_signature s ->
+                    (* A VOIR : cela peut-il etre Tmty_ident ? dans ce cas, on aurait pas la signature *)
+                    Types.Mty_signature s ->
                       Odoc_env.add_signature e complete_name ~rel: name s
                   | _ ->
                       print_DEBUG "not a Tmty_signature";
@@ -726,9 +761,10 @@
                 [] ->
                   (acc_maybe_more, [])
               | (name, modtype) :: q ->
-                  let complete_name = Name.concat current_module_name name in
-                  let loc_start = modtype.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in
-                  let loc_end = modtype.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
+                  let complete_name = Name.concat current_module_name name.txt in
+                  let loc = modtype.Parsetree.pmty_loc in
+                  let loc_start = loc.Location.loc_start.Lexing.pos_cnum in
+                  let loc_end = loc.Location.loc_end.Lexing.pos_cnum in
                   let (assoc_com, ele_comments) =
                     if first then
                       (comment_opt, [])
@@ -740,19 +776,18 @@
                   let pos_limit2 =
                     match q with
                       [] -> pos_limit
-                    | (_, mty) :: _ -> mty.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum
+                    | (_, mty) :: _ -> loc.Location.loc_start.Lexing.pos_cnum
                   in
                   (* get the information for the module in the signature *)
                   let sig_module_type =
-                    try Signature_search.search_module table name
+                    try Signature_search.search_module table name.txt
                     with Not_found ->
-                      raise (Failure (Odoc_messages.module_not_found current_module_name name))
+                      raise (Failure (Odoc_messages.module_not_found current_module_name name.txt))
                   in
                   (* associate the comments to each constructor and build the [Type.t_type] *)
                   let module_kind = analyse_module_kind new_env complete_name modtype sig_module_type in
                   let code_intf =
-                    if !Odoc_args.keep_code then
-                      let loc = modtype.Parsetree.pmty_loc in
+                    if !Odoc_global.keep_code then
                       let st = loc.Location.loc_start.Lexing.pos_cnum in
                       let en = loc.Location.loc_end.Lexing.pos_cnum in
                       Some (get_string_of_file st en)
@@ -767,7 +802,7 @@
                       m_is_interface = true ;
                       m_file = !file_name ;
                       m_kind = module_kind ;
-                      m_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ;
+                      m_loc = { loc_impl = None ; loc_inter = Some loc } ;
                       m_top_deps = [] ;
                       m_code = None ;
                       m_code_intf = code_intf ;
@@ -792,11 +827,11 @@
             (maybe_more, new_env, mods)
 
         | Parsetree.Psig_modtype (name, pmodtype_decl) ->
-            let complete_name = Name.concat current_module_name name in
+            let complete_name = Name.concat current_module_name name.txt in
             let sig_mtype =
-              try Signature_search.search_module_type table name
+              try Signature_search.search_module_type table name.txt
               with Not_found ->
-                raise (Failure (Odoc_messages.module_type_not_found current_module_name name))
+                raise (Failure (Odoc_messages.module_type_not_found current_module_name name.txt))
             in
             let module_type_kind =
               match pmodtype_decl with
@@ -815,7 +850,7 @@
                 mt_is_interface = true ;
                 mt_file = !file_name ;
                 mt_kind = module_type_kind ;
-                mt_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ;
+                mt_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ;
               }
             in
             let (maybe_more, info_after_opt) =
@@ -826,8 +861,8 @@
             mt.mt_info <- merge_infos mt.mt_info info_after_opt ;
             let new_env = Odoc_env.add_module_type env mt.mt_name in
             let new_env2 =
-              match sig_mtype with (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on aurait pas la signature *)
-                Some (Types.Tmty_signature s) -> Odoc_env.add_signature new_env mt.mt_name ~rel: (Name.simple mt.mt_name) s
+              match sig_mtype with (* A VOIR : cela peut-il etre Tmty_ident ? dans ce cas, on aurait pas la signature *)
+                Some (Types.Mty_signature s) -> Odoc_env.add_signature new_env mt.mt_name ~rel: (Name.simple mt.mt_name) s
               | _ -> new_env
             in
             (maybe_more, new_env2, [ Element_module_type mt ])
@@ -835,7 +870,7 @@
         | Parsetree.Psig_include module_type ->
             let rec f = function
                 Parsetree.Pmty_ident longident ->
-                  Name.from_longident longident
+                  Name.from_longident longident.txt
               | Parsetree.Pmty_signature _ ->
                   "??"
               | Parsetree.Pmty_functor _ ->
@@ -844,7 +879,7 @@
                   f mt.Parsetree.pmty_desc
               | Parsetree.Pmty_typeof mexpr ->
                   match mexpr.Parsetree.pmod_desc with
-                    Parsetree.Pmod_ident longident -> Name.from_longident longident
+                    Parsetree.Pmod_ident longident -> Name.from_longident longident.txt
                   | _ -> "??"
             in
             let name = f module_type.Parsetree.pmty_desc in
@@ -856,14 +891,14 @@
                 im_info = comment_opt;
               }
             in
-            (0, env, [ Element_included_module im ]) (* A VOIR : étendre l'environnement ? avec quoi ? *)
+            (0, env, [ Element_included_module im ]) (* A VOIR : etendre l'environnement ? avec quoi ? *)
 
         | Parsetree.Psig_class class_description_list ->
             (* we start by extending the environment *)
             let new_env =
               List.fold_left
                 (fun acc_env -> fun class_desc ->
-                  let complete_name = Name.concat current_module_name class_desc.Parsetree.pci_name in
+                  let complete_name = Name.concat current_module_name class_desc.Parsetree.pci_name.txt in
                   Odoc_env.add_class acc_env complete_name
                 )
                 env
@@ -889,11 +924,11 @@
                     | cd :: _ -> cd.Parsetree.pci_loc.Location.loc_start.Lexing.pos_cnum
                   in
                   let name = class_desc.Parsetree.pci_name in
-                  let complete_name = Name.concat current_module_name name in
+                  let complete_name = Name.concat current_module_name name.txt in
                   let sig_class_decl =
-                    try Signature_search.search_class table name
+                    try Signature_search.search_class table name.txt
                     with Not_found ->
-                      raise (Failure (Odoc_messages.class_not_found current_module_name name))
+                      raise (Failure (Odoc_messages.class_not_found current_module_name name.txt))
                   in
                   let sig_class_type = sig_class_decl.Types.cty_type in
                   let (parameters, class_kind) =
@@ -913,7 +948,7 @@
                      cl_virtual = class_desc.Parsetree.pci_virt = Asttypes.Virtual ;
                      cl_kind = class_kind ;
                      cl_parameters = parameters ;
-                     cl_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ;
+                     cl_loc = { loc_impl = None ; loc_inter = Some class_desc.Parsetree.pci_loc } ;
                    }
                  in
                  let (maybe_more, info_after_opt) =
@@ -939,7 +974,7 @@
             let new_env =
               List.fold_left
                 (fun acc_env -> fun class_type_decl ->
-                  let complete_name = Name.concat current_module_name class_type_decl.Parsetree.pci_name in
+                  let complete_name = Name.concat current_module_name class_type_decl.Parsetree.pci_name.txt in
                   Odoc_env.add_class_type acc_env complete_name
                 )
                 env
@@ -965,11 +1000,11 @@
                     | ct_decl2 :: _ -> ct_decl2.Parsetree.pci_loc.Location.loc_start.Lexing.pos_cnum
                   in
                   let name = ct_decl.Parsetree.pci_name in
-                  let complete_name = Name.concat current_module_name name in
+                  let complete_name = Name.concat current_module_name name.txt in
                   let sig_cltype_decl =
-                    try Signature_search.search_class_type table name
+                    try Signature_search.search_class_type table name.txt
                     with Not_found ->
-                      raise (Failure (Odoc_messages.class_type_not_found current_module_name name))
+                      raise (Failure (Odoc_messages.class_type_not_found current_module_name name.txt))
                   in
                   let sig_class_type = sig_cltype_decl.Types.clty_type in
                   let kind = analyse_class_type_kind
@@ -987,7 +1022,7 @@
                       clt_type_parameters = sig_cltype_decl.clty_params ;
                       clt_virtual = ct_decl.Parsetree.pci_virt = Asttypes.Virtual ;
                       clt_kind = kind ;
-                      clt_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ;
+                      clt_loc = { loc_impl = None ; loc_inter = Some ct_decl.Parsetree.pci_loc } ;
                     }
                   in
                   let (maybe_more, info_after_opt) =
@@ -1008,13 +1043,14 @@
             (maybe_more, new_env, eles)
 
     (** Return a module_type_kind from a Parsetree.module_type and a Types.module_type *)
-    and analyse_module_type_kind env current_module_name module_type sig_module_type =
+    and analyse_module_type_kind
+      ?(erased = Name.Set.empty) env current_module_name module_type sig_module_type =
       match module_type.Parsetree.pmty_desc with
         Parsetree.Pmty_ident longident ->
           let name =
             match sig_module_type with
-              Types.Tmty_ident path -> Name.from_path path
-            | _ -> Name.from_longident longident
+              Types.Mty_ident path -> Name.from_path path
+            | _ -> Name.from_longident longident.txt
               (* A VOIR cela arrive quand on fait module type F : functor ... -> Toto, Toto n'est pas un ident mais une structure *)
           in
           Module_type_alias { mta_name = Odoc_env.full_module_type_name env name ;
@@ -1022,25 +1058,26 @@
 
       | Parsetree.Pmty_signature ast ->
           (
+           let ast = filter_out_erased_items_from_signature erased ast in
            (* we must have a signature in the module type *)
            match sig_module_type with
-             Types.Tmty_signature signat ->
+             Types.Mty_signature signat ->
                let pos_start = module_type.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in
                let pos_end = module_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
                let elements = analyse_parsetree env signat current_module_name pos_start pos_end ast in
                Module_type_struct elements
            | _ ->
-               raise (Failure "Parsetree.Pmty_signature signature but not Types.Tmty_signature signat")
+               raise (Failure "Parsetree.Pmty_signature signature but not Types.Mty_signature signat")
           )
 
-      | Parsetree.Pmty_functor (_,pmodule_type2, module_type2) ->
+      | Parsetree.Pmty_functor (_, pmodule_type2, module_type2) ->
           (
            let loc_start = pmodule_type2.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in
            let loc_end = pmodule_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
            let mp_type_code = get_string_of_file loc_start loc_end in
            print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code);
            match sig_module_type with
-             Types.Tmty_functor (ident, param_module_type, body_module_type) ->
+             Types.Mty_functor (ident, param_module_type, body_module_type) ->
                let mp_kind = analyse_module_type_kind env
                    current_module_name pmodule_type2 param_module_type
                in
@@ -1052,7 +1089,7 @@
                    mp_kind = mp_kind ;
                  }
                in
-               let k = analyse_module_type_kind env
+               let k = analyse_module_type_kind ~erased env
                    current_module_name
                    module_type2
                    body_module_type
@@ -1061,16 +1098,18 @@
 
            | _ ->
                (* if we're here something's wrong *)
-               raise (Failure "Parsetree.Pmty_functor _ but not Types.Tmty_functor _")
+               raise (Failure "Parsetree.Pmty_functor _ but not Types.Mty_functor _")
           )
 
-      | Parsetree.Pmty_with (module_type2, _) ->
+      | Parsetree.Pmty_with (module_type2, constraints) ->
           (* of module_type * (Longident.t * with_constraint) list *)
           (
            let loc_start = module_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
            let loc_end = module_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
            let s = get_string_of_file loc_start loc_end in
-           let k = analyse_module_type_kind env current_module_name module_type2 sig_module_type in
+           let erased = erased_names_of_constraints constraints erased in
+           let k = analyse_module_type_kind ~erased env current_module_name module_type2 sig_module_type in
+
            Module_type_with (k, s)
           )
 
@@ -1081,7 +1120,8 @@
           Module_type_typeof s
 
     (** analyse of a Parsetree.module_type and a Types.module_type.*)
-    and analyse_module_kind env current_module_name module_type sig_module_type =
+    and analyse_module_kind
+        ?(erased = Name.Set.empty) env current_module_name module_type sig_module_type =
       match module_type.Parsetree.pmty_desc with
         Parsetree.Pmty_ident longident ->
           let k = analyse_module_type_kind env current_module_name module_type sig_module_type in
@@ -1089,8 +1129,9 @@
 
       | Parsetree.Pmty_signature signature ->
           (
+           let signature = filter_out_erased_items_from_signature erased signature in
            match sig_module_type with
-             Types.Tmty_signature signat ->
+             Types.Mty_signature signat ->
                Module_struct
                  (analyse_parsetree
                     env
@@ -1102,12 +1143,12 @@
                  )
            | _ ->
                (* if we're here something's wrong *)
-               raise (Failure "Parsetree.Pmty_signature signature but not Types.Tmty_signature signat")
+               raise (Failure "Parsetree.Pmty_signature signature but not Types.Mty_signature signat")
           )
-      | Parsetree.Pmty_functor (_,pmodule_type2,module_type2) (* of string * module_type * module_type *) ->
+      | Parsetree.Pmty_functor (_, pmodule_type2,module_type2) (* of string * module_type * module_type *) ->
           (
            match sig_module_type with
-             Types.Tmty_functor (ident, param_module_type, body_module_type) ->
+             Types.Mty_functor (ident, param_module_type, body_module_type) ->
                let loc_start = pmodule_type2.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in
                let loc_end = pmodule_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
                let mp_type_code = get_string_of_file loc_start loc_end in
@@ -1123,7 +1164,7 @@
                    mp_kind = mp_kind ;
                  }
                in
-               let k = analyse_module_kind env
+               let k = analyse_module_kind ~erased env
                    current_module_name
                    module_type2
                    body_module_type
@@ -1132,15 +1173,16 @@
 
            | _ ->
                (* if we're here something's wrong *)
-               raise (Failure "Parsetree.Pmty_functor _ but not Types.Tmty_functor _")
+               raise (Failure "Parsetree.Pmty_functor _ but not Types.Mty_functor _")
           )
-      | Parsetree.Pmty_with (module_type2, _) ->
+      | Parsetree.Pmty_with (module_type2, constraints) ->
           (*of module_type * (Longident.t * with_constraint) list*)
           (
            let loc_start = module_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
            let loc_end = module_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
            let s = get_string_of_file loc_start loc_end in
-           let k = analyse_module_type_kind env current_module_name module_type2 sig_module_type in
+           let erased = erased_names_of_constraints constraints erased in
+           let k = analyse_module_type_kind ~erased env current_module_name module_type2 sig_module_type in
            Module_with (k, s)
           )
       | Parsetree.Pmty_typeof module_expr ->
@@ -1154,8 +1196,8 @@
     and analyse_class_kind env current_class_name last_pos parse_class_type sig_class_type =
       match parse_class_type.Parsetree.pcty_desc, sig_class_type with
         (Parsetree.Pcty_constr (_, _) (*of Longident.t * core_type list *),
-         Types.Tcty_constr (p, typ_list, _) (*of Path.t * type_expr list * class_type*)) ->
-          print_DEBUG "Tcty_constr _";
+         Types.Cty_constr (p, typ_list, _) (*of Path.t * type_expr list * class_type*)) ->
+          print_DEBUG "Cty_constr _";
            let path_name = Name.from_path p in
            let name = Odoc_env.full_class_or_class_type_name env path_name in
            let k =
@@ -1168,7 +1210,7 @@
            in
            ([], k)
 
-      | (Parsetree.Pcty_signature (_, class_type_field_list), Types.Tcty_signature class_signature) ->
+      | (Parsetree.Pcty_signature { Parsetree.pcsig_fields = class_type_field_list }, Types.Cty_signature class_signature) ->
           (* we get the elements of the class in class_type_field_list *)
           let (inher_l, ele) = analyse_class_elements env current_class_name
               last_pos
@@ -1178,8 +1220,8 @@
           in
           ([], Class_structure (inher_l, ele))
 
-      | (Parsetree.Pcty_fun (parse_label, _, pclass_type), Types.Tcty_fun (label, type_expr, class_type)) ->
-          (* label = string. Dans les signatures, pas de nom de paramètres à l'intérieur des tuples *)
+      | (Parsetree.Pcty_fun (parse_label, _, pclass_type), Types.Cty_fun (label, type_expr, class_type)) ->
+          (* label = string. Dans les signatures, pas de nom de parametres a l'interieur des tuples *)
           (* si label = "", pas de label. ici on a l'information pour savoir si on a un label explicite. *)
           if parse_label = label then
             (
@@ -1195,7 +1237,7 @@
             )
           else
             (
-             raise (Failure "Parsetree.Pcty_fun (parse_label, _, pclass_type), labels différents")
+             raise (Failure "Parsetree.Pcty_fun (parse_label, _, pclass_type), labels differents")
             )
 
       | _ ->
@@ -1205,8 +1247,8 @@
     and analyse_class_type_kind env current_class_name last_pos parse_class_type sig_class_type =
       match parse_class_type.Parsetree.pcty_desc, sig_class_type with
         (Parsetree.Pcty_constr (_, _) (*of Longident.t * core_type list *),
-         Types.Tcty_constr (p, typ_list, _) (*of Path.t * type_expr list * class_type*)) ->
-          print_DEBUG "Tcty_constr _";
+         Types.Cty_constr (p, typ_list, _) (*of Path.t * type_expr list * class_type*)) ->
+          print_DEBUG "Cty_constr _";
            let k =
              Class_type
                {
@@ -1217,7 +1259,9 @@
            in
            k
 
-      | (Parsetree.Pcty_signature (_, class_type_field_list), Types.Tcty_signature class_signature) ->
+        | (Parsetree.Pcty_signature {
+              Parsetree.pcsig_fields = class_type_field_list;
+              }, Types.Cty_signature class_signature) ->
           (* we get the elements of the class in class_type_field_list *)
           let (inher_l, ele) = analyse_class_elements env current_class_name
               last_pos
@@ -1227,11 +1271,11 @@
           in
           Class_signature (inher_l, ele)
 
-      | (Parsetree.Pcty_fun (parse_label, _, pclass_type), Types.Tcty_fun (label, type_expr, class_type)) ->
-          raise (Failure "analyse_class_type_kind : Parsetree.Pcty_fun (...) with Types.Tcty_fun (...)")
+      | (Parsetree.Pcty_fun (parse_label, _, pclass_type), Types.Cty_fun (label, type_expr, class_type)) ->
+          raise (Failure "analyse_class_type_kind : Parsetree.Pcty_fun (...) with Types.Cty_fun (...)")
 (*
       | (Parsetree.Pcty_constr (longident, _) (*of Longident.t * core_type list *),
-         Types.Tcty_signature class_signature) ->
+         Types.Cty_signature class_signature) ->
            (* A VOIR : c'est pour le cas des contraintes de classes :
               class type cons = object
                 method m : int
@@ -1283,19 +1327,19 @@
         analyse_parsetree Odoc_env.empty signat mod_name len (String.length !file) ast
       in
       let code_intf =
-        if !Odoc_args.keep_code then
+        if !Odoc_global.keep_code then
           Some !file
         else
           None
       in
       {
         m_name = mod_name ;
-        m_type = Types.Tmty_signature signat ;
+        m_type = Types.Mty_signature signat ;
         m_info = info_opt ;
         m_is_interface = true ;
         m_file = !file_name ;
         m_kind = Module_struct elements ;
-        m_loc = { loc_impl = None ; loc_inter = Some (!file_name, 0) } ;
+        m_loc = { loc_impl = None ; loc_inter = Some (Location.in_file !file_name) } ;
         m_top_deps = [] ;
         m_code = None ;
         m_code_intf = code_intf ;
diff -Nru ocaml-3.12.1/ocamldoc/odoc_sig.mli ocaml-4.01.0/ocamldoc/odoc_sig.mli
--- ocaml-3.12.1/ocamldoc/odoc_sig.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_sig.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_sig.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** The module for analysing a signature and source code and creating modules, classes, ..., elements.*)
 
 (** The functions used to retrieve information from a signature. *)
@@ -46,7 +45,7 @@
       (** This function returns the Types.cltype_declaration  for the class type whose name is given,
          in the given table.
          @raise Not_found if error.*)
-      val search_class_type : tab -> string -> Types.cltype_declaration
+      val search_class_type : tab -> string -> Types.class_type_declaration
 
       (** This function returns the Types.module_type  for the module whose name is given,
          in the given table.
@@ -156,7 +155,7 @@
 
       (** Return a module_type_kind from a Parsetree.module_type and a Types.module_type *)
       val analyse_module_type_kind :
-          Odoc_env.env -> Odoc_name.t ->
+          ?erased:Odoc_name.Set.t -> Odoc_env.env -> Odoc_name.t ->
             Parsetree.module_type -> Types.module_type ->
               Odoc_module.module_type_kind
 
diff -Nru ocaml-3.12.1/ocamldoc/odoc_str.ml ocaml-4.01.0/ocamldoc/odoc_str.ml
--- ocaml-3.12.1/ocamldoc/odoc_str.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_str.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_str.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** The functions to get a string from different kinds of elements (types, modules, ...). *)
 
 module Name = Odoc_name
@@ -31,7 +30,7 @@
   | Types.Tlink t2 | Types.Tsubst t2 -> is_arrow_type t2
   | Types.Ttuple _
   | Types.Tconstr _
-  | Types.Tvar | Types.Tunivar | Types.Tobject _ | Types.Tpoly _
+  | Types.Tvar _ | Types.Tunivar _ | Types.Tobject _ | Types.Tpoly _
   | Types.Tfield _ | Types.Tnil | Types.Tvariant _ | Types.Tpackage _ -> false
 
 let raw_string_of_type_list sep type_list =
@@ -43,7 +42,7 @@
     | Types.Tlink t2 | Types.Tsubst t2 -> need_parent t2
     | Types.Tconstr _ ->
         false
-    | Types.Tvar | Types.Tunivar | Types.Tobject _ | Types.Tpoly _
+    | Types.Tvar _ | Types.Tunivar _ | Types.Tobject _ | Types.Tpoly _
     | Types.Tfield _ | Types.Tnil | Types.Tvariant _ | Types.Tpackage _ -> false
   in
   let print_one_type variance t =
@@ -126,7 +125,7 @@
 let string_of_class_params c =
   let b = Buffer.create 256 in
   let rec iter = function
-      Types.Tcty_fun (label, t, ctype) ->
+      Types.Cty_fun (label, t, ctype) ->
         let parent = is_arrow_type t in
         Printf.bprintf b "%s%s%s%s -> "
           (
@@ -144,8 +143,8 @@
           )
           (if parent then ")" else "");
         iter ctype
-    | Types.Tcty_signature _
-    | Types.Tcty_constr _ -> ()
+    | Types.Cty_signature _
+    | Types.Cty_constr _ -> ()
   in
   iter c.Odoc_class.cl_type;
   Buffer.contents b
@@ -183,11 +182,20 @@
          (List.map
             (fun cons ->
               "  | "^cons.M.vc_name^
-              (match cons.M.vc_args with
-                [] -> ""
-              | l ->
-                  " of "^(String.concat " * "
-                            (List.map (fun t -> "("^(Odoc_print.string_of_type_expr t)^")") l))
+              (match cons.M.vc_args,cons.M.vc_ret with
+              | [], None -> ""
+              | l, None ->
+                  " of " ^
+                  (String.concat " * "
+                     (List.map
+                        (fun t -> "("^Odoc_print.string_of_type_expr t^")") l))
+              | [], Some r -> " : " ^ Odoc_print.string_of_type_expr r
+              | l, Some r ->
+                  " : " ^
+                  (String.concat " * "
+                     (List.map
+                        (fun t -> "("^Odoc_print.string_of_type_expr t^")") l))
+                  ^ " -> " ^ Odoc_print.string_of_type_expr r
               )^
               (match cons.M.vc_text with
                 None ->
@@ -205,7 +213,8 @@
          (List.map
             (fun record ->
               "   "^(if record.M.rf_mutable then "mutable " else "")^
-              record.M.rf_name^" : "^(Odoc_print.string_of_type_expr record.M.rf_type)^";"^
+              record.M.rf_name^" : "^
+              (Odoc_print.string_of_type_expr record.M.rf_type)^";"^
               (match record.M.rf_text with
                 None ->
                   ""
@@ -273,5 +282,3 @@
   (match m.M.met_value.M.val_info with
     None -> ""
   | Some i -> Odoc_misc.string_of_info i)
-
-(* eof $Id: odoc_str.ml 9547 2010-01-22 12:48:24Z doligez $ *)
diff -Nru ocaml-3.12.1/ocamldoc/odoc_str.mli ocaml-4.01.0/ocamldoc/odoc_str.mli
--- ocaml-3.12.1/ocamldoc/odoc_str.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_str.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_str.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** The functions to get a string from different kinds of elements (types, modules, ...). *)
 
 (** @return the variance string for the given type and (covariant, contravariant) information. *)
diff -Nru ocaml-3.12.1/ocamldoc/odoc_test.ml ocaml-4.01.0/ocamldoc/odoc_test.ml
--- ocaml-3.12.1/ocamldoc/odoc_test.ml	2010-04-08 03:58:41.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_test.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_test.ml 10250 2010-04-08 03:58:41Z garrigue $ *)
-
 (** Custom generator to perform test on ocamldoc. *)
 
 open Odoc_info
@@ -22,10 +21,13 @@
 
 let p = Format.fprintf
 
-class string_gen =
+module Generator (G : Odoc_gen.Base) =
+struct
+  class string_gen =
   object(self)
     inherit Odoc_info.Scan.scanner
 
+
     val mutable test_kinds = []
     val mutable fmt = Format.str_formatter
 
@@ -88,7 +90,7 @@
       true
 
     method generate (module_list: Odoc_info.Module.t_module list) =
-      let oc = open_out !Odoc_info.Args.out_file in
+      let oc = open_out !Odoc_info.Global.out_file in
       fmt <- Format.formatter_of_out_channel oc;
       (
        try
@@ -106,7 +108,15 @@
       close_out oc
   end
 
+  class generator =
+    let g = new string_gen in
+    object
+      inherit G.generator as base
+
+      method generate l =
+        base#generate l;
+        g#generate l
+    end
+end;;
 
-let my_generator = new string_gen
-let _ = Odoc_info.Args.set_doc_generator
-    (Some (my_generator :> Odoc_info.Args.doc_generator))
+let _ = Odoc_args.extend_base_generator (module Generator : Odoc_gen.Base_functor);;
diff -Nru ocaml-3.12.1/ocamldoc/odoc_texi.ml ocaml-4.01.0/ocamldoc/odoc_texi.ml
--- ocaml-3.12.1/ocamldoc/odoc_texi.ml	2010-05-31 11:52:13.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_texi.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,15 +1,15 @@
 (***********************************************************************)
-(*                           OCamldoc                                  *)
+(*                                                                     *)
+(*                             OCamldoc                                *)
 (*                                                                     *)
 (*      Olivier Andrieu, base sur du code de Maxence Guesdon           *)
 (*                                                                     *)
 (*  Copyright 2001 Institut National de Recherche en Informatique et   *)
 (*  en Automatique.  All rights reserved.  This file is distributed    *)
 (*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_texi.ml 10480 2010-05-31 11:52:13Z guesdon $ *)
-
 (** Generation of Texinfo documentation. *)
 
 open Odoc_info
@@ -20,6 +20,12 @@
 open Class
 open Module
 
+let esc_8bits = ref false
+
+let info_section = ref "OCaml"
+
+let info_entry = ref []
+
 (** {2 Some small helper functions} *)
 
 let puts_nl chan s =
@@ -140,25 +146,25 @@
     (Str.regexp "}", "@}") ;
     (Str.regexp "\\.\\.\\.", "@dots{}") ;
   ] @
-    (if !Args.esc_8bits
+    (if !esc_8bits
     then [
-    (Str.regexp "à", "@`a") ;
-    (Str.regexp "â", "@^a") ;
-    (Str.regexp "é", "@'e") ;
-    (Str.regexp "è", "@`e") ;
-    (Str.regexp "ê", "@^e") ;
-    (Str.regexp "ë", "@\"e") ;
-    (Str.regexp "ç", "@,{c}") ;
-    (Str.regexp "ô", "@^o") ;
-    (Str.regexp "ö", "@\"o") ;
-    (Str.regexp "î", "@^i") ;
-    (Str.regexp "ï", "@\"i") ;
-    (Str.regexp "ù", "@`u") ;
-    (Str.regexp "û", "@^u") ;
-    (Str.regexp "æ", "@ae{}" ) ;
-    (Str.regexp "Æ", "@AE{}" ) ;
-    (Str.regexp "ß", "@ss{}" ) ;
-    (Str.regexp "©", "@copyright{}" ) ;
+    (Str.regexp "\xE0", "@`a") ;
+    (Str.regexp "\xE2", "@^a") ;
+    (Str.regexp "\xE9", "@'e") ;
+    (Str.regexp "\xE8", "@`e") ;
+    (Str.regexp "\xEA", "@^e") ;
+    (Str.regexp "\xEB", "@\"e") ;
+    (Str.regexp "\xF7", "@,{c}") ;
+    (Str.regexp "\xF4", "@^o") ;
+    (Str.regexp "\xF6", "@\"o") ;
+    (Str.regexp "\xEE", "@^i") ;
+    (Str.regexp "\xEF", "@\"i") ;
+    (Str.regexp "\xF9", "@`u") ;
+    (Str.regexp "\xFB", "@^u") ;
+    (Str.regexp "\xE6", "@ae{}" ) ;
+    (Str.regexp "\xC6", "@AE{}" ) ;
+    (Str.regexp "\xDF", "@ss{}" ) ;
+    (Str.regexp "\xA9", "@copyright{}" ) ;
     ]
     else [])
 
@@ -381,6 +387,9 @@
 
 exception Aliased_node
 
+module Generator =
+struct
+
 (** This class is used to create objects which can generate a simple
     Texinfo documentation. *)
 class texi =
@@ -413,7 +422,7 @@
 
     method index (ind : indices) ent =
       Verbatim
-        (if !Args.with_index
+        (if !Global.with_index
         then (assert(List.mem ind indices_to_build) ;
               String.concat ""
                 [ "@" ; indices ind ; "index " ;
@@ -630,9 +639,13 @@
           Printf.sprintf "(%s) "
             (String.concat ", " (List.map f l))
 
-    method string_of_type_args = function
-      | [] -> ""
-      | args -> " of " ^ (Odoc_info.string_of_type_list " * " args)
+    method string_of_type_args (args:Types.type_expr list) (ret:Types.type_expr option) =
+      match args, ret with
+      | [], None -> ""
+      | args, None -> " of " ^ (Odoc_info.string_of_type_list " * " args)
+      | [], Some r -> " : " ^ (Odoc_info.string_of_type_expr r)
+      | args, Some r -> " : " ^ (Odoc_info.string_of_type_list " * " args) ^
+                                " -> " ^ (Odoc_info.string_of_type_expr r)
 
     (** Return Texinfo code for a type. *)
     method texi_of_type ty =
@@ -658,11 +671,13 @@
                   (List.map
                      (fun constr ->
                        (Raw ("  | " ^ constr.vc_name)) ::
-                       (Raw (self#string_of_type_args constr.vc_args)) ::
+                       (Raw (self#string_of_type_args
+                               constr.vc_args constr.vc_ret)) ::
                        (match constr.vc_text with
                        | None -> [ Newline ]
                        | Some t ->
-                           ((Raw (indent 5 "\n(* ")) :: (self#soft_fix_linebreaks 8 t)) @
+                           (Raw (indent 5 "\n(* ") ::
+                            self#soft_fix_linebreaks 8 t) @
                            [ Raw " *)" ; Newline ]
                        ) ) l ) )
            | Type_record l ->
@@ -694,7 +709,7 @@
         [ self#fixedblock
             ( [ Newline ; minus ; Raw "exception " ;
                 Raw (Name.simple e.ex_name) ;
-                Raw (self#string_of_type_args e.ex_args) ] @
+                Raw (self#string_of_type_args e.ex_args None) ] @
               (match e.ex_alias with
               | None -> []
               | Some ea -> [ Raw " = " ; Raw
@@ -1055,7 +1070,7 @@
 
     (** Writes the header of the TeXinfo document. *)
     method generate_texi_header chan texi_filename m_list =
-      let title = match !Args.title with
+      let title = match !Global.title with
       | None -> ""
       | Some s -> self#escape s in
       let filename =
@@ -1080,18 +1095,18 @@
                "@settitle " ^ title ;
                "@c %**end of header" ; ] ;
 
-             (if !Args.with_index then
+             (if !Global.with_index then
                List.map
                  (fun ind ->
                    "@defcodeindex " ^ (indices ind))
                  indices_to_build
              else []) ;
 
-             [ Texi.dirsection !Args.info_section ] ;
+             [ Texi.dirsection !info_section ] ;
 
              Texi.direntry
-               (if !Args.info_entry <> []
-               then !Args.info_entry
+               (if !info_entry <> []
+               then !info_entry
                else [ Printf.sprintf "* %s: (%s)."
                         title
                         (Filename.chop_suffix filename ".info") ]) ;
@@ -1108,7 +1123,7 @@
 
       (* insert the intro file *)
       begin
-        match !Odoc_info.Args.intro_file with
+        match !Odoc_info.Global.intro_file with
         | None when title <> "" ->
             puts_nl chan "@ifinfo" ;
             puts_nl chan ("Documentation for " ^ title) ;
@@ -1125,7 +1140,7 @@
       (* write a top menu *)
       Texi.generate_menu chan
         ((List.map (fun m -> `Module m) m_list) @
-         (if !Args.with_index then
+         (if !Global.with_index then
            let indices_names_to_build = List.map indices indices_to_build in
            List.rev
              (List.fold_left
@@ -1142,7 +1157,7 @@
     (** Writes the trailer of the TeXinfo document. *)
     method generate_texi_trailer chan =
       nl chan ;
-      if !Args.with_index
+      if !Global.with_index
       then
         let indices_names_to_build = List.map indices indices_to_build in
         List.iter (puts_nl chan)
@@ -1155,7 +1170,7 @@
                          "@printindex " ^ shortname ; ]
                   else [])
                 indices_names )) ;
-      if !Args.with_toc
+      if !Global.with_toc
       then puts_nl chan "@contents" ;
       puts_nl chan "@bye"
 
@@ -1203,25 +1218,25 @@
 
 
     (** Generate the Texinfo file from a module list,
-       in the {!Odoc_info.Args.out_file} file. *)
+       in the {!Odoc_info.Global.out_file} file. *)
     method generate module_list =
       Hashtbl.clear node_tbl ;
       let filename =
-        if !Args.out_file = Odoc_messages.default_out_file
+        if !Global.out_file = Odoc_messages.default_out_file
         then "ocamldoc.texi"
-        else !Args.out_file in
-      if !Args.with_index
+        else !Global.out_file in
+      if !Global.with_index
       then List.iter self#scan_for_index
           (List.map (fun m -> `Module m) module_list) ;
       try
         let chanout = open_out
-            (Filename.concat !Args.target_dir filename) in
-        if !Args.with_header
+            (Filename.concat !Global.target_dir filename) in
+        if !Global.with_header
         then self#generate_texi_header chanout filename module_list ;
         List.iter
           (self#generate_for_module chanout)
           module_list ;
-        if !Args.with_trailer
+        if !Global.with_trailer
         then self#generate_texi_trailer chanout ;
         close_out chanout
       with
@@ -1230,3 +1245,6 @@
           prerr_endline s ;
           incr Odoc_info.errors
   end
+end
+
+module type Texi_generator = module type of Generator
diff -Nru ocaml-3.12.1/ocamldoc/odoc_text.ml ocaml-4.01.0/ocamldoc/odoc_text.ml
--- ocaml-3.12.1/ocamldoc/odoc_text.ml	2010-03-08 16:54:13.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_text.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_text.ml 9638 2010-03-08 16:54:13Z guesdon $ *)
-
 exception Text_syntax of int * int * string (* line, char, string *)
 
 open Odoc_types
@@ -133,6 +132,8 @@
                    | RK_attribute -> "attribute"
                    | RK_method -> "method"
                    | RK_section _ -> "section"
+                   | RK_recfield -> "recfield"
+                   | RK_const -> "const"
                  in
                  s^":"
             )
diff -Nru ocaml-3.12.1/ocamldoc/odoc_text.mli ocaml-4.01.0/ocamldoc/odoc_text.mli
--- ocaml-3.12.1/ocamldoc/odoc_text.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_text.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_text.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** A module with a function to parse strings to obtain a [Odoc_types.text] value. *)
 
 (** Syntax error in a text. *)
diff -Nru ocaml-3.12.1/ocamldoc/odoc_text_lexer.mll ocaml-4.01.0/ocamldoc/odoc_text_lexer.mll
--- ocaml-3.12.1/ocamldoc/odoc_text_lexer.mll	2010-06-16 11:38:22.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_text_lexer.mll	2013-05-28 11:04:11.000000000 +0000
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_text_lexer.mll 10584 2010-06-16 11:38:22Z guesdon $ *)
-
 (** The lexer for string to build text structures. *)
 
 open Lexing
@@ -22,10 +20,10 @@
 
 let string_buffer = Buffer.create 32
 
-(** Fonction de remise à zéro de la chaine de caractères tampon *)
+(** Fonction de remise a zero de la chaine de caracteres tampon *)
 let reset_string_buffer () = Buffer.reset string_buffer
 
-(** Fonction d'ajout d'un caractère dans la chaine de caractères tampon *)
+(** Fonction d'ajout d'un caractere dans la chaine de caracteres tampon *)
 let ajout_char_string = Buffer.add_char string_buffer
 
 (** Add a string to the buffer. *)
@@ -161,6 +159,8 @@
 let begin_att_ref = "{!attribute:"blank_nl | "{!attribute:"
 let begin_met_ref = "{!method:"blank_nl | "{!method:"
 let begin_sec_ref = "{!section:"blank_nl | "{!section:"
+let begin_recf_ref = "{!recfield:"blank_nl | "{!recfield:"
+let begin_const_ref = "{!const:"blank_nl | "{!const:"
 let begin_mod_list_ref = "{!modules:"blank_nl | "{!modules:"
 let index_list = "{!indexlist}"
 let begin_custom = "{"['a'-'z''A'-'Z']['a'-'z''A'-'Z''0'-'9']*
@@ -186,7 +186,7 @@
     {
       print_DEBUG "end";
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or
+      if !verb_mode || !target_mode || !code_pre_mode ||
         (!open_brackets >= 1) then
         Char (Lexing.lexeme lexbuf)
       else
@@ -200,8 +200,8 @@
     {
       print_DEBUG "begin_title";
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or
-        (!open_brackets >= 1) or !ele_ref_mode then
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         let s = Lexing.lexeme lexbuf in
@@ -229,8 +229,8 @@
 | begin_bold
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or
-        (!open_brackets >= 1) or !ele_ref_mode then
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         BOLD
@@ -238,8 +238,8 @@
 | begin_italic
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or
-        (!open_brackets >= 1) or !ele_ref_mode then
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         ITALIC
@@ -247,8 +247,8 @@
 | begin_link
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or
-        (!open_brackets >= 1) or !ele_ref_mode then
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         LINK
@@ -256,8 +256,8 @@
 | begin_emp
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or
-        (!open_brackets >= 1) or !ele_ref_mode then
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         EMP
@@ -265,8 +265,8 @@
 | begin_superscript
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or
-        (!open_brackets >= 1) or !ele_ref_mode then
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         SUPERSCRIPT
@@ -274,8 +274,8 @@
 | begin_subscript
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or
-        (!open_brackets >= 1) or !ele_ref_mode then
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         SUBSCRIPT
@@ -283,8 +283,8 @@
 | begin_center
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or
-        (!open_brackets >= 1) or !ele_ref_mode then
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         CENTER
@@ -292,8 +292,8 @@
 | begin_left
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or
-        (!open_brackets >= 1) or !ele_ref_mode then
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         LEFT
@@ -301,8 +301,8 @@
 | begin_right
      {
       incr_cpts lexbuf ;
-       if !verb_mode or !target_mode or !code_pre_mode
-           or (!open_brackets >= 1) or !ele_ref_mode then
+       if !verb_mode || !target_mode || !code_pre_mode
+           || (!open_brackets >= 1) || !ele_ref_mode then
          Char (Lexing.lexeme lexbuf)
        else
          RIGHT
@@ -311,8 +311,8 @@
     {
       print_DEBUG "LIST";
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or
-        (!open_brackets >= 1) or !ele_ref_mode then
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         LIST
@@ -320,8 +320,8 @@
 | begin_enum
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or
-        (!open_brackets >= 1) or !ele_ref_mode then
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         ENUM
@@ -330,8 +330,8 @@
     {
       print_DEBUG "ITEM";
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or
-        (!open_brackets >= 1) or !ele_ref_mode then
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         ITEM
@@ -339,8 +339,8 @@
 | begin_target
    {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or
-        (!open_brackets >= 1) or !ele_ref_mode then
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         (
@@ -357,8 +357,8 @@
 | begin_latex
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or
-        (!open_brackets >= 1) or !ele_ref_mode then
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         (
@@ -369,7 +369,7 @@
 | end_target
     {
       incr_cpts lexbuf ;
-      if !verb_mode or (!open_brackets >= 1) or !code_pre_mode or
+      if !verb_mode || (!open_brackets >= 1) || !code_pre_mode ||
         !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
@@ -387,7 +387,7 @@
 | begin_code
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or !ele_ref_mode then
+      if !verb_mode || !target_mode || !code_pre_mode || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         if !open_brackets <= 0 then
@@ -404,7 +404,7 @@
 | end_code
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or !ele_ref_mode then
+      if !verb_mode || !target_mode || !code_pre_mode || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         if !open_brackets > 1 then
@@ -428,7 +428,7 @@
 | begin_code_pre
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or !ele_ref_mode then
+      if !verb_mode || !target_mode || !code_pre_mode || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         (
@@ -439,7 +439,7 @@
 | end_code_pre
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !ele_ref_mode then
+      if !verb_mode || !target_mode || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         if !open_brackets >= 1 then
@@ -480,7 +480,7 @@
 | begin_ele_ref
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or !open_brackets >= 1 then
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
         Char (Lexing.lexeme lexbuf)
       else
         if not !ele_ref_mode then
@@ -498,7 +498,7 @@
 | begin_val_ref
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or !open_brackets >= 1 then
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
         Char (Lexing.lexeme lexbuf)
       else
         if not !ele_ref_mode then
@@ -515,7 +515,7 @@
 | begin_typ_ref
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or !open_brackets >= 1 then
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
         Char (Lexing.lexeme lexbuf)
       else
         if not !ele_ref_mode then
@@ -532,7 +532,7 @@
 | begin_exc_ref
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or !open_brackets >= 1 then
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
         Char (Lexing.lexeme lexbuf)
       else
         if not !ele_ref_mode then
@@ -549,7 +549,7 @@
 | begin_mod_ref
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or !open_brackets >= 1 then
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
         Char (Lexing.lexeme lexbuf)
       else
         if not !ele_ref_mode then
@@ -566,7 +566,7 @@
 | begin_modt_ref
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or !open_brackets >= 1 then
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
         Char (Lexing.lexeme lexbuf)
       else
         if not !ele_ref_mode then
@@ -583,7 +583,7 @@
 | begin_cla_ref
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or !open_brackets >= 1 then
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
         Char (Lexing.lexeme lexbuf)
       else
         if not !ele_ref_mode then
@@ -600,7 +600,7 @@
 | begin_clt_ref
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or !open_brackets >= 1 then
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
         Char (Lexing.lexeme lexbuf)
       else
         if not !ele_ref_mode then
@@ -617,7 +617,7 @@
 | begin_att_ref
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or !open_brackets >= 1 then
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
         Char (Lexing.lexeme lexbuf)
       else
         if not !ele_ref_mode then
@@ -634,7 +634,7 @@
 | begin_met_ref
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or !open_brackets >= 1 then
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
         Char (Lexing.lexeme lexbuf)
       else
         if not !ele_ref_mode then
@@ -651,7 +651,7 @@
 | begin_sec_ref
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or !open_brackets >= 1 then
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
         Char (Lexing.lexeme lexbuf)
       else
         if not !ele_ref_mode then
@@ -664,11 +664,42 @@
            Char (Lexing.lexeme lexbuf)
           )
     }
-
+| begin_recf_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           RECF_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+| begin_const_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           CONST_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
 | begin_mod_list_ref
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or !open_brackets >= 1 then
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
         Char (Lexing.lexeme lexbuf)
       else
         if not !ele_ref_mode then
@@ -685,7 +716,7 @@
 | index_list
     {
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or !open_brackets >= 1 then
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
         Char (Lexing.lexeme lexbuf)
       else
         if not !ele_ref_mode then
@@ -697,7 +728,7 @@
 | begin_verb
     {
       incr_cpts lexbuf ;
-      if !target_mode or (!open_brackets >= 1) or !code_pre_mode or !ele_ref_mode then
+      if !target_mode || (!open_brackets >= 1) || !code_pre_mode || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         (
@@ -708,7 +739,7 @@
 | end_verb
     {
       incr_cpts lexbuf ;
-      if !target_mode or (!open_brackets >= 1) or !code_pre_mode or !ele_ref_mode then
+      if !target_mode || (!open_brackets >= 1) || !code_pre_mode || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         (
@@ -720,7 +751,10 @@
 | shortcut_list_item
     {
       incr_cpts lexbuf ;
-      if !shortcut_list_mode then
+      if !target_mode || (!open_brackets >= 1) || !code_pre_mode
+          || !ele_ref_mode || !verb_mode then
+        Char (Lexing.lexeme lexbuf)
+      else if !shortcut_list_mode then
         (
          SHORTCUT_LIST_ITEM
         )
@@ -734,7 +768,10 @@
 | shortcut_enum_item
     {
       incr_cpts lexbuf ;
-      if !shortcut_list_mode then
+      if !target_mode || (!open_brackets >= 1) || !code_pre_mode
+         || !ele_ref_mode || !verb_mode then
+        Char (Lexing.lexeme lexbuf)
+      else if !shortcut_list_mode then
         SHORTCUT_ENUM_ITEM
       else
         (
@@ -760,7 +797,7 @@
          END_SHORTCUT_LIST
         )
       else
-        if !target_mode or (!open_brackets >= 1) or !code_pre_mode or !ele_ref_mode or !verb_mode then
+        if !target_mode || (!open_brackets >= 1) || !code_pre_mode || !ele_ref_mode || !verb_mode then
           Char (Lexing.lexeme lexbuf)
         else
           BLANK_LINE
@@ -772,8 +809,8 @@
     {
       print_DEBUG "begin_custom";
       incr_cpts lexbuf ;
-      if !verb_mode or !target_mode or !code_pre_mode or
-        (!open_brackets >= 1) or !ele_ref_mode then
+      if !verb_mode || !target_mode || !code_pre_mode ||
+        (!open_brackets >= 1) || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         let s = Lexing.lexeme lexbuf in
@@ -786,7 +823,7 @@
 |  "{"
     {
       incr_cpts lexbuf ;
-      if !target_mode or (!open_brackets >= 1) or !code_pre_mode or !ele_ref_mode then
+      if !target_mode || (!open_brackets >= 1) || !code_pre_mode || !ele_ref_mode then
         Char (Lexing.lexeme lexbuf)
       else
         LBRACE
diff -Nru ocaml-3.12.1/ocamldoc/odoc_text_parser.mly ocaml-4.01.0/ocamldoc/odoc_text_parser.mly
--- ocaml-3.12.1/ocamldoc/odoc_text_parser.mly	2010-03-08 16:54:13.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_text_parser.mly	2012-10-15 17:50:56.000000000 +0000
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_text_parser.mly 9638 2010-03-08 16:54:13Z guesdon $ *)
-
 open Odoc_types
 
 let identchar =
@@ -62,6 +60,8 @@
 %token ATT_REF
 %token MET_REF
 %token SEC_REF
+%token RECF_REF
+%token CONST_REF
 %token MOD_LIST_REF
 %token INDEX_LIST
 
@@ -80,8 +80,9 @@
 %token  Char
 
 /* Start Symbols */
-%start main
+%start main located_element_list
 %type  main
+%type <(int * int * Odoc_types.text_element) list> located_element_list
 
 %%
 main:
@@ -98,6 +99,16 @@
 | text_element text_element_list { $1 :: $2 }
 ;
 
+located_element_list:
+  located_element { [ $1 ] }
+| located_element located_element_list { $1 :: $2 }
+;
+
+located_element:
+  text_element { Parsing.symbol_start (), Parsing.symbol_end (), $1}
+;
+
+
 ele_ref_kind:
   ELE_REF { None }
 | VAL_REF { Some RK_value }
@@ -110,6 +121,8 @@
 | ATT_REF { Some RK_attribute }
 | MET_REF { Some RK_method }
 | SEC_REF { Some (RK_section [])}
+| RECF_REF { Some RK_recfield }
+| CONST_REF { Some RK_const }
 ;
 
 text_element:
diff -Nru ocaml-3.12.1/ocamldoc/odoc_to_text.ml ocaml-4.01.0/ocamldoc/odoc_to_text.ml
--- ocaml-3.12.1/ocamldoc/odoc_to_text.ml	2010-05-31 11:52:13.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_to_text.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_to_text.ml 10480 2010-05-31 11:52:13Z guesdon $ *)
-
 (** Text generation.
 
    This module contains the class [to_text] with methods used to transform
diff -Nru ocaml-3.12.1/ocamldoc/odoc_type.ml ocaml-4.01.0/ocamldoc/odoc_type.ml
--- ocaml-3.12.1/ocamldoc/odoc_type.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_type.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_type.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** Representation and manipulation of a type, but not class nor module type.*)
 
 module Name = Odoc_name
@@ -22,6 +21,7 @@
 type variant_constructor = {
     vc_name : string ;
     vc_args : Types.type_expr list ; (** arguments of the constructor *)
+    vc_ret : Types.type_expr option ;
     mutable vc_text : Odoc_types.text option ; (** optional user description *)
   }
 
diff -Nru ocaml-3.12.1/ocamldoc/odoc_types.ml ocaml-4.01.0/ocamldoc/odoc_types.ml
--- ocaml-3.12.1/ocamldoc/odoc_types.ml	2010-11-29 12:49:46.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_types.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_types.ml 10867 2010-11-29 12:49:46Z xclerc $ *)
-
 type ref_kind =
     RK_module
   | RK_module_type
@@ -22,6 +21,8 @@
   | RK_attribute
   | RK_method
   | RK_section of text
+  | RK_recfield
+  | RK_const
 
 and text_element =
   | Raw of string
@@ -91,8 +92,8 @@
 }
 
 type location = {
-    loc_impl : (string * int) option ;
-    loc_inter : (string * int) option ;
+    loc_impl : Location.t option ;
+    loc_inter : Location.t option ;
   }
 
 let dummy_loc = { loc_impl = None ; loc_inter = None }
diff -Nru ocaml-3.12.1/ocamldoc/odoc_types.mli ocaml-4.01.0/ocamldoc/odoc_types.mli
--- ocaml-3.12.1/ocamldoc/odoc_types.mli	2010-11-29 12:49:46.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_types.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_types.mli 10867 2010-11-29 12:49:46Z xclerc $ *)
-
 (** Types for the information collected in comments. *)
 
 (** The differents kinds of element references. *)
@@ -25,6 +24,8 @@
   | RK_attribute
   | RK_method
   | RK_section of text
+  | RK_recfield
+  | RK_const
 
 and text_element =
   | Raw of string (** Raw text. *)
@@ -94,8 +95,8 @@
 
 (** Location of elements in implementation and interface files. *)
 type location = {
-    loc_impl : (string * int) option ; (** implementation file name and position *)
-    loc_inter : (string * int) option ; (** interface file name and position *)
+    loc_impl : Location.t option ; (** implementation location *)
+    loc_inter : Location.t option ; (** interface location *)
   }
 
 (** A dummy location. *)
diff -Nru ocaml-3.12.1/ocamldoc/odoc_value.ml ocaml-4.01.0/ocamldoc/odoc_value.ml
--- ocaml-3.12.1/ocamldoc/odoc_value.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/odoc_value.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_value.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** Representation and manipulation of values, class attributes and class methods. *)
 
 module Name = Odoc_name
@@ -77,13 +76,13 @@
     | Types.Tsubst texp ->
         iter texp
     | Types.Tpoly (texp, _) -> iter texp
-    | Types.Tvar
+    | Types.Tvar _
     | Types.Ttuple _
     | Types.Tconstr _
     | Types.Tobject _
     | Types.Tfield _
     | Types.Tnil
-    | Types.Tunivar
+    | Types.Tunivar _
     | Types.Tpackage _
     | Types.Tvariant _ ->
         []
diff -Nru ocaml-3.12.1/ocamldoc/remove_DEBUG ocaml-4.01.0/ocamldoc/remove_DEBUG
--- ocaml-3.12.1/ocamldoc/remove_DEBUG	2010-05-20 09:44:25.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/remove_DEBUG	2012-10-15 17:50:56.000000000 +0000
@@ -1,7 +1,7 @@
 #!/bin/sh
 
 #(***********************************************************************)
-#(*                            OCamldoc                                 *)
+#(*                             OCamldoc                                *)
 #(*                                                                     *)
 #(*            Damien Doligez, projet Moscova, INRIA Rocquencourt       *)
 #(*                                                                     *)
@@ -11,8 +11,6 @@
 #(*                                                                     *)
 #(***********************************************************************)
 
-# $Id: remove_DEBUG 10443 2010-05-20 09:44:25Z doligez $
-
 # usage: remove_DEBUG 
 # remove from  every line that contains the string "DEBUG",
 # respecting the cpp # line annotation conventions
diff -Nru ocaml-3.12.1/ocamldoc/runocamldoc ocaml-4.01.0/ocamldoc/runocamldoc
--- ocaml-3.12.1/ocamldoc/runocamldoc	2010-05-20 09:44:25.000000000 +0000
+++ ocaml-4.01.0/ocamldoc/runocamldoc	2012-10-15 17:50:56.000000000 +0000
@@ -1,5 +1,16 @@
 #!/bin/sh
-# $Id: runocamldoc 10443 2010-05-20 09:44:25Z doligez $
+
+#######################################################################
+#                                                                     #
+#                                OCaml                                #
+#                                                                     #
+#            Xavier Leroy, projet Cristal, INRIA Rocquencourt         #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique.  All rights reserved.  This file is distributed    #
+#  under the terms of the Q Public License version 1.0.               #
+#                                                                     #
+#######################################################################
 
 case "$1" in
   true) shift
diff -Nru ocaml-3.12.1/otherlibs/Makefile ocaml-4.01.0/otherlibs/Makefile
--- ocaml-3.12.1/otherlibs/Makefile	2007-11-08 09:17:48.000000000 +0000
+++ ocaml-4.01.0/otherlibs/Makefile	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,8 +11,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile 8489 2007-11-08 09:17:48Z frisch $
-
 # Common Makefile for otherlibs on the Unix ports
 
 CAMLC=$(ROOTDIR)/ocamlcomp.sh
diff -Nru ocaml-3.12.1/otherlibs/Makefile.nt ocaml-4.01.0/otherlibs/Makefile.nt
--- ocaml-3.12.1/otherlibs/Makefile.nt	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/Makefile.nt	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,8 +11,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile.nt 9547 2010-01-22 12:48:24Z doligez $
-
 # Common Makefile for otherlibs on the Win32/MinGW ports
 
 CAMLC=$(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib -w s
diff -Nru ocaml-3.12.1/otherlibs/Makefile.shared ocaml-4.01.0/otherlibs/Makefile.shared
--- ocaml-3.12.1/otherlibs/Makefile.shared	2008-07-15 15:31:32.000000000 +0000
+++ ocaml-4.01.0/otherlibs/Makefile.shared	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,8 +11,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile.shared 8916 2008-07-15 15:31:32Z frisch $
-
 # Common Makefile for otherlibs
 
 ROOTDIR=../..
@@ -21,7 +19,7 @@
 # Compilation options
 CC=$(BYTECC)
 CAMLRUN=$(ROOTDIR)/boot/ocamlrun
-COMPFLAGS=-warn-error A -g $(EXTRACAMLFLAGS)
+COMPFLAGS=-w +33..39 -warn-error A -g $(EXTRACAMLFLAGS)
 MKLIB=$(CAMLRUN) $(ROOTDIR)/tools/ocamlmklib
 
 # Variables to be defined by individual libraries:
@@ -45,10 +43,12 @@
 allopt: lib$(CLIBNAME).$(A) $(LIBNAME).cmxa $(LIBNAME).$(CMXS) $(CMIFILES)
 
 $(LIBNAME).cma: $(CAMLOBJS)
-	$(MKLIB) -o $(LIBNAME) -oc $(CLIBNAME) -ocamlc '$(CAMLC)' -linkall $(CAMLOBJS) $(LINKOPTS)
+	$(MKLIB) -o $(LIBNAME) -oc $(CLIBNAME) -ocamlc '$(CAMLC)' -linkall \
+	         $(CAMLOBJS) $(LINKOPTS)
 
 $(LIBNAME).cmxa: $(CAMLOBJS_NAT)
-	$(MKLIB) -o $(LIBNAME) -oc $(CLIBNAME) -ocamlopt '$(CAMLOPT)' -linkall $(CAMLOBJS_NAT) $(LINKOPTS)
+	$(MKLIB) -o $(LIBNAME) -oc $(CLIBNAME) -ocamlopt '$(CAMLOPT)' -linkall \
+	         $(CAMLOBJS_NAT) $(LINKOPTS)
 
 $(LIBNAME).cmxs: $(LIBNAME).cmxa lib$(CLIBNAME).$(A)
 	$(CAMLOPT) -shared -o $(LIBNAME).cmxs -I . $(LIBNAME).cmxa
diff -Nru ocaml-3.12.1/otherlibs/bigarray/.cvsignore ocaml-4.01.0/otherlibs/bigarray/.cvsignore
--- ocaml-3.12.1/otherlibs/bigarray/.cvsignore	2010-01-20 16:26:46.000000000 +0000
+++ ocaml-4.01.0/otherlibs/bigarray/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-*.o
-*.x
-so_locations
-*.so
-*.a
diff -Nru ocaml-3.12.1/otherlibs/bigarray/.depend ocaml-4.01.0/otherlibs/bigarray/.depend
--- ocaml-3.12.1/otherlibs/bigarray/.depend	2011-07-04 21:15:01.000000000 +0000
+++ ocaml-4.01.0/otherlibs/bigarray/.depend	2013-08-15 16:13:16.000000000 +0000
@@ -3,9 +3,9 @@
   ../../byterun/../config/s.h ../../byterun/mlvalues.h bigarray.h \
   ../../byterun/config.h ../../byterun/mlvalues.h ../../byterun/custom.h \
   ../../byterun/fail.h ../../byterun/intext.h ../../byterun/io.h \
-  ../../byterun/fix_code.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/hash.h ../../byterun/memory.h ../../byterun/gc.h \
   ../../byterun/major_gc.h ../../byterun/freelist.h \
-  ../../byterun/minor_gc.h
+  ../../byterun/minor_gc.h ../../byterun/int64_native.h
 mmap_unix.o: mmap_unix.c bigarray.h ../../byterun/config.h \
   ../../byterun/../config/m.h ../../byterun/../config/s.h \
   ../../byterun/mlvalues.h ../../byterun/config.h ../../byterun/misc.h \
@@ -16,6 +16,6 @@
   ../../byterun/mlvalues.h ../../byterun/config.h ../../byterun/misc.h \
   ../../byterun/alloc.h ../../byterun/mlvalues.h ../../byterun/custom.h \
   ../../byterun/fail.h ../../byterun/sys.h ../unix/unixsupport.h
-bigarray.cmi:
-bigarray.cmo: bigarray.cmi
-bigarray.cmx: bigarray.cmi
+bigarray.cmi :
+bigarray.cmo : bigarray.cmi
+bigarray.cmx : bigarray.cmi
diff -Nru ocaml-3.12.1/otherlibs/bigarray/Makefile ocaml-4.01.0/otherlibs/bigarray/Makefile
--- ocaml-3.12.1/otherlibs/bigarray/Makefile	2008-01-04 09:52:27.000000000 +0000
+++ ocaml-4.01.0/otherlibs/bigarray/Makefile	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,8 +11,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile 8748 2008-01-04 09:52:27Z xleroy $
-
 LIBNAME=bigarray
 EXTRACFLAGS=-I../unix -DIN_OCAML_BIGARRAY -DCAML_NAME_SPACE
 EXTRACAMLFLAGS=-I ../unix
diff -Nru ocaml-3.12.1/otherlibs/bigarray/Makefile.nt ocaml-4.01.0/otherlibs/bigarray/Makefile.nt
--- ocaml-3.12.1/otherlibs/bigarray/Makefile.nt	2008-01-04 15:01:48.000000000 +0000
+++ ocaml-4.01.0/otherlibs/bigarray/Makefile.nt	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,8 +11,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile.nt 8754 2008-01-04 15:01:48Z xleroy $
-
 LIBNAME=bigarray
 EXTRACFLAGS=-I../win32unix -DIN_OCAML_BIGARRAY -DCAML_NAME_SPACE
 EXTRACAMLFLAGS=-I ../win32unix
diff -Nru ocaml-3.12.1/otherlibs/bigarray/bigarray.h ocaml-4.01.0/otherlibs/bigarray/bigarray.h
--- ocaml-3.12.1/otherlibs/bigarray/bigarray.h	2008-12-03 18:09:09.000000000 +0000
+++ ocaml-4.01.0/otherlibs/bigarray/bigarray.h	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*         Manuel Serrano and Xavier Leroy, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: bigarray.h 9153 2008-12-03 18:09:09Z doligez $ */
-
 #ifndef CAML_BIGARRAY_H
 #define CAML_BIGARRAY_H
 
@@ -42,7 +40,7 @@
   CAML_BA_UINT16,              /* Unsigned 16-bit integers */
   CAML_BA_INT32,               /* Signed 32-bit integers */
   CAML_BA_INT64,               /* Signed 64-bit integers */
-  CAML_BA_CAML_INT,            /* Caml-style integers (signed 31 or 63 bits) */
+  CAML_BA_CAML_INT,            /* OCaml-style integers (signed 31 or 63 bits) */
   CAML_BA_NATIVE_INT,       /* Platform-native long integers (32 or 64 bits) */
   CAML_BA_COMPLEX32,           /* Single-precision complex */
   CAML_BA_COMPLEX64,           /* Double-precision complex */
@@ -56,8 +54,8 @@
 };
 
 enum caml_ba_managed {
-  CAML_BA_EXTERNAL = 0,        /* Data is not allocated by Caml */
-  CAML_BA_MANAGED = 0x200,     /* Data is allocated by Caml */
+  CAML_BA_EXTERNAL = 0,        /* Data is not allocated by OCaml */
+  CAML_BA_MANAGED = 0x200,     /* Data is allocated by OCaml */
   CAML_BA_MAPPED_FILE = 0x400, /* Data is a memory mapped file */
   CAML_BA_MANAGED_MASK = 0x600 /* Mask for "managed" bits in flags field */
 };
@@ -73,9 +71,21 @@
   intnat num_dims;            /* Number of dimensions */
   intnat flags;  /* Kind of element array + memory layout + allocation status */
   struct caml_ba_proxy * proxy; /* The proxy for sub-arrays, or NULL */
+  /* PR#5516: use C99's flexible array types if possible */
+#if (__STDC_VERSION__ >= 199901L)
+  intnat dim[]  /*[num_dims]*/; /* Size in each dimension */
+#else
   intnat dim[1] /*[num_dims]*/; /* Size in each dimension */
+#endif
 };
 
+/* Size of struct caml_ba_array, in bytes, without dummy first dimension */
+#if (__STDC_VERSION__ >= 199901L)
+#define SIZEOF_BA_ARRAY sizeof(struct caml_ba_array)
+#else
+#define SIZEOF_BA_ARRAY (sizeof(struct caml_ba_array) - sizeof(intnat))
+#endif
+
 #define Caml_ba_array_val(v) ((struct caml_ba_array *) Data_custom_val(v))
 
 #define Caml_ba_data_val(v) (Caml_ba_array_val(v)->data)
diff -Nru ocaml-3.12.1/otherlibs/bigarray/bigarray.ml ocaml-4.01.0/otherlibs/bigarray/bigarray.ml
--- ocaml-3.12.1/otherlibs/bigarray/bigarray.ml	2008-07-14 09:09:53.000000000 +0000
+++ ocaml-4.01.0/otherlibs/bigarray/bigarray.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*          Manuel Serrano et Xavier Leroy, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: bigarray.ml 8911 2008-07-14 09:09:53Z xleroy $ *)
-
 (* Module [Bigarray]: large, multi-dimensional, numerical arrays *)
 
 external init : unit -> unit = "caml_ba_init"
@@ -96,7 +94,7 @@
   external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
   external map_internal: Unix.file_descr -> ('a, 'b) kind -> 'c layout ->
                      bool -> int array -> int64 -> ('a, 'b, 'c) t
-                     = "caml_ba_map_file_bytecode" "caml_ba_map_file"
+     = "caml_ba_map_file_bytecode" "caml_ba_map_file"
   let map_file fd ?(pos = 0L) kind layout shared dims =
     map_internal fd kind layout shared dims pos
 end
@@ -108,8 +106,9 @@
   external get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_ref_1"
   external set: ('a, 'b, 'c) t -> int -> 'a -> unit = "%caml_ba_set_1"
   external unsafe_get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_unsafe_ref_1"
-  external unsafe_set: ('a, 'b, 'c) t -> int -> 'a -> unit = "%caml_ba_unsafe_set_1"
-  let dim a = Genarray.nth_dim a 0
+  external unsafe_set: ('a, 'b, 'c) t -> int -> 'a -> unit
+     = "%caml_ba_unsafe_set_1"
+  external dim: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
   external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
   external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
   external sub: ('a, 'b, 'c) t -> int -> int -> ('a, 'b, 'c) t = "caml_ba_sub"
@@ -130,17 +129,19 @@
     Genarray.create kind layout [|dim1; dim2|]
   external get: ('a, 'b, 'c) t -> int -> int -> 'a = "%caml_ba_ref_2"
   external set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit = "%caml_ba_set_2"
-  external unsafe_get: ('a, 'b, 'c) t -> int -> int -> 'a = "%caml_ba_unsafe_ref_2"
-  external unsafe_set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit = "%caml_ba_unsafe_set_2"
-  let dim1 a = Genarray.nth_dim a 0
-  let dim2 a = Genarray.nth_dim a 1
+  external unsafe_get: ('a, 'b, 'c) t -> int -> int -> 'a
+     = "%caml_ba_unsafe_ref_2"
+  external unsafe_set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit
+     = "%caml_ba_unsafe_set_2"
+  external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
+  external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2"
   external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
   external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
   external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
-    = "caml_ba_sub"
+     = "caml_ba_sub"
   external sub_right:
     ('a, 'b, fortran_layout) t -> int -> int -> ('a, 'b, fortran_layout) t
-    = "caml_ba_sub"
+     = "caml_ba_sub"
   let slice_left a n = Genarray.slice_left a [|n|]
   let slice_right a n = Genarray.slice_right a [|n|]
   external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
@@ -169,19 +170,21 @@
     Genarray.create kind layout [|dim1; dim2; dim3|]
   external get: ('a, 'b, 'c) t -> int -> int -> int -> 'a = "%caml_ba_ref_3"
   external set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit
-    = "%caml_ba_set_3"
-  external unsafe_get: ('a, 'b, 'c) t -> int -> int -> int -> 'a = "%caml_ba_unsafe_ref_3"
-  external unsafe_set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit = "%caml_ba_unsafe_set_3"
-  let dim1 a = Genarray.nth_dim a 0
-  let dim2 a = Genarray.nth_dim a 1
-  let dim3 a = Genarray.nth_dim a 2
+     = "%caml_ba_set_3"
+  external unsafe_get: ('a, 'b, 'c) t -> int -> int -> int -> 'a
+     = "%caml_ba_unsafe_ref_3"
+  external unsafe_set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit
+     = "%caml_ba_unsafe_set_3"
+  external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
+  external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2"
+  external dim3: ('a, 'b, 'c) t -> int = "%caml_ba_dim_3"
   external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
   external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
   external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
-    = "caml_ba_sub"
+     = "caml_ba_sub"
   external sub_right:
-    ('a, 'b, fortran_layout) t -> int -> int -> ('a, 'b, fortran_layout) t
-    = "caml_ba_sub"
+     ('a, 'b, fortran_layout) t -> int -> int -> ('a, 'b, fortran_layout) t
+     = "caml_ba_sub"
   let slice_left_1 a n m = Genarray.slice_left a [|n; m|]
   let slice_right_1 a n m = Genarray.slice_right a [|n; m|]
   let slice_left_2 a n = Genarray.slice_left a [|n|]
@@ -213,11 +216,11 @@
 end
 
 external genarray_of_array1: ('a, 'b, 'c) Array1.t -> ('a, 'b, 'c) Genarray.t
-  = "%identity"
+   = "%identity"
 external genarray_of_array2: ('a, 'b, 'c) Array2.t -> ('a, 'b, 'c) Genarray.t
-  = "%identity"
+   = "%identity"
 external genarray_of_array3: ('a, 'b, 'c) Array3.t -> ('a, 'b, 'c) Genarray.t
-  = "%identity"
+   = "%identity"
 let array1_of_genarray a =
   if Genarray.num_dims a = 1 then a
   else invalid_arg "Bigarray.array1_of_genarray"
diff -Nru ocaml-3.12.1/otherlibs/bigarray/bigarray.mli ocaml-4.01.0/otherlibs/bigarray/bigarray.mli
--- ocaml-3.12.1/otherlibs/bigarray/bigarray.mli	2008-12-03 18:09:09.000000000 +0000
+++ ocaml-4.01.0/otherlibs/bigarray/bigarray.mli	2013-05-29 18:05:44.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*         Manuel Serrano and Xavier Leroy, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,25 +11,23 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: bigarray.mli 9153 2008-12-03 18:09:09Z doligez $ *)
-
 (** Large, multi-dimensional, numerical arrays.
 
    This module implements multi-dimensional arrays of integers and
-   floating-point numbers, thereafter referred to as ``big arrays''.
+   floating-point numbers, thereafter referred to as 'big arrays'.
    The implementation allows efficient sharing of large numerical
-   arrays between Caml code and C or Fortran numerical libraries.
+   arrays between OCaml code and C or Fortran numerical libraries.
 
    Concerning the naming conventions, users of this module are encouraged
    to do [open Bigarray] in their source, then refer to array types and
    operations via short dot notation, e.g. [Array1.t] or [Array2.sub].
 
-   Big arrays support all the Caml ad-hoc polymorphic operations:
+   Big arrays support all the OCaml ad-hoc polymorphic operations:
    - comparisons ([=], [<>], [<=], etc, as well as {!Pervasives.compare});
    - hashing (module [Hash]);
-   - and structured input-output ({!Pervasives.output_value}
-     and {!Pervasives.input_value}, as well as the functions from the
-     {!Marshal} module).
+   - and structured input-output (the functions from the
+     {!Marshal} module, as well as {!Pervasives.output_value}
+     and {!Pervasives.input_value}).
 *)
 
 (** {6 Element kinds} *)
@@ -47,7 +45,7 @@
    ({!Bigarray.int8_signed_elt} or {!Bigarray.int8_unsigned_elt}),
 - 16-bit integers (signed or unsigned)
    ({!Bigarray.int16_signed_elt} or {!Bigarray.int16_unsigned_elt}),
-- Caml integers (signed, 31 bits on 32-bit architectures,
+- OCaml integers (signed, 31 bits on 32-bit architectures,
    63 bits on 64-bit architectures) ({!Bigarray.int_elt}),
 - 32-bit signed integer ({!Bigarray.int32_elt}),
 - 64-bit signed integers ({!Bigarray.int64_elt}),
@@ -72,20 +70,20 @@
 type nativeint_elt
 
 type ('a, 'b) kind
-(** To each element kind is associated a Caml type, which is
-   the type of Caml values that can be stored in the big array
+(** To each element kind is associated an OCaml type, which is
+   the type of OCaml values that can be stored in the big array
    or read back from it.  This type is not necessarily the same
    as the type of the array elements proper: for instance,
    a big array whose elements are of kind [float32_elt] contains
    32-bit single precision floats, but reading or writing one of
-   its elements from Caml uses the Caml type [float], which is
+   its elements from OCaml uses the OCaml type [float], which is
    64-bit double precision floats.
 
    The abstract type [('a, 'b) kind] captures this association
-   of a Caml type ['a] for values read or written in the big array,
+   of an OCaml type ['a] for values read or written in the big array,
    and of an element kind ['b] which represents the actual contents
    of the big array.  The following predefined values of type
-   [kind] list all possible associations of Caml types with
+   [kind] list all possible associations of OCaml types with
    element kinds: *)
 
 val float32 : (float, float32_elt) kind
@@ -127,12 +125,12 @@
 val char : (char, int8_unsigned_elt) kind
 (** As shown by the types of the values above,
    big arrays of kind [float32_elt] and [float64_elt] are
-   accessed using the Caml type [float].  Big arrays of complex kinds
-   [complex32_elt], [complex64_elt] are accessed with the Caml type
+   accessed using the OCaml type [float].  Big arrays of complex kinds
+   [complex32_elt], [complex64_elt] are accessed with the OCaml type
    {!Complex.t}.  Big arrays of
-   integer kinds are accessed using the smallest Caml integer
+   integer kinds are accessed using the smallest OCaml integer
    type large enough to represent the array elements:
-   [int] for 8- and 16-bit integer bigarrays, as well as Caml-integer
+   [int] for 8- and 16-bit integer bigarrays, as well as OCaml-integer
    bigarrays; [int32] for 32-bit integer bigarrays; [int64]
    for 64-bit integer bigarrays; and [nativeint] for
    platform-native integer bigarrays.  Finally, big arrays of
@@ -195,7 +193,7 @@
 
      The three type parameters to [Genarray.t] identify the array element
      kind and layout, as follows:
-     - the first parameter, ['a], is the Caml type for accessing array
+     - the first parameter, ['a], is the OCaml type for accessing array
        elements ([float], [int], [int32], [int64], [nativeint]);
      - the second parameter, ['b], is the actual kind of array elements
        ([float32_elt], [float64_elt], [int8_signed_elt], [int8_unsigned_elt],
@@ -206,7 +204,7 @@
      For instance, [(float, float32_elt, fortran_layout) Genarray.t]
      is the type of generic big arrays containing 32-bit floats
      in Fortran layout; reads and writes in this array use the
-     Caml type [float]. *)
+     OCaml type [float]. *)
 
   external create: ('a, 'b) kind -> 'c layout -> int array -> ('a, 'b, 'c) t
     = "caml_ba_create"
@@ -333,7 +331,7 @@
     = "caml_ba_slice"
   (** Extract a sub-array of lower dimension from the given big array
      by fixing one or several of the first (left-most) coordinates.
-     [Genarray.slice_left a [|i1; ... ; iM|]] returns the ``slice''
+     [Genarray.slice_left a [|i1; ... ; iM|]] returns the 'slice'
      of [a] obtained by setting the first [M] coordinates to
      [i1], ..., [iM].  If [a] has [N] dimensions, the slice has
      dimension [N - M], and the element at coordinates
@@ -351,7 +349,7 @@
     = "caml_ba_slice"
   (** Extract a sub-array of lower dimension from the given big array
      by fixing one or several of the last (right-most) coordinates.
-     [Genarray.slice_right a [|i1; ... ; iM|]] returns the ``slice''
+     [Genarray.slice_right a [|i1; ... ; iM|]] returns the 'slice'
      of [a] obtained by setting the last [M] coordinates to
      [i1], ..., [iM].  If [a] has [N] dimensions, the slice has
      dimension [N - M], and the element at coordinates
@@ -418,7 +416,13 @@
      than the big array, only the initial portion of the file is
      mapped to the big array.  If the file is smaller than the big
      array, the file is automatically grown to the size of the big array.
-     This requires write permissions on [fd]. *)
+     This requires write permissions on [fd].
+
+     Array accesses are bounds-checked, but the bounds are determined by
+     the initial call to [map_file]. Therefore, you should make sure no
+     other process modifies the mapped file while you're accessing it,
+     or a SIGBUS signal may be raised. This happens, for instance, if the
+     file is shrinked. *)
 
   end
 
@@ -434,7 +438,7 @@
 module Array1 : sig
   type ('a, 'b, 'c) t
   (** The type of one-dimensional big arrays whose elements have
-     Caml type ['a], representation kind ['b], and memory layout ['c]. *)
+     OCaml type ['a], representation kind ['b], and memory layout ['c]. *)
 
   val create: ('a, 'b) kind -> 'c layout -> int -> ('a, 'b, 'c) t
   (** [Array1.create kind layout dim] returns a new bigarray of
@@ -442,7 +446,7 @@
      determine the array element kind and the array layout
      as described for [Genarray.create]. *)
 
-  val dim: ('a, 'b, 'c) t -> int
+  external dim: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
   (** Return the size (dimension) of the given one-dimensional
      big array. *)
 
@@ -513,7 +517,7 @@
   sig
   type ('a, 'b, 'c) t
   (** The type of two-dimensional big arrays whose elements have
-     Caml type ['a], representation kind ['b], and memory layout ['c]. *)
+     OCaml type ['a], representation kind ['b], and memory layout ['c]. *)
 
   val create: ('a, 'b) kind ->  'c layout -> int -> int -> ('a, 'b, 'c) t
   (** [Array2.create kind layout dim1 dim2] returns a new bigarray of
@@ -522,10 +526,10 @@
      determine the array element kind and the array layout
      as described for {!Bigarray.Genarray.create}. *)
 
-  val dim1: ('a, 'b, 'c) t -> int
+  external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
   (** Return the first dimension of the given two-dimensional big array. *)
 
-  val dim2: ('a, 'b, 'c) t -> int
+  external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2"
   (** Return the second dimension of the given two-dimensional big array. *)
 
   external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
@@ -616,7 +620,7 @@
   sig
   type ('a, 'b, 'c) t
   (** The type of three-dimensional big arrays whose elements have
-     Caml type ['a], representation kind ['b], and memory layout ['c]. *)
+     OCaml type ['a], representation kind ['b], and memory layout ['c]. *)
 
   val create: ('a, 'b) kind -> 'c layout -> int -> int -> int -> ('a, 'b, 'c) t
   (** [Array3.create kind layout dim1 dim2 dim3] returns a new bigarray of
@@ -625,13 +629,13 @@
      [kind] and [layout] determine the array element kind and
      the array layout as described for {!Bigarray.Genarray.create}. *)
 
-  val dim1: ('a, 'b, 'c) t -> int
+  external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
   (** Return the first dimension of the given three-dimensional big array. *)
 
-  val dim2: ('a, 'b, 'c) t -> int
+  external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2"
   (** Return the second dimension of the given three-dimensional big array. *)
 
-  val dim3: ('a, 'b, 'c) t -> int
+  external dim3: ('a, 'b, 'c) t -> int = "%caml_ba_dim_3"
   (** Return the third dimension of the given three-dimensional big array. *)
 
   external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
diff -Nru ocaml-3.12.1/otherlibs/bigarray/bigarray_stubs.c ocaml-4.01.0/otherlibs/bigarray/bigarray_stubs.c
--- ocaml-3.12.1/otherlibs/bigarray/bigarray_stubs.c	2011-05-12 14:34:05.000000000 +0000
+++ ocaml-4.01.0/otherlibs/bigarray/bigarray_stubs.c	2012-12-19 16:22:30.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*         Manuel Serrano and Xavier Leroy, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: bigarray_stubs.c 11037 2011-05-12 14:34:05Z xleroy $ */
-
 #include 
 #include 
 #include 
@@ -21,6 +19,7 @@
 #include "custom.h"
 #include "fail.h"
 #include "intext.h"
+#include "hash.h"
 #include "memory.h"
 #include "mlvalues.h"
 
@@ -75,7 +74,8 @@
   caml_ba_compare,
   caml_ba_hash,
   caml_ba_serialize,
-  caml_ba_deserialize
+  caml_ba_deserialize,
+  custom_compare_ext_default
 };
 
 /* Multiplication of unsigned longs with overflow detection */
@@ -121,20 +121,20 @@
 
 /* Allocation of a big array */
 
-#define CAML_BA_MAX_MEMORY 256*1024*1024
-/* 256 Mb -- after allocating that much, it's probably worth speeding
+#define CAML_BA_MAX_MEMORY 1024*1024*1024
+/* 1 Gb -- after allocating that much, it's probably worth speeding
    up the major GC */
 
 /* [caml_ba_alloc] will allocate a new bigarray object in the heap.
    If [data] is NULL, the memory for the contents is also allocated
    (with [malloc]) by [caml_ba_alloc].
-   [data] cannot point into the Caml heap.
-   [dim] may point into an object in the Caml heap.
+   [data] cannot point into the OCaml heap.
+   [dim] may point into an object in the OCaml heap.
 */
 CAMLexport value
 caml_ba_alloc(int flags, int num_dims, void * data, intnat * dim)
 {
-  uintnat num_elts, size;
+  uintnat num_elts, asize, size;
   int overflow, i;
   value res;
   struct caml_ba_array * b;
@@ -158,10 +158,8 @@
     if (data == NULL && size != 0) caml_raise_out_of_memory();
     flags |= CAML_BA_MANAGED;
   }
-  res = caml_alloc_custom(&caml_ba_ops,
-                          sizeof(struct caml_ba_array)
-                          + (num_dims - 1) * sizeof(intnat),
-                          size, CAML_BA_MAX_MEMORY);
+  asize = SIZEOF_BA_ARRAY + num_dims * sizeof(intnat);
+  res = caml_alloc_custom(&caml_ba_ops, asize, size, CAML_BA_MAX_MEMORY);
   b = Caml_ba_array_val(res);
   b->data = data;
   b->num_dims = num_dims;
@@ -181,6 +179,7 @@
   int i;
   value res;
 
+  Assert(num_dims <= CAML_BA_MAX_NUM_DIMS);
   va_start(ap, data);
   for (i = 0; i < num_dims; i++) dim[i] = va_arg(ap, intnat);
   va_end(ap);
@@ -188,7 +187,7 @@
   return res;
 }
 
-/* Allocate a bigarray from Caml */
+/* Allocate a bigarray from OCaml */
 
 CAMLprim value caml_ba_create(value vkind, value vlayout, value vdim)
 {
@@ -347,6 +346,75 @@
   return caml_ba_get_N(vb, &Field(vind, 0), Wosize_val(vind));
 }
 
+
+CAMLprim value caml_ba_uint8_get16(value vb, value vind)
+{
+  intnat res;
+  unsigned char b1, b2;
+  intnat idx = Long_val(vind);
+  struct caml_ba_array * b = Caml_ba_array_val(vb);
+  if (idx < 0 || idx >= b->dim[0] - 1) caml_array_bound_error();
+  b1 = ((unsigned char*) b->data)[idx];
+  b2 = ((unsigned char*) b->data)[idx+1];
+#ifdef ARCH_BIG_ENDIAN
+  res = b1 << 8 | b2;
+#else
+  res = b2 << 8 | b1;
+#endif
+  return Val_int(res);
+}
+
+CAMLprim value caml_ba_uint8_get32(value vb, value vind)
+{
+  intnat res;
+  unsigned char b1, b2, b3, b4;
+  intnat idx = Long_val(vind);
+  struct caml_ba_array * b = Caml_ba_array_val(vb);
+  if (idx < 0 || idx >= b->dim[0] - 3) caml_array_bound_error();
+  b1 = ((unsigned char*) b->data)[idx];
+  b2 = ((unsigned char*) b->data)[idx+1];
+  b3 = ((unsigned char*) b->data)[idx+2];
+  b4 = ((unsigned char*) b->data)[idx+3];
+#ifdef ARCH_BIG_ENDIAN
+  res = b1 << 24 | b2 << 16 | b3 << 8 | b4;
+#else
+  res = b4 << 24 | b3 << 16 | b2 << 8 | b1;
+#endif
+  return caml_copy_int32(res);
+}
+
+#ifdef ARCH_INT64_TYPE
+#include "int64_native.h"
+#else
+#include "int64_emul.h"
+#endif
+
+CAMLprim value caml_ba_uint8_get64(value vb, value vind)
+{
+  uint32 reshi;
+  uint32 reslo;
+  unsigned char b1, b2, b3, b4, b5, b6, b7, b8;
+  intnat idx = Long_val(vind);
+  struct caml_ba_array * b = Caml_ba_array_val(vb);
+  if (idx < 0 || idx >= b->dim[0] - 7) caml_array_bound_error();
+  b1 = ((unsigned char*) b->data)[idx];
+  b2 = ((unsigned char*) b->data)[idx+1];
+  b3 = ((unsigned char*) b->data)[idx+2];
+  b4 = ((unsigned char*) b->data)[idx+3];
+  b5 = ((unsigned char*) b->data)[idx+4];
+  b6 = ((unsigned char*) b->data)[idx+5];
+  b7 = ((unsigned char*) b->data)[idx+6];
+  b8 = ((unsigned char*) b->data)[idx+7];
+#ifdef ARCH_BIG_ENDIAN
+  reshi = b1 << 24 | b2 << 16 | b3 << 8 | b4;
+  reslo = b5 << 24 | b6 << 16 | b7 << 8 | b8;
+#else
+  reshi = b8 << 24 | b7 << 16 | b6 << 8 | b5;
+  reslo = b4 << 24 | b3 << 16 | b2 << 8 | b1;
+#endif
+  return caml_copy_int64(I64_literal(reshi,reslo));
+}
+
 /* Generic write to a big array */
 
 static value caml_ba_set_aux(value vb, value * vind, intnat nind, value newval)
@@ -458,6 +526,92 @@
   return caml_ba_set_aux(vb, &Field(vind, 0), Wosize_val(vind), newval);
 }
 
+CAMLprim value caml_ba_uint8_set16(value vb, value vind, value newval)
+{
+  unsigned char b1, b2;
+  intnat val;
+  intnat idx = Long_val(vind);
+  struct caml_ba_array * b = Caml_ba_array_val(vb);
+  if (idx < 0 || idx >= b->dim[0] - 1) caml_array_bound_error();
+  val = Long_val(newval);
+#ifdef ARCH_BIG_ENDIAN
+  b1 = 0xFF & val >> 8;
+  b2 = 0xFF & val;
+#else
+  b2 = 0xFF & val >> 8;
+  b1 = 0xFF & val;
+#endif
+  ((unsigned char*) b->data)[idx] = b1;
+  ((unsigned char*) b->data)[idx+1] = b2;
+  return Val_unit;
+}
+
+CAMLprim value caml_ba_uint8_set32(value vb, value vind, value newval)
+{
+  unsigned char b1, b2, b3, b4;
+  intnat idx = Long_val(vind);
+  intnat val;
+  struct caml_ba_array * b = Caml_ba_array_val(vb);
+  if (idx < 0 || idx >= b->dim[0] - 3) caml_array_bound_error();
+  val = Int32_val(newval);
+#ifdef ARCH_BIG_ENDIAN
+  b1 = 0xFF & val >> 24;
+  b2 = 0xFF & val >> 16;
+  b3 = 0xFF & val >> 8;
+  b4 = 0xFF & val;
+#else
+  b4 = 0xFF & val >> 24;
+  b3 = 0xFF & val >> 16;
+  b2 = 0xFF & val >> 8;
+  b1 = 0xFF & val;
+#endif
+  ((unsigned char*) b->data)[idx] = b1;
+  ((unsigned char*) b->data)[idx+1] = b2;
+  ((unsigned char*) b->data)[idx+2] = b3;
+  ((unsigned char*) b->data)[idx+3] = b4;
+  return Val_unit;
+}
+
+CAMLprim value caml_ba_uint8_set64(value vb, value vind, value newval)
+{
+  unsigned char b1, b2, b3, b4, b5, b6, b7, b8;
+  uint32 lo,hi;
+  intnat idx = Long_val(vind);
+  int64 val;
+  struct caml_ba_array * b = Caml_ba_array_val(vb);
+  if (idx < 0 || idx >= b->dim[0] - 7) caml_array_bound_error();
+  val = Int64_val(newval);
+  I64_split(val,hi,lo);
+#ifdef ARCH_BIG_ENDIAN
+  b1 = 0xFF & hi >> 24;
+  b2 = 0xFF & hi >> 16;
+  b3 = 0xFF & hi >> 8;
+  b4 = 0xFF & hi;
+  b5 = 0xFF & lo >> 24;
+  b6 = 0xFF & lo >> 16;
+  b7 = 0xFF & lo >> 8;
+  b8 = 0xFF & lo;
+#else
+  b8 = 0xFF & hi >> 24;
+  b7 = 0xFF & hi >> 16;
+  b6 = 0xFF & hi >> 8;
+  b5 = 0xFF & hi;
+  b4 = 0xFF & lo >> 24;
+  b3 = 0xFF & lo >> 16;
+  b2 = 0xFF & lo >> 8;
+  b1 = 0xFF & lo;
+#endif
+  ((unsigned char*) b->data)[idx] = b1;
+  ((unsigned char*) b->data)[idx+1] = b2;
+  ((unsigned char*) b->data)[idx+2] = b3;
+  ((unsigned char*) b->data)[idx+3] = b4;
+  ((unsigned char*) b->data)[idx+4] = b5;
+  ((unsigned char*) b->data)[idx+5] = b6;
+  ((unsigned char*) b->data)[idx+6] = b7;
+  ((unsigned char*) b->data)[idx+7] = b8;
+  return Val_unit;
+}
+
 /* Return the number of dimensions of a big array */
 
 CAMLprim value caml_ba_num_dims(value vb)
@@ -476,6 +630,21 @@
   return Val_long(b->dim[n]);
 }
 
+CAMLprim value caml_ba_dim_1(value vb)
+{
+  return caml_ba_dim(vb, Val_int(0));
+}
+
+CAMLprim value caml_ba_dim_2(value vb)
+{
+  return caml_ba_dim(vb, Val_int(1));
+}
+
+CAMLprim value caml_ba_dim_3(value vb)
+{
+  return caml_ba_dim(vb, Val_int(2));
+}
+
 /* Return the kind of a big array */
 
 CAMLprim value caml_ba_kind(value vb)
@@ -621,69 +790,85 @@
 static intnat caml_ba_hash(value v)
 {
   struct caml_ba_array * b = Caml_ba_array_val(v);
-  intnat num_elts, n, h;
+  intnat num_elts, n;
+  uint32 h, w;
   int i;
 
   num_elts = 1;
   for (i = 0; i < b->num_dims; i++) num_elts = num_elts * b->dim[i];
-  if (num_elts >= 50) num_elts = 50;
   h = 0;
 
-#define COMBINE(h,v) ((h << 4) + h + (v))
-
   switch (b->flags & CAML_BA_KIND_MASK) {
   case CAML_BA_SINT8:
   case CAML_BA_UINT8: {
     uint8 * p = b->data;
-    for (n = 0; n < num_elts; n++) h = COMBINE(h, *p++);
+    if (num_elts > 256) num_elts = 256;
+    for (n = 0; n + 4 <= num_elts; n += 4, p += 4) {
+      w = p[0] | (p[1] << 8) | (p[2] << 16) | (p[3] << 24);
+      h = caml_hash_mix_uint32(h, w);
+    }
+    w = 0;
+    switch (num_elts & 3) {
+    case 3: w  = p[2] << 16;    /* fallthrough */
+    case 2: w |= p[1] << 8;     /* fallthrough */
+    case 1: w |= p[0];
+            h = caml_hash_mix_uint32(h, w);
+    }
     break;
   }
   case CAML_BA_SINT16:
   case CAML_BA_UINT16: {
     uint16 * p = b->data;
-    for (n = 0; n < num_elts; n++) h = COMBINE(h, *p++);
+    if (num_elts > 128) num_elts = 128;
+    for (n = 0; n + 2 <= num_elts; n += 2, p += 2) {
+      w = p[0] | (p[1] << 16);
+      h = caml_hash_mix_uint32(h, w);
+    }
+    if ((num_elts & 1) != 0)
+      h = caml_hash_mix_uint32(h, p[0]);
     break;
   }
-  case CAML_BA_FLOAT32:
-  case CAML_BA_COMPLEX32:
   case CAML_BA_INT32:
-#ifndef ARCH_SIXTYFOUR
-  case CAML_BA_CAML_INT:
-  case CAML_BA_NATIVE_INT:
-#endif
   {
     uint32 * p = b->data;
-    for (n = 0; n < num_elts; n++) h = COMBINE(h, *p++);
+    if (num_elts > 64) num_elts = 64;
+    for (n = 0; n < num_elts; n++, p++) h = caml_hash_mix_uint32(h, *p);
     break;
   }
-  case CAML_BA_FLOAT64:
-  case CAML_BA_COMPLEX64:
-  case CAML_BA_INT64:
-#ifdef ARCH_SIXTYFOUR
   case CAML_BA_CAML_INT:
   case CAML_BA_NATIVE_INT:
-#endif
-#ifdef ARCH_SIXTYFOUR
   {
-    uintnat * p = b->data;
-    for (n = 0; n < num_elts; n++) h = COMBINE(h, *p++);
+    intnat * p = b->data;
+    if (num_elts > 64) num_elts = 64;
+    for (n = 0; n < num_elts; n++, p++) h = caml_hash_mix_intnat(h, *p);
     break;
   }
-#else
+  case CAML_BA_INT64:
   {
-    uint32 * p = b->data;
-    for (n = 0; n < num_elts; n++) {
-#ifdef ARCH_BIG_ENDIAN
-      h = COMBINE(h, p[1]); h = COMBINE(h, p[0]); p += 2;
-#else
-      h = COMBINE(h, p[0]); h = COMBINE(h, p[1]); p += 2;
-#endif
-    }
+    int64 * p = b->data;
+    if (num_elts > 32) num_elts = 32;
+    for (n = 0; n < num_elts; n++, p++) h = caml_hash_mix_int64(h, *p);
+    break;
+  }
+  case CAML_BA_COMPLEX32:
+    num_elts *= 2;              /* fallthrough */
+  case CAML_BA_FLOAT32:
+  {
+    float * p = b->data;
+    if (num_elts > 64) num_elts = 64;
+    for (n = 0; n < num_elts; n++, p++) h = caml_hash_mix_float(h, *p);
+    break;
+  }
+  case CAML_BA_COMPLEX64:
+    num_elts *= 2;              /* fallthrough */
+  case CAML_BA_FLOAT64:
+  {
+    double * p = b->data;
+    if (num_elts > 32) num_elts = 32;
+    for (n = 0; n < num_elts; n++, p++) h = caml_hash_mix_double(h, *p);
     break;
   }
-#endif
   }
-#undef COMBINE
   return h;
 }
 
@@ -755,9 +940,9 @@
     caml_ba_serialize_longarray(b->data, num_elts, -0x80000000, 0x7FFFFFFF);
     break;
   }
-  /* Compute required size in Caml heap.  Assumes struct caml_ba_array
+  /* Compute required size in OCaml heap.  Assumes struct caml_ba_array
      is exactly 4 + num_dims words */
-  Assert(sizeof(struct caml_ba_array) == 5 * sizeof(value));
+  Assert(SIZEOF_BA_ARRAY == 4 * sizeof(value));
   *wsize_32 = (4 + b->num_dims) * 4;
   *wsize_64 = (4 + b->num_dims) * 8;
 }
@@ -776,7 +961,7 @@
 #else
   if (sixty)
     caml_deserialize_error("input_value: cannot read bigarray "
-                      "with 64-bit Caml ints");
+                      "with 64-bit OCaml ints");
   caml_deserialize_block_4(dest, num_elts);
 #endif
 }
@@ -824,7 +1009,8 @@
   case CAML_BA_NATIVE_INT:
     caml_ba_deserialize_longarray(b->data, num_elts); break;
   }
-  return sizeof(struct caml_ba_array) + (b->num_dims - 1) * sizeof(intnat);
+  /* PR#5516: use C99's flexible array types if possible */
+  return SIZEOF_BA_ARRAY + b->num_dims * sizeof(intnat);
 }
 
 /* Create / update proxy to indicate that b2 is a sub-array of b1 */
@@ -887,7 +1073,7 @@
   sub_data =
     (char *) b->data +
     offset * caml_ba_element_size[b->flags & CAML_BA_KIND_MASK];
-  /* Allocate a Caml bigarray to hold the result */
+  /* Allocate an OCaml bigarray to hold the result */
   res = caml_ba_alloc(b->flags, b->num_dims - num_inds, sub_data, sub_dims);
   /* Create or update proxy in case of managed bigarray */
   caml_ba_update_proxy(b, Caml_ba_array_val(res));
@@ -928,7 +1114,7 @@
   sub_data =
     (char *) b->data +
     ofs * mul * caml_ba_element_size[b->flags & CAML_BA_KIND_MASK];
-  /* Allocate a Caml bigarray to hold the result */
+  /* Allocate an OCaml bigarray to hold the result */
   res = caml_ba_alloc(b->flags, b->num_dims, sub_data, b->dim);
   /* Doctor the changed dimension */
   Caml_ba_array_val(res)->dim[changed_dim] = len;
@@ -1062,7 +1248,7 @@
   num_elts = 1;
   for (i = 0; i < num_dims; i++) {
     dim[i] = Long_val(Field(vdim, i));
-    if (dim[i] < 0 || dim[i] > 0x7FFFFFFFL)
+    if (dim[i] < 0)
       caml_invalid_argument("Bigarray.reshape: negative dimension");
     num_elts *= dim[i];
   }
diff -Nru ocaml-3.12.1/otherlibs/bigarray/mmap_unix.c ocaml-4.01.0/otherlibs/bigarray/mmap_unix.c
--- ocaml-3.12.1/otherlibs/bigarray/mmap_unix.c	2010-08-18 12:46:09.000000000 +0000
+++ ocaml-4.01.0/otherlibs/bigarray/mmap_unix.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*         Manuel Serrano and Xavier Leroy, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,7 +11,9 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: mmap_unix.c 10648 2010-08-18 12:46:09Z doligez $ */
+/* Needed (under Linux at least) to get pwrite's prototype in unistd.h.
+   Must be defined before the first system .h is included. */
+#define _XOPEN_SOURCE 500
 
 #include 
 #include 
@@ -25,12 +27,14 @@
 
 extern int caml_ba_element_size[];  /* from bigarray_stubs.c */
 
+#include 
 #ifdef HAS_UNISTD
 #include 
 #endif
 #ifdef HAS_MMAP
 #include 
 #include 
+#include 
 #endif
 
 #if defined(HAS_MMAP)
@@ -39,15 +43,61 @@
 #define MAP_FAILED ((void *) -1)
 #endif
 
+/* [caml_grow_file] function contributed by Gerd Stolpmann (PR#5543). */
+
+static int caml_grow_file(int fd, file_offset size)
+{
+  char c;
+  int p;
+
+  /* First use pwrite for growing - it is a conservative method, as it
+     can never happen that we shrink by accident
+   */
+#ifdef HAS_PWRITE
+  c = 0;
+  p = pwrite(fd, &c, 1, size - 1);
+#else
+
+  /* Emulate pwrite with lseek. This should only be necessary on ancient
+     systems nowadays
+   */
+  file_offset currpos;
+  currpos = lseek(fd, 0, SEEK_CUR);
+  if (currpos != -1) {
+    p = lseek(fd, size - 1, SEEK_SET);
+    if (p != -1) {
+      c = 0;
+      p = write(fd, &c, 1);
+      if (p != -1)
+        p = lseek(fd, currpos, SEEK_SET);
+    }
+  }
+  else p=-1;
+#endif
+#ifdef HAS_TRUNCATE
+  if (p == -1 && errno == ESPIPE) {
+    /* Plan B. Check if at least ftruncate is possible. There are
+       some non-seekable descriptor types that do not support pwrite
+       but ftruncate, like shared memory. We never get into this case
+       for real files, so there is no danger of truncating persistent
+       data by accident
+     */
+    p = ftruncate(fd, size);
+  }
+#endif
+  return p;
+}
+
+
 CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
                                 value vshared, value vdim, value vstart)
 {
   int fd, flags, major_dim, shared;
   intnat num_dims, i;
   intnat dim[CAML_BA_MAX_NUM_DIMS];
-  file_offset currpos, startpos, file_size, data_size;
+  file_offset startpos, file_size, data_size;
+  struct stat st;
   uintnat array_size, page, delta;
-  char c;
   void * addr;
 
   fd = Int_val(vfd);
@@ -55,7 +105,7 @@
   startpos = File_offset_val(vstart);
   num_dims = Wosize_val(vdim);
   major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0;
-  /* Extract dimensions from Caml array */
+  /* Extract dimensions from OCaml array */
   num_dims = Wosize_val(vdim);
   if (num_dims < 1 || num_dims > CAML_BA_MAX_NUM_DIMS)
     caml_invalid_argument("Bigarray.mmap: bad number of dimensions");
@@ -65,18 +115,15 @@
     if (dim[i] < 0)
       caml_invalid_argument("Bigarray.create: negative dimension");
   }
-  /* Determine file size */
+  /* Determine file size. We avoid lseek here because it is fragile,
+     and because some mappable file types do not support it
+   */
   caml_enter_blocking_section();
-  currpos = lseek(fd, 0, SEEK_CUR);
-  if (currpos == -1) {
-    caml_leave_blocking_section();
-    caml_sys_error(NO_ARG);
-  }
-  file_size = lseek(fd, 0, SEEK_END);
-  if (file_size == -1) {
+  if (fstat(fd, &st) == -1) {
     caml_leave_blocking_section();
     caml_sys_error(NO_ARG);
   }
+  file_size = st.st_size;
   /* Determine array size in bytes (or size of array without the major
      dimension if that dimension wasn't specified) */
   array_size = caml_ba_element_size[flags & CAML_BA_KIND_MASK];
@@ -99,37 +146,33 @@
   } else {
     /* Check that file is large enough, and grow it otherwise */
     if (file_size < startpos + array_size) {
-      if (lseek(fd, startpos + array_size - 1, SEEK_SET) == -1) {
-        caml_leave_blocking_section();
-        caml_sys_error(NO_ARG);
-      }
-      c = 0;
-      if (write(fd, &c, 1) != 1) {
+      if (caml_grow_file(fd, startpos + array_size) == -1) { /* PR#5543 */
         caml_leave_blocking_section();
         caml_sys_error(NO_ARG);
       }
     }
   }
-  /* Restore original file position */
-  lseek(fd, currpos, SEEK_SET);
   /* Determine offset so that the mapping starts at the given file pos */
   page = getpagesize();
-  delta = (uintnat) (startpos % page);
+  delta = (uintnat) startpos % page;
   /* Do the mmap */
   shared = Bool_val(vshared) ? MAP_SHARED : MAP_PRIVATE;
-  addr = mmap(NULL, array_size + delta, PROT_READ | PROT_WRITE,
-              shared, fd, startpos - delta);
+  if (array_size > 0)
+    addr = mmap(NULL, array_size + delta, PROT_READ | PROT_WRITE,
+                shared, fd, startpos - delta);
+  else
+    addr = NULL;                /* PR#5463 - mmap fails on empty region */
   caml_leave_blocking_section();
   if (addr == (void *) MAP_FAILED) caml_sys_error(NO_ARG);
   addr = (void *) ((uintnat) addr + delta);
-  /* Build and return the Caml bigarray */
+  /* Build and return the OCaml bigarray */
   return caml_ba_alloc(flags | CAML_BA_MAPPED_FILE, num_dims, addr, dim);
 }
 
 #else
 
-value caml_ba_map_file(value vfd, value vkind, value vlayout,
-                       value vshared, value vdim, value vpos)
+CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
+                                value vshared, value vdim, value vpos)
 {
   caml_invalid_argument("Bigarray.map_file: not supported");
   return Val_unit;
@@ -148,6 +191,12 @@
 #if defined(HAS_MMAP)
   uintnat page = getpagesize();
   uintnat delta = (uintnat) addr % page;
-  munmap((void *)((uintnat)addr - delta), len + delta);
+  if (len == 0) return;         /* PR#5463 */
+  addr = (void *)((uintnat)addr - delta);
+  len  = len + delta;
+#if defined(_POSIX_SYNCHRONIZED_IO)
+  msync(addr, len, MS_ASYNC);   /* PR#3571 */
+#endif
+  munmap(addr, len);
 #endif
 }
diff -Nru ocaml-3.12.1/otherlibs/bigarray/mmap_win32.c ocaml-4.01.0/otherlibs/bigarray/mmap_win32.c
--- ocaml-3.12.1/otherlibs/bigarray/mmap_win32.c	2011-06-04 13:53:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/bigarray/mmap_win32.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*         Manuel Serrano and Xavier Leroy, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: mmap_win32.c 11066 2011-06-04 13:53:24Z xleroy $ */
-
 #include 
 #include 
 #include 
@@ -62,7 +60,7 @@
   startpos = Int64_val(vstart);
   num_dims = Wosize_val(vdim);
   major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0;
-  /* Extract dimensions from Caml array */
+  /* Extract dimensions from OCaml array */
   num_dims = Wosize_val(vdim);
   if (num_dims < 1 || num_dims > CAML_BA_MAX_NUM_DIMS)
     caml_invalid_argument("Bigarray.mmap: bad number of dimensions");
@@ -117,7 +115,7 @@
   addr = (void *) ((uintnat) addr + delta);
   /* Close the file mapping */
   CloseHandle(fmap);
-  /* Build and return the Caml bigarray */
+  /* Build and return the OCaml bigarray */
   return caml_ba_alloc(flags | CAML_BA_MAPPED_FILE, num_dims, addr, dim);
 }
 
diff -Nru ocaml-3.12.1/otherlibs/dbm/.cvsignore ocaml-4.01.0/otherlibs/dbm/.cvsignore
--- ocaml-3.12.1/otherlibs/dbm/.cvsignore	2010-01-20 16:26:46.000000000 +0000
+++ ocaml-4.01.0/otherlibs/dbm/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,3 +0,0 @@
-so_locations
-*.so
-*.a
diff -Nru ocaml-3.12.1/otherlibs/dbm/.depend ocaml-4.01.0/otherlibs/dbm/.depend
--- ocaml-3.12.1/otherlibs/dbm/.depend	2010-01-20 16:26:46.000000000 +0000
+++ ocaml-4.01.0/otherlibs/dbm/.depend	1970-01-01 00:00:00.000000000 +0000
@@ -1,3 +0,0 @@
-dbm.cmi:
-dbm.cmo: dbm.cmi
-dbm.cmx: dbm.cmi
diff -Nru ocaml-3.12.1/otherlibs/dbm/Makefile ocaml-4.01.0/otherlibs/dbm/Makefile
--- ocaml-3.12.1/otherlibs/dbm/Makefile	2009-05-20 11:52:42.000000000 +0000
+++ ocaml-4.01.0/otherlibs/dbm/Makefile	1970-01-01 00:00:00.000000000 +0000
@@ -1,32 +0,0 @@
-#########################################################################
-#                                                                       #
-#                            Objective Caml                             #
-#                                                                       #
-#            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
-#                                                                       #
-#   Copyright 1999 Institut National de Recherche en Informatique et    #
-#   en Automatique.  All rights reserved.  This file is distributed     #
-#   under the terms of the GNU Library General Public License, with     #
-#   the special exception on linking described in file ../../LICENSE.   #
-#                                                                       #
-#########################################################################
-
-# $Id: Makefile 9270 2009-05-20 11:52:42Z doligez $
-
-# Makefile for the ndbm library
-
-LIBNAME=dbm
-CLIBNAME=mldbm
-CAMLOBJS=dbm.cmo
-COBJS=cldbm.o
-EXTRACFLAGS=$(DBM_INCLUDES)
-LINKOPTS=$(DBM_LINK)
-LDOPTS=-ldopt "$(DBM_LINK)"
-
-include ../Makefile
-
-
-depend:
-	../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml > .depend
-
-include .depend
diff -Nru ocaml-3.12.1/otherlibs/dbm/cldbm.c ocaml-4.01.0/otherlibs/dbm/cldbm.c
--- ocaml-3.12.1/otherlibs/dbm/cldbm.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/dbm/cldbm.c	1970-01-01 00:00:00.000000000 +0000
@@ -1,166 +0,0 @@
-/***********************************************************************/
-/*                                                                     */
-/*                           Objective Caml                            */
-/*                                                                     */
-/*            Francois Rouaix, projet Cristal, INRIA Rocquencourt      */
-/*                                                                     */
-/*  Copyright 1996 Institut National de Recherche en Informatique et   */
-/*  en Automatique.  All rights reserved.  This file is distributed    */
-/*  under the terms of the GNU Library General Public License, with    */
-/*  the special exception on linking described in file ../../LICENSE.  */
-/*                                                                     */
-/***********************************************************************/
-
-/* $Id: cldbm.c 9547 2010-01-22 12:48:24Z doligez $ */
-
-#include 
-#include 
-#include 
-#include 
-#include 
-#include 
-#include 
-
-#ifdef DBM_USES_GDBM_NDBM
-#include 
-#else
-#include 
-#endif
-
-/* Quite close to sys_open_flags, but we need RDWR */
-static int dbm_open_flags[] = {
-  O_RDONLY, O_WRONLY, O_RDWR, O_CREAT
-};
-
-static void raise_dbm (char *errmsg) Noreturn;
-
-static void raise_dbm(char *errmsg)
-{
-  static value * dbm_exn = NULL;
-  if (dbm_exn == NULL)
-    dbm_exn = caml_named_value("dbmerror");
-  raise_with_string(*dbm_exn, errmsg);
-}
-
-#define DBM_val(v) *((DBM **) &Field(v, 0))
-
-static value alloc_dbm(DBM * db)
-{
-  value res = alloc_small(1, Abstract_tag);
-  DBM_val(res) = db;
-  return res;
-}
-
-static DBM * extract_dbm(value vdb)
-{
-  if (DBM_val(vdb) == NULL) raise_dbm("DBM has been closed");
-  return DBM_val(vdb);
-}
-
-/* Dbm.open : string -> Sys.open_flag list -> int -> t */
-value caml_dbm_open(value vfile, value vflags, value vmode) /* ML */
-{
-  char *file = String_val(vfile);
-  int flags = convert_flag_list(vflags, dbm_open_flags);
-  int mode = Int_val(vmode);
-  DBM *db = dbm_open(file,flags,mode);
-
-  if (db == NULL)
-    raise_dbm("Can't open file");
-  else
-    return (alloc_dbm(db));
-}
-
-/* Dbm.close: t -> unit */
-value caml_dbm_close(value vdb)       /* ML */
-{
-  dbm_close(extract_dbm(vdb));
-  DBM_val(vdb) = NULL;
-  return Val_unit;
-}
-
-/* Dbm.fetch: t -> string -> string */
-value caml_dbm_fetch(value vdb, value vkey)  /* ML */
-{
-  datum key,answer;
-  key.dptr = String_val(vkey);
-  key.dsize = string_length(vkey);
-  answer = dbm_fetch(extract_dbm(vdb), key);
-  if (answer.dptr) {
-    value res = alloc_string(answer.dsize);
-    memmove (String_val (res), answer.dptr, answer.dsize);
-    return res;
-  }
-  else raise_not_found();
-}
-
-value caml_dbm_insert(value vdb, value vkey, value vcontent) /* ML */
-{
-  datum key, content;
-
-  key.dptr = String_val(vkey);
-  key.dsize = string_length(vkey);
-  content.dptr = String_val(vcontent);
-  content.dsize = string_length(vcontent);
-
-  switch(dbm_store(extract_dbm(vdb), key, content, DBM_INSERT)) {
-  case 0:
-    return Val_unit;
-  case 1:                       /* DBM_INSERT and already existing */
-    raise_dbm("Entry already exists");
-  default:
-    raise_dbm("dbm_store failed");
-  }
-}
-
-value caml_dbm_replace(value vdb, value vkey, value vcontent) /* ML */
-{
-  datum key, content;
-
-  key.dptr = String_val(vkey);
-  key.dsize = string_length(vkey);
-  content.dptr = String_val(vcontent);
-  content.dsize = string_length(vcontent);
-
-  switch(dbm_store(extract_dbm(vdb), key, content, DBM_REPLACE)) {
-  case 0:
-    return Val_unit;
-  default:
-    raise_dbm("dbm_store failed");
-  }
-}
-
-value caml_dbm_delete(value vdb, value vkey)         /* ML */
-{
-  datum key;
-  key.dptr = String_val(vkey);
-  key.dsize = string_length(vkey);
-
-  if (dbm_delete(extract_dbm(vdb), key) < 0)
-    raise_dbm("dbm_delete");
-  else return Val_unit;
-}
-
-value caml_dbm_firstkey(value vdb)            /* ML */
-{
-  datum key = dbm_firstkey(extract_dbm(vdb));
-
-  if (key.dptr) {
-    value res = alloc_string(key.dsize);
-    memmove (String_val (res), key.dptr, key.dsize);
-    return res;
-  }
-  else raise_not_found();
-}
-
-value caml_dbm_nextkey(value vdb)             /* ML */
-{
-  datum key = dbm_nextkey(extract_dbm(vdb));
-
-  if (key.dptr) {
-    value res = alloc_string(key.dsize);
-    memmove (String_val (res), key.dptr, key.dsize);
-    return res;
-  }
-  else raise_not_found();
-}
diff -Nru ocaml-3.12.1/otherlibs/dbm/dbm.ml ocaml-4.01.0/otherlibs/dbm/dbm.ml
--- ocaml-3.12.1/otherlibs/dbm/dbm.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/dbm/dbm.ml	1970-01-01 00:00:00.000000000 +0000
@@ -1,58 +0,0 @@
-(***********************************************************************)
-(*                                                                     *)
-(*                           Objective Caml                            *)
-(*                                                                     *)
-(*          Francois Rouaix, projet Cristal, INRIA Rocquencourt        *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the GNU Library General Public License, with    *)
-(*  the special exception on linking described in file ../../LICENSE.  *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* $Id: dbm.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
-type t
-
-type open_flag =
-   Dbm_rdonly | Dbm_wronly | Dbm_rdwr | Dbm_create
-
-type dbm_flag =
-   DBM_INSERT
- | DBM_REPLACE
-
-exception Dbm_error of string
-
-external raw_opendbm : string -> open_flag list -> int -> t
-              = "caml_dbm_open"
-
-let opendbm file flags mode =
-  try
-    raw_opendbm file flags mode
-  with Dbm_error msg ->
-    raise(Dbm_error("Can't open file " ^ file))
-
- (* By exporting opendbm as val, we are sure to link in this
-    file (we must register the exception). Since t is abstract, programs
-    have to call it in order to do anything *)
-
-external close : t -> unit = "caml_dbm_close"
-external find : t -> string -> string = "caml_dbm_fetch"
-external add : t -> string -> string -> unit = "caml_dbm_insert"
-external replace : t -> string -> string -> unit = "caml_dbm_replace"
-external remove : t -> string -> unit = "caml_dbm_delete"
-external firstkey : t -> string = "caml_dbm_firstkey"
-external nextkey : t -> string = "caml_dbm_nextkey"
-
-let _ = Callback.register_exception "dbmerror" (Dbm_error "")
-
-(* Usual iterator *)
-let iter f t =
-  let rec walk = function
-      None -> ()
-    | Some k ->
-        f k (find t k);
-        walk (try Some(nextkey t) with Not_found -> None)
-  in
-  walk (try Some(firstkey t) with Not_found -> None)
diff -Nru ocaml-3.12.1/otherlibs/dbm/dbm.mli ocaml-4.01.0/otherlibs/dbm/dbm.mli
--- ocaml-3.12.1/otherlibs/dbm/dbm.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/dbm/dbm.mli	1970-01-01 00:00:00.000000000 +0000
@@ -1,79 +0,0 @@
-(***********************************************************************)
-(*                                                                     *)
-(*                           Objective Caml                            *)
-(*                                                                     *)
-(*          Francois Rouaix, projet Cristal, INRIA Rocquencourt        *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the GNU Library General Public License, with    *)
-(*  the special exception on linking described in file ../../LICENSE.  *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* $Id: dbm.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
-(** Interface to the NDBM database. *)
-
-type t
-(** The type of file descriptors opened on NDBM databases. *)
-
-
-type open_flag =
-    Dbm_rdonly
-  | Dbm_wronly
-  | Dbm_rdwr
-  | Dbm_create
-(** Flags for opening a database (see {!Dbm.opendbm}). *)
-
-
-exception Dbm_error of string
-(** Raised by the following functions when an error is encountered. *)
-
-val opendbm : string -> open_flag list -> int -> t
-(** Open a descriptor on an NDBM database. The first argument is
-   the name of the database (without the [.dir] and [.pag] suffixes).
-   The second argument is a list of flags: [Dbm_rdonly] opens
-   the database for reading only, [Dbm_wronly] for writing only,
-   [Dbm_rdwr] for reading and writing; [Dbm_create] causes the
-   database to be created if it does not already exist.
-   The third argument is the permissions to give to the database
-   files, if the database is created. *)
-
-external close : t -> unit = "caml_dbm_close"
-(** Close the given descriptor. *)
-
-external find : t -> string -> string = "caml_dbm_fetch"
-(** [find db key] returns the data associated with the given
-   [key] in the database opened for the descriptor [db].
-   Raise [Not_found] if the [key] has no associated data. *)
-
-external add : t -> string -> string -> unit = "caml_dbm_insert"
-(** [add db key data] inserts the pair ([key], [data]) in
-   the database [db]. If the database already contains data
-   associated with [key], raise [Dbm_error "Entry already exists"]. *)
-
-external replace : t -> string -> string -> unit = "caml_dbm_replace"
-(** [replace db key data] inserts the pair ([key], [data]) in
-   the database [db]. If the database already contains data
-   associated with [key], that data is discarded and silently
-   replaced by the new [data]. *)
-
-external remove : t -> string -> unit = "caml_dbm_delete"
-(** [remove db key data] removes the data associated with [key]
-   in [db]. If [key] has no associated data, raise
-   [Dbm_error "dbm_delete"]. *)
-
-external firstkey : t -> string = "caml_dbm_firstkey"
-(** See {!Dbm.nextkey}.*)
-
-external nextkey : t -> string = "caml_dbm_nextkey"
-(** Enumerate all keys in the given database, in an unspecified order.
-   [firstkey db] returns the first key, and repeated calls
-   to [nextkey db] return the remaining keys. [Not_found] is raised
-   when all keys have been enumerated. *)
-
-val iter : (string -> string -> 'a) -> t -> unit
-(** [iter f db] applies [f] to each ([key], [data]) pair in
-   the database [db]. [f] receives [key] as first argument
-   and [data] as second argument. *)
diff -Nru ocaml-3.12.1/otherlibs/dbm/libmldbm.clib ocaml-4.01.0/otherlibs/dbm/libmldbm.clib
--- ocaml-3.12.1/otherlibs/dbm/libmldbm.clib	2007-02-07 09:52:28.000000000 +0000
+++ ocaml-4.01.0/otherlibs/dbm/libmldbm.clib	1970-01-01 00:00:00.000000000 +0000
@@ -1 +0,0 @@
-cldbm.o
diff -Nru ocaml-3.12.1/otherlibs/dynlink/.cvsignore ocaml-4.01.0/otherlibs/dynlink/.cvsignore
--- ocaml-3.12.1/otherlibs/dynlink/.cvsignore	2010-01-20 16:26:46.000000000 +0000
+++ ocaml-4.01.0/otherlibs/dynlink/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,2 +0,0 @@
-extract_crc
-*.a
diff -Nru ocaml-3.12.1/otherlibs/dynlink/.ignore ocaml-4.01.0/otherlibs/dynlink/.ignore
--- ocaml-3.12.1/otherlibs/dynlink/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/otherlibs/dynlink/.ignore	2012-07-17 15:31:12.000000000 +0000
@@ -0,0 +1 @@
+extract_crc
diff -Nru ocaml-3.12.1/otherlibs/dynlink/Makefile ocaml-4.01.0/otherlibs/dynlink/Makefile
--- ocaml-3.12.1/otherlibs/dynlink/Makefile	2010-05-28 15:09:22.000000000 +0000
+++ ocaml-4.01.0/otherlibs/dynlink/Makefile	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,8 +11,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile 10476 2010-05-28 15:09:22Z frisch $
-
 # Makefile for the dynamic link library
 
 include ../../config/Makefile
@@ -20,7 +18,7 @@
 CAMLC=../../boot/ocamlrun ../../ocamlc
 CAMLOPT=../../ocamlcompopt.sh
 INCLUDES=-I ../../utils -I ../../typing -I ../../bytecomp -I ../../asmcomp
-COMPFLAGS=-warn-error A -I ../../stdlib $(INCLUDES)
+COMPFLAGS=-w +33..39 -warn-error A -I ../../stdlib $(INCLUDES)
 
 OBJS=dynlinkaux.cmo dynlink.cmo
 
@@ -28,12 +26,12 @@
   ../../utils/misc.cmo ../../utils/config.cmo ../../utils/clflags.cmo \
   ../../utils/tbl.cmo ../../utils/consistbl.cmo \
   ../../utils/terminfo.cmo ../../utils/warnings.cmo \
-  ../../parsing/asttypes.cmi ../../parsing/linenum.cmo \
+  ../../parsing/asttypes.cmi \
   ../../parsing/location.cmo ../../parsing/longident.cmo \
   ../../typing/ident.cmo ../../typing/path.cmo \
   ../../typing/primitive.cmo ../../typing/types.cmo \
   ../../typing/btype.cmo ../../typing/subst.cmo ../../typing/predef.cmo \
-  ../../typing/datarepr.cmo ../../typing/env.cmo \
+  ../../typing/datarepr.cmo ../../typing/cmi_format.cmo ../../typing/env.cmo \
   ../../bytecomp/lambda.cmo ../../bytecomp/instruct.cmo \
   ../../bytecomp/cmo_format.cmi ../../bytecomp/opcodes.cmo \
   ../../bytecomp/runtimedef.cmo ../../bytecomp/bytesections.cmo \
@@ -47,10 +45,12 @@
 allopt: dynlink.cmxa
 
 dynlink.cma: $(OBJS)
-	$(CAMLC) $(COMPFLAGS) -ccopt "$(NATDYNLINKOPTS)" -a -o dynlink.cma $(OBJS)
+	$(CAMLC) $(COMPFLAGS) -ccopt "$(NATDYNLINKOPTS)" -a -o dynlink.cma \
+	         $(OBJS)
 
 dynlink.cmxa: $(NATOBJS)
-	$(CAMLOPT) $(COMPFLAGS) -ccopt "$(NATDYNLINKOPTS)" -a -o dynlink.cmxa $(NATOBJS)
+	$(CAMLOPT) $(COMPFLAGS) -ccopt "$(NATDYNLINKOPTS)" -a -o dynlink.cmxa \
+	           $(NATOBJS)
 
 dynlinkaux.cmo: $(COMPILEROBJS)
 	$(CAMLC) $(COMPFLAGS) -pack -o dynlinkaux.cmo $(COMPILEROBJS)
diff -Nru ocaml-3.12.1/otherlibs/dynlink/Makefile.nt ocaml-4.01.0/otherlibs/dynlink/Makefile.nt
--- ocaml-3.12.1/otherlibs/dynlink/Makefile.nt	2007-11-06 15:16:56.000000000 +0000
+++ ocaml-4.01.0/otherlibs/dynlink/Makefile.nt	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,8 +11,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile.nt 8477 2007-11-06 15:16:56Z frisch $
-
 # Makefile for the dynamic link library
 
 include Makefile
diff -Nru ocaml-3.12.1/otherlibs/dynlink/dynlink.ml ocaml-4.01.0/otherlibs/dynlink/dynlink.ml
--- ocaml-3.12.1/otherlibs/dynlink/dynlink.ml	2010-05-28 10:16:31.000000000 +0000
+++ ocaml-4.01.0/otherlibs/dynlink/dynlink.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: dynlink.ml 10471 2010-05-28 10:16:31Z frisch $ *)
-
 (* Dynamic loading of .cmo files *)
 
 open Dynlinkaux  (* REMOVE_ME for ../../debugger/dynlink.ml *)
@@ -36,6 +34,39 @@
 
 exception Error of error
 
+let () =
+  Printexc.register_printer
+    (function
+      | Error err ->
+          let msg = match err with
+          | Not_a_bytecode_file s ->
+              Printf.sprintf "Not_a_bytecode_file %S" s
+          | Inconsistent_import s ->
+              Printf.sprintf "Inconsistent_import %S" s
+          | Unavailable_unit s ->
+              Printf.sprintf "Unavailable_unit %S" s
+          | Unsafe_file ->
+              "Unsafe_file"
+          | Linking_error (s, Undefined_global s') ->
+              Printf.sprintf "Linking_error (%S, Dynlink.Undefined_global %S)"
+                             s s'
+          | Linking_error (s, Unavailable_primitive s') ->
+              Printf.sprintf "Linking_error (%S, Dynlink.Unavailable_primitive \
+                              %S)" s s'
+          | Linking_error (s, Uninitialized_global s') ->
+              Printf.sprintf "Linking_error (%S, Dynlink.Uninitialized_global \
+                              %S)" s s'
+          | Corrupted_interface s ->
+              Printf.sprintf "Corrupted_interface %S" s
+          | File_not_found s ->
+              Printf.sprintf "File_not_found %S" s
+          | Cannot_open_dll s ->
+              Printf.sprintf "Cannot_open_dll %S" s
+          | Inconsistent_implementation s ->
+              Printf.sprintf "Inconsistent_implementation %S" s in
+          Some (Printf.sprintf "Dynlink.Error(Dynlink.%s)" msg)
+      | _ -> None)
+
 (* Management of interface CRCs *)
 
 let crc_interfaces = ref (Consistbl.create ())
@@ -121,19 +152,18 @@
       raise (Error(File_not_found shortname)) in
   let ic = open_in_bin filename in
   try
-    let buffer = String.create (String.length Config.cmi_magic_number) in
-    really_input ic buffer 0 (String.length Config.cmi_magic_number);
+    let buffer = Misc.input_bytes ic (String.length Config.cmi_magic_number) in
     if buffer <> Config.cmi_magic_number then begin
       close_in ic;
       raise(Error(Corrupted_interface filename))
     end;
-    ignore (input_value ic);
+    let cmi = Cmi_format.input_cmi ic in
+    close_in ic;
     let crc =
-      match input_value ic with
+      match cmi.Cmi_format.cmi_crcs with
         (_, crc) :: _ -> crc
       | _             -> raise(Error(Corrupted_interface filename))
     in
-    close_in ic;
     crc
   with End_of_file | Failure _ ->
     close_in ic;
@@ -159,7 +189,10 @@
 
 (* Load in-core and execute a bytecode object file *)
 
-let load_compunit ic file_name compunit =
+external register_code_fragment: string -> int -> string -> unit
+                               = "caml_register_code_fragment"
+
+let load_compunit ic file_name file_digest compunit =
   check_consistency file_name compunit;
   check_unsafe_module compunit;
   seek_in ic compunit.cu_pos;
@@ -188,6 +221,11 @@
       | _ -> assert false in
     raise(Error(Linking_error (file_name, new_error)))
   end;
+  (* PR#5215: identify this code fragment by
+     digest of file contents + unit name.
+     Unit name is needed for .cma files, which produce several code fragments.*)
+  let digest = Digest.string (file_digest ^ compunit.cu_name) in
+  register_code_fragment code code_size digest;
   begin try
     ignore((Meta.reify_bytecode code code_size) ())
   with exn ->
@@ -197,18 +235,21 @@
 
 let loadfile file_name =
   init();
-  if not (Sys.file_exists file_name) then raise(Error (File_not_found file_name));
+  if not (Sys.file_exists file_name)
+    then raise (Error (File_not_found file_name));
   let ic = open_in_bin file_name in
+  let file_digest = Digest.channel ic (-1) in
+  seek_in ic 0;
   try
-    let buffer = String.create (String.length Config.cmo_magic_number) in
-    begin
-      try really_input ic buffer 0 (String.length Config.cmo_magic_number)
-      with End_of_file -> raise(Error(Not_a_bytecode_file file_name))
-    end;
+    let buffer =
+      try Misc.input_bytes ic (String.length Config.cmo_magic_number)
+      with End_of_file -> raise (Error (Not_a_bytecode_file file_name))
+    in
     if buffer = Config.cmo_magic_number then begin
       let compunit_pos = input_binary_int ic in  (* Go to descriptor *)
       seek_in ic compunit_pos;
-      load_compunit ic file_name (input_value ic : compilation_unit)
+      let cu = (input_value ic : compilation_unit) in
+      load_compunit ic file_name file_digest cu
     end else
     if buffer = Config.cma_magic_number then begin
       let toc_pos = input_binary_int ic in  (* Go to table of contents *)
@@ -220,7 +261,7 @@
       with Failure reason ->
         raise(Error(Cannot_open_dll reason))
       end;
-      List.iter (load_compunit ic file_name) lib.lib_units
+      List.iter (load_compunit ic file_name file_digest) lib.lib_units
     end else
       raise(Error(Not_a_bytecode_file file_name));
     close_in ic
diff -Nru ocaml-3.12.1/otherlibs/dynlink/dynlink.mli ocaml-4.01.0/otherlibs/dynlink/dynlink.mli
--- ocaml-3.12.1/otherlibs/dynlink/dynlink.mli	2010-05-28 10:16:31.000000000 +0000
+++ ocaml-4.01.0/otherlibs/dynlink/dynlink.mli	2013-05-29 18:05:44.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: dynlink.mli 10471 2010-05-28 10:16:31Z frisch $ *)
-
 (** Dynamic loading of object files. *)
 
 val is_native: bool
@@ -70,7 +68,7 @@
 
 val allow_unsafe_modules : bool -> unit
 (** Govern whether unsafe object files are allowed to be
-    dynamically linked. A compilation unit is ``unsafe'' if it contains
+    dynamically linked. A compilation unit is 'unsafe' if it contains
     declarations of external functions, which can break type safety.
     By default, dynamic linking of unsafe object files is
     not allowed. In native code, this function does nothing; object files
@@ -98,7 +96,7 @@
     for each unit. This way, the [.cmi] interface files need not be
     available at run-time. The digests can be extracted from [.cmi]
     files using the [extract_crc] program installed in the
-    Objective Caml standard library directory. *)
+    OCaml standard library directory. *)
 
 val clear_available_units : unit -> unit
 (** Empty the list of compilation units accessible to dynamically-linked
diff -Nru ocaml-3.12.1/otherlibs/dynlink/dynlinkaux.mlpack ocaml-4.01.0/otherlibs/dynlink/dynlinkaux.mlpack
--- ocaml-3.12.1/otherlibs/dynlink/dynlinkaux.mlpack	2007-02-07 09:52:28.000000000 +0000
+++ ocaml-4.01.0/otherlibs/dynlink/dynlinkaux.mlpack	2012-07-17 15:31:12.000000000 +0000
@@ -1,5 +1,5 @@
 Misc Config Clflags Tbl Consistbl
-Terminfo Warnings Asttypes Linenum Location Longident
+Terminfo Warnings Asttypes Location Longident
 Ident Path Primitive Types Btype Subst Predef
-Datarepr Env Lambda Instruct Cmo_format Opcodes
+Datarepr Cmi_format Env Lambda Instruct Cmo_format Opcodes
 Runtimedef Bytesections Dll Meta Symtable
diff -Nru ocaml-3.12.1/otherlibs/dynlink/extract_crc.ml ocaml-4.01.0/otherlibs/dynlink/extract_crc.ml
--- ocaml-3.12.1/otherlibs/dynlink/extract_crc.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/dynlink/extract_crc.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: extract_crc.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* Print the digests of unit interfaces *)
 
 let load_path = ref []
diff -Nru ocaml-3.12.1/otherlibs/dynlink/natdynlink.ml ocaml-4.01.0/otherlibs/dynlink/natdynlink.ml
--- ocaml-3.12.1/otherlibs/dynlink/natdynlink.ml	2010-05-28 10:16:31.000000000 +0000
+++ ocaml-4.01.0/otherlibs/dynlink/natdynlink.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: natdynlink.ml 10471 2010-05-28 10:16:31Z frisch $ *)
-
 (* Dynamic loading of .cmx files *)
 
 type handle
diff -Nru ocaml-3.12.1/otherlibs/graph/.cvsignore ocaml-4.01.0/otherlibs/graph/.cvsignore
--- ocaml-3.12.1/otherlibs/graph/.cvsignore	2010-01-20 16:26:46.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,3 +0,0 @@
-so_locations
-*.so
-*.a
diff -Nru ocaml-3.12.1/otherlibs/graph/.depend ocaml-4.01.0/otherlibs/graph/.depend
--- ocaml-3.12.1/otherlibs/graph/.depend	2010-07-23 15:30:37.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/.depend	2013-08-15 16:13:16.000000000 +0000
@@ -98,9 +98,9 @@
   ../../byterun/config.h ../../byterun/../config/m.h \
   ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
   ../../byterun/mlvalues.h
-graphics.cmi:
-graphicsX11.cmi:
-graphics.cmo: graphics.cmi
-graphics.cmx: graphics.cmi
-graphicsX11.cmo: graphics.cmi graphicsX11.cmi
-graphicsX11.cmx: graphics.cmx graphicsX11.cmi
+graphics.cmi :
+graphicsX11.cmi :
+graphics.cmo : graphics.cmi
+graphics.cmx : graphics.cmi
+graphicsX11.cmo : graphics.cmi graphicsX11.cmi
+graphicsX11.cmx : graphics.cmx graphicsX11.cmi
diff -Nru ocaml-3.12.1/otherlibs/graph/Makefile ocaml-4.01.0/otherlibs/graph/Makefile
--- ocaml-3.12.1/otherlibs/graph/Makefile	2007-11-08 09:23:06.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/Makefile	2013-08-15 11:27:24.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,8 +11,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile 8490 2007-11-08 09:23:06Z frisch $
-
 # Makefile for the portable graphics library
 
 LIBNAME=graphics
@@ -28,7 +26,7 @@
 include ../Makefile
 
 depend:
-	gcc -MM $(CFLAGS) *.c | sed -e 's, /usr[^ ]*\.h,,g' > .depend
+	gcc -MM $(CFLAGS) *.c | sed -e 's, /[^ ]*\.h,,g' > .depend
 	../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend
 
 include .depend
diff -Nru ocaml-3.12.1/otherlibs/graph/color.c ocaml-4.01.0/otherlibs/graph/color.c
--- ocaml-3.12.1/otherlibs/graph/color.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/color.c	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: color.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include "libgraph.h"
 #include 
 
@@ -99,7 +97,8 @@
     fprintf(stderr, "green %d %d\n", caml_gr_green_l, caml_gr_green_r);
 #endif
     for(i=0; i<256; i++){
-      caml_gr_green_vals[i] = (((i << 8) + i) >> caml_gr_green_r) << caml_gr_green_l;
+      caml_gr_green_vals[i] =
+        (((i << 8) + i) >> caml_gr_green_r) << caml_gr_green_l;
     }
 
     caml_gr_get_shifts(caml_gr_blue_mask, &caml_gr_blue_l, &caml_gr_blue_r);
@@ -107,7 +106,8 @@
     fprintf(stderr, "blue %d %d\n", caml_gr_blue_l, caml_gr_blue_r);
 #endif
     for(i=0; i<256; i++){
-      caml_gr_blue_vals[i] = (((i << 8) + i) >> caml_gr_blue_r) << caml_gr_blue_l;
+      caml_gr_blue_vals[i] =
+        (((i << 8) + i) >> caml_gr_blue_r) << caml_gr_blue_l;
     }
 
     if( caml_gr_red_l < 0 || caml_gr_red_r < 0 ||
@@ -191,9 +191,12 @@
   int i;
 
   if (caml_gr_direct_rgb) {
-    r = (((pixel & caml_gr_red_mask) >> caml_gr_red_l) << 8) >> (16 - caml_gr_red_r);
-    g = (((pixel & caml_gr_green_mask) >> caml_gr_green_l) << 8) >> (16 - caml_gr_green_r);
-    b = (((pixel & caml_gr_blue_mask) >> caml_gr_blue_l) << 8) >> (16 - caml_gr_blue_r);
+    r = (((pixel & caml_gr_red_mask) >> caml_gr_red_l) << 8)
+        >> (16 - caml_gr_red_r);
+    g = (((pixel & caml_gr_green_mask) >> caml_gr_green_l) << 8)
+        >> (16 - caml_gr_green_r);
+    b = (((pixel & caml_gr_blue_mask) >> caml_gr_blue_l) << 8)
+        >> (16 - caml_gr_blue_r);
     return (r << 16) + (g << 8) + b;
   }
 
diff -Nru ocaml-3.12.1/otherlibs/graph/draw.c ocaml-4.01.0/otherlibs/graph/draw.c
--- ocaml-3.12.1/otherlibs/graph/draw.c	2004-05-30 14:11:41.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/draw.c	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: draw.c 6351 2004-05-30 14:11:41Z xleroy $ */
-
 #include "libgraph.h"
 #include 
 
@@ -22,9 +20,11 @@
   int y = Int_val(vy);
   caml_gr_check_open();
   if(caml_gr_remember_modeflag)
-    XDrawPoint(caml_gr_display, caml_gr_bstore.win, caml_gr_bstore.gc, x, Bcvt(y));
+    XDrawPoint(caml_gr_display, caml_gr_bstore.win, caml_gr_bstore.gc, x,
+               Bcvt(y));
   if(caml_gr_display_modeflag) {
-    XDrawPoint(caml_gr_display, caml_gr_window.win, caml_gr_window.gc, x, Wcvt(y));
+    XDrawPoint(caml_gr_display, caml_gr_window.win, caml_gr_window.gc, x,
+               Wcvt(y));
     XFlush(caml_gr_display);
   }
   return Val_unit;
@@ -84,7 +84,8 @@
   return Val_unit;
 }
 
-value caml_gr_draw_arc_nat(value vx, value vy, value vrx, value vry, value va1, value va2)
+value caml_gr_draw_arc_nat(value vx, value vy, value vrx, value vry, value va1,
+                           value va2)
 {
   int x = Int_val(vx);
   int y = Int_val(vy);
@@ -107,7 +108,8 @@
 
 value caml_gr_draw_arc(value *argv, int argc)
 {
-  return caml_gr_draw_arc_nat(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
+  return caml_gr_draw_arc_nat(argv[0], argv[1], argv[2], argv[3], argv[4],
+                              argv[5]);
 }
 
 value caml_gr_set_line_width(value vwidth)
diff -Nru ocaml-3.12.1/otherlibs/graph/dump_img.c ocaml-4.01.0/otherlibs/graph/dump_img.c
--- ocaml-3.12.1/otherlibs/graph/dump_img.c	2004-03-24 15:02:06.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/dump_img.c	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: dump_img.c 6171 2004-03-24 15:02:06Z starynke $ */
-
 #include "libgraph.h"
 #include "image.h"
 #include 
@@ -35,15 +33,18 @@
     }
 
     idata =
-      XGetImage(caml_gr_display, Data_im(image), 0, 0, width, height, (-1), ZPixmap);
+      XGetImage(caml_gr_display, Data_im(image), 0, 0, width, height, (-1),
+                ZPixmap);
     for (i = 0; i < height; i++)
       for (j = 0; j < width; j++)
-        Field(Field(m, i), j) = Val_int(caml_gr_rgb_pixel(XGetPixel(idata, j, i)));
+        Field(Field(m, i), j) =
+          Val_int(caml_gr_rgb_pixel(XGetPixel(idata, j, i)));
     XDestroyImage(idata);
 
     if (Mask_im(image) != None) {
       imask =
-        XGetImage(caml_gr_display, Mask_im(image), 0, 0, width, height, 1, ZPixmap);
+        XGetImage(caml_gr_display, Mask_im(image), 0, 0, width, height, 1,
+                  ZPixmap);
       for (i = 0; i < height; i++)
         for (j = 0; j < width; j++)
           if (XGetPixel(imask, j, i) == 0)
diff -Nru ocaml-3.12.1/otherlibs/graph/events.c ocaml-4.01.0/otherlibs/graph/events.c
--- ocaml-3.12.1/otherlibs/graph/events.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/events.c	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: events.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include "libgraph.h"
 #include 
@@ -62,8 +60,10 @@
   switch (event->type) {
 
   case Expose:
-    XCopyArea(caml_gr_display, caml_gr_bstore.win, caml_gr_window.win, caml_gr_window.gc,
-              event->xexpose.x, event->xexpose.y + caml_gr_bstore.h - caml_gr_window.h,
+    XCopyArea(caml_gr_display, caml_gr_bstore.win, caml_gr_window.win,
+              caml_gr_window.gc,
+              event->xexpose.x,
+              event->xexpose.y + caml_gr_bstore.h - caml_gr_window.h,
               event->xexpose.width, event->xexpose.height,
               event->xexpose.x, event->xexpose.y);
     XFlush(caml_gr_display);
@@ -72,7 +72,8 @@
   case ConfigureNotify:
     caml_gr_window.w = event->xconfigure.width;
     caml_gr_window.h = event->xconfigure.height;
-    if (caml_gr_window.w > caml_gr_bstore.w || caml_gr_window.h > caml_gr_bstore.h) {
+    if (caml_gr_window.w > caml_gr_bstore.w
+        || caml_gr_window.h > caml_gr_bstore.h) {
 
       /* Allocate a new backing store large enough to accomodate
          both the old backing store and the current window. */
@@ -80,7 +81,8 @@
       newbstore.w = max(caml_gr_window.w, caml_gr_bstore.w);
       newbstore.h = max(caml_gr_window.h, caml_gr_bstore.h);
       newbstore.win =
-        XCreatePixmap(caml_gr_display, caml_gr_window.win, newbstore.w, newbstore.h,
+        XCreatePixmap(caml_gr_display, caml_gr_window.win, newbstore.w,
+                      newbstore.h,
                       XDefaultDepth(caml_gr_display, caml_gr_screen));
       newbstore.gc = XCreateGC(caml_gr_display, newbstore.win, 0, NULL);
       XSetBackground(caml_gr_display, newbstore.gc, caml_gr_white);
@@ -92,8 +94,10 @@
         XSetFont(caml_gr_display, newbstore.gc, caml_gr_font->fid);
 
       /* Copy the old backing store into the new one */
-      XCopyArea(caml_gr_display, caml_gr_bstore.win, newbstore.win, newbstore.gc,
-                0, 0, caml_gr_bstore.w, caml_gr_bstore.h, 0, newbstore.h - caml_gr_bstore.h);
+      XCopyArea(caml_gr_display, caml_gr_bstore.win, newbstore.win,
+                newbstore.gc,
+                0, 0, caml_gr_bstore.w, caml_gr_bstore.h, 0,
+                newbstore.h - caml_gr_bstore.h);
 
       /* Free the old backing store */
       XFreeGC(caml_gr_display, caml_gr_bstore.gc);
@@ -155,6 +159,7 @@
   unsigned int modifiers;
   unsigned int i;
 
+  caml_process_pending_signals ();
   if (XQueryPointer(caml_gr_display, caml_gr_window.win,
                     &rootwin, &childwin,
                     &root_x, &root_y, &win_x, &win_y,
@@ -177,7 +182,8 @@
       break;
     }
   }
-  return caml_gr_wait_allocate_result(mouse_x, mouse_y, button, keypressed, key);
+  return
+    caml_gr_wait_allocate_result(mouse_x, mouse_y, button, keypressed, key);
 }
 
 static value caml_gr_wait_event_in_queue(long mask)
diff -Nru ocaml-3.12.1/otherlibs/graph/fill.c ocaml-4.01.0/otherlibs/graph/fill.c
--- ocaml-3.12.1/otherlibs/graph/fill.c	2004-05-30 14:11:41.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/fill.c	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: fill.c 6351 2004-05-30 14:11:41Z xleroy $ */
-
 #include "libgraph.h"
 #include 
 
@@ -42,7 +40,7 @@
 
   caml_gr_check_open();
   npoints = Wosize_val(array);
-  points = (XPoint *) stat_alloc(npoints * sizeof(XPoint));
+  points = (XPoint *) caml_stat_alloc(npoints * sizeof(XPoint));
   for (i = 0; i < npoints; i++) {
     points[i].x = Int_val(Field(Field(array, i), 0));
     points[i].y = Bcvt(Int_val(Field(Field(array, i), 1)));
@@ -61,7 +59,8 @@
   return Val_unit;
 }
 
-value caml_gr_fill_arc_nat(value vx, value vy, value vrx, value vry, value va1, value va2)
+value caml_gr_fill_arc_nat(value vx, value vy, value vrx, value vry, value va1,
+                           value va2)
 {
   int x = Int_val(vx);
   int y = Int_val(vy);
@@ -84,5 +83,6 @@
 
 value caml_gr_fill_arc(value *argv, int argc)
 {
-  return caml_gr_fill_arc_nat(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
+  return caml_gr_fill_arc_nat(argv[0], argv[1], argv[2], argv[3], argv[4],
+                              argv[5]);
 }
diff -Nru ocaml-3.12.1/otherlibs/graph/graphics.ml ocaml-4.01.0/otherlibs/graph/graphics.ml
--- ocaml-3.12.1/otherlibs/graph/graphics.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/graphics.ml	2013-07-02 15:14:00.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: graphics.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 exception Graphic_failure of string
 
 (* Initializations *)
@@ -214,6 +212,18 @@
 let key_pressed () =
   let e = wait_next_event [Poll] in e.keypressed
 
+let loop_at_exit events handler =
+  let events = List.filter (fun e -> e <> Poll) events in
+  at_exit (fun _ ->
+    try
+      while true do
+        let e = wait_next_event events in
+        handler e
+      done
+    with Exit -> close_graph ()
+       | e -> close_graph (); raise e
+  )
+
 (*** Sound *)
 
 external sound : int -> int -> unit = "caml_gr_sound"
diff -Nru ocaml-3.12.1/otherlibs/graph/graphics.mli ocaml-4.01.0/otherlibs/graph/graphics.mli
--- ocaml-3.12.1/otherlibs/graph/graphics.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/graphics.mli	2013-07-02 15:14:00.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: graphics.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** Machine-independent graphics primitives. *)
 
 exception Graphic_failure of string
@@ -237,7 +235,7 @@
    Externally, images are represented as matrices of colors. *)
 
 val transp : color
-(** In matrices of colors, this color represent a ``transparent''
+(** In matrices of colors, this color represent a 'transparent'
    point: when drawing the corresponding image, all pixels on the
    screen corresponding to a transparent pixel in the image will
    not be modified, while other points will be set to the color
@@ -305,6 +303,14 @@
    are queued, and dequeued one by one when the [Key_pressed]
    event is specified. *)
 
+val loop_at_exit : event list -> (status -> unit) -> unit
+(** Loop before exiting the program, the list given as argument is the
+    list of handlers and the events on which these handlers are called.
+    To exit cleanly the loop, the handler should raise Exit. Any other
+    exception will be propagated outside of the loop.
+    @since 4.01
+*)
+
 (** {6 Mouse and keyboard polling} *)
 
 val mouse_pos : unit -> int * int
@@ -335,7 +341,7 @@
 
 val auto_synchronize : bool -> unit
 (** By default, drawing takes place both on the window displayed
-   on screen, and in a memory area (the ``backing store'').
+   on screen, and in a memory area (the 'backing store').
    The backing store image is used to re-paint the on-screen
    window when necessary.
 
diff -Nru ocaml-3.12.1/otherlibs/graph/graphicsX11.ml ocaml-4.01.0/otherlibs/graph/graphicsX11.ml
--- ocaml-3.12.1/otherlibs/graph/graphicsX11.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/graphicsX11.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*    Pierre Weis and Jun Furuse, projet Cristal, INRIA Rocquencourt   *)
 (*                                                                     *)
@@ -11,9 +11,8 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: graphicsX11.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
-(* Module [GraphicsX11]: additional graphics primitives for the X Windows system *)
+(* Module [GraphicsX11]: additional graphics primitives for
+   the X Windows system *)
 
 type window_id = string
 
@@ -37,5 +36,5 @@
     close_subwindow wid;
     Hashtbl.remove subwindows wid
   end else
-    raise (Graphics.Graphic_failure ("close_subwindow: no such subwindow: " ^ wid))
+    raise (Graphics.Graphic_failure("close_subwindow: no such subwindow: "^wid))
 ;;
diff -Nru ocaml-3.12.1/otherlibs/graph/graphicsX11.mli ocaml-4.01.0/otherlibs/graph/graphicsX11.mli
--- ocaml-3.12.1/otherlibs/graph/graphicsX11.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/graphicsX11.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*    Pierre Weis and Jun Furuse, projet Cristal, INRIA Rocquencourt   *)
 (*                                                                     *)
@@ -11,19 +11,17 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: graphicsX11.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** Additional graphics primitives for the X Windows system. *)
 
 type window_id = string
 
 val window_id : unit -> window_id
-(** Return the unique identifier of the Caml graphics window.
+(** Return the unique identifier of the OCaml graphics window.
    The returned string is an unsigned 32 bits integer
    in decimal form. *)
 
 val open_subwindow : x:int -> y:int -> width:int -> height:int -> window_id
-(** Create a sub-window of the current Caml graphics window
+(** Create a sub-window of the current OCaml graphics window
    and return its identifier. *)
 
 val close_subwindow : window_id -> unit
diff -Nru ocaml-3.12.1/otherlibs/graph/image.c ocaml-4.01.0/otherlibs/graph/image.c
--- ocaml-3.12.1/otherlibs/graph/image.c	2004-03-24 15:02:06.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/image.c	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: image.c 6171 2004-03-24 15:02:06Z starynke $ */
-
 #include "libgraph.h"
 #include "image.h"
 #include 
@@ -30,7 +28,8 @@
   custom_compare_default,
   custom_hash_default,
   custom_serialize_default,
-  custom_deserialize_default
+  custom_deserialize_default,
+  custom_compare_ext_default
 };
 
 #define Max_image_mem 2000000
@@ -84,12 +83,14 @@
     }
   }
   if(caml_gr_remember_modeflag)
-    XCopyArea(caml_gr_display, Data_im(im), caml_gr_bstore.win, caml_gr_bstore.gc,
+    XCopyArea(caml_gr_display, Data_im(im), caml_gr_bstore.win,
+              caml_gr_bstore.gc,
               0, 0,
               Width_im(im), Height_im(im),
               x, by);
   if(caml_gr_display_modeflag)
-    XCopyArea(caml_gr_display, Data_im(im), caml_gr_window.win, caml_gr_window.gc,
+    XCopyArea(caml_gr_display, Data_im(im), caml_gr_window.win,
+              caml_gr_window.gc,
           0, 0,
           Width_im(im), Height_im(im),
           x, wy);
@@ -103,5 +104,3 @@
     XFlush(caml_gr_display);
   return Val_unit;
 }
-
-/* eof $Id: image.c 6171 2004-03-24 15:02:06Z starynke $ */
diff -Nru ocaml-3.12.1/otherlibs/graph/image.h ocaml-4.01.0/otherlibs/graph/image.h
--- ocaml-3.12.1/otherlibs/graph/image.h	2004-03-24 15:02:06.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/image.h	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: image.h 6171 2004-03-24 15:02:06Z starynke $ */
-
 struct grimage {
   int width, height;            /* Dimensions of the image */
   Pixmap data;                  /* Pixels */
diff -Nru ocaml-3.12.1/otherlibs/graph/libgraph.h ocaml-4.01.0/otherlibs/graph/libgraph.h
--- ocaml-3.12.1/otherlibs/graph/libgraph.h	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/libgraph.h	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: libgraph.h 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
@@ -34,8 +32,8 @@
                                      (used for CAML color -1) */
 extern Bool caml_gr_display_modeflag;     /* Display-mode flag */
 extern Bool caml_gr_remember_modeflag;    /* Remember-mode flag */
-extern int caml_gr_x, caml_gr_y;            /* Coordinates of the current point */
-extern int caml_gr_color;             /* Current *CAML* drawing color (can be -1) */
+extern int caml_gr_x, caml_gr_y;      /* Coordinates of the current point */
+extern int caml_gr_color;        /* Current *CAML* drawing color (can be -1) */
 extern XFontStruct * caml_gr_font;    /* Current font */
 extern long caml_gr_selected_events;  /* Events we are interested in */
 extern Bool caml_gr_ignore_sigio;     /* Whether to consume events on sigio */
@@ -55,7 +53,7 @@
 #define DEFAULT_SCREEN_WIDTH 600
 #define DEFAULT_SCREEN_HEIGHT 450
 #define BORDER_WIDTH 2
-#define DEFAULT_WINDOW_NAME "Caml graphics"
+#define DEFAULT_WINDOW_NAME "OCaml graphics"
 #define DEFAULT_SELECTED_EVENTS \
             (ExposureMask | KeyPressMask | StructureNotifyMask)
 #define DEFAULT_FONT "fixed"
diff -Nru ocaml-3.12.1/otherlibs/graph/make_img.c ocaml-4.01.0/otherlibs/graph/make_img.c
--- ocaml-3.12.1/otherlibs/graph/make_img.c	2004-03-24 15:02:06.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/make_img.c	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: make_img.c 6171 2004-03-24 15:02:06Z starynke $ */
-
 #include "libgraph.h"
 #include "image.h"
 #include 
@@ -38,12 +36,13 @@
 
   /* Build an XImage for the data part of the image */
   idata =
-    XCreateImage(caml_gr_display, DefaultVisual(caml_gr_display, caml_gr_screen),
+    XCreateImage(caml_gr_display,
+                 DefaultVisual(caml_gr_display, caml_gr_screen),
                  XDefaultDepth(caml_gr_display, caml_gr_screen),
                  ZPixmap, 0, NULL, width, height,
                  BitmapPad(caml_gr_display), 0);
 
-  bdata = (char *) stat_alloc(height * idata->bytes_per_line);
+  bdata = (char *) caml_stat_alloc(height * idata->bytes_per_line);
   idata->data = bdata;
   has_transp = False;
 
@@ -60,10 +59,11 @@
      build an XImage for the mask part of the image */
   if (has_transp) {
     imask =
-      XCreateImage(caml_gr_display, DefaultVisual(caml_gr_display, caml_gr_screen),
+      XCreateImage(caml_gr_display,
+                   DefaultVisual(caml_gr_display, caml_gr_screen),
                    1, ZPixmap, 0, NULL, width, height,
                    BitmapPad(caml_gr_display), 0);
-    bmask = (char *) stat_alloc(height * imask->bytes_per_line);
+    bmask = (char *) caml_stat_alloc(height * imask->bytes_per_line);
     imask->data = bmask;
 
     for (i = 0; i < height; i++) {
@@ -84,9 +84,11 @@
   XDestroyImage(idata);
   XFreeGC(caml_gr_display, gc);
   if (has_transp) {
-    Mask_im(im) = XCreatePixmap(caml_gr_display, caml_gr_window.win, width, height, 1);
+    Mask_im(im) = XCreatePixmap(caml_gr_display, caml_gr_window.win, width,
+                                height, 1);
     gc = XCreateGC(caml_gr_display, Mask_im(im), 0, NULL);
-    XPutImage(caml_gr_display, Mask_im(im), gc, imask, 0, 0, 0, 0, width, height);
+    XPutImage(caml_gr_display, Mask_im(im), gc, imask, 0, 0, 0, 0, width,
+              height);
     XDestroyImage(imask);
     XFreeGC(caml_gr_display, gc);
   }
diff -Nru ocaml-3.12.1/otherlibs/graph/open.c ocaml-4.01.0/otherlibs/graph/open.c
--- ocaml-3.12.1/otherlibs/graph/open.c	2005-08-13 20:59:37.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/open.c	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: open.c 7019 2005-08-13 20:59:37Z doligez $ */
-
 #include 
 #include 
 #include 
@@ -95,7 +93,8 @@
     hints.flags = PPosition | PSize;
     hints.win_gravity = 0;
 
-    ret = XWMGeometry(caml_gr_display, caml_gr_screen, geometry_spec, "", BORDER_WIDTH,
+    ret = XWMGeometry(caml_gr_display, caml_gr_screen, geometry_spec, "",
+                      BORDER_WIDTH,
                       &hints, &x, &y, &w, &h, &hints.win_gravity);
     if (ret & (XValue | YValue)) {
       hints.x = x; hints.y = y; hints.flags |= USPosition;
@@ -140,7 +139,8 @@
     caml_gr_bstore.w = caml_gr_window.w;
     caml_gr_bstore.h = caml_gr_window.h;
     caml_gr_bstore.win =
-      XCreatePixmap(caml_gr_display, caml_gr_window.win, caml_gr_bstore.w, caml_gr_bstore.h,
+      XCreatePixmap(caml_gr_display, caml_gr_window.win, caml_gr_bstore.w,
+                    caml_gr_bstore.h,
                     XDefaultDepth(caml_gr_display, caml_gr_screen));
     caml_gr_bstore.gc = XCreateGC(caml_gr_display, caml_gr_bstore.win, 0, NULL);
     XSetBackground(caml_gr_display, caml_gr_bstore.gc, caml_gr_background);
@@ -213,7 +213,9 @@
     setitimer(ITIMER_REAL, &it, NULL);
 #endif
     caml_gr_initialized = False;
-    if (caml_gr_font != NULL) { XFreeFont(caml_gr_display, caml_gr_font); caml_gr_font = NULL; }
+    if (caml_gr_font != NULL) {
+      XFreeFont(caml_gr_display, caml_gr_font); caml_gr_font = NULL;
+    }
     XFreeGC(caml_gr_display, caml_gr_window.gc);
     XDestroyWindow(caml_gr_display, caml_gr_window.win);
     XFreeGC(caml_gr_display, caml_gr_bstore.gc);
@@ -242,7 +244,7 @@
 value caml_gr_set_window_title(value n)
 {
   if (window_name != NULL) stat_free(window_name);
-  window_name = stat_alloc(strlen(String_val(n))+1);
+  window_name = caml_stat_alloc(strlen(String_val(n))+1);
   strcpy(window_name, String_val(n));
   if (caml_gr_initialized) {
     XStoreName(caml_gr_display, caml_gr_window.win, window_name);
@@ -313,7 +315,8 @@
 value caml_gr_synchronize(void)
 {
   caml_gr_check_open();
-  XCopyArea(caml_gr_display, caml_gr_bstore.win, caml_gr_window.win, caml_gr_window.gc,
+  XCopyArea(caml_gr_display, caml_gr_bstore.win, caml_gr_window.win,
+            caml_gr_window.gc,
             0, caml_gr_bstore.h - caml_gr_window.h,
             caml_gr_window.w, caml_gr_window.h,
             0, 0);
@@ -369,7 +372,8 @@
   if (graphic_failure_exn == NULL) {
     graphic_failure_exn = caml_named_value("Graphics.Graphic_failure");
     if (graphic_failure_exn == NULL)
-      invalid_argument("Exception Graphics.Graphic_failure not initialized, must link graphics.cma");
+      invalid_argument("Exception Graphics.Graphic_failure not initialized,"
+                       " must link graphics.cma");
   }
   sprintf(buffer, fmt, arg);
   raise_with_string(*graphic_failure_exn, buffer);
diff -Nru ocaml-3.12.1/otherlibs/graph/point_col.c ocaml-4.01.0/otherlibs/graph/point_col.c
--- ocaml-3.12.1/otherlibs/graph/point_col.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/point_col.c	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: point_col.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include "libgraph.h"
 
 value caml_gr_point_color(value vx, value vy)
@@ -23,7 +21,8 @@
   int rgb;
 
   caml_gr_check_open();
-  im = XGetImage(caml_gr_display, caml_gr_bstore.win, x, Bcvt(y), 1, 1, (-1), ZPixmap);
+  im = XGetImage(caml_gr_display, caml_gr_bstore.win, x, Bcvt(y), 1, 1, (-1),
+                 ZPixmap);
   rgb = caml_gr_rgb_pixel(XGetPixel(im, 0, 0));
   XDestroyImage(im);
   return Val_int(rgb);
diff -Nru ocaml-3.12.1/otherlibs/graph/sound.c ocaml-4.01.0/otherlibs/graph/sound.c
--- ocaml-3.12.1/otherlibs/graph/sound.c	2004-03-24 15:02:06.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/sound.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: sound.c 6171 2004-03-24 15:02:06Z starynke $ */
-
 #include "libgraph.h"
 
 value caml_gr_sound(value vfreq, value vdur)
diff -Nru ocaml-3.12.1/otherlibs/graph/subwindow.c ocaml-4.01.0/otherlibs/graph/subwindow.c
--- ocaml-3.12.1/otherlibs/graph/subwindow.c	2004-03-24 15:02:06.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/subwindow.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*              Jun Furuse, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: subwindow.c 6171 2004-03-24 15:02:06Z starynke $ */
-
 #include "libgraph.h"
 
 value caml_gr_open_subwindow(value vx, value vy, value width, value height)
diff -Nru ocaml-3.12.1/otherlibs/graph/text.c ocaml-4.01.0/otherlibs/graph/text.c
--- ocaml-3.12.1/otherlibs/graph/text.c	2004-03-24 15:02:06.000000000 +0000
+++ ocaml-4.01.0/otherlibs/graph/text.c	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: text.c 6171 2004-03-24 15:02:06Z starynke $ */
-
 #include "libgraph.h"
 #include 
 
@@ -45,10 +43,12 @@
   if (caml_gr_font == NULL) caml_gr_get_font(DEFAULT_FONT);
   if (caml_gr_remember_modeflag)
     XDrawString(caml_gr_display, caml_gr_bstore.win, caml_gr_bstore.gc,
-                caml_gr_x, Bcvt(caml_gr_y) - caml_gr_font->descent + 1, txt, len);
+                caml_gr_x, Bcvt(caml_gr_y) - caml_gr_font->descent + 1, txt,
+                len);
   if (caml_gr_display_modeflag) {
     XDrawString(caml_gr_display, caml_gr_window.win, caml_gr_window.gc,
-                caml_gr_x, Wcvt(caml_gr_y) - caml_gr_font->descent + 1, txt, len);
+                caml_gr_x, Wcvt(caml_gr_y) - caml_gr_font->descent + 1, txt,
+                len);
     XFlush(caml_gr_display);
   }
   caml_gr_x += XTextWidth(caml_gr_font, txt, len);
diff -Nru ocaml-3.12.1/otherlibs/labltk/.cvsignore ocaml-4.01.0/otherlibs/labltk/.cvsignore
--- ocaml-3.12.1/otherlibs/labltk/.cvsignore	2002-07-09 16:23:20.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,4 +0,0 @@
-labltklink
-labltkopt
-Makefile.config
-config.status
diff -Nru ocaml-3.12.1/otherlibs/labltk/.ignore ocaml-4.01.0/otherlibs/labltk/.ignore
--- ocaml-3.12.1/otherlibs/labltk/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/.ignore	2012-07-17 15:31:12.000000000 +0000
@@ -0,0 +1,4 @@
+labltklink
+labltkopt
+Makefile.config
+config.status
diff -Nru ocaml-3.12.1/otherlibs/labltk/Makefile ocaml-4.01.0/otherlibs/labltk/Makefile
--- ocaml-3.12.1/otherlibs/labltk/Makefile	2010-04-03 06:43:51.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/Makefile	2012-07-17 15:31:12.000000000 +0000
@@ -1,3 +1,19 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 1999 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 # Top Makefile for mlTk
 
 SUBDIRS=compiler support lib jpf frx examples_labltk \
diff -Nru ocaml-3.12.1/otherlibs/labltk/Makefile.nt ocaml-4.01.0/otherlibs/labltk/Makefile.nt
--- ocaml-3.12.1/otherlibs/labltk/Makefile.nt	2010-05-19 11:37:13.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/Makefile.nt	2012-07-17 15:31:12.000000000 +0000
@@ -1,3 +1,19 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2000 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 # Top Makefile for LablTk
 
 include ../../config/Makefile
diff -Nru ocaml-3.12.1/otherlibs/labltk/README ocaml-4.01.0/otherlibs/labltk/README
--- ocaml-3.12.1/otherlibs/labltk/README	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/README	2012-08-02 08:17:59.000000000 +0000
@@ -1,6 +1,6 @@
 INTRODUCTION
 ============
-mlTk is a library for interfacing Objective Caml with the scripting
+mlTk is a library for interfacing OCaml with the scripting
 language Tcl/Tk (all versions since 8.0.3, but no betas).
 
 In addition to the basic interface with Tcl/Tk, this package contains
@@ -13,11 +13,11 @@
 
 mlTk = CamlTk + LablTk
 ======================
-There existed two parallel Tcl/Tk interfaces for O'Caml, CamlTk and LablTk.
+There existed two parallel Tcl/Tk interfaces for OCaml, CamlTk and LablTk.
 
 CamlTk uses classical features only, therefore it is easy to understand for
-the beginners of ML. It makes many conservative O'Caml gurus also happy.
-LablTk, on the other hand, uses rather newer features of O'Caml, the labeled
+the beginners of ML. It makes many conservative OCaml gurus also happy.
+LablTk, on the other hand, uses rather newer features of OCaml, the labeled
 optional arguments and polymorphic variants. Its syntax has much more Tcl/Tk
 script flavor, but provides more powerful typing than CamlTk at the same time
 (i.e. less run time type checking of widgets).
@@ -31,7 +31,7 @@
 REQUIREMENTS
 ============
 You must have already installed
- * Objective Caml source, version 3.04+8 or later
+ * OCaml source, version 3.04+8 or later
 
  * Tcl/Tk 8.0.3 or later
     http://www.scriptics.com/ or various mirrors
@@ -44,9 +44,9 @@
 INSTALLATION
 ============
 
-0. Check-out the O'Caml CVS source code tree.
+0. Check-out the OCaml CVS source code tree.
 
-1. Compile O'Caml (= make world). If you want, also make opt.
+1. Compile OCaml (= make world). If you want, also make opt.
 
 2. Untar this mlTk distribution in the otherlibs directory, just like
    the labltk source tree.
@@ -55,9 +55,9 @@
 
 4. To install the library, make install (and make installopt)
 
-To compile mlTk, you need the O'Caml source tree, since mltk/camlbrowser
-requires some modules of O'Caml. If you are not interested in camlbrowser,
-you can compile mlTk without the O'Caml source tree, but you have to modify
+To compile mlTk, you need the OCaml source tree, since mltk/camlbrowser
+requires some modules of OCaml. If you are not interested in camlbrowser,
+you can compile mlTk without the OCaml source tree, but you have to modify
 support/Makefile.common.
 
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/Widgets.src ocaml-4.01.0/otherlibs/labltk/Widgets.src
--- ocaml-3.12.1/otherlibs/labltk/Widgets.src	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/Widgets.src	2012-07-17 15:31:12.000000000 +0000
@@ -1,3 +1,19 @@
+%(***********************************************************************)
+%(*                                                                     *)
+%(*                 MLTk, Tcl/Tk interface of OCaml                     *)
+%(*                                                                     *)
+%(*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
+%(*               projet Cristal, INRIA Rocquencourt                    *)
+%(*            Jacques Garrigue, Kyoto University RIMS                  *)
+%(*                                                                     *)
+%(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
+%(*  en Automatique and Kyoto University.  All rights reserved.         *)
+%(*  This file is distributed under the terms of the GNU Library        *)
+%(*  General Public License, with the special exception on linking      *)
+%(*  described in file LICENSE found in the OCaml source tree.          *)
+%(*                                                                     *)
+%(***********************************************************************)
+
 %%%%%%%%%%%%%% Standard Tk8.0.3 Widgets and functions %%%%%%%%%%%%%%
 type Widget external
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/.cvsignore ocaml-4.01.0/otherlibs/labltk/browser/.cvsignore
--- ocaml-3.12.1/otherlibs/labltk/browser/.cvsignore	2000-02-01 05:43:25.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,2 +0,0 @@
-ocamlbrowser
-dummy.mli
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/.depend ocaml-4.01.0/otherlibs/labltk/browser/.depend
--- ocaml-3.12.1/otherlibs/labltk/browser/.depend	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/.depend	2012-07-17 15:31:12.000000000 +0000
@@ -1,66 +1,265 @@
-editor.cmo: viewer.cmi typecheck.cmi shell.cmi setpath.cmi searchpos.cmi \
-    searchid.cmi mytypes.cmi lexical.cmi jg_toplevel.cmo jg_tk.cmo \
-    jg_text.cmi jg_message.cmi jg_menu.cmo jg_button.cmo jg_bind.cmi \
-    fileselect.cmi editor.cmi
-editor.cmx: viewer.cmx typecheck.cmx shell.cmx setpath.cmx searchpos.cmx \
-    searchid.cmx mytypes.cmi lexical.cmx jg_toplevel.cmx jg_tk.cmx \
-    jg_text.cmx jg_message.cmx jg_menu.cmx jg_button.cmx jg_bind.cmx \
-    fileselect.cmx editor.cmi
-fileselect.cmo: useunix.cmi setpath.cmi list2.cmo jg_toplevel.cmo jg_memo.cmi \
-    jg_entry.cmo jg_box.cmo fileselect.cmi
-fileselect.cmx: useunix.cmx setpath.cmx list2.cmx jg_toplevel.cmx jg_memo.cmx \
-    jg_entry.cmx jg_box.cmx fileselect.cmi
-jg_bind.cmo: jg_bind.cmi
-jg_bind.cmx: jg_bind.cmi
-jg_box.cmo: jg_completion.cmi jg_bind.cmi
-jg_box.cmx: jg_completion.cmx jg_bind.cmx
-jg_completion.cmo: jg_completion.cmi
-jg_completion.cmx: jg_completion.cmi
-jg_config.cmo: jg_tk.cmo jg_config.cmi
-jg_config.cmx: jg_tk.cmx jg_config.cmi
-jg_entry.cmo: jg_bind.cmi
-jg_entry.cmx: jg_bind.cmx
-jg_memo.cmo: jg_memo.cmi
-jg_memo.cmx: jg_memo.cmi
-jg_message.cmo: jg_toplevel.cmo jg_tk.cmo jg_text.cmi jg_bind.cmi \
-    jg_message.cmi
-jg_message.cmx: jg_toplevel.cmx jg_tk.cmx jg_text.cmx jg_bind.cmx \
-    jg_message.cmi
-jg_multibox.cmo: jg_completion.cmi jg_bind.cmi jg_multibox.cmi
-jg_multibox.cmx: jg_completion.cmx jg_bind.cmx jg_multibox.cmi
-jg_text.cmo: jg_toplevel.cmo jg_tk.cmo jg_button.cmo jg_bind.cmi jg_text.cmi
-jg_text.cmx: jg_toplevel.cmx jg_tk.cmx jg_button.cmx jg_bind.cmx jg_text.cmi
-lexical.cmo: jg_tk.cmo lexical.cmi
-lexical.cmx: jg_tk.cmx lexical.cmi
-main.cmo: viewer.cmi shell.cmi searchpos.cmi searchid.cmi jg_config.cmi \
+editor.cmo : ../labltk/wm.cmi ../labltk/winfo.cmi ../support/widget.cmi \
+    viewer.cmi ../../../typing/types.cmi typecheck.cmi ../labltk/toplevel.cmi \
+    ../labltk/tk.cmo ../support/timer.cmi ../support/textvariable.cmi \
+    ../labltk/text.cmi shell.cmi setpath.cmi ../labltk/selection.cmi \
+    searchpos.cmi searchid.cmi ../support/protocol.cmi \
+    ../../../parsing/parsetree.cmi ../../../parsing/parser.cmi \
+    ../labltk/pack.cmi mytypes.cmi ../labltk/menu.cmi \
+    ../../../parsing/longident.cmi ../../../parsing/location.cmi \
+    ../labltk/listbox.cmi lexical.cmi ../../../parsing/lexer.cmi \
+    ../labltk/label.cmi jg_toplevel.cmo jg_tk.cmo jg_text.cmi jg_message.cmi \
+    jg_menu.cmo jg_button.cmo jg_bind.cmi ../../../typing/ident.cmi \
+    ../labltk/frame.cmi ../labltk/focus.cmi fileselect.cmi \
+    ../../../typing/env.cmi ../labltk/entry.cmi ../labltk/clipboard.cmi \
+    ../../../utils/clflags.cmi ../labltk/checkbutton.cmi ../labltk/button.cmi \
     editor.cmi
-main.cmx: viewer.cmx shell.cmx searchpos.cmx searchid.cmx jg_config.cmx \
-    editor.cmx
-searchid.cmo: list2.cmo searchid.cmi
-searchid.cmx: list2.cmx searchid.cmi
-searchpos.cmo: searchid.cmi lexical.cmi jg_tk.cmo jg_text.cmi jg_message.cmi \
-    jg_memo.cmi jg_bind.cmi searchpos.cmi
-searchpos.cmx: searchid.cmx lexical.cmx jg_tk.cmx jg_text.cmx jg_message.cmx \
-    jg_memo.cmx jg_bind.cmx searchpos.cmi
-setpath.cmo: useunix.cmi list2.cmo jg_toplevel.cmo jg_button.cmo jg_box.cmo \
-    jg_bind.cmi setpath.cmi
-setpath.cmx: useunix.cmx list2.cmx jg_toplevel.cmx jg_button.cmx jg_box.cmx \
-    jg_bind.cmx setpath.cmi
-shell.cmo: list2.cmo lexical.cmi jg_toplevel.cmo jg_tk.cmo jg_text.cmi \
-    jg_message.cmi jg_menu.cmo jg_memo.cmi fileselect.cmi dummy.cmi shell.cmi
-shell.cmx: list2.cmx lexical.cmx jg_toplevel.cmx jg_tk.cmx jg_text.cmx \
-    jg_message.cmx jg_menu.cmx jg_memo.cmx fileselect.cmx dummy.cmi shell.cmi
-typecheck.cmo: mytypes.cmi jg_tk.cmo jg_text.cmi jg_message.cmi typecheck.cmi
-typecheck.cmx: mytypes.cmi jg_tk.cmx jg_text.cmx jg_message.cmx typecheck.cmi
-useunix.cmo: useunix.cmi
-useunix.cmx: useunix.cmi
-viewer.cmo: useunix.cmi shell.cmi setpath.cmi searchpos.cmi searchid.cmi \
-    mytypes.cmi jg_toplevel.cmo jg_tk.cmo jg_text.cmi jg_multibox.cmi \
-    jg_message.cmi jg_menu.cmo jg_entry.cmo jg_completion.cmi jg_button.cmo \
-    jg_box.cmo jg_bind.cmi help.cmo viewer.cmi
-viewer.cmx: useunix.cmx shell.cmx setpath.cmx searchpos.cmx searchid.cmx \
-    mytypes.cmi jg_toplevel.cmx jg_tk.cmx jg_text.cmx jg_multibox.cmx \
-    jg_message.cmx jg_menu.cmx jg_entry.cmx jg_completion.cmx jg_button.cmx \
-    jg_box.cmx jg_bind.cmx help.cmx viewer.cmi
-mytypes.cmi: shell.cmi
-typecheck.cmi: mytypes.cmi
+editor.cmx : ../labltk/wm.cmx ../labltk/winfo.cmx ../support/widget.cmx \
+    viewer.cmx ../../../typing/types.cmx typecheck.cmx ../labltk/toplevel.cmx \
+    ../labltk/tk.cmx ../support/timer.cmx ../support/textvariable.cmx \
+    ../labltk/text.cmx shell.cmx setpath.cmx ../labltk/selection.cmx \
+    searchpos.cmx searchid.cmx ../support/protocol.cmx \
+    ../../../parsing/parsetree.cmi ../../../parsing/parser.cmx \
+    ../labltk/pack.cmx mytypes.cmi ../labltk/menu.cmx \
+    ../../../parsing/longident.cmx ../../../parsing/location.cmx \
+    ../labltk/listbox.cmx lexical.cmx ../../../parsing/lexer.cmx \
+    ../labltk/label.cmx jg_toplevel.cmx jg_tk.cmx jg_text.cmx jg_message.cmx \
+    jg_menu.cmx jg_button.cmx jg_bind.cmx ../../../typing/ident.cmx \
+    ../labltk/frame.cmx ../labltk/focus.cmx fileselect.cmx \
+    ../../../typing/env.cmx ../labltk/entry.cmx ../labltk/clipboard.cmx \
+    ../../../utils/clflags.cmx ../labltk/checkbutton.cmx ../labltk/button.cmx \
+    editor.cmi
+fileselect.cmo : useunix.cmi ../labltk/tkwait.cmi ../labltk/tk.cmo \
+    ../support/textvariable.cmi setpath.cmi ../labltk/pack.cmi \
+    ../../../utils/misc.cmi ../labltk/listbox.cmi list2.cmo \
+    ../labltk/label.cmi jg_toplevel.cmo jg_memo.cmi jg_entry.cmo jg_box.cmo \
+    ../labltk/grab.cmi ../labltk/frame.cmi ../labltk/focus.cmi \
+    ../../../utils/config.cmi ../labltk/checkbutton.cmi ../labltk/button.cmi \
+    fileselect.cmi
+fileselect.cmx : useunix.cmx ../labltk/tkwait.cmx ../labltk/tk.cmx \
+    ../support/textvariable.cmx setpath.cmx ../labltk/pack.cmx \
+    ../../../utils/misc.cmx ../labltk/listbox.cmx list2.cmx \
+    ../labltk/label.cmx jg_toplevel.cmx jg_memo.cmx jg_entry.cmx jg_box.cmx \
+    ../labltk/grab.cmx ../labltk/frame.cmx ../labltk/focus.cmx \
+    ../../../utils/config.cmx ../labltk/checkbutton.cmx ../labltk/button.cmx \
+    fileselect.cmi
+help.cmo :
+help.cmx :
+jg_bind.cmo : ../labltk/tk.cmo ../labltk/focus.cmi ../labltk/button.cmi \
+    jg_bind.cmi
+jg_bind.cmx : ../labltk/tk.cmx ../labltk/focus.cmx ../labltk/button.cmx \
+    jg_bind.cmi
+jg_box.cmo : ../labltk/winfo.cmi ../labltk/tk.cmo ../labltk/scrollbar.cmi \
+    ../labltk/listbox.cmi jg_completion.cmi jg_bind.cmi ../labltk/frame.cmi
+jg_box.cmx : ../labltk/winfo.cmx ../labltk/tk.cmx ../labltk/scrollbar.cmx \
+    ../labltk/listbox.cmx jg_completion.cmx jg_bind.cmx ../labltk/frame.cmx
+jg_button.cmo : ../labltk/tk.cmo ../labltk/button.cmi
+jg_button.cmx : ../labltk/tk.cmx ../labltk/button.cmx
+jg_completion.cmo : ../support/timer.cmi jg_completion.cmi
+jg_completion.cmx : ../support/timer.cmx jg_completion.cmi
+jg_config.cmo : ../support/widget.cmi ../labltk/option.cmi jg_tk.cmo \
+    jg_config.cmi
+jg_config.cmx : ../support/widget.cmx ../labltk/option.cmx jg_tk.cmx \
+    jg_config.cmi
+jg_entry.cmo : ../labltk/tk.cmo jg_bind.cmi ../labltk/entry.cmi
+jg_entry.cmx : ../labltk/tk.cmx jg_bind.cmx ../labltk/entry.cmx
+jg_memo.cmo : jg_memo.cmi
+jg_memo.cmx : jg_memo.cmi
+jg_menu.cmo : ../labltk/toplevel.cmi ../labltk/tk.cmo ../labltk/menu.cmi
+jg_menu.cmx : ../labltk/toplevel.cmx ../labltk/tk.cmx ../labltk/menu.cmx
+jg_message.cmo : ../labltk/wm.cmi ../labltk/tkwait.cmi ../labltk/tk.cmo \
+    ../support/textvariable.cmi ../labltk/text.cmi ../labltk/message.cmi \
+    jg_toplevel.cmo jg_tk.cmo jg_text.cmi jg_bind.cmi ../labltk/grab.cmi \
+    ../labltk/frame.cmi ../labltk/button.cmi jg_message.cmi
+jg_message.cmx : ../labltk/wm.cmx ../labltk/tkwait.cmx ../labltk/tk.cmx \
+    ../support/textvariable.cmx ../labltk/text.cmx ../labltk/message.cmx \
+    jg_toplevel.cmx jg_tk.cmx jg_text.cmx jg_bind.cmx ../labltk/grab.cmx \
+    ../labltk/frame.cmx ../labltk/button.cmx jg_message.cmi
+jg_multibox.cmo : ../labltk/tk.cmo ../labltk/scrollbar.cmi \
+    ../labltk/listbox.cmi jg_completion.cmi jg_bind.cmi ../labltk/focus.cmi \
+    jg_multibox.cmi
+jg_multibox.cmx : ../labltk/tk.cmx ../labltk/scrollbar.cmx \
+    ../labltk/listbox.cmx jg_completion.cmx jg_bind.cmx ../labltk/focus.cmx \
+    jg_multibox.cmi
+jg_text.cmo : ../labltk/wm.cmi ../labltk/winfo.cmi ../labltk/tk.cmo \
+    ../support/textvariable.cmi ../labltk/text.cmi ../labltk/scrollbar.cmi \
+    ../labltk/radiobutton.cmi ../support/protocol.cmi ../labltk/label.cmi \
+    jg_toplevel.cmo jg_tk.cmo jg_button.cmo jg_bind.cmi ../labltk/frame.cmi \
+    ../labltk/focus.cmi ../labltk/entry.cmi ../labltk/button.cmi jg_text.cmi
+jg_text.cmx : ../labltk/wm.cmx ../labltk/winfo.cmx ../labltk/tk.cmx \
+    ../support/textvariable.cmx ../labltk/text.cmx ../labltk/scrollbar.cmx \
+    ../labltk/radiobutton.cmx ../support/protocol.cmx ../labltk/label.cmx \
+    jg_toplevel.cmx jg_tk.cmx jg_button.cmx jg_bind.cmx ../labltk/frame.cmx \
+    ../labltk/focus.cmx ../labltk/entry.cmx ../labltk/button.cmx jg_text.cmi
+jg_tk.cmo : ../labltk/tk.cmo
+jg_tk.cmx : ../labltk/tk.cmx
+jg_toplevel.cmo : ../labltk/wm.cmi ../support/widget.cmi \
+    ../labltk/toplevel.cmi ../labltk/tk.cmo
+jg_toplevel.cmx : ../labltk/wm.cmx ../support/widget.cmx \
+    ../labltk/toplevel.cmx ../labltk/tk.cmx
+lexical.cmo : ../labltk/tk.cmo ../labltk/text.cmi \
+    ../../../parsing/parser.cmi ../../../parsing/location.cmi \
+    ../../../parsing/lexer.cmi jg_tk.cmo lexical.cmi
+lexical.cmx : ../labltk/tk.cmx ../labltk/text.cmx \
+    ../../../parsing/parser.cmx ../../../parsing/location.cmx \
+    ../../../parsing/lexer.cmx jg_tk.cmx lexical.cmi
+list2.cmo :
+list2.cmx :
+main.cmo : ../../../utils/warnings.cmi viewer.cmi ../labltk/tk.cmo shell.cmi \
+    searchpos.cmi searchid.cmi ../support/protocol.cmi \
+    ../../../utils/misc.cmi ../labltk/message.cmi jg_config.cmi \
+    ../../../typing/env.cmi editor.cmi ../../../utils/config.cmi \
+    ../../../utils/clflags.cmi ../labltk/button.cmi
+main.cmx : ../../../utils/warnings.cmx viewer.cmx ../labltk/tk.cmx shell.cmx \
+    searchpos.cmx searchid.cmx ../support/protocol.cmx \
+    ../../../utils/misc.cmx ../labltk/message.cmx jg_config.cmx \
+    ../../../typing/env.cmx editor.cmx ../../../utils/config.cmx \
+    ../../../utils/clflags.cmx ../labltk/button.cmx
+searchid.cmo : ../../../typing/typetexp.cmi ../../../typing/types.cmi \
+    ../../../typing/typemod.cmi ../../../typing/typedtree.cmi \
+    ../../../parsing/syntaxerr.cmi ../../../typing/path.cmi \
+    ../../../parsing/parsetree.cmi ../../../parsing/parse.cmi \
+    ../../../parsing/longident.cmi ../../../parsing/location.cmi list2.cmo \
+    ../../../parsing/lexer.cmi ../../../typing/ident.cmi \
+    ../../../typing/env.cmi ../../../typing/ctype.cmi \
+    ../../../typing/btype.cmi ../../../parsing/asttypes.cmi searchid.cmi
+searchid.cmx : ../../../typing/typetexp.cmx ../../../typing/types.cmx \
+    ../../../typing/typemod.cmx ../../../typing/typedtree.cmx \
+    ../../../parsing/syntaxerr.cmx ../../../typing/path.cmx \
+    ../../../parsing/parsetree.cmi ../../../parsing/parse.cmx \
+    ../../../parsing/longident.cmx ../../../parsing/location.cmx list2.cmx \
+    ../../../parsing/lexer.cmx ../../../typing/ident.cmx \
+    ../../../typing/env.cmx ../../../typing/ctype.cmx \
+    ../../../typing/btype.cmx ../../../parsing/asttypes.cmi searchid.cmi
+searchpos.cmo : ../labltk/wm.cmi ../labltk/winfo.cmi ../support/widget.cmi \
+    ../../../typing/typetexp.cmi ../../../typing/types.cmi \
+    ../../../typing/typemod.cmi ../../../typing/typedtree.cmi \
+    ../../../typing/typedecl.cmi ../../../typing/typeclass.cmi \
+    ../labltk/tk.cmo ../labltk/text.cmi ../../../parsing/syntaxerr.cmi \
+    ../support/support.cmi ../../../typing/stypes.cmi searchid.cmi \
+    ../../../typing/printtyp.cmi ../../../typing/path.cmi \
+    ../../../parsing/parsetree.cmi ../../../parsing/parse.cmi \
+    ../labltk/pack.cmi ../labltk/option.cmi ../../../utils/misc.cmi \
+    ../labltk/menu.cmi ../../../parsing/longident.cmi \
+    ../../../parsing/location.cmi lexical.cmi ../../../parsing/lexer.cmi \
+    ../labltk/label.cmi jg_tk.cmo jg_text.cmi jg_message.cmi jg_memo.cmi \
+    jg_bind.cmi ../../../typing/ident.cmi ../../../typing/env.cmi \
+    ../../../typing/ctype.cmi ../../../utils/config.cmi ../labltk/button.cmi \
+    ../../../parsing/asttypes.cmi searchpos.cmi
+searchpos.cmx : ../labltk/wm.cmx ../labltk/winfo.cmx ../support/widget.cmx \
+    ../../../typing/typetexp.cmx ../../../typing/types.cmx \
+    ../../../typing/typemod.cmx ../../../typing/typedtree.cmx \
+    ../../../typing/typedecl.cmx ../../../typing/typeclass.cmx \
+    ../labltk/tk.cmx ../labltk/text.cmx ../../../parsing/syntaxerr.cmx \
+    ../support/support.cmx ../../../typing/stypes.cmx searchid.cmx \
+    ../../../typing/printtyp.cmx ../../../typing/path.cmx \
+    ../../../parsing/parsetree.cmi ../../../parsing/parse.cmx \
+    ../labltk/pack.cmx ../labltk/option.cmx ../../../utils/misc.cmx \
+    ../labltk/menu.cmx ../../../parsing/longident.cmx \
+    ../../../parsing/location.cmx lexical.cmx ../../../parsing/lexer.cmx \
+    ../labltk/label.cmx jg_tk.cmx jg_text.cmx jg_message.cmx jg_memo.cmx \
+    jg_bind.cmx ../../../typing/ident.cmx ../../../typing/env.cmx \
+    ../../../typing/ctype.cmx ../../../utils/config.cmx ../labltk/button.cmx \
+    ../../../parsing/asttypes.cmi searchpos.cmi
+setpath.cmo : useunix.cmi ../labltk/tk.cmo ../support/textvariable.cmi \
+    ../support/protocol.cmi ../labltk/listbox.cmi list2.cmo \
+    ../labltk/label.cmi jg_toplevel.cmo jg_button.cmo jg_box.cmo jg_bind.cmi \
+    ../labltk/frame.cmi ../labltk/entry.cmi ../../../utils/config.cmi \
+    ../labltk/button.cmi setpath.cmi
+setpath.cmx : useunix.cmx ../labltk/tk.cmx ../support/textvariable.cmx \
+    ../support/protocol.cmx ../labltk/listbox.cmx list2.cmx \
+    ../labltk/label.cmx jg_toplevel.cmx jg_button.cmx jg_box.cmx jg_bind.cmx \
+    ../labltk/frame.cmx ../labltk/entry.cmx ../../../utils/config.cmx \
+    ../labltk/button.cmx setpath.cmi
+shell.cmo : ../labltk/winfo.cmi ../../../utils/warnings.cmi \
+    ../labltk/toplevel.cmi ../labltk/tk.cmo ../support/timer.cmi \
+    ../labltk/text.cmi ../labltk/menu.cmi list2.cmo lexical.cmi \
+    jg_toplevel.cmo jg_tk.cmo jg_text.cmi jg_message.cmi jg_menu.cmo \
+    jg_memo.cmi fileselect.cmi ../support/fileevent.cmi dummy.cmi \
+    ../../../utils/config.cmi ../../../utils/clflags.cmi shell.cmi
+shell.cmx : ../labltk/winfo.cmx ../../../utils/warnings.cmx \
+    ../labltk/toplevel.cmx ../labltk/tk.cmx ../support/timer.cmx \
+    ../labltk/text.cmx ../labltk/menu.cmx list2.cmx lexical.cmx \
+    jg_toplevel.cmx jg_tk.cmx jg_text.cmx jg_message.cmx jg_menu.cmx \
+    jg_memo.cmx fileselect.cmx ../support/fileevent.cmx dummy.cmi \
+    ../../../utils/config.cmx ../../../utils/clflags.cmx shell.cmi
+typecheck.cmo : ../../../typing/typetexp.cmi ../../../typing/typemod.cmi \
+    ../../../typing/typedtree.cmi ../../../typing/typedecl.cmi \
+    ../../../typing/typecore.cmi ../../../typing/typeclass.cmi \
+    ../labltk/tk.cmo ../labltk/text.cmi ../../../parsing/syntaxerr.cmi \
+    ../../../typing/stypes.cmi ../../../parsing/parsetree.cmi \
+    ../../../parsing/parse.cmi mytypes.cmi ../../../utils/misc.cmi \
+    ../../../parsing/location.cmi ../../../parsing/lexer.cmi jg_tk.cmo \
+    jg_text.cmi jg_message.cmi ../../../typing/includemod.cmi \
+    ../../../typing/env.cmi ../../../typing/ctype.cmi \
+    ../../../utils/config.cmi ../../../typing/cmi_format.cmi \
+    ../../../utils/clflags.cmi ../../../utils/ccomp.cmi typecheck.cmi
+typecheck.cmx : ../../../typing/typetexp.cmx ../../../typing/typemod.cmx \
+    ../../../typing/typedtree.cmx ../../../typing/typedecl.cmx \
+    ../../../typing/typecore.cmx ../../../typing/typeclass.cmx \
+    ../labltk/tk.cmx ../labltk/text.cmx ../../../parsing/syntaxerr.cmx \
+    ../../../typing/stypes.cmx ../../../parsing/parsetree.cmi \
+    ../../../parsing/parse.cmx mytypes.cmi ../../../utils/misc.cmx \
+    ../../../parsing/location.cmx ../../../parsing/lexer.cmx jg_tk.cmx \
+    jg_text.cmx jg_message.cmx ../../../typing/includemod.cmx \
+    ../../../typing/env.cmx ../../../typing/ctype.cmx \
+    ../../../utils/config.cmx ../../../typing/cmi_format.cmx \
+    ../../../utils/clflags.cmx ../../../utils/ccomp.cmx typecheck.cmi
+useunix.cmo : useunix.cmi
+useunix.cmx : useunix.cmi
+viewer.cmo : ../labltk/wm.cmi useunix.cmi ../../../typing/types.cmi \
+    ../../../typing/typedtree.cmi ../labltk/toplevel.cmi ../labltk/tk.cmo \
+    ../support/textvariable.cmi ../labltk/text.cmi shell.cmi setpath.cmi \
+    searchpos.cmi searchid.cmi ../labltk/radiobutton.cmi \
+    ../support/protocol.cmi ../../../typing/predef.cmi \
+    ../../../typing/path.cmi ../labltk/pack.cmi mytypes.cmi \
+    ../labltk/menu.cmi ../../../parsing/longident.cmi \
+    ../../../parsing/location.cmi ../labltk/listbox.cmi ../labltk/label.cmi \
+    jg_toplevel.cmo jg_tk.cmo jg_text.cmi jg_multibox.cmi jg_message.cmi \
+    jg_menu.cmo jg_entry.cmo jg_completion.cmi jg_button.cmo jg_box.cmo \
+    jg_bind.cmi ../../../typing/ident.cmi help.cmo ../labltk/frame.cmi \
+    ../labltk/focus.cmi ../../../typing/env.cmi ../labltk/entry.cmi \
+    ../../../utils/config.cmi ../../../typing/cmi_format.cmi \
+    ../labltk/button.cmi viewer.cmi
+viewer.cmx : ../labltk/wm.cmx useunix.cmx ../../../typing/types.cmx \
+    ../../../typing/typedtree.cmx ../labltk/toplevel.cmx ../labltk/tk.cmx \
+    ../support/textvariable.cmx ../labltk/text.cmx shell.cmx setpath.cmx \
+    searchpos.cmx searchid.cmx ../labltk/radiobutton.cmx \
+    ../support/protocol.cmx ../../../typing/predef.cmx \
+    ../../../typing/path.cmx ../labltk/pack.cmx mytypes.cmi \
+    ../labltk/menu.cmx ../../../parsing/longident.cmx \
+    ../../../parsing/location.cmx ../labltk/listbox.cmx ../labltk/label.cmx \
+    jg_toplevel.cmx jg_tk.cmx jg_text.cmx jg_multibox.cmx jg_message.cmx \
+    jg_menu.cmx jg_entry.cmx jg_completion.cmx jg_button.cmx jg_box.cmx \
+    jg_bind.cmx ../../../typing/ident.cmx help.cmx ../labltk/frame.cmx \
+    ../labltk/focus.cmx ../../../typing/env.cmx ../labltk/entry.cmx \
+    ../../../utils/config.cmx ../../../typing/cmi_format.cmx \
+    ../labltk/button.cmx viewer.cmi
+dummy.cmi :
+dummyUnix.cmi :
+dummyWin.cmi :
+editor.cmi : ../support/widget.cmi
+fileselect.cmi :
+jg_bind.cmi : ../support/widget.cmi
+jg_completion.cmi :
+jg_config.cmi :
+jg_memo.cmi :
+jg_message.cmi : ../support/widget.cmi
+jg_multibox.cmi : ../support/widget.cmi ../labltk/tk.cmo
+jg_text.cmi : ../support/widget.cmi ../labltk/tk.cmo
+lexical.cmi : ../support/widget.cmi ../labltk/tk.cmo
+mytypes.cmi : ../support/widget.cmi ../../../typing/types.cmi \
+    ../../../typing/typedtree.cmi ../support/textvariable.cmi \
+    ../../../typing/stypes.cmi shell.cmi ../../../parsing/parsetree.cmi
+searchid.cmi : ../../../typing/path.cmi ../../../parsing/parsetree.cmi \
+    ../../../parsing/longident.cmi ../../../typing/env.cmi
+searchpos.cmi : ../support/widget.cmi ../../../typing/types.cmi \
+    ../../../typing/typedtree.cmi ../../../typing/stypes.cmi \
+    ../../../typing/path.cmi ../../../parsing/parsetree.cmi \
+    ../../../parsing/longident.cmi ../../../parsing/location.cmi \
+    ../../../typing/env.cmi
+setpath.cmi : ../support/widget.cmi
+shell.cmi : ../support/widget.cmi
+typecheck.cmi : ../support/widget.cmi mytypes.cmi
+useunix.cmi :
+viewer.cmi : ../support/widget.cmi ../../../parsing/longident.cmi \
+    ../../../typing/env.cmi
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/.ignore ocaml-4.01.0/otherlibs/labltk/browser/.ignore
--- ocaml-3.12.1/otherlibs/labltk/browser/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/.ignore	2012-07-17 15:31:12.000000000 +0000
@@ -0,0 +1,3 @@
+ocamlbrowser
+dummy.mli
+help.ml
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/Makefile ocaml-4.01.0/otherlibs/labltk/browser/Makefile
--- ocaml-3.12.1/otherlibs/labltk/browser/Makefile	2010-05-19 11:33:23.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/Makefile	2012-07-17 15:31:12.000000000 +0000
@@ -1,4 +1,18 @@
-# $Id: Makefile 10425 2010-05-19 11:33:23Z doligez $
+#########################################################################
+#                                                                       #
+#                         OCaml LablTk library                          #
+#                                                                       #
+#            Jacques Garrigue, Kyoto University RIMS                    #
+#                                                                       #
+#   Copyright 1999 Institut National de Recherche en Informatique et    #
+#   en Automatique and Kyoto University.  All rights reserved.          #
+#   This file is distributed under the terms of the GNU Library         #
+#   General Public License, with the special exception on linking       #
+#   described in file ../../../LICENSE.                                 #
+#                                                                       #
+#########################################################################
+
+# $Id$
 
 OTHERSLIB=-I $(OTHERS)/unix -I $(OTHERS)/str
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/Makefile.nt ocaml-4.01.0/otherlibs/labltk/browser/Makefile.nt
--- ocaml-3.12.1/otherlibs/labltk/browser/Makefile.nt	2008-12-03 18:09:09.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/Makefile.nt	2012-07-17 15:31:12.000000000 +0000
@@ -1,4 +1,18 @@
-# $Id: Makefile.nt 9153 2008-12-03 18:09:09Z doligez $
+#########################################################################
+#                                                                       #
+#                         OCaml LablTk library                          #
+#                                                                       #
+#            Jacques Garrigue, Kyoto University RIMS                    #
+#                                                                       #
+#   Copyright 2000 Institut National de Recherche en Informatique et    #
+#   en Automatique and Kyoto University.  All rights reserved.          #
+#   This file is distributed under the terms of the GNU Library         #
+#   General Public License, with the special exception on linking       #
+#   described in file ../../../LICENSE.                                 #
+#                                                                       #
+#########################################################################
+
+# $Id$
 
 OTHERSLIB=-I $(OTHERS)/win32unix -I $(OTHERS)/str -I $(OTHERS)/systhreads
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/Makefile.shared ocaml-4.01.0/otherlibs/labltk/browser/Makefile.shared
--- ocaml-3.12.1/otherlibs/labltk/browser/Makefile.shared	2010-05-19 14:52:34.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/Makefile.shared	2012-07-17 15:31:12.000000000 +0000
@@ -1,5 +1,19 @@
 include ../support/Makefile.common
 
+#########################################################################
+#                                                                       #
+#                         OCaml LablTk library                          #
+#                                                                       #
+#            Jacques Garrigue, Kyoto University RIMS                    #
+#                                                                       #
+#   Copyright 1999 Institut National de Recherche en Informatique et    #
+#   en Automatique and Kyoto University.  All rights reserved.          #
+#   This file is distributed under the terms of the GNU Library         #
+#   General Public License, with the special exception on linking       #
+#   described in file ../../../LICENSE.                                 #
+#                                                                       #
+#########################################################################
+
 LABLTKLIB=-I ../labltk -I ../lib -I ../support
 OCAMLTOPLIB=-I $(TOPDIR)/parsing -I $(TOPDIR)/utils -I $(TOPDIR)/typing
 INCLUDES=$(OTHERSLIB) $(LABLTKLIB) $(OCAMLTOPLIB)
@@ -9,7 +23,7 @@
 	help.cmo	\
 	viewer.cmo	typecheck.cmo	editor.cmo	main.cmo
 
-JG =	jg_tk.cmo	jg_config.cmo	jg_bind.cmo	 jg_completion.cmo \
+JG =	jg_tk.cmo	jg_config.cmo	jg_bind.cmo	jg_completion.cmo \
 	jg_box.cmo \
 	jg_button.cmo	jg_toplevel.cmo	jg_text.cmo	jg_message.cmo \
 	jg_menu.cmo	jg_entry.cmo	jg_multibox.cmo	jg_memo.cmo
@@ -29,10 +43,10 @@
 
 all: ocamlbrowser$(EXE)
 
-ocamlbrowser$(EXE): $(TOPDIR)/toplevel/toplevellib.cma jglib.cma $(OBJ) \
+ocamlbrowser$(EXE): $(TOPDIR)/compilerlibs/ocamlcommon.cma jglib.cma $(OBJ) \
 			../support/lib$(LIBNAME).$(A) $(XTRAOBJ)
 	$(CAMLC) -o ocamlbrowser$(EXE) $(INCLUDES) \
-		$(TOPDIR)/toplevel/toplevellib.cma \
+		$(TOPDIR)/compilerlibs/ocamlcommon.cma \
 		unix.cma str.cma $(XTRALIBS) $(LIBNAME).cma jglib.cma \
 	        $(OBJ) $(XTRAOBJ)
 
@@ -52,13 +66,13 @@
 	  cp ocamlbrowser$(EXE) $(BINDIR); fi
 
 clean:
-	rm -f *.cm? ocamlbrowser$(EXE) dummy.mli *~ *.orig *.$(O)
+	rm -f *.cm? ocamlbrowser$(EXE) dummy.mli *~ *.orig *.$(O) help.ml
 
-depend:
-	$(CAMLDEP) *.ml *.mli > .depend
+depend: help.ml
+	$(CAMLDEP) $(LABLTKLIB) $(OCAMLTOPLIB) *.ml *.mli > .depend
 
 shell.cmo: dummy.cmi
-setpath.cmo fileselect.cmo lexical.cmi searchid.cmi typecheck.cmi: $(TOPDIR)/toplevel/toplevellib.cma
+setpath.cmo fileselect.cmo lexical.cmi searchid.cmi typecheck.cmi: $(TOPDIR)/compilerlibs/ocamlcommon.cma
 mytypes.cmi searchpos.cmi searchpos.cmo typecheck.cmo: $(TOPDIR)/typing/stypes.cmi
 
 include	.depend
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/dummyUnix.mli ocaml-4.01.0/otherlibs/labltk/browser/dummyUnix.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/dummyUnix.mli	2003-12-29 22:15:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/dummyUnix.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: dummyUnix.mli 6041 2003-12-29 22:15:02Z doligez $ *)
+(* $Id$ *)
 
 module Mutex : sig
   type t
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/dummyWin.mli ocaml-4.01.0/otherlibs/labltk/browser/dummyWin.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/dummyWin.mli	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/dummyWin.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,4 +12,4 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: dummyWin.mli 4144 2001-12-07 13:41:02Z xleroy $ *)
+(* $Id$ *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/editor.ml ocaml-4.01.0/otherlibs/labltk/browser/editor.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/editor.ml	2006-01-04 16:55:50.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/editor.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: editor.ml 7307 2006-01-04 16:55:50Z doligez $ *)
+(* $Id$ *)
 
 open StdLabels
 open Tk
@@ -618,7 +618,7 @@
               (try Filename.chop_extension basename with _ -> basename) in
           let env =
             Env.add_module (Ident.create modname)
-              (Types.Tmty_signature txt.signature)
+              (Types.Mty_signature txt.signature)
               Env.initial
           in Viewer.view_defined (Longident.Lident modname) ~env ~show_all:true
       end;
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/editor.mli ocaml-4.01.0/otherlibs/labltk/browser/editor.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/editor.mli	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/editor.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: editor.mli 4144 2001-12-07 13:41:02Z xleroy $ *)
+(* $Id$ *)
 
 open Widget
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/fileselect.ml ocaml-4.01.0/otherlibs/labltk/browser/fileselect.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/fileselect.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/fileselect.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: fileselect.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 (* file selection box *)
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/fileselect.mli ocaml-4.01.0/otherlibs/labltk/browser/fileselect.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/fileselect.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/fileselect.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: fileselect.mli 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 val f :
   title:string ->
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/help.ml ocaml-4.01.0/otherlibs/labltk/browser/help.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/help.ml	2002-07-04 10:25:29.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/help.ml	1970-01-01 00:00:00.000000000 +0000
@@ -1,168 +0,0 @@
-let text = "\
-\032                         OCamlBrowser Help\n\
-\n\
-USE\n\
-\n\
-\032  OCamlBrowser is composed of three tools, the Editor, which allows\n\
-\032  one to edit/typecheck/analyse .mli and .ml files, the Viewer, to\n\
-\032  walk around compiled modules, and the Shell, to run an OCaml\n\
-\032  subshell. You may only have one instance of Editor and Viewer, but\n\
-\032  you may use several subshells.\n\
-\n\
-\032  As with the compiler, you may specify a different path for the\n\
-\032  standard library by setting OCAMLLIB. You may also extend the\n\
-\032  initial load path (only standard library by default) by using the\n\
-\032  -I command line option. The -nolabels, -rectypes and -w options are\n\
-\032  also accepted, and inherited by subshells.\n\
-\032  The -oldui options selects the old multi-window interface. The\n\
-\032  default is now more like Smalltalk's class browser.\n\
-\n\
-1) Viewer\n\
-\n\
-\032  This is the first window you get when you start OCamlBrowser.  It\n\
-\032  displays a search window, and the list of modules in the load path.\n\
-\032  At the top a row of menus.\n\
-\n\
-\032  File - Open and File - Editor give access to the editor.\n\
-\n\
-\032  File - Shell opens an OCaml shell.\n\
-\n\
-\032  View - Show all defs  displays the signature of the currently\n\
-\032  selected module.\n\
-\n\
-\032  View - Search entry  shows/hides the search entry just\n\
-\032  below the menu bar.\n\
-\n\
-\032  Modules - Path editor changes the load path.\n\
-\032       Pressing [Add to path] or Insert key adds selected directories\n\
-\032       to the load path.\n\
-\032       Pressing [Remove from path] or Delete key removes selected\n\
-\032       paths from the load path.\n\
-\n\
-\032  Modules - Reset cache rescans the load path and resets the module\n\
-\032  cache. Do it if you recompile some interface, or change the load\n\
-\032  path in a conflictual way.\n\
-\n\
-\032  Modules - Search symbol allows to search a symbol either by its\n\
-\032  name, like the bottom line of the viewer, or, more interestingly,\n\
-\032  by its type. Exact type searches for a type with exactly the same\n\
-\032  information as the pattern (variables match only variables),\n\
-\032  included type allows to give only partial information: the actual\n\
-\032  type may take more arguments and return more results, and variables\n\
-\032  in the pattern match anything. In both cases, argument and tuple\n\
-\032  order is irrelevant (*), and unlabeled arguments in the pattern\n\
-\032  match any label.\n\
-\n\
-\032  (*) To avoid combinatorial explosion of the search space, optional\n\
-\032  arguments in the actual type are ignored if (1) there are to many\n\
-\032  of them, and (2) they do not appear explicitly in the pattern.\n\
-\n\
-\032  The Search entry just below the menu bar allows one to search for\n\
-\032  an identifier in all modules, either by its name (? and * patterns\n\
-\032  allowed) or by its type (if there is an arrow in the input). When\n\
-\032  search by type is used, it is done in inclusion mode (cf. Modules -\n\
-\032  search symbol)\n\
-\n\
-\032  The Close all button is there to dismiss the windows created\n\
-\032  by the Detach button. By double-clicking on it you will quit the\n\
-\032  browser.\n\
-\n\
-\n\
-2) Module browsing\n\
-\n\
-\032  You select a module in the leftmost box by either cliking on it or\n\
-\032  pressing return when it is selected. Fast access is available in\n\
-\032  all boxes pressing the first few letter of the desired name.\n\
-\032  Double-clicking / double-return displays the whole signature for\n\
-\032  the module.\n\
-\n\
-\032  Defined identifiers inside the module are displayed in a box to the\n\
-\032  right of the previous one. If you click on one, this will either\n\
-\032  display its contents in another box (if this is a sub-module) or\n\
-\032  display the signature for this identifier below.\n\
-\n\
-\032  Signatures are clickable. Double clicking with the left mouse\n\
-\032  button on an identifier in a signature brings you to its signature,\n\
-\032  inside its module box.\n\
-\032  A single click on the right button pops up a menu displaying the\n\
-\032  type declaration for the selected identifier. Its title, when\n\
-\032  selectable, also brings you to its signature.\n\
-\n\
-\032  At the bottom, a series of buttons, depending on the context.\n\
-\032  * Detach copies the currently displayed signature in a new window,\n\
-\032    to keep it.\n\
-\032  * Impl and Intf bring you to the implementation or interface of\n\
-\032    the currently displayed signature, if it is available.\n\
-\n\
-\032  C-s opens a text search dialog for the displayed signature.\n\
-\n\
-3) File editor\n\
-\n\
-\032  You can edit files with it, but there is no auto-save nor undo at\n\
-\032  the moment. Otherwise you can use it as a browser, making\n\
-\032  occasional corrections.\n\
-\n\
-\032  The Edit menu contains commands for jump (C-g), search (C-s), and\n\
-\032  sending the current selection to a sub-shell (M-x). For this last\n\
-\032  option, you may choose the shell via a dialog.\n\
-\n\
-\032  Essential function are in the Compiler menu.\n\
-\n\
-\032  Preferences opens a dialog to set internals of the editor and\n\
-\032  type checker.\n\
-\n\
-\032  Lex (M-l) adds colors according to lexical categories.\n\
-\n\
-\032  Typecheck (M-t) verifies typing, and memorizes it to let one see an\n\
-\032  expression's type by double-clicking on it. This is also valid for\n\
-\032  interfaces. If an error occurs, the part of the interface preceding\n\
-\032  the error is computed.\n\
-\n\
-\032  After typechecking, pressing the right button pops up a menu giving\n\
-\032  the type of the pointed expression, and eventually allowing to\n\
-\032  follow some links.\n\
-\n\
-\032  Clear errors dismisses type checker error messages and warnings.\n\
-\n\
-\032  Signature shows the signature of the current file.\n\
-\n\
-4) Shell\n\
-\n\
-\032  When you create a shell, a dialog is presented to you, letting you\n\
-\032  choose which command you want to run, and the title of the shell\n\
-\032  (to choose it in the Editor).\n\
-\n\
-\032  You may change the default command by setting the OLABL environment\n\
-\032  variable.\n\
-\n\
-\032  The executed subshell is given the current load path.\n\
-\032  File: use a source file or load a bytecode file.\n\
-\032    You may also import the browser's path into the subprocess.\n\
-\032  History: M-p and M-n browse up and down.\n\
-\032  Signal: C-c interrupts and you can kill the subprocess.\n\
-\n\
-BUGS\n\
-\n\
-* When you quit the editor and some file was modified, a dialogue is\n\
-\032 displayed asking wether you want to really quit or not. But 1) if\n\
-\032 you quit directly from the viewer, there is no dialogue at all, and\n\
-\032 2) if you close from the window manager, the dialogue is displayed,\n\
-\032 but you cannot cancel the destruction... Beware.\n\
-\n\
-* When you run it through xon, the shell hangs at the first error. But\n\
-\032 its ok if you start ocamlbrowser from a remote shell...\n\
-\n\
-TODO\n\
-\n\
-* Complete cross-references.\n\
-\n\
-* Power up editor.\n\
-\n\
-* Add support for the debugger.\n\
-\n\
-* Make this a real programming environment, both for beginners an\n\
-\032 experimented users.\n\
-\n\
-\n\
-Bug reports and comments to \n\
-";;
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/help.txt ocaml-4.01.0/otherlibs/labltk/browser/help.txt
--- ocaml-3.12.1/otherlibs/labltk/browser/help.txt	2002-07-04 10:25:29.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/help.txt	2012-08-02 08:17:59.000000000 +0000
@@ -159,7 +159,7 @@
 
 * Add support for the debugger.
 
-* Make this a real programming environment, both for beginners an
+* Make this a real programming environment, both for beginners and
   experimented users.
 
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_bind.ml ocaml-4.01.0/otherlibs/labltk/browser/jg_bind.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_bind.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_bind.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_bind.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open Tk
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_bind.mli ocaml-4.01.0/otherlibs/labltk/browser/jg_bind.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_bind.mli	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_bind.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_bind.mli 4144 2001-12-07 13:41:02Z xleroy $ *)
+(* $Id$ *)
 
 open Widget
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_box.ml ocaml-4.01.0/otherlibs/labltk/browser/jg_box.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_box.ml	2010-04-08 03:58:41.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_box.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_box.ml 10250 2010-04-08 03:58:41Z garrigue $ *)
+(* $Id$ *)
 
 open Tk
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_button.ml ocaml-4.01.0/otherlibs/labltk/browser/jg_button.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_button.ml	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_button.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_button.ml 4144 2001-12-07 13:41:02Z xleroy $ *)
+(* $Id$ *)
 
 open Tk
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_completion.ml ocaml-4.01.0/otherlibs/labltk/browser/jg_completion.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_completion.ml	2010-04-08 03:58:41.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_completion.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_completion.ml 10250 2010-04-08 03:58:41Z garrigue $ *)
+(* $Id$ *)
 
 let lt_string ?(nocase=false) s1 s2 =
   if nocase then String.lowercase s1 < String.lowercase s2 else s1 < s2
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_completion.mli ocaml-4.01.0/otherlibs/labltk/browser/jg_completion.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_completion.mli	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_completion.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_completion.mli 4144 2001-12-07 13:41:02Z xleroy $ *)
+(* $Id$ *)
 
 val lt_string : ?nocase:bool -> string -> string -> bool
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_config.ml ocaml-4.01.0/otherlibs/labltk/browser/jg_config.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_config.ml	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_config.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_config.ml 4144 2001-12-07 13:41:02Z xleroy $ *)
+(* $Id$ *)
 
 open StdLabels
 open Jg_tk
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_config.mli ocaml-4.01.0/otherlibs/labltk/browser/jg_config.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_config.mli	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_config.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,6 +12,6 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_config.mli 4144 2001-12-07 13:41:02Z xleroy $ *)
+(* $Id$ *)
 
 val init: unit -> unit
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_entry.ml ocaml-4.01.0/otherlibs/labltk/browser/jg_entry.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_entry.ml	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_entry.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_entry.ml 4144 2001-12-07 13:41:02Z xleroy $ *)
+(* $Id$ *)
 
 open Tk
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_memo.ml ocaml-4.01.0/otherlibs/labltk/browser/jg_memo.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_memo.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_memo.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_memo.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 type ('a, 'b) assoc_list =
     Nil
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_memo.mli ocaml-4.01.0/otherlibs/labltk/browser/jg_memo.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_memo.mli	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_memo.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_memo.mli 4144 2001-12-07 13:41:02Z xleroy $ *)
+(* $Id$ *)
 
 val fast : f:('a -> 'b) -> 'a -> 'b
 (* "fast" memoizer: uses a List.assq like function      *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_menu.ml ocaml-4.01.0/otherlibs/labltk/browser/jg_menu.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_menu.ml	2006-01-04 16:55:50.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_menu.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_menu.ml 7307 2006-01-04 16:55:50Z doligez $ *)
+(* $Id$ *)
 
 open Tk
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_message.ml ocaml-4.01.0/otherlibs/labltk/browser/jg_message.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_message.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_message.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_message.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open StdLabels
 open Tk
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_message.mli ocaml-4.01.0/otherlibs/labltk/browser/jg_message.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_message.mli	2002-07-26 00:04:05.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_message.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_message.mli 5045 2002-07-26 00:04:05Z garrigue $ *)
+(* $Id$ *)
 
 open Widget
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_multibox.ml ocaml-4.01.0/otherlibs/labltk/browser/jg_multibox.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_multibox.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_multibox.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_multibox.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open StdLabels
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_multibox.mli ocaml-4.01.0/otherlibs/labltk/browser/jg_multibox.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_multibox.mli	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_multibox.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_multibox.mli 4144 2001-12-07 13:41:02Z xleroy $ *)
+(* $Id$ *)
 
 class c :
   cols:int -> texts:string list ->
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_text.ml ocaml-4.01.0/otherlibs/labltk/browser/jg_text.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_text.ml	2002-08-09 10:34:44.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_text.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_text.ml 5094 2002-08-09 10:34:44Z garrigue $ *)
+(* $Id$ *)
 
 open StdLabels
 open Tk
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_text.mli ocaml-4.01.0/otherlibs/labltk/browser/jg_text.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_text.mli	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_text.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_text.mli 4144 2001-12-07 13:41:02Z xleroy $ *)
+(* $Id$ *)
 
 open Widget
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_tk.ml ocaml-4.01.0/otherlibs/labltk/browser/jg_tk.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_tk.ml	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_tk.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_tk.ml 4144 2001-12-07 13:41:02Z xleroy $ *)
+(* $Id$ *)
 
 open Tk
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/jg_toplevel.ml ocaml-4.01.0/otherlibs/labltk/browser/jg_toplevel.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/jg_toplevel.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/jg_toplevel.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: jg_toplevel.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open Tk
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/lexical.ml ocaml-4.01.0/otherlibs/labltk/browser/lexical.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/lexical.ml	2009-07-20 11:51:50.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/lexical.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: lexical.ml 9319 2009-07-20 11:51:50Z doligez $ *)
+(* $Id$ *)
 
 open StdLabels
 open Tk
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/lexical.mli ocaml-4.01.0/otherlibs/labltk/browser/lexical.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/lexical.mli	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/lexical.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: lexical.mli 4144 2001-12-07 13:41:02Z xleroy $ *)
+(* $Id$ *)
 
 open Widget
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/list2.ml ocaml-4.01.0/otherlibs/labltk/browser/list2.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/list2.ml	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/list2.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: list2.ml 4144 2001-12-07 13:41:02Z xleroy $ *)
+(* $Id$ *)
 
 open StdLabels
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/main.ml ocaml-4.01.0/otherlibs/labltk/browser/main.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/main.ml	2010-05-20 14:06:29.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/main.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: main.ml 10444 2010-05-20 14:06:29Z doligez $ *)
+(* $Id$ *)
 
 open StdLabels
 module Unix = UnixLabels
@@ -49,7 +49,7 @@
 open Printf
 
 let print_version () =
-  printf "The Objective Caml browser, version %s\n" Sys.ocaml_version;
+  printf "The OCaml browser, version %s\n" Sys.ocaml_version;
   exit 0;
 ;;
 
@@ -106,7 +106,7 @@
         (Printf.sprintf "%s\nPlease check that %s %s\nCurrent value is `%s'"
            "Couldn't initialize environment."
            (if is_win32 then "%OCAMLLIB%" else "$OCAMLLIB")
-           "points to the Objective Caml library."
+           "points to the OCaml library."
            Config.standard_library)
   end;
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/mytypes.mli ocaml-4.01.0/otherlibs/labltk/browser/mytypes.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/mytypes.mli	2007-05-16 08:21:41.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/mytypes.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: mytypes.mli 8232 2007-05-16 08:21:41Z doligez $ *)
+(* $Id$ *)
 
 open Widget
 
@@ -22,7 +22,7 @@
     frame: frame widget;
     modified: Textvariable.textVariable;
     mutable shell: (string * Shell.shell) option;
-    mutable structure: Typedtree.structure;
+    mutable structure: Typedtree.structure_item list;
     mutable type_info: Stypes.annotation list;
     mutable signature: Types.signature;
     mutable psignature: Parsetree.signature;
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/searchid.ml ocaml-4.01.0/otherlibs/labltk/browser/searchid.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/searchid.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/searchid.ml	2013-05-16 13:34:53.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,8 +12,9 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: searchid.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
+open Asttypes
 open StdLabels
 open Location
 open Longident
@@ -101,7 +102,7 @@
 
 let rec equal ~prefix t1 t2 =
   match (repr t1).desc, (repr t2).desc with
-    Tvar, Tvar -> true
+    Tvar _, Tvar _ -> true
   | Tvariant row1, Tvariant row2 ->
       let row1 = row_repr row1 and row2 = row_repr row2 in
       let fields1 = filter_row_fields false row1.row_fields
@@ -144,7 +145,7 @@
 
 let rec included ~prefix t1 t2 =
   match (repr t1).desc, (repr t2).desc with
-    Tvar, _ -> true
+    Tvar _, _ -> true
   | Tvariant row1, Tvariant row2 ->
       let row1 = row_repr row1 and row2 = row_repr row2 in
       let fields1 = filter_row_fields false row1.row_fields
@@ -205,7 +206,7 @@
       ~f:(fun acc x -> Pdot (acc, x, 0))
 
 let get_fields ~prefix ~sign self =
-  let env = open_signature (mkpath prefix) sign initial in
+  let env = open_signature Fresh (mkpath prefix) sign initial in
   match (expand_head env self).desc with
     Tobject (ty_obj, _) ->
       let l,_ = flatten_fields ty_obj in l
@@ -218,10 +219,11 @@
   and lid_of_id id = mklid (prefix @ [Ident.name id]) in
   List2.flat_map sign ~f:
   begin fun item -> match item with
-        Tsig_value (id, vd) ->
+        Sig_value (id, vd) ->
           if matches vd.val_type then [lid_of_id id, Pvalue] else []
-      | Tsig_type (id, td, _) ->
+      | Sig_type (id, td, _) ->
           if
+          matches (newconstr (Pident id) td.type_params) ||
           begin match td.type_manifest with
             None -> false
           | Some t -> matches t
@@ -229,28 +231,32 @@
           begin match td.type_kind with
             Type_abstract -> false
           | Type_variant l ->
-            List.exists l ~f:(fun (_, l) -> List.exists l ~f:matches)
+            List.exists l ~f:
+            begin fun (_, l, r) ->
+              List.exists l ~f:matches ||
+              match r with None -> false | Some x -> matches x
+            end
           | Type_record(l, rep) ->
             List.exists l ~f:(fun (_, _, t) -> matches t)
           end
           then [lid_of_id id, Ptype] else []
-      | Tsig_exception (id, l) ->
-          if List.exists l ~f:matches
+      | Sig_exception (id, l) ->
+          if List.exists l.exn_args ~f:matches
           then [lid_of_id id, Pconstructor]
           else []
-      | Tsig_module (id, Tmty_signature sign, _) ->
+      | Sig_module (id, Mty_signature sign, _) ->
           search_type_in_signature t ~sign ~mode
             ~prefix:(prefix @ [Ident.name id])
-      | Tsig_module _ -> []
-      | Tsig_modtype _ -> []
-      | Tsig_class (id, cl, _) ->
+      | Sig_module _ -> []
+      | Sig_modtype _ -> []
+      | Sig_class (id, cl, _) ->
           let self = self_type cl.cty_type in
           if matches self
           || (match cl.cty_new with None -> false | Some ty -> matches ty)
           (* || List.exists (get_fields ~prefix ~sign self)
               ~f:(fun (_,_,ty_field) -> matches ty_field) *)
           then [lid_of_id id, Pclass] else []
-      | Tsig_cltype (id, cl, _) ->
+      | Sig_class_type (id, cl, _) ->
           let self = self_type cl.clty_type in
           if matches self
           (* || List.exists (get_fields ~prefix ~sign self)
@@ -268,7 +274,7 @@
     begin fun modname ->
     let mlid = Lident modname in
     try match lookup_module mlid initial with
-      _, Tmty_signature sign ->
+      _, Mty_signature sign ->
         List2.flat_map tl
           ~f:(search_type_in_signature ~sign ~prefix:[modname] ~mode)
     | _ -> []
@@ -281,23 +287,23 @@
   try
     let sexp = Parse.interface (Lexing.from_string ("val z : " ^ text)) in
     let sign =
-      try Typemod.transl_signature !start_env sexp with _ ->
+      try (Typemod.transl_signature !start_env sexp).sig_type with _ ->
       let env = List.fold_left !module_list ~init:initial ~f:
         begin fun acc m ->
           try open_pers_signature m acc with Env.Error _ -> acc
         end in
-      try Typemod.transl_signature env sexp
+      try (Typemod.transl_signature env sexp).sig_type
       with Env.Error err -> []
-      | Typemod.Error (l,_) ->
+      | Typemod.Error (l,_,_) ->
           let start_c = l.loc_start.Lexing.pos_cnum in
           let end_c = l.loc_end.Lexing.pos_cnum in
           raise (Error (start_c - 8, end_c - 8))
-      | Typetexp.Error (l,_) ->
+      | Typetexp.Error (l,_,_) ->
           let start_c = l.loc_start.Lexing.pos_cnum in
           let end_c = l.loc_end.Lexing.pos_cnum in
           raise (Error (start_c - 8, end_c - 8))
     in match sign with
-        [Tsig_value (_, vd)] ->
+        [ Sig_value (_, vd) ] ->
           search_all_types vd.val_type ~mode
       | _ -> []
   with
@@ -350,20 +356,20 @@
   let l = List.map !module_list ~f:
     begin fun modname -> Lident modname,
     try match lookup_module (Lident modname) initial with
-      _, Tmty_signature sign ->
+      _, Mty_signature sign ->
         List2.flat_map sign ~f:
           begin function
-            Tsig_value (i, _) when check i -> [i, Pvalue]
-          | Tsig_type (i, _, _) when check i -> [i, Ptype]
-          | Tsig_exception (i, _) when check i -> [i, Pconstructor]
-          | Tsig_module (i, _, _) when check i -> [i, Pmodule]
-          | Tsig_modtype (i, _) when check i -> [i, Pmodtype]
-          | Tsig_class (i, cl, _) when check i
+            Sig_value (i, _) when check i -> [i, Pvalue]
+          | Sig_type (i, _, _) when check i -> [i, Ptype]
+          | Sig_exception (i, _) when check i -> [i, Pconstructor]
+          | Sig_module (i, _, _) when check i -> [i, Pmodule]
+          | Sig_modtype (i, _) when check i -> [i, Pmodtype]
+          | Sig_class (i, cl, _) when check i
             || List.exists
                 (get_fields ~prefix:[modname] ~sign (self_type cl.cty_type))
                 ~f:(fun (name,_,_) -> check_match ~pattern (explode name))
             -> [i, Pclass]
-          | Tsig_cltype (i, cl, _) when check i
+          | Sig_class_type (i, cl, _) when check i
             || List.exists
                 (get_fields ~prefix:[modname] ~sign (self_type cl.clty_type))
                 ~f:(fun (name,_,_) -> check_match ~pattern (explode name))
@@ -406,9 +412,9 @@
 
 let rec bound_variables pat =
   match pat.ppat_desc with
-    Ppat_any | Ppat_constant _ | Ppat_type _ -> []
-  | Ppat_var s -> [s]
-  | Ppat_alias (pat,s) -> s :: bound_variables pat
+    Ppat_any | Ppat_constant _ | Ppat_type _ | Ppat_unpack _ -> []
+  | Ppat_var s -> [s.txt]
+  | Ppat_alias (pat,s) -> s.txt :: bound_variables pat
   | Ppat_tuple l -> List2.flat_map l ~f:bound_variables
   | Ppat_construct (_,None,_) -> []
   | Ppat_construct (_,Some pat,_) -> bound_variables pat
@@ -432,7 +438,7 @@
           List.fold_left ~init:[] str ~f:
             begin fun acc item ->
               match item.pstr_desc with
-                Pstr_module (s, mexp) when s = modu ->
+                Pstr_module (s, mexp) when s.txt = modu ->
                   loc := mexp.pmod_loc.loc_start.Lexing.pos_cnum;
                   begin match mexp.pmod_desc with
                     Pmod_structure str -> str
@@ -452,27 +458,27 @@
               then loc := pat.ppat_loc.loc_start.Lexing.pos_cnum
             end;
           false
-      | Pstr_primitive (s, _) when kind = Pvalue -> name = s
+      | Pstr_primitive (s, _) when kind = Pvalue -> name = s.txt
       | Pstr_type l when kind = Ptype ->
           List.iter l ~f:
             begin fun (s, td) ->
-              if s = name then loc := td.ptype_loc.loc_start.Lexing.pos_cnum
+              if s.txt = name then loc := td.ptype_loc.loc_start.Lexing.pos_cnum
             end;
           false
-      | Pstr_exception (s, _) when kind = Pconstructor -> name = s
-      | Pstr_module (s, _) when kind = Pmodule -> name = s
-      | Pstr_modtype (s, _) when kind = Pmodtype -> name = s
+      | Pstr_exception (s, _) when kind = Pconstructor -> name = s.txt
+      | Pstr_module (s, _) when kind = Pmodule -> name = s.txt
+      | Pstr_modtype (s, _) when kind = Pmodtype -> name = s.txt
       | Pstr_class l when kind = Pclass || kind = Ptype || kind = Pcltype ->
           List.iter l ~f:
             begin fun c ->
-              if c.pci_name = name
+              if c.pci_name.txt = name
               then loc := c.pci_loc.loc_start.Lexing.pos_cnum
             end;
           false
       | Pstr_class_type l when kind = Pcltype || kind = Ptype ->
           List.iter l ~f:
             begin fun c ->
-              if c.pci_name = name
+              if c.pci_name.txt = name
               then loc := c.pci_loc.loc_start.Lexing.pos_cnum
             end;
           false
@@ -482,6 +488,8 @@
   !loc
 
 let search_signature sign ~name ~kind ~prefix =
+  ignore (name = "");
+  ignore (prefix = [""]);
   let loc = ref 0 in
   let rec search_module_type  sign ~prefix =
     match prefix with [] -> sign
@@ -490,7 +498,7 @@
           List.fold_left ~init:[] sign ~f:
             begin fun acc item ->
               match item.psig_desc with
-                Psig_module (s, mtyp) when s = modu ->
+                Psig_module (s, mtyp) when s.txt = modu ->
                   loc := mtyp.pmty_loc.loc_start.Lexing.pos_cnum;
                   begin match mtyp.pmty_desc with
                     Pmty_signature sign -> sign
@@ -503,27 +511,27 @@
   List.iter (search_module_type sign ~prefix) ~f:
     begin fun item ->
       if match item.psig_desc with
-        Psig_value (s, _) when kind = Pvalue -> name = s
+        Psig_value (s, _) when kind = Pvalue -> name = s.txt
       | Psig_type l when kind = Ptype ->
           List.iter l ~f:
             begin fun (s, td) ->
-              if s = name then loc := td.ptype_loc.loc_start.Lexing.pos_cnum
+              if s.txt = name then loc := td.ptype_loc.loc_start.Lexing.pos_cnum
             end;
           false
-      | Psig_exception (s, _) when kind = Pconstructor -> name = s
-      | Psig_module (s, _) when kind = Pmodule -> name = s
-      | Psig_modtype (s, _) when kind = Pmodtype -> name = s
+      | Psig_exception (s, _) when kind = Pconstructor -> name = s.txt
+      | Psig_module (s, _) when kind = Pmodule -> name = s.txt
+      | Psig_modtype (s, _) when kind = Pmodtype -> name = s.txt
       | Psig_class l when kind = Pclass || kind = Ptype || kind = Pcltype ->
           List.iter l ~f:
             begin fun c ->
-              if c.pci_name = name
+              if c.pci_name.txt = name
               then loc := c.pci_loc.loc_start.Lexing.pos_cnum
             end;
           false
       | Psig_class_type l when kind = Ptype || kind = Pcltype ->
           List.iter l ~f:
             begin fun c ->
-              if c.pci_name = name
+              if c.pci_name.txt = name
               then loc := c.pci_loc.loc_start.Lexing.pos_cnum
             end;
           false
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/searchid.mli ocaml-4.01.0/otherlibs/labltk/browser/searchid.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/searchid.mli	2002-07-25 22:51:47.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/searchid.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: searchid.mli 5044 2002-07-25 22:51:47Z garrigue $ *)
+(* $Id$ *)
 
 val start_env : Env.t ref
 val module_list : string list ref
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/searchpos.ml ocaml-4.01.0/otherlibs/labltk/browser/searchpos.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/searchpos.ml	2010-04-02 12:53:33.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/searchpos.ml	2013-05-16 13:34:53.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,8 +12,9 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: searchpos.ml 10227 2010-04-02 12:53:33Z xleroy $ *)
+(* $Id$ *)
 
+open Asttypes
 open StdLabels
 open Support
 open Tk
@@ -118,7 +119,7 @@
       List.iter tl ~f:(search_pos_type ~pos ~env)
   | Ptyp_constr (lid, tl) ->
       List.iter tl ~f:(search_pos_type ~pos ~env);
-      add_found_sig (`Type, lid) ~env ~loc:t.ptyp_loc
+      add_found_sig (`Type, lid.txt) ~env ~loc:t.ptyp_loc
   | Ptyp_object fl ->
       List.iter fl ~f:
         begin function
@@ -127,7 +128,7 @@
         end
   | Ptyp_class (lid, tl, _) ->
       List.iter tl ~f:(search_pos_type ~pos ~env);
-      add_found_sig (`Type, lid) ~env ~loc:t.ptyp_loc
+      add_found_sig (`Type, lid.txt) ~env ~loc:t.ptyp_loc
   | Ptyp_alias (t, _)
   | Ptyp_poly (_, t) -> search_pos_type ~pos ~env t
   | Ptyp_package (_, stl) ->
@@ -138,23 +139,23 @@
   if in_loc cl.pcty_loc ~pos then
     begin match cl.pcty_desc with
       Pcty_constr (lid, _) ->
-        add_found_sig (`Class, lid) ~env ~loc:cl.pcty_loc
-    | Pcty_signature (_, cfl) ->
-        List.iter cfl ~f:
-          begin function
+        add_found_sig (`Class, lid.txt) ~env ~loc:cl.pcty_loc
+    | Pcty_signature  cl ->
+        List.iter cl.pcsig_fields ~f: (fun fl ->
+          begin match fl.pctf_desc with
               Pctf_inher cty -> search_pos_class_type cty ~pos ~env
-            | Pctf_val (_, _, _, ty, loc) ->
-                if in_loc loc ~pos then search_pos_type ty ~pos ~env
-            | Pctf_virt (_, _, ty, loc) ->
-                if in_loc loc ~pos then search_pos_type ty ~pos ~env
-            | Pctf_meth (_, _, ty, loc) ->
-                if in_loc loc ~pos then search_pos_type ty ~pos ~env
-            | Pctf_cstr (ty1, ty2, loc) ->
-                if in_loc loc ~pos then begin
+            | Pctf_val (_, _, _, ty) ->
+                if in_loc fl.pctf_loc ~pos then search_pos_type ty ~pos ~env
+            | Pctf_virt (_, _, ty) ->
+                if in_loc fl.pctf_loc ~pos then search_pos_type ty ~pos ~env
+            | Pctf_meth (_, _, ty) ->
+                if in_loc fl.pctf_loc ~pos then search_pos_type ty ~pos ~env
+            | Pctf_cstr (ty1, ty2) ->
+                if in_loc fl.pctf_loc ~pos then begin
                   search_pos_type ty1 ~pos ~env;
                   search_pos_type ty2 ~pos ~env
                 end
-          end
+          end)
     | Pcty_fun (_, ty, cty) ->
         search_pos_type ty ~pos ~env;
         search_pos_class_type cty ~pos ~env
@@ -170,7 +171,7 @@
       Ptype_abstract -> ()
     | Ptype_variant dl ->
         List.iter dl
-          ~f:(fun (_, tl, _) -> List.iter tl ~f:(search_pos_type ~pos ~env))
+          ~f:(fun (_, tl, _, _) -> List.iter tl ~f:(search_pos_type ~pos ~env))
     | Ptype_record dl ->
         List.iter dl ~f:(fun (_, _, t, _) -> search_pos_type t ~pos ~env) in
     search_tkind td.ptype_kind;
@@ -186,14 +187,14 @@
   List.fold_left l ~init:env ~f:
   begin fun env pt ->
     let env = match pt.psig_desc with
-      Psig_open id ->
-        let path, mt = lookup_module id env in
+      Psig_open (ovf, id) ->
+        let path, mt = lookup_module id.txt env in
         begin match mt with
-          Tmty_signature sign -> open_signature path sign env
+          Mty_signature sign -> open_signature ovf path sign env
         | _ -> env
         end
     | sign_item ->
-        try add_signature (Typemod.transl_signature env [pt]) env
+        try add_signature (Typemod.transl_signature env [pt]).sig_type env
         with Typemod.Error _ | Typeclass.Error _
         | Typetexp.Error _  | Typedecl.Error _ -> env
     in
@@ -219,7 +220,8 @@
           List.iter l
             ~f:(fun ci -> search_pos_class_type ci.pci_expr ~pos ~env)
       (* The last cases should not happen in generated interfaces *)
-      | Psig_open lid -> add_found_sig (`Module, lid) ~env ~loc:pt.psig_loc
+      | Psig_open (_, lid) ->
+        add_found_sig (`Module, lid.txt) ~env ~loc:pt.psig_loc
       | Psig_include t -> search_pos_module t ~pos ~env
       end;
     env
@@ -228,7 +230,7 @@
 and search_pos_module m ~pos ~env =
   if in_loc m.pmty_loc ~pos then begin
     begin match m.pmty_desc with
-      Pmty_ident lid -> add_found_sig (`Modtype, lid) ~env ~loc:m.pmty_loc
+      Pmty_ident lid -> add_found_sig (`Modtype, lid.txt) ~env ~loc:m.pmty_loc
     | Pmty_signature sg -> search_pos_signature sg ~pos ~env
     | Pmty_functor (_ , m1, m2) ->
         search_pos_module m1 ~pos ~env;
@@ -240,7 +242,7 @@
               _, Pwith_type t -> search_pos_type_decl t ~pos ~env
             | _ -> ()
           end
-    | Pmty_typeof md -> 
+    | Pmty_typeof md ->
         ()   (* TODO? *)
     end
   end
@@ -292,13 +294,13 @@
     [item] ->
       let id, kind =
         match item with
-          Tsig_value (id, _) -> id, Pvalue
-        | Tsig_type (id, _, _) -> id, Ptype
-        | Tsig_exception (id, _) -> id, Pconstructor
-        | Tsig_module (id, _, _) -> id, Pmodule
-        | Tsig_modtype (id, _) -> id, Pmodtype
-        | Tsig_class (id, _, _) -> id, Pclass
-        | Tsig_cltype (id, _, _) -> id, Pcltype
+          Sig_value (id, _) -> id, Pvalue
+        | Sig_type (id, _, _) -> id, Ptype
+        | Sig_exception (id, _) -> id, Pconstructor
+        | Sig_module (id, _, _) -> id, Pmodule
+        | Sig_modtype (id, _) -> id, Pmodtype
+        | Sig_class (id, _, _) -> id, Pclass
+        | Sig_class_type (id, _, _) -> id, Pcltype
       in
       let prefix = List.tl (list_of_path path) and name = Ident.name id in
       let pos =
@@ -319,12 +321,12 @@
 (* List of windows to destroy by Close All *)
 let top_widgets = ref []
 
-let dummy_item = Tsig_modtype (Ident.create "dummy", Tmodtype_abstract)
+let dummy_item = Sig_modtype (Ident.create "dummy", Modtype_abstract)
 
 let rec view_signature ?title ?path ?(env = !start_env) ?(detach=false) sign =
   let env =
     match path with None -> env
-    | Some path -> Env.open_signature path sign env in
+    | Some path -> Env.open_signature Fresh path sign env in
   let title =
     match title, path with Some title, _ -> title
     | None, Some path -> string_of_path path
@@ -384,7 +386,8 @@
       tl, tw, finish
   in
   Format.set_max_boxes 100;
-  Printtyp.signature Format.std_formatter sign;
+  Printtyp.wrap_printing_env env
+    (fun () -> Printtyp.signature Format.std_formatter sign);
   finish ();
   Lexical.init_tags tw;
   Lexical.tag tw;
@@ -393,12 +396,7 @@
   let pt =
       try Parse.interface (Lexing.from_string text)
       with Syntaxerr.Error e ->
-        let l =
-          match e with
-            Syntaxerr.Unclosed(l,_,_,_) -> l
-          | Syntaxerr.Applicative_path l -> l
-          | Syntaxerr.Other l -> l
-        in
+        let l = Syntaxerr.location_of_error e in
         Jg_text.tag_and_see  tw ~start:(tpos l.loc_start.Lexing.pos_cnum)
           ~stop:(tpos l.loc_end.Lexing.pos_cnum) ~tag:"error"; []
       | Lexer.Error (_, l) ->
@@ -440,11 +438,11 @@
 
 and view_module path ~env =
   match find_module path env with
-    Tmty_signature sign ->
+    Mty_signature sign ->
       !view_defined_ref (Searchid.longident_of_path path) ~env
   | modtype ->
       let id = ident_of_path path ~default:"M" in
-      view_signature_item [Tsig_module (id, modtype, Trec_not)] ~path ~env
+      view_signature_item [Sig_module (id, modtype, Trec_not)] ~path ~env
 
 and view_module_id id ~env =
   let path, _ = lookup_module id env in
@@ -457,12 +455,12 @@
         {desc = Tobject _} ->
           let clt = find_cltype path env in
           view_signature_item ~path ~env
-            [Tsig_cltype(ident_of_path path ~default:"ct", clt, Trec_first);
+            [Sig_class_type(ident_of_path path ~default:"ct", clt, Trec_first);
              dummy_item; dummy_item]
       | _ -> raise Not_found
   with Not_found ->
     view_signature_item ~path ~env
-      [Tsig_type(ident_of_path path ~default:"t", td, Trec_first)]
+      [Sig_type(ident_of_path path ~default:"t", td, Trec_first)]
 
 and view_type_id li ~env =
   let path, decl = lookup_type li env in
@@ -471,19 +469,19 @@
 and view_class_id li ~env =
   let path, cl = lookup_class li env in
   view_signature_item ~path ~env
-     [Tsig_class(ident_of_path path ~default:"c", cl, Trec_first);
+     [Sig_class(ident_of_path path ~default:"c", cl, Trec_first);
       dummy_item; dummy_item; dummy_item]
 
 and view_cltype_id li ~env =
   let path, clt = lookup_cltype li env in
   view_signature_item ~path ~env
-     [Tsig_cltype(ident_of_path path ~default:"ct", clt, Trec_first);
+     [Sig_class_type(ident_of_path path ~default:"ct", clt, Trec_first);
       dummy_item; dummy_item]
 
 and view_modtype_id li ~env =
   let path, td = lookup_modtype li env in
   view_signature_item ~path ~env
-    [Tsig_modtype(ident_of_path path ~default:"S", td)]
+    [Sig_modtype(ident_of_path path ~default:"S", td)]
 
 and view_expr_type ?title ?path ?env ?(name="noname") t =
   let title =
@@ -495,7 +493,8 @@
     | Some path -> parent_path path, ident_of_path path ~default:name
   in
   view_signature ~title ?path ?env
-    [Tsig_value (id, {val_type = t; val_kind = Val_reg})]
+    [Sig_value (id, {val_type = t; val_kind = Val_reg;
+           Types.val_loc = Location.none})]
 
 and view_decl lid ~kind ~env =
   match kind with
@@ -529,16 +528,18 @@
     Format.set_formatter_output_functions buf#out (fun () -> ());
     Format.set_margin 60;
     Format.open_hbox ();
-    if kind = `Type then
-      Printtyp.type_declaration
-        (ident_of_path path ~default:"t")
-        Format.std_formatter
-        (find_type path env)
-    else
-      Printtyp.modtype_declaration
-        (ident_of_path path ~default:"S")
-        Format.std_formatter
-        (find_modtype path env);
+    Printtyp.wrap_printing_env env begin fun () ->
+      if kind = `Type then
+        Printtyp.type_declaration
+          (ident_of_path path ~default:"t")
+          Format.std_formatter
+          (find_type path env)
+      else
+        Printtyp.modtype_declaration
+          (ident_of_path path ~default:"S")
+          Format.std_formatter
+          (find_modtype path env)
+    end;
     Format.close_box (); Format.print_flush ();
     Format.set_formatter_output_functions fo ff;
     Format.set_margin margin;
@@ -575,7 +576,7 @@
           begin try
             let vd = find_value path env in
             view_signature_item ~path ~env
-              [Tsig_value(ident_of_path path ~default:"v", vd)]
+              [Sig_value(ident_of_path path ~default:"v", vd)]
           with Not_found ->
             view_expr_type ty ~path ~env
           end
@@ -585,19 +586,19 @@
       | `New path ->
           let cl = find_class path env in
           view_signature_item ~path ~env
-            [Tsig_class(ident_of_path path ~default:"c", cl, Trec_first)]
+            [Sig_class(ident_of_path path ~default:"c", cl, Trec_first)]
       end
   | `Class (path, cty) ->
       let cld = { cty_params = []; cty_variance = []; cty_type = cty;
                   cty_path = path; cty_new = None } in
       view_signature_item ~path ~env
-        [Tsig_class(ident_of_path path ~default:"c", cld, Trec_first)]
+        [Sig_class(ident_of_path path ~default:"c", cld, Trec_first)]
   | `Module (path, mty) ->
       match mty with
-        Tmty_signature sign -> view_signature sign ~path ~env
+        Mty_signature sign -> view_signature sign ~path ~env
       | modtype ->
           view_signature_item ~path ~env
-            [Tsig_module(ident_of_path path ~default:"M", mty, Trec_not)]
+            [Sig_module(ident_of_path path ~default:"M", mty, Trec_not)]
 
 let view_type_menu kind ~env ~parent =
   let title =
@@ -629,7 +630,8 @@
       Format.open_hbox ();
       Printtyp.reset ();
       Printtyp.mark_loops ty;
-      Printtyp.type_expr Format.std_formatter ty;
+      Printtyp.wrap_printing_env env
+        (fun () -> Printtyp.type_expr Format.std_formatter ty);
       Format.close_box (); Format.print_flush ();
       Format.set_formatter_output_functions fo ff;
       Format.set_margin margin;
@@ -659,7 +661,7 @@
 
 let rec search_pos_structure ~pos str =
   List.iter str ~f:
-  begin function
+  begin function str -> match str.str_desc with
     Tstr_eval exp -> search_pos_expr exp ~pos
   | Tstr_value (rec_flag, l) ->
       List.iter l ~f:
@@ -669,63 +671,59 @@
         search_pos_pat pat ~pos ~env;
         search_pos_expr exp ~pos
       end
-  | Tstr_primitive (_, vd) ->()
+  | Tstr_primitive (_, _, vd) ->()
   | Tstr_type _ -> ()
   | Tstr_exception _ -> ()
-  | Tstr_exn_rebind(_, _) -> ()
-  | Tstr_module (_, m) -> search_pos_module_expr m ~pos
+  | Tstr_exn_rebind(_, _, _, _) -> ()
+  | Tstr_module (_, _, m) -> search_pos_module_expr m ~pos
   | Tstr_recmodule bindings ->
-      List.iter bindings ~f:(fun (_, m) -> search_pos_module_expr m ~pos)
+      List.iter bindings ~f:(fun (_, _, _, m) -> search_pos_module_expr m ~pos)
   | Tstr_modtype _ -> ()
   | Tstr_open _ -> ()
   | Tstr_class l ->
-      List.iter l ~f:(fun (id, _, _, cl, _) -> search_pos_class_expr cl ~pos)
-  | Tstr_cltype _ -> ()
+      List.iter l ~f:(fun (cl, _, _) -> search_pos_class_expr cl.ci_expr ~pos)
+  | Tstr_class_type _ -> ()
   | Tstr_include (m, _) -> search_pos_module_expr m ~pos
   end
 
 and search_pos_class_structure ~pos cls =
-  List.iter cls.cl_field ~f:
-    begin function
-        Cf_inher (cl, _, _) ->
+  List.iter cls.cstr_fields ~f:
+    begin function cf -> match cf.cf_desc with
+        Tcf_inher (_, cl, _, _, _) ->
           search_pos_class_expr cl ~pos
-      | Cf_val (_, _, Some exp, _) -> search_pos_expr exp ~pos
-      | Cf_val _ -> ()
-      | Cf_meth (_, exp) -> search_pos_expr exp ~pos
-      | Cf_let (_, pel, iel) ->
-          List.iter pel ~f:
-            begin fun (pat, exp) ->
-              search_pos_pat pat ~pos ~env:exp.exp_env;
-              search_pos_expr exp ~pos
-            end;
-          List.iter iel ~f:(fun (_,exp) -> search_pos_expr exp ~pos)
-      | Cf_init exp -> search_pos_expr exp ~pos
+      | Tcf_val (_, _, _, _, Tcfk_concrete exp, _) -> search_pos_expr exp ~pos
+      | Tcf_val _ -> ()
+      | Tcf_meth (_, _, _, Tcfk_concrete exp, _) -> search_pos_expr exp ~pos
+      | Tcf_init exp -> search_pos_expr exp ~pos
+      | Tcf_constr _
+      | Tcf_meth _
+        -> assert false (* TODO !!!!!!!!!!!!!!!!! *)
     end
 
 and search_pos_class_expr ~pos cl =
   if in_loc cl.cl_loc ~pos then begin
     begin match cl.cl_desc with
-      Tclass_ident path ->
+      Tcl_ident (path, _, _) ->
         add_found_str (`Class (path, cl.cl_type))
           ~env:!start_env ~loc:cl.cl_loc
-    | Tclass_structure cls ->
+    | Tcl_structure cls ->
         search_pos_class_structure ~pos cls
-    | Tclass_fun (pat, iel, cl, _) ->
+    | Tcl_fun (_, pat, iel, cl, _) ->
         search_pos_pat pat ~pos ~env:pat.pat_env;
-        List.iter iel ~f:(fun (_,exp) -> search_pos_expr exp ~pos);
+        List.iter iel ~f:(fun (_,_, exp) -> search_pos_expr exp ~pos);
         search_pos_class_expr cl ~pos
-    | Tclass_apply (cl, el) ->
+    | Tcl_apply (cl, el) ->
         search_pos_class_expr cl ~pos;
-        List.iter el ~f:(fun (x,_) -> Misc.may (search_pos_expr ~pos) x)
-    | Tclass_let (_, pel, iel, cl) ->
+        List.iter el ~f:(fun (_, x,_) -> Misc.may (search_pos_expr ~pos) x)
+    | Tcl_let (_, pel, iel, cl) ->
         List.iter pel ~f:
           begin fun (pat, exp) ->
             search_pos_pat pat ~pos ~env:exp.exp_env;
             search_pos_expr exp ~pos
           end;
-        List.iter iel ~f:(fun (_,exp) -> search_pos_expr exp ~pos);
+        List.iter iel ~f:(fun (_,_, exp) -> search_pos_expr exp ~pos);
         search_pos_class_expr cl ~pos
-    | Tclass_constraint (cl, _, _, _) ->
+    | Tcl_constraint (cl, _, _, _, _) ->
         search_pos_class_expr cl ~pos
     end;
     add_found_str (`Class (Pident (Ident.create "c"), cl.cl_type))
@@ -735,7 +733,7 @@
 and search_pos_expr ~pos exp =
   if in_loc exp.exp_loc ~pos then begin
   begin match exp.exp_desc with
-    Texp_ident (path, _) ->
+    Texp_ident (path, _, _) ->
       add_found_str (`Exp(`Val path, exp.exp_type))
         ~env:exp.exp_env ~loc:exp.exp_loc
   | Texp_constant v ->
@@ -748,14 +746,14 @@
         search_pos_expr exp' ~pos
       end;
       search_pos_expr exp ~pos
-  | Texp_function (l, _) ->
+  | Texp_function (_, l, _) ->
       List.iter l ~f:
       begin fun (pat, exp) ->
         search_pos_pat pat ~pos ~env:exp.exp_env;
         search_pos_expr exp ~pos
       end
   | Texp_apply (exp, l) ->
-      List.iter l ~f:(fun (x,_) -> Misc.may (search_pos_expr ~pos) x);
+      List.iter l ~f:(fun (_, x,_) -> Misc.may (search_pos_expr ~pos) x);
       search_pos_expr exp ~pos
   | Texp_match (exp, l, _) ->
       search_pos_expr exp ~pos;
@@ -772,14 +770,14 @@
         search_pos_expr exp ~pos
       end
   | Texp_tuple l -> List.iter l ~f:(search_pos_expr ~pos)
-  | Texp_construct (_, l) -> List.iter l ~f:(search_pos_expr ~pos)
+  | Texp_construct (_, _, l,_) -> List.iter l ~f:(search_pos_expr ~pos)
   | Texp_variant (_, None) -> ()
   | Texp_variant (_, Some exp) -> search_pos_expr exp ~pos
   | Texp_record (l, opt) ->
-      List.iter l ~f:(fun (_, exp) -> search_pos_expr exp ~pos);
+      List.iter l ~f:(fun (_, _, exp) -> search_pos_expr exp ~pos);
       (match opt with None -> () | Some exp -> search_pos_expr exp ~pos)
-  | Texp_field (exp, _) -> search_pos_expr exp ~pos
-  | Texp_setfield (a, _, b) ->
+  | Texp_field (exp, _, _) -> search_pos_expr exp ~pos
+  | Texp_setfield (a, _, _, b) ->
       search_pos_expr a ~pos; search_pos_expr b ~pos
   | Texp_array l -> List.iter l ~f:(search_pos_expr ~pos)
   | Texp_ifthenelse (a, b, c) ->
@@ -791,24 +789,24 @@
       search_pos_expr a ~pos; search_pos_expr b ~pos
   | Texp_while (a,b) ->
       search_pos_expr a ~pos; search_pos_expr b ~pos
-  | Texp_for (_, a, b, _, c) ->
+  | Texp_for (_, _, a, b, _, c) ->
       List.iter [a;b;c] ~f:(search_pos_expr ~pos)
   | Texp_when (a, b) ->
       search_pos_expr a ~pos; search_pos_expr b ~pos
-  | Texp_send (exp, _) -> search_pos_expr exp ~pos
-  | Texp_new (path, _) ->
+  | Texp_send (exp, _, _) -> search_pos_expr exp ~pos
+  | Texp_new (path, _, _) ->
       add_found_str (`Exp(`New path, exp.exp_type))
         ~env:exp.exp_env ~loc:exp.exp_loc
-  | Texp_instvar (_,path) ->
+  | Texp_instvar (_, path, _) ->
       add_found_str (`Exp(`Var path, exp.exp_type))
         ~env:exp.exp_env ~loc:exp.exp_loc
-  | Texp_setinstvar (_, path, exp) ->
+  | Texp_setinstvar (_, path, _, exp) ->
       search_pos_expr exp ~pos;
       add_found_str (`Exp(`Var path, exp.exp_type))
         ~env:exp.exp_env ~loc:exp.exp_loc
   | Texp_override (_, l) ->
-      List.iter l ~f:(fun (_, exp) -> search_pos_expr exp ~pos)
-  | Texp_letmodule (id, modexp, exp) ->
+      List.iter l ~f:(fun (_, _, exp) -> search_pos_expr exp ~pos)
+  | Texp_letmodule (id, _, modexp, exp) ->
       search_pos_module_expr modexp ~pos;
       search_pos_expr exp ~pos
   | Texp_assertfalse -> ()
@@ -816,7 +814,7 @@
       search_pos_expr exp ~pos
   | Texp_lazy exp ->
       search_pos_expr exp ~pos
-  | Texp_object (cls, _, _) ->
+  | Texp_object (cls, _) ->
       search_pos_class_structure ~pos cls
   | Texp_pack modexp ->
       search_pos_module_expr modexp ~pos
@@ -828,21 +826,21 @@
   if in_loc pat.pat_loc ~pos then begin
   begin match pat.pat_desc with
     Tpat_any -> ()
-  | Tpat_var id ->
+  | Tpat_var (id, _) ->
       add_found_str (`Exp(`Val (Pident id), pat.pat_type))
         ~env ~loc:pat.pat_loc
-  | Tpat_alias (pat, _) -> search_pos_pat pat ~pos ~env
+  | Tpat_alias (pat, _, _) -> search_pos_pat pat ~pos ~env
   | Tpat_lazy pat -> search_pos_pat pat ~pos ~env
   | Tpat_constant _ ->
       add_found_str (`Exp(`Const, pat.pat_type)) ~env ~loc:pat.pat_loc
   | Tpat_tuple l ->
       List.iter l ~f:(search_pos_pat ~pos ~env)
-  | Tpat_construct (_, l) ->
+  | Tpat_construct (_, _, l, _) ->
       List.iter l ~f:(search_pos_pat ~pos ~env)
   | Tpat_variant (_, None, _) -> ()
   | Tpat_variant (_, Some pat, _) -> search_pos_pat pat ~pos ~env
-  | Tpat_record l ->
-      List.iter l ~f:(fun (_, pat) -> search_pos_pat pat ~pos ~env)
+  | Tpat_record (l, _) ->
+      List.iter l ~f:(fun (_, _, pat) -> search_pos_pat pat ~pos ~env)
   | Tpat_array l ->
       List.iter l ~f:(search_pos_pat ~pos ~env)
   | Tpat_or (a, b, None) ->
@@ -853,17 +851,17 @@
   add_found_str (`Exp(`Pat, pat.pat_type)) ~env ~loc:pat.pat_loc
   end
 
-and search_pos_module_expr ~pos m =
+and search_pos_module_expr ~pos (m :module_expr) =
   if in_loc m.mod_loc ~pos then begin
     begin match m.mod_desc with
-      Tmod_ident path ->
+      Tmod_ident (path, _) ->
         add_found_str (`Module (path, m.mod_type))
           ~env:m.mod_env ~loc:m.mod_loc
-    | Tmod_structure str -> search_pos_structure str ~pos
-    | Tmod_functor (_, _, m) -> search_pos_module_expr m ~pos
+    | Tmod_structure str -> search_pos_structure str.str_items ~pos
+    | Tmod_functor (_, _, _, m) -> search_pos_module_expr m ~pos
     | Tmod_apply (a, b, _) ->
         search_pos_module_expr a ~pos; search_pos_module_expr b ~pos
-    | Tmod_constraint (m, _, _) -> search_pos_module_expr m ~pos
+    | Tmod_constraint (m, _, _, _) -> search_pos_module_expr m ~pos
     | Tmod_unpack (e, _) -> search_pos_expr e ~pos
     end;
     add_found_str (`Module (Pident (Ident.create "M"), m.mod_type))
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/searchpos.mli ocaml-4.01.0/otherlibs/labltk/browser/searchpos.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/searchpos.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/searchpos.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: searchpos.mli 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open Widget
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/setpath.ml ocaml-4.01.0/otherlibs/labltk/browser/setpath.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/setpath.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/setpath.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: setpath.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open StdLabels
 open Tk
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/setpath.mli ocaml-4.01.0/otherlibs/labltk/browser/setpath.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/setpath.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/setpath.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: setpath.mli 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open Widget
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/shell.ml ocaml-4.01.0/otherlibs/labltk/browser/shell.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/shell.ml	2010-08-28 06:10:22.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/shell.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: shell.ml 10659 2010-08-28 06:10:22Z garrigue $ *)
+(* $Id$ *)
 
 open StdLabels
 module Unix = UnixLabels
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/shell.mli ocaml-4.01.0/otherlibs/labltk/browser/shell.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/shell.mli	2002-07-25 22:51:47.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/shell.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: shell.mli 5044 2002-07-25 22:51:47Z garrigue $ *)
+(* $Id$ *)
 
 class ['a] history :
   unit ->
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/typecheck.ml ocaml-4.01.0/otherlibs/labltk/browser/typecheck.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/typecheck.ml	2009-07-20 11:51:50.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/typecheck.ml	2013-02-09 08:42:11.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,11 +12,12 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: typecheck.ml 9319 2009-07-20 11:51:50Z doligez $ *)
+(* $Id$ *)
 
 open StdLabels
 open Tk
 open Parsetree
+open Typedtree
 open Location
 open Jg_tk
 open Mytypes
@@ -60,8 +61,7 @@
       let ic = open_in_bin tmpfile in
       let ast =
         try
-          let buffer = String.create (String.length ast_magic) in
-          really_input ic buffer 0 (String.length ast_magic);
+          let buffer = Misc.input_bytes ic (String.length ast_magic) in
           if buffer = ast_magic then begin
             ignore (input_value ic);
             wrap (input_value ic)
@@ -73,7 +73,7 @@
           Outdated_version ->
             close_in ic;
             Sys.remove tmpfile;
-            failwith "Ocaml and preprocessor have incompatible versions"
+            failwith "OCaml and preprocessor have incompatible versions"
         | _ ->
             seek_in ic 0;
             let buffer = Lexing.from_channel ic in
@@ -106,7 +106,7 @@
     let psign = parse_pp text ~ext:".mli"
         ~parse:Parse.interface ~wrap:(fun x -> x) in
     txt.psignature <- psign;
-    txt.signature <- Typemod.transl_signature !env psign
+    txt.signature <- (Typemod.transl_signature !env psign).sig_type;
 
     else (* others are interpreted as .ml *)
 
@@ -116,7 +116,7 @@
     begin function
       Ptop_def pstr ->
         let str, sign, env' = Typemod.type_structure !env pstr Location.none in
-        txt.structure <- txt.structure @ str;
+        txt.structure <- txt.structure @ str.str_items;
         txt.signature <- txt.signature @ sign;
         env := env'
     | Ptop_dir _ -> ()
@@ -137,25 +137,23 @@
           Lexer.report_error Format.std_formatter err; l
       | Syntaxerr.Error err ->
           Syntaxerr.report_error Format.std_formatter err;
-          begin match err with
-            Syntaxerr.Unclosed(l,_,_,_) -> l
-          | Syntaxerr.Applicative_path l -> l
-          | Syntaxerr.Other l -> l
-          end
-      | Typecore.Error (l,err) ->
-          Typecore.report_error Format.std_formatter err; l
-      | Typeclass.Error (l,err) ->
-          Typeclass.report_error Format.std_formatter err; l
+          Syntaxerr.location_of_error err
+      | Typecore.Error (l, env, err) ->
+          Typecore.report_error env Format.std_formatter err; l
+      | Typeclass.Error (l, env, err) ->
+          Typeclass.report_error env Format.std_formatter err; l
       | Typedecl.Error (l, err) ->
           Typedecl.report_error Format.std_formatter err; l
-      | Typemod.Error (l,err) ->
-          Typemod.report_error Format.std_formatter err; l
-      | Typetexp.Error (l,err) ->
-          Typetexp.report_error Format.std_formatter err; l
+      | Typemod.Error (l, env, err) ->
+          Typemod.report_error env Format.std_formatter err; l
+      | Typetexp.Error (l, env, err) ->
+          Typetexp.report_error env Format.std_formatter err; l
       | Includemod.Error errl ->
           Includemod.report_error Format.std_formatter errl; Location.none
       | Env.Error err ->
           Env.report_error Format.std_formatter err; Location.none
+      | Cmi_format.Error err ->
+          Cmi_format.report_error Format.std_formatter err; Location.none
       | Ctype.Tags(l, l') ->
           Format.printf "In this program,@ variant constructors@ `%s and `%s@ have same hash value.@." l l';
           Location.none
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/typecheck.mli ocaml-4.01.0/otherlibs/labltk/browser/typecheck.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/typecheck.mli	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/typecheck.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: typecheck.mli 4144 2001-12-07 13:41:02Z xleroy $ *)
+(* $Id$ *)
 
 open Widget
 open Mytypes
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/useunix.ml ocaml-4.01.0/otherlibs/labltk/browser/useunix.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/useunix.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/useunix.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: useunix.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open StdLabels
 open UnixLabels
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/useunix.mli ocaml-4.01.0/otherlibs/labltk/browser/useunix.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/useunix.mli	2002-08-09 10:34:44.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/useunix.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: useunix.mli 5094 2002-08-09 10:34:44Z garrigue $ *)
+(* $Id$ *)
 
 (* Unix utilities *)
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/viewer.ml ocaml-4.01.0/otherlibs/labltk/browser/viewer.ml
--- ocaml-3.12.1/otherlibs/labltk/browser/viewer.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/viewer.ml	2013-05-16 13:34:53.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: viewer.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open StdLabels
 open Tk
@@ -61,7 +61,7 @@
   match kind with
     Pvalue ->
       let path, vd = lookup_value id env in
-      view_signature_item ~path ~env [Tsig_value (Ident.create name, vd)]
+      view_signature_item ~path ~env [Sig_value (Ident.create name, vd)]
   | Ptype -> view_type_id id ~env
   | Plabel -> let ld = lookup_label id env in
       begin match ld.lbl_res.desc with
@@ -74,7 +74,7 @@
         Tconstr (cpath, _, _) ->
         if Path.same cpath Predef.path_exn then
           view_signature ~title:(string_of_longident id) ~env ?path
-            [Tsig_exception (Ident.create name, cd.cstr_args)]
+            [Sig_exception (Ident.create name, {Types.exn_loc = Location.none; exn_args = cd.cstr_args})]
         else
           view_type_decl cpath ~env
       | _ -> ()
@@ -217,29 +217,29 @@
 (* Display the contents of a module *)
 
 let ident_of_decl ~modlid = function
-    Tsig_value (id, _) -> Lident (Ident.name id), Pvalue
-  | Tsig_type (id, _, _) -> Lident (Ident.name id), Ptype
-  | Tsig_exception (id, _) -> Ldot (modlid, Ident.name id), Pconstructor
-  | Tsig_module (id, _, _) -> Lident (Ident.name id), Pmodule
-  | Tsig_modtype (id, _) -> Lident (Ident.name id), Pmodtype
-  | Tsig_class (id, _, _) -> Lident (Ident.name id), Pclass
-  | Tsig_cltype (id, _, _) -> Lident (Ident.name id), Pcltype
+    Sig_value (id, _) -> Lident (Ident.name id), Pvalue
+  | Sig_type (id, _, _) -> Lident (Ident.name id), Ptype
+  | Sig_exception (id, _) -> Ldot (modlid, Ident.name id), Pconstructor
+  | Sig_module (id, _, _) -> Lident (Ident.name id), Pmodule
+  | Sig_modtype (id, _) -> Lident (Ident.name id), Pmodtype
+  | Sig_class (id, _, _) -> Lident (Ident.name id), Pclass
+  | Sig_class_type (id, _, _) -> Lident (Ident.name id), Pcltype
 
 let view_defined ~env ?(show_all=false) modlid =
-  try match lookup_module modlid env with path, Tmty_signature sign ->
+  try match lookup_module modlid env with path, Mty_signature sign ->
     let rec iter_sign sign idents =
       match sign with
         [] -> List.rev idents
       | decl :: rem ->
           let rem = match decl, rem with
-            Tsig_class _, cty :: ty1 :: ty2 :: rem -> rem
-          | Tsig_cltype _, ty1 :: ty2 :: rem -> rem
+            Sig_class _, cty :: ty1 :: ty2 :: rem -> rem
+          | Sig_class_type _, ty1 :: ty2 :: rem -> rem
           | _, rem -> rem
           in iter_sign rem (ident_of_decl ~modlid decl :: idents)
     in
     let l = iter_sign sign [] in
     let title = string_of_path path in
-    let env = open_signature path sign env in
+    let env = open_signature Asttypes.Fresh path sign env in
     !choose_symbol_ref l ~title ~signature:sign ~env ~path;
     if show_all then view_signature sign ~title ~env ~path
   | _ -> ()
@@ -248,6 +248,10 @@
       let tl, tw, finish = Jg_message.formatted ~title:"Error!" () in
       Env.report_error Format.std_formatter err;
       finish ()
+  | Cmi_format.Error err ->
+      let tl, tw, finish = Jg_message.formatted ~title:"Error!" () in
+      Cmi_format.report_error Format.std_formatter err;
+      finish ()
 
 
 (* Manage toplevel windows *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/viewer.mli ocaml-4.01.0/otherlibs/labltk/browser/viewer.mli
--- ocaml-3.12.1/otherlibs/labltk/browser/viewer.mli	2002-07-11 13:49:51.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/viewer.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*            Jacques Garrigue, Kyoto University RIMS                    *)
 (*                                                                       *)
@@ -12,7 +12,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: viewer.mli 4990 2002-07-11 13:49:51Z garrigue $ *)
+(* $Id$ *)
 
 (* Module viewer *)
 open Widget
diff -Nru ocaml-3.12.1/otherlibs/labltk/browser/winmain.c ocaml-4.01.0/otherlibs/labltk/browser/winmain.c
--- ocaml-3.12.1/otherlibs/labltk/browser/winmain.c	2008-12-03 18:09:09.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/browser/winmain.c	2012-07-17 15:31:12.000000000 +0000
@@ -1,4 +1,18 @@
-/* $Id: winmain.c 9153 2008-12-03 18:09:09Z doligez $ */
+/*************************************************************************/
+/*                                                                       */
+/*                         OCaml LablTk library                          */
+/*                                                                       */
+/*            Jacques Garrigue, Kyoto University RIMS                    */
+/*                                                                       */
+/*   Copyright 2001 Institut National de Recherche en Informatique et    */
+/*   en Automatique and Kyoto University.  All rights reserved.          */
+/*   This file is distributed under the terms of the GNU Library         */
+/*   General Public License, with the special exception on linking       */
+/*   described in file ../../../LICENSE.                                 */
+/*                                                                       */
+/*************************************************************************/
+
+/* $Id$ */
 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/labltk/builtin/LICENSE ocaml-4.01.0/otherlibs/labltk/builtin/LICENSE
--- ocaml-3.12.1/otherlibs/labltk/builtin/LICENSE	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/builtin/LICENSE	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                Objective Caml LablTk library                          *)
+(*                         OCaml LablTk library                          *)
 (*                                                                       *)
 (*          Francois Rouaix, Francois Pessaux, Jun Furuse                *)
 (*               projet Cristal, INRIA Rocquencourt                      *)
@@ -14,6 +14,6 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: LICENSE 4144 2001-12-07 13:41:02Z xleroy $ *)
+(* $Id$ *)
 
-All the files in this directory are subject to the above copyright notice.
\ No newline at end of file
+All the files in this directory are subject to the above copyright notice.
diff -Nru ocaml-3.12.1/otherlibs/labltk/camltk/.cvsignore ocaml-4.01.0/otherlibs/labltk/camltk/.cvsignore
--- ocaml-3.12.1/otherlibs/labltk/camltk/.cvsignore	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/camltk/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,3 +0,0 @@
-*.ml *.mli labltktop labltk
-modules
-.depend
diff -Nru ocaml-3.12.1/otherlibs/labltk/camltk/.ignore ocaml-4.01.0/otherlibs/labltk/camltk/.ignore
--- ocaml-3.12.1/otherlibs/labltk/camltk/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/camltk/.ignore	2012-07-17 15:31:12.000000000 +0000
@@ -0,0 +1,4 @@
+*.ml
+*.mli
+labltktop
+labltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/camltk/Makefile ocaml-4.01.0/otherlibs/labltk/camltk/Makefile
--- ocaml-3.12.1/otherlibs/labltk/camltk/Makefile	2007-12-12 14:09:45.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/camltk/Makefile	2013-03-19 17:49:49.000000000 +0000
@@ -1,3 +1,19 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include ../support/Makefile.common
 
 COMPFLAGS= -I ../support -I $(OTHERS)/win32unix -I $(OTHERS)/unix
@@ -8,19 +24,17 @@
 
 include ./modules
 
-CAMLTKOBJS= $(CWIDGETOBJS) cTk.cmo camltk.cmo
+CAMLTKOBJS = $(CWIDGETOBJS) cTk.cmo camltk.cmo
 CAMLTKOBJSX = $(CAMLTKOBJS:.cmo=.cmx)
 
 camltkobjs: $(CAMLTKOBJS)
 
 camltkobjsx: $(CAMLTKOBJSX)
 
-clean:
-	$(MAKE) -f Makefile.gen clean
-
 install:
 	if test -d $(INSTALLDIR); then : ; else mkdir $(INSTALLDIR); fi
-	cp $(CAMLTKOBJS:.cmo=.cmi) $(CWIDGETOBJS:.cmo=.mli) $(INSTALLDIR)
+	cp $(CAMLTKOBJS:.cmo=.cmi) $(INSTALLDIR)
+	cp $(CWIDGETOBJS:.cmo=.mli) $(INSTALLDIR)
 	chmod 644 $(INSTALLDIR)/*.cmi
 
 installopt:
@@ -28,6 +42,9 @@
 	cp $(CAMLTKOBJSX) $(INSTALLDIR)
 	chmod 644 $(INSTALLDIR)/*.cmx
 
+clean:
+	$(MAKE) -f Makefile.gen clean
+
 .SUFFIXES :
 .SUFFIXES : .mli .ml .cmi .cmx .cmo .mlp
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/camltk/Makefile.gen ocaml-4.01.0/otherlibs/labltk/camltk/Makefile.gen
--- ocaml-3.12.1/otherlibs/labltk/camltk/Makefile.gen	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/camltk/Makefile.gen	2012-07-17 15:31:12.000000000 +0000
@@ -1,3 +1,19 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include ../support/Makefile.common
 
 all: cTk.ml camltk.ml .depend
diff -Nru ocaml-3.12.1/otherlibs/labltk/camltk/Makefile.gen.nt ocaml-4.01.0/otherlibs/labltk/camltk/Makefile.gen.nt
--- ocaml-3.12.1/otherlibs/labltk/camltk/Makefile.gen.nt	2007-11-06 15:16:56.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/camltk/Makefile.gen.nt	2012-08-02 08:17:59.000000000 +0000
@@ -1 +1,17 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include Makefile.gen
diff -Nru ocaml-3.12.1/otherlibs/labltk/camltk/Makefile.nt ocaml-4.01.0/otherlibs/labltk/camltk/Makefile.nt
--- ocaml-3.12.1/otherlibs/labltk/camltk/Makefile.nt	2007-11-06 15:16:56.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/camltk/Makefile.nt	2012-08-02 08:17:59.000000000 +0000
@@ -1 +1,17 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include Makefile
diff -Nru ocaml-3.12.1/otherlibs/labltk/camltk/modules ocaml-4.01.0/otherlibs/labltk/camltk/modules
--- ocaml-3.12.1/otherlibs/labltk/camltk/modules	2002-04-26 13:58:17.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/camltk/modules	2012-08-09 06:05:28.000000000 +0000
@@ -1,80 +1,80 @@
-CWIDGETOBJS=cPlace.cmo cResource.cmo cWm.cmo cImagephoto.cmo cCanvas.cmo cButton.cmo cText.cmo cLabel.cmo cScrollbar.cmo cImage.cmo cEncoding.cmo cPixmap.cmo cPalette.cmo cFont.cmo cMessage.cmo cMenu.cmo cEntry.cmo cListbox.cmo cFocus.cmo cMenubutton.cmo cPack.cmo cOption.cmo cToplevel.cmo cFrame.cmo cDialog.cmo cImagebitmap.cmo cClipboard.cmo cRadiobutton.cmo cTkwait.cmo cGrab.cmo cSelection.cmo cScale.cmo cOptionmenu.cmo cWinfo.cmo cGrid.cmo cCheckbutton.cmo cBell.cmo cTkvars.cmo 
-cPlace.ml cResource.ml cWm.ml cImagephoto.ml cCanvas.ml cButton.ml cText.ml cLabel.ml cScrollbar.ml cImage.ml cEncoding.ml cPixmap.ml cPalette.ml cFont.ml cMessage.ml cMenu.ml cEntry.ml cListbox.ml cFocus.ml cMenubutton.ml cPack.ml cOption.ml cToplevel.ml cFrame.ml cDialog.ml cImagebitmap.ml cClipboard.ml cRadiobutton.ml cTkwait.ml cGrab.ml cSelection.ml cScale.ml cOptionmenu.ml cWinfo.ml cGrid.ml cCheckbutton.ml cBell.ml cTkvars.ml : _tkgen.ml
+CWIDGETOBJS= cBell.cmo cScale.cmo cWinfo.cmo cScrollbar.cmo cEntry.cmo cListbox.cmo cWm.cmo cTkwait.cmo cGrab.cmo cFont.cmo cCanvas.cmo cImage.cmo cClipboard.cmo cLabel.cmo cResource.cmo cMessage.cmo cText.cmo cImagephoto.cmo cOption.cmo cFrame.cmo cSelection.cmo cDialog.cmo cPlace.cmo cPixmap.cmo cMenubutton.cmo cRadiobutton.cmo cFocus.cmo cPack.cmo cImagebitmap.cmo cEncoding.cmo cOptionmenu.cmo cCheckbutton.cmo cTkvars.cmo cPalette.cmo cMenu.cmo cButton.cmo cToplevel.cmo cGrid.cmo
+cBell.ml cScale.ml cWinfo.ml cScrollbar.ml cEntry.ml cListbox.ml cWm.ml cTkwait.ml cGrab.ml cFont.ml cCanvas.ml cImage.ml cClipboard.ml cLabel.ml cResource.ml cMessage.ml cText.ml cImagephoto.ml cOption.ml cFrame.ml cSelection.ml cDialog.ml cPlace.ml cPixmap.ml cMenubutton.ml cRadiobutton.ml cFocus.ml cPack.ml cImagebitmap.ml cEncoding.ml cOptionmenu.ml cCheckbutton.ml cTkvars.ml cPalette.ml cMenu.ml cButton.ml cToplevel.ml cGrid.ml : _tkgen.ml
 
-cPlace.cmo : cPlace.ml
-cPlace.cmi : cPlace.mli
-cResource.cmo : cResource.ml
-cResource.cmi : cResource.mli
+cBell.cmo : cBell.ml
+cBell.cmi : cBell.mli
+cScale.cmo : cScale.ml
+cScale.cmi : cScale.mli
+cWinfo.cmo : cWinfo.ml
+cWinfo.cmi : cWinfo.mli
+cScrollbar.cmo : cScrollbar.ml
+cScrollbar.cmi : cScrollbar.mli
+cEntry.cmo : cEntry.ml
+cEntry.cmi : cEntry.mli
+cListbox.cmo : cListbox.ml
+cListbox.cmi : cListbox.mli
 cWm.cmo : cWm.ml
 cWm.cmi : cWm.mli
-cImagephoto.cmo : cImagephoto.ml
-cImagephoto.cmi : cImagephoto.mli
+cTkwait.cmo : cTkwait.ml
+cTkwait.cmi : cTkwait.mli
+cGrab.cmo : cGrab.ml
+cGrab.cmi : cGrab.mli
+cFont.cmo : cFont.ml
+cFont.cmi : cFont.mli
 cCanvas.cmo : cCanvas.ml
 cCanvas.cmi : cCanvas.mli
-cButton.cmo : cButton.ml
-cButton.cmi : cButton.mli
-cText.cmo : cText.ml
-cText.cmi : cText.mli
-cLabel.cmo : cLabel.ml
-cLabel.cmi : cLabel.mli
-cScrollbar.cmo : cScrollbar.ml
-cScrollbar.cmi : cScrollbar.mli
 cImage.cmo : cImage.ml
 cImage.cmi : cImage.mli
-cEncoding.cmo : cEncoding.ml
-cEncoding.cmi : cEncoding.mli
-cPixmap.cmo : cPixmap.ml
-cPixmap.cmi : cPixmap.mli
-cPalette.cmo : cPalette.ml
-cPalette.cmi : cPalette.mli
-cFont.cmo : cFont.ml
-cFont.cmi : cFont.mli
+cClipboard.cmo : cClipboard.ml
+cClipboard.cmi : cClipboard.mli
+cLabel.cmo : cLabel.ml
+cLabel.cmi : cLabel.mli
+cResource.cmo : cResource.ml
+cResource.cmi : cResource.mli
 cMessage.cmo : cMessage.ml
 cMessage.cmi : cMessage.mli
-cMenu.cmo : cMenu.ml
-cMenu.cmi : cMenu.mli
-cEntry.cmo : cEntry.ml
-cEntry.cmi : cEntry.mli
-cListbox.cmo : cListbox.ml
-cListbox.cmi : cListbox.mli
-cFocus.cmo : cFocus.ml
-cFocus.cmi : cFocus.mli
-cMenubutton.cmo : cMenubutton.ml
-cMenubutton.cmi : cMenubutton.mli
-cPack.cmo : cPack.ml
-cPack.cmi : cPack.mli
+cText.cmo : cText.ml
+cText.cmi : cText.mli
+cImagephoto.cmo : cImagephoto.ml
+cImagephoto.cmi : cImagephoto.mli
 cOption.cmo : cOption.ml
 cOption.cmi : cOption.mli
-cToplevel.cmo : cToplevel.ml
-cToplevel.cmi : cToplevel.mli
 cFrame.cmo : cFrame.ml
 cFrame.cmi : cFrame.mli
+cSelection.cmo : cSelection.ml
+cSelection.cmi : cSelection.mli
 cDialog.cmo : cDialog.ml
 cDialog.cmi : cDialog.mli
-cImagebitmap.cmo : cImagebitmap.ml
-cImagebitmap.cmi : cImagebitmap.mli
-cClipboard.cmo : cClipboard.ml
-cClipboard.cmi : cClipboard.mli
+cPlace.cmo : cPlace.ml
+cPlace.cmi : cPlace.mli
+cPixmap.cmo : cPixmap.ml
+cPixmap.cmi : cPixmap.mli
+cMenubutton.cmo : cMenubutton.ml
+cMenubutton.cmi : cMenubutton.mli
 cRadiobutton.cmo : cRadiobutton.ml
 cRadiobutton.cmi : cRadiobutton.mli
-cTkwait.cmo : cTkwait.ml
-cTkwait.cmi : cTkwait.mli
-cGrab.cmo : cGrab.ml
-cGrab.cmi : cGrab.mli
-cSelection.cmo : cSelection.ml
-cSelection.cmi : cSelection.mli
-cScale.cmo : cScale.ml
-cScale.cmi : cScale.mli
+cFocus.cmo : cFocus.ml
+cFocus.cmi : cFocus.mli
+cPack.cmo : cPack.ml
+cPack.cmi : cPack.mli
+cImagebitmap.cmo : cImagebitmap.ml
+cImagebitmap.cmi : cImagebitmap.mli
+cEncoding.cmo : cEncoding.ml
+cEncoding.cmi : cEncoding.mli
 cOptionmenu.cmo : cOptionmenu.ml
 cOptionmenu.cmi : cOptionmenu.mli
-cWinfo.cmo : cWinfo.ml
-cWinfo.cmi : cWinfo.mli
-cGrid.cmo : cGrid.ml
-cGrid.cmi : cGrid.mli
 cCheckbutton.cmo : cCheckbutton.ml
 cCheckbutton.cmi : cCheckbutton.mli
-cBell.cmo : cBell.ml
-cBell.cmi : cBell.mli
 cTkvars.cmo : cTkvars.ml
 cTkvars.cmi : cTkvars.mli
-camltk.cmo : cTk.cmo cPlace.cmo cResource.cmo cWm.cmo cImagephoto.cmo cCanvas.cmo cButton.cmo cText.cmo cLabel.cmo cScrollbar.cmo cImage.cmo cEncoding.cmo cPixmap.cmo cPalette.cmo cFont.cmo cMessage.cmo cMenu.cmo cEntry.cmo cListbox.cmo cFocus.cmo cMenubutton.cmo cPack.cmo cOption.cmo cToplevel.cmo cFrame.cmo cDialog.cmo cImagebitmap.cmo cClipboard.cmo cRadiobutton.cmo cTkwait.cmo cGrab.cmo cSelection.cmo cScale.cmo cOptionmenu.cmo cWinfo.cmo cGrid.cmo cCheckbutton.cmo cBell.cmo cTkvars.cmo 
+cPalette.cmo : cPalette.ml
+cPalette.cmi : cPalette.mli
+cMenu.cmo : cMenu.ml
+cMenu.cmi : cMenu.mli
+cButton.cmo : cButton.ml
+cButton.cmi : cButton.mli
+cToplevel.cmo : cToplevel.ml
+cToplevel.cmi : cToplevel.mli
+cGrid.cmo : cGrid.ml
+cGrid.cmi : cGrid.mli
+camltk.cmo : cTk.cmo cBell.cmo cScale.cmo cWinfo.cmo cScrollbar.cmo cEntry.cmo cListbox.cmo cWm.cmo cTkwait.cmo cGrab.cmo cFont.cmo cCanvas.cmo cImage.cmo cClipboard.cmo cLabel.cmo cResource.cmo cMessage.cmo cText.cmo cImagephoto.cmo cOption.cmo cFrame.cmo cSelection.cmo cDialog.cmo cPlace.cmo cPixmap.cmo cMenubutton.cmo cRadiobutton.cmo cFocus.cmo cPack.cmo cImagebitmap.cmo cEncoding.cmo cOptionmenu.cmo cCheckbutton.cmo cTkvars.cmo cPalette.cmo cMenu.cmo cButton.cmo cToplevel.cmo cGrid.cmo 
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/.cvsignore ocaml-4.01.0/otherlibs/labltk/compiler/.cvsignore
--- ocaml-3.12.1/otherlibs/labltk/compiler/.cvsignore	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,11 +0,0 @@
-lexer.ml
-parser.output
-parser.ml
-parser.mli
-tkcompiler
-pp
-copyright.ml
-pplex.ml
-ppyac.ml
-ppyac.output
-ppyac.mli
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/.ignore ocaml-4.01.0/otherlibs/labltk/compiler/.ignore
--- ocaml-3.12.1/otherlibs/labltk/compiler/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/.ignore	2012-07-17 15:31:12.000000000 +0000
@@ -0,0 +1,11 @@
+lexer.ml
+parser.output
+parser.ml
+parser.mli
+tkcompiler
+pp
+copyright.ml
+pplex.ml
+ppyac.ml
+ppyac.output
+ppyac.mli
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/Makefile ocaml-4.01.0/otherlibs/labltk/compiler/Makefile
--- ocaml-3.12.1/otherlibs/labltk/compiler/Makefile	2010-01-19 13:12:47.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/Makefile	2012-07-17 15:31:12.000000000 +0000
@@ -1,3 +1,19 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 1999 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include ../support/Makefile.common
 
 OBJS=	../support/support.cmo flags.cmo copyright.cmo \
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/Makefile.nt ocaml-4.01.0/otherlibs/labltk/compiler/Makefile.nt
--- ocaml-3.12.1/otherlibs/labltk/compiler/Makefile.nt	2007-11-06 15:16:56.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/Makefile.nt	2012-08-02 08:17:59.000000000 +0000
@@ -1 +1,17 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include Makefile
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/code.mli ocaml-4.01.0/otherlibs/labltk/compiler/code.mli
--- ocaml-3.12.1/otherlibs/labltk/compiler/code.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/code.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/compile.ml ocaml-4.01.0/otherlibs/labltk/compiler/compile.ml
--- ocaml-3.12.1/otherlibs/labltk/compiler/compile.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/compile.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: compile.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open StdLabels
 open Tables
@@ -548,7 +548,7 @@
 (* Converters                 *)
 (******************************)
 
-(* Produce an in-lined converter Caml -> Tk for simple types *)
+(* Produce an in-lined converter OCaml -> Tk for simple types *)
 (* the converter is a function of type:   -> string  *)
 let rec converterCAMLtoTK ~context_widget argname ty =
  match ty with
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/copyright ocaml-4.01.0/otherlibs/labltk/compiler/copyright
--- ocaml-3.12.1/otherlibs/labltk/compiler/copyright	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/copyright	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,6 +10,6 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/flags.ml ocaml-4.01.0/otherlibs/labltk/compiler/flags.ml
--- ocaml-3.12.1/otherlibs/labltk/compiler/flags.ml	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/flags.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/intf.ml ocaml-4.01.0/otherlibs/labltk/compiler/intf.ml
--- ocaml-3.12.1/otherlibs/labltk/compiler/intf.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/intf.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: intf.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open StdLabels
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/lexer.mll ocaml-4.01.0/otherlibs/labltk/compiler/lexer.mll
--- ocaml-3.12.1/otherlibs/labltk/compiler/lexer.mll	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/lexer.mll	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -14,13 +14,12 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: lexer.mll 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 {
 open StdLabels
 open Lexing
 open Parser
-open Support
 
 exception Lexical_error of string
 let current_line = ref 1
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/maincompile.ml ocaml-4.01.0/otherlibs/labltk/compiler/maincompile.ml
--- ocaml-3.12.1/otherlibs/labltk/compiler/maincompile.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/maincompile.ml	2012-08-09 06:05:28.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,14 +10,13 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: maincompile.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open StdLabels
-open Support
 open Tables
 open Printer
 open Compile
@@ -337,8 +336,9 @@
   Hashtbl.iter
     (fun name _ ->
       let name = realname name in
+      output_string oc " ";
       output_string oc name;
-      output_string oc ".cmo ")
+      output_string oc ".cmo")
     module_table;
   output_string oc "\n";
   Hashtbl.iter
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/parser.mly ocaml-4.01.0/otherlibs/labltk/compiler/parser.mly
--- ocaml-3.12.1/otherlibs/labltk/compiler/parser.mly	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/parser.mly	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                 MLTk, Tcl/Tk interface of Objective Caml            */
+/*                 MLTk, Tcl/Tk interface of OCaml                     */
 /*                                                                     */
 /*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    */
 /*               projet Cristal, INRIA Rocquencourt                    */
@@ -10,11 +10,11 @@
 /*  en Automatique and Kyoto University.  All rights reserved.         */
 /*  This file is distributed under the terms of the GNU Library        */
 /*  General Public License, with the special exception on linking      */
-/*  described in file ../LICENSE.                                      */
+/*  described in file ../../../LICENSE.                                */
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: parser.mly 9547 2010-01-22 12:48:24Z doligez $ */
+/* $Id$ */
 
 %{
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/pp.ml ocaml-4.01.0/otherlibs/labltk/compiler/pp.ml
--- ocaml-3.12.1/otherlibs/labltk/compiler/pp.ml	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/pp.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/ppexec.ml ocaml-4.01.0/otherlibs/labltk/compiler/ppexec.ml
--- ocaml-3.12.1/otherlibs/labltk/compiler/ppexec.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/ppexec.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/pplex.mli ocaml-4.01.0/otherlibs/labltk/compiler/pplex.mli
--- ocaml-3.12.1/otherlibs/labltk/compiler/pplex.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/pplex.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/pplex.mll ocaml-4.01.0/otherlibs/labltk/compiler/pplex.mll
--- ocaml-3.12.1/otherlibs/labltk/compiler/pplex.mll	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/pplex.mll	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file ../LICENSE.                                      *)
+(*  described in file ../../../LICENSE.                                *)
 (*                                                                     *)
 (***********************************************************************)
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/ppparse.ml ocaml-4.01.0/otherlibs/labltk/compiler/ppparse.ml
--- ocaml-3.12.1/otherlibs/labltk/compiler/ppparse.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/ppparse.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/ppyac.mly ocaml-4.01.0/otherlibs/labltk/compiler/ppyac.mly
--- ocaml-3.12.1/otherlibs/labltk/compiler/ppyac.mly	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/ppyac.mly	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                 MLTk, Tcl/Tk interface of Objective Caml            */
+/*                 MLTk, Tcl/Tk interface of OCaml                     */
 /*                                                                     */
 /*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    */
 /*               projet Cristal, INRIA Rocquencourt                    */
@@ -10,7 +10,7 @@
 /*  en Automatique and Kyoto University.  All rights reserved.         */
 /*  This file is distributed under the terms of the GNU Library        */
 /*  General Public License, with the special exception on linking      */
-/*  described in file ../LICENSE.                                      */
+/*  described in file ../../../LICENSE.                                */
 /*                                                                     */
 /***********************************************************************/
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/printer.ml ocaml-4.01.0/otherlibs/labltk/compiler/printer.ml
--- ocaml-3.12.1/otherlibs/labltk/compiler/printer.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/printer.ml	2013-05-29 18:05:44.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
@@ -22,7 +22,7 @@
   let more = ref 0 in
   for i = 0 to String.length s - 1 do
    match s.[i] with
-   | '\\' | '"' -> incr more
+   | '\\' | '\"' | '\'' -> incr more
    |  _ -> ()
   done;
   if !more = 0 then s else
@@ -31,45 +31,52 @@
   for i = 0 to String.length s - 1 do
    let c = s.[i] in
    match c with
-   | '\\' | '"' -> res.[!j] <- '\\'; incr j; res.[!j] <- c; incr j
+   | '\\' | '\"' |'\'' -> res.[!j] <- '\\'; incr j; res.[!j] <- c; incr j
    | _ -> res.[!j] <- c; incr j
   done;
-  res;;
+  res
+;;
 
-let escape_char c = if c = '\'' then "\\'" else String.make 1 c;;
+let escape_char c = if c = '\'' then "\\\'" else String.make 1 c;;
 
 let print_quoted_string s = printf "\"%s\"" (escape_string s);;
-let print_quoted_char c = printf "'%s'" (escape_char c);;
+let print_quoted_char c = printf "\'%s\'" (escape_char c);;
 let print_quoted_int i =
- if i < 0 then printf "(%d)" i else printf "%d" i;;
+  if i < 0 then printf "(%d)" i else printf "%d" i
+;;
 let print_quoted_float f =
- if f <= 0.0 then printf "(%f)" f else printf "%f" f;;
+  if f <= 0.0 then printf "(%f)" f else printf "%f" f
+;;
 
 (* Iterators *)
 let print_list f l =
- printf "@[<1>[";
- let rec pl = function
- | [] -> printf "@;<0 -1>]@]"
- | [x] -> f x; pl []
- | x :: xs -> f x; printf ";@ "; pl xs in
- pl l;;
+  printf "@[<1>[";
+  let rec pl = function
+  | [] -> printf "@;<0 -1>]@]"
+  | [x] -> f x; pl []
+  | x :: xs -> f x; printf ";@ "; pl xs in
+  pl l
+;;
 
 let print_array f v =
- printf "@[<2>[|";
- let l = Array.length v in
- if l >= 1 then f v.(0);
- if l >= 2 then
-  for i = 1 to l - 1 do
-   printf ";@ "; f v.(i)
-  done;
- printf "@;<0 -1>|]@]";;
+  printf "@[<2>[|";
+  let l = Array.length v in
+  if l >= 1 then f v.(0);
+  if l >= 2 then
+   for i = 1 to l - 1 do
+    printf ";@ "; f v.(i)
+   done;
+  printf "@;<0 -1>|]@]"
+;;
 
 let print_option f = function
   | None -> print_string "None"
-  | Some x -> printf "@[<1>Some@ "; f x; printf "@]";;
+  | Some x -> printf "@[<1>Some@ "; f x; printf "@]"
+;;
 
 let print_bool = function
-  | true -> print_string "true" | _ -> print_string "false";;
+  | true -> print_string "true" | _ -> print_string "false"
+;;
 
 let print_poly x = print_string "";;
 
@@ -97,7 +104,8 @@
      printf "@[<1>(%s@ " "Function"; print_mltype m; printf ")@]"
   | As (m, s) ->
      printf "@[<1>(%s@ " "As"; printf "@[<1>("; print_mltype m; printf ",@ ";
-     print_quoted_string s; printf ")@]"; printf ")@]";;
+     print_quoted_string s; printf ")@]"; printf ")@]"
+;;
 
 let rec print_template = function
   | StringArg s ->
@@ -111,12 +119,14 @@
   | OptionalArgs (s, l_t, l_t0) ->
      printf "@[<1>(%s@ " "OptionalArgs"; printf "@[<1>(";
      print_quoted_string s; printf ",@ "; print_list print_template l_t;
-     printf ",@ "; print_list print_template l_t0; printf ")@]"; printf ")@]";;
+     printf ",@ "; print_list print_template l_t0; printf ")@]"; printf ")@]"
+;;
 
 (* Sorts of components *)
 let rec print_component_type = function
   | Constructor -> printf "Constructor" | Command -> printf "Command"
-  | External -> printf "External";;
+  | External -> printf "External"
+;;
 
 (* Full definition of a component *)
 let rec print_fullcomponent = function
@@ -128,13 +138,15 @@
     printf ";@]@ "; printf "@[<1>var_name =@ "; print_quoted_string s0;
     printf ";@]@ "; printf "@[<1>template =@ "; print_template t;
     printf ";@]@ "; printf "@[<1>result =@ "; print_mltype m; printf ";@]@ ";
-    printf "@[<1>safe =@ "; print_bool b; printf ";@]@ "; printf "@,}@]";;
+    printf "@[<1>safe =@ "; print_bool b; printf ";@]@ "; printf "@,}@]"
+;;
 
 (* components are given either in full or abbreviated *)
 let rec print_component = function
   | Full f -> printf "@[<1>(%s@ " "Full"; print_fullcomponent f; printf ")@]"
   | Abbrev s ->
-     printf "@[<1>(%s@ " "Abbrev"; print_quoted_string s; printf ")@]";;
+     printf "@[<1>(%s@ " "Abbrev"; print_quoted_string s; printf ")@]"
+;;
 
 (* A type definition *)
 (*
@@ -142,7 +154,8 @@
    an additional argument of type Widget.
 *)
 let rec print_parser_arity = function
-  | OneToken -> printf "OneToken" | MultipleToken -> printf "MultipleToken";;
+  | OneToken -> printf "OneToken" | MultipleToken -> printf "MultipleToken"
+;;
 
 let rec print_type_def = function
   {parser_arity = p; constructors = l_f; subtypes = l_t_s_l_f;
@@ -159,10 +172,12 @@
      l_t_s_l_f;
     printf ";@]@ "; printf "@[<1>requires_widget_context =@ "; print_bool b;
     printf ";@]@ "; printf "@[<1>variant =@ "; print_bool b0; printf ";@]@ ";
-    printf "@,}@]";;
+    printf "@,}@]"
+;;
 
 let rec print_module_type = function
-  | Widget -> printf "Widget" | Family -> printf "Family";;
+  | Widget -> printf "Widget" | Family -> printf "Family"
+;;
 
 let rec print_module_def = function
   {module_type = m; commands = l_f; externals = l_f0; } ->
@@ -170,4 +185,5 @@
     printf ";@]@ "; printf "@[<1>commands =@ ";
     print_list print_fullcomponent l_f; printf ";@]@ ";
     printf "@[<1>externals =@ "; print_list print_fullcomponent l_f0;
-    printf ";@]@ "; printf "@,}@]";;
+    printf ";@]@ "; printf "@,}@]"
+;;
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/tables.ml ocaml-4.01.0/otherlibs/labltk/compiler/tables.ml
--- ocaml-3.12.1/otherlibs/labltk/compiler/tables.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/tables.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,14 +10,13 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: tables.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open StdLabels
-open Support
 
 (* Internal compiler errors *)
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/compiler/tsort.ml ocaml-4.01.0/otherlibs/labltk/compiler/tsort.ml
--- ocaml-3.12.1/otherlibs/labltk/compiler/tsort.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/compiler/tsort.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: tsort.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open StdLabels
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_camltk/.cvsignore ocaml-4.01.0/otherlibs/labltk/examples_camltk/.cvsignore
--- ocaml-3.12.1/otherlibs/labltk/examples_camltk/.cvsignore	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_camltk/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,8 +0,0 @@
-addition
-eyes
-fileinput
-fileopen
-helloworld
-tetris
-winskel
-mytext
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_camltk/.ignore ocaml-4.01.0/otherlibs/labltk/examples_camltk/.ignore
--- ocaml-3.12.1/otherlibs/labltk/examples_camltk/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_camltk/.ignore	2012-07-17 15:31:12.000000000 +0000
@@ -0,0 +1,8 @@
+addition
+eyes
+fileinput
+fileopen
+helloworld
+tetris
+winskel
+mytext
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_camltk/Makefile ocaml-4.01.0/otherlibs/labltk/examples_camltk/Makefile
--- ocaml-3.12.1/otherlibs/labltk/examples_camltk/Makefile	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_camltk/Makefile	2013-02-27 19:23:39.000000000 +0000
@@ -1,52 +1,118 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include ../support/Makefile.common
 
 # We are using the non-installed library !
-COMPFLAGS=-I ../lib -I ../camltk -I ../support -I $(OTHERS)/unix -w s -dllpath ../support
+BYT_COMPFLAGS=-I ../lib -I ../camltk -I ../support -I $(OTHERS)/unix -w s -dllpath ../support
+BIN_COMPFLAGS=-I ../lib -I ../camltk -I ../support -I $(OTHERS)/unix -w s
+
+WITH_BYT_CAMLTK=labltk.cma camltk.cmo
+WITH_BIN_CAMLTK=labltk.cmxa camltk.cmx
+
+BYT_EXECS =\
+  addition.byt helloworld.byt winskel.byt fileinput.byt\
+  eyes.byt taquin.byt tetris.byt mytext.byt fileopen.byt\
+
+BIN_EXECS=$(BYT_EXECS:.byt=.bin)
+
+EXECS=$(BYT_EXECS:.byt=$(EXE))
+
+all: byt bin
+
+byt: $(BYT_EXECS)
+
+#opt: hello.opt demo.opt calc.opt clock.opt tetris.opt
+
+bin: opt
+
+opt: $(BIN_EXECS)
 
+addition.bin: addition.cmx
+	$(CAMLOPT) $(BIN_COMPFLAGS) -o $@ $(WITH_BIN_CAMLTK) addition.cmx
 
-all: addition$(EXE) helloworld$(EXE) winskel$(EXE) fileinput$(EXE) \
-	eyes$(EXE) tetris$(EXE) mytext$(EXE) fileopen$(EXE)
+helloworld.bin: helloworld.cmx
+	$(CAMLOPT) $(BIN_COMPFLAGS) -o $@ $(WITH_BIN_CAMLTK) helloworld.cmx
 
-addition$(EXE): addition.cmo
-	$(CAMLC) $(COMPFLAGS) -o $@ $(LIBNAME).cma addition.cmo
+winskel.bin: winskel.cmx
+	$(CAMLOPT) $(BIN_COMPFLAGS) -o $@ $(WITH_BIN_CAMLTK) winskel.cmx
 
-helloworld$(EXE): helloworld.cmo
-	$(CAMLC) $(COMPFLAGS) -o $@ $(LIBNAME).cma helloworld.cmo
+fileinput.bin: fileinput.cmx
+	$(CAMLOPT) $(BIN_COMPFLAGS) -o $@ $(WITH_BIN_CAMLTK) unix.cmxa fileinput.cmx
 
-winskel$(EXE): winskel.cmo
-	$(CAMLC) $(COMPFLAGS) -o $@ $(LIBNAME).cma winskel.cmo
+socketinput.bin: socketinput.cmx
+	$(CAMLOPT) $(BIN_COMPFLAGS) -o $@ unix.cmxa $(WITH_BIN_CAMLTK) socketinput.cmx
 
-fileinput$(EXE): fileinput.cmo
-	$(CAMLC) $(COMPFLAGS) -o $@ unix.cma $(LIBNAME).cma fileinput.cmo
+eyes.bin: eyes.cmx
+	$(CAMLOPT) $(BIN_COMPFLAGS) -o $@ unix.cmxa $(WITH_BIN_CAMLTK) eyes.cmx
 
-socketinput$(EXE): socketinput.cmo
-	$(CAMLC) $(COMPFLAGS) -o $@ unix.cma $(LIBNAME).cma socketinput.cmo
+taquin.bin: taquin.cmx
+	$(CAMLOPT) $(BIN_COMPFLAGS) -o $@ unix.cmxa $(WITH_BIN_CAMLTK) taquin.cmx
 
-eyes$(EXE): eyes.cmo
-	$(CAMLC) $(COMPFLAGS) -o $@ unix.cma $(LIBNAME).cma eyes.cmo
+tetris.bin: tetris.cmx
+	$(CAMLOPT) $(BIN_COMPFLAGS) -o $@ unix.cmxa $(WITH_BIN_CAMLTK) tetris.cmx
 
-tetris$(EXE): tetris.cmo
-	$(CAMLC) $(COMPFLAGS) -o $@ unix.cma $(LIBNAME).cma tetris.cmo
+mytext.bin: mytext.cmx
+	$(CAMLOPT) $(BIN_COMPFLAGS) -o $@ unix.cmxa $(WITH_BIN_CAMLTK) mytext.cmx
 
-mytext$(EXE): mytext.cmo
-	$(CAMLC) $(COMPFLAGS) -o $@ unix.cma $(LIBNAME).cma mytext.cmo
+fileopen.bin: fileopen.cmx
+	$(CAMLOPT) $(BIN_COMPFLAGS) -o $@ unix.cmxa $(WITH_BIN_CAMLTK) fileopen.cmx
 
-# graph$(EXE): graphics.cmo graphics_test.cmo
-# 	  $(CAMLC) -o $@ graphics.cmo graphics_test.cmo
-#
-# graphics_test.cmo: graphics.cmo
 
-fileopen$(EXE): fileopen.cmo
-	$(CAMLC) $(COMPFLAGS) -o $@ $(LIBNAME).cma fileopen.cmo
+addition.byt: addition.cmo
+	$(CAMLC) $(BYT_COMPFLAGS) -o $@ $(LIBNAME).cma addition.cmo
+
+helloworld.byt: helloworld.cmo
+	$(CAMLC) $(BYT_COMPFLAGS) -o $@ $(LIBNAME).cma helloworld.cmo
+
+winskel.byt: winskel.cmo
+	$(CAMLC) $(BYT_COMPFLAGS) -o $@ $(LIBNAME).cma winskel.cmo
+
+fileinput.byt: fileinput.cmo
+	$(CAMLC) $(BYT_COMPFLAGS) -o $@ unix.cma $(LIBNAME).cma fileinput.cmo
+
+socketinput.byt: socketinput.cmo
+	$(CAMLC) $(BYT_COMPFLAGS) -o $@ unix.cma $(LIBNAME).cma socketinput.cmo
+
+eyes.byt: eyes.cmo
+	$(CAMLC) $(BYT_COMPFLAGS) -o $@ unix.cma $(LIBNAME).cma eyes.cmo
+
+taquin.byt: taquin.cmo
+	$(CAMLC) $(BYT_COMPFLAGS) -o $@ unix.cma $(LIBNAME).cma taquin.cmo
+
+tetris.byt: tetris.cmo
+	$(CAMLC) $(BYT_COMPFLAGS) -o $@ unix.cma $(LIBNAME).cma tetris.cmo
+
+mytext.byt: mytext.cmo
+	$(CAMLC) $(BYT_COMPFLAGS) -o $@ unix.cma $(LIBNAME).cma mytext.cmo
+
+fileopen.byt: fileopen.cmo
+	$(CAMLC) $(BYT_COMPFLAGS) -o $@ $(LIBNAME).cma fileopen.cmo
 
 clean :
-	rm -f *.cm? $(EXECS) addition eyes fileinput fileopen helloworld jptest mytext tetris winskel
+	rm -f *.cm? *.o a.out $(EXECS) $(BYT_EXECS) $(BIN_EXECS)
 
 .SUFFIXES :
-.SUFFIXES : .mli .ml .cmi .cmo
+.SUFFIXES : .mli .ml .cmi .cmo .cmx .cma .cmxa
 
 .mli.cmi:
-	$(CAMLCOMP) $(COMPFLAGS) $<
+	$(CAMLCOMP) $(BYT_COMPFLAGS) -c $<
 
 .ml.cmo:
-	$(CAMLCOMP) $(COMPFLAGS) $<
+	$(CAMLCOMP) $(BYT_COMPFLAGS) -c $<
+
+.ml.cmx:
+	$(CAMLOPT) $(BIN_COMPFLAGS) -c $<
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_camltk/Makefile.nt ocaml-4.01.0/otherlibs/labltk/examples_camltk/Makefile.nt
--- ocaml-3.12.1/otherlibs/labltk/examples_camltk/Makefile.nt	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_camltk/Makefile.nt	2012-08-02 08:17:59.000000000 +0000
@@ -1,3 +1,19 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include ../support/Makefile.common
 
 # We are using the non-installed library !
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_camltk/addition.ml ocaml-4.01.0/otherlibs/labltk/examples_camltk/addition.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_camltk/addition.ml	2002-07-23 14:12:03.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_camltk/addition.ml	2013-02-27 18:40:50.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,10 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
-open Camltk
+
+open Camltk;;
 
 let main () =
   let top = opentk ()  in
@@ -50,4 +51,5 @@
   mainLoop ()
 ;;
 
-let _ = Printexc.catch main () ;;
+Printexc.catch main ()
+;;
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_camltk/eyes.ml ocaml-4.01.0/otherlibs/labltk/examples_camltk/eyes.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_camltk/eyes.ml	2010-04-03 06:43:51.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_camltk/eyes.ml	2013-03-19 19:51:45.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,54 +10,65 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* The eyes of Caml (CamlTk) *)
+(* The eyes of OCaml (CamlTk) *)
 
 open Camltk;;
 
-let _ =
-  let top = opentk () in
+let create_eye canvas cx cy wx wy ewx ewy bnd =
+  let _oval2 =
+    Canvas.create_oval canvas
+     (Pixels (cx - wx)) (Pixels (cy - wy))
+     (Pixels (cx + wx)) (Pixels (cy + wy))
+     [Outline (NamedColor "black"); Width (Pixels 7);
+      FillColor (NamedColor "white"); ]
+  and oval =
+    Canvas.create_oval canvas
+     (Pixels (cx - ewx)) (Pixels (cy - ewy))
+     (Pixels (cx + ewx)) (Pixels (cy + ewy))
+     [FillColor (NamedColor "black")] in
+  let curx = ref cx
+  and cury = ref cy in
+
+  let treat_event e =
+
+    let xdiff = e.ev_MouseX - cx
+    and ydiff = e.ev_MouseY - cy in
+
+    let diff =
+      sqrt ((float xdiff /. (float wx *. bnd)) ** 2.0 +.
+            (float ydiff /. (float wy *. bnd)) ** 2.0) in
+
+    let nx, ny =
+      if diff <= 1.0 then e.ev_MouseX, e.ev_MouseY else
+        truncate ((float xdiff) *. (1.0 /. diff)) + cx,
+        truncate ((float ydiff) *. (1.0 /. diff)) + cy in
+
+    Canvas.move canvas oval (Pixels (nx - !curx)) (Pixels (ny - !cury));
+    curx := nx;
+    cury := ny; in
 
+  bind canvas [[], Motion] (
+    BindExtend ([Ev_MouseX; Ev_MouseY], treat_event)
+  )
+;;
+
+let main () =
+  let top = opentk () in
   let fw = Frame.create top [] in
   pack [fw] [];
-  let c = Canvas.create fw [Width (Pixels 200); Height (Pixels 200)] in
-  let create_eye cx cy wx wy ewx ewy bnd =
-    let _o2 =
-       Canvas.create_oval c
-        (Pixels (cx - wx)) (Pixels (cy - wy))
-        (Pixels (cx + wx)) (Pixels (cy + wy))
-        [Outline (NamedColor "black"); Width (Pixels 7);
-         FillColor (NamedColor "white")]
-    and o =
-      Canvas.create_oval c
-       (Pixels (cx - ewx)) (Pixels (cy - ewy))
-       (Pixels (cx + ewx)) (Pixels (cy + ewy))
-       [FillColor (NamedColor "black")] in
-    let curx = ref cx
-    and cury = ref cy in
-    bind c [[], Motion]
-      (BindExtend ([Ev_MouseX; Ev_MouseY],
-        (fun e ->
-          let nx, ny =
-            let xdiff = e.ev_MouseX - cx
-            and ydiff = e.ev_MouseY - cy in
-            let diff = sqrt ((float xdiff /. (float wx *. bnd)) ** 2.0 +.
-                               (float ydiff /. (float wy *. bnd)) ** 2.0) in
-            if diff > 1.0 then
-              truncate ((float xdiff) *. (1.0 /. diff)) + cx,
-              truncate ((float ydiff) *. (1.0 /. diff)) + cy
-            else
-              e.ev_MouseX, e.ev_MouseY
-          in
-          Canvas.move c o (Pixels (nx - !curx)) (Pixels (ny - !cury));
-          curx := nx;
-          cury := ny)))
-  in
-  create_eye 60 100 30 40 5 6 0.6;
-  create_eye 140 100 30 40 5 6 0.6;
-  pack [c] []
 
-let _ = Printexc.print mainLoop ()
+  let canvas = Canvas.create fw [Width (Pixels 200); Height (Pixels 200)] in
+
+  create_eye canvas 60 100 30 40 5 6 0.6;
+  create_eye canvas 140 100 30 40 5 6 0.6;
+  pack [canvas] [];
+
+  mainLoop ();
+;;
+
+Printexc.print main ();;
+
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_camltk/fileinput.ml ocaml-4.01.0/otherlibs/labltk/examples_camltk/fileinput.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_camltk/fileinput.ml	2002-07-23 14:12:03.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_camltk/fileinput.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk ;;
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_camltk/fileopen.ml ocaml-4.01.0/otherlibs/labltk/examples_camltk/fileopen.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_camltk/fileopen.ml	2006-01-04 16:55:50.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_camltk/fileopen.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk;;
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_camltk/helloworld.ml ocaml-4.01.0/otherlibs/labltk/examples_camltk/helloworld.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_camltk/helloworld.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_camltk/helloworld.ml	2013-02-27 19:20:54.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,28 +10,41 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
-open Camltk;;            (* Make interface functions available *)
 
-let top = opentk ();;   (* Initialisation of the interface *)
-(* top is now the toplevel widget *)
+(* Make interface functions available *)
+open Camltk;;
+
+(* Initialisation of the interface. *)
+let top = opentk ();;
+(* top is now the toplevel widget. *)
 
 (* Widget initialisation *)
-let b = Button.create top
-          [Text "foobar";
-           Command (function () ->
-                      print_string "foobar";
-                      print_newline();
-                      flush stdout)];;
-(* b exists but is not yet visible *)
-
-let q = Button.create top
-          [Text "quit";
-           Command closeTk];;
-(* q exists but is not yet visible *)
-
-pack [b; q][] ;;           (* Make b visible *)
-mainLoop() ;;           (* User interaction*)
-(* You can quit this program by deleting its main window *)
+let b =
+  Button.create top [
+    Text "foobar";
+    Command
+      (function () ->
+       print_string "foobar";
+       print_newline ();
+       flush stdout);
+  ]
+;;
+(* Now button [b] exists but is not yet visible. *)
+
+let q =
+  Button.create top [
+    Text "quit";
+    Command closeTk;
+  ]
+;;
+(* Button [q] also exists but is not yet visible. *)
+
+(* Make b and q visible. *)
+pack [b; q] [];;
+
+(* Start user interaction. *)
+mainLoop ();;
+(* You can also quit this program by deleting its main window. *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_camltk/jptest.ml ocaml-4.01.0/otherlibs/labltk/examples_camltk/jptest.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_camltk/jptest.ml	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_camltk/jptest.ml	2012-07-30 18:04:46.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Tk
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_camltk/mytext.ml ocaml-4.01.0/otherlibs/labltk/examples_camltk/mytext.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_camltk/mytext.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_camltk/mytext.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_camltk/socketinput.ml ocaml-4.01.0/otherlibs/labltk/examples_camltk/socketinput.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_camltk/socketinput.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_camltk/socketinput.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_camltk/taddition.ml ocaml-4.01.0/otherlibs/labltk/examples_camltk/taddition.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_camltk/taddition.ml	2002-07-23 14:12:03.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_camltk/taddition.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Tk
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_camltk/taquin.ml ocaml-4.01.0/otherlibs/labltk/examples_camltk/taquin.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_camltk/taquin.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_camltk/taquin.ml	2013-02-27 19:27:45.000000000 +0000
@@ -0,0 +1,146 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                        Caml examples                                *)
+(*                                                                     *)
+(*            Pierre Weis                                              *)
+(*                                                                     *)
+(*                        INRIA Rocquencourt                           *)
+(*                                                                     *)
+(*  Copyright (c) 1994-2011, INRIA                                     *)
+(*  All rights reserved.                                               *)
+(*                                                                     *)
+(*  Distributed under the BSD license.                                 *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id: taquin.ml,v 1.4 2011-08-08 19:31:17 weis Exp $ *)
+
+open Camltk;;
+
+let découpe_image img nx ny =
+  let l = Imagephoto.width img
+  and h = Imagephoto.height img in
+  let tx = l / nx and ty = h / ny in
+  let pièces = ref [] in
+  for x = 0 to nx - 1 do
+    for y = 0 to ny - 1 do
+      let pièce =
+        Imagephoto.create [Width (Pixels tx); Height (Pixels ty)] in
+      Imagephoto.copy pièce img
+        [ImgFrom(x * tx, y * ty, (x + 1) * tx, (y + 1) * ty)];
+      pièces := pièce :: !pièces
+    done
+  done;
+  (tx, ty, List.tl !pièces)
+;;
+
+let remplir_taquin c nx ny tx ty pièces =
+  let trou_x = ref (nx - 1)
+  and trou_y = ref (ny - 1) in
+  let trou =
+    Canvas.create_rectangle c
+      (Pixels (!trou_x * tx)) (Pixels (!trou_y * ty))
+      (Pixels tx) (Pixels ty) [] in
+  let taquin = Array.make_matrix nx ny trou in
+  let p = ref pièces in
+  for x = 0 to nx - 1 do
+    for y = 0 to ny - 1 do
+      match !p with
+      | [] -> ()
+      | pièce :: reste ->
+          taquin.(x).(y) <-
+            Canvas.create_image c
+              (Pixels (x * tx)) (Pixels (y * ty))
+              [ImagePhoto pièce; Anchor NW; Tags [Tag "pièce"]];
+          p := reste
+    done
+  done;
+  let déplacer x y =
+    let pièce = taquin.(x).(y) in
+    Canvas.coords_set c pièce
+      [Pixels (!trou_x * tx); Pixels(!trou_y * ty)];
+    Canvas.coords_set c trou
+      [Pixels (x * tx); Pixels(y * ty); Pixels tx; Pixels ty];
+    taquin.(!trou_x).(!trou_y) <- pièce;
+    taquin.(x).(y) <- trou;
+    trou_x := x; trou_y := y in
+  let jouer ei =
+    let x = ei.ev_MouseX / tx and y = ei.ev_MouseY / ty in
+    if x = !trou_x && (y = !trou_y - 1 || y = !trou_y + 1)
+    || y = !trou_y && (x = !trou_x - 1 || x = !trou_x + 1)
+    then déplacer x y in
+  Canvas.bind c (Tag "pièce") [[], ButtonPress]
+                (BindSet ([Ev_MouseX; Ev_MouseY], jouer));;
+
+let rec permutation = function
+  | [] -> []
+  | l  -> let n = Random.int (List.length l) in
+          let (élément, reste) = partage l n in
+          élément :: permutation reste
+
+and partage l n =
+  match l with
+  | [] -> failwith "partage"
+  | tête :: reste ->
+      if n = 0 then (tête, reste) else
+      let (élément, reste') = partage reste (n - 1) in
+      (élément, tête :: reste')
+;;
+
+let create_filled_text parent lines =
+  let lnum = List.length lines
+  and lwidth =
+    List.fold_right
+     (fun line max ->
+       let l = String.length line in
+       if l > max then l else max)
+     lines 1 in
+  let txtw = Text.create parent [TextWidth lwidth; TextHeight lnum] in
+  List.iter
+   (fun line ->
+     Text.insert txtw (TextIndex (End, [])) line [];
+     Text.insert txtw (TextIndex (End, [])) "\n" [])
+   lines;
+  txtw
+;;
+
+let give_help parent lines () =
+ let help_window = Toplevel.create parent [] in
+ Wm.title_set help_window "Help";
+
+ let help_frame = Frame.create help_window [] in
+
+ let help_txtw = create_filled_text help_frame lines in
+
+ let quit_help () = destroy help_window in
+ let ok_button = Button.create help_frame [Text "Ok"; Command quit_help] in
+
+ pack [help_txtw; ok_button ] [Side Side_Bottom];
+ pack [help_frame] []
+;;
+
+let taquin nom_fichier nx ny =
+  let fp = openTk () in
+  Wm.title_set fp "Taquin";
+  let img = Imagephoto.create [File nom_fichier] in
+  let c =
+    Canvas.create fp
+     [Width(Pixels(Imagephoto.width img));
+      Height(Pixels(Imagephoto.height img))] in
+  let (tx, ty, pièces) = découpe_image img nx ny in
+  remplir_taquin c nx ny tx ty (permutation pièces);
+  pack [c] [];
+
+  let quit = Button.create fp [Text "Quit"; Command closeTk] in
+  let help_lines =
+   ["Pour jouer, cliquer sur une des pièces";
+    "entourant le trou";
+    "";
+    "To play, click on a part around the hole"] in
+  let help =
+    Button.create fp [Text "Help"; Command (give_help fp help_lines)] in
+  pack [quit; help] [Side Side_Left; Fill Fill_X];
+  mainLoop ()
+;;
+
+if !Sys.interactive then () else begin taquin "joconde.gif" 3 5; exit 0 end;;
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_camltk/tetris.ml ocaml-4.01.0/otherlibs/labltk/examples_camltk/tetris.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_camltk/tetris.ml	2010-04-03 06:43:51.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_camltk/tetris.ml	2013-02-27 19:27:19.000000000 +0000
@@ -1,236 +1,136 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                        Caml examples                                *)
 (*                                                                     *)
-(*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
-(*               projet Cristal, INRIA Rocquencourt                    *)
-(*            Jacques Garrigue, Kyoto University RIMS                  *)
+(*            Pierre Weis                                              *)
 (*                                                                     *)
-(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
-(*  en Automatique and Kyoto University.  All rights reserved.         *)
-(*  This file is distributed under the terms of the GNU Library        *)
-(*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*                        INRIA Rocquencourt                           *)
+(*                                                                     *)
+(*  Copyright (c) 1994-2011, INRIA                                     *)
+(*  All rights reserved.                                               *)
+(*                                                                     *)
+(*  Distributed under the BSD license.                                 *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* A Tetris game for CamlTk *)
-(* written by Jun P. Furuse *)
+(* $Id: tetris.ml,v 1.6 2011-08-08 19:31:17 weis Exp $ *)
 
-open Camltk
+(* A Tetris game for CamlTk.
+   Written by Jun P. Furuse.
+   Adapted to the oc examples repository by P. Weis *)
 
-exception Done
+open Camltk;;
 
-type cell = {mutable color : int;
-             tag : tagOrId * tagOrId * tagOrId}
+(* The directory where images will be found. *)
+let baseurl = "images/";;
+
+exception Done;;
+
+type cell = {
+ mutable color : int;
+ tag : tagOrId * tagOrId * tagOrId;
+}
+;;
 
 type falling_block = {
-  mutable pattern: int array list;
-  mutable bcolor: int;
-  mutable x: int;
-  mutable y: int;
-  mutable d: int;
-  mutable alive: bool
+  mutable pattern : int array list;
+  mutable bcolor : int;
+  mutable x : int;
+  mutable y : int;
+  mutable d : int;
+  mutable alive: bool;
 }
+;;
 
-let stop_a_bit = 300
+let stop_a_bit = 300;;
 
 let colors = [|
-  NamedColor "red";
-  NamedColor "yellow";
-
-  NamedColor "blue";
-  NamedColor "orange";
-
-  NamedColor "magenta";
-  NamedColor "green";
-
-  NamedColor "cyan"
+  NamedColor "red"; NamedColor "yellow"; NamedColor "blue";
+  NamedColor "orange"; NamedColor "magenta"; NamedColor "green";
+  NamedColor "cyan";
 |]
-
-let baseurl = "images/"
+;;
 
 let backgrounds =
   List.map (fun s -> baseurl ^ s)
-    [ "dojoji.back.gif";
-      "Lambda2back.gif";
-      "CamlBook.gif";
-    ]
+    [ "dojoji.back.gif"; "Lambda2.back.gif"; "CamlBook.gif"; ];;
 
 (* blocks *)
 let block_size = 16
-let cell_border = 2
+and cell_border = 2
+;;
 
 let blocks = [
-  [ [|"0000";
-      "0000";
-      "1111";
-      "0000" |];
-
-    [|"0010";
-      "0010";
-      "0010";
-      "0010" |];
-
-    [|"0000";
-      "0000";
-      "1111";
-      "0000" |];
-
-    [|"0010";
-      "0010";
-      "0010";
-      "0010" |] ];
-
-  [ [|"0000";
-      "0110";
-      "0110";
-      "0000" |];
-
-    [|"0000";
-      "0110";
-      "0110";
-      "0000" |];
-
-    [|"0000";
-      "0110";
-      "0110";
-      "0000" |];
-
-    [|"0000";
-      "0110";
-      "0110";
-      "0000" |] ];
-
-  [ [|"0000";
-      "0111";
-      "0100";
-      "0000" |];
-
-    [|"0000";
-      "0110";
-      "0010";
-      "0010" |];
-
-    [|"0000";
-      "0010";
-      "1110";
-      "0000" |];
-
-    [|"0100";
-      "0100";
-      "0110";
-      "0000" |] ];
-
-  [ [|"0000";
-      "0100";
-      "0111";
-      "0000" |];
-
-    [|"0000";
-      "0110";
-      "0100";
-      "0100" |];
-
-    [|"0000";
-      "1110";
-      "0010";
-      "0000" |];
-
-    [|"0010";
-      "0010";
-      "0110";
-      "0000" |] ];
-
-  [ [|"0000";
-      "1100";
-      "0110";
-      "0000" |];
-
-    [|"0010";
-      "0110";
-      "0100";
-      "0000" |];
-
-    [|"0000";
-      "1100";
-      "0110";
-      "0000" |];
-
-    [|"0010";
-      "0110";
-      "0100";
-      "0000" |] ];
-
-  [ [|"0000";
-      "0011";
-      "0110";
-      "0000" |];
-
-    [|"0100";
-      "0110";
-      "0010";
-      "0000" |];
-
-    [|"0000";
-      "0011";
-      "0110";
-      "0000" |];
-
-    [|"0000";
-      "0100";
-      "0110";
-      "0010" |] ];
-
-  [ [|"0000";
-      "0000";
-      "1110";
-      "0100" |];
-
-    [|"0000";
-      "0100";
-      "1100";
-      "0100" |];
-
-    [|"0000";
-      "0100";
-      "1110";
-      "0000" |];
-
-    [|"0000";
-      "0100";
-      "0110";
-      "0100" |] ]
-
+  [ [|"0000"; "0000"; "1111"; "0000" |];
+    [|"0010"; "0010"; "0010"; "0010" |];
+    [|"0000"; "0000"; "1111"; "0000" |];
+    [|"0010"; "0010"; "0010"; "0010" |] ];
+
+  [ [|"0000"; "0110"; "0110"; "0000" |];
+    [|"0000"; "0110"; "0110"; "0000" |];
+    [|"0000"; "0110"; "0110"; "0000" |];
+    [|"0000"; "0110"; "0110"; "0000" |] ];
+
+  [ [|"0000"; "0111"; "0100"; "0000" |];
+    [|"0000"; "0110"; "0010"; "0010" |];
+    [|"0000"; "0010"; "1110"; "0000" |];
+    [|"0100"; "0100"; "0110"; "0000" |] ];
+
+  [ [|"0000"; "0100"; "0111"; "0000" |];
+    [|"0000"; "0110"; "0100"; "0100" |];
+    [|"0000"; "1110"; "0010"; "0000" |];
+    [|"0010"; "0010"; "0110"; "0000" |] ];
+
+  [ [|"0000"; "1100"; "0110"; "0000" |];
+    [|"0010"; "0110"; "0100"; "0000" |];
+    [|"0000"; "1100"; "0110"; "0000" |];
+    [|"0010"; "0110"; "0100"; "0000" |] ];
+
+  [ [|"0000"; "0011"; "0110"; "0000" |];
+    [|"0100"; "0110"; "0010"; "0000" |];
+    [|"0000"; "0011"; "0110"; "0000" |];
+    [|"0000"; "0100"; "0110"; "0010" |] ];
+
+  [ [|"0000"; "0000"; "1110"; "0100" |];
+    [|"0000"; "0100"; "1100"; "0100" |];
+    [|"0000"; "0100"; "1110"; "0000" |];
+    [|"0000"; "0100"; "0110"; "0100" |] ];
 ]
+;;
 
 let line_empty = int_of_string "0b1110000000000111"
-let line_full = int_of_string  "0b1111111111111111"
+and line_full = int_of_string  "0b1111111111111111"
+;;
 
 let decode_block dvec =
-  let btoi d = int_of_string ("0b"^d) in
+  let btoi d = int_of_string ("0b" ^ d) in
   Array.map btoi dvec
+;;
 
 let init fw =
   let scorev = Textvariable.create ()
   and linev = Textvariable.create ()
   and levv = Textvariable.create ()
-  in
+  and _namev = Textvariable.create () in
   let f = Frame.create fw [BorderWidth (Pixels 2)] in
-  let c = Canvas.create f [Width (Pixels (block_size * 10));
-                           Height (Pixels (block_size * 20));
-                           BorderWidth (Pixels cell_border);
-                           Relief Sunken;
-                           Background Black]
+  let c =
+    Canvas.create f
+     [Width (Pixels (block_size * 10));
+      Height (Pixels (block_size * 20));
+      BorderWidth (Pixels cell_border);
+      Relief Sunken;
+      Background Black]
   and r = Frame.create f []
   and r' = Frame.create f [] in
 
   let nl = Label.create r [Text "Next"; Font "variable"] in
-  let nc = Canvas.create r [Width (Pixels (block_size * 4));
-                           Height (Pixels (block_size * 4));
-                           BorderWidth (Pixels cell_border);
-                           Relief Sunken;
-                           Background Black] in
+  let nc =
+    Canvas.create r
+     [Width (Pixels (block_size * 4));
+      Height (Pixels (block_size * 4));
+      BorderWidth (Pixels cell_border);
+      Relief Sunken;
+      Background Black] in
   let scl = Label.create r [Text "Score"; Font "variable"] in
   let sc = Label.create r [TextVariable scorev; Font "variable"] in
   let lnl = Label.create r [Text "Lines"; Font "variable"] in
@@ -245,139 +145,128 @@
   pack [nl; nc] [Side Side_Top];
   pack [scl; sc; lnl; ln; levl; lev; newg; exitg] [Side Side_Top];
 
-  let cells_src = Array.create 20 (Array.create 10 ()) in
+  let cells_src = Array.make_matrix 20 10 () in
   let cells = Array.map (Array.map (fun () ->
-    {tag=
-        (let t1, t2, t3 =
+    {tag =
+      (let t1, t2, t3 =
+         Canvas.create_rectangle c
+           (Pixels (-block_size - 8)) (Pixels (-block_size - 8))
+           (Pixels (-9)) (Pixels (-9)) [],
           Canvas.create_rectangle c
-             (Pixels (-block_size - 8)) (Pixels (-block_size - 8))
-             (Pixels (-9))          (Pixels (-9)) [],
+           (Pixels (-block_size - 10)) (Pixels (-block_size - 10))
+           (Pixels (-11)) (Pixels (-11)) [],
           Canvas.create_rectangle c
-             (Pixels (-block_size - 10)) (Pixels (-block_size - 10))
-             (Pixels (-11))          (Pixels (-11)) [],
-          Canvas.create_rectangle c
-             (Pixels (-block_size - 12)) (Pixels (-block_size - 12))
-             (Pixels (-13))          (Pixels (-13)) []
-        in
-          Canvas.raise_top c t1;
-          Canvas.raise_top c t2;
-          Canvas.lower_bot c t3;
-          t1,t2,t3);
-     color= 0})) cells_src
-  in
-  let nexts_src = Array.create 4 (Array.create 4 ()) in
+           (Pixels (-block_size - 12)) (Pixels (-block_size - 12))
+           (Pixels (-13)) (Pixels (-13)) [] in
+       Canvas.raise_top c t1;
+       Canvas.raise_top c t2;
+       Canvas.lower_bot c t3;
+       t1, t2, t3);
+     color = 0})) cells_src in
+  let nexts_src = Array.make_matrix 4 4 () in
   let nexts =
    Array.map (Array.map (fun () ->
-    {tag=
-       (let t1, t2, t3 =
-          Canvas.create_rectangle nc
-             (Pixels (-block_size - 8)) (Pixels (-block_size - 8))
-             (Pixels (-9))          (Pixels (-9)) [],
-          Canvas.create_rectangle nc
-             (Pixels (-block_size - 10)) (Pixels (-block_size - 10))
-             (Pixels (-11))          (Pixels (-11)) [],
-          Canvas.create_rectangle nc
-             (Pixels (-block_size - 12)) (Pixels (-block_size - 12))
-             (Pixels (-13))          (Pixels (-13)) []
-        in
-          Canvas.raise_top nc t1;
-          Canvas.raise_top nc t2;
-          Canvas.lower_bot nc t3;
-          t1, t2, t3);
-     color= 0})) nexts_src in
+    {tag =
+      (let t1, t2, t3 =
+         Canvas.create_rectangle nc
+           (Pixels (-block_size - 8)) (Pixels (-block_size - 8))
+           (Pixels (-9)) (Pixels (-9)) [],
+         Canvas.create_rectangle nc
+           (Pixels (-block_size - 10)) (Pixels (-block_size - 10))
+           (Pixels (-11)) (Pixels (-11)) [],
+         Canvas.create_rectangle nc
+           (Pixels (-block_size - 12)) (Pixels (-block_size - 12))
+           (Pixels (-13)) (Pixels (-13)) [] in
+       Canvas.raise_top nc t1;
+       Canvas.raise_top nc t2;
+       Canvas.lower_bot nc t3;
+       t1, t2, t3);
+     color = 0})) nexts_src in
   let game_over () = ()
   in
-    [f; c; r; nl; nc; scl; sc; levl; lev; lnl; ln], newg, exitg,
-      (c, cells), (nc, nexts), scorev, linev, levv, game_over
+  [f; c; r; nl; nc; scl; sc; levl; lev; lnl; ln], newg, exitg,
+  (c, cells), (nc, nexts), scorev, linev, levv, game_over
+;;
 
-let cell_get (c, cf) x y =
-  (Array.get (Array.get cf y) x).color
+let cell_get (c, cf) x y = cf.(y).(x).color;;
 
 let cell_set (c, cf) x y col =
-  let cur = Array.get (Array.get cf y) x in
-  let t1,t2,t3 = cur.tag in
-    if cur.color = col then ()
-    else
-    if cur.color <> 0 && col = 0 then
-      begin
+  let cur = cf.(y).(x) in
+  let t1, t2, t3 = cur.tag in
+  if cur.color = col then () else
+  if cur.color <> 0 && col = 0 then begin
+    Canvas.move c t1
+      (Pixels (- block_size * (x + 1) -10 - cell_border * 2))
+      (Pixels (- block_size * (y + 1) -10 - cell_border * 2));
+    Canvas.move c t2
+      (Pixels (- block_size * (x + 1) -10 - cell_border * 2))
+      (Pixels (- block_size * (y + 1) -10 - cell_border * 2));
+    Canvas.move c t3
+      (Pixels (- block_size * (x + 1) -10 - cell_border * 2))
+      (Pixels (- block_size * (y + 1) -10 - cell_border * 2))
+
+  end else begin
+    Canvas.configure_rectangle c t2
+      [FillColor (Array.get colors (col - 1));
+       Outline (Array.get colors (col - 1))];
+    Canvas.configure_rectangle c t1
+      [FillColor Black;
+       Outline Black];
+    Canvas.configure_rectangle c t3
+      [FillColor (NamedColor "light gray");
+       Outline (NamedColor "light gray")];
+    if cur.color = 0 && col <> 0 then begin
       Canvas.move c t1
-                       (Pixels (- block_size * (x + 1) -10 - cell_border * 2))
-                       (Pixels (- block_size * (y + 1) -10 - cell_border * 2));
+        (Pixels (block_size * (x + 1) + 10 + cell_border * 2))
+        (Pixels (block_size * (y + 1) + 10 + cell_border * 2));
       Canvas.move c t2
-                       (Pixels (- block_size * (x + 1) -10 - cell_border * 2))
-                       (Pixels (- block_size * (y + 1) -10 - cell_border * 2));
+        (Pixels (block_size * (x + 1) + 10 + cell_border * 2))
+        (Pixels (block_size * (y + 1) + 10 + cell_border * 2));
       Canvas.move c t3
-                       (Pixels (- block_size * (x + 1) -10 - cell_border * 2))
-                       (Pixels (- block_size * (y + 1) -10 - cell_border * 2))
-      end
-    else
-      begin
-        Canvas.configure_rectangle c t2
-              [FillColor (Array.get colors (col - 1));
-               Outline (Array.get colors (col - 1))];
-        Canvas.configure_rectangle c t1
-              [FillColor Black;
-               Outline Black];
-        Canvas.configure_rectangle c t3
-              [FillColor (NamedColor "light gray");
-               Outline (NamedColor "light gray")];
-        if cur.color = 0 && col <> 0 then
-          begin
-            Canvas.move c t1
-              (Pixels (block_size * (x+1)+10+ cell_border*2))
-              (Pixels (block_size * (y+1)+10+ cell_border*2));
-            Canvas.move c t2
-              (Pixels (block_size * (x+1)+10+ cell_border*2))
-              (Pixels (block_size * (y+1)+10+ cell_border*2));
-            Canvas.move c t3
-              (Pixels (block_size * (x+1)+10+ cell_border*2))
-              (Pixels (block_size * (y+1)+10+ cell_border*2))
-          end
-      end;
-    cur.color <- col
+        (Pixels (block_size * (x + 1) + 10 + cell_border * 2))
+        (Pixels (block_size * (y + 1) + 10 + cell_border * 2))
+    end
+  end;
+  cur.color <- col
+;;
 
 let draw_block field col d x y =
   for iy = 0 to 3 do
     let base = ref 1 in
     let xd = Array.get d iy in
     for ix = 0 to 3 do
-      if xd land !base <> 0 then
-        begin
-          try cell_set field (ix + x) (iy + y) col with _ -> ()
-        end
-      else
-        begin
-        (* cell_set field (ix + x) (iy + y) 0 *) ()
-        end;
+      if xd land !base <> 0 then begin
+        try cell_set field (ix + x) (iy + y) col with _ -> ()
+      end;
       base := !base lsl 1
     done
   done
+;;
 
-let timer_ref = (ref None : Timer.t option ref)
-(* I know, this should be timer ref, but I'm not sure what should be
-   the initial value ... *)
+let timer_ref = (ref None : Timer.t option ref);;
 
 let remove_timer () =
   match !timer_ref with
   | None -> ()
-  | Some t -> Timer.remove t (* ; prerr_endline "removed!" *)
+  | Some t -> Timer.remove t
+;;
 
-let do_after milli f =
-  timer_ref := Some (Timer.add milli f)
+let do_after milli f = timer_ref := Some (Timer.add milli f);;
 
 let copy_block c =
-  { pattern= !c.pattern;
-    bcolor= !c.bcolor;
-    x= !c.x;
-    y= !c.y;
-    d= !c.d;
-    alive= !c.alive }
-
-let _ =
-  let top = opentk () in
+  { pattern = !c.pattern;
+    bcolor = !c.bcolor;
+    x = !c.x;
+    y = !c.y;
+    d = !c.d;
+    alive = !c.alive }
+;;
+
+let start_game () =
+  let top = openTk () in
+  Wm.title_set top "";
   let lb = Label.create top []
-  and fw = Frame.create top []
-  in
+  and fw = Frame.create top [] in
   let set_message s = Label.configure lb [Text s] in
   pack [lb; fw] [Side Side_Top];
   let score = ref 0 in
@@ -385,10 +274,9 @@
   let level = ref 0 in
   let time = ref 1000 in
   let blocks = List.map (List.map decode_block) blocks in
-  let field = Array.create 26 0 in
+  let field = Array.make 26 0 in
   let widgets, newg, exitg, cell_field, next_field,
-      scorev, linev, levv, game_over =
-        init fw in
+      scorev, linev, levv, game_over = init fw in
   let canvas = fst cell_field in
 
   let init_field () =
@@ -405,46 +293,37 @@
       for j = 0 to 3 do
         cell_set next_field j i 0
       done
-    done
-  in
+    done in
 
   let draw_falling_block fb =
     draw_block cell_field fb.bcolor
       (List.nth fb.pattern fb.d) (fb.x - 3) (fb.y - 3)
-
   and erase_falling_block fb =
-    draw_block cell_field 0 (List.nth fb.pattern fb.d) (fb.x - 3) (fb.y - 3)
-  in
+    draw_block cell_field 0 (List.nth fb.pattern fb.d) (fb.x - 3) (fb.y - 3) in
 
   let stone fb =
-    for i=0 to 3 do
+    for i = 0 to 3 do
       let cur = field.(i + fb.y) in
       field.(i + fb.y) <-
          cur lor ((List.nth fb.pattern fb.d).(i) lsl fb.x)
     done;
-    for i=0 to 2 do
-      field.(i) <- line_empty
-    done
+    for i = 0 to 2 do field.(i) <- line_empty done
 
   and clear fb =
     let l = ref 0 in
     for i = 0 to 3 do
-      if i + fb.y >= 3 && i + fb.y <= 22 then
-        if field.(i + fb.y) = line_full then
-          begin
-            incr l;
-            field.(i + fb.y) <- line_empty;
-            for j = 0 to 9 do
-              cell_set cell_field j (i + fb.y - 3) 0
-            done
-          end
+      if i + fb.y >= 3 && i + fb.y <= 22 &&
+         field.(i + fb.y) = line_full then begin
+        incr l;
+        field.(i + fb.y) <- line_empty;
+        for j = 0 to 9 do cell_set cell_field j (i + fb.y - 3) 0 done
+      end
     done;
     !l
 
   and fall_lines () =
     let eye = ref 22 (* bottom *)
-    and cur = ref 22 (* bottom *)
-    in
+    and cur = ref 22 (* bottom *) in
     try
       while !eye >= 3 do
         while field.(!eye) = line_empty do
@@ -461,33 +340,28 @@
     with Done -> ();
       for i = 3 to !cur do
         field.(i) <- line_empty;
-        for j = 0 to 9 do
-          cell_set cell_field j (i-3) 0
-        done
-      done
- in
+        for j = 0 to 9 do cell_set cell_field j (i - 3) 0 done
+      done in
 
   let next = ref 42 (* THE ANSWER *)
   and current =
-    ref { pattern= [[|0;0;0;0|]]; bcolor=0; x=0; y=0; d=0; alive= false}
-  in
+    ref { pattern= [[|0; 0; 0; 0|]];
+          bcolor = 0; x = 0; y = 0; d = 0; alive = false} in
 
   let draw_next () =
-    draw_block next_field (!next+1) (List.hd (List.nth blocks !next)) 0 0
+    draw_block next_field (!next + 1) (List.hd (List.nth blocks !next)) 0 0
 
   and erase_next () =
-    draw_block next_field 0 (List.hd (List.nth blocks !next)) 0 0
-  in
+    draw_block next_field 0 (List.hd (List.nth blocks !next)) 0 0 in
 
   let set_nextblock () =
     current :=
-       { pattern= (List.nth blocks !next);
-         bcolor= !next+1;
-         x=6; y= 1; d= 0; alive= true};
+       { pattern = (List.nth blocks !next);
+         bcolor = !next + 1;
+         x = 6; y = 1; d = 0; alive = true};
     erase_next ();
     next := Random.int 7;
-    draw_next ()
-  in
+    draw_next () in
 
   let death_check fb =
     try
@@ -498,8 +372,7 @@
       done;
       false
     with
-      Done -> true
-  in
+      Done -> true in
 
   let try_to_move m =
     if !current.alive then
@@ -511,40 +384,29 @@
             draw_falling_block m;
             current := m;
             true
-          end
-      in
-      if sub m then ()
-      else
-        begin
-          m.x <- m.x + 1;
-          if sub m then ()
-          else
-            begin
-              m.x <- m.x - 2;
-              ignore (sub m)
-            end
+          end in
+      if sub m then () else begin
+        m.x <- m.x + 1;
+        if sub m then () else begin
+          m.x <- m.x - 2;
+          ignore (sub m)
         end
-    else ()
-  in
+      end
+    else () in
 
   let image_load =
-    let i = Canvas.create_image canvas
-            (Pixels (block_size * 5 + block_size / 2))
-            (Pixels (block_size * 10 + block_size / 2))
-                [Anchor Center] in
+    let i =
+      Canvas.create_image canvas
+        (Pixels (block_size * 5 + block_size / 2))
+        (Pixels (block_size * 10 + block_size / 2))
+        [Anchor Center] in
     Canvas.lower_bot canvas i;
     let img = Imagephoto.create [] in
     fun file ->
       try
         Imagephoto.configure img [File file];
         Canvas.configure_image canvas i [ImagePhoto img]
-      with
-        _ ->
-          begin
-            Printf.eprintf "%s : No such image...\n" file;
-            flush stderr
-          end
-  in
+      with _ -> Printf.eprintf "%s : No such image...\n" file; flush stderr in
 
   let add_score l =
     let pline = !line in
@@ -557,62 +419,53 @@
     Textvariable.set linev (string_of_int !line);
     Textvariable.set scorev (string_of_int !score);
 
-    if !line /10 <> pline /10 then
+    if !line / 10 <> pline / 10 then
       (* update the background every 10 lines. *)
       begin
         let num_image = List.length backgrounds - 1 in
-        let n = !line/10 in
+        let n = !line / 10 in
         let n = if n > num_image then num_image else n in
         let file = List.nth backgrounds n in
         image_load file;
         (* Future work: We should gain level after an image is put... *)
         incr level;
         Textvariable.set levv (string_of_int !level)
-      end
-  in
+      end in
 
   let rec newblock () =
     set_message "TETRIS";
     set_nextblock ();
     draw_falling_block !current;
-    if death_check !current then
-      begin
+    if death_check !current then begin
         !current.alive <- false;
         set_message "GAME OVER";
         game_over ()
-      end
-    else
-      begin
-        time := 1100 - (!level / 4 * 300) - ((!level mod 4) * 200);
-        if !time < 60 - !level * 3 then time := 60 - !level * 3;
-        do_after stop_a_bit loop
-      end
+    end else begin
+      time := 1100 - (!level / 4 * 300) - ((!level mod 4) * 200);
+      if !time < 60 - !level * 3 then time := 60 - !level * 3;
+      do_after stop_a_bit loop
+    end
 
   and loop () =
     let m = copy_block current in
     m.y <- m.y + 1;
-    if death_check m then
-      begin
-        !current.alive <- false;
-        stone !current;
-        do_after stop_a_bit (fun () ->
-          let l = clear !current in
-            if l > 0 then
-              do_after stop_a_bit (fun () ->
-                fall_lines ();
-                add_score l;
-                do_after stop_a_bit newblock)
-            else
-              newblock ())
-      end
-    else
-      begin
-        erase_falling_block !current;
-        draw_falling_block m;
-        current := m;
-        do_after !time loop
-      end
-  in
+    if death_check m then begin
+      !current.alive <- false;
+      stone !current;
+      do_after stop_a_bit (fun () ->
+        let l = clear !current in
+        if l > 0 then
+          do_after stop_a_bit (fun () ->
+            fall_lines ();
+            add_score l;
+            do_after stop_a_bit newblock)
+        else newblock ())
+    end else begin
+      erase_falling_block !current;
+      draw_falling_block m;
+      current := m;
+      do_after !time loop
+    end in
 
   let bind_game w =
     bind w [([], KeyPress)] (BindSet ([Ev_KeySymString],
@@ -656,8 +509,7 @@
                 loop ()
               end
         | _ -> ()
-      ))
-  in
+      )) in
 
   let game_init () =
     (* Game Initialization *)
@@ -674,11 +526,17 @@
     set_message "Welcome to TETRIS";
     set_nextblock ();
     draw_falling_block !current;
-    do_after !time loop
-  in
-   bind_game top;
-   Button.configure newg [Command game_init];
-   Button.configure exitg [Command (fun () -> closeTk (); exit 0)];
-   game_init ()
+    do_after !time loop in
+
+  bind_game top;
+  Button.configure newg [Command game_init];
+  Button.configure exitg [Command (fun () -> exit 0)];
+  game_init ()
+;;
+
+let tetris () =
+ start_game ();
+ Printexc.print mainLoop ()
+;;
 
-let _ = Printexc.print mainLoop ()
+if !Sys.interactive then () else begin tetris (); exit 0 end;;
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_camltk/text.ml ocaml-4.01.0/otherlibs/labltk/examples_camltk/text.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_camltk/text.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_camltk/text.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Tk
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_camltk/winskel.ml ocaml-4.01.0/otherlibs/labltk/examples_camltk/winskel.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_camltk/winskel.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_camltk/winskel.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 (* This examples is based on Ousterhout's book (fig 16.15) *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_labltk/.cvsignore ocaml-4.01.0/otherlibs/labltk/examples_labltk/.cvsignore
--- ocaml-3.12.1/otherlibs/labltk/examples_labltk/.cvsignore	2002-12-19 13:38:29.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_labltk/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,8 +0,0 @@
-calc
-clock
-demo
-eyes
-hello
-tetris
-lang
-taquin
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_labltk/.ignore ocaml-4.01.0/otherlibs/labltk/examples_labltk/.ignore
--- ocaml-3.12.1/otherlibs/labltk/examples_labltk/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_labltk/.ignore	2012-07-17 15:31:12.000000000 +0000
@@ -0,0 +1,8 @@
+calc
+clock
+demo
+eyes
+hello
+tetris
+lang
+taquin
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_labltk/Makefile ocaml-4.01.0/otherlibs/labltk/examples_labltk/Makefile
--- ocaml-3.12.1/otherlibs/labltk/examples_labltk/Makefile	2002-12-19 13:38:29.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_labltk/Makefile	2012-08-02 08:17:59.000000000 +0000
@@ -1,3 +1,19 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include ../support/Makefile.common
 
 COMPFLAGS=-I ../lib -I ../labltk -I ../support -I $(OTHERS)/unix -w s -dllpath ../support
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_labltk/Makefile.nt ocaml-4.01.0/otherlibs/labltk/examples_labltk/Makefile.nt
--- ocaml-3.12.1/otherlibs/labltk/examples_labltk/Makefile.nt	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_labltk/Makefile.nt	2012-08-02 08:17:59.000000000 +0000
@@ -1,3 +1,19 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include ../support/Makefile.common
 
 # We are using the non-installed library !
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_labltk/README ocaml-4.01.0/otherlibs/labltk/examples_labltk/README
--- ocaml-3.12.1/otherlibs/labltk/examples_labltk/README	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_labltk/README	2012-08-02 08:17:59.000000000 +0000
@@ -1,4 +1,4 @@
-$Id: README 4745 2002-04-26 12:16:26Z furuse $
+$Id$
 
 Some examples for LablTk.
 They are written in classic mode, except testris.ml which uses label
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_labltk/calc.ml ocaml-4.01.0/otherlibs/labltk/examples_labltk/calc.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_labltk/calc.ml	2002-10-11 19:01:19.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_labltk/calc.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: calc.ml 5175 2002-10-11 19:01:19Z doligez $ *)
+(* $Id$ *)
 
 (* A simple calculator demonstrating OO programming with O'Labl
    and LablTk.
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_labltk/clock.ml ocaml-4.01.0/otherlibs/labltk/examples_labltk/clock.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_labltk/clock.ml	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_labltk/clock.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: clock.ml 4745 2002-04-26 12:16:26Z furuse $ *)
+(* $Id$ *)
 
 (* Clock/V, a simple clock.
    Reverts every time you push the right button.
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_labltk/demo.ml ocaml-4.01.0/otherlibs/labltk/examples_labltk/demo.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_labltk/demo.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_labltk/demo.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: demo.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 (* Some CamlTk4 Demonstration by JPF *)
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_labltk/eyes.ml ocaml-4.01.0/otherlibs/labltk/examples_labltk/eyes.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_labltk/eyes.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_labltk/eyes.ml	2013-02-27 17:45:59.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: eyes.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open Tk
 
@@ -24,7 +24,7 @@
   pack [fw];
   let c = Canvas.create ~width: 200 ~height: 200 fw in
   let create_eye cx cy wx wy ewx ewy bnd =
-    let o2 = Canvas.create_oval
+    let _o2 = Canvas.create_oval
         ~x1:(cx - wx) ~y1:(cy - wy)
         ~x2:(cx + wx) ~y2:(cy + wy)
         ~outline: `Black ~width: 7
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_labltk/hello.ml ocaml-4.01.0/otherlibs/labltk/examples_labltk/hello.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_labltk/hello.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_labltk/hello.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: hello.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 (* LablTk4 Demonstration by JPF *)
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_labltk/hello.tcl ocaml-4.01.0/otherlibs/labltk/examples_labltk/hello.tcl
--- ocaml-3.12.1/otherlibs/labltk/examples_labltk/hello.tcl	2003-08-21 13:51:29.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_labltk/hello.tcl	2012-08-02 08:17:59.000000000 +0000
@@ -1,5 +1,21 @@
 #!/usr/bin/wish
 
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 button .hello -text "Hello, TclTk!"
 
 pack .hello
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_labltk/lang.ml ocaml-4.01.0/otherlibs/labltk/examples_labltk/lang.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_labltk/lang.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_labltk/lang.ml	2012-07-30 18:04:46.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_labltk/taquin.ml ocaml-4.01.0/otherlibs/labltk/examples_labltk/taquin.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_labltk/taquin.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_labltk/taquin.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: taquin.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open Tk;;
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/examples_labltk/tetris.ml ocaml-4.01.0/otherlibs/labltk/examples_labltk/tetris.ml
--- ocaml-3.12.1/otherlibs/labltk/examples_labltk/tetris.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/examples_labltk/tetris.ml	2013-02-27 17:45:59.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: tetris.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 (* A Tetris game for LablTk *)
 (* written by Jun P. Furuse *)
@@ -268,7 +268,6 @@
   let scorev = Textvariable.create ()
   and linev = Textvariable.create ()
   and levv = Textvariable.create ()
-  and namev = Textvariable.create ()
   in
   let f = Frame.create fw ~borderwidth: 2 in
   let c = Canvas.create f ~width: (block_size * 10)
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/.cvsignore ocaml-4.01.0/otherlibs/labltk/frx/.cvsignore
--- ocaml-3.12.1/otherlibs/labltk/frx/.cvsignore	2010-01-20 16:26:46.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1 +0,0 @@
-*.a
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/Makefile ocaml-4.01.0/otherlibs/labltk/frx/Makefile
--- ocaml-3.12.1/otherlibs/labltk/frx/Makefile	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/Makefile	2012-07-17 15:31:12.000000000 +0000
@@ -1,3 +1,19 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include ../support/Makefile.common
 
 COMPFLAGS=-I ../camltk -I ../support
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/Makefile.nt ocaml-4.01.0/otherlibs/labltk/frx/Makefile.nt
--- ocaml-3.12.1/otherlibs/labltk/frx/Makefile.nt	2007-11-06 15:16:56.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/Makefile.nt	2012-08-02 08:17:59.000000000 +0000
@@ -1 +1,17 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include Makefile
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/README ocaml-4.01.0/otherlibs/labltk/frx/README
--- ocaml-3.12.1/otherlibs/labltk/frx/README	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/README	2012-08-02 08:17:59.000000000 +0000
@@ -1,2 +1,2 @@
 This is Francois Rouaix's widget set library, Frx.
-It uses CamlTk API.
\ No newline at end of file
+It uses CamlTk API.
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_after.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_after.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_after.ml	2002-07-23 14:12:03.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_after.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Protocol
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_after.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_after.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_after.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_after.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 val idle : (unit -> unit) -> unit
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_color.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_color.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_color.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_color.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_color.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_color.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_color.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_color.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 val check : string -> bool
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_ctext.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_ctext.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_ctext.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_ctext.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 (* A trick by Steve Ball to do pixel scrolling on text widgets *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_ctext.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_ctext.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_ctext.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_ctext.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_dialog.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_dialog.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_dialog.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_dialog.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_dialog.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_dialog.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_dialog.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_dialog.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_entry.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_entry.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_entry.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_entry.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,12 +10,12 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
 
-let version = "$Id: frx_entry.ml 9547 2010-01-22 12:48:24Z doligez $"
+let version = "$Id$"
 
 (*
  * Tk 4.0 has emacs bindings for entry widgets
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_entry.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_entry.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_entry.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_entry.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_fileinput.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_fileinput.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_fileinput.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_fileinput.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,12 +10,12 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
 
-let version = "$Id: frx_fileinput.ml 9547 2010-01-22 12:48:24Z doligez $"
+let version = "$Id$"
 
 (*
  * Simple spooling for fileinput callbacks
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_fillbox.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_fillbox.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_fillbox.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_fillbox.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_fillbox.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_fillbox.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_fillbox.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_fillbox.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_fit.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_fit.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_fit.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_fit.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_fit.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_fit.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_fit.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_fit.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_focus.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_focus.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_focus.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_focus.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_focus.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_focus.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_focus.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_focus.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_font.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_font.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_font.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_font.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,13 +10,13 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
 open Widget
 
-let version = "$Id: frx_font.ml 9547 2010-01-22 12:48:24Z doligez $"
+let version = "$Id$"
 
 (*
  * Finding fonts. Inspired by code in Ical by Sanjay Ghemawat.
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_font.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_font.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_font.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_font.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 val find : string -> string -> string -> int -> string
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_group.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_group.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_group.ml	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_group.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_lbutton.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_lbutton.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_lbutton.ml	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_lbutton.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
@@ -18,7 +18,7 @@
 open Widget
 
 
-let version = "$Id: frx_lbutton.ml 4745 2002-04-26 12:16:26Z furuse $"
+let version = "$Id$"
 
 (*
  * Simulate a button with a bitmap AND a label
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_lbutton.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_lbutton.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_lbutton.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_lbutton.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Widget
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_listbox.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_listbox.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_listbox.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_listbox.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,12 +10,12 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
 
-let version = "$Id: frx_listbox.ml 9547 2010-01-22 12:48:24Z doligez $"
+let version = "$Id$"
 
 (*
  * Link a scrollbar and a listbox
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_listbox.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_listbox.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_listbox.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_listbox.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_mem.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_mem.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_mem.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_mem.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 (* Memory gauge *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_mem.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_mem.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_mem.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_mem.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,10 +10,10 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
-(* A Garbage Collector Gauge for Caml *)
+(* A Garbage Collector Gauge for OCaml *)
 
 val init : unit -> unit
   (* [init ()] creates the gauge and its updater, but keeps it iconified *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_misc.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_misc.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_misc.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_misc.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 (* Delayed global, a.k.a cache&carry *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_misc.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_misc.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_misc.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_misc.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_req.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_req.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_req.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_req.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
@@ -20,7 +20,7 @@
  * jargon).
 *)
 
-let version = "$Id: frx_req.ml 9547 2010-01-22 12:48:24Z doligez $"
+let version = "$Id$"
 
 (*
  * Simple requester
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_req.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_req.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_req.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_req.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 (* Various dialog boxes *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_rpc.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_rpc.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_rpc.ml	2002-07-23 14:12:03.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_rpc.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 (* Some notion of RPC *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_rpc.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_rpc.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_rpc.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_rpc.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 (* Some notion of RPC *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_selection.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_selection.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_selection.ml	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_selection.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 (* A selection handler *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_selection.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_selection.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_selection.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_selection.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 val set : string -> unit
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_synth.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_synth.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_synth.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_synth.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 (* Some notion of synthetic events *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_synth.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_synth.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_synth.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_synth.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 (* Synthetic events *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_text.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_text.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_text.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_text.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,12 +10,12 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
 
-let version = "$Id: frx_text.ml 9547 2010-01-22 12:48:24Z doligez $"
+let version = "$Id$"
 
 (*
  * convert an integer to an absolute index
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_text.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_text.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_text.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_text.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_toplevel.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_toplevel.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_toplevel.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_toplevel.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Widget
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_widget.ml ocaml-4.01.0/otherlibs/labltk/frx/frx_widget.ml
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_widget.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_widget.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,13 +10,13 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
 open Widget
 
-let version = "$Id: frx_widget.ml 9547 2010-01-22 12:48:24Z doligez $"
+let version = "$Id$"
 (* Make a window (toplevel widget) resizeable *)
 let resizeable t =
   update_idletasks(); (* wait until layout is computed *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/frx/frx_widget.mli ocaml-4.01.0/otherlibs/labltk/frx/frx_widget.mli
--- ocaml-3.12.1/otherlibs/labltk/frx/frx_widget.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/frx/frx_widget.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Camltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/jpf/.cvsignore ocaml-4.01.0/otherlibs/labltk/jpf/.cvsignore
--- ocaml-3.12.1/otherlibs/labltk/jpf/.cvsignore	2010-01-20 16:26:46.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/jpf/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1 +0,0 @@
-*.a
diff -Nru ocaml-3.12.1/otherlibs/labltk/jpf/Makefile ocaml-4.01.0/otherlibs/labltk/jpf/Makefile
--- ocaml-3.12.1/otherlibs/labltk/jpf/Makefile	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/jpf/Makefile	2012-07-17 15:31:12.000000000 +0000
@@ -1,3 +1,19 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 1999 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include ../support/Makefile.common
 
 COMPFLAGS=-I ../labltk -I ../support -I $(OTHERS)/win32unix -I $(OTHERS)/unix -I $(OTHERS)/str
diff -Nru ocaml-3.12.1/otherlibs/labltk/jpf/Makefile.nt ocaml-4.01.0/otherlibs/labltk/jpf/Makefile.nt
--- ocaml-3.12.1/otherlibs/labltk/jpf/Makefile.nt	2007-11-06 15:16:56.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/jpf/Makefile.nt	2012-08-02 08:17:59.000000000 +0000
@@ -1 +1,17 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include Makefile
diff -Nru ocaml-3.12.1/otherlibs/labltk/jpf/balloon.ml ocaml-4.01.0/otherlibs/labltk/jpf/balloon.ml
--- ocaml-3.12.1/otherlibs/labltk/jpf/balloon.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/jpf/balloon.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: balloon.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open StdLabels
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/jpf/balloon.mli ocaml-4.01.0/otherlibs/labltk/jpf/balloon.mli
--- ocaml-3.12.1/otherlibs/labltk/jpf/balloon.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/jpf/balloon.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: balloon.mli 4745 2002-04-26 12:16:26Z furuse $ *)
+(* $Id$ *)
 
 (* easy balloon help facility *)
 open Widget
diff -Nru ocaml-3.12.1/otherlibs/labltk/jpf/balloontest.ml ocaml-4.01.0/otherlibs/labltk/jpf/balloontest.ml
--- ocaml-3.12.1/otherlibs/labltk/jpf/balloontest.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/jpf/balloontest.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: balloontest.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open Tk
 open Widget
diff -Nru ocaml-3.12.1/otherlibs/labltk/jpf/fileselect.ml ocaml-4.01.0/otherlibs/labltk/jpf/fileselect.ml
--- ocaml-3.12.1/otherlibs/labltk/jpf/fileselect.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/jpf/fileselect.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: fileselect.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 (* file selection box *)
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/jpf/fileselect.mli ocaml-4.01.0/otherlibs/labltk/jpf/fileselect.mli
--- ocaml-3.12.1/otherlibs/labltk/jpf/fileselect.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/jpf/fileselect.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: fileselect.mli 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 (* This file selecter works only under the OS with the full unix support.
    For the portability, Tk.getOpenFile and Tk.getSaveFile are recommended. *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/jpf/jpf_font.ml ocaml-4.01.0/otherlibs/labltk/jpf/jpf_font.ml
--- ocaml-3.12.1/otherlibs/labltk/jpf/jpf_font.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/jpf/jpf_font.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 (* find font information *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/jpf/jpf_font.mli ocaml-4.01.0/otherlibs/labltk/jpf/jpf_font.mli
--- ocaml-3.12.1/otherlibs/labltk/jpf/jpf_font.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/jpf/jpf_font.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 val debug : bool ref
diff -Nru ocaml-3.12.1/otherlibs/labltk/jpf/shell.ml ocaml-4.01.0/otherlibs/labltk/jpf/shell.ml
--- ocaml-3.12.1/otherlibs/labltk/jpf/shell.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/jpf/shell.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 open Unix
diff -Nru ocaml-3.12.1/otherlibs/labltk/jpf/shell.mli ocaml-4.01.0/otherlibs/labltk/jpf/shell.mli
--- ocaml-3.12.1/otherlibs/labltk/jpf/shell.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/jpf/shell.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 val subshell : string -> string list
diff -Nru ocaml-3.12.1/otherlibs/labltk/labltk/.cvsignore ocaml-4.01.0/otherlibs/labltk/labltk/.cvsignore
--- ocaml-3.12.1/otherlibs/labltk/labltk/.cvsignore	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/labltk/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,3 +0,0 @@
-*.ml *.mli labltktop labltk
-modules
-.depend
diff -Nru ocaml-3.12.1/otherlibs/labltk/labltk/.ignore ocaml-4.01.0/otherlibs/labltk/labltk/.ignore
--- ocaml-3.12.1/otherlibs/labltk/labltk/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/labltk/.ignore	2012-07-17 15:31:12.000000000 +0000
@@ -0,0 +1,4 @@
+*.ml
+*.mli
+labltktop
+labltk
diff -Nru ocaml-3.12.1/otherlibs/labltk/labltk/Makefile ocaml-4.01.0/otherlibs/labltk/labltk/Makefile
--- ocaml-3.12.1/otherlibs/labltk/labltk/Makefile	2007-12-12 14:09:45.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/labltk/Makefile	2012-07-17 15:31:12.000000000 +0000
@@ -1,3 +1,19 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include ../support/Makefile.common
 
 COMPFLAGS= -I ../support -I $(OTHERS)/win32unix -I $(OTHERS)/unix
diff -Nru ocaml-3.12.1/otherlibs/labltk/labltk/Makefile.gen ocaml-4.01.0/otherlibs/labltk/labltk/Makefile.gen
--- ocaml-3.12.1/otherlibs/labltk/labltk/Makefile.gen	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/labltk/Makefile.gen	2012-07-17 15:31:12.000000000 +0000
@@ -1,3 +1,19 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include ../support/Makefile.common
 
 all: tk.ml labltk.ml .depend
diff -Nru ocaml-3.12.1/otherlibs/labltk/labltk/Makefile.gen.nt ocaml-4.01.0/otherlibs/labltk/labltk/Makefile.gen.nt
--- ocaml-3.12.1/otherlibs/labltk/labltk/Makefile.gen.nt	2007-11-06 15:16:56.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/labltk/Makefile.gen.nt	2012-08-02 08:17:59.000000000 +0000
@@ -1 +1,17 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include Makefile.gen
diff -Nru ocaml-3.12.1/otherlibs/labltk/labltk/Makefile.nt ocaml-4.01.0/otherlibs/labltk/labltk/Makefile.nt
--- ocaml-3.12.1/otherlibs/labltk/labltk/Makefile.nt	2007-11-06 15:16:56.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/labltk/Makefile.nt	2012-08-02 08:17:59.000000000 +0000
@@ -1 +1,17 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include Makefile
diff -Nru ocaml-3.12.1/otherlibs/labltk/labltk/modules ocaml-4.01.0/otherlibs/labltk/labltk/modules
--- ocaml-3.12.1/otherlibs/labltk/labltk/modules	2002-04-26 13:58:17.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/labltk/modules	2012-08-09 06:05:28.000000000 +0000
@@ -1,77 +1,77 @@
-WIDGETOBJS=place.cmo wm.cmo imagephoto.cmo canvas.cmo button.cmo text.cmo label.cmo scrollbar.cmo image.cmo encoding.cmo pixmap.cmo palette.cmo font.cmo message.cmo menu.cmo entry.cmo listbox.cmo focus.cmo menubutton.cmo pack.cmo option.cmo toplevel.cmo frame.cmo dialog.cmo imagebitmap.cmo clipboard.cmo radiobutton.cmo tkwait.cmo grab.cmo selection.cmo scale.cmo optionmenu.cmo winfo.cmo grid.cmo checkbutton.cmo bell.cmo tkvars.cmo 
-place.ml wm.ml imagephoto.ml canvas.ml button.ml text.ml label.ml scrollbar.ml image.ml encoding.ml pixmap.ml palette.ml font.ml message.ml menu.ml entry.ml listbox.ml focus.ml menubutton.ml pack.ml option.ml toplevel.ml frame.ml dialog.ml imagebitmap.ml clipboard.ml radiobutton.ml tkwait.ml grab.ml selection.ml scale.ml optionmenu.ml winfo.ml grid.ml checkbutton.ml bell.ml tkvars.ml : _tkgen.ml
+WIDGETOBJS= bell.cmo scale.cmo winfo.cmo scrollbar.cmo entry.cmo listbox.cmo wm.cmo tkwait.cmo grab.cmo font.cmo canvas.cmo image.cmo clipboard.cmo label.cmo message.cmo text.cmo imagephoto.cmo option.cmo frame.cmo selection.cmo dialog.cmo place.cmo pixmap.cmo menubutton.cmo radiobutton.cmo focus.cmo pack.cmo imagebitmap.cmo encoding.cmo optionmenu.cmo checkbutton.cmo tkvars.cmo palette.cmo menu.cmo button.cmo toplevel.cmo grid.cmo
+bell.ml scale.ml winfo.ml scrollbar.ml entry.ml listbox.ml wm.ml tkwait.ml grab.ml font.ml canvas.ml image.ml clipboard.ml label.ml message.ml text.ml imagephoto.ml option.ml frame.ml selection.ml dialog.ml place.ml pixmap.ml menubutton.ml radiobutton.ml focus.ml pack.ml imagebitmap.ml encoding.ml optionmenu.ml checkbutton.ml tkvars.ml palette.ml menu.ml button.ml toplevel.ml grid.ml : _tkgen.ml
 
-place.cmo : place.ml
-place.cmi : place.mli
+bell.cmo : bell.ml
+bell.cmi : bell.mli
+scale.cmo : scale.ml
+scale.cmi : scale.mli
+winfo.cmo : winfo.ml
+winfo.cmi : winfo.mli
+scrollbar.cmo : scrollbar.ml
+scrollbar.cmi : scrollbar.mli
+entry.cmo : entry.ml
+entry.cmi : entry.mli
+listbox.cmo : listbox.ml
+listbox.cmi : listbox.mli
 wm.cmo : wm.ml
 wm.cmi : wm.mli
-imagephoto.cmo : imagephoto.ml
-imagephoto.cmi : imagephoto.mli
+tkwait.cmo : tkwait.ml
+tkwait.cmi : tkwait.mli
+grab.cmo : grab.ml
+grab.cmi : grab.mli
+font.cmo : font.ml
+font.cmi : font.mli
 canvas.cmo : canvas.ml
 canvas.cmi : canvas.mli
-button.cmo : button.ml
-button.cmi : button.mli
-text.cmo : text.ml
-text.cmi : text.mli
-label.cmo : label.ml
-label.cmi : label.mli
-scrollbar.cmo : scrollbar.ml
-scrollbar.cmi : scrollbar.mli
 image.cmo : image.ml
 image.cmi : image.mli
-encoding.cmo : encoding.ml
-encoding.cmi : encoding.mli
-pixmap.cmo : pixmap.ml
-pixmap.cmi : pixmap.mli
-palette.cmo : palette.ml
-palette.cmi : palette.mli
-font.cmo : font.ml
-font.cmi : font.mli
+clipboard.cmo : clipboard.ml
+clipboard.cmi : clipboard.mli
+label.cmo : label.ml
+label.cmi : label.mli
 message.cmo : message.ml
 message.cmi : message.mli
-menu.cmo : menu.ml
-menu.cmi : menu.mli
-entry.cmo : entry.ml
-entry.cmi : entry.mli
-listbox.cmo : listbox.ml
-listbox.cmi : listbox.mli
-focus.cmo : focus.ml
-focus.cmi : focus.mli
-menubutton.cmo : menubutton.ml
-menubutton.cmi : menubutton.mli
-pack.cmo : pack.ml
-pack.cmi : pack.mli
+text.cmo : text.ml
+text.cmi : text.mli
+imagephoto.cmo : imagephoto.ml
+imagephoto.cmi : imagephoto.mli
 option.cmo : option.ml
 option.cmi : option.mli
-toplevel.cmo : toplevel.ml
-toplevel.cmi : toplevel.mli
 frame.cmo : frame.ml
 frame.cmi : frame.mli
+selection.cmo : selection.ml
+selection.cmi : selection.mli
 dialog.cmo : dialog.ml
 dialog.cmi : dialog.mli
-imagebitmap.cmo : imagebitmap.ml
-imagebitmap.cmi : imagebitmap.mli
-clipboard.cmo : clipboard.ml
-clipboard.cmi : clipboard.mli
+place.cmo : place.ml
+place.cmi : place.mli
+pixmap.cmo : pixmap.ml
+pixmap.cmi : pixmap.mli
+menubutton.cmo : menubutton.ml
+menubutton.cmi : menubutton.mli
 radiobutton.cmo : radiobutton.ml
 radiobutton.cmi : radiobutton.mli
-tkwait.cmo : tkwait.ml
-tkwait.cmi : tkwait.mli
-grab.cmo : grab.ml
-grab.cmi : grab.mli
-selection.cmo : selection.ml
-selection.cmi : selection.mli
-scale.cmo : scale.ml
-scale.cmi : scale.mli
+focus.cmo : focus.ml
+focus.cmi : focus.mli
+pack.cmo : pack.ml
+pack.cmi : pack.mli
+imagebitmap.cmo : imagebitmap.ml
+imagebitmap.cmi : imagebitmap.mli
+encoding.cmo : encoding.ml
+encoding.cmi : encoding.mli
 optionmenu.cmo : optionmenu.ml
 optionmenu.cmi : optionmenu.mli
-winfo.cmo : winfo.ml
-winfo.cmi : winfo.mli
-grid.cmo : grid.ml
-grid.cmi : grid.mli
 checkbutton.cmo : checkbutton.ml
 checkbutton.cmi : checkbutton.mli
-bell.cmo : bell.ml
-bell.cmi : bell.mli
 tkvars.cmo : tkvars.ml
 tkvars.cmi : tkvars.mli
+palette.cmo : palette.ml
+palette.cmi : palette.mli
+menu.cmo : menu.ml
+menu.cmi : menu.mli
+button.cmo : button.ml
+button.cmi : button.mli
+toplevel.cmo : toplevel.ml
+toplevel.cmi : toplevel.mli
+grid.cmo : grid.ml
+grid.cmi : grid.mli
diff -Nru ocaml-3.12.1/otherlibs/labltk/lib/.cvsignore ocaml-4.01.0/otherlibs/labltk/lib/.cvsignore
--- ocaml-3.12.1/otherlibs/labltk/lib/.cvsignore	2010-01-20 16:26:46.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/lib/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,8 +0,0 @@
-labltktop labltk mltktop mltk
-.depend
-*.ml
-*.mli
-modules
-labltk.cma
-labltk.cmxa
-*.a
diff -Nru ocaml-3.12.1/otherlibs/labltk/lib/.ignore ocaml-4.01.0/otherlibs/labltk/lib/.ignore
--- ocaml-3.12.1/otherlibs/labltk/lib/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/lib/.ignore	2012-07-17 15:31:12.000000000 +0000
@@ -0,0 +1,7 @@
+labltktop
+labltk
+mltktop
+mltk
+.depend
+*.ml
+*.mli
diff -Nru ocaml-3.12.1/otherlibs/labltk/lib/Makefile ocaml-4.01.0/otherlibs/labltk/lib/Makefile
--- ocaml-3.12.1/otherlibs/labltk/lib/Makefile	2010-06-08 00:54:09.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/lib/Makefile	2012-09-30 12:31:27.000000000 +0000
@@ -1,3 +1,19 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 1999 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include ../support/Makefile.common
 
 all: $(LIBNAME).cma $(LIBNAME)top$(EXE) $(LIBNAME)
@@ -5,7 +21,7 @@
 opt: $(LIBNAME).cmxa
 
 clean:
-	rm -f $(LIBNAME)top$(EXE) $(LIBNAME) *.cm* *.$(A)
+	rm -f $(LIBNAME)top$(EXE) $(LIBNAME) *.cm* *.$(A) *$(EXT_DLL)
 
 superclean:
 	- if test -f tk.cmo; then \
@@ -26,7 +42,13 @@
 
 TKOBJS=$(SUPPORT) $(LABLTKOBJS) $(CAMLTKOBJS)
 
-TOPDEPS = $(TOPDIR)/toplevel/toplevellib.cma $(TOPDIR)/toplevel/topmain.cmo
+TOPLEVELLIBS=$(TOPDIR)/compilerlibs/ocamlcommon.cma \
+             $(TOPDIR)/compilerlibs/ocamlbytecomp.cma \
+             $(TOPDIR)/compilerlibs/ocamltoplevel.cma
+
+TOPLEVELSTART=$(TOPDIR)/toplevel/topstart.cmo
+
+TOPDEPS = $(TOPLEVELLIBS) $(TOPLEVELSTART)
 
 $(LIBNAME).cma: $(SUPPORT) ../Widgets.src
 	$(MAKE) superclean
@@ -34,7 +56,7 @@
 	cd ../camltk; $(MAKE)
 	$(MKLIB) -ocamlc '$(CAMLCB)' -o $(LIBNAME) \
 	  -I ../labltk -I ../camltk $(TKOBJS) \
-	  -ccopt "\"$(TK_LINK)\""
+	  -cclib "\"$(TK_LINK)\""
 
 $(LIBNAME).cmxa: $(SUPPORT:.cmo=.cmx) ../Widgets.src
 	$(MAKE) superclean
@@ -42,20 +64,20 @@
 	cd ../camltk; $(MAKE) opt
 	$(MKLIB) -ocamlopt '$(CAMLOPTB)' -o $(LIBNAME) -oc $(LIBNAME) \
 	  -I ../labltk -I ../camltk $(TKOBJS:.cmo=.cmx) \
-	  -ccopt "\"$(TK_LINK)\""
+	  -cclib "\"$(TK_LINK)\""
 
 $(LIBNAME)top$(EXE) : $(TOPDEPS) $(LIBNAME).cma ../support/lib$(LIBNAME).$(A)
 	$(CAMLC) -verbose -linkall -o $(LIBNAME)top$(EXE) -I ../support \
-	       -I $(TOPDIR)/toplevel toplevellib.cma \
+	       $(TOPLEVELLIBS) \
 	       -I $(OTHERS)/unix -I $(OTHERS)/win32unix unix.cma \
 	       -I ../labltk -I ../camltk $(LIBNAME).cma \
 	       -I $(OTHERS)/str str.cma \
-	       topstart.cmo
+	       $(TOPLEVELSTART)
 
 $(LIBNAME): Makefile $(TOPDIR)/config/Makefile
 	@echo Generate $@
 	@echo "#!/bin/sh" > $@
-	@echo 'exec $(INSTALLDIR)/$(LIBNAME)top$(EXE) -I $(INSTALLDIR) $$*' >> $@
+	@echo 'exec $(INSTALLDIR)/$(LIBNAME)top$(EXE) -I $(INSTALLDIR) "$$@"' >> $@
 
 install-script: $(LIBNAME)
 	cp $(LIBNAME) $(BINDIR)
diff -Nru ocaml-3.12.1/otherlibs/labltk/lib/Makefile.nt ocaml-4.01.0/otherlibs/labltk/lib/Makefile.nt
--- ocaml-3.12.1/otherlibs/labltk/lib/Makefile.nt	2007-11-06 15:16:56.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/lib/Makefile.nt	2012-08-02 08:17:59.000000000 +0000
@@ -1 +1,17 @@
-include Makefile
\ No newline at end of file
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
+include Makefile
diff -Nru ocaml-3.12.1/otherlibs/labltk/lib/labltk.bat ocaml-4.01.0/otherlibs/labltk/lib/labltk.bat
--- ocaml-3.12.1/otherlibs/labltk/lib/labltk.bat	2010-06-08 00:54:09.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/lib/labltk.bat	2012-08-02 08:17:59.000000000 +0000
@@ -1 +1 @@
-@ocaml -I +labltk labltk.cma %1 %2 %3 %4 %5 %6 %7 %8 %9
\ No newline at end of file
+@ocaml -I +labltk labltk.cma %1 %2 %3 %4 %5 %6 %7 %8 %9
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/.cvsignore ocaml-4.01.0/otherlibs/labltk/support/.cvsignore
--- ocaml-3.12.1/otherlibs/labltk/support/.cvsignore	2010-01-20 16:26:46.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,2 +0,0 @@
-*.so
-*.a
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/Makefile ocaml-4.01.0/otherlibs/labltk/support/Makefile
--- ocaml-3.12.1/otherlibs/labltk/support/Makefile	2008-04-22 07:38:07.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/Makefile	2012-07-17 15:31:12.000000000 +0000
@@ -1,3 +1,19 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 1999 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include Makefile.common
 
 all: support.cmo rawwidget.cmo widget.cmo protocol.cmo \
@@ -16,9 +32,10 @@
 
 COMPFLAGS=-I $(OTHERS)/win32unix -I $(OTHERS)/unix
 THFLAGS=-I $(OTHERS)/systhreads -I $(OTHERS)/threads
+TKLDOPTS=$(TK_LINK:%=-ldopt "%")
 
 lib$(LIBNAME).$(A): $(COBJS)
-	$(MKLIB) -o $(LIBNAME) $(COBJS) -ldopt "$(TK_LINK)"
+	$(MKLIB) -o $(LIBNAME) $(COBJS) $(TKLDOPTS)
 
 PUBMLI=fileevent.mli protocol.mli textvariable.mli timer.mli \
     rawwidget.mli widget.mli
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/Makefile.common ocaml-4.01.0/otherlibs/labltk/support/Makefile.common
--- ocaml-3.12.1/otherlibs/labltk/support/Makefile.common	2009-12-03 16:06:56.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/Makefile.common	2012-07-17 15:31:12.000000000 +0000
@@ -1,5 +1,21 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 1999 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 ## Paths are relative to subdirectories
-## Where you compiled Objective Caml
+## Where you compiled OCaml
 TOPDIR=../../..
 ## Path to the otherlibs subdirectory
 OTHERS=$(TOPDIR)/otherlibs
@@ -10,7 +26,7 @@
 
 INSTALLDIR=$(LIBDIR)/$(LIBNAME)
 
-## Tools from the Objective Caml distribution
+## Tools from the OCaml distribution
 
 CAMLRUN=$(TOPDIR)/boot/ocamlrun
 CAMLC=$(TOPDIR)/ocamlcomp.sh
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/Makefile.nt ocaml-4.01.0/otherlibs/labltk/support/Makefile.nt
--- ocaml-3.12.1/otherlibs/labltk/support/Makefile.nt	2008-04-22 07:38:07.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/Makefile.nt	2012-08-02 08:17:59.000000000 +0000
@@ -1 +1,17 @@
+#######################################################################
+#                                                                     #
+#                 MLTk, Tcl/Tk interface of OCaml                     #
+#                                                                     #
+#    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    #
+#               projet Cristal, INRIA Rocquencourt                    #
+#            Jacques Garrigue, Kyoto University RIMS                  #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique and Kyoto University.  All rights reserved.         #
+#  This file is distributed under the terms of the GNU Library        #
+#  General Public License, with the special exception on linking      #
+#  described in file LICENSE found in the OCaml source tree.          #
+#                                                                     #
+#######################################################################
+
 include Makefile
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/camltk.h ocaml-4.01.0/otherlibs/labltk/support/camltk.h
--- ocaml-3.12.1/otherlibs/labltk/support/camltk.h	2010-04-03 06:43:51.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/camltk.h	2013-02-27 19:31:47.000000000 +0000
@@ -1,6 +1,6 @@
 /*************************************************************************/
 /*                                                                       */
-/*                Objective Caml LablTk library                          */
+/*                         OCaml LablTk library                          */
 /*                                                                       */
 /*         Francois Rouaix, Francois Pessaux and Jun Furuse              */
 /*               projet Cristal, INRIA Rocquencourt                      */
@@ -14,7 +14,7 @@
 /*                                                                       */
 /*************************************************************************/
 
-/* $Id: camltk.h 10230 2010-04-03 06:43:51Z furuse $ */
+/* $Id$ */
 
 #if defined(_WIN32) && defined(CAML_DLL) && defined(IN_CAMLTKSUPPORT)
 #define CAMLTKextern CAMLexport
@@ -27,13 +27,16 @@
 #define CONST84
 #endif
 
+/*Tcl_GetResult(), Tcl_GetStringResult(), Tcl_SetResult(), */
+  /*Tcl_SetStringResult(), Tcl_GetErrorLine() */
+
 /* if Tcl_GetStringResult is not defined, we use interp->result */
-#ifndef Tcl_GetStringResult
-#  define Tcl_GetStringResult(interp) (interp->result)
-#endif
+/*#ifndef Tcl_GetStringResult*/
+/*#  define Tcl_GetStringResult(interp) (interp->result)*/
+/*#endif*/
 
 /* cltkMisc.c */
-/* copy a Caml string to the C heap. Must be deallocated with stat_free */
+/* copy an OCaml string to the C heap. Must be deallocated with stat_free */
 extern char *string_to_c(value s);
 
 /* cltkUtf.c */
@@ -45,7 +48,7 @@
 extern value copy_string_list(int argc, char **argv);
 
 /* cltkCaml.c */
-/* pointers to Caml values */
+/* pointers to OCaml values */
 extern value *tkerror_exn;
 extern value *handler_code;
 extern int CamlCBCmd(ClientData clientdata, Tcl_Interp *interp,
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/camltkwrap.ml ocaml-4.01.0/otherlibs/labltk/support/camltkwrap.ml
--- ocaml-3.12.1/otherlibs/labltk/support/camltkwrap.ml	2009-09-25 12:56:10.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/camltkwrap.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 module Widget = struct
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/camltkwrap.mli ocaml-4.01.0/otherlibs/labltk/support/camltkwrap.mli
--- ocaml-3.12.1/otherlibs/labltk/support/camltkwrap.mli	2009-09-25 12:56:10.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/camltkwrap.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,7 +10,7 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 module Widget : sig
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/cltkCaml.c ocaml-4.01.0/otherlibs/labltk/support/cltkCaml.c
--- ocaml-3.12.1/otherlibs/labltk/support/cltkCaml.c	2008-09-26 07:35:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/cltkCaml.c	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                 MLTk, Tcl/Tk interface of Objective Caml            */
+/*                 MLTk, Tcl/Tk interface of OCaml                     */
 /*                                                                     */
 /*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    */
 /*               projet Cristal, INRIA Rocquencourt                    */
@@ -10,11 +10,11 @@
 /*  en Automatique and Kyoto University.  All rights reserved.         */
 /*  This file is distributed under the terms of the GNU Library        */
 /*  General Public License, with the special exception on linking      */
-/*  described in file LICENSE found in the Objective Caml source tree. */
+/*  described in file LICENSE found in the OCaml source tree.          */
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: cltkCaml.c 9036 2008-09-26 07:35:24Z garrigue $ */
+/* $Id$ */
 
 #include 
 #include 
@@ -27,7 +27,7 @@
 value * tkerror_exn = NULL;
 value * handler_code = NULL;
 
-/* The Tcl command for evaluating callback in Caml */
+/* The Tcl command for evaluating callback in OCaml */
 int CamlCBCmd(ClientData clientdata, Tcl_Interp *interp,
               int argc, CONST84 char **argv)
 {
@@ -41,7 +41,7 @@
       return TCL_ERROR;
     callback2(*handler_code,Val_int(id),
               copy_string_list(argc - 2,(char **)&argv[2]));
-    /* Never fails (Caml would have raised an exception) */
+    /* Never fails (OCaml would have raised an exception) */
     /* but result may have been set by callback */
     return TCL_OK;
   }
@@ -69,14 +69,14 @@
 }
 
 
-/* The initialisation of the C global variables pointing to Caml values
-   must be made accessible from Caml, so that we are sure that it *always*
+/* The initialisation of the C global variables pointing to OCaml values
+   must be made accessible from OCaml, so that we are sure that it *always*
    takes place during loading of the protocol module
  */
 
 CAMLprim value camltk_init(value v)
 {
-  /* Initialize the Caml pointers */
+  /* Initialize the OCaml pointers */
   if (tkerror_exn == NULL)
     tkerror_exn = caml_named_value("tkerror");
   if (handler_code == NULL)
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/cltkDMain.c ocaml-4.01.0/otherlibs/labltk/support/cltkDMain.c
--- ocaml-3.12.1/otherlibs/labltk/support/cltkDMain.c	2010-04-03 06:43:51.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/cltkDMain.c	2013-02-25 03:01:31.000000000 +0000
@@ -1,6 +1,6 @@
 /*************************************************************************/
 /*                                                                       */
-/*                Objective Caml LablTk library                          */
+/*                         OCaml LablTk library                          */
 /*                                                                       */
 /*         Francois Rouaix, Francois Pessaux and Jun Furuse              */
 /*               projet Cristal, INRIA Rocquencourt                      */
@@ -14,7 +14,7 @@
 /*                                                                       */
 /*************************************************************************/
 
-/* $Id: cltkDMain.c 10230 2010-04-03 06:43:51Z furuse $ */
+/* $Id$ */
 
 #include 
 #include 
@@ -35,7 +35,7 @@
 
 
 /*
- * Dealing with signals: when a signal handler is defined in Caml,
+ * Dealing with signals: when a signal handler is defined in OCaml,
  * the actual execution of the signal handler upon reception of the
  * signal is delayed until we are sure we are out of the GC.
  * If a signal occurs during the MainLoop, we would have to wait
@@ -162,7 +162,7 @@
                         + trail.symbol_size + trail.debug_size), 2);
 
     code_size = trail.code_size;
-    start_code = (code_t) stat_alloc(code_size);
+    start_code = (code_t) caml_stat_alloc(code_size);
     if (read(fd, (char *) start_code, code_size) != code_size)
       fatal_error("Fatal error: truncated bytecode file.\n");
 
@@ -215,7 +215,7 @@
   {
     char *home = getenv("HOME");
     if (home != NULL) {
-      char *f = stat_alloc(strlen(home)+strlen(RCNAME)+2);
+      char *f = caml_stat_alloc(strlen(home)+strlen(RCNAME)+2);
       f[0]='\0';
       strcat(f, home);
       strcat(f, "/");
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/cltkEval.c ocaml-4.01.0/otherlibs/labltk/support/cltkEval.c
--- ocaml-3.12.1/otherlibs/labltk/support/cltkEval.c	2010-04-03 06:43:51.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/cltkEval.c	2013-02-25 03:01:31.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                 MLTk, Tcl/Tk interface of Objective Caml            */
+/*                 MLTk, Tcl/Tk interface of OCaml                     */
 /*                                                                     */
 /*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    */
 /*               projet Cristal, INRIA Rocquencourt                    */
@@ -10,11 +10,11 @@
 /*  en Automatique and Kyoto University.  All rights reserved.         */
 /*  This file is distributed under the terms of the GNU Library        */
 /*  General Public License, with the special exception on linking      */
-/*  described in file LICENSE found in the Objective Caml source tree. */
+/*  described in file LICENSE found in the OCaml source tree.          */
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: cltkEval.c 10230 2010-04-03 06:43:51Z furuse $ */
+/* $Id$ */
 
 #include 
 #include 
@@ -32,7 +32,7 @@
 /* The Tcl interpretor */
 Tcl_Interp *cltclinterp = NULL;
 
-/* Copy a list of strings from the C heap to Caml */
+/* Copy a list of strings from the C heap to OCaml */
 value copy_string_list(int argc, char **argv)
 {
   CAMLparam0();
@@ -53,7 +53,7 @@
 }
 
 /*
- * Calling Tcl from Caml
+ * Calling Tcl from OCaml
  *   this version works on an arbitrary Tcl command,
  *   and does parsing and substitution
  */
@@ -65,7 +65,7 @@
   CheckInit();
 
   /* Tcl_Eval may write to its argument, so we take a copy
-   * If the evaluation raises a Caml exception, we have a space
+   * If the evaluation raises an OCaml exception, we have a space
    * leak
    */
   Tcl_ResetResult(cltclinterp);
@@ -84,7 +84,7 @@
 }
 
 /*
- * Calling Tcl from Caml
+ * Calling Tcl from OCaml
  *   direct call, argument is TkArgs vect
   type TkArgs =
       TkToken of string
@@ -139,14 +139,14 @@
       char *merged;
       int i;
       int size = argv_size(Field(v,0));
-      tmpargv = (char **)stat_alloc((size + 1) * sizeof(char *));
+      tmpargv = (char **)caml_stat_alloc((size + 1) * sizeof(char *));
       fill_args(tmpargv,0,Field(v,0));
       tmpargv[size] = NULL;
-      merged = Tcl_Merge(size,tmpargv);
+      merged = Tcl_Merge(size,(const char *const*)tmpargv);
       for(i = 0; i= 0; i--)
         argv[i+1] = argv[i];
       argv[0] = "unknown";
-      result = (*info.proc)(info.clientData,cltclinterp,size+1,argv);
+      result = (*info.proc)(info.clientData,cltclinterp,size+1,(const char**)argv);
     } else { /* ah, it isn't there at all */
       result = TCL_ERROR;
       Tcl_AppendResult(cltclinterp, "Unknown command \"",
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/cltkEvent.c ocaml-4.01.0/otherlibs/labltk/support/cltkEvent.c
--- ocaml-3.12.1/otherlibs/labltk/support/cltkEvent.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/cltkEvent.c	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                 MLTk, Tcl/Tk interface of Objective Caml            */
+/*                 MLTk, Tcl/Tk interface of OCaml                     */
 /*                                                                     */
 /*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    */
 /*               projet Cristal, INRIA Rocquencourt                    */
@@ -10,11 +10,11 @@
 /*  en Automatique and Kyoto University.  All rights reserved.         */
 /*  This file is distributed under the terms of the GNU Library        */
 /*  General Public License, with the special exception on linking      */
-/*  described in file LICENSE found in the Objective Caml source tree. */
+/*  described in file LICENSE found in the OCaml source tree.          */
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: cltkEvent.c 9547 2010-01-22 12:48:24Z doligez $ */
+/* $Id$ */
 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/cltkFile.c ocaml-4.01.0/otherlibs/labltk/support/cltkFile.c
--- ocaml-3.12.1/otherlibs/labltk/support/cltkFile.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/cltkFile.c	2012-07-26 19:21:54.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                 MLTk, Tcl/Tk interface of Objective Caml            */
+/*                 MLTk, Tcl/Tk interface of OCaml                     */
 /*                                                                     */
 /*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    */
 /*               projet Cristal, INRIA Rocquencourt                    */
@@ -10,15 +10,11 @@
 /*  en Automatique and Kyoto University.  All rights reserved.         */
 /*  This file is distributed under the terms of the GNU Library        */
 /*  General Public License, with the special exception on linking      */
-/*  described in file LICENSE found in the Objective Caml source tree. */
+/*  described in file LICENSE found in the OCaml source tree.          */
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: cltkFile.c 9547 2010-01-22 12:48:24Z doligez $ */
-
-#ifdef __CYGWIN__
-#define _WIN32
-#endif
+/* $Id$ */
 
 #ifdef _WIN32
 #include 
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/cltkImg.c ocaml-4.01.0/otherlibs/labltk/support/cltkImg.c
--- ocaml-3.12.1/otherlibs/labltk/support/cltkImg.c	2008-07-01 09:55:52.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/cltkImg.c	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                 MLTk, Tcl/Tk interface of Objective Caml            */
+/*                 MLTk, Tcl/Tk interface of OCaml                     */
 /*                                                                     */
 /*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    */
 /*               projet Cristal, INRIA Rocquencourt                    */
@@ -10,7 +10,7 @@
 /*  en Automatique and Kyoto University.  All rights reserved.         */
 /*  This file is distributed under the terms of the GNU Library        */
 /*  General Public License, with the special exception on linking      */
-/*  described in file LICENSE found in the Objective Caml source tree. */
+/*  described in file LICENSE found in the OCaml source tree.          */
 /*                                                                     */
 /***********************************************************************/
 #include 
@@ -90,7 +90,7 @@
     tk_error("no such image");
 #endif
 
-  pib.pixelPtr = String_val(pixmap);
+  pib.pixelPtr = (unsigned char *)String_val(pixmap);
   pib.width = Int_val(w);
   pib.height = Int_val(h);
   pib.pitch = pib.width * 3;
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/cltkMain.c ocaml-4.01.0/otherlibs/labltk/support/cltkMain.c
--- ocaml-3.12.1/otherlibs/labltk/support/cltkMain.c	2010-04-03 06:43:51.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/cltkMain.c	2013-02-25 03:01:31.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                 MLTk, Tcl/Tk interface of Objective Caml            */
+/*                 MLTk, Tcl/Tk interface of OCaml                     */
 /*                                                                     */
 /*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    */
 /*               projet Cristal, INRIA Rocquencourt                    */
@@ -10,11 +10,11 @@
 /*  en Automatique and Kyoto University.  All rights reserved.         */
 /*  This file is distributed under the terms of the GNU Library        */
 /*  General Public License, with the special exception on linking      */
-/*  described in file LICENSE found in the Objective Caml source tree. */
+/*  described in file LICENSE found in the OCaml source tree.          */
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: cltkMain.c 10230 2010-04-03 06:43:51Z furuse $ */
+/* $Id$ */
 
 #include 
 #include 
@@ -35,7 +35,7 @@
 #endif
 
 /*
- * Dealing with signals: when a signal handler is defined in Caml,
+ * Dealing with signals: when a signal handler is defined in OCaml,
  * the actual execution of the signal handler upon reception of the
  * signal is delayed until we are sure we are out of the GC.
  * If a signal occurs during the MainLoop, we would have to wait
@@ -113,7 +113,7 @@
         char **tkargv;
         char argcstr[256]; /* string of argc */
 
-        tkargv = (char**)stat_alloc(sizeof( char* ) * argc );
+        tkargv = (char**)caml_stat_alloc(sizeof( char* ) * argc );
         tmp = Field(argv, 1); /* starts from argv[1] */
         i = 0;
 
@@ -125,7 +125,7 @@
 
         sprintf( argcstr, "%d", argc );
         Tcl_SetVar(cltclinterp, "argc", argcstr, TCL_GLOBAL_ONLY);
-        args = Tcl_Merge(argc, tkargv); /* args must be freed by Tcl_Free */
+        args = Tcl_Merge(argc, (const char *const*)tkargv); /* args must be freed by Tcl_Free */
         Tcl_SetVar(cltclinterp, "argv", args, TCL_GLOBAL_ONLY);
         Tcl_Free(args);
         stat_free( tkargv );
@@ -157,7 +157,7 @@
   {
     char *home = getenv("HOME");
     if (home != NULL) {
-      char *f = stat_alloc(strlen(home)+strlen(RCNAME)+2);
+      char *f = caml_stat_alloc(strlen(home)+strlen(RCNAME)+2);
       f[0]='\0';
       strcat(f, home);
       strcat(f, "/");
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/cltkMisc.c ocaml-4.01.0/otherlibs/labltk/support/cltkMisc.c
--- ocaml-3.12.1/otherlibs/labltk/support/cltkMisc.c	2010-04-03 06:43:51.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/cltkMisc.c	2013-02-25 03:01:31.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                 MLTk, Tcl/Tk interface of Objective Caml            */
+/*                 MLTk, Tcl/Tk interface of OCaml                     */
 /*                                                                     */
 /*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    */
 /*               projet Cristal, INRIA Rocquencourt                    */
@@ -10,11 +10,11 @@
 /*  en Automatique and Kyoto University.  All rights reserved.         */
 /*  This file is distributed under the terms of the GNU Library        */
 /*  General Public License, with the special exception on linking      */
-/*  described in file LICENSE found in the Objective Caml source tree. */
+/*  described in file LICENSE found in the OCaml source tree.          */
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: cltkMisc.c 10230 2010-04-03 06:43:51Z furuse $ */
+/* $Id$ */
 
 #include 
 #include 
@@ -35,7 +35,7 @@
 
   utf = caml_string_to_tcl(v);
   /* argv is allocated by Tcl, to be freed by us */
-  result = Tcl_SplitList(cltclinterp,utf,&argc,&argv);
+  result = Tcl_SplitList(cltclinterp,utf,&argc,(const char ***)&argv);
   switch(result) {
   case TCL_OK:
    { value res = copy_string_list(argc,argv);
@@ -51,11 +51,11 @@
   }
 }
 
-/* Copy a Caml string to the C heap. Should deallocate with stat_free */
+/* Copy an OCaml string to the C heap. Should deallocate with stat_free */
 char *string_to_c(value s)
 {
   int l = string_length(s);
-  char *res = stat_alloc(l + 1);
+  char *res = caml_stat_alloc(l + 1);
   memmove (res, String_val (s), l);
   res[l] = '\0';
   return res;
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/cltkTimer.c ocaml-4.01.0/otherlibs/labltk/support/cltkTimer.c
--- ocaml-3.12.1/otherlibs/labltk/support/cltkTimer.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/cltkTimer.c	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                 MLTk, Tcl/Tk interface of Objective Caml            */
+/*                 MLTk, Tcl/Tk interface of OCaml                     */
 /*                                                                     */
 /*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    */
 /*               projet Cristal, INRIA Rocquencourt                    */
@@ -10,11 +10,11 @@
 /*  en Automatique and Kyoto University.  All rights reserved.         */
 /*  This file is distributed under the terms of the GNU Library        */
 /*  General Public License, with the special exception on linking      */
-/*  described in file LICENSE found in the Objective Caml source tree. */
+/*  described in file LICENSE found in the OCaml source tree.          */
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: cltkTimer.c 9547 2010-01-22 12:48:24Z doligez $ */
+/* $Id$ */
 
 #include 
 #include 
@@ -34,11 +34,11 @@
   CheckInit();
   /* look at tkEvent.c , Tk_Token is an int */
   return (Val_int(Tcl_CreateTimerHandler(Int_val(milli), TimerProc,
-                                       (ClientData) (Int_val(cbid)))));
+                                       (ClientData) (Long_val(cbid)))));
 }
 
 CAMLprim value camltk_rem_timer(value token)
 {
-  Tcl_DeleteTimerHandler((Tcl_TimerToken) Int_val(token));
+  Tcl_DeleteTimerHandler((Tcl_TimerToken) Long_val(token));
   return Val_unit;
 }
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/cltkUtf.c ocaml-4.01.0/otherlibs/labltk/support/cltkUtf.c
--- ocaml-3.12.1/otherlibs/labltk/support/cltkUtf.c	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/cltkUtf.c	2013-02-25 03:01:31.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                 MLTk, Tcl/Tk interface of Objective Caml            */
+/*                 MLTk, Tcl/Tk interface of OCaml                     */
 /*                                                                     */
 /*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    */
 /*               projet Cristal, INRIA Rocquencourt                    */
@@ -10,11 +10,11 @@
 /*  en Automatique and Kyoto University.  All rights reserved.         */
 /*  This file is distributed under the terms of the GNU Library        */
 /*  General Public License, with the special exception on linking      */
-/*  described in file LICENSE found in the Objective Caml source tree. */
+/*  described in file LICENSE found in the OCaml source tree.          */
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: cltkUtf.c 4745 2002-04-26 12:16:26Z furuse $ */
+/* $Id$ */
 
 #include 
 #include 
@@ -43,7 +43,7 @@
 
   Tcl_ExternalToUtfDString(NULL, str, strlen(str), &dstr);
   length = Tcl_DStringLength(&dstr);
-  res = stat_alloc(length + 1);
+  res = caml_stat_alloc(length + 1);
   memmove( res, Tcl_DStringValue(&dstr), length+1);
   Tcl_DStringFree(&dstr);
 
@@ -57,7 +57,7 @@
 
   Tcl_UtfToExternalDString(NULL, str, strlen(str), &dstr);
   length = Tcl_DStringLength(&dstr);
-  res = stat_alloc(length + 1);
+  res = caml_stat_alloc(length + 1);
   memmove( res, Tcl_DStringValue(&dstr), length+1);
   Tcl_DStringFree(&dstr);
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/cltkVar.c ocaml-4.01.0/otherlibs/labltk/support/cltkVar.c
--- ocaml-3.12.1/otherlibs/labltk/support/cltkVar.c	2010-04-03 06:43:51.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/cltkVar.c	2012-07-30 18:04:46.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                 MLTk, Tcl/Tk interface of Objective Caml            */
+/*                 MLTk, Tcl/Tk interface of OCaml                     */
 /*                                                                     */
 /*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    */
 /*               projet Cristal, INRIA Rocquencourt                    */
@@ -10,11 +10,11 @@
 /*  en Automatique and Kyoto University.  All rights reserved.         */
 /*  This file is distributed under the terms of the GNU Library        */
 /*  General Public License, with the special exception on linking      */
-/*  described in file LICENSE found in the Objective Caml source tree. */
+/*  described in file LICENSE found in the OCaml source tree.          */
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: cltkVar.c 10230 2010-04-03 06:43:51Z furuse $ */
+/* $Id$ */
 
 /* Alternative to tkwait variable */
 #include 
@@ -33,13 +33,13 @@
   CheckInit();
 
   stable_var = string_to_c(var);
-  s = Tcl_GetVar(cltclinterp,stable_var,
-                   TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
+  s = (char *)Tcl_GetVar(cltclinterp,stable_var,
+                         TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
   stat_free(stable_var);
 
   if (s == NULL)
     tk_error(Tcl_GetStringResult(cltclinterp));
-  else 
+  else
     return(tcl_string_to_caml(s));
 }
 
@@ -51,12 +51,12 @@
   CheckInit();
 
   /* SetVar makes a copy of the contents. */
-  /* In case we have write traces in Caml, it's better to make sure that
+  /* In case we have write traces in OCaml, it's better to make sure that
      var doesn't move... */
   stable_var = string_to_c(var);
   utf_contents = caml_string_to_tcl(contents);
-  s = Tcl_SetVar(cltclinterp,stable_var, utf_contents,
-                   TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
+  s = (char *)Tcl_SetVar(cltclinterp,stable_var, utf_contents,
+                         TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
   stat_free(stable_var);
   if( s == utf_contents ){
     tk_error("camltk_setvar: Tcl_SetVar returned strange result. Call the author of mlTk!");
@@ -65,7 +65,7 @@
 
   if (s == NULL)
     tk_error(Tcl_GetStringResult(cltclinterp));
-  else 
+  else
     return(Val_unit);
 }
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/cltkWait.c ocaml-4.01.0/otherlibs/labltk/support/cltkWait.c
--- ocaml-3.12.1/otherlibs/labltk/support/cltkWait.c	2010-04-03 06:43:51.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/cltkWait.c	2013-02-25 03:01:31.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                 MLTk, Tcl/Tk interface of Objective Caml            */
+/*                 MLTk, Tcl/Tk interface of OCaml                     */
 /*                                                                     */
 /*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    */
 /*               projet Cristal, INRIA Rocquencourt                    */
@@ -10,11 +10,11 @@
 /*  en Automatique and Kyoto University.  All rights reserved.         */
 /*  This file is distributed under the terms of the GNU Library        */
 /*  General Public License, with the special exception on linking      */
-/*  described in file LICENSE found in the Objective Caml source tree. */
+/*  described in file LICENSE found in the OCaml source tree.          */
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: cltkWait.c 10230 2010-04-03 06:43:51Z furuse $ */
+/* $Id$ */
 
 #include 
 #include 
@@ -62,7 +62,7 @@
 CAMLprim value camltk_wait_vis(value win, value cbid)
 {
   struct WinCBData *vis =
-    (struct WinCBData *)stat_alloc(sizeof(struct WinCBData));
+    (struct WinCBData *)caml_stat_alloc(sizeof(struct WinCBData));
   vis->win = Tk_NameToWindow(cltclinterp, String_val(win), cltk_mainWindow);
   if (vis -> win == NULL) {
     stat_free((char *)vis);
@@ -89,7 +89,7 @@
 CAMLprim value camltk_wait_des(value win, value cbid)
 {
   struct WinCBData *vis =
-    (struct WinCBData *)stat_alloc(sizeof(struct WinCBData));
+    (struct WinCBData *)caml_stat_alloc(sizeof(struct WinCBData));
   vis->win = Tk_NameToWindow(cltclinterp, String_val(win), cltk_mainWindow);
   if (vis -> win == NULL) {
     stat_free((char *)vis);
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/fileevent.ml ocaml-4.01.0/otherlibs/labltk/support/fileevent.ml
--- ocaml-3.12.1/otherlibs/labltk/support/fileevent.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/fileevent.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,14 +10,13 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: fileevent.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open Unix
-open Support
 open Protocol
 
 external add_file_input : file_descr -> cbid -> unit
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/fileevent.mli ocaml-4.01.0/otherlibs/labltk/support/fileevent.mli
--- ocaml-3.12.1/otherlibs/labltk/support/fileevent.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/fileevent.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: fileevent.mli 4745 2002-04-26 12:16:26Z furuse $ *)
+(* $Id$ *)
 
 open Unix
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/protocol.ml ocaml-4.01.0/otherlibs/labltk/support/protocol.ml
--- ocaml-3.12.1/otherlibs/labltk/support/protocol.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/protocol.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,13 +10,12 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: protocol.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
-open Support
 open Widget
 
 type callback_buffer = string list
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/protocol.mli ocaml-4.01.0/otherlibs/labltk/support/protocol.mli
--- ocaml-3.12.1/otherlibs/labltk/support/protocol.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/protocol.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: protocol.mli 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open Widget
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/rawwidget.ml ocaml-4.01.0/otherlibs/labltk/support/rawwidget.ml
--- ocaml-3.12.1/otherlibs/labltk/support/rawwidget.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/rawwidget.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,13 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: rawwidget.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
-open Support
+(* $Id$ *)
 
 (*
  * Widgets
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/rawwidget.mli ocaml-4.01.0/otherlibs/labltk/support/rawwidget.mli
--- ocaml-3.12.1/otherlibs/labltk/support/rawwidget.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/rawwidget.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: rawwidget.mli 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 (* Support for widget manipulations *)
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/slave.ml ocaml-4.01.0/otherlibs/labltk/support/slave.ml
--- ocaml-3.12.1/otherlibs/labltk/support/slave.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/slave.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: slave.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 (* The code run on initialisation, in addition to normal Tk code
  * NOTE: camltk has not fully been initialised yet
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/support.ml ocaml-4.01.0/otherlibs/labltk/support/support.ml
--- ocaml-3.12.1/otherlibs/labltk/support/support.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/support.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: support.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 (* Parsing results of Tcl *)
 (* List.split a string according to char_sep predicate *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/support.mli ocaml-4.01.0/otherlibs/labltk/support/support.mli
--- ocaml-3.12.1/otherlibs/labltk/support/support.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/support.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: support.mli 4745 2002-04-26 12:16:26Z furuse $ *)
+(* $Id$ *)
 
 val split_str : pred:(char -> bool) -> string -> string list
 val may : ('a -> 'b) -> 'a option -> 'b option
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/textvariable.ml ocaml-4.01.0/otherlibs/labltk/support/textvariable.ml
--- ocaml-3.12.1/otherlibs/labltk/support/textvariable.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/textvariable.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,13 +10,12 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: textvariable.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
-open Support
 open Protocol
 
 external internal_tracevar : string -> cbid -> unit
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/textvariable.mli ocaml-4.01.0/otherlibs/labltk/support/textvariable.mli
--- ocaml-3.12.1/otherlibs/labltk/support/textvariable.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/textvariable.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: textvariable.mli 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 (* Support for Tk -textvariable option *)
 open Widget
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/timer.ml ocaml-4.01.0/otherlibs/labltk/support/timer.ml
--- ocaml-3.12.1/otherlibs/labltk/support/timer.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/timer.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,14 +10,13 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: timer.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 (* Timers *)
-open Support
 open Protocol
 
 type tkTimer = int
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/timer.mli ocaml-4.01.0/otherlibs/labltk/support/timer.mli
--- ocaml-3.12.1/otherlibs/labltk/support/timer.mli	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/timer.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: timer.mli 4745 2002-04-26 12:16:26Z furuse $ *)
+(* $Id$ *)
 
 type t
 
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/tkthread.ml ocaml-4.01.0/otherlibs/labltk/support/tkthread.ml
--- ocaml-3.12.1/otherlibs/labltk/support/tkthread.ml	2008-01-11 16:13:18.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/tkthread.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*              LablTk, Tcl/Tk interface of Objective Caml             *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*         Jacques Garrigue, Nagoya University Mathematics Dept.       *)
 (*                                                                     *)
@@ -8,11 +8,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: tkthread.ml 8768 2008-01-11 16:13:18Z doligez $ *)
+(* $Id$ *)
 
 let jobs : (unit -> unit) Queue.t = Queue.create ()
 let m = Mutex.create ()
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/tkthread.mli ocaml-4.01.0/otherlibs/labltk/support/tkthread.mli
--- ocaml-3.12.1/otherlibs/labltk/support/tkthread.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/tkthread.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*              LablTk, Tcl/Tk interface of Objective Caml             *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*         Jacques Garrigue, Nagoya University Mathematics Dept.       *)
 (*                                                                     *)
@@ -8,11 +8,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: tkthread.mli 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 (* Helper functions for using LablTk with threads.
    To use, add tkthread.cmo or tkthread.cmx to your command line *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/tkwait.ml ocaml-4.01.0/otherlibs/labltk/support/tkwait.ml
--- ocaml-3.12.1/otherlibs/labltk/support/tkwait.ml	2009-09-25 12:56:10.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/tkwait.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: tkwait.ml 9358 2009-09-25 12:56:10Z weis $ *)
+(* $Id$ *)
 
 external internal_tracevis : string -> Protocol.cbid -> unit
         = "camltk_wait_vis"
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/widget.ml ocaml-4.01.0/otherlibs/labltk/support/widget.ml
--- ocaml-3.12.1/otherlibs/labltk/support/widget.ml	2002-04-26 12:16:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/widget.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: widget.ml 4745 2002-04-26 12:16:26Z furuse $ *)
+(* $Id$ *)
 
 (* Hack to permit having the different data type with the same name
    [widget] for CamlTk and LablTk. *)
diff -Nru ocaml-3.12.1/otherlibs/labltk/support/widget.mli ocaml-4.01.0/otherlibs/labltk/support/widget.mli
--- ocaml-3.12.1/otherlibs/labltk/support/widget.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/labltk/support/widget.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                 MLTk, Tcl/Tk interface of OCaml                     *)
 (*                                                                     *)
 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
 (*               projet Cristal, INRIA Rocquencourt                    *)
@@ -10,11 +10,11 @@
 (*  en Automatique and Kyoto University.  All rights reserved.         *)
 (*  This file is distributed under the terms of the GNU Library        *)
 (*  General Public License, with the special exception on linking      *)
-(*  described in file LICENSE found in the Objective Caml source tree. *)
+(*  described in file LICENSE found in the OCaml source tree.          *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: widget.mli 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 (* Support for widget manipulations *)
 
diff -Nru ocaml-3.12.1/otherlibs/num/.cvsignore ocaml-4.01.0/otherlibs/num/.cvsignore
--- ocaml-3.12.1/otherlibs/num/.cvsignore	2010-01-20 16:26:46.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-libnums.x
-*.c.x
-so_locations
-*.so
-*.a
diff -Nru ocaml-3.12.1/otherlibs/num/.depend ocaml-4.01.0/otherlibs/num/.depend
--- ocaml-3.12.1/otherlibs/num/.depend	2010-07-23 15:30:37.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/.depend	2012-07-26 19:21:54.000000000 +0000
@@ -1,11 +1,9 @@
 bng.o: bng.c bng.h ../../byterun/config.h ../../byterun/../config/m.h \
   ../../byterun/../config/s.h ../../byterun/compatibility.h bng_amd64.c \
   bng_digit.c
-bng_alpha.o: bng_alpha.c
 bng_amd64.o: bng_amd64.c
 bng_digit.o: bng_digit.c
 bng_ia32.o: bng_ia32.c
-bng_mips.o: bng_mips.c
 bng_ppc.o: bng_ppc.c
 bng_sparc.o: bng_sparc.c
 nat_stubs.o: nat_stubs.c ../../byterun/alloc.h \
@@ -13,28 +11,28 @@
   ../../byterun/config.h ../../byterun/../config/m.h \
   ../../byterun/../config/s.h ../../byterun/mlvalues.h \
   ../../byterun/config.h ../../byterun/custom.h ../../byterun/intext.h \
-  ../../byterun/io.h ../../byterun/fix_code.h ../../byterun/fail.h \
+  ../../byterun/io.h ../../byterun/fail.h ../../byterun/hash.h \
   ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \
   ../../byterun/freelist.h ../../byterun/minor_gc.h \
   ../../byterun/mlvalues.h bng.h nat.h
-arith_flags.cmi:
-arith_status.cmi:
-big_int.cmi: nat.cmi
-int_misc.cmi:
-nat.cmi:
-num.cmi: ratio.cmi nat.cmi big_int.cmi
-ratio.cmi: nat.cmi big_int.cmi
-arith_flags.cmo: arith_flags.cmi
-arith_flags.cmx: arith_flags.cmi
-arith_status.cmo: arith_flags.cmi arith_status.cmi
-arith_status.cmx: arith_flags.cmx arith_status.cmi
-big_int.cmo: nat.cmi int_misc.cmi big_int.cmi
-big_int.cmx: nat.cmx int_misc.cmx big_int.cmi
-int_misc.cmo: int_misc.cmi
-int_misc.cmx: int_misc.cmi
-nat.cmo: int_misc.cmi nat.cmi
-nat.cmx: int_misc.cmx nat.cmi
-num.cmo: ratio.cmi nat.cmi int_misc.cmi big_int.cmi arith_flags.cmi num.cmi
-num.cmx: ratio.cmx nat.cmx int_misc.cmx big_int.cmx arith_flags.cmx num.cmi
-ratio.cmo: nat.cmi int_misc.cmi big_int.cmi arith_flags.cmi ratio.cmi
-ratio.cmx: nat.cmx int_misc.cmx big_int.cmx arith_flags.cmx ratio.cmi
+arith_flags.cmi :
+arith_status.cmi :
+big_int.cmi : nat.cmi
+int_misc.cmi :
+nat.cmi :
+num.cmi : ratio.cmi nat.cmi big_int.cmi
+ratio.cmi : nat.cmi big_int.cmi
+arith_flags.cmo : arith_flags.cmi
+arith_flags.cmx : arith_flags.cmi
+arith_status.cmo : arith_flags.cmi arith_status.cmi
+arith_status.cmx : arith_flags.cmx arith_status.cmi
+big_int.cmo : nat.cmi int_misc.cmi big_int.cmi
+big_int.cmx : nat.cmx int_misc.cmx big_int.cmi
+int_misc.cmo : int_misc.cmi
+int_misc.cmx : int_misc.cmi
+nat.cmo : int_misc.cmi nat.cmi
+nat.cmx : int_misc.cmx nat.cmi
+num.cmo : ratio.cmi nat.cmi int_misc.cmi big_int.cmi arith_flags.cmi num.cmi
+num.cmx : ratio.cmx nat.cmx int_misc.cmx big_int.cmx arith_flags.cmx num.cmi
+ratio.cmo : nat.cmi int_misc.cmi big_int.cmi arith_flags.cmi ratio.cmi
+ratio.cmx : nat.cmx int_misc.cmx big_int.cmx arith_flags.cmx ratio.cmi
diff -Nru ocaml-3.12.1/otherlibs/num/Makefile ocaml-4.01.0/otherlibs/num/Makefile
--- ocaml-3.12.1/otherlibs/num/Makefile	2010-02-09 14:17:20.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/Makefile	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,7 +11,7 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile 9623 2010-02-09 14:17:20Z doligez $
+# $Id$
 
 # Makefile for the "num" (exact rational arithmetic) library
 
@@ -28,7 +28,7 @@
 	rm -f *~
 
 bng.$(O): bng.h bng_digit.c \
-       bng_alpha.c bng_amd64.c bng_ia32.c bng_mips.c bng_ppc.c bng_sparc.c
+       bng_amd64.c bng_ia32.c bng_ppc.c bng_sparc.c
 
 depend:
 	gcc -MM $(CFLAGS) *.c > .depend
diff -Nru ocaml-3.12.1/otherlibs/num/Makefile.nt ocaml-4.01.0/otherlibs/num/Makefile.nt
--- ocaml-3.12.1/otherlibs/num/Makefile.nt	2010-04-30 13:27:35.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/Makefile.nt	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,7 +11,7 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile.nt 10337 2010-04-30 13:27:35Z frisch $
+# $Id$
 
 # Makefile for the "num" (exact rational arithmetic) library
 
@@ -28,7 +28,7 @@
 	rm -f *~
 
 bng.$(O): bng.h bng_digit.c \
-       bng_alpha.c bng_amd64.c bng_ia32.c bng_mips.c bng_ppc.c bng_sparc.c
+       bng_amd64.c bng_ia32.c bng_ppc.c bng_sparc.c
 
 depend:
 	sed -e 's/\.o/.$(O)/g' .depend > .depend.nt
diff -Nru ocaml-3.12.1/otherlibs/num/arith_flags.ml ocaml-4.01.0/otherlibs/num/arith_flags.ml
--- ocaml-3.12.1/otherlibs/num/arith_flags.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/arith_flags.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
@@ -11,7 +11,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: arith_flags.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 let error_when_null_denominator_flag = ref true;;
 
diff -Nru ocaml-3.12.1/otherlibs/num/arith_flags.mli ocaml-4.01.0/otherlibs/num/arith_flags.mli
--- ocaml-3.12.1/otherlibs/num/arith_flags.mli	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/arith_flags.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
@@ -11,7 +11,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: arith_flags.mli 4144 2001-12-07 13:41:02Z xleroy $ *)
+(* $Id$ *)
 
 val error_when_null_denominator_flag : bool ref
 val normalize_ratio_flag : bool ref
diff -Nru ocaml-3.12.1/otherlibs/num/arith_status.ml ocaml-4.01.0/otherlibs/num/arith_status.ml
--- ocaml-3.12.1/otherlibs/num/arith_status.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/arith_status.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
@@ -11,7 +11,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: arith_status.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open Arith_flags;;
 
diff -Nru ocaml-3.12.1/otherlibs/num/arith_status.mli ocaml-4.01.0/otherlibs/num/arith_status.mli
--- ocaml-3.12.1/otherlibs/num/arith_status.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/arith_status.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
@@ -11,7 +11,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: arith_status.mli 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 (** Flags that control rational arithmetic. *)
 
diff -Nru ocaml-3.12.1/otherlibs/num/big_int.ml ocaml-4.01.0/otherlibs/num/big_int.ml
--- ocaml-3.12.1/otherlibs/num/big_int.ml	2010-08-18 13:22:48.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/big_int.ml	2013-05-08 08:38:55.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
@@ -11,7 +11,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: big_int.ml 10649 2010-08-18 13:22:48Z doligez $ *)
+(* $Id$ *)
 
 open Int_misc
 open Nat
@@ -451,7 +451,6 @@
     let res = make_nat n
     and res2 = make_nat (succ n)
     and l = num_bits_int n - 2 in
-    let p = ref (1 lsl l) in
       blit_nat res 0 power_base pmax 1;
       for i = l downto 0 do
         let len = num_digits_nat res 0 n in
@@ -459,14 +458,13 @@
         let succ_len2 = succ len2 in
           ignore (square_nat res2 0 len2 res 0 len);
           begin
-           if n land !p > 0
+           if n land (1 lsl i) > 0
               then (set_to_zero_nat res 0 len;
                     ignore (mult_digit_nat res 0 succ_len2
                               res2 0 len2 power_base pmax))
               else blit_nat res 0 res2 0 len2
           end;
-          set_to_zero_nat res2 0 len2;
-          p := !p lsr 1
+          set_to_zero_nat res2 0 len2
       done;
     if rem > 0
      then (ignore (mult_digit_nat res2 0 (succ n)
@@ -496,21 +494,19 @@
          let res = make_nat res_len
          and res2 = make_nat res_len
          and l = num_bits_int n - 2 in
-         let p = ref (1 lsl l) in
          blit_nat res 0 bi.abs_value 0 bi_len;
          for i = l downto 0 do
            let len = num_digits_nat res 0 res_len in
            let len2 = min res_len (2 * len) in
            set_to_zero_nat res2 0 len2;
            ignore (square_nat res2 0 len2 res 0 len);
-           if n land !p > 0 then begin
+           if n land (1 lsl i) > 0 then begin
              let lenp = min res_len (len2 + bi_len) in
              set_to_zero_nat res 0 lenp;
              ignore(mult_nat res 0 lenp res2 0 len2 (bi.abs_value) 0 bi_len)
            end else begin
              blit_nat res 0 res2 0 len2
-           end;
-           p := !p lsr 1
+           end
          done;
          {sign = if bi.sign >=  0 then bi.sign
                  else if n land 1 = 0 then 1 else -1;
@@ -743,7 +739,13 @@
     if bi.sign < 0 then begin
       (* Two's complement *)
       complement_nat res 0 size_res;
-      ignore (incr_nat res 0 size_res 1)
+      (* PR#6010: need to increment res iff digits 0...ndigits-1 of bi are 0.
+         In this case, digits 0...ndigits-1 of not(bi) are all 0xFF...FF,
+         and adding 1 to them produces a carry out at ndigits. *)
+      let rec carry_incr i =
+        i >= ndigits || i >= size_bi ||
+          (is_digit_zero bi.abs_value i && carry_incr (i + 1)) in
+      if carry_incr 0 then ignore (incr_nat res 0 size_res 1)
     end;
     if nbits > 0 then begin
       let tmp = create_nat 1 in
diff -Nru ocaml-3.12.1/otherlibs/num/big_int.mli ocaml-4.01.0/otherlibs/num/big_int.mli
--- ocaml-3.12.1/otherlibs/num/big_int.mli	2010-04-29 13:53:01.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/big_int.mli	2013-05-29 18:05:44.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
@@ -11,7 +11,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: big_int.mli 10327 2010-04-29 13:53:01Z xleroy $ *)
+(* $Id$ *)
 
 (** Operations on arbitrary-precision integers.
 
@@ -155,13 +155,13 @@
 (** {6 Bit-oriented operations} *)
 
 val and_big_int : big_int -> big_int -> big_int
-        (** Bitwise logical ``and''.
+        (** Bitwise logical 'and'.
             The arguments must be positive or zero. *)
 val or_big_int : big_int -> big_int -> big_int
-        (** Bitwise logical ``or''.
+        (** Bitwise logical 'or'.
             The arguments must be positive or zero. *)
 val xor_big_int : big_int -> big_int -> big_int
-        (** Bitwise logical ``exclusive or''.
+        (** Bitwise logical 'exclusive or'.
             The arguments must be positive or zero. *)
 val shift_left_big_int : big_int -> int -> big_int
         (** [shift_left_big_int b n] returns [b] shifted left by [n] bits.
diff -Nru ocaml-3.12.1/otherlibs/num/bignum/.cvsignore ocaml-4.01.0/otherlibs/num/bignum/.cvsignore
--- ocaml-3.12.1/otherlibs/num/bignum/.cvsignore	1996-12-17 13:23:22.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/bignum/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1 +0,0 @@
-libbignum.x
diff -Nru ocaml-3.12.1/otherlibs/num/bng.c ocaml-4.01.0/otherlibs/num/bng.c
--- ocaml-3.12.1/otherlibs/num/bng.c	2010-05-21 12:00:49.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/bng.c	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,7 +11,7 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: bng.c 10450 2010-05-21 12:00:49Z doligez $ */
+/* $Id$ */
 
 #include "bng.h"
 #include "config.h"
diff -Nru ocaml-3.12.1/otherlibs/num/bng.h ocaml-4.01.0/otherlibs/num/bng.h
--- ocaml-3.12.1/otherlibs/num/bng.h	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/bng.h	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,7 +11,7 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: bng.h 9547 2010-01-22 12:48:24Z doligez $ */
+/* $Id$ */
 
 #include 
 #include "config.h"
diff -Nru ocaml-3.12.1/otherlibs/num/bng_alpha.c ocaml-4.01.0/otherlibs/num/bng_alpha.c
--- ocaml-3.12.1/otherlibs/num/bng_alpha.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/bng_alpha.c	1970-01-01 00:00:00.000000000 +0000
@@ -1,22 +0,0 @@
-/***********************************************************************/
-/*                                                                     */
-/*                           Objective Caml                            */
-/*                                                                     */
-/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
-/*                                                                     */
-/*  Copyright 2003 Institut National de Recherche en Informatique et   */
-/*  en Automatique.  All rights reserved.  This file is distributed    */
-/*  under the terms of the GNU Library General Public License, with    */
-/*  the special exception on linking described in file ../../LICENSE.  */
-/*                                                                     */
-/***********************************************************************/
-
-/* $Id: bng_alpha.c 9547 2010-01-22 12:48:24Z doligez $ */
-
-/* Code specific to the Alpha architecture. */
-
-#define BngMult(resh,resl,arg1,arg2)                                        \
-  asm("mulq %2, %3, %0 \n\t"                                                \
-      "umulh %2, %3, %1"                                                    \
-      : "=&r" (resl), "=r" (resh)                                           \
-      : "r" (arg1), "r" (arg2))
diff -Nru ocaml-3.12.1/otherlibs/num/bng_amd64.c ocaml-4.01.0/otherlibs/num/bng_amd64.c
--- ocaml-3.12.1/otherlibs/num/bng_amd64.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/bng_amd64.c	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,7 +11,7 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: bng_amd64.c 9547 2010-01-22 12:48:24Z doligez $ */
+/* $Id$ */
 
 /* Code specific to the AMD x86_64 architecture. */
 
diff -Nru ocaml-3.12.1/otherlibs/num/bng_digit.c ocaml-4.01.0/otherlibs/num/bng_digit.c
--- ocaml-3.12.1/otherlibs/num/bng_digit.c	2010-04-28 11:59:09.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/bng_digit.c	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,7 +11,7 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: bng_digit.c 10324 2010-04-28 11:59:09Z xleroy $ */
+/* $Id$ */
 
 /**** Generic operations on digits ****/
 
diff -Nru ocaml-3.12.1/otherlibs/num/bng_ia32.c ocaml-4.01.0/otherlibs/num/bng_ia32.c
--- ocaml-3.12.1/otherlibs/num/bng_ia32.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/bng_ia32.c	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,7 +11,7 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: bng_ia32.c 9547 2010-01-22 12:48:24Z doligez $ */
+/* $Id$ */
 
 /* Code specific to the Intel IA32 (x86) architecture. */
 
diff -Nru ocaml-3.12.1/otherlibs/num/bng_mips.c ocaml-4.01.0/otherlibs/num/bng_mips.c
--- ocaml-3.12.1/otherlibs/num/bng_mips.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/bng_mips.c	1970-01-01 00:00:00.000000000 +0000
@@ -1,23 +0,0 @@
-/***********************************************************************/
-/*                                                                     */
-/*                           Objective Caml                            */
-/*                                                                     */
-/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
-/*                                                                     */
-/*  Copyright 2003 Institut National de Recherche en Informatique et   */
-/*  en Automatique.  All rights reserved.  This file is distributed    */
-/*  under the terms of the GNU Library General Public License, with    */
-/*  the special exception on linking described in file ../../LICENSE.  */
-/*                                                                     */
-/***********************************************************************/
-
-/* $Id: bng_mips.c 9547 2010-01-22 12:48:24Z doligez $ */
-
-/* Code specific to the MIPS architecture. */
-
-#define BngMult(resh,resl,arg1,arg2)                                        \
-  asm("multu %2, %3 \n\t"                                                   \
-      "mflo %0 \n\t"                                                        \
-      "mfhi %1"                                                             \
-      : "=r" (resl), "=r" (resh)                                            \
-      : "r" (arg1), "r" (arg2))
diff -Nru ocaml-3.12.1/otherlibs/num/bng_ppc.c ocaml-4.01.0/otherlibs/num/bng_ppc.c
--- ocaml-3.12.1/otherlibs/num/bng_ppc.c	2006-05-31 08:16:34.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/bng_ppc.c	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,7 +11,7 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: bng_ppc.c 7430 2006-05-31 08:16:34Z xleroy $ */
+/* $Id$ */
 
 /* Code specific to the PowerPC architecture. */
 
@@ -91,4 +91,4 @@
       "mulhwu %1, %2, %3"                                                   \
       : "=&r" (resl), "=r" (resh)                                           \
       : "r" (arg1), "r" (arg2))
-#endif
\ No newline at end of file
+#endif
diff -Nru ocaml-3.12.1/otherlibs/num/bng_sparc.c ocaml-4.01.0/otherlibs/num/bng_sparc.c
--- ocaml-3.12.1/otherlibs/num/bng_sparc.c	2003-10-24 09:18:01.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/bng_sparc.c	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,7 +11,7 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: bng_sparc.c 5880 2003-10-24 09:18:01Z xleroy $ */
+/* $Id$ */
 
 /* Code specific to the SPARC (V8 and above) architecture. */
 
diff -Nru ocaml-3.12.1/otherlibs/num/int_misc.ml ocaml-4.01.0/otherlibs/num/int_misc.ml
--- ocaml-3.12.1/otherlibs/num/int_misc.ml	2002-05-27 12:06:49.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/int_misc.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
@@ -11,7 +11,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: int_misc.ml 4845 2002-05-27 12:06:49Z weis $ *)
+(* $Id$ *)
 
 (* Some extra operations on integers *)
 
diff -Nru ocaml-3.12.1/otherlibs/num/int_misc.mli ocaml-4.01.0/otherlibs/num/int_misc.mli
--- ocaml-3.12.1/otherlibs/num/int_misc.mli	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/int_misc.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
@@ -11,7 +11,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: int_misc.mli 4144 2001-12-07 13:41:02Z xleroy $ *)
+(* $Id$ *)
 
 (* Some extra operations on integers *)
 
diff -Nru ocaml-3.12.1/otherlibs/num/nat.h ocaml-4.01.0/otherlibs/num/nat.h
--- ocaml-3.12.1/otherlibs/num/nat.h	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/nat.h	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,7 +11,7 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: nat.h 9547 2010-01-22 12:48:24Z doligez $ */
+/* $Id$ */
 
 /* Nats are represented as unstructured blocks with tag Custom_tag. */
 
diff -Nru ocaml-3.12.1/otherlibs/num/nat.ml ocaml-4.01.0/otherlibs/num/nat.ml
--- ocaml-3.12.1/otherlibs/num/nat.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/nat.ml	2013-09-07 07:06:31.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
@@ -11,7 +11,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: nat.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open Int_misc
 
@@ -355,8 +355,10 @@
 (* XL: suppression de adjust_string *)
 
 let power_base_int base i =
-  if i = 0 then
+  if i = 0 || base = 1 then
     nat_of_int 1
+  else if base = 0 then
+    nat_of_int 0
   else if i < 0 then
     invalid_arg "power_base_int"
   else begin
@@ -370,22 +372,20 @@
                let res = make_nat newn
                and res2 = make_nat newn
                and l = num_bits_int n - 2 in
-               let p = ref (1 lsl l) in
                  blit_nat res 0 power_base pmax 1;
                  for i = l downto 0 do
                    let len = num_digits_nat res 0 newn in
                    let len2 = min n (2 * len) in
                    let succ_len2 = succ len2 in
                      ignore (square_nat res2 0 len2 res 0 len);
-                     if n land !p > 0 then begin
+                     if n land (1 lsl i) > 0 then begin
                        set_to_zero_nat res 0 len;
                        ignore
                          (mult_digit_nat res 0 succ_len2
                             res2 0 len2  power_base pmax)
                      end else
                        blit_nat res 0 res2 0 len2;
-                     set_to_zero_nat res2 0 len2;
-                     p := !p lsr 1
+                     set_to_zero_nat res2 0 len2
                  done;
                if rem > 0 then begin
                  ignore
diff -Nru ocaml-3.12.1/otherlibs/num/nat.mli ocaml-4.01.0/otherlibs/num/nat.mli
--- ocaml-3.12.1/otherlibs/num/nat.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/nat.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
@@ -11,7 +11,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: nat.mli 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 (* Module [Nat]: operations on natural numbers *)
 
diff -Nru ocaml-3.12.1/otherlibs/num/nat_stubs.c ocaml-4.01.0/otherlibs/num/nat_stubs.c
--- ocaml-3.12.1/otherlibs/num/nat_stubs.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/nat_stubs.c	2012-07-30 18:04:46.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,13 +11,14 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: nat_stubs.c 9547 2010-01-22 12:48:24Z doligez $ */
+/* $Id$ */
 
 #include "alloc.h"
 #include "config.h"
 #include "custom.h"
 #include "intext.h"
 #include "fail.h"
+#include "hash.h"
 #include "memory.h"
 #include "mlvalues.h"
 
@@ -26,6 +27,7 @@
 
 /* Stub code for the Nat module. */
 
+static intnat hash_nat(value);
 static void serialize_nat(value, uintnat *, uintnat *);
 static uintnat deserialize_nat(void * dst);
 
@@ -33,9 +35,10 @@
   "_nat",
   custom_finalize_default,
   custom_compare_default,
-  custom_hash_default,
+  hash_nat,
   serialize_nat,
-  deserialize_nat
+  deserialize_nat,
+  custom_compare_ext_default
 };
 
 CAMLprim value initialize_nat(value unit)
@@ -389,3 +392,27 @@
 #endif
   return len * 4;
 }
+
+static intnat hash_nat(value v)
+{
+  bngsize len, i;
+  uint32 h;
+
+  len = bng_num_digits(&Digit_val(v,0), Wosize_val(v) - 1);
+  h = 0;
+  for (i = 0; i < len; i++) {
+    bngdigit d = Digit_val(v, i);
+#ifdef ARCH_SIXTYFOUR
+    /* Mix the two 32-bit halves as if we were on a 32-bit platform,
+       namely low 32 bits first, then high 32 bits.
+       Also, ignore final 32 bits if they are zero. */
+    h = caml_hash_mix_uint32(h, (uint32) d);
+    d = d >> 32;
+    if (d == 0 && i + 1 == len) break;
+    h = caml_hash_mix_uint32(h, (uint32) d);
+#else
+    h = caml_hash_mix_uint32(h, d);
+#endif
+  }
+  return h;
+}
diff -Nru ocaml-3.12.1/otherlibs/num/num.ml ocaml-4.01.0/otherlibs/num/num.ml
--- ocaml-3.12.1/otherlibs/num/num.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/num.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
@@ -11,7 +11,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: num.ml 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 open Int_misc
 open Nat
diff -Nru ocaml-3.12.1/otherlibs/num/num.mli ocaml-4.01.0/otherlibs/num/num.mli
--- ocaml-3.12.1/otherlibs/num/num.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/num.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
@@ -11,7 +11,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: num.mli 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
 (** Operation on arbitrary-precision numbers.
 
@@ -155,7 +155,9 @@
    first argument is the number of digits in the mantissa. *)
 
 val num_of_string : string -> num
-(** Convert a string to a number. *)
+(** Convert a string to a number.
+   Raise [Failure "num_of_string"] if the given string is not
+   a valid representation of an integer *)
 
 (** {6 Coercions between numerical types} *)
 
diff -Nru ocaml-3.12.1/otherlibs/num/ratio.ml ocaml-4.01.0/otherlibs/num/ratio.ml
--- ocaml-3.12.1/otherlibs/num/ratio.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/ratio.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
diff -Nru ocaml-3.12.1/otherlibs/num/ratio.mli ocaml-4.01.0/otherlibs/num/ratio.mli
--- ocaml-3.12.1/otherlibs/num/ratio.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/num/ratio.mli	2012-07-17 15:31:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
@@ -11,9 +11,12 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: ratio.mli 9547 2010-01-22 12:48:24Z doligez $ *)
+(* $Id$ *)
 
-(* Module [Ratio]: operations on rational numbers *)
+(** Operation on rational numbers.
+
+    This module is used to support the implementation of {!Num} and
+    should not be called directly. *)
 
 open Nat
 open Big_int
@@ -25,6 +28,8 @@
 
 type ratio
 
+(**/**)
+
 val null_denominator : ratio -> bool
 val numerator_ratio : ratio -> big_int
 val denominator_ratio : ratio -> big_int
@@ -32,8 +37,9 @@
 val normalize_ratio : ratio -> ratio
 val cautious_normalize_ratio : ratio -> ratio
 val cautious_normalize_ratio_when_printing : ratio -> ratio
-val create_ratio : big_int -> big_int -> ratio
+val create_ratio : big_int -> big_int -> ratio (* assumes nothing *)
 val create_normalized_ratio : big_int -> big_int -> ratio
+                              (* assumes normalized argument *)
 val is_normalized_ratio : ratio -> bool
 val report_sign_ratio : ratio -> big_int -> big_int
 val abs_ratio : ratio -> ratio
diff -Nru ocaml-3.12.1/otherlibs/str/.cvsignore ocaml-4.01.0/otherlibs/str/.cvsignore
--- ocaml-3.12.1/otherlibs/str/.cvsignore	2010-01-20 16:26:46.000000000 +0000
+++ ocaml-4.01.0/otherlibs/str/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-libstr.x
-*.c.x
-so_locations
-*.so
-*.a
diff -Nru ocaml-3.12.1/otherlibs/str/.depend ocaml-4.01.0/otherlibs/str/.depend
--- ocaml-3.12.1/otherlibs/str/.depend	2010-07-23 15:30:37.000000000 +0000
+++ ocaml-4.01.0/otherlibs/str/.depend	2012-07-26 19:21:54.000000000 +0000
@@ -4,6 +4,6 @@
   ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
   ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \
   ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/fail.h
-str.cmi:
-str.cmo: str.cmi
-str.cmx: str.cmi
+str.cmi :
+str.cmo : str.cmi
+str.cmx : str.cmi
diff -Nru ocaml-3.12.1/otherlibs/str/Makefile ocaml-4.01.0/otherlibs/str/Makefile
--- ocaml-3.12.1/otherlibs/str/Makefile	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/str/Makefile	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,8 +11,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile 9547 2010-01-22 12:48:24Z doligez $
-
 # Makefile for the str library
 
 
diff -Nru ocaml-3.12.1/otherlibs/str/Makefile.nt ocaml-4.01.0/otherlibs/str/Makefile.nt
--- ocaml-3.12.1/otherlibs/str/Makefile.nt	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/str/Makefile.nt	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,8 +11,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile.nt 9547 2010-01-22 12:48:24Z doligez $
-
 # Makefile for the str library
 
 LIBNAME=str
diff -Nru ocaml-3.12.1/otherlibs/str/str.ml ocaml-4.01.0/otherlibs/str/str.ml
--- ocaml-3.12.1/otherlibs/str/str.ml	2010-05-05 14:36:41.000000000 +0000
+++ ocaml-4.01.0/otherlibs/str/str.ml	2013-03-19 07:22:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: str.ml 10375 2010-05-05 14:36:41Z guesdon $ *)
-
 (** String utilities *)
 
 let string_before s n = String.sub s 0 n
@@ -212,7 +210,8 @@
   for i = 0 to 255 do t.[i] <- Char.lowercase(Char.chr i) done;
   t
 
-module StringMap = Map.Make(struct type t = string let compare = compare end)
+module StringMap =
+  Map.Make(struct type t = string let compare (x:t) y = compare x y end)
 
 (* Compilation of a regular expression *)
 
diff -Nru ocaml-3.12.1/otherlibs/str/str.mli ocaml-4.01.0/otherlibs/str/str.mli
--- ocaml-3.12.1/otherlibs/str/str.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/str/str.mli	2013-06-19 11:48:14.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: str.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** Regular expressions and high-level string processing *)
 
 
@@ -48,7 +46,22 @@
      ([\2] for the second expression, and so on up to [\9]).
    - [\b    ] Matches word boundaries.
    - [\     ] Quotes special characters.  The special characters
-              are [$^.*+?[]].
+              are [$^\.*+?[]].
+
+   Note: the argument to [regexp] is usually a string literal. In this
+   case, any backslash character in the regular expression must be
+   doubled to make it past the OCaml string parser. For example, the
+   following expression:
+   {[ let r = Str.regexp "hello \\([A-Za-z]+\\)" in
+      Str.replace_first r "\\1" "hello world" ]}
+   returns the string ["world"].
+
+   In particular, if you want a regular expression that matches a single
+   backslash character, you need to quote it in the argument to [regexp]
+   (according to the last item of the list above) by adding a second
+   backslash. Then you need to quote both backslashes (according to the
+   syntax of string constants in OCaml) by doubling them again, so you
+   need to write four backslash characters: [Str.regexp "\\\\"].
 *)
 
 val regexp_case_fold : string -> regexp
@@ -82,15 +95,16 @@
    matching the regular expression [r]. The search starts at position
    [start] and proceeds towards the end of the string.
    Return the position of the first character of the matched
-   substring, or raise [Not_found] if no substring matches. *)
+   substring.
+   @raise Not_found if no substring matches. *)
 
 val search_backward : regexp -> string -> int -> int
 (** [search_backward r s last] searches the string [s] for a
   substring matching the regular expression [r]. The search first
   considers substrings that start at position [last] and proceeds
   towards the beginning of string. Return the position of the first
-  character of the matched substring; raise [Not_found] if no
-  substring matches. *)
+  character of the matched substring.
+  @raise Not_found if no substring matches. *)
 
 val string_partial_match : regexp -> string -> int -> bool
 (** Similar to {!Str.string_match}, but also returns true if
@@ -99,29 +113,50 @@
 
 val matched_string : string -> string
 (** [matched_string s] returns the substring of [s] that was matched
-   by the latest {!Str.string_match}, {!Str.search_forward} or
-   {!Str.search_backward}.
+   by the last call to one of the following matching or searching
+   functions:
+   - {!Str.string_match}
+   - {!Str.search_forward}
+   - {!Str.search_backward}
+   - {!Str.string_partial_match}
+   - {!Str.global_substitute}
+   - {!Str.substitute_first}
+   provided that none of the following functions was called inbetween:
+   - {!Str.global_replace}
+   - {!Str.replace_first}
+   - {!Str.split}
+   - {!Str.bounded_split}
+   - {!Str.split_delim}
+   - {!Str.bounded_split_delim}
+   - {!Str.full_split}
+   - {!Str.bounded_full_split}
+
+   Note: in the case of [global_substitute] and [substitute_first],
+   a call to [matched_string] is only valid within the [subst] argument,
+   not after [global_substitute] or [substitute_first] returns.
+
    The user must make sure that the parameter [s] is the same string
    that was passed to the matching or searching function. *)
 
 val match_beginning : unit -> int
 (** [match_beginning()] returns the position of the first character
-   of the substring that was matched by {!Str.string_match},
-   {!Str.search_forward} or {!Str.search_backward}. *)
+   of the substring that was matched by the last call to a matching
+   or searching function (see {!Str.matched_string} for details). *)
 
 val match_end : unit -> int
 (** [match_end()] returns the position of the character following the
-   last character of the substring that was matched by [string_match],
-   [search_forward] or [search_backward]. *)
+   last character of the substring that was matched by the last call
+   to a matching or searching function (see {!Str.matched_string} for
+   details). *)
 
 val matched_group : int -> string -> string
 (** [matched_group n s] returns the substring of [s] that was matched
-   by the [n]th group [\(...\)] of the regular expression during
-   the latest {!Str.string_match}, {!Str.search_forward} or
-   {!Str.search_backward}.
+   by the [n]th group [\(...\)] of the regular expression that was
+   matched by the last call to a matching or searching function (see
+   {!Str.matched_string} for details).
    The user must make sure that the parameter [s] is the same string
    that was passed to the matching or searching function.
-   [matched_group n s] raises [Not_found] if the [n]th group
+   @raise Not_found if the [n]th group
    of the regular expression was not matched.  This can happen
    with groups inside alternatives [\|], options [?]
    or repetitions [*].  For instance, the empty string will match
@@ -131,7 +166,8 @@
 val group_beginning : int -> int
 (** [group_beginning n] returns the position of the first character
    of the substring that was matched by the [n]th group of
-   the regular expression.
+   the regular expression that was matched by the last call to a
+   matching or searching function (see {!Str.matched_string} for details).
    @raise Not_found if the [n]th group of the regular expression
    was not matched.
    @raise Invalid_argument if there are fewer than [n] groups in
@@ -140,7 +176,9 @@
 val group_end : int -> int
 (** [group_end n] returns
    the position of the character following the last character of
-   substring that was matched by the [n]th group of the regular expression.
+   substring that was matched by the [n]th group of the regular
+   expression that was matched by the last call to a matching or
+   searching function (see {!Str.matched_string} for details).
    @raise Not_found if the [n]th group of the regular expression
    was not matched.
    @raise Invalid_argument if there are fewer than [n] groups in
@@ -176,9 +214,11 @@
 val replace_matched : string -> string -> string
 (** [replace_matched repl s] returns the replacement text [repl]
    in which [\1], [\2], etc. have been replaced by the text
-   matched by the corresponding groups in the most recent matching
-   operation.  [s] must be the same string that was matched during
-   this matching operation. *)
+   matched by the corresponding groups in the regular expression
+   that was matched by the last call to a matching or searching
+   function (see {!Str.matched_string} for details).
+   [s] must be the same string that was passed to the matching or
+   searching function. *)
 
 
 (** {6 Splitting} *)
@@ -189,7 +229,7 @@
    the substrings that match [r], and returns the list of substrings.
    For instance, [split (regexp "[ \t]+") s] splits [s] into
    blank-separated words.  An occurrence of the delimiter at the
-   beginning and at the end of the string is ignored. *)
+   beginning or at the end of the string is ignored. *)
 
 val bounded_split : regexp -> string -> int -> string list
 (** Same as {!Str.split}, but splits into at most [n] substrings,
diff -Nru ocaml-3.12.1/otherlibs/str/strstubs.c ocaml-4.01.0/otherlibs/str/strstubs.c
--- ocaml-3.12.1/otherlibs/str/strstubs.c	2010-05-19 12:22:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/str/strstubs.c	2013-02-25 03:01:31.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*           Xavier Leroy, projet Cristal, INRIA Rocquencourt          */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: strstubs.c 10429 2010-05-19 12:22:24Z xleroy $ */
-
 #include 
 #include 
 #include 
@@ -300,7 +298,7 @@
     /* Push an item on the backtrack stack and continue with next instr */
     if (sp == stack->point + BACKTRACK_STACK_BLOCK_SIZE) {
       struct backtrack_stack * newstack =
-        stat_alloc(sizeof(struct backtrack_stack));
+        caml_stat_alloc(sizeof(struct backtrack_stack));
       newstack->previous = stack;
       stack = newstack;
       sp = stack->point;
diff -Nru ocaml-3.12.1/otherlibs/systhreads/.cvsignore ocaml-4.01.0/otherlibs/systhreads/.cvsignore
--- ocaml-3.12.1/otherlibs/systhreads/.cvsignore	2010-01-20 16:26:46.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-*.x
-thread.ml
-so_locations
-*.so
-*.a
diff -Nru ocaml-3.12.1/otherlibs/systhreads/.depend ocaml-4.01.0/otherlibs/systhreads/.depend
--- ocaml-3.12.1/otherlibs/systhreads/.depend	2010-07-23 15:30:37.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/.depend	2012-07-26 19:21:54.000000000 +0000
@@ -9,18 +9,18 @@
   ../../byterun/mlvalues.h ../../byterun/printexc.h ../../byterun/roots.h \
   ../../byterun/memory.h ../../byterun/signals.h ../../byterun/stacks.h \
   ../../byterun/sys.h threads.h st_posix.h
-condition.cmi: mutex.cmi
-event.cmi:
-mutex.cmi:
-thread.cmi:
-threadUnix.cmi:
-condition.cmo: mutex.cmi condition.cmi
-condition.cmx: mutex.cmx condition.cmi
-event.cmo: mutex.cmi condition.cmi event.cmi
-event.cmx: mutex.cmx condition.cmx event.cmi
-mutex.cmo: mutex.cmi
-mutex.cmx: mutex.cmi
-thread.cmo: thread.cmi
-thread.cmx: thread.cmi
-threadUnix.cmo: thread.cmi threadUnix.cmi
-threadUnix.cmx: thread.cmx threadUnix.cmi
+condition.cmi : mutex.cmi
+event.cmi :
+mutex.cmi :
+thread.cmi :
+threadUnix.cmi :
+condition.cmo : mutex.cmi condition.cmi
+condition.cmx : mutex.cmx condition.cmi
+event.cmo : mutex.cmi condition.cmi event.cmi
+event.cmx : mutex.cmx condition.cmx event.cmi
+mutex.cmo : mutex.cmi
+mutex.cmx : mutex.cmi
+thread.cmo : thread.cmi
+thread.cmx : thread.cmi
+threadUnix.cmo : thread.cmi threadUnix.cmi
+threadUnix.cmx : thread.cmx threadUnix.cmi
diff -Nru ocaml-3.12.1/otherlibs/systhreads/.ignore ocaml-4.01.0/otherlibs/systhreads/.ignore
--- ocaml-3.12.1/otherlibs/systhreads/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/.ignore	2012-07-17 15:31:12.000000000 +0000
@@ -0,0 +1 @@
+thread.ml
diff -Nru ocaml-3.12.1/otherlibs/systhreads/Makefile ocaml-4.01.0/otherlibs/systhreads/Makefile
--- ocaml-3.12.1/otherlibs/systhreads/Makefile	2010-04-27 07:55:08.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/Makefile	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,14 +11,12 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile 10315 2010-04-27 07:55:08Z xleroy $
-
 include ../../config/Makefile
 
 CAMLC=../../ocamlcomp.sh -I ../unix
 CAMLOPT=../../ocamlcompopt.sh -I ../unix
 MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib
-COMPFLAGS=-warn-error A -g
+COMPFLAGS=-w +33..39 -warn-error A -g
 
 BYTECODE_C_OBJS=st_stubs_b.o
 NATIVECODE_C_OBJS=st_stubs_n.o
@@ -30,7 +28,7 @@
 allopt: libthreadsnat.a threads.cmxa
 
 libthreads.a: $(BYTECODE_C_OBJS)
-	$(MKLIB) -o threads $(BYTECODE_C_OBJS)
+	$(MKLIB) -o threads $(BYTECODE_C_OBJS) -lpthread
 
 st_stubs_b.o: st_stubs.c st_posix.h
 	$(BYTECC) -O -I../../byterun $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) \
@@ -43,7 +41,9 @@
 	$(AR) rc libthreadsnat.a $(NATIVECODE_C_OBJS)
 
 st_stubs_n.o: st_stubs.c st_posix.h
-	$(NATIVECC) -O -I../../asmrun -I../../byterun $(NATIVECCCOMPOPTS) $(SHAREDCCCOMPOPTS) -DNATIVE_CODE -DTARGET_$(ARCH) -DSYS_$(SYSTEM) -c st_stubs.c
+	$(NATIVECC) -O -I../../asmrun -I../../byterun $(NATIVECCCOMPOPTS) \
+	            $(SHAREDCCCOMPOPTS) -DNATIVE_CODE -DTARGET_$(ARCH) \
+	            -DSYS_$(SYSTEM) -c st_stubs.c
 	mv st_stubs.o st_stubs_n.o
 
 threads.cma: $(THREAD_OBJS)
diff -Nru ocaml-3.12.1/otherlibs/systhreads/Makefile.nt ocaml-4.01.0/otherlibs/systhreads/Makefile.nt
--- ocaml-3.12.1/otherlibs/systhreads/Makefile.nt	2010-04-27 07:55:08.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/Makefile.nt	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,14 +11,12 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile.nt 10315 2010-04-27 07:55:08Z xleroy $
-
 include ../../config/Makefile
 
 # Compilation options
 CAMLC=../../boot/ocamlrun ../../ocamlc -I ../../stdlib -I ../win32unix
 CAMLOPT=../../boot/ocamlrun ../../ocamlopt -I ../../stdlib -I ../win32unix
-COMPFLAGS=-warn-error A -g
+COMPFLAGS=-w +33 -warn-error A -g
 MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib
 CFLAGS=-I../../byterun $(EXTRACFLAGS)
 
@@ -34,7 +32,8 @@
 allopt: lib$(LIBNAME).$(A) $(LIBNAME).cmxa $(LIBNAME).cmxs $(CMIFILES)
 
 $(LIBNAME).cma: $(CAMLOBJS)
-	$(MKLIB) -o $(LIBNAME) -ocamlc "..\\..\\boot\\ocamlrun ..\\..\\ocamlc" -linkall $(CAMLOBJS) $(LINKOPTS)
+	$(MKLIB) -o $(LIBNAME) -ocamlc "../../boot/ocamlrun ../../ocamlc" \
+	         -linkall $(CAMLOBJS) $(LINKOPTS)
 
 lib$(LIBNAME).$(A): $(COBJS)
 	$(MKLIB) -o $(LIBNAME) $(COBJS) $(LDOPTS)
@@ -46,7 +45,9 @@
 
 
 $(LIBNAME).cmxa: $(CAMLOBJS:.cmo=.cmx)
-	$(MKLIB) -o $(LIBNAME)nat -ocamlopt "..\\..\\boot\\ocamlrun ..\\..\\ocamlopt" -linkall $(CAMLOBJS:.cmo=.cmx) $(LINKOPTS)
+	$(MKLIB) -o $(LIBNAME)nat \
+	         -ocamlopt "../../boot/ocamlrun ../../ocamlopt" -linkall \
+	         $(CAMLOBJS:.cmo=.cmx) $(LINKOPTS)
 	mv $(LIBNAME)nat.cmxa $(LIBNAME).cmxa
 	mv $(LIBNAME)nat.$(A) $(LIBNAME).$(A)
 
@@ -57,7 +58,8 @@
 	$(MKLIB) -o $(LIBNAME)nat $(COBJS_NAT) $(LDOPTS)
 
 st_stubs_n.$(O): st_stubs.c st_win32.h
-	$(NATIVECC) -DNATIVE_CODE -I../../asmrun -I../../byterun $(NATIVECCCOMPOPTS) -c st_stubs.c
+	$(NATIVECC) -DNATIVE_CODE -I../../asmrun -I../../byterun \
+	            $(NATIVECCCOMPOPTS) -c st_stubs.c
 	mv st_stubs.$(O) st_stubs_n.$(O)
 
 $(CAMLOBJS:.cmo=.cmx): ../../ocamlopt
diff -Nru ocaml-3.12.1/otherlibs/systhreads/condition.ml ocaml-4.01.0/otherlibs/systhreads/condition.ml
--- ocaml-3.12.1/otherlibs/systhreads/condition.ml	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/condition.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                         Caml Special Light                          *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: condition.ml 4144 2001-12-07 13:41:02Z xleroy $ *)
-
 type t
 external create: unit -> t = "caml_condition_new"
 external wait: t -> Mutex.t -> unit = "caml_condition_wait"
diff -Nru ocaml-3.12.1/otherlibs/systhreads/condition.mli ocaml-4.01.0/otherlibs/systhreads/condition.mli
--- ocaml-3.12.1/otherlibs/systhreads/condition.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/condition.mli	2013-05-29 18:05:44.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*         Xavier Leroy and Damien Doligez, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,13 +11,11 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: condition.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** Condition variables to synchronize between threads.
 
    Condition variables are used when one thread wants to wait until another
-   thread has finished doing something: the former thread ``waits'' on the
-   condition variable, the latter thread ``signals'' the condition when it
+   thread has finished doing something: the former thread 'waits' on the
+   condition variable, the latter thread 'signals' the condition when it
    is done. Condition variables should always be protected by a mutex.
    The typical use is (if [D] is a shared data structure, [m] its mutex,
    and [c] is a condition variable):
diff -Nru ocaml-3.12.1/otherlibs/systhreads/event.ml ocaml-4.01.0/otherlibs/systhreads/event.ml
--- ocaml-3.12.1/otherlibs/systhreads/event.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/event.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*  David Nowak and Xavier Leroy, projet Cristal, INRIA Rocquencourt   *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: event.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* Events *)
 type 'a basic_event =
   { poll: unit -> bool;
diff -Nru ocaml-3.12.1/otherlibs/systhreads/event.mli ocaml-4.01.0/otherlibs/systhreads/event.mli
--- ocaml-3.12.1/otherlibs/systhreads/event.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/event.mli	2013-05-29 18:05:44.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*  David Nowak and Xavier Leroy, projet Cristal, INRIA Rocquencourt   *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: event.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** First-class synchronous communication.
 
    This module implements synchronous inter-thread communications over
@@ -64,13 +62,13 @@
    operation. *)
 
 val sync : 'a event -> 'a
-(** ``Synchronize'' on an event: offer all the communication
+(** 'Synchronize' on an event: offer all the communication
    possibilities specified in the event to the outside world,
    and block until one of the communications succeed. The result
    value of that communication is returned. *)
 
 val select : 'a event list -> 'a
-(** ``Synchronize'' on an alternative of events.
+(** 'Synchronize' on an alternative of events.
    [select evl] is shorthand for [sync(choose evl)]. *)
 
 val poll : 'a event -> 'a option
diff -Nru ocaml-3.12.1/otherlibs/systhreads/mutex.ml ocaml-4.01.0/otherlibs/systhreads/mutex.ml
--- ocaml-3.12.1/otherlibs/systhreads/mutex.ml	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/mutex.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                         Caml Special Light                          *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*          Xavier Leroy and Pascal Cuoq, INRIA Rocquencourt           *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: mutex.ml 4144 2001-12-07 13:41:02Z xleroy $ *)
-
 type t
 external create: unit -> t = "caml_mutex_new"
 external lock: t -> unit = "caml_mutex_lock"
diff -Nru ocaml-3.12.1/otherlibs/systhreads/mutex.mli ocaml-4.01.0/otherlibs/systhreads/mutex.mli
--- ocaml-3.12.1/otherlibs/systhreads/mutex.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/mutex.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*         Xavier Leroy and Damien Doligez, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: mutex.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** Locks for mutual exclusion.
 
    Mutexes (mutual-exclusion locks) are used to implement critical sections
diff -Nru ocaml-3.12.1/otherlibs/systhreads/st_posix.h ocaml-4.01.0/otherlibs/systhreads/st_posix.h
--- ocaml-3.12.1/otherlibs/systhreads/st_posix.h	2010-04-27 07:55:08.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/st_posix.h	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                             Objective Caml                          */
+/*                                OCaml                                */
 /*                                                                     */
 /*         Xavier Leroy and Damien Doligez, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: posix.c 9270 2009-05-20 11:52:42Z doligez $ */
-
 /* POSIX thread implementation of the "st" interface */
 
 #include 
@@ -158,7 +156,7 @@
 {
   return m->waiters;
 }
- 
+
 /* Mutexes */
 
 typedef pthread_mutex_t * st_mutex;
@@ -254,7 +252,7 @@
   rc = pthread_mutex_init(&e->lock, NULL);
   if (rc != 0) { free(e); return rc; }
   rc = pthread_cond_init(&e->triggered, NULL);
-  if (rc != 0) { free(e); return rc; }
+  if (rc != 0) { pthread_mutex_destroy(&e->lock); free(e); return rc; }
   e->status = 0;
   *res = e;
   return 0;
@@ -320,11 +318,8 @@
 {
   struct timeval timeout;
   sigset_t mask;
-#ifdef __linux__
-  int tickcount = 0;
-#endif
 
-  /* Block all signals so that we don't try to execute a Caml signal handler */
+  /* Block all signals so that we don't try to execute an OCaml signal handler*/
   sigfillset(&mask);
   pthread_sigmask(SIG_BLOCK, &mask, NULL);
   /* Allow async cancellation */
@@ -339,18 +334,6 @@
      go through caml_handle_signal(), just record signal delivery via
      caml_record_signal(). */
     caml_record_signal(SIGPREEMPTION);
-#ifdef __linux__
-    /* Hack around LinuxThreads' non-standard signal handling:
-       if program is killed on a signal, e.g. SIGINT, the current
-       thread will not die on this signal (because of the signal blocking
-       above).  Hence, periodically check that the thread manager (our
-       parent process) still exists. */
-    tickcount++;
-    if (tickcount >= 2000 / Thread_timeout) { /* every 2 secs approx */
-      tickcount = 0;
-      if (getppid() == 1) pthread_exit(NULL);
-    }
-#endif
   }
   return NULL;                  /* prevents compiler warning */
 }
@@ -426,6 +409,6 @@
   return Val_int(signo);
 #else
   invalid_argument("Thread.wait_signal not implemented");
-  return Val_int(0);		/* not reached */
+  return Val_int(0);            /* not reached */
 #endif
 }
diff -Nru ocaml-3.12.1/otherlibs/systhreads/st_stubs.c ocaml-4.01.0/otherlibs/systhreads/st_stubs.c
--- ocaml-3.12.1/otherlibs/systhreads/st_stubs.c	2010-12-22 13:39:00.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/st_stubs.c	2013-07-24 20:42:59.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                             Objective Caml                          */
+/*                                OCaml                                */
 /*                                                                     */
 /*         Xavier Leroy and Damien Doligez, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: posix.c 9270 2009-05-20 11:52:42Z doligez $ */
-
 #include "alloc.h"
 #include "backtrace.h"
 #include "callback.h"
@@ -94,7 +92,7 @@
 /* The descriptor for the currently executing thread */
 static caml_thread_t curr_thread = NULL;
 
-/* The master lock protecting the Caml runtime system */
+/* The master lock protecting the OCaml runtime system */
 static st_masterlock caml_master_lock;
 
 /* Whether the ``tick'' thread is already running */
@@ -279,7 +277,7 @@
     sz += (value *) th->top_of_stack - (value *) th->bottom_of_stack;
 #else
     sz += th->stack_high - th->sp;
-#endif    
+#endif
   }
   if (prev_stack_usage_hook != NULL)
     sz += prev_stack_usage_hook();
@@ -306,7 +304,7 @@
   th->exit_buf = NULL;
 #else
   /* Allocate the stacks */
-  th->stack_low = (value *) stat_alloc(Thread_stack_size);
+  th->stack_low = (value *) caml_stat_alloc(Thread_stack_size);
   th->stack_high = th->stack_low + Thread_stack_size / sizeof(value);
   th->stack_threshold = th->stack_low + Stack_threshold / sizeof(value);
   th->sp = th->stack_high;
@@ -344,7 +342,10 @@
 
 static void caml_thread_remove_info(caml_thread_t th)
 {
-  if (th->next == th) all_threads = NULL; /* last Caml thread exiting */
+  if (th->next == th)
+    all_threads = NULL; /* last OCaml thread exiting */
+  else if (all_threads == th)
+    all_threads = th->next;     /* PR#5295 */
   th->next->prev = th->prev;
   th->prev->next = th->next;
 #ifndef NATIVE_CODE
@@ -405,7 +406,7 @@
   st_tls_newkey(&last_channel_locked_key);
   /* Set up a thread info block for the current thread */
   curr_thread =
-    (caml_thread_t) stat_alloc(sizeof(struct caml_thread_struct));
+    (caml_thread_t) caml_stat_alloc(sizeof(struct caml_thread_struct));
   curr_thread->descr = caml_thread_new_descriptor(Val_unit);
   curr_thread->next = curr_thread;
   curr_thread->prev = curr_thread;
@@ -498,7 +499,7 @@
 #endif
   /* The thread now stops running */
   return 0;
-}  
+}
 
 CAMLprim value caml_thread_new(value clos)          /* ML */
 {
@@ -522,7 +523,7 @@
     caml_thread_remove_info(th);
     st_check_error(err, "Thread.create");
   }
-  /* Create the tick thread if not already done.  
+  /* Create the tick thread if not already done.
      Because of PR#4666, we start the tick thread late, only when we create
      the first additional thread in the current process*/
   if (! caml_tick_thread_running) {
@@ -578,7 +579,7 @@
   return 1;
 }
 
-/* Unregister a thread that was created from C and registered with 
+/* Unregister a thread that was created from C and registered with
    the function above */
 
 CAMLexport int caml_c_thread_unregister(void)
@@ -646,7 +647,7 @@
 #endif
   caml_thread_stop();
   if (exit_buf != NULL) {
-    /* Native-code and (main thread or thread created by Caml) */
+    /* Native-code and (main thread or thread created by OCaml) */
     siglongjmp(exit_buf->buf, 1);
   } else {
     /* Bytecode, or thread created from C */
@@ -685,18 +686,23 @@
   st_mutex_destroy(Mutex_val(wrapper));
 }
 
-static int caml_mutex_condition_compare(value wrapper1, value wrapper2)
+static int caml_mutex_compare(value wrapper1, value wrapper2)
 {
   st_mutex mut1 = Mutex_val(wrapper1);
   st_mutex mut2 = Mutex_val(wrapper2);
   return mut1 == mut2 ? 0 : mut1 < mut2 ? -1 : 1;
 }
 
+static intnat caml_mutex_hash(value wrapper)
+{
+  return (intnat) (Mutex_val(wrapper));
+}
+
 static struct custom_operations caml_mutex_ops = {
   "_mutex",
   caml_mutex_finalize,
-  caml_mutex_condition_compare,
-  custom_hash_default,
+  caml_mutex_compare,
+  caml_mutex_hash,
   custom_serialize_default,
   custom_deserialize_default
 };
@@ -759,13 +765,26 @@
   st_condvar_destroy(Condition_val(wrapper));
 }
 
+static int caml_condition_compare(value wrapper1, value wrapper2)
+{
+  st_condvar cond1 = Condition_val(wrapper1);
+  st_condvar cond2 = Condition_val(wrapper2);
+  return cond1 == cond2 ? 0 : cond1 < cond2 ? -1 : 1;
+}
+
+static intnat caml_condition_hash(value wrapper)
+{
+  return (intnat) (Condition_val(wrapper));
+}
+
 static struct custom_operations caml_condition_ops = {
   "_condition",
   caml_condition_finalize,
-  caml_mutex_condition_compare,
-  custom_hash_default,
+  caml_condition_compare,
+  caml_condition_hash,
   custom_serialize_default,
-  custom_deserialize_default
+  custom_deserialize_default,
+  custom_compare_ext_default
 };
 
 CAMLprim value caml_condition_new(value unit)        /* ML */
@@ -804,7 +823,7 @@
 CAMLprim value caml_condition_broadcast(value wrapper)           /* ML */
 {
   st_check_error(st_condvar_broadcast(Condition_val(wrapper)),
-                 "Condition.signal");
+                 "Condition.broadcast");
   return Val_unit;
 }
 
@@ -818,13 +837,21 @@
   st_event_destroy(Threadstatus_val(wrapper));
 }
 
+static int caml_threadstatus_compare(value wrapper1, value wrapper2)
+{
+  st_event ts1 = Threadstatus_val(wrapper1);
+  st_event ts2 = Threadstatus_val(wrapper2);
+  return ts1 == ts2 ? 0 : ts1 < ts2 ? -1 : 1;
+}
+
 static struct custom_operations caml_threadstatus_ops = {
   "_threadstatus",
   caml_threadstatus_finalize,
-  custom_compare_default,
+  caml_threadstatus_compare,
   custom_hash_default,
   custom_serialize_default,
-  custom_deserialize_default
+  custom_deserialize_default,
+  custom_compare_ext_default
 };
 
 static value caml_threadstatus_new (void)
diff -Nru ocaml-3.12.1/otherlibs/systhreads/st_win32.h ocaml-4.01.0/otherlibs/systhreads/st_win32.h
--- ocaml-3.12.1/otherlibs/systhreads/st_win32.h	2010-04-27 07:55:08.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/st_win32.h	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                             Objective Caml                          */
+/*                                OCaml                                */
 /*                                                                     */
 /*         Xavier Leroy and Damien Doligez, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,12 +11,11 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: posix.c 9270 2009-05-20 11:52:42Z doligez $ */
-
 /* Win32 implementation of the "st" interface */
 
+#define _WIN32_WINNT 0x0400
 #include 
-#include 
+#include 
 #include 
 #include 
 
@@ -28,7 +27,8 @@
 #else
 #include 
 #define TRACE(x) printf("%d: %s\n", GetCurrentThreadId(), x); fflush(stdout)
-#define TRACE1(x,y) printf("%d: %s %p\n", GetCurrentThreadId(), x, (void *)y); fflush(stdout)
+#define TRACE1(x,y) printf("%d: %s %p\n", GetCurrentThreadId(), x, (void *)y); \
+                    fflush(stdout)
 #endif
 
 typedef DWORD st_retcode;
@@ -53,7 +53,7 @@
 
 typedef HANDLE st_thread_id;
 
-static DWORD st_thread_create(st_thread_id * res, 
+static DWORD st_thread_create(st_thread_id * res,
                               LPTHREAD_START_ROUTINE fn, void * arg)
 {
   HANDLE h = CreateThread(NULL, 0, fn, arg, 0, NULL);
@@ -149,7 +149,7 @@
 {
   return 1;                     /* info not maintained */
 }
- 
+
 /* Mutexes */
 
 typedef CRITICAL_SECTION * st_mutex;
@@ -366,12 +366,12 @@
   if (retcode == 0) return;
   if (retcode == ERROR_NOT_ENOUGH_MEMORY) raise_out_of_memory();
   if (! FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS,
-		      NULL,
-		      retcode,
-		      0,
-		      err,
-		      sizeof(err),
-		      NULL)) {
+                      NULL,
+                      retcode,
+                      0,
+                      err,
+                      sizeof(err),
+                      NULL)) {
     sprintf(err, "error code %lx", retcode);
   }
   msglen = strlen(msg);
@@ -409,11 +409,11 @@
 value caml_thread_sigmask(value cmd, value sigs) /* ML */
 {
   invalid_argument("Thread.sigmask not implemented");
-  return Val_int(0);		/* not reached */
+  return Val_int(0);            /* not reached */
 }
 
 value caml_wait_signal(value sigs) /* ML */
 {
   invalid_argument("Thread.wait_signal not implemented");
-  return Val_int(0);		/* not reached */
+  return Val_int(0);            /* not reached */
 }
diff -Nru ocaml-3.12.1/otherlibs/systhreads/thread.ml ocaml-4.01.0/otherlibs/systhreads/thread.ml
--- ocaml-3.12.1/otherlibs/systhreads/thread.ml	2011-06-06 07:34:12.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/thread.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                         Objective Caml                              *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: thread_posix.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* User-level threads *)
 
 type t
@@ -63,7 +61,7 @@
   at_exit
     (fun () ->
         thread_cleanup();
-        (* In case of DLL-embedded Ocaml the preempt_signal handler
+        (* In case of DLL-embedded OCaml the preempt_signal handler
            will point to nowhere after DLL unloading and an accidental
            preempt_signal will crash the main program. So restore the
            default handler. *)
@@ -85,5 +83,6 @@
 
 let wait_pid p = Unix.waitpid [] p
 
-external sigmask : Unix.sigprocmask_command -> int list -> int list = "caml_thread_sigmask"
+external sigmask : Unix.sigprocmask_command -> int list -> int list
+   = "caml_thread_sigmask"
 external wait_signal : int list -> int = "caml_wait_signal"
diff -Nru ocaml-3.12.1/otherlibs/systhreads/thread.mli ocaml-4.01.0/otherlibs/systhreads/thread.mli
--- ocaml-3.12.1/otherlibs/systhreads/thread.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/thread.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                         Objective Caml                              *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: thread.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** Lightweight threads for Posix [1003.1c] and Win32. *)
 
 type t
diff -Nru ocaml-3.12.1/otherlibs/systhreads/threadUnix.ml ocaml-4.01.0/otherlibs/systhreads/threadUnix.ml
--- ocaml-3.12.1/otherlibs/systhreads/threadUnix.ml	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/threadUnix.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: threadUnix.ml 4144 2001-12-07 13:41:02Z xleroy $ *)
-
 (* Module [ThreadUnix]: thread-compatible system calls *)
 
 open Unix
diff -Nru ocaml-3.12.1/otherlibs/systhreads/threadUnix.mli ocaml-4.01.0/otherlibs/systhreads/threadUnix.mli
--- ocaml-3.12.1/otherlibs/systhreads/threadUnix.mli	2002-06-26 09:48:00.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/threadUnix.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: threadUnix.mli 4951 2002-06-26 09:48:00Z xleroy $ *)
-
 (** Thread-compatible system calls.
 
    @deprecated The functionality of this module has been merged back into
diff -Nru ocaml-3.12.1/otherlibs/systhreads/threads.h ocaml-4.01.0/otherlibs/systhreads/threads.h
--- ocaml-3.12.1/otherlibs/systhreads/threads.h	2010-04-27 07:55:08.000000000 +0000
+++ ocaml-4.01.0/otherlibs/systhreads/threads.h	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                             Objective Caml                          */
+/*                                OCaml                                */
 /*                                                                     */
 /*         Xavier Leroy and Damien Doligez, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: posix.c 9270 2009-05-20 11:52:42Z doligez $ */
-
 #ifndef CAML_THREADS_H
 #define CAML_THREADS_H
 
@@ -21,22 +19,22 @@
 #define caml_acquire_runtime_system caml_leave_blocking_section
 #define caml_release_runtime_system caml_enter_blocking_section
 
-/* Manage the master lock around the Caml run-time system.
-   Only one thread at a time can execute Caml compiled code or
-   Caml run-time system functions.
+/* Manage the master lock around the OCaml run-time system.
+   Only one thread at a time can execute OCaml compiled code or
+   OCaml run-time system functions.
 
-   When Caml calls a C function, the current thread holds the master
+   When OCaml calls a C function, the current thread holds the master
    lock.  The C function can release it by calling
-   [caml_release_runtime_system].  Then, another thread can execute Caml
-   code.  However, the calling thread must not access any Caml data,
-   nor call any runtime system function, nor call back into Caml.
+   [caml_release_runtime_system].  Then, another thread can execute OCaml
+   code.  However, the calling thread must not access any OCaml data,
+   nor call any runtime system function, nor call back into OCaml.
 
-   Before returning to its Caml caller, or accessing Caml data,
+   Before returning to its OCaml caller, or accessing OCaml data,
    or call runtime system functions, the current thread must
    re-acquire the master lock by calling [caml_acquire_runtime_system].
 
-   Symmetrically, if a C function (not called from Caml) wishes to
-   call back into Caml code, it should invoke [caml_acquire_runtime_system]
+   Symmetrically, if a C function (not called from OCaml) wishes to
+   call back into OCaml code, it should invoke [caml_acquire_runtime_system]
    first, then do the callback, then invoke [caml_release_runtime_system].
 
    For historical reasons, alternate names can be used:
@@ -49,9 +47,9 @@
 CAMLextern int caml_c_thread_register(void);
 CAMLextern int caml_c_thread_unregister(void);
 
-/* If a thread is created by C code (instead of by Caml itself),
-   it must be registered with the Caml runtime system before
-   being able to call back into Caml code or use other runtime system
+/* If a thread is created by C code (instead of by OCaml itself),
+   it must be registered with the OCaml runtime system before
+   being able to call back into OCaml code or use other runtime system
    functions.  Just call [caml_c_thread_register] once.
    Before the thread finishes, it must call [caml_c_thread_unregister].
    Both functions return 1 on success, 0 on error.
diff -Nru ocaml-3.12.1/otherlibs/threads/.cvsignore ocaml-4.01.0/otherlibs/threads/.cvsignore
--- ocaml-3.12.1/otherlibs/threads/.cvsignore	2010-01-20 16:26:46.000000000 +0000
+++ ocaml-4.01.0/otherlibs/threads/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-marshal.mli
-pervasives.mli
-unix.mli
-*.so
-*.a
diff -Nru ocaml-3.12.1/otherlibs/threads/.depend ocaml-4.01.0/otherlibs/threads/.depend
--- ocaml-3.12.1/otherlibs/threads/.depend	2010-07-23 15:30:37.000000000 +0000
+++ ocaml-4.01.0/otherlibs/threads/.depend	2013-08-15 16:13:16.000000000 +0000
@@ -9,24 +9,24 @@
   ../../byterun/mlvalues.h ../../byterun/printexc.h ../../byterun/roots.h \
   ../../byterun/memory.h ../../byterun/signals.h ../../byterun/stacks.h \
   ../../byterun/sys.h
-condition.cmi: mutex.cmi
-event.cmi:
-mutex.cmi:
-thread.cmi: unix.cmo
-threadUnix.cmi: unix.cmo
-condition.cmo: thread.cmi mutex.cmi condition.cmi
-condition.cmx: thread.cmx mutex.cmx condition.cmi
-event.cmo: mutex.cmi condition.cmi event.cmi
-event.cmx: mutex.cmx condition.cmx event.cmi
-marshal.cmo: pervasives.cmo
-marshal.cmx: pervasives.cmx
-mutex.cmo: thread.cmi mutex.cmi
-mutex.cmx: thread.cmx mutex.cmi
-pervasives.cmo: unix.cmo
-pervasives.cmx: unix.cmx
-thread.cmo: unix.cmo thread.cmi
-thread.cmx: unix.cmx thread.cmi
-threadUnix.cmo: unix.cmo thread.cmi threadUnix.cmi
-threadUnix.cmx: unix.cmx thread.cmx threadUnix.cmi
-unix.cmo:
-unix.cmx:
+condition.cmi : mutex.cmi
+event.cmi :
+mutex.cmi :
+thread.cmi : unix.cmo
+threadUnix.cmi : unix.cmo
+condition.cmo : thread.cmi mutex.cmi condition.cmi
+condition.cmx : thread.cmx mutex.cmx condition.cmi
+event.cmo : mutex.cmi condition.cmi event.cmi
+event.cmx : mutex.cmx condition.cmx event.cmi
+marshal.cmo : pervasives.cmo
+marshal.cmx : pervasives.cmx
+mutex.cmo : thread.cmi mutex.cmi
+mutex.cmx : thread.cmx mutex.cmi
+pervasives.cmo : unix.cmo
+pervasives.cmx : unix.cmx
+thread.cmo : unix.cmo thread.cmi
+thread.cmx : unix.cmx thread.cmi
+threadUnix.cmo : unix.cmo thread.cmi threadUnix.cmi
+threadUnix.cmx : unix.cmx thread.cmx threadUnix.cmi
+unix.cmo :
+unix.cmx :
diff -Nru ocaml-3.12.1/otherlibs/threads/.ignore ocaml-4.01.0/otherlibs/threads/.ignore
--- ocaml-3.12.1/otherlibs/threads/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/otherlibs/threads/.ignore	2012-07-17 15:31:12.000000000 +0000
@@ -0,0 +1,3 @@
+marshal.mli
+pervasives.mli
+unix.mli
diff -Nru ocaml-3.12.1/otherlibs/threads/Makefile ocaml-4.01.0/otherlibs/threads/Makefile
--- ocaml-3.12.1/otherlibs/threads/Makefile	2008-12-03 18:09:09.000000000 +0000
+++ ocaml-4.01.0/otherlibs/threads/Makefile	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,15 +11,13 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile 9153 2008-12-03 18:09:09Z doligez $
-
 include ../../config/Makefile
 
 CC=$(BYTECC)
 CFLAGS=-I../../byterun -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) -g
 CAMLC=../../ocamlcomp.sh -I ../unix
 MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib
-COMPFLAGS=-warn-error A
+COMPFLAGS=-w +33..39 -warn-error A
 
 C_OBJS=scheduler.o
 
@@ -28,22 +26,20 @@
 LIB=../../stdlib
 
 LIB_OBJS=pervasives.cmo \
-  $(LIB)/array.cmo $(LIB)/list.cmo $(LIB)/char.cmo $(LIB)/string.cmo \
-  $(LIB)/sys.cmo $(LIB)/hashtbl.cmo $(LIB)/sort.cmo \
-  marshal.cmo $(LIB)/obj.cmo $(LIB)/int32.cmo $(LIB)/int64.cmo \
-  $(LIB)/nativeint.cmo \
-  $(LIB)/lexing.cmo $(LIB)/parsing.cmo \
-  $(LIB)/set.cmo $(LIB)/map.cmo $(LIB)/stack.cmo $(LIB)/queue.cmo \
-  $(LIB)/camlinternalLazy.cmo $(LIB)/lazy.cmo \
-  $(LIB)/stream.cmo $(LIB)/buffer.cmo \
-  $(LIB)/printf.cmo $(LIB)/format.cmo \
-  $(LIB)/scanf.cmo $(LIB)/arg.cmo \
-  $(LIB)/printexc.cmo $(LIB)/gc.cmo $(LIB)/digest.cmo $(LIB)/random.cmo \
-  $(LIB)/camlinternalOO.cmo $(LIB)/oo.cmo $(LIB)/camlinternalMod.cmo \
-  $(LIB)/genlex.cmo $(LIB)/callback.cmo $(LIB)/weak.cmo \
-  $(LIB)/filename.cmo $(LIB)/complex.cmo \
-  $(LIB)/arrayLabels.cmo $(LIB)/listLabels.cmo $(LIB)/stringLabels.cmo \
-  $(LIB)/stdLabels.cmo $(LIB)/moreLabels.cmo
+  $(LIB)/array.cmo $(LIB)/list.cmo $(LIB)/char.cmo $(LIB)/string.cmo        \
+  $(LIB)/sys.cmo $(LIB)/sort.cmo marshal.cmo $(LIB)/obj.cmo                 \
+  $(LIB)/int32.cmo $(LIB)/int64.cmo $(LIB)/nativeint.cmo                    \
+  $(LIB)/lexing.cmo $(LIB)/parsing.cmo $(LIB)/set.cmo $(LIB)/map.cmo        \
+  $(LIB)/stack.cmo $(LIB)/queue.cmo $(LIB)/camlinternalLazy.cmo             \
+  $(LIB)/lazy.cmo $(LIB)/stream.cmo $(LIB)/buffer.cmo                       \
+  $(LIB)/printf.cmo $(LIB)/arg.cmo $(LIB)/printexc.cmo $(LIB)/gc.cmo        \
+  $(LIB)/digest.cmo $(LIB)/random.cmo $(LIB)/hashtbl.cmo                    \
+  $(LIB)/format.cmo $(LIB)/scanf.cmo $(LIB)/callback.cmo \
+  $(LIB)/camlinternalOO.cmo              \
+  $(LIB)/oo.cmo $(LIB)/camlinternalMod.cmo $(LIB)/genlex.cmo                \
+  $(LIB)/weak.cmo $(LIB)/filename.cmo                   \
+  $(LIB)/complex.cmo $(LIB)/arrayLabels.cmo $(LIB)/listLabels.cmo           \
+  $(LIB)/stringLabels.cmo $(LIB)/stdLabels.cmo $(LIB)/moreLabels.cmo
 
 UNIXLIB=../unix
 
@@ -104,8 +100,10 @@
 	mkdir -p $(LIBDIR)/vmthreads
 	cp libvmthreads.a $(LIBDIR)/vmthreads/libvmthreads.a
 	cd $(LIBDIR)/vmthreads; $(RANLIB) libvmthreads.a
-	cp thread.cmi mutex.cmi condition.cmi event.cmi threadUnix.cmi threads.cma stdlib.cma unix.cma $(LIBDIR)/vmthreads
-	cp thread.mli mutex.mli condition.mli event.mli threadUnix.mli $(LIBDIR)/vmthreads
+	cp thread.cmi mutex.cmi condition.cmi event.cmi threadUnix.cmi \
+	   threads.cma stdlib.cma unix.cma $(LIBDIR)/vmthreads
+	cp thread.mli mutex.mli condition.mli event.mli threadUnix.mli \
+	   $(LIBDIR)/vmthreads
 
 installopt:
 
diff -Nru ocaml-3.12.1/otherlibs/threads/condition.ml ocaml-4.01.0/otherlibs/threads/condition.ml
--- ocaml-3.12.1/otherlibs/threads/condition.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/threads/condition.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*         Xavier Leroy and Damien Doligez, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: condition.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 type t = { mutable waiting: Thread.t list }
 
 let create () = { waiting = [] }
diff -Nru ocaml-3.12.1/otherlibs/threads/condition.mli ocaml-4.01.0/otherlibs/threads/condition.mli
--- ocaml-3.12.1/otherlibs/threads/condition.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/threads/condition.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*         Xavier Leroy and Damien Doligez, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: condition.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** Condition variables to synchronize between threads.
 
    Condition variables are used when one thread wants to wait until another
diff -Nru ocaml-3.12.1/otherlibs/threads/event.ml ocaml-4.01.0/otherlibs/threads/event.ml
--- ocaml-3.12.1/otherlibs/threads/event.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/threads/event.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*  David Nowak and Xavier Leroy, projet Cristal, INRIA Rocquencourt   *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: event.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* Events *)
 type 'a basic_event =
   { poll: unit -> bool;
diff -Nru ocaml-3.12.1/otherlibs/threads/event.mli ocaml-4.01.0/otherlibs/threads/event.mli
--- ocaml-3.12.1/otherlibs/threads/event.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/threads/event.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*  David Nowak and Xavier Leroy, projet Cristal, INRIA Rocquencourt   *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: event.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** First-class synchronous communication.
 
    This module implements synchronous inter-thread communications over
@@ -59,8 +57,8 @@
 
 val guard : (unit -> 'a event) -> 'a event
 (** [guard fn] returns the event that, when synchronized, computes
-   [fn()] and behaves as the resulting event. This allows to
-   compute events with side-effects at the time of the synchronization
+   [fn()] and behaves as the resulting event. This allows events with
+   side-effects to be computed at the time of the synchronization
    operation. *)
 
 val sync : 'a event -> 'a
diff -Nru ocaml-3.12.1/otherlibs/threads/marshal.ml ocaml-4.01.0/otherlibs/threads/marshal.ml
--- ocaml-3.12.1/otherlibs/threads/marshal.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/threads/marshal.ml	2013-04-18 11:58:59.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,11 +11,10 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: marshal.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 type extern_flags =
     No_sharing
   | Closures
+  | Compat_32
 
 external to_string: 'a -> extern_flags list -> string
     = "caml_output_value_to_string"
diff -Nru ocaml-3.12.1/otherlibs/threads/mutex.ml ocaml-4.01.0/otherlibs/threads/mutex.ml
--- ocaml-3.12.1/otherlibs/threads/mutex.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/threads/mutex.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*         Xavier Leroy and Damien Doligez, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: mutex.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 type t = { mutable locked: bool; mutable waiting: Thread.t list }
 
 let create () = { locked = false; waiting = [] }
diff -Nru ocaml-3.12.1/otherlibs/threads/mutex.mli ocaml-4.01.0/otherlibs/threads/mutex.mli
--- ocaml-3.12.1/otherlibs/threads/mutex.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/threads/mutex.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*         Xavier Leroy and Damien Doligez, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: mutex.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** Locks for mutual exclusion.
 
    Mutexes (mutual-exclusion locks) are used to implement critical sections
diff -Nru ocaml-3.12.1/otherlibs/threads/pervasives.ml ocaml-4.01.0/otherlibs/threads/pervasives.ml
--- ocaml-3.12.1/otherlibs/threads/pervasives.ml	2010-06-09 10:23:48.000000000 +0000
+++ ocaml-4.01.0/otherlibs/threads/pervasives.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: pervasives.ml 10547 2010-06-09 10:23:48Z weis $ *)
-
 (* Same as ../../stdlib/pervasives.ml, except that I/O functions have
    been redefined to not block the whole process, but only the calling
    thread. *)
@@ -28,6 +26,11 @@
 
 exception Exit
 
+(* Composition operators *)
+
+external (|>) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
+
 (* Comparisons *)
 
 external (=) : 'a -> 'a -> bool = "%equal"
@@ -94,6 +97,8 @@
 external asin : float -> float = "caml_asin_float" "asin" "float"
 external atan : float -> float = "caml_atan_float" "atan" "float"
 external atan2 : float -> float -> float = "caml_atan2_float" "atan2" "float"
+external hypot : float -> float -> float
+   = "caml_hypot_float" "caml_hypot" "float"
 external cos : float -> float = "caml_cos_float" "cos" "float"
 external cosh : float -> float = "caml_cosh_float" "cosh" "float"
 external log : float -> float = "caml_log_float" "log" "float"
@@ -107,6 +112,8 @@
 external ceil : float -> float = "caml_ceil_float" "ceil" "float"
 external floor : float -> float = "caml_floor_float" "floor" "float"
 external abs_float : float -> float = "%absfloat"
+external copysign : float -> float -> float
+   = "caml_copysign_float" "caml_copysign" "float"
 external mod_float : float -> float -> float = "caml_fmod_float" "fmod" "float"
 external frexp : float -> float * int = "caml_frexp_float"
 external ldexp : float -> int -> float = "caml_ldexp_float"
diff -Nru ocaml-3.12.1/otherlibs/threads/scheduler.c ocaml-4.01.0/otherlibs/threads/scheduler.c
--- ocaml-3.12.1/otherlibs/threads/scheduler.c	2005-09-22 14:21:50.000000000 +0000
+++ ocaml-4.01.0/otherlibs/threads/scheduler.c	2013-02-25 03:01:31.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: scheduler.c 7064 2005-09-22 14:21:50Z xleroy $ */
-
 /* The thread scheduler */
 
 #include 
@@ -227,7 +225,7 @@
   End_roots();
   th->ident = next_ident;
   next_ident = Val_int(Int_val(next_ident) + 1);
-  th->stack_low = (value *) stat_alloc(Thread_stack_size);
+  th->stack_low = (value *) caml_stat_alloc(Thread_stack_size);
   th->stack_high = th->stack_low + Thread_stack_size / sizeof(value);
   th->stack_threshold = th->stack_low + Stack_threshold / sizeof(value);
   th->sp = th->stack_high;
diff -Nru ocaml-3.12.1/otherlibs/threads/thread.ml ocaml-4.01.0/otherlibs/threads/thread.ml
--- ocaml-3.12.1/otherlibs/threads/thread.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/threads/thread.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: thread.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* User-level threads *)
 
 type t
@@ -28,6 +26,11 @@
       Unix.file_descr list * Unix.file_descr list * Unix.file_descr list
   | Resumed_wait of int * Unix.process_status
 
+(* to avoid warning *)
+let _ = [Resumed_wakeup; Resumed_delay; Resumed_join;
+         Resumed_io; Resumed_select ([], [], []);
+         Resumed_wait (0, Unix.WEXITED 0)]
+
 (* It is mucho important that the primitives that reschedule are called
    through an ML function call, not directly. That's because when such a
    primitive returns, the bytecode interpreter is only semi-obedient:
@@ -39,7 +42,8 @@
    must take exactly one argument. *)
 
 external thread_initialize : unit -> unit = "thread_initialize"
-external thread_initialize_preemption : unit -> unit = "thread_initialize_preemption"
+external thread_initialize_preemption : unit -> unit
+   = "thread_initialize_preemption"
 external thread_new : (unit -> unit) -> t = "thread_new"
 external thread_yield : unit -> unit = "thread_yield"
 external thread_request_reschedule : unit -> unit = "thread_request_reschedule"
diff -Nru ocaml-3.12.1/otherlibs/threads/thread.mli ocaml-4.01.0/otherlibs/threads/thread.mli
--- ocaml-3.12.1/otherlibs/threads/thread.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/threads/thread.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: thread.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (** Lightweight threads. *)
 
 type t
diff -Nru ocaml-3.12.1/otherlibs/threads/threadUnix.ml ocaml-4.01.0/otherlibs/threads/threadUnix.ml
--- ocaml-3.12.1/otherlibs/threads/threadUnix.ml	2004-07-13 12:25:21.000000000 +0000
+++ ocaml-4.01.0/otherlibs/threads/threadUnix.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: threadUnix.ml 6553 2004-07-13 12:25:21Z xleroy $ *)
-
 (* Module [ThreadUnix]: thread-compatible system calls *)
 
 let execv = Unix.execv
diff -Nru ocaml-3.12.1/otherlibs/threads/threadUnix.mli ocaml-4.01.0/otherlibs/threads/threadUnix.mli
--- ocaml-3.12.1/otherlibs/threads/threadUnix.mli	2004-07-13 12:25:21.000000000 +0000
+++ ocaml-4.01.0/otherlibs/threads/threadUnix.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: threadUnix.mli 6553 2004-07-13 12:25:21Z xleroy $ *)
-
 (** Thread-compatible system calls.
 
    @deprecated The functionality of this module has been merged back into
diff -Nru ocaml-3.12.1/otherlibs/threads/unix.ml ocaml-4.01.0/otherlibs/threads/unix.ml
--- ocaml-3.12.1/otherlibs/threads/unix.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/threads/unix.ml	2013-08-01 15:31:25.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: unix.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* An alternate implementation of the Unix module from ../unix
    which is safe in conjunction with bytecode threads. *)
 
@@ -36,6 +34,11 @@
   | Resumed_select of file_descr list * file_descr list * file_descr list
   | Resumed_wait of int * process_status
 
+(* to avoid warning *)
+let _ = [Resumed_wakeup; Resumed_delay; Resumed_join;
+         Resumed_io; Resumed_select ([], [], []);
+         Resumed_wait (0, WEXITED 0)]
+
 external thread_initialize : unit -> unit = "thread_initialize"
 external thread_wait_read : file_descr -> unit = "thread_wait_read"
 external thread_wait_write : file_descr -> unit = "thread_wait_write"
@@ -192,6 +195,8 @@
   | O_DSYNC
   | O_SYNC
   | O_RSYNC
+  | O_SHARE_DELETE
+  | O_CLOEXEC
 
 type file_perm = int
 
diff -Nru ocaml-3.12.1/otherlibs/unix/.cvsignore ocaml-4.01.0/otherlibs/unix/.cvsignore
--- ocaml-3.12.1/otherlibs/unix/.cvsignore	2010-01-20 16:26:46.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,3 +0,0 @@
-so_locations
-*.so
-*.a
diff -Nru ocaml-3.12.1/otherlibs/unix/.depend ocaml-4.01.0/otherlibs/unix/.depend
--- ocaml-3.12.1/otherlibs/unix/.depend	2011-07-04 21:15:01.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/.depend	2013-08-15 16:13:16.000000000 +0000
@@ -12,7 +12,9 @@
 addrofstr.o: addrofstr.c ../../byterun/mlvalues.h \
   ../../byterun/compatibility.h ../../byterun/config.h \
   ../../byterun/../config/m.h ../../byterun/../config/s.h \
-  ../../byterun/misc.h ../../byterun/fail.h ../../byterun/mlvalues.h \
+  ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/fail.h \
   unixsupport.h socketaddr.h ../../byterun/misc.h
 alarm.o: alarm.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
   ../../byterun/config.h ../../byterun/../config/m.h \
@@ -449,9 +451,9 @@
   ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
   ../../byterun/freelist.h ../../byterun/minor_gc.h \
   ../../byterun/signals.h unixsupport.h
-unix.cmi:
-unixLabels.cmi: unix.cmi
-unix.cmo: unix.cmi
-unix.cmx: unix.cmi
-unixLabels.cmo: unix.cmi unixLabels.cmi
-unixLabels.cmx: unix.cmx unixLabels.cmi
+unix.cmi :
+unixLabels.cmi : unix.cmi
+unix.cmo : unix.cmi
+unix.cmx : unix.cmi
+unixLabels.cmo : unix.cmi unixLabels.cmi
+unixLabels.cmx : unix.cmx unixLabels.cmi
diff -Nru ocaml-3.12.1/otherlibs/unix/Makefile ocaml-4.01.0/otherlibs/unix/Makefile
--- ocaml-3.12.1/otherlibs/unix/Makefile	2010-05-20 09:40:41.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/Makefile	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,8 +11,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile 10442 2010-05-20 09:40:41Z xleroy $
-
 # Makefile for the Unix interface library
 
 LIBNAME=unix
diff -Nru ocaml-3.12.1/otherlibs/unix/accept.c ocaml-4.01.0/otherlibs/unix/accept.c
--- ocaml-3.12.1/otherlibs/unix/accept.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/accept.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: accept.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/access.c ocaml-4.01.0/otherlibs/unix/access.c
--- ocaml-3.12.1/otherlibs/unix/access.c	2008-01-11 16:13:18.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/access.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: access.c 8768 2008-01-11 16:13:18Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/addrofstr.c ocaml-4.01.0/otherlibs/unix/addrofstr.c
--- ocaml-3.12.1/otherlibs/unix/addrofstr.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/addrofstr.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,9 +11,8 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: addrofstr.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
+#include 
 #include 
 #include "unixsupport.h"
 
@@ -24,6 +23,39 @@
 CAMLprim value unix_inet_addr_of_string(value s)
 {
 #if defined(HAS_IPV6)
+#ifdef _WIN32
+  CAMLparam1(s);
+  CAMLlocal1(vres);
+  struct addrinfo hints;
+  struct addrinfo * res;
+  int retcode;
+  memset(&hints, 0, sizeof(hints));
+  hints.ai_family = AF_UNSPEC;
+  hints.ai_flags = AI_NUMERICHOST;
+  retcode = getaddrinfo(String_val(s), NULL, &hints, &res);
+  if (retcode != 0) failwith("inet_addr_of_string");
+  switch (res->ai_addr->sa_family) {
+  case AF_INET:
+    {
+      vres =
+        alloc_inet_addr(&((struct sockaddr_in *) res->ai_addr)->sin_addr);
+      break;
+    }
+  case AF_INET6:
+    {
+      vres =
+        alloc_inet6_addr(&((struct sockaddr_in6 *) res->ai_addr)->sin6_addr);
+      break;
+    }
+  default:
+    {
+      freeaddrinfo(res);
+      failwith("inet_addr_of_string");
+    }
+  }
+  freeaddrinfo(res);
+  CAMLreturn (vres);
+#else
   struct in_addr address;
   struct in6_addr address6;
   if (inet_pton(AF_INET, String_val(s), &address) > 0)
@@ -32,6 +64,7 @@
     return alloc_inet6_addr(&address6);
   else
     failwith("inet_addr_of_string");
+#endif
 #elif defined(HAS_INET_ATON)
   struct in_addr address;
   if (inet_aton(String_val(s), &address) == 0)
diff -Nru ocaml-3.12.1/otherlibs/unix/alarm.c ocaml-4.01.0/otherlibs/unix/alarm.c
--- ocaml-3.12.1/otherlibs/unix/alarm.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/alarm.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: alarm.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/bind.c ocaml-4.01.0/otherlibs/unix/bind.c
--- ocaml-3.12.1/otherlibs/unix/bind.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/bind.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: bind.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/chdir.c ocaml-4.01.0/otherlibs/unix/chdir.c
--- ocaml-3.12.1/otherlibs/unix/chdir.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/chdir.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: chdir.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/chmod.c ocaml-4.01.0/otherlibs/unix/chmod.c
--- ocaml-3.12.1/otherlibs/unix/chmod.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/chmod.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: chmod.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/chown.c ocaml-4.01.0/otherlibs/unix/chown.c
--- ocaml-3.12.1/otherlibs/unix/chown.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/chown.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: chown.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/chroot.c ocaml-4.01.0/otherlibs/unix/chroot.c
--- ocaml-3.12.1/otherlibs/unix/chroot.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/chroot.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: chroot.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/close.c ocaml-4.01.0/otherlibs/unix/close.c
--- ocaml-3.12.1/otherlibs/unix/close.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/close.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: close.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/closedir.c ocaml-4.01.0/otherlibs/unix/closedir.c
--- ocaml-3.12.1/otherlibs/unix/closedir.c	2004-02-14 10:21:23.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/closedir.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: closedir.c 6113 2004-02-14 10:21:23Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/connect.c ocaml-4.01.0/otherlibs/unix/connect.c
--- ocaml-3.12.1/otherlibs/unix/connect.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/connect.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: connect.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/cst2constr.c ocaml-4.01.0/otherlibs/unix/cst2constr.c
--- ocaml-3.12.1/otherlibs/unix/cst2constr.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/cst2constr.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: cst2constr.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include 
 #include "cst2constr.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/cst2constr.h ocaml-4.01.0/otherlibs/unix/cst2constr.h
--- ocaml-3.12.1/otherlibs/unix/cst2constr.h	2004-04-09 13:25:23.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/cst2constr.h	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,6 +11,4 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: cst2constr.h 6193 2004-04-09 13:25:23Z xleroy $ */
-
 extern value cst_to_constr(int n, int * tbl, int size, int deflt);
diff -Nru ocaml-3.12.1/otherlibs/unix/cstringv.c ocaml-4.01.0/otherlibs/unix/cstringv.c
--- ocaml-3.12.1/otherlibs/unix/cstringv.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/cstringv.c	2013-02-25 03:01:31.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: cstringv.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
@@ -23,7 +21,7 @@
   mlsize_t size, i;
 
   size = Wosize_val(arg);
-  res = (char **) stat_alloc((size + 1) * sizeof(char *));
+  res = (char **) caml_stat_alloc((size + 1) * sizeof(char *));
   for (i = 0; i < size; i++) res[i] = String_val(Field(arg, i));
   res[size] = NULL;
   return res;
diff -Nru ocaml-3.12.1/otherlibs/unix/dup.c ocaml-4.01.0/otherlibs/unix/dup.c
--- ocaml-3.12.1/otherlibs/unix/dup.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/dup.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: dup.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/dup2.c ocaml-4.01.0/otherlibs/unix/dup2.c
--- ocaml-3.12.1/otherlibs/unix/dup2.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/dup2.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: dup2.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/envir.c ocaml-4.01.0/otherlibs/unix/envir.c
--- ocaml-3.12.1/otherlibs/unix/envir.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/envir.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: envir.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 
@@ -22,5 +20,9 @@
 
 CAMLprim value unix_environment(value unit)
 {
-  return copy_string_array((const char**)environ);
+  if (environ != NULL) {
+    return copy_string_array((const char**)environ);
+  } else {
+    return Atom(0);
+  }
 }
diff -Nru ocaml-3.12.1/otherlibs/unix/errmsg.c ocaml-4.01.0/otherlibs/unix/errmsg.c
--- ocaml-3.12.1/otherlibs/unix/errmsg.c	2004-05-23 15:53:50.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/errmsg.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: errmsg.c 6315 2004-05-23 15:53:50Z xleroy $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/execv.c ocaml-4.01.0/otherlibs/unix/execv.c
--- ocaml-3.12.1/otherlibs/unix/execv.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/execv.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: execv.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/execve.c ocaml-4.01.0/otherlibs/unix/execve.c
--- ocaml-3.12.1/otherlibs/unix/execve.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/execve.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: execve.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/execvp.c ocaml-4.01.0/otherlibs/unix/execvp.c
--- ocaml-3.12.1/otherlibs/unix/execvp.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/execvp.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: execvp.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/exit.c ocaml-4.01.0/otherlibs/unix/exit.c
--- ocaml-3.12.1/otherlibs/unix/exit.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/exit.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: exit.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/fchmod.c ocaml-4.01.0/otherlibs/unix/fchmod.c
--- ocaml-3.12.1/otherlibs/unix/fchmod.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/fchmod.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: fchmod.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/fchown.c ocaml-4.01.0/otherlibs/unix/fchown.c
--- ocaml-3.12.1/otherlibs/unix/fchown.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/fchown.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: fchown.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/fcntl.c ocaml-4.01.0/otherlibs/unix/fcntl.c
--- ocaml-3.12.1/otherlibs/unix/fcntl.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/fcntl.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: fcntl.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/fork.c ocaml-4.01.0/otherlibs/unix/fork.c
--- ocaml-3.12.1/otherlibs/unix/fork.c	2010-04-20 15:47:15.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/fork.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: fork.c 10287 2010-04-20 15:47:15Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/ftruncate.c ocaml-4.01.0/otherlibs/unix/ftruncate.c
--- ocaml-3.12.1/otherlibs/unix/ftruncate.c	2007-02-09 13:31:15.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/ftruncate.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: ftruncate.c 7849 2007-02-09 13:31:15Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/getaddrinfo.c ocaml-4.01.0/otherlibs/unix/getaddrinfo.c
--- ocaml-3.12.1/otherlibs/unix/getaddrinfo.c	2005-08-13 20:59:37.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/getaddrinfo.c	2013-02-25 03:01:31.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getaddrinfo.c 7019 2005-08-13 20:59:37Z doligez $ */
-
 #include 
 #include 
 #include 
@@ -69,7 +67,7 @@
   if (len == 0) {
     node = NULL;
   } else {
-    node = stat_alloc(len + 1);
+    node = caml_stat_alloc(len + 1);
     strcpy(node, String_val(vnode));
   }
   /* Extract "service" parameter */
@@ -77,7 +75,7 @@
   if (len == 0) {
     serv = NULL;
   } else {
-    serv = stat_alloc(len + 1);
+    serv = caml_stat_alloc(len + 1);
     strcpy(serv, String_val(vserv));
   }
   /* Parse options, set hints */
diff -Nru ocaml-3.12.1/otherlibs/unix/getcwd.c ocaml-4.01.0/otherlibs/unix/getcwd.c
--- ocaml-3.12.1/otherlibs/unix/getcwd.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/getcwd.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getcwd.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/getegid.c ocaml-4.01.0/otherlibs/unix/getegid.c
--- ocaml-3.12.1/otherlibs/unix/getegid.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/getegid.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getegid.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/geteuid.c ocaml-4.01.0/otherlibs/unix/geteuid.c
--- ocaml-3.12.1/otherlibs/unix/geteuid.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/geteuid.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: geteuid.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/getgid.c ocaml-4.01.0/otherlibs/unix/getgid.c
--- ocaml-3.12.1/otherlibs/unix/getgid.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/getgid.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getgid.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/getgr.c ocaml-4.01.0/otherlibs/unix/getgr.c
--- ocaml-3.12.1/otherlibs/unix/getgr.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/getgr.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getgr.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/getgroups.c ocaml-4.01.0/otherlibs/unix/getgroups.c
--- ocaml-3.12.1/otherlibs/unix/getgroups.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/getgroups.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getgroups.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/gethost.c ocaml-4.01.0/otherlibs/unix/gethost.c
--- ocaml-3.12.1/otherlibs/unix/gethost.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/gethost.c	2013-02-25 03:01:31.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: gethost.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
@@ -129,7 +127,7 @@
   char * hostname;
 
 #if HAS_GETHOSTBYNAME_R || GETHOSTBYNAME_IS_REENTRANT
-  hostname = stat_alloc(string_length(name) + 1);
+  hostname = caml_stat_alloc(string_length(name) + 1);
   strcpy(hostname, String_val(name));
 #else
   hostname = String_val(name);
diff -Nru ocaml-3.12.1/otherlibs/unix/gethostname.c ocaml-4.01.0/otherlibs/unix/gethostname.c
--- ocaml-3.12.1/otherlibs/unix/gethostname.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/gethostname.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,14 +11,10 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: gethostname.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include 
-#if defined (_WIN32)
-#include 
-#else
+#ifndef _WIN32
 #include 
 #endif
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/getlogin.c ocaml-4.01.0/otherlibs/unix/getlogin.c
--- ocaml-3.12.1/otherlibs/unix/getlogin.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/getlogin.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getlogin.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/getnameinfo.c ocaml-4.01.0/otherlibs/unix/getnameinfo.c
--- ocaml-3.12.1/otherlibs/unix/getnameinfo.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/getnameinfo.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getnameinfo.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/getpeername.c ocaml-4.01.0/otherlibs/unix/getpeername.c
--- ocaml-3.12.1/otherlibs/unix/getpeername.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/getpeername.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getpeername.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/getpid.c ocaml-4.01.0/otherlibs/unix/getpid.c
--- ocaml-3.12.1/otherlibs/unix/getpid.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/getpid.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getpid.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/getppid.c ocaml-4.01.0/otherlibs/unix/getppid.c
--- ocaml-3.12.1/otherlibs/unix/getppid.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/getppid.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getppid.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/getproto.c ocaml-4.01.0/otherlibs/unix/getproto.c
--- ocaml-3.12.1/otherlibs/unix/getproto.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/getproto.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getproto.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
@@ -23,8 +21,6 @@
 
 #ifndef _WIN32
 #include 
-#else
-#include 
 #endif
 
 static value alloc_proto_entry(struct protoent *entry)
diff -Nru ocaml-3.12.1/otherlibs/unix/getpw.c ocaml-4.01.0/otherlibs/unix/getpw.c
--- ocaml-3.12.1/otherlibs/unix/getpw.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/getpw.c	2013-01-13 13:05:37.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getpw.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include 
 #include 
@@ -29,7 +27,7 @@
   Begin_roots5 (name, passwd, gecos, dir, shell);
     name = copy_string(entry->pw_name);
     passwd = copy_string(entry->pw_passwd);
-#ifndef __BEOS__
+#if !defined(__BEOS__) && !defined(__ANDROID__)
     gecos = copy_string(entry->pw_gecos);
 #else
     gecos = copy_string("");
diff -Nru ocaml-3.12.1/otherlibs/unix/getserv.c ocaml-4.01.0/otherlibs/unix/getserv.c
--- ocaml-3.12.1/otherlibs/unix/getserv.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/getserv.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getserv.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
@@ -27,8 +25,6 @@
 #include 
 #include 
 #include 
-#else
-#include 
 #endif
 
 static value alloc_service_entry(struct servent *entry)
diff -Nru ocaml-3.12.1/otherlibs/unix/getsockname.c ocaml-4.01.0/otherlibs/unix/getsockname.c
--- ocaml-3.12.1/otherlibs/unix/getsockname.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/getsockname.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getsockname.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/gettimeofday.c ocaml-4.01.0/otherlibs/unix/gettimeofday.c
--- ocaml-3.12.1/otherlibs/unix/gettimeofday.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/gettimeofday.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: gettimeofday.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/getuid.c ocaml-4.01.0/otherlibs/unix/getuid.c
--- ocaml-3.12.1/otherlibs/unix/getuid.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/getuid.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getuid.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/gmtime.c ocaml-4.01.0/otherlibs/unix/gmtime.c
--- ocaml-3.12.1/otherlibs/unix/gmtime.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/gmtime.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: gmtime.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/initgroups.c ocaml-4.01.0/otherlibs/unix/initgroups.c
--- ocaml-3.12.1/otherlibs/unix/initgroups.c	2009-04-16 07:23:35.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/initgroups.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,8 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
+/*                                                                     */
+/*  Contributed by Stephane Glondu                   */
 /*                                                                     */
 /*  Copyright 2009 Institut National de Recherche en Informatique et   */
 /*  en Automatique.  All rights reserved.  This file is distributed    */
@@ -9,10 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* Contributed by Stephane Glondu  */
-
-/* $Id: initgroups.c 9235 2009-04-16 07:23:35Z xleroy $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/isatty.c ocaml-4.01.0/otherlibs/unix/isatty.c
--- ocaml-3.12.1/otherlibs/unix/isatty.c	2006-09-21 13:54:26.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/isatty.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: isatty.c 7632 2006-09-21 13:54:26Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/itimer.c ocaml-4.01.0/otherlibs/unix/itimer.c
--- ocaml-3.12.1/otherlibs/unix/itimer.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/itimer.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: itimer.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/kill.c ocaml-4.01.0/otherlibs/unix/kill.c
--- ocaml-3.12.1/otherlibs/unix/kill.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/kill.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: kill.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/link.c ocaml-4.01.0/otherlibs/unix/link.c
--- ocaml-3.12.1/otherlibs/unix/link.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/link.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: link.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/listen.c ocaml-4.01.0/otherlibs/unix/listen.c
--- ocaml-3.12.1/otherlibs/unix/listen.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/listen.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: listen.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/lockf.c ocaml-4.01.0/otherlibs/unix/lockf.c
--- ocaml-3.12.1/otherlibs/unix/lockf.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/lockf.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: lockf.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/lseek.c ocaml-4.01.0/otherlibs/unix/lseek.c
--- ocaml-3.12.1/otherlibs/unix/lseek.c	2010-08-18 12:44:33.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/lseek.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: lseek.c 10647 2010-08-18 12:44:33Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/mkdir.c ocaml-4.01.0/otherlibs/unix/mkdir.c
--- ocaml-3.12.1/otherlibs/unix/mkdir.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/mkdir.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: mkdir.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/mkfifo.c ocaml-4.01.0/otherlibs/unix/mkfifo.c
--- ocaml-3.12.1/otherlibs/unix/mkfifo.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/mkfifo.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: mkfifo.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/nice.c ocaml-4.01.0/otherlibs/unix/nice.c
--- ocaml-3.12.1/otherlibs/unix/nice.c	2008-08-01 13:14:36.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/nice.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: nice.c 8967 2008-08-01 13:14:36Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/open.c ocaml-4.01.0/otherlibs/unix/open.c
--- ocaml-3.12.1/otherlibs/unix/open.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/open.c	2013-08-01 12:13:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,14 +11,15 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: open.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
 #include 
 #include "unixsupport.h"
 #include 
+#ifdef HAS_UNISTD
+#include 
+#endif
 #include 
 
 #ifndef O_NONBLOCK
@@ -33,26 +34,49 @@
 #ifndef O_RSYNC
 #define O_RSYNC 0
 #endif
+#ifndef O_CLOEXEC
+#define NEED_CLOEXEC_EMULATION
+#define O_CLOEXEC 0
+#endif
 
-static int open_flag_table[] = {
+static int open_flag_table[14] = {
   O_RDONLY, O_WRONLY, O_RDWR, O_NONBLOCK, O_APPEND, O_CREAT, O_TRUNC, O_EXCL,
-  O_NOCTTY, O_DSYNC, O_SYNC, O_RSYNC
+  O_NOCTTY, O_DSYNC, O_SYNC, O_RSYNC,
+  0, /* O_SHARE_DELETE, Windows-only */
+  O_CLOEXEC
 };
 
+#ifdef NEED_CLOEXEC_EMULATION
+static int open_cloexec_table[14] = {
+  0, 0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0,
+  0,
+  1
+};
+#endif
+
 CAMLprim value unix_open(value path, value flags, value perm)
 {
   CAMLparam3(path, flags, perm);
-  int ret, cv_flags;
+  int fd, cv_flags;
   char * p;
 
   cv_flags = convert_flag_list(flags, open_flag_table);
-  p = stat_alloc(string_length(path) + 1);
+  p = caml_stat_alloc(string_length(path) + 1);
   strcpy(p, String_val(path));
   /* open on a named FIFO can block (PR#1533) */
   enter_blocking_section();
-  ret = open(p, cv_flags, Int_val(perm));
+  fd = open(p, cv_flags, Int_val(perm));
   leave_blocking_section();
   stat_free(p);
-  if (ret == -1) uerror("open", path);
-  CAMLreturn (Val_int(ret));
+  if (fd == -1) uerror("open", path);
+#if defined(NEED_CLOEXEC_EMULATION) && defined(FD_CLOEXEC)
+  if (convert_flag_list(flags, open_cloexec_table) != 0) {
+    int flags = fcntl(fd, F_GETFD, 0);
+    if (flags == -1 ||
+        fcntl(fd, F_SETFD, flags | FD_CLOEXEC) == -1)
+      uerror("open", path);
+  }
+#endif
+  CAMLreturn (Val_int(fd));
 }
diff -Nru ocaml-3.12.1/otherlibs/unix/opendir.c ocaml-4.01.0/otherlibs/unix/opendir.c
--- ocaml-3.12.1/otherlibs/unix/opendir.c	2004-02-14 10:21:23.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/opendir.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: opendir.c 6113 2004-02-14 10:21:23Z xleroy $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/pipe.c ocaml-4.01.0/otherlibs/unix/pipe.c
--- ocaml-3.12.1/otherlibs/unix/pipe.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/pipe.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: pipe.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/putenv.c ocaml-4.01.0/otherlibs/unix/putenv.c
--- ocaml-3.12.1/otherlibs/unix/putenv.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/putenv.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: putenv.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 
@@ -28,13 +26,16 @@
 {
   mlsize_t namelen = string_length(name);
   mlsize_t vallen = string_length(val);
-  char * s = (char *) stat_alloc(namelen + 1 + vallen + 1);
+  char * s = (char *) caml_stat_alloc(namelen + 1 + vallen + 1);
 
   memmove (s, String_val(name), namelen);
   s[namelen] = '=';
   memmove (s + namelen + 1, String_val(val), vallen);
   s[namelen + 1 + vallen] = 0;
-  if (putenv(s) == -1) uerror("putenv", name);
+  if (putenv(s) == -1) {
+    caml_stat_free(s);
+    uerror("putenv", name);
+  }
   return Val_unit;
 }
 
diff -Nru ocaml-3.12.1/otherlibs/unix/read.c ocaml-4.01.0/otherlibs/unix/read.c
--- ocaml-3.12.1/otherlibs/unix/read.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/read.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: read.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/readdir.c ocaml-4.01.0/otherlibs/unix/readdir.c
--- ocaml-3.12.1/otherlibs/unix/readdir.c	2004-02-14 10:21:23.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/readdir.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: readdir.c 6113 2004-02-14 10:21:23Z xleroy $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/readlink.c ocaml-4.01.0/otherlibs/unix/readlink.c
--- ocaml-3.12.1/otherlibs/unix/readlink.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/readlink.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: readlink.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/rename.c ocaml-4.01.0/otherlibs/unix/rename.c
--- ocaml-3.12.1/otherlibs/unix/rename.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/rename.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: rename.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/rewinddir.c ocaml-4.01.0/otherlibs/unix/rewinddir.c
--- ocaml-3.12.1/otherlibs/unix/rewinddir.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/rewinddir.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: rewinddir.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/rmdir.c ocaml-4.01.0/otherlibs/unix/rmdir.c
--- ocaml-3.12.1/otherlibs/unix/rmdir.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/rmdir.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: rmdir.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/select.c ocaml-4.01.0/otherlibs/unix/select.c
--- ocaml-3.12.1/otherlibs/unix/select.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/select.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: select.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
@@ -29,18 +27,20 @@
 #endif
 #include 
 #include 
+#include 
 
-typedef fd_set file_descr_set;
-
-static void fdlist_to_fdset(value fdlist, fd_set *fdset, int *maxfd)
+static int fdlist_to_fdset(value fdlist, fd_set *fdset, int *maxfd)
 {
   value l;
   FD_ZERO(fdset);
   for (l = fdlist; l != Val_int(0); l = Field(l, 1)) {
-    int fd = Int_val(Field(l, 0));
-    FD_SET(fd, fdset);
+    long fd = Long_val(Field(l, 0));
+    /* PR#5563: harden against bad fds */
+    if (fd < 0 || fd >= FD_SETSIZE) return -1;
+    FD_SET((int) fd, fdset);
     if (fd > *maxfd) *maxfd = fd;
   }
+  return 0;
 }
 
 static value fdset_to_fdlist(value fdlist, fd_set *fdset)
@@ -75,9 +75,11 @@
 
   Begin_roots3 (readfds, writefds, exceptfds);
     maxfd = -1;
-    fdlist_to_fdset(readfds, &read, &maxfd);
-    fdlist_to_fdset(writefds, &write, &maxfd);
-    fdlist_to_fdset(exceptfds, &except, &maxfd);
+    retcode  = fdlist_to_fdset(readfds, &read, &maxfd);
+    retcode += fdlist_to_fdset(writefds, &write, &maxfd);
+    retcode += fdlist_to_fdset(exceptfds, &except, &maxfd);
+    /* PR#5563: if a bad fd was encountered, report EINVAL error */
+    if (retcode != 0) unix_error(EINVAL, "select", Nothing);
     tm = Double_val(timeout);
     if (tm < 0.0)
       tvp = (struct timeval *) NULL;
diff -Nru ocaml-3.12.1/otherlibs/unix/sendrecv.c ocaml-4.01.0/otherlibs/unix/sendrecv.c
--- ocaml-3.12.1/otherlibs/unix/sendrecv.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/sendrecv.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: sendrecv.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/setgid.c ocaml-4.01.0/otherlibs/unix/setgid.c
--- ocaml-3.12.1/otherlibs/unix/setgid.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/setgid.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: setgid.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/setgroups.c ocaml-4.01.0/otherlibs/unix/setgroups.c
--- ocaml-3.12.1/otherlibs/unix/setgroups.c	2009-04-01 16:50:10.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/setgroups.c	2013-02-25 03:01:31.000000000 +0000
@@ -1,6 +1,8 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
+/*                                                                     */
+/* Contributed by Stephane Glondu                    */
 /*                                                                     */
 /*  Copyright 2009 Institut National de Recherche en Informatique et   */
 /*  en Automatique.  All rights reserved.  This file is distributed    */
@@ -9,10 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* Contributed by Stephane Glondu  */
-
-/* $Id: setgroups.c 9220 2009-04-01 16:50:10Z xleroy $ */
-
 #include 
 #include 
 #include 
@@ -35,7 +33,7 @@
   int n;
 
   size = Wosize_val(groups);
-  gidset = (gid_t *) stat_alloc(size * sizeof(gid_t));
+  gidset = (gid_t *) caml_stat_alloc(size * sizeof(gid_t));
   for (i = 0; i < size; i++) gidset[i] = Int_val(Field(groups, i));
 
   n = setgroups(size, gidset);
diff -Nru ocaml-3.12.1/otherlibs/unix/setsid.c ocaml-4.01.0/otherlibs/unix/setsid.c
--- ocaml-3.12.1/otherlibs/unix/setsid.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/setsid.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: setsid.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/setuid.c ocaml-4.01.0/otherlibs/unix/setuid.c
--- ocaml-3.12.1/otherlibs/unix/setuid.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/setuid.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: setuid.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/shutdown.c ocaml-4.01.0/otherlibs/unix/shutdown.c
--- ocaml-3.12.1/otherlibs/unix/shutdown.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/shutdown.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: shutdown.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/signals.c ocaml-4.01.0/otherlibs/unix/signals.c
--- ocaml-3.12.1/otherlibs/unix/signals.c	2008-01-11 16:13:18.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/signals.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: signals.c 8768 2008-01-11 16:13:18Z doligez $ */
-
 #include 
 #include 
 
diff -Nru ocaml-3.12.1/otherlibs/unix/sleep.c ocaml-4.01.0/otherlibs/unix/sleep.c
--- ocaml-3.12.1/otherlibs/unix/sleep.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/sleep.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: sleep.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/socket.c ocaml-4.01.0/otherlibs/unix/socket.c
--- ocaml-3.12.1/otherlibs/unix/socket.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/socket.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: socket.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/socketaddr.c ocaml-4.01.0/otherlibs/unix/socketaddr.c
--- ocaml-3.12.1/otherlibs/unix/socketaddr.c	2010-01-20 16:26:46.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/socketaddr.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: socketaddr.c 9540 2010-01-20 16:26:46Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/socketaddr.h ocaml-4.01.0/otherlibs/unix/socketaddr.h
--- ocaml-3.12.1/otherlibs/unix/socketaddr.h	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/socketaddr.h	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,9 +11,7 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: socketaddr.h 6824 2005-03-24 17:20:54Z doligez $ */
-
-#include 
+#include "misc.h"
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/socketpair.c ocaml-4.01.0/otherlibs/unix/socketpair.c
--- ocaml-3.12.1/otherlibs/unix/socketpair.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/socketpair.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: socketpair.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/sockopt.c ocaml-4.01.0/otherlibs/unix/sockopt.c
--- ocaml-3.12.1/otherlibs/unix/sockopt.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/sockopt.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: sockopt.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/stat.c ocaml-4.01.0/otherlibs/unix/stat.c
--- ocaml-3.12.1/otherlibs/unix/stat.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/stat.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: stat.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/strofaddr.c ocaml-4.01.0/otherlibs/unix/strofaddr.c
--- ocaml-3.12.1/otherlibs/unix/strofaddr.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/strofaddr.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: strofaddr.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include 
@@ -26,6 +24,29 @@
 {
   char * res;
 #ifdef HAS_IPV6
+#ifdef _WIN32
+  char buffer[64];
+  union sock_addr_union sa;
+  int len;
+  int retcode;
+  if (string_length(a) == 16) {
+    memset(&sa.s_inet6, 0, sizeof(struct sockaddr_in6));
+    sa.s_inet6.sin6_family = AF_INET6;
+    sa.s_inet6.sin6_addr = GET_INET6_ADDR(a);
+    len = sizeof(struct sockaddr_in6);
+  } else {
+    memset(&sa.s_inet, 0, sizeof(struct sockaddr_in));
+    sa.s_inet.sin_family = AF_INET;
+    sa.s_inet.sin_addr = GET_INET_ADDR(a);
+    len = sizeof(struct sockaddr_in);
+  }
+  retcode = getnameinfo
+    (&sa.s_gen, len, buffer, sizeof(buffer), NULL, 0, NI_NUMERICHOST);
+  if (retcode != 0)
+    res = NULL;
+  else
+    res = buffer;
+#else
   char buffer[64];
   if (string_length(a) == 16)
     res = (char *)
@@ -35,6 +56,7 @@
     res = (char *)
       inet_ntop(AF_INET, (const void *) &GET_INET_ADDR(a),
                 buffer, sizeof(buffer));
+#endif
 #else
   res = inet_ntoa(GET_INET_ADDR(a));
 #endif
diff -Nru ocaml-3.12.1/otherlibs/unix/symlink.c ocaml-4.01.0/otherlibs/unix/symlink.c
--- ocaml-3.12.1/otherlibs/unix/symlink.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/symlink.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: symlink.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/termios.c ocaml-4.01.0/otherlibs/unix/termios.c
--- ocaml-3.12.1/otherlibs/unix/termios.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/termios.c	2013-01-13 13:05:37.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: termios.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
@@ -265,11 +263,16 @@
   return Val_unit;
 }
 
+#if defined(__ANDROID__)
+CAMLprim value unix_tcdrain(value fd)
+{ invalid_argument("tcdrain not implemented"); }
+#else
 CAMLprim value unix_tcdrain(value fd)
 {
   if (tcdrain(Int_val(fd)) == -1) uerror("tcdrain", Nothing);
   return Val_unit;
 }
+#endif
 
 static int queue_flag_table[] = {
   TCIFLUSH, TCOFLUSH, TCIOFLUSH
diff -Nru ocaml-3.12.1/otherlibs/unix/time.c ocaml-4.01.0/otherlibs/unix/time.c
--- ocaml-3.12.1/otherlibs/unix/time.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/time.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: time.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/times.c ocaml-4.01.0/otherlibs/unix/times.c
--- ocaml-3.12.1/otherlibs/unix/times.c	2006-04-16 23:28:22.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/times.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: times.c 7382 2006-04-16 23:28:22Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/truncate.c ocaml-4.01.0/otherlibs/unix/truncate.c
--- ocaml-3.12.1/otherlibs/unix/truncate.c	2007-02-09 13:31:15.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/truncate.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: truncate.c 7849 2007-02-09 13:31:15Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/umask.c ocaml-4.01.0/otherlibs/unix/umask.c
--- ocaml-3.12.1/otherlibs/unix/umask.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/umask.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: umask.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/unix.ml ocaml-4.01.0/otherlibs/unix/unix.ml
--- ocaml-3.12.1/otherlibs/unix/unix.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/unix.ml	2013-08-01 12:13:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: unix.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 type error =
     E2BIG
   | EACCES
@@ -91,6 +89,83 @@
 
 external error_message : error -> string = "unix_error_message"
 
+let () =
+  Printexc.register_printer
+    (function
+      | Unix_error (e, s, s') ->
+          let msg = match e with
+          | E2BIG -> "E2BIG"
+          | EACCES -> "EACCES"
+          | EAGAIN -> "EAGAIN"
+          | EBADF -> "EBADF"
+          | EBUSY -> "EBUSY"
+          | ECHILD -> "ECHILD"
+          | EDEADLK -> "EDEADLK"
+          | EDOM -> "EDOM"
+          | EEXIST -> "EEXIST"
+          | EFAULT -> "EFAULT"
+          | EFBIG -> "EFBIG"
+          | EINTR -> "EINTR"
+          | EINVAL -> "EINVAL"
+          | EIO -> "EIO"
+          | EISDIR -> "EISDIR"
+          | EMFILE -> "EMFILE"
+          | EMLINK -> "EMLINK"
+          | ENAMETOOLONG -> "ENAMETOOLONG"
+          | ENFILE -> "ENFILE"
+          | ENODEV -> "ENODEV"
+          | ENOENT -> "ENOENT"
+          | ENOEXEC -> "ENOEXEC"
+          | ENOLCK -> "ENOLCK"
+          | ENOMEM -> "ENOMEM"
+          | ENOSPC -> "ENOSPC"
+          | ENOSYS -> "ENOSYS"
+          | ENOTDIR -> "ENOTDIR"
+          | ENOTEMPTY -> "ENOTEMPTY"
+          | ENOTTY -> "ENOTTY"
+          | ENXIO -> "ENXIO"
+          | EPERM -> "EPERM"
+          | EPIPE -> "EPIPE"
+          | ERANGE -> "ERANGE"
+          | EROFS -> "EROFS"
+          | ESPIPE -> "ESPIPE"
+          | ESRCH -> "ESRCH"
+          | EXDEV -> "EXDEV"
+          | EWOULDBLOCK -> "EWOULDBLOCK"
+          | EINPROGRESS -> "EINPROGRESS"
+          | EALREADY -> "EALREADY"
+          | ENOTSOCK -> "ENOTSOCK"
+          | EDESTADDRREQ -> "EDESTADDRREQ"
+          | EMSGSIZE -> "EMSGSIZE"
+          | EPROTOTYPE -> "EPROTOTYPE"
+          | ENOPROTOOPT -> "ENOPROTOOPT"
+          | EPROTONOSUPPORT -> "EPROTONOSUPPORT"
+          | ESOCKTNOSUPPORT -> "ESOCKTNOSUPPORT"
+          | EOPNOTSUPP -> "EOPNOTSUPP"
+          | EPFNOSUPPORT -> "EPFNOSUPPORT"
+          | EAFNOSUPPORT -> "EAFNOSUPPORT"
+          | EADDRINUSE -> "EADDRINUSE"
+          | EADDRNOTAVAIL -> "EADDRNOTAVAIL"
+          | ENETDOWN -> "ENETDOWN"
+          | ENETUNREACH -> "ENETUNREACH"
+          | ENETRESET -> "ENETRESET"
+          | ECONNABORTED -> "ECONNABORTED"
+          | ECONNRESET -> "ECONNRESET"
+          | ENOBUFS -> "ENOBUFS"
+          | EISCONN -> "EISCONN"
+          | ENOTCONN -> "ENOTCONN"
+          | ESHUTDOWN -> "ESHUTDOWN"
+          | ETOOMANYREFS -> "ETOOMANYREFS"
+          | ETIMEDOUT -> "ETIMEDOUT"
+          | ECONNREFUSED -> "ECONNREFUSED"
+          | EHOSTDOWN -> "EHOSTDOWN"
+          | EHOSTUNREACH -> "EHOSTUNREACH"
+          | ELOOP -> "ELOOP"
+          | EOVERFLOW -> "EOVERFLOW"
+          | EUNKNOWNERR x -> Printf.sprintf "EUNKNOWNERR %d" x in
+          Some (Printf.sprintf "Unix.Unix_error(Unix.%s, %S, %S)" msg s s')
+      | _ -> None)
+
 let handle_unix_error f arg =
   try
     f arg
@@ -127,7 +202,8 @@
 external execvpe : string -> string array -> string array -> 'a = "unix_execvpe"
 external fork : unit -> int = "unix_fork"
 external wait : unit -> int * process_status = "unix_wait"
-external waitpid : wait_flag list -> int -> int * process_status = "unix_waitpid"
+external waitpid : wait_flag list -> int -> int * process_status
+   = "unix_waitpid"
 external getpid : unit -> int = "unix_getpid"
 external getppid : unit -> int = "unix_getppid"
 external nice : int -> int = "unix_nice"
@@ -151,6 +227,8 @@
   | O_DSYNC
   | O_SYNC
   | O_RSYNC
+  | O_SHARE_DELETE
+  | O_CLOEXEC
 
 type file_perm = int
 
@@ -161,7 +239,8 @@
 external close : file_descr -> unit = "unix_close"
 external unsafe_read : file_descr -> string -> int -> int -> int = "unix_read"
 external unsafe_write : file_descr -> string -> int -> int -> int = "unix_write"
-external unsafe_single_write : file_descr -> string -> int -> int -> int = "unix_single_write"
+external unsafe_single_write : file_descr -> string -> int -> int -> int
+   = "unix_single_write"
 
 let read fd buf ofs len =
   if ofs < 0 || len < 0 || ofs > String.length buf - len
@@ -230,7 +309,8 @@
 
 module LargeFile =
   struct
-    external lseek : file_descr -> int64 -> seek_command -> int64 = "unix_lseek_64"
+    external lseek : file_descr -> int64 -> seek_command -> int64
+       = "unix_lseek_64"
     external truncate : string -> int64 -> unit = "unix_truncate_64"
     external ftruncate : file_descr -> int64 -> unit = "unix_ftruncate_64"
     type stats =
@@ -761,6 +841,10 @@
 
 (* High-level process management (system, popen) *)
 
+let rec waitpid_non_intr pid =
+  try waitpid [] pid
+  with Unix_error (EINTR, _, _) -> waitpid_non_intr pid
+
 let system cmd =
   match fork() with
      0 -> begin try
@@ -768,7 +852,7 @@
           with _ ->
             exit 127
           end
-  | id -> snd(waitpid [] id)
+  | id -> snd(waitpid_non_intr id)
 
 let rec safe_dup fd =
   let new_fd = dup fd in
@@ -838,27 +922,47 @@
 let open_process_in cmd =
   let (in_read, in_write) = pipe() in
   let inchan = in_channel_of_descr in_read in
-  open_proc cmd (Process_in inchan) stdin in_write [in_read];
+  begin
+    try
+      open_proc cmd (Process_in inchan) stdin in_write [in_read];
+    with e ->
+      close_in inchan;
+      close in_write;
+      raise e
+  end;
   close in_write;
   inchan
 
 let open_process_out cmd =
   let (out_read, out_write) = pipe() in
   let outchan = out_channel_of_descr out_write in
-  open_proc cmd (Process_out outchan) out_read stdout [out_write];
+  begin
+    try
+      open_proc cmd (Process_out outchan) out_read stdout [out_write];
+    with e ->
+      close_out outchan;
+      close out_read;
+      raise e
+  end;
   close out_read;
   outchan
 
 let open_process cmd =
   let (in_read, in_write) = pipe() in
-  let (out_read, out_write) = pipe() in
-  let inchan = in_channel_of_descr in_read in
-  let outchan = out_channel_of_descr out_write in
-  open_proc cmd (Process(inchan, outchan)) out_read in_write
+  let fds_to_close = ref [in_read;in_write] in
+  try
+    let (out_read, out_write) = pipe() in
+    fds_to_close := [in_read;in_write;out_read;out_write];
+    let inchan = in_channel_of_descr in_read in
+    let outchan = out_channel_of_descr out_write in
+    open_proc cmd (Process(inchan, outchan)) out_read in_write
                                            [in_read; out_write];
-  close out_read;
-  close in_write;
-  (inchan, outchan)
+    close out_read;
+    close in_write;
+    (inchan, outchan)
+  with e ->
+    List.iter close !fds_to_close;
+    raise e
 
 let open_proc_full cmd env proc input output error toclose =
   let cloexec = List.for_all try_set_close_on_exec toclose in
@@ -874,17 +978,24 @@
 
 let open_process_full cmd env =
   let (in_read, in_write) = pipe() in
-  let (out_read, out_write) = pipe() in
-  let (err_read, err_write) = pipe() in
-  let inchan = in_channel_of_descr in_read in
-  let outchan = out_channel_of_descr out_write in
-  let errchan = in_channel_of_descr err_read in
-  open_proc_full cmd env (Process_full(inchan, outchan, errchan))
-                 out_read in_write err_write [in_read; out_write; err_read];
-  close out_read;
-  close in_write;
-  close err_write;
-  (inchan, outchan, errchan)
+  let fds_to_close = ref [in_read;in_write] in
+  try
+    let (out_read, out_write) = pipe() in
+    fds_to_close := out_read::out_write:: !fds_to_close;
+    let (err_read, err_write) = pipe() in
+    fds_to_close := err_read::err_write:: !fds_to_close;
+    let inchan = in_channel_of_descr in_read in
+    let outchan = out_channel_of_descr out_write in
+    let errchan = in_channel_of_descr err_read in
+    open_proc_full cmd env (Process_full(inchan, outchan, errchan))
+      out_read in_write err_write [in_read; out_write; err_read];
+    close out_read;
+    close in_write;
+    close err_write;
+    (inchan, outchan, errchan)
+  with e ->
+    List.iter close !fds_to_close;
+    raise e
 
 let find_proc_id fun_name proc =
   try
@@ -894,10 +1005,6 @@
   with Not_found ->
     raise(Unix_error(EBADF, fun_name, ""))
 
-let rec waitpid_non_intr pid =
-  try waitpid [] pid
-  with Unix_error (EINTR, _, _) -> waitpid_non_intr pid
-
 let close_process_in inchan =
   let pid = find_proc_id "close_process_in" (Process_in inchan) in
   close_in inchan;
diff -Nru ocaml-3.12.1/otherlibs/unix/unix.mli ocaml-4.01.0/otherlibs/unix/unix.mli
--- ocaml-3.12.1/otherlibs/unix/unix.mli	2011-03-06 16:17:09.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/unix.mli	2013-08-01 12:13:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: unix.mli 10972 2011-03-06 16:17:09Z weis $ *)
-
 (** Interface to the Unix system *)
 
 
@@ -122,7 +120,7 @@
 val getenv : string -> string
 (** Return the value associated to a variable in the process
    environment. Raise [Not_found] if the variable is unbound.
-   (This function is identical to [Sys.getenv].) *)
+   (This function is identical to {!Sys.getenv}.) *)
 
 val putenv : string -> string -> unit
 (** [Unix.putenv name value] sets the value associated to a
@@ -189,7 +187,8 @@
    as the current process.
    Negative pid arguments represent process groups.
    The list of options indicates whether [waitpid] should return
-   immediately without waiting, or also report stopped children. *)
+   immediately without waiting, and whether it should report stopped
+   children. *)
 
 val system : string -> process_status
 (** Execute the given command, wait until it terminates, and return
@@ -235,9 +234,17 @@
   | O_TRUNC                     (** Truncate to 0 length if existing *)
   | O_EXCL                      (** Fail if existing *)
   | O_NOCTTY                    (** Don't make this dev a controlling tty *)
-  | O_DSYNC                     (** Writes complete as `Synchronised I/O data integrity completion' *)
-  | O_SYNC                      (** Writes complete as `Synchronised I/O file integrity completion' *)
-  | O_RSYNC                     (** Reads complete as writes (depending on O_SYNC/O_DSYNC) *)
+  | O_DSYNC                     (** Writes complete as `Synchronised I/O data
+                                   integrity completion' *)
+  | O_SYNC                      (** Writes complete as `Synchronised I/O file
+                                   integrity completion' *)
+  | O_RSYNC                     (** Reads complete as writes (depending on
+                                   O_SYNC/O_DSYNC) *)
+  | O_SHARE_DELETE              (** Windows only: allow the file to be deleted
+                                   while still open *)
+  | O_CLOEXEC                   (** Set the close-on-exec flag on the
+                                   descriptor returned by {!openfile} *)
+
 (** The flags to {!Unix.openfile}. *)
 
 
@@ -246,9 +253,9 @@
     read for group, none for others *)
 
 val openfile : string -> open_flag list -> file_perm -> file_descr
-(** Open the named file with the given flags. Third argument is
-   the permissions to give to the file if it is created. Return
-   a file descriptor on the named file. *)
+(** Open the named file with the given flags. Third argument is the
+   permissions to give to the file if it is created (see
+   {!umask}). Return a file descriptor on the named file. *)
 
 val close : file_descr -> unit
 (** Close a file descriptor. *)
@@ -302,7 +309,8 @@
 
 
 val lseek : file_descr -> int -> seek_command -> int
-(** Set the current position for a file descriptor *)
+(** Set the current position for a file descriptor, and return the resulting
+    offset (from the beginning of the file). *)
 
 val truncate : string -> int -> unit
 (** Truncates the named file to the given size. *)
@@ -475,7 +483,7 @@
 
 
 val mkdir : string -> file_perm -> unit
-(** Create a directory with the given permissions. *)
+(** Create a directory with the given permissions (see {!umask}). *)
 
 val rmdir : string -> unit
 (** Remove an empty directory. *)
@@ -516,7 +524,7 @@
    opened for writing, that's the entrance to the pipe. *)
 
 val mkfifo : string -> file_perm -> unit
-(** Create a named pipe with the given permissions. *)
+(** Create a named pipe with the given permissions (see {!umask}). *)
 
 
 (** {6 High-level process and redirection management} *)
@@ -765,9 +773,11 @@
 
 type interval_timer =
     ITIMER_REAL
-      (** decrements in real time, and sends the signal [SIGALRM] when expired.*)
+      (** decrements in real time, and sends the signal [SIGALRM] when
+         expired.*)
   | ITIMER_VIRTUAL
-      (**  decrements in process virtual time, and sends [SIGVTALRM] when expired. *)
+      (** decrements in process virtual time, and sends [SIGVTALRM]
+          when expired. *)
   | ITIMER_PROF
       (** (for profiling) decrements both when the process
          is running and when the system is running on behalf of the
@@ -1022,8 +1032,9 @@
   | SO_RCVBUF      (** Size of received buffer *)
   | SO_ERROR       (** Deprecated.  Use {!Unix.getsockopt_error} instead. *)
   | SO_TYPE        (** Report the socket type *)
-  | SO_RCVLOWAT    (** Minimum number of bytes to process for input operations *)
-  | SO_SNDLOWAT    (** Minimum number of bytes to process for output operations *)
+  | SO_RCVLOWAT    (** Minimum number of bytes to process for input operations*)
+  | SO_SNDLOWAT    (** Minimum number of bytes to process for output
+                       operations *)
 (** The socket options that can be consulted with {!Unix.getsockopt_int}
    and modified with {!Unix.setsockopt_int}.  These options have an
    integer value. *)
@@ -1058,17 +1069,21 @@
 (** Same as {!Unix.setsockopt} for an integer-valued socket option. *)
 
 val getsockopt_optint : file_descr -> socket_optint_option -> int option
-(** Same as {!Unix.getsockopt} for a socket option whose value is an [int option]. *)
+(** Same as {!Unix.getsockopt} for a socket option whose value is an
+   [int option]. *)
 
 val setsockopt_optint :
       file_descr -> socket_optint_option -> int option -> unit
-(** Same as {!Unix.setsockopt} for a socket option whose value is an [int option]. *)
+(** Same as {!Unix.setsockopt} for a socket option whose value is an
+   [int option]. *)
 
 val getsockopt_float : file_descr -> socket_float_option -> float
-(** Same as {!Unix.getsockopt} for a socket option whose value is a floating-point number. *)
+(** Same as {!Unix.getsockopt} for a socket option whose value is a
+   floating-point number. *)
 
 val setsockopt_float : file_descr -> socket_float_option -> float -> unit
-(** Same as {!Unix.setsockopt} for a socket option whose value is a floating-point number. *)
+(** Same as {!Unix.setsockopt} for a socket option whose value is a
+   floating-point number. *)
 
 val getsockopt_error : file_descr -> error option
 (** Return the error condition associated with the given socket,
diff -Nru ocaml-3.12.1/otherlibs/unix/unixLabels.ml ocaml-4.01.0/otherlibs/unix/unixLabels.ml
--- ocaml-3.12.1/otherlibs/unix/unixLabels.ml	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/unixLabels.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*               Jacques Garrigue, Kyoto University RIMS               *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: unixLabels.ml 4144 2001-12-07 13:41:02Z xleroy $ *)
-
 (* Module [UnixLabels]: labelled Unix module *)
 
 include Unix
diff -Nru ocaml-3.12.1/otherlibs/unix/unixLabels.mli ocaml-4.01.0/otherlibs/unix/unixLabels.mli
--- ocaml-3.12.1/otherlibs/unix/unixLabels.mli	2011-03-06 16:15:34.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/unixLabels.mli	2013-08-01 12:13:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: unixLabels.mli 10971 2011-03-06 16:15:34Z weis $ *)
-
 (** Interface to the Unix system.
    To use as replacement to default {!Unix} module,
    add [module Unix = UnixLabels] in your implementation.
@@ -185,7 +183,8 @@
    and termination status. *)
 
 val waitpid : mode:wait_flag list -> int -> int * process_status
-(** Same as {!UnixLabels.wait}, but waits for the child process whose pid is given.
+(** Same as {!UnixLabels.wait}, but waits for the child process whose pid
+   is given.
    A pid of [-1] means wait for any child.
    A pid of [0] means wait for any child in the same process group
    as the current process.
@@ -240,6 +239,9 @@
   | O_DSYNC                     (** Writes complete as `Synchronised I/O data integrity completion' *)
   | O_SYNC                      (** Writes complete as `Synchronised I/O file integrity completion' *)
   | O_RSYNC                     (** Reads complete as writes (depending on O_SYNC/O_DSYNC) *)
+  | O_SHARE_DELETE              (** Windows only: allow the file to be deleted while still open *)
+  | O_CLOEXEC                   (** Set the close-on-exec flag on the
+                                   descriptor returned by {!openfile} *)
 (** The flags to {!UnixLabels.openfile}. *)
 
 
@@ -304,7 +306,8 @@
 
 
 val lseek : file_descr -> int -> mode:seek_command -> int
-(** Set the current position for a file descriptor *)
+(** Set the current position for a file descriptor, and return the resulting
+    offset (from the beginning of the file). *)
 
 val truncate : string -> len:int -> unit
 (** Truncates the named file to the given size. *)
diff -Nru ocaml-3.12.1/otherlibs/unix/unixsupport.c ocaml-4.01.0/otherlibs/unix/unixsupport.c
--- ocaml-3.12.1/otherlibs/unix/unixsupport.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/unixsupport.c	2013-08-02 14:21:40.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: unixsupport.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
@@ -165,7 +163,11 @@
 #define ESOCKTNOSUPPORT (-1)
 #endif
 #ifndef EOPNOTSUPP
-#define EOPNOTSUPP (-1)
+#  ifdef ENOTSUP
+#    define EOPNOTSUPP ENOTSUP
+#  else
+#    define EOPNOTSUPP (-1)
+#  endif
 #endif
 #ifndef EPFNOSUPPORT
 #define EPFNOSUPPORT (-1)
@@ -252,6 +254,11 @@
   int errconstr;
   value err;
 
+#if defined(ENOTSUP) && (EOPNOTSUPP != ENOTSUP)
+  if (errcode == ENOTSUP)
+    errcode = EOPNOTSUPP;
+#endif
+
   errconstr =
       cst_to_constr(errcode, error_table, sizeof(error_table)/sizeof(int), -1);
   if (errconstr == Val_int(-1)) {
@@ -263,6 +270,15 @@
   return err;
 }
 
+extern int code_of_unix_error (value error)
+{
+  if (Is_block(error)) {
+    return Int_val(Field(error, 0));
+  } else {
+    return error_table[Int_val(error)];
+  }
+}
+
 void unix_error(int errcode, char *cmdname, value cmdarg)
 {
   value res;
@@ -275,7 +291,8 @@
     if (unix_error_exn == NULL) {
       unix_error_exn = caml_named_value("Unix.Unix_error");
       if (unix_error_exn == NULL)
-        invalid_argument("Exception Unix.Unix_error not initialized, please link unix.cma");
+        invalid_argument("Exception Unix.Unix_error not initialized,"
+                         " please link unix.cma");
     }
     res = alloc_small(4, 0);
     Field(res, 0) = *unix_error_exn;
diff -Nru ocaml-3.12.1/otherlibs/unix/unixsupport.h ocaml-4.01.0/otherlibs/unix/unixsupport.h
--- ocaml-3.12.1/otherlibs/unix/unixsupport.h	2005-09-06 12:38:32.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/unixsupport.h	2013-08-02 14:21:40.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: unixsupport.h 7045 2005-09-06 12:38:32Z doligez $ */
-
 #ifdef HAS_UNISTD
 #include 
 #endif
@@ -20,9 +18,10 @@
 #define Nothing ((value) 0)
 
 extern value unix_error_of_code (int errcode);
+extern int code_of_unix_error (value error);
 extern void unix_error (int errcode, char * cmdname, value arg) Noreturn;
 extern void uerror (char * cmdname, value arg) Noreturn;
 
-#define UNIX_BUFFER_SIZE 16384
+#define UNIX_BUFFER_SIZE 65536
 
 #define DIR_Val(v) *((DIR **) &Field(v, 0))
diff -Nru ocaml-3.12.1/otherlibs/unix/unlink.c ocaml-4.01.0/otherlibs/unix/unlink.c
--- ocaml-3.12.1/otherlibs/unix/unlink.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/unlink.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: unlink.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/unix/utimes.c ocaml-4.01.0/otherlibs/unix/utimes.c
--- ocaml-3.12.1/otherlibs/unix/utimes.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/utimes.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: utimes.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/unix/wait.c ocaml-4.01.0/otherlibs/unix/wait.c
--- ocaml-3.12.1/otherlibs/unix/wait.c	2005-04-17 08:23:51.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/wait.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: wait.c 6845 2005-04-17 08:23:51Z xleroy $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/unix/write.c ocaml-4.01.0/otherlibs/unix/write.c
--- ocaml-3.12.1/otherlibs/unix/write.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/unix/write.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: write.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/win32graph/.cvsignore ocaml-4.01.0/otherlibs/win32graph/.cvsignore
--- ocaml-3.12.1/otherlibs/win32graph/.cvsignore	2010-05-19 14:52:34.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32graph/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,2 +0,0 @@
-graphics.ml
-graphics.mli
diff -Nru ocaml-3.12.1/otherlibs/win32graph/.ignore ocaml-4.01.0/otherlibs/win32graph/.ignore
--- ocaml-3.12.1/otherlibs/win32graph/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32graph/.ignore	2011-07-20 15:37:36.000000000 +0000
@@ -0,0 +1,2 @@
+graphics.ml
+graphics.mli
diff -Nru ocaml-3.12.1/otherlibs/win32graph/Makefile.nt ocaml-4.01.0/otherlibs/win32graph/Makefile.nt
--- ocaml-3.12.1/otherlibs/win32graph/Makefile.nt	2007-11-06 15:16:56.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32graph/Makefile.nt	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,8 +11,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile.nt 8477 2007-11-06 15:16:56Z frisch $
-
 LIBNAME=graphics
 COBJS=open.$(O) draw.$(O) events.$(O) dib.$(O)
 CAMLOBJS=graphics.cmo
diff -Nru ocaml-3.12.1/otherlibs/win32graph/dib.c ocaml-4.01.0/otherlibs/win32graph/dib.c
--- ocaml-3.12.1/otherlibs/win32graph/dib.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32graph/dib.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,8 +1,9 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Developed by Jacob Navia                                           */
+/*                                                                     */
 /*  Copyright 2001 Institut National de Recherche en Informatique et   */
 /*  en Automatique.  All rights reserved.  This file is distributed    */
 /*  under the terms of the GNU Library General Public License, with    */
@@ -10,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: dib.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 //-----------------------------------------------------------------------------
 // DIB.C
 //
diff -Nru ocaml-3.12.1/otherlibs/win32graph/draw.c ocaml-4.01.0/otherlibs/win32graph/draw.c
--- ocaml-3.12.1/otherlibs/win32graph/draw.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32graph/draw.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,8 +1,9 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Developed by Jacob Navia, based on code by J-M Geffroy and X Leroy */
+/*                                                                     */
 /*  Copyright 2001 Institut National de Recherche en Informatique et   */
 /*  en Automatique.  All rights reserved.  This file is distributed    */
 /*  under the terms of the GNU Library General Public License, with    */
@@ -10,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: draw.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include "mlvalues.h"
 #include "alloc.h"
@@ -452,7 +451,8 @@
         custom_compare_default,
         custom_hash_default,
         custom_serialize_default,
-        custom_deserialize_default
+        custom_deserialize_default,
+        custom_compare_ext_default
 };
 
 CAMLprim value caml_gr_create_image(value vw, value vh)
diff -Nru ocaml-3.12.1/otherlibs/win32graph/events.c ocaml-4.01.0/otherlibs/win32graph/events.c
--- ocaml-3.12.1/otherlibs/win32graph/events.c	2004-07-13 12:25:21.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32graph/events.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: events.c 6553 2004-07-13 12:25:21Z xleroy $ */
-
 #include "mlvalues.h"
 #include "alloc.h"
 #include "libgraph.h"
diff -Nru ocaml-3.12.1/otherlibs/win32graph/libgraph.h ocaml-4.01.0/otherlibs/win32graph/libgraph.h
--- ocaml-3.12.1/otherlibs/win32graph/libgraph.h	2004-07-13 12:25:21.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32graph/libgraph.h	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Jacob Navia, after Xavier Leroy                          */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: libgraph.h 6553 2004-07-13 12:25:21Z xleroy $ */
-
 #include 
 #include 
 #include 
@@ -43,8 +41,8 @@
 #define DEFAULT_SCREEN_WIDTH 1024
 #define DEFAULT_SCREEN_HEIGHT 768
 #define BORDER_WIDTH 2
-#define WINDOW_NAME "Caml graphics"
-#define ICON_NAME "Caml graphics"
+#define WINDOW_NAME "OCaml graphics"
+#define ICON_NAME "OCaml graphics"
 #define SIZE_QUEUE 256
 
 void gr_fail(char *fmt, char *arg);
diff -Nru ocaml-3.12.1/otherlibs/win32graph/open.c ocaml-4.01.0/otherlibs/win32graph/open.c
--- ocaml-3.12.1/otherlibs/win32graph/open.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32graph/open.c	2013-06-03 19:00:06.000000000 +0000
@@ -1,8 +1,9 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Developed by Jacob Navia, based on code by J-M Geffroy and X Leroy */
+/*                                                                     */
 /*  Copyright 2001 Institut National de Recherche en Informatique et   */
 /*  en Automatique.  All rights reserved.  This file is distributed    */
 /*  under the terms of the GNU Library General Public License, with    */
@@ -10,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: open.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include "mlvalues.h"
@@ -100,6 +99,7 @@
                 // End application
         case WM_DESTROY:
                 ResetForClose(hwnd);
+		gr_check_open();
                 break;
         }
         caml_gr_handle_event(msg, wParam, lParam);
@@ -237,7 +237,7 @@
   caml_gr_init_event_queue();
 
   /* The global data structures are now correctly initialized.
-     Restart the Caml main thread. */
+     Restart the OCaml main thread. */
   open_graph_errmsg = NULL;
   SetEvent(open_graph_event);
 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/.cvsignore ocaml-4.01.0/otherlibs/win32unix/.cvsignore
--- ocaml-3.12.1/otherlibs/win32unix/.cvsignore	2010-05-19 14:52:34.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,27 +0,0 @@
-unixLabels.ml*
-unix.mli
-unix.lib
-access.c
-addrofstr.c
-chdir.c
-chmod.c
-cst2constr.c
-cstringv.c
-envir.c
-execv.c
-execve.c
-execvp.c
-exit.c
-getcwd.c
-gethost.c
-gethostname.c
-getproto.c
-getserv.c
-gmtime.c
-putenv.c
-rmdir.c
-socketaddr.c
-strofaddr.c
-time.c
-unlink.c
-utimes.c
diff -Nru ocaml-3.12.1/otherlibs/win32unix/.ignore ocaml-4.01.0/otherlibs/win32unix/.ignore
--- ocaml-3.12.1/otherlibs/win32unix/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/.ignore	2013-04-29 18:20:56.000000000 +0000
@@ -0,0 +1,29 @@
+unixLabels.ml*
+unix.mli
+unix.lib
+access.c
+addrofstr.c
+chdir.c
+chmod.c
+cst2constr.c
+cstringv.c
+envir.c
+execv.c
+execve.c
+execvp.c
+exit.c
+getaddrinfo.c
+getcwd.c
+gethost.c
+gethostname.c
+getnameinfo.c
+getproto.c
+getserv.c
+gmtime.c
+putenv.c
+rmdir.c
+socketaddr.c
+strofaddr.c
+time.c
+unlink.c
+utimes.c
diff -Nru ocaml-3.12.1/otherlibs/win32unix/Makefile.nt ocaml-4.01.0/otherlibs/win32unix/Makefile.nt
--- ocaml-3.12.1/otherlibs/win32unix/Makefile.nt	2010-05-20 09:40:41.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/Makefile.nt	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,8 +11,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile.nt 10442 2010-05-20 09:40:41Z xleroy $
-
 # Files in this directory
 WIN_FILES = accept.c bind.c channels.c close.c \
   close_on.c connect.c createprocess.c dup.c dup2.c errmsg.c \
@@ -21,13 +19,14 @@
   mkdir.c open.c pipe.c read.c rename.c \
   select.c sendrecv.c \
   shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
-  system.c unixsupport.c windir.c winwait.c write.c \
+  system.c times.c unixsupport.c windir.c winwait.c write.c \
   winlist.c winworker.c windbug.c
 
 # Files from the ../unix directory
 UNIX_FILES = access.c addrofstr.c chdir.c chmod.c cst2constr.c \
   cstringv.c envir.c execv.c execve.c execvp.c \
-  exit.c getcwd.c gethost.c gethostname.c getproto.c \
+  exit.c getaddrinfo.c getcwd.c gethost.c gethostname.c \
+  getnameinfo.c getproto.c \
   getserv.c gmtime.c putenv.c rmdir.c \
   socketaddr.c strofaddr.c time.c unlink.c utimes.c
 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/accept.c ocaml-4.01.0/otherlibs/win32unix/accept.c
--- ocaml-3.12.1/otherlibs/win32unix/accept.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/accept.c	2013-06-14 11:50:12.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,13 +11,12 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: accept.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
 #include 
 #include "unixsupport.h"
+#include    // for SO_OPENTYPE and SO_SYNCHRONOUS_NONALERT
 #include "socketaddr.h"
 
 CAMLprim value unix_accept(sock)
diff -Nru ocaml-3.12.1/otherlibs/win32unix/bind.c ocaml-4.01.0/otherlibs/win32unix/bind.c
--- ocaml-3.12.1/otherlibs/win32unix/bind.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/bind.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: bind.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include "unixsupport.h"
 #include "socketaddr.h"
diff -Nru ocaml-3.12.1/otherlibs/win32unix/channels.c ocaml-4.01.0/otherlibs/win32unix/channels.c
--- ocaml-3.12.1/otherlibs/win32unix/channels.c	2011-05-09 11:38:43.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/channels.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: channels.c 11030 2011-05-09 11:38:43Z doligez $ */
-
 #include 
 #include 
 #include 
@@ -20,15 +18,15 @@
 #include "unixsupport.h"
 #include 
 
-extern long _get_osfhandle(int);
-extern int _open_osfhandle(long, int);
+extern intptr_t _get_osfhandle(int);
+extern int _open_osfhandle(intptr_t, int);
 
 int win_CRT_fd_of_filedescr(value handle)
 {
   if (CRT_fd_val(handle) != NO_CRT_FD) {
     return CRT_fd_val(handle);
   } else {
-    int fd = _open_osfhandle((long) Handle_val(handle), O_BINARY);
+    int fd = _open_osfhandle((intptr_t) Handle_val(handle), O_BINARY);
     if (fd == -1) uerror("channel_of_descr", Nothing);
     CRT_fd_val(handle) = fd;
     return fd;
diff -Nru ocaml-3.12.1/otherlibs/win32unix/close.c ocaml-4.01.0/otherlibs/win32unix/close.c
--- ocaml-3.12.1/otherlibs/win32unix/close.c	2011-05-09 11:38:43.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/close.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: close.c 11030 2011-05-09 11:38:43Z doligez $ */
-
 #include 
 #include "unixsupport.h"
 #include 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/close_on.c ocaml-4.01.0/otherlibs/win32unix/close_on.c
--- ocaml-3.12.1/otherlibs/win32unix/close_on.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/close_on.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   */
 /*                                                                     */
@@ -11,25 +11,20 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: close_on.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
-#include 
 #include "unixsupport.h"
+#include 
 
 int win_set_inherit(value fd, BOOL inherit)
 {
-  HANDLE oldh, newh;
-
-  oldh = Handle_val(fd);
-  if (! DuplicateHandle(GetCurrentProcess(), oldh,
-                        GetCurrentProcess(), &newh,
-                        0L, inherit, DUPLICATE_SAME_ACCESS)) {
+  /* According to the MSDN, SetHandleInformation may not work
+     for console handles on WinNT4 and earlier versions. */
+  if (! SetHandleInformation(Handle_val(fd),
+                             HANDLE_FLAG_INHERIT,
+                             inherit ? HANDLE_FLAG_INHERIT : 0)) {
     win32_maperr(GetLastError());
     return -1;
   }
-  Handle_val(fd) = newh;
-  CloseHandle(oldh);
   return 0;
 }
 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/connect.c ocaml-4.01.0/otherlibs/win32unix/connect.c
--- ocaml-3.12.1/otherlibs/win32unix/connect.c	2006-10-18 08:26:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/connect.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: connect.c 7697 2006-10-18 08:26:54Z xleroy $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/win32unix/createprocess.c ocaml-4.01.0/otherlibs/win32unix/createprocess.c
--- ocaml-3.12.1/otherlibs/win32unix/createprocess.c	2009-07-20 11:51:50.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/createprocess.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   */
 /*                                                                     */
@@ -11,12 +11,10 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: createprocess.c 9319 2009-07-20 11:51:50Z doligez $ */
-
-#include 
 #include 
-#include 
 #include "unixsupport.h"
+#include 
+#include 
 
 static int win_has_console(void);
 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/dup.c ocaml-4.01.0/otherlibs/win32unix/dup.c
--- ocaml-3.12.1/otherlibs/win32unix/dup.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/dup.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: dup.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/dup2.c ocaml-4.01.0/otherlibs/win32unix/dup2.c
--- ocaml-3.12.1/otherlibs/win32unix/dup2.c	2006-09-21 09:43:58.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/dup2.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: dup2.c 7630 2006-09-21 09:43:58Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/errmsg.c ocaml-4.01.0/otherlibs/win32unix/errmsg.c
--- ocaml-3.12.1/otherlibs/win32unix/errmsg.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/errmsg.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: errmsg.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/getpeername.c ocaml-4.01.0/otherlibs/win32unix/getpeername.c
--- ocaml-3.12.1/otherlibs/win32unix/getpeername.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/getpeername.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getpeername.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include "unixsupport.h"
 #include "socketaddr.h"
diff -Nru ocaml-3.12.1/otherlibs/win32unix/getpid.c ocaml-4.01.0/otherlibs/win32unix/getpid.c
--- ocaml-3.12.1/otherlibs/win32unix/getpid.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/getpid.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getpid.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/getsockname.c ocaml-4.01.0/otherlibs/win32unix/getsockname.c
--- ocaml-3.12.1/otherlibs/win32unix/getsockname.c	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/getsockname.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: getsockname.c 6824 2005-03-24 17:20:54Z doligez $ */
-
 #include 
 #include "unixsupport.h"
 #include "socketaddr.h"
diff -Nru ocaml-3.12.1/otherlibs/win32unix/gettimeofday.c ocaml-4.01.0/otherlibs/win32unix/gettimeofday.c
--- ocaml-3.12.1/otherlibs/win32unix/gettimeofday.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/gettimeofday.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,23 +11,41 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: gettimeofday.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
 
 #include "unixsupport.h"
 
+#ifdef HAS_MKTIME
+static double initial_time = 0; /* 0 means uninitialized */
+#else
 static time_t initial_time = 0; /* 0 means uninitialized */
+#endif
 static DWORD initial_tickcount;
 
 CAMLprim value unix_gettimeofday(value unit)
 {
   DWORD tickcount = GetTickCount();
+  SYSTEMTIME st;
+  struct tm tm;
   if (initial_time == 0 || tickcount < initial_tickcount) {
     initial_tickcount = tickcount;
+#ifdef HAS_MKTIME
+    GetLocalTime(&st);
+    tm.tm_sec = st.wSecond;
+    tm.tm_min = st.wMinute;
+    tm.tm_hour = st.wHour;
+    tm.tm_mday = st.wDay;
+    tm.tm_mon = st.wMonth - 1;
+    tm.tm_year = st.wYear - 1900;
+    tm.tm_wday = 0;
+    tm.tm_yday = 0;
+    tm.tm_isdst = -1;
+    initial_time = ((double) mktime(&tm) + (double) st.wMilliseconds * 1e-3);
+#else
     initial_time = time(NULL);
+#endif
     return copy_double((double) initial_time);
   } else {
     return copy_double((double) initial_time +
diff -Nru ocaml-3.12.1/otherlibs/win32unix/link.c ocaml-4.01.0/otherlibs/win32unix/link.c
--- ocaml-3.12.1/otherlibs/win32unix/link.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/link.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*                 File contributed by Lionel Fourquaux                */
 /*                                                                     */
@@ -11,12 +11,10 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: link.c 9547 2010-01-22 12:48:24Z doligez $ */
-
-#include 
 #include 
 #include 
 #include "unixsupport.h"
+#include 
 
 typedef
 BOOL (WINAPI *tCreateHardLink)(
diff -Nru ocaml-3.12.1/otherlibs/win32unix/listen.c ocaml-4.01.0/otherlibs/win32unix/listen.c
--- ocaml-3.12.1/otherlibs/win32unix/listen.c	2002-04-30 15:00:48.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/listen.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: listen.c 4765 2002-04-30 15:00:48Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/lockf.c ocaml-4.01.0/otherlibs/win32unix/lockf.c
--- ocaml-3.12.1/otherlibs/win32unix/lockf.c	2008-12-03 18:09:09.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/lockf.c	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Contributed by Tracy Camp, PolyServe Inc.,    */
 /*  Further improvements by Reed Wilson                                */
@@ -13,8 +13,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: lockf.c 9153 2008-12-03 18:09:09Z doligez $ */
-
 #include 
 #include 
 #include 
@@ -64,7 +62,8 @@
 
   version.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
   if(GetVersionEx(&version) == 0) {
-    invalid_argument("lockf only supported on WIN32_NT platforms: could not determine current platform.");
+    invalid_argument("lockf only supported on WIN32_NT platforms:"
+                     " could not determine current platform.");
   }
   if(version.dwPlatformId != VER_PLATFORM_WIN32_NT) {
     invalid_argument("lockf only supported on WIN32_NT platforms");
diff -Nru ocaml-3.12.1/otherlibs/win32unix/lseek.c ocaml-4.01.0/otherlibs/win32unix/lseek.c
--- ocaml-3.12.1/otherlibs/win32unix/lseek.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/lseek.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: lseek.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/win32unix/mkdir.c ocaml-4.01.0/otherlibs/win32unix/mkdir.c
--- ocaml-3.12.1/otherlibs/win32unix/mkdir.c	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/mkdir.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: mkdir.c 4144 2001-12-07 13:41:02Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/nonblock.c ocaml-4.01.0/otherlibs/win32unix/nonblock.c
--- ocaml-3.12.1/otherlibs/win32unix/nonblock.c	2010-05-25 13:01:06.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/nonblock.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: nonblock.c 10467 2010-05-25 13:01:06Z xleroy $ */
-
 #include 
 #include 
 #include "unixsupport.h"
@@ -26,7 +24,7 @@
     win32_maperr(WSAGetLastError());
     uerror("unix_set_nonblock", Nothing);
   }
-  Flags_fd_val(socket) = Flags_fd_val(socket) | FLAGS_FD_IS_BLOCKING;
+  Flags_fd_val(socket) = Flags_fd_val(socket) & ~FLAGS_FD_IS_BLOCKING;
   return Val_unit;
 }
 
@@ -39,6 +37,6 @@
     win32_maperr(WSAGetLastError());
     uerror("unix_clear_nonblock", Nothing);
   }
-  Flags_fd_val(socket) = Flags_fd_val(socket) & ~FLAGS_FD_IS_BLOCKING;
+  Flags_fd_val(socket) = Flags_fd_val(socket) | FLAGS_FD_IS_BLOCKING;
   return Val_unit;
 }
diff -Nru ocaml-3.12.1/otherlibs/win32unix/open.c ocaml-4.01.0/otherlibs/win32unix/open.c
--- ocaml-3.12.1/otherlibs/win32unix/open.c	2008-01-11 16:13:18.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/open.c	2013-08-01 12:13:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   */
 /*                                                                     */
@@ -11,29 +11,37 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: open.c 8768 2008-01-11 16:13:18Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
 #include 
 
-static int open_access_flags[12] = {
+static int open_access_flags[14] = {
   GENERIC_READ, GENERIC_WRITE, GENERIC_READ|GENERIC_WRITE,
-  0, 0, 0, 0, 0, 0, 0, 0, 0
+  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
+};
+
+static int open_create_flags[14] = {
+  0, 0, 0, 0, 0, O_CREAT, O_TRUNC, O_EXCL, 0, 0, 0, 0, 0, 0
+};
+
+static int open_share_flags[14] = {
+  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, FILE_SHARE_DELETE, 0
 };
 
-static int open_create_flags[12] = {
-  0, 0, 0, 0, 0, O_CREAT, O_TRUNC, O_EXCL, 0, 0, 0, 0
+static int open_cloexec_flags[14] = {
+  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1
 };
 
 CAMLprim value unix_open(value path, value flags, value perm)
 {
-  int fileaccess, createflags, fileattrib, filecreate;
+  int fileaccess, createflags, fileattrib, filecreate, sharemode, cloexec;
   SECURITY_ATTRIBUTES attr;
   HANDLE h;
 
   fileaccess = convert_flag_list(flags, open_access_flags);
+  sharemode = FILE_SHARE_READ | FILE_SHARE_WRITE
+              | convert_flag_list(flags, open_share_flags);
 
   createflags = convert_flag_list(flags, open_create_flags);
   if ((createflags & (O_CREAT | O_EXCL)) == (O_CREAT | O_EXCL))
@@ -52,12 +60,13 @@
   else
     fileattrib = FILE_ATTRIBUTE_NORMAL;
 
+  cloexec = convert_flag_list(flags, open_cloexec_flags);
   attr.nLength = sizeof(attr);
   attr.lpSecurityDescriptor = NULL;
-  attr.bInheritHandle = TRUE;
+  attr.bInheritHandle = cloexec ? FALSE : TRUE;
 
   h = CreateFile(String_val(path), fileaccess,
-                 FILE_SHARE_READ | FILE_SHARE_WRITE, &attr,
+                 sharemode, &attr,
                  filecreate, fileattrib, NULL);
   if (h == INVALID_HANDLE_VALUE) {
     win32_maperr(GetLastError());
diff -Nru ocaml-3.12.1/otherlibs/win32unix/pipe.c ocaml-4.01.0/otherlibs/win32unix/pipe.c
--- ocaml-3.12.1/otherlibs/win32unix/pipe.c	2009-05-20 11:52:42.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/pipe.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: pipe.c 9270 2009-05-20 11:52:42Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/read.c ocaml-4.01.0/otherlibs/win32unix/read.c
--- ocaml-3.12.1/otherlibs/win32unix/read.c	2006-10-18 08:26:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/read.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: read.c 7697 2006-10-18 08:26:54Z xleroy $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/rename.c ocaml-4.01.0/otherlibs/win32unix/rename.c
--- ocaml-3.12.1/otherlibs/win32unix/rename.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/rename.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Contributed by Tracy Camp, PolyServe Inc.,    */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: rename.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/win32unix/select.c ocaml-4.01.0/otherlibs/win32unix/select.c
--- ocaml-3.12.1/otherlibs/win32unix/select.c	2010-05-25 13:01:06.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/select.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Contributed by Sylvain Le Gall for Lexifi                          */
 /*                                                                     */
@@ -11,19 +11,14 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: select.c 10467 2010-05-25 13:01:06Z xleroy $ */
-
 #include 
 #include 
 #include 
 #include 
 #include 
-#include 
-#include 
+#include "winworker.h"
 #include 
-#include "unixsupport.h"
 #include "windbug.h"
-#include "winworker.h"
 #include "winlist.h"
 
 /* This constant define the maximum number of objects that
@@ -31,7 +26,7 @@
  * It takes the following parameters into account:
  * - limitation on number of objects is mostly due to limitation
  *   a WaitForMultipleObjects
- * - there is always an event "hStop" to watch 
+ * - there is always an event "hStop" to watch
  *
  * This lead to pick the following value as the biggest possible
  * value
@@ -114,9 +109,9 @@
 
 typedef enum _SELECTMODE {
   SELECT_MODE_NONE = 0,
-  SELECT_MODE_READ,
-  SELECT_MODE_WRITE, 
-  SELECT_MODE_EXCEPT,
+  SELECT_MODE_READ = 1,
+  SELECT_MODE_WRITE = 2,
+  SELECT_MODE_EXCEPT = 4,
 } SELECTMODE;
 
 typedef enum _SELECTSTATE {
@@ -157,7 +152,9 @@
 typedef struct _SELECTDATA {
   LIST             lst;
   SELECTTYPE       EType;
-  SELECTRESULT     aResults[MAXIMUM_SELECT_OBJECTS];
+  /* Sockets may generate a result for all three lists from one single query object
+   */
+  SELECTRESULT     aResults[MAXIMUM_SELECT_OBJECTS * 3];
   DWORD            nResultsCount;
   /* Data following are dedicated to APC like call, they
      will be initialized if required.
@@ -189,18 +186,18 @@
   /* Allocate the data structure */
   LPSELECTDATA res;
   DWORD        i;
-  
-  res = (LPSELECTDATA)caml_stat_alloc(sizeof(SELECTDATA)); 
+
+  res = (LPSELECTDATA)caml_stat_alloc(sizeof(SELECTDATA));
 
   /* Init common data */
   list_init((LPLIST)res);
   list_next_set((LPLIST)res, (LPLIST)lpSelectData);
   res->EType         = EType;
   res->nResultsCount = 0;
-        
+
 
   /* Data following are dedicated to APC like call, they
-     will be initialized if required. For now they are set to 
+     will be initialized if required. For now they are set to
      invalid values.
      */
   res->funcWorker    = NULL;
@@ -240,7 +237,7 @@
   DWORD i;
 
   res = 0;
-  if (lpSelectData->nResultsCount < MAXIMUM_SELECT_OBJECTS)
+  if (lpSelectData->nResultsCount < MAXIMUM_SELECT_OBJECTS * 3)
   {
     i = lpSelectData->nResultsCount;
     lpSelectData->aResults[i].EMode  = EMode;
@@ -253,14 +250,14 @@
 }
 
 /* Add a query to select data, return zero if something goes wrong */
-DWORD select_data_query_add (LPSELECTDATA lpSelectData, 
-                             SELECTMODE EMode, 
-                             HANDLE hFileDescr, 
+DWORD select_data_query_add (LPSELECTDATA lpSelectData,
+                             SELECTMODE EMode,
+                             HANDLE hFileDescr,
                              int lpOrigIdx,
                              unsigned int uFlagsFd)
 {
   DWORD res;
-  DWORD i; 
+  DWORD i;
 
   res = 0;
   if (lpSelectData->nQueriesCount < MAXIMUM_SELECT_OBJECTS)
@@ -278,22 +275,22 @@
 }
 
 /* Search for a job that has available query slots and that match provided type.
- * If none is found, create a new one. Return the corresponding SELECTDATA, and 
+ * If none is found, create a new one. Return the corresponding SELECTDATA, and
  * update provided SELECTDATA head, if required.
  */
 LPSELECTDATA select_data_job_search (LPSELECTDATA *lppSelectData, SELECTTYPE EType)
 {
   LPSELECTDATA res;
-  
+
   res = NULL;
-  
+
   /* Search for job */
   DEBUG_PRINT("Searching an available job for type %d", EType);
   res = *lppSelectData;
   while (
       res != NULL
       && !(
-        res->EType == EType 
+        res->EType == EType
         && res->nQueriesCount < MAXIMUM_SELECT_OBJECTS
         )
       )
@@ -324,7 +321,7 @@
   DWORD n;
   LPSELECTDATA  lpSelectData;
   LPSELECTQUERY lpQuery;
-  
+
   DEBUG_PRINT("Waiting for data on console");
 
   record;
@@ -336,7 +333,7 @@
   events[0] = hStop;
   events[1] = lpQuery->hFileDescr;
   while (lpSelectData->EState == SELECT_STATE_NONE)
-  {    
+  {
     waitRes = WaitForMultipleObjects(2, events, FALSE, INFINITE);
     if (waitRes == WAIT_OBJECT_0 || check_error(lpSelectData, waitRes == WAIT_FAILED))
     {
@@ -357,7 +354,7 @@
       lpSelectData->EState = SELECT_STATE_SIGNALED;
       break;
     }
-    else 
+    else
     {
       /* discard everything else and try again */
       if (check_error(lpSelectData, ReadConsoleInput(lpQuery->hFileDescr, &record, 1, &n) == 0))
@@ -369,9 +366,9 @@
 }
 
 /* Add a function to monitor console input */
-LPSELECTDATA read_console_poll_add (LPSELECTDATA lpSelectData, 
-                                    SELECTMODE EMode, 
-                                    HANDLE hFileDescr, 
+LPSELECTDATA read_console_poll_add (LPSELECTDATA lpSelectData,
+                                    SELECTMODE EMode,
+                                    HANDLE hFileDescr,
                                     int lpOrigIdx,
                                     unsigned int uFlagsFd)
 {
@@ -412,14 +409,14 @@
     {
       iterQuery = &(lpSelectData->aQueries[i]);
       res = PeekNamedPipe(
-          iterQuery->hFileDescr, 
-          NULL, 
-          0, 
-          NULL, 
-          &n, 
+          iterQuery->hFileDescr,
+          NULL,
+          0,
+          NULL,
+          &n,
           NULL);
-      if (check_error(lpSelectData, 
-            (res == 0) && 
+      if (check_error(lpSelectData,
+            (res == 0) &&
             (GetLastError() != ERROR_BROKEN_PIPE)))
       {
         break;
@@ -433,7 +430,7 @@
     };
 
     /* Alas, nothing except polling seems to work for pipes.
-       Check the state & stop_worker_event every 10 ms 
+       Check the state & stop_worker_event every 10 ms
      */
     if (lpSelectData->EState == SELECT_STATE_NONE)
     {
@@ -444,7 +441,7 @@
        * a chance that one of the 4 first calls succeed.
        */
       wait = 2 * wait;
-      if (wait > 10) 
+      if (wait > 10)
       {
         wait = 10;
       };
@@ -458,23 +455,23 @@
 }
 
 /* Add a function to monitor pipe input */
-LPSELECTDATA read_pipe_poll_add (LPSELECTDATA lpSelectData, 
-                                 SELECTMODE EMode, 
-                                 HANDLE hFileDescr, 
+LPSELECTDATA read_pipe_poll_add (LPSELECTDATA lpSelectData,
+                                 SELECTMODE EMode,
+                                 HANDLE hFileDescr,
                                  int lpOrigIdx,
                                  unsigned int uFlagsFd)
 {
   LPSELECTDATA res;
   LPSELECTDATA hd;
-  
+
   hd = lpSelectData;
   /* Polling pipe is a non blocking operation by default. This means that each
-     worker can handle many pipe. We begin to try to find a worker that is 
+     worker can handle many pipe. We begin to try to find a worker that is
      polling pipe, but for which there is under the limit of pipe per worker.
      */
   DEBUG_PRINT("Searching an available worker handling pipe");
   res = select_data_job_search(&hd, SELECT_TYPE_PIPE_READ);
-  
+
   /* Add a new pipe to poll */
   res->funcWorker = read_pipe_poll;
   select_data_query_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
@@ -490,51 +487,58 @@
 void socket_poll (HANDLE hStop, void *_data)
 {
   LPSELECTDATA   lpSelectData;
-  LPSELECTQUERY  iterQuery;
-  HANDLE         aEvents[MAXIMUM_SELECT_OBJECTS];
-  DWORD          nEvents;
-  long           maskEvents;
-  DWORD          i;
-  u_long         iMode;
+  LPSELECTQUERY    iterQuery;
+  HANDLE           aEvents[MAXIMUM_SELECT_OBJECTS];
+  DWORD            nEvents;
+  long             maskEvents;
+  DWORD            i;
+  u_long           iMode;
+  SELECTMODE       mode;
+  WSANETWORKEVENTS events;
 
   lpSelectData = (LPSELECTDATA)_data;
 
+  DEBUG_PRINT("Worker has %d queries to service", lpSelectData->nQueriesCount);
   for (nEvents = 0; nEvents < lpSelectData->nQueriesCount; nEvents++)
   {
     iterQuery = &(lpSelectData->aQueries[nEvents]);
     aEvents[nEvents] = CreateEvent(NULL, TRUE, FALSE, NULL);
     maskEvents = 0;
-    switch (iterQuery->EMode)
+    mode = iterQuery->EMode;
+    if ((mode & SELECT_MODE_READ) != 0)
     {
-      case SELECT_MODE_READ:
-        maskEvents = FD_READ | FD_ACCEPT | FD_CLOSE;
-        break;
-      case SELECT_MODE_WRITE:
-        maskEvents = FD_WRITE | FD_CONNECT | FD_CLOSE;
-        break;
-      case SELECT_MODE_EXCEPT:
-        maskEvents = FD_OOB;
-        break;
+      DEBUG_PRINT("Polling read for %d", iterQuery->hFileDescr);
+      maskEvents |= FD_READ | FD_ACCEPT | FD_CLOSE;
+    }
+    if ((mode & SELECT_MODE_WRITE) != 0)
+    {
+      DEBUG_PRINT("Polling write for %d", iterQuery->hFileDescr);
+      maskEvents |= FD_WRITE | FD_CONNECT | FD_CLOSE;
+    }
+    if ((mode & SELECT_MODE_EXCEPT) != 0)
+    {
+      DEBUG_PRINT("Polling exceptions for %d", iterQuery->hFileDescr);
+      maskEvents |= FD_OOB;
     }
 
     check_error(lpSelectData,
         WSAEventSelect(
-          (SOCKET)(iterQuery->hFileDescr), 
-          aEvents[nEvents], 
+          (SOCKET)(iterQuery->hFileDescr),
+          aEvents[nEvents],
           maskEvents) == SOCKET_ERROR);
   }
-  
+
   /* Add stop event */
   aEvents[nEvents]  = hStop;
   nEvents++;
 
   if (lpSelectData->nError == 0)
   {
-    check_error(lpSelectData, 
+    check_error(lpSelectData,
         WaitForMultipleObjects(
-          nEvents, 
-          aEvents, 
-          FALSE, 
+          nEvents,
+          aEvents,
+          FALSE,
           INFINITE) == WAIT_FAILED);
   };
 
@@ -548,7 +552,23 @@
         DEBUG_PRINT("Socket %d has pending events", (i - 1));
         if (iterQuery != NULL)
         {
-          select_data_result_add(lpSelectData, iterQuery->EMode, iterQuery->lpOrigIdx);
+          /* Find out what kind of events were raised
+           */
+          if (WSAEnumNetworkEvents((SOCKET)(iterQuery->hFileDescr), aEvents[i], &events) == 0)
+          {
+            if ((iterQuery->EMode & SELECT_MODE_READ) != 0 && (events.lNetworkEvents & (FD_READ | FD_ACCEPT | FD_CLOSE)) != 0)
+            {
+              select_data_result_add(lpSelectData, SELECT_MODE_READ, iterQuery->lpOrigIdx);
+            }
+            if ((iterQuery->EMode & SELECT_MODE_WRITE) != 0 && (events.lNetworkEvents & (FD_WRITE | FD_CONNECT | FD_CLOSE)) != 0)
+            {
+              select_data_result_add(lpSelectData, SELECT_MODE_WRITE, iterQuery->lpOrigIdx);
+            }
+            if ((iterQuery->EMode & SELECT_MODE_EXCEPT) != 0 && (events.lNetworkEvents & FD_OOB) != 0)
+            {
+              select_data_result_add(lpSelectData, SELECT_MODE_EXCEPT, iterQuery->lpOrigIdx);
+            }
+          }
         }
       }
       /* WSAEventSelect() automatically sets socket to nonblocking mode.
@@ -556,7 +576,7 @@
       if (iterQuery->uFlagsFd & FLAGS_FD_IS_BLOCKING)
       {
         DEBUG_PRINT("Restore a blocking socket");
-        iMode = 1;
+        iMode = 0;
         check_error(lpSelectData,
           WSAEventSelect((SOCKET)(iterQuery->hFileDescr), aEvents[i], 0) != 0 ||
           ioctlsocket((SOCKET)(iterQuery->hFileDescr), FIONBIO, &iMode) != 0);
@@ -574,30 +594,95 @@
 }
 
 /* Add a function to monitor socket */
-LPSELECTDATA socket_poll_add (LPSELECTDATA lpSelectData, 
-                              SELECTMODE EMode, 
-                              HANDLE hFileDescr, 
+LPSELECTDATA socket_poll_add (LPSELECTDATA lpSelectData,
+                              SELECTMODE EMode,
+                              HANDLE hFileDescr,
                               int lpOrigIdx,
                               unsigned int uFlagsFd)
 {
   LPSELECTDATA res;
-  LPSELECTDATA hd;
-  
-  hd = lpSelectData;
+  LPSELECTDATA candidate;
+  DWORD i;
+  LPSELECTQUERY aQueries;
+
+  res = lpSelectData;
+  candidate = NULL;
+  aQueries = NULL;
+
   /* Polling socket can be done mulitple handle at the same time. You just
      need one worker to use it. Try to find if there is already a worker
      handling this kind of request.
+     Only one event can be associated with a given socket which means that if a socket
+     is in more than one of the fd_sets then we have to find that particular query and update
+     EMode with the additional flag.
      */
   DEBUG_PRINT("Scanning list of worker to find one that already handle socket");
-  res = select_data_job_search(&hd, SELECT_TYPE_SOCKET);
-  
-  /* Add a new socket to poll */
-  res->funcWorker = socket_poll;
-  DEBUG_PRINT("Add socket %x to worker", hFileDescr);
-  select_data_query_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
-  DEBUG_PRINT("Socket %x added", hFileDescr);
+  /* Search for job */
+  DEBUG_PRINT("Searching for an available job for type %d for descriptor %d", SELECT_TYPE_SOCKET, hFileDescr);
+  while (res != NULL)
+  {
+    if (res->EType == SELECT_TYPE_SOCKET)
+    {
+      i = res->nQueriesCount - 1;
+      aQueries = res->aQueries;
+      while (i >= 0 && aQueries[i].hFileDescr != hFileDescr)
+      {
+        i--;
+      }
+      /* If we didn't find the socket but this worker has available slots, store it
+       */
+      if (i < 0)
+      {
+        if ( res->nQueriesCount < MAXIMUM_SELECT_OBJECTS)
+        {
+          candidate = res;
+        }
+        res = LIST_NEXT(LPSELECTDATA, res);
+      }
+      else
+      {
+        /* Previous socket query located -- we're finished
+         */
+        aQueries = &aQueries[i];
+        break;
+      }
+    }
+    else
+    {
+      res = LIST_NEXT(LPSELECTDATA, res);
+    }
+  }
 
-  return hd;
+  if (res == NULL)
+  {
+    res = candidate;
+
+    /* No matching job found, create one */
+    if (res == NULL)
+    {
+      DEBUG_PRINT("No job for type %d found, create one", SELECT_TYPE_SOCKET);
+      res = select_data_new(lpSelectData, SELECT_TYPE_SOCKET);
+      res->funcWorker = socket_poll;
+      res->nQueriesCount = 1;
+      aQueries = &res->aQueries[0];
+    }
+    else
+    {
+      aQueries = &(res->aQueries[res->nQueriesCount++]);
+    }
+    aQueries->EMode = EMode;
+    aQueries->hFileDescr = hFileDescr;
+    aQueries->lpOrigIdx = lpOrigIdx;
+    aQueries->uFlagsFd = uFlagsFd;
+    DEBUG_PRINT("Socket %x added", hFileDescr);
+  }
+  else
+  {
+    aQueries->EMode |= EMode;
+    DEBUG_PRINT("Socket %x updated to %d", hFileDescr, aQueries->EMode);
+  }
+
+  return res;
 }
 
 /***********************/
@@ -605,19 +690,19 @@
 /***********************/
 
 /* Add a static result */
-LPSELECTDATA static_poll_add (LPSELECTDATA lpSelectData, 
-                              SELECTMODE EMode, 
-                              HANDLE hFileDescr, 
+LPSELECTDATA static_poll_add (LPSELECTDATA lpSelectData,
+                              SELECTMODE EMode,
+                              HANDLE hFileDescr,
                               int lpOrigIdx,
                               unsigned int uFlagsFd)
 {
   LPSELECTDATA res;
   LPSELECTDATA hd;
-  
+
   /* Look for an already initialized static element */
   hd = lpSelectData;
   res = select_data_job_search(&hd, SELECT_TYPE_STATIC);
-  
+
   /* Add a new query/result */
   select_data_query_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
   select_data_result_add(res, EMode, lpOrigIdx);
@@ -648,7 +733,7 @@
   {
     switch(GetFileType(Handle_val(fd)))
     {
-      case FILE_TYPE_DISK: 
+      case FILE_TYPE_DISK:
         res = SELECT_HANDLE_DISK;
         break;
 
@@ -693,8 +778,8 @@
   DEBUG_PRINT("Begin dispatching handle %x", hFileDescr);
 
   DEBUG_PRINT("Waiting for %d on handle %x", EMode, hFileDescr);
-  
-  /* There is only 2 way to have except mode: transmission of OOB data through 
+
+  /* There is only 2 way to have except mode: transmission of OOB data through
      a socket TCP/IP and through a strange interaction with a TTY.
      With windows, we only consider the TCP/IP except condition
   */
@@ -789,7 +874,7 @@
   CAMLlocal2(result, list);
   int i;
 
-  switch( iterResult->EMode )  
+  switch( iterResult->EMode )
   {
     case SELECT_MODE_READ:
       list = readfds;
@@ -802,12 +887,12 @@
       break;
   };
 
-  for(i=0; list != Val_unit && i < iterResult->lpOrigIdx; ++i ) 
+  for(i=0; list != Val_unit && i < iterResult->lpOrigIdx; ++i )
   {
     list = Field(list, 1);
   }
 
-  if (list == Val_unit) 
+  if (list == Val_unit)
     failwith ("select.c: original file handle not found");
 
   result = Field(list, 0);
@@ -817,13 +902,49 @@
 
 #define MAX(a, b) ((a) > (b) ? (a) : (b))
 
+/* Convert fdlist to an fd_set if all the handles in fdlist are sockets and return 0.
+ * Returns 1 if a non-socket value is encountered.
+ */
+static int fdlist_to_fdset(value fdlist, fd_set *fdset)
+{
+  value l, c;
+  FD_ZERO(fdset);
+  for (l = fdlist; l != Val_int(0); l = Field(l, 1)) {
+    c = Field(l, 0);
+    if (Descr_kind_val(c) == KIND_SOCKET) {
+      FD_SET(Socket_val(c), fdset);
+    } else {
+      DEBUG_PRINT("Non socket value encountered");
+      return 0;
+    }
+  }
+  return 1;
+}
+
+static value fdset_to_fdlist(value fdlist, fd_set *fdset)
+{
+  value res = Val_int(0);
+  Begin_roots2(fdlist, res)
+    for (/*nothing*/; fdlist != Val_int(0); fdlist = Field(fdlist, 1)) {
+      value s = Field(fdlist, 0);
+      if (FD_ISSET(Socket_val(s), fdset)) {
+        value newres = alloc_small(2, 0);
+        Field(newres, 0) = s;
+        Field(newres, 1) = res;
+        res = newres;
+      }
+    }
+  End_roots();
+  return res;
+}
+
 CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value timeout)
-{  
+{
   /* Event associated to handle */
   DWORD   nEventsCount;
   DWORD   nEventsMax;
   HANDLE *lpEventsDone;
-  
+
   /* Data for all handles */
   LPSELECTDATA lpSelectData;
   LPSELECTDATA iterSelectData;
@@ -860,246 +981,287 @@
   CAMLlocal5 (read_list, write_list, except_list, res, l);
   CAMLlocal1 (fd);
 
+  fd_set read, write, except;
+  double tm;
+  struct timeval tv;
+  struct timeval * tvp;
+
   DEBUG_PRINT("in select");
 
-  nEventsCount   = 0;
-  nEventsMax     = 0;
-  lpEventsDone   = NULL;
-  lpSelectData   = NULL;
-  iterSelectData = NULL;
-  iterResult     = NULL;
-  err            = 0;
-  hasStaticData  = 0;
-  waitRet        = 0;
-  readfds_len    = caml_list_length(readfds);
-  writefds_len   = caml_list_length(writefds);
-  exceptfds_len  = caml_list_length(exceptfds);
-  hdsMax         = MAX(readfds_len, MAX(writefds_len, exceptfds_len));
+  err = 0;
+  tm = Double_val(timeout);
+  if (readfds == Val_int(0) && writefds == Val_int(0) && exceptfds == Val_int(0)) {
+    DEBUG_PRINT("nothing to do");
+    if ( tm > 0.0 ) {
+      enter_blocking_section();
+      Sleep( (int)(tm * 1000));
+      leave_blocking_section();
+    }
+    read_list = write_list = except_list = Val_int(0);
+  } else {
+    if (fdlist_to_fdset(readfds, &read) && fdlist_to_fdset(writefds, &write) && fdlist_to_fdset(exceptfds, &except)) {
+      DEBUG_PRINT("only sockets to select on, using classic select");
+      if (tm < 0.0) {
+        tvp = (struct timeval *) NULL;
+      } else {
+        tv.tv_sec = (int) tm;
+        tv.tv_usec = (int) (1e6 * (tm - (int) tm));
+        tvp = &tv;
+      }
+      enter_blocking_section();
+      if (select(FD_SETSIZE, &read, &write, &except, tvp) == -1) {
+        err = WSAGetLastError();
+        DEBUG_PRINT("Error %ld occurred", err);
+      }
+      leave_blocking_section();
+      if (err) {
+        DEBUG_PRINT("Error %ld occurred", err);
+        win32_maperr(err);
+        uerror("select", Nothing);
+      }
+      read_list = fdset_to_fdlist(readfds, &read);
+      write_list = fdset_to_fdlist(writefds, &write);
+      except_list = fdset_to_fdlist(exceptfds, &except);
+    } else {
+      nEventsCount   = 0;
+      nEventsMax     = 0;
+      lpEventsDone   = NULL;
+      lpSelectData   = NULL;
+      iterSelectData = NULL;
+      iterResult     = NULL;
+      hasStaticData  = 0;
+      waitRet        = 0;
+      readfds_len    = caml_list_length(readfds);
+      writefds_len   = caml_list_length(writefds);
+      exceptfds_len  = caml_list_length(exceptfds);
+      hdsMax         = MAX(readfds_len, MAX(writefds_len, exceptfds_len));
 
-  hdsData = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * hdsMax);
+      hdsData = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * hdsMax);
 
-  if (Double_val(timeout) >= 0.0)
-  {
-    milliseconds = 1000 * Double_val(timeout);
-    DEBUG_PRINT("Will wait %d ms", milliseconds);
-  }
-  else
-  {
-    milliseconds = INFINITE;
-  }
+      if (tm >= 0.0)
+        {
+          milliseconds = 1000 * tm;
+          DEBUG_PRINT("Will wait %d ms", milliseconds);
+        }
+      else
+        {
+          milliseconds = INFINITE;
+        }
 
 
-  /* Create list of select data, based on the different list of fd to watch */
-  DEBUG_PRINT("Dispatch read fd");
-  handle_set_init(&hds, hdsData, hdsMax);
-  i=0;
-  for (l = readfds; l != Val_int(0); l = Field(l, 1))
-  {
-    fd = Field(l, 0);
-    if (!handle_set_mem(&hds, Handle_val(fd)))
-    {
-      handle_set_add(&hds, Handle_val(fd));
-      lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_READ, fd, i++);
-    }
-    else
-    {
-      DEBUG_PRINT("Discarding handle %x which is already monitor for read", Handle_val(fd));
-    }
-  }
-  handle_set_reset(&hds);
+      /* Create list of select data, based on the different list of fd to watch */
+      DEBUG_PRINT("Dispatch read fd");
+      handle_set_init(&hds, hdsData, hdsMax);
+      i=0;
+      for (l = readfds; l != Val_int(0); l = Field(l, 1))
+        {
+          fd = Field(l, 0);
+          if (!handle_set_mem(&hds, Handle_val(fd)))
+            {
+              handle_set_add(&hds, Handle_val(fd));
+              lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_READ, fd, i++);
+            }
+          else
+            {
+              DEBUG_PRINT("Discarding handle %x which is already monitor for read", Handle_val(fd));
+            }
+        }
+      handle_set_reset(&hds);
 
-  DEBUG_PRINT("Dispatch write fd");
-  handle_set_init(&hds, hdsData, hdsMax);
-  i=0;
-  for (l = writefds; l != Val_int(0); l = Field(l, 1))
-  {
-    fd = Field(l, 0);
-    if (!handle_set_mem(&hds, Handle_val(fd)))
-    {
-      handle_set_add(&hds, Handle_val(fd));
-      lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_WRITE, fd, i++);
-    }
-    else
-    {
-      DEBUG_PRINT("Discarding handle %x which is already monitor for write", Handle_val(fd));
-    }
-  }
-  handle_set_reset(&hds);
+      DEBUG_PRINT("Dispatch write fd");
+      handle_set_init(&hds, hdsData, hdsMax);
+      i=0;
+      for (l = writefds; l != Val_int(0); l = Field(l, 1))
+        {
+          fd = Field(l, 0);
+          if (!handle_set_mem(&hds, Handle_val(fd)))
+            {
+              handle_set_add(&hds, Handle_val(fd));
+              lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_WRITE, fd, i++);
+            }
+          else
+            {
+              DEBUG_PRINT("Discarding handle %x which is already monitor for write", Handle_val(fd));
+            }
+        }
+      handle_set_reset(&hds);
 
-  DEBUG_PRINT("Dispatch exceptional fd");
-  handle_set_init(&hds, hdsData, hdsMax);
-  i=0;
-  for (l = exceptfds; l != Val_int(0); l = Field(l, 1))
-  {
-    fd = Field(l, 0);
-    if (!handle_set_mem(&hds, Handle_val(fd)))
-    {
-      handle_set_add(&hds, Handle_val(fd));
-      lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_EXCEPT, fd, i++);
-    }
-    else
-    {
-      DEBUG_PRINT("Discarding handle %x which is already monitor for exceptional", Handle_val(fd));
-    }
-  }
-  handle_set_reset(&hds);
+      DEBUG_PRINT("Dispatch exceptional fd");
+      handle_set_init(&hds, hdsData, hdsMax);
+      i=0;
+      for (l = exceptfds; l != Val_int(0); l = Field(l, 1))
+        {
+          fd = Field(l, 0);
+          if (!handle_set_mem(&hds, Handle_val(fd)))
+            {
+              handle_set_add(&hds, Handle_val(fd));
+              lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_EXCEPT, fd, i++);
+            }
+          else
+            {
+              DEBUG_PRINT("Discarding handle %x which is already monitor for exceptional", Handle_val(fd));
+            }
+        }
+      handle_set_reset(&hds);
 
-  /* Building the list of handle to wait for */
-  DEBUG_PRINT("Building events done array");
-  nEventsMax   = list_length((LPLIST)lpSelectData);
-  nEventsCount = 0;
-  lpEventsDone = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * nEventsMax);
-
-  iterSelectData = lpSelectData;
-  while (iterSelectData != NULL)
-  {
-    /* Check if it is static data. If this is the case, launch everything
-     * but don't wait for events. It helps to test if there are events on
-     * any other fd (which are not static), knowing that there is at least
-     * one result (the static data).
-     */
-    if (iterSelectData->EType == SELECT_TYPE_STATIC)
-    {
-      hasStaticData = TRUE;
-    };
+      /* Building the list of handle to wait for */
+      DEBUG_PRINT("Building events done array");
+      nEventsMax   = list_length((LPLIST)lpSelectData);
+      nEventsCount = 0;
+      lpEventsDone = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * nEventsMax);
 
-    /* Execute APC */
-    if (iterSelectData->funcWorker != NULL)
-    {
-      iterSelectData->lpWorker = 
-        worker_job_submit(
-            iterSelectData->funcWorker, 
-            (void *)iterSelectData);
-      DEBUG_PRINT("Job submitted to worker %x", iterSelectData->lpWorker); 
-      lpEventsDone[nEventsCount] = worker_job_event_done(iterSelectData->lpWorker);
-      nEventsCount++;
-    };
-    iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
-  };
+      iterSelectData = lpSelectData;
+      while (iterSelectData != NULL)
+        {
+          /* Check if it is static data. If this is the case, launch everything
+           * but don't wait for events. It helps to test if there are events on
+           * any other fd (which are not static), knowing that there is at least
+           * one result (the static data).
+           */
+          if (iterSelectData->EType == SELECT_TYPE_STATIC)
+            {
+              hasStaticData = TRUE;
+            };
+
+          /* Execute APC */
+          if (iterSelectData->funcWorker != NULL)
+            {
+              iterSelectData->lpWorker =
+                worker_job_submit(
+                                  iterSelectData->funcWorker,
+                                  (void *)iterSelectData);
+              DEBUG_PRINT("Job submitted to worker %x", iterSelectData->lpWorker);
+              lpEventsDone[nEventsCount] = worker_job_event_done(iterSelectData->lpWorker);
+              nEventsCount++;
+            };
+          iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
+        };
 
-  DEBUG_PRINT("Need to watch %d workers", nEventsCount);
+      DEBUG_PRINT("Need to watch %d workers", nEventsCount);
 
-  /* Processing select itself */
-  enter_blocking_section();
-  /* There are worker started, waiting to be monitored */
-  if (nEventsCount > 0)
-  {
-    /* Waiting for event */
-    if (err == 0 && !hasStaticData)
-    {
-      DEBUG_PRINT("Waiting for one select worker to be done");
-      switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, FALSE, milliseconds))
-      {
-        case WAIT_FAILED:
-          err = GetLastError();
-          break;
-
-        case WAIT_TIMEOUT:
-          DEBUG_PRINT("Select timeout");
-          break;
-
-        default:
-          DEBUG_PRINT("One worker is done");
-          break;
-      };
-    }
+      /* Processing select itself */
+      enter_blocking_section();
+      /* There are worker started, waiting to be monitored */
+      if (nEventsCount > 0)
+        {
+          /* Waiting for event */
+          if (err == 0 && !hasStaticData)
+            {
+              DEBUG_PRINT("Waiting for one select worker to be done");
+              switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, FALSE, milliseconds))
+                {
+                case WAIT_FAILED:
+                  err = GetLastError();
+                  break;
+
+                case WAIT_TIMEOUT:
+                  DEBUG_PRINT("Select timeout");
+                  break;
+
+                default:
+                  DEBUG_PRINT("One worker is done");
+                  break;
+                };
+            }
+
+          /* Ordering stop to every worker */
+          DEBUG_PRINT("Sending stop signal to every select workers");
+          iterSelectData = lpSelectData;
+          while (iterSelectData != NULL)
+            {
+              if (iterSelectData->lpWorker != NULL)
+                {
+                  worker_job_stop(iterSelectData->lpWorker);
+                };
+              iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
+            };
+
+          DEBUG_PRINT("Waiting for every select worker to be done");
+          switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, TRUE, INFINITE))
+            {
+            case WAIT_FAILED:
+              err = GetLastError();
+              break;
+
+            default:
+              DEBUG_PRINT("Every worker is done");
+              break;
+            }
+        }
+      /* Nothing to monitor but some time to wait. */
+      else if (!hasStaticData)
+        {
+          Sleep(milliseconds);
+        }
+      leave_blocking_section();
 
-    /* Ordering stop to every worker */
-    DEBUG_PRINT("Sending stop signal to every select workers");
-    iterSelectData = lpSelectData;
-    while (iterSelectData != NULL)
-    {
-      if (iterSelectData->lpWorker != NULL)
-      {
-        worker_job_stop(iterSelectData->lpWorker);
-      };
-      iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
-    };
-      
-    DEBUG_PRINT("Waiting for every select worker to be done");
-    switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, TRUE, INFINITE))
-    {
-      case WAIT_FAILED:
-        err = GetLastError();
-        break;
+      DEBUG_PRINT("Error status: %d (0 is ok)", err);
+      /* Build results */
+      if (err == 0)
+        {
+          DEBUG_PRINT("Building result");
+          read_list = Val_unit;
+          write_list = Val_unit;
+          except_list = Val_unit;
+
+          iterSelectData = lpSelectData;
+          while (iterSelectData != NULL)
+            {
+              for (i = 0; i < iterSelectData->nResultsCount; i++)
+                {
+                  iterResult = &(iterSelectData->aResults[i]);
+                  l = alloc_small(2, 0);
+                  Store_field(l, 0, find_handle(iterResult, readfds, writefds, exceptfds));
+                  switch (iterResult->EMode)
+                    {
+                    case SELECT_MODE_READ:
+                      Store_field(l, 1, read_list);
+                      read_list = l;
+                      break;
+                    case SELECT_MODE_WRITE:
+                      Store_field(l, 1, write_list);
+                      write_list = l;
+                      break;
+                    case SELECT_MODE_EXCEPT:
+                      Store_field(l, 1, except_list);
+                      except_list = l;
+                      break;
+                    }
+                }
+              /* We try to only process the first error, bypass other errors */
+              if (err == 0 && iterSelectData->EState == SELECT_STATE_ERROR)
+                {
+                  err = iterSelectData->nError;
+                }
+              iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
+            }
+        }
 
-      default:
-        DEBUG_PRINT("Every worker is done");
-        break;
-    }
-  }
-  /* Nothing to monitor but some time to wait. */
-  else if (!hasStaticData)
-  {
-    Sleep(milliseconds);
-  }
-  leave_blocking_section();
+      /* Free resources */
+      DEBUG_PRINT("Free selectdata resources");
+      iterSelectData = lpSelectData;
+      while (iterSelectData != NULL)
+        {
+          lpSelectData = iterSelectData;
+          iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
+          select_data_free(lpSelectData);
+        }
+      lpSelectData = NULL;
 
-  DEBUG_PRINT("Error status: %d (0 is ok)", err);
-  /* Build results */
-  if (err == 0)
-  {
-    DEBUG_PRINT("Building result");
-    read_list = Val_unit; 
-    write_list = Val_unit;
-    except_list = Val_unit;
+      /* Free allocated events/handle set array */
+      DEBUG_PRINT("Free local allocated resources");
+      caml_stat_free(lpEventsDone);
+      caml_stat_free(hdsData);
 
-    iterSelectData = lpSelectData;
-    while (iterSelectData != NULL)
-    {
-      for (i = 0; i < iterSelectData->nResultsCount; i++)
-      {
-        iterResult = &(iterSelectData->aResults[i]);
-        l = alloc_small(2, 0);
-        Store_field(l, 0, find_handle(iterResult, readfds, writefds, exceptfds));
-        switch (iterResult->EMode)
+      DEBUG_PRINT("Raise error if required");
+      if (err != 0)
         {
-        case SELECT_MODE_READ:
-          Store_field(l, 1, read_list);
-          read_list = l;
-          break;
-        case SELECT_MODE_WRITE:
-          Store_field(l, 1, write_list);
-          write_list = l;
-          break;
-        case SELECT_MODE_EXCEPT:
-          Store_field(l, 1, except_list);
-          except_list = l;
-          break;
+          win32_maperr(err);
+          uerror("select", Nothing);
         }
-      }
-      /* We try to only process the first error, bypass other errors */
-      if (err == 0 && iterSelectData->EState == SELECT_STATE_ERROR)
-      {
-        err = iterSelectData->nError;
-      }
-      iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
     }
   }
 
-  /* Free resources */
-  DEBUG_PRINT("Free selectdata resources");
-  iterSelectData = lpSelectData;
-  while (iterSelectData != NULL)
-  {
-    lpSelectData = iterSelectData;
-    iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
-    select_data_free(lpSelectData);
-  }
-  lpSelectData = NULL;
-  
-  /* Free allocated events/handle set array */
-  DEBUG_PRINT("Free local allocated resources");
-  caml_stat_free(lpEventsDone);
-  caml_stat_free(hdsData);
-
-  DEBUG_PRINT("Raise error if required");
-  if (err != 0)
-  {
-    win32_maperr(err);
-    uerror("select", Nothing);
-  }
-
   DEBUG_PRINT("Build final result");
   res = alloc_small(3, 0);
   Store_field(res, 0, read_list);
diff -Nru ocaml-3.12.1/otherlibs/win32unix/sendrecv.c ocaml-4.01.0/otherlibs/win32unix/sendrecv.c
--- ocaml-3.12.1/otherlibs/win32unix/sendrecv.c	2006-10-18 08:26:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/sendrecv.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: sendrecv.c 7697 2006-10-18 08:26:54Z xleroy $ */
-
 #include 
 #include 
 #include 
@@ -132,9 +130,7 @@
   return Val_int(ret);
 }
 
-CAMLprim value unix_sendto(argv, argc)
-     value * argv;
-     int argc;
+CAMLprim value unix_sendto(value * argv, int argc)
 {
   return unix_sendto_native
            (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
diff -Nru ocaml-3.12.1/otherlibs/win32unix/shutdown.c ocaml-4.01.0/otherlibs/win32unix/shutdown.c
--- ocaml-3.12.1/otherlibs/win32unix/shutdown.c	2002-04-30 15:00:48.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/shutdown.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: shutdown.c 4765 2002-04-30 15:00:48Z xleroy $ */
-
 #include 
 #include "unixsupport.h"
 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/sleep.c ocaml-4.01.0/otherlibs/win32unix/sleep.c
--- ocaml-3.12.1/otherlibs/win32unix/sleep.c	2002-06-07 09:49:45.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/sleep.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: sleep.c 4899 2002-06-07 09:49:45Z xleroy $ */
-
 #include 
 #include 
 #include "unixsupport.h"
diff -Nru ocaml-3.12.1/otherlibs/win32unix/socket.c ocaml-4.01.0/otherlibs/win32unix/socket.c
--- ocaml-3.12.1/otherlibs/win32unix/socket.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/socket.c	2013-06-14 11:50:12.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   */
 /*                                                                     */
@@ -11,13 +11,17 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: socket.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include "unixsupport.h"
+#include    // for SO_OPENTYPE and SO_SYNCHRONOUS_NONALERT
 
 int socket_domain_table[] = {
-  PF_UNIX, PF_INET
+  PF_UNIX, PF_INET,
+#if defined(HAS_IPV6)
+  PF_INET6
+#else
+  0
+#endif
 };
 
 int socket_type_table[] = {
@@ -30,6 +34,14 @@
   SOCKET s;
   int oldvalue, oldvaluelen, newvalue, retcode;
 
+  #ifndef HAS_IPV6
+  /* IPv6 requires WinSock2, we must raise an error on PF_INET6 */
+  if (Int_val(domain) >= sizeof(socket_domain_table)/sizeof(int)) {
+    win32_maperr(WSAEPFNOSUPPORT);
+    uerror("socket", Nothing);
+  }
+  #endif
+
   oldvaluelen = sizeof(oldvalue);
   retcode = getsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
                        (char *) &oldvalue, &oldvaluelen);
diff -Nru ocaml-3.12.1/otherlibs/win32unix/socketaddr.h ocaml-4.01.0/otherlibs/win32unix/socketaddr.h
--- ocaml-3.12.1/otherlibs/win32unix/socketaddr.h	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/socketaddr.h	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,13 +11,14 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: socketaddr.h 6824 2005-03-24 17:20:54Z doligez $ */
-
-#include 
+#include "misc.h"
 
 union sock_addr_union {
   struct sockaddr s_gen;
   struct sockaddr_in s_inet;
+#ifdef HAS_IPV6
+  struct sockaddr_in6 s_inet6;
+#endif
 };
 
 extern union sock_addr_union sock_addr;
@@ -35,3 +36,8 @@
                       socklen_param_type addr_len, int close_on_error);
 CAMLprim value alloc_inet_addr (struct in_addr * inaddr);
 #define GET_INET_ADDR(v) (*((struct in_addr *) (v)))
+
+#ifdef HAS_IPV6
+CAMLexport value alloc_inet6_addr (struct in6_addr * inaddr);
+#define GET_INET6_ADDR(v) (*((struct in6_addr *) (v)))
+#endif
diff -Nru ocaml-3.12.1/otherlibs/win32unix/sockopt.c ocaml-4.01.0/otherlibs/win32unix/sockopt.c
--- ocaml-3.12.1/otherlibs/win32unix/sockopt.c	2008-08-01 13:46:08.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/sockopt.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: sockopt.c 8968 2008-08-01 13:46:08Z xleroy $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/startup.c ocaml-4.01.0/otherlibs/win32unix/startup.c
--- ocaml-3.12.1/otherlibs/win32unix/startup.c	2010-05-25 13:01:06.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/startup.c	2012-09-26 04:18:08.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   */
 /*                                                                     */
@@ -15,7 +15,6 @@
 #include 
 #include 
 #include 
-#include "unixsupport.h"
 #include "winworker.h"
 #include "windbug.h"
 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/stat.c ocaml-4.01.0/otherlibs/win32unix/stat.c
--- ocaml-3.12.1/otherlibs/win32unix/stat.c	2009-05-20 11:52:42.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/stat.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: stat.c 9270 2009-05-20 11:52:42Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/system.c ocaml-4.01.0/otherlibs/win32unix/system.c
--- ocaml-3.12.1/otherlibs/win32unix/system.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/system.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: system.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/times.c ocaml-4.01.0/otherlibs/win32unix/times.c
--- ocaml-3.12.1/otherlibs/win32unix/times.c	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/times.c	2012-09-26 04:18:08.000000000 +0000
@@ -0,0 +1,48 @@
+/***********************************************************************/
+/*                                                                     */
+/*                                OCaml                                */
+/*                                                                     */
+/*                 File contributed by Josh Berdine                    */
+/*                                                                     */
+/*  Copyright 2011 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the GNU Library General Public License, with    */
+/*  the special exception on linking described in file ../../LICENSE.  */
+/*                                                                     */
+/***********************************************************************/
+
+#include 
+#include 
+#include "unixsupport.h"
+#include 
+
+
+double to_sec(FILETIME ft) {
+  ULARGE_INTEGER tmp;
+
+  tmp.u.LowPart = ft.dwLowDateTime;
+  tmp.u.HighPart = ft.dwHighDateTime;
+
+  /* convert to seconds:
+     GetProcessTimes returns number of 100-nanosecond intervals */
+  return tmp.QuadPart / 1e7;
+}
+
+
+value unix_times(value unit) {
+  value res;
+  FILETIME creation, exit, stime, utime;
+
+  if (!(GetProcessTimes(GetCurrentProcess(), &creation, &exit, &stime,
+                        &utime))) {
+    win32_maperr(GetLastError());
+    uerror("times", Nothing);
+  }
+
+  res = alloc_small(4 * Double_wosize, Double_array_tag);
+  Store_double_field(res, 0, to_sec(utime));
+  Store_double_field(res, 1, to_sec(stime));
+  Store_double_field(res, 2, 0);
+  Store_double_field(res, 3, 0);
+  return res;
+}
diff -Nru ocaml-3.12.1/otherlibs/win32unix/unix.ml ocaml-4.01.0/otherlibs/win32unix/unix.ml
--- ocaml-3.12.1/otherlibs/win32unix/unix.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/unix.ml	2013-08-01 12:13:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: unix.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* Initialization *)
 
 external startup: unit -> unit = "win_startup"
@@ -170,6 +168,8 @@
   | O_DSYNC
   | O_SYNC
   | O_RSYNC
+  | O_SHARE_DELETE
+  | O_CLOEXEC
 
 type file_perm = int
 
@@ -198,10 +198,14 @@
 
 (* Interfacing with the standard input/output library *)
 
-external in_channel_of_descr: file_descr -> in_channel = "win_inchannel_of_filedescr"
-external out_channel_of_descr: file_descr -> out_channel = "win_outchannel_of_filedescr"
-external descr_of_in_channel : in_channel -> file_descr = "win_filedescr_of_channel"
-external descr_of_out_channel : out_channel -> file_descr = "win_filedescr_of_channel"
+external in_channel_of_descr: file_descr -> in_channel
+   = "win_inchannel_of_filedescr"
+external out_channel_of_descr: file_descr -> out_channel
+   = "win_outchannel_of_filedescr"
+external descr_of_in_channel : in_channel -> file_descr
+   = "win_filedescr_of_channel"
+external descr_of_out_channel : out_channel -> file_descr
+   = "win_filedescr_of_channel"
 
 (* Seeking and truncating *)
 
@@ -256,9 +260,12 @@
 
 module LargeFile =
   struct
-    external lseek : file_descr -> int64 -> seek_command -> int64 = "unix_lseek_64"
-    let truncate name len = invalid_arg "Unix.LargeFile.truncate not implemented"
-    let ftruncate name len = invalid_arg "Unix.LargeFile.ftruncate not implemented"
+    external lseek : file_descr -> int64 -> seek_command -> int64
+       = "unix_lseek_64"
+    let truncate name len =
+      invalid_arg "Unix.LargeFile.truncate not implemented"
+    let ftruncate name len =
+      invalid_arg "Unix.LargeFile.ftruncate not implemented"
     type stats =
       { st_dev : int;
         st_ino : int;
@@ -407,9 +414,7 @@
 external mktime : tm -> float * tm = "unix_mktime"
 let alarm n = invalid_arg "Unix.alarm not implemented"
 external sleep : int -> unit = "unix_sleep"
-let times () =
-  { tms_utime = Sys.time(); tms_stime = 0.0;
-    tms_cutime = 0.0; tms_cstime = 0.0 }
+external times: unit -> process_times = "unix_times"
 external utimes : string -> float -> float -> unit = "unix_utimes"
 
 type interval_timer =
@@ -659,7 +664,11 @@
   | AI_CANONNAME
   | AI_PASSIVE
 
-let getaddrinfo node service opts =
+external getaddrinfo_system
+  : string -> string -> getaddrinfo_option list -> addr_info list
+  = "unix_getaddrinfo"
+
+let getaddrinfo_emulation node service opts =
   (* Parse options *)
   let opt_socktype = ref None
   and opt_protocol = ref 0
@@ -721,6 +730,12 @@
           addresses)
       ports)
 
+let getaddrinfo node service opts =
+  try
+    List.rev(getaddrinfo_system node service opts)
+  with Invalid_argument _ ->
+    getaddrinfo_emulation node service opts
+
 type name_info =
   { ni_hostname : string;
     ni_service : string }
@@ -732,7 +747,11 @@
   | NI_NUMERICSERV
   | NI_DGRAM
 
-let getnameinfo addr opts =
+external getnameinfo_system
+  : sockaddr -> getnameinfo_option list -> name_info
+  = "unix_getnameinfo"
+
+let getnameinfo_emulation addr opts =
   match addr with
   | ADDR_UNIX f ->
       { ni_hostname = ""; ni_service = f } (* why not? *)
@@ -753,6 +772,12 @@
           string_of_int p in
       { ni_hostname = hostname; ni_service = service }
 
+let getnameinfo addr opts =
+  try
+    getnameinfo_system addr opts
+  with Invalid_argument _ ->
+    getnameinfo_emulation addr opts
+
 (* High-level process management (system, popen) *)
 
 external win_create_process : string -> string -> string option ->
@@ -875,12 +900,14 @@
 (* High-level network functions *)
 
 let open_connection sockaddr =
-  let domain =
-    match sockaddr with ADDR_UNIX _ -> PF_UNIX | ADDR_INET(_,_) -> PF_INET in
   let sock =
-    socket domain SOCK_STREAM 0 in
-  connect sock sockaddr;
-  (in_channel_of_descr sock, out_channel_of_descr sock)
+    socket (domain_of_sockaddr sockaddr) SOCK_STREAM 0 in
+  try
+    connect sock sockaddr;
+    set_close_on_exec sock;
+    (in_channel_of_descr sock, out_channel_of_descr sock)
+  with exn ->
+    close sock; raise exn
 
 let shutdown_connection inchan =
   shutdown (descr_of_in_channel inchan) SHUTDOWN_SEND
diff -Nru ocaml-3.12.1/otherlibs/win32unix/unixsupport.c ocaml-4.01.0/otherlibs/win32unix/unixsupport.c
--- ocaml-3.12.1/otherlibs/win32unix/unixsupport.c	2010-05-25 13:01:06.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/unixsupport.c	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: unixsupport.c 10467 2010-05-25 13:01:06Z xleroy $ */
-
 #include 
 #include 
 #include 
@@ -44,7 +42,8 @@
   win_handle_compare,
   win_handle_hash,
   custom_serialize_default,
-  custom_deserialize_default
+  custom_deserialize_default,
+  custom_compare_ext_default
 };
 
 value win_alloc_handle(HANDLE h)
@@ -53,7 +52,7 @@
   Handle_val(res) = h;
   Descr_kind_val(res) = KIND_HANDLE;
   CRT_fd_val(res) = NO_CRT_FD;
-  Flags_fd_val(res) = 0;
+  Flags_fd_val(res) = FLAGS_FD_IS_BLOCKING;
   return res;
 }
 
@@ -63,7 +62,7 @@
   Socket_val(res) = s;
   Descr_kind_val(res) = KIND_SOCKET;
   CRT_fd_val(res) = NO_CRT_FD;
-  Flags_fd_val(res) = 0;
+  Flags_fd_val(res) = FLAGS_FD_IS_BLOCKING;
   return res;
 }
 
@@ -256,7 +255,8 @@
     if (unix_error_exn == NULL) {
       unix_error_exn = caml_named_value("Unix.Unix_error");
       if (unix_error_exn == NULL)
-        invalid_argument("Exception Unix.Unix_error not initialized, please link unix.cma");
+        invalid_argument("Exception Unix.Unix_error not initialized,"
+                         " please link unix.cma");
     }
     res = alloc_small(4, 0);
     Field(res, 0) = *unix_error_exn;
diff -Nru ocaml-3.12.1/otherlibs/win32unix/unixsupport.h ocaml-4.01.0/otherlibs/win32unix/unixsupport.h
--- ocaml-3.12.1/otherlibs/win32unix/unixsupport.h	2010-05-25 13:01:06.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/unixsupport.h	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: unixsupport.h 10467 2010-05-25 13:01:06Z xleroy $ */
-
 #define WIN32_LEAN_AND_MEAN
 #include 
 #include 
@@ -20,7 +18,11 @@
 #include 
 #include 
 #include 
-#include 
+#include 
+#ifdef HAS_IPV6
+#include 
+#include 
+#endif
 
 struct filedescr {
   union {
@@ -59,4 +61,4 @@
 /* Blocking or nonblocking.  By default a filedescr is in blocking state */
 #define FLAGS_FD_IS_BLOCKING (1<<0)
 
-#define UNIX_BUFFER_SIZE 16384
+#define UNIX_BUFFER_SIZE 65536
diff -Nru ocaml-3.12.1/otherlibs/win32unix/windbug.c ocaml-4.01.0/otherlibs/win32unix/windbug.c
--- ocaml-3.12.1/otherlibs/win32unix/windbug.c	2010-05-25 13:01:06.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/windbug.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Contributed by Sylvain Le Gall for Lexifi                          */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: windbug.c 10467 2010-05-25 13:01:06Z xleroy $ */
-
 #include "windbug.h"
 
 int debug_test (void)
@@ -26,7 +24,7 @@
     debug = (getenv("OCAMLDEBUG") != NULL);
     debug_init = 1;
   };
-#endif 
+#endif
 
   return debug;
 }
diff -Nru ocaml-3.12.1/otherlibs/win32unix/windbug.h ocaml-4.01.0/otherlibs/win32unix/windbug.h
--- ocaml-3.12.1/otherlibs/win32unix/windbug.h	2010-05-25 13:01:06.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/windbug.h	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Contributed by Sylvain Le Gall for Lexifi                          */
 /*                                                                     */
@@ -11,20 +11,22 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: windbug.h 10467 2010-05-25 13:01:06Z xleroy $ */
-
 #ifdef DEBUG
 
 #include 
 #include 
 
+/* According to MSDN, MSVC supports the gcc ## operator (to deal with empty
+   argument lists)
+ */
 #define DEBUG_PRINT(fmt, ...) \
   do \
   { \
     if (debug_test()) \
     { \
-      fprintf(stderr, "DBUG (pid:%d, tid: %d): ", GetCurrentProcessId(), GetCurrentThreadId()); \
-      fprintf(stderr, fmt, __VA_ARGS__); \
+      fprintf(stderr, "DBUG (pid:%ld, tid: %ld): ", GetCurrentProcessId(), \
+              GetCurrentThreadId()); \
+      fprintf(stderr, fmt, ##__VA_ARGS__); \
       fprintf(stderr, "\n"); \
       fflush(stderr); \
     }; \
diff -Nru ocaml-3.12.1/otherlibs/win32unix/windir.c ocaml-4.01.0/otherlibs/win32unix/windir.c
--- ocaml-3.12.1/otherlibs/win32unix/windir.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/windir.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*   Pascal Cuoq and Xavier Leroy, projet Cristal, INRIA Rocquencourt  */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: windir.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/winlist.c ocaml-4.01.0/otherlibs/win32unix/winlist.c
--- ocaml-3.12.1/otherlibs/win32unix/winlist.c	2008-07-31 12:09:18.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/winlist.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Contributed by Sylvain Le Gall for Lexifi                          */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: winlist.c 8961 2008-07-31 12:09:18Z xleroy $ */
-
 /* Basic list function in C. */
 
 #include "winlist.h"
diff -Nru ocaml-3.12.1/otherlibs/win32unix/winlist.h ocaml-4.01.0/otherlibs/win32unix/winlist.h
--- ocaml-3.12.1/otherlibs/win32unix/winlist.h	2008-07-31 12:09:18.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/winlist.h	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Contributed by Sylvain Le Gall for Lexifi                          */
 /*                                                                     */
@@ -11,7 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: winlist.h 8961 2008-07-31 12:09:18Z xleroy $ */
 #ifndef _WINLIST_H
 #define _WINLIST_H
 
diff -Nru ocaml-3.12.1/otherlibs/win32unix/winwait.c ocaml-4.01.0/otherlibs/win32unix/winwait.c
--- ocaml-3.12.1/otherlibs/win32unix/winwait.c	2008-01-11 16:13:18.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/winwait.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*   Pascal Cuoq and Xavier Leroy, projet Cristal, INRIA Rocquencourt  */
 /*                                                                     */
@@ -11,15 +11,13 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: winwait.c 8768 2008-01-11 16:13:18Z doligez $ */
-
-#include 
 #include 
 #include 
 #include 
+#include 
 #include "unixsupport.h"
+#include 
 #include 
-#include 
 
 static value alloc_process_status(HANDLE pid, int status)
 {
diff -Nru ocaml-3.12.1/otherlibs/win32unix/winworker.c ocaml-4.01.0/otherlibs/win32unix/winworker.c
--- ocaml-3.12.1/otherlibs/win32unix/winworker.c	2010-05-25 13:01:06.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/winworker.c	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Contributed by Sylvain Le Gall for Lexifi                          */
 /*                                                                     */
@@ -11,14 +11,13 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: winworker.c 10467 2010-05-25 13:01:06Z xleroy $ */
-
+#include 
+#include 
+#include 
+#include 
 #include "winworker.h"
 #include "winlist.h"
 #include "windbug.h"
-#include 
-#include 
-#include "unixsupport.h"
 
 typedef enum {
   WORKER_CMD_NONE = 0,
@@ -28,10 +27,11 @@
 
 struct _WORKER {
   LIST       lst;           /* This structure is used as a list. */
-  HANDLE     hJobStarted;   /* Event representing that the function has begun. */
-  HANDLE     hJobStop;      /* Event that can be used to notify the function that it
-                               should stop processing. */
-  HANDLE     hJobDone;      /* Event representing that the function has finished. */
+  HANDLE     hJobStarted;   /* Event representing that the function has begun.*/
+  HANDLE     hJobStop;      /* Event that can be used to notify the function
+                               that it should stop processing. */
+  HANDLE     hJobDone;      /* Event representing that the function has
+                               finished. */
   void      *lpJobUserData; /* User data for the job. */
   WORKERFUNC hJobFunc;      /* Function to be called during APC */
   HANDLE     hWorkerReady;  /* Worker is ready. */
diff -Nru ocaml-3.12.1/otherlibs/win32unix/winworker.h ocaml-4.01.0/otherlibs/win32unix/winworker.h
--- ocaml-3.12.1/otherlibs/win32unix/winworker.h	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/winworker.h	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*  Contributed by Sylvain Le Gall for Lexifi                          */
 /*                                                                     */
@@ -11,11 +11,11 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: winworker.h 9547 2010-01-22 12:48:24Z doligez $ */
 #ifndef _WINWORKER_H
 #define _WINWORKER_H
 
 #define _WIN32_WINNT 0x0400
+#include "unixsupport.h"
 #include 
 
 /* Pool of worker threads.
diff -Nru ocaml-3.12.1/otherlibs/win32unix/write.c ocaml-4.01.0/otherlibs/win32unix/write.c
--- ocaml-3.12.1/otherlibs/win32unix/write.c	2009-09-25 15:03:06.000000000 +0000
+++ ocaml-4.01.0/otherlibs/win32unix/write.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: write.c 9359 2009-09-25 15:03:06Z weis $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/parsing/.cvsignore ocaml-4.01.0/parsing/.cvsignore
--- ocaml-3.12.1/parsing/.cvsignore	2006-04-16 23:28:22.000000000 +0000
+++ ocaml-4.01.0/parsing/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,9 +0,0 @@
-parser.ml
-parser.mli
-lexer.ml
-lexer_tmp.mll
-lexer_tmp.ml
-linenum.ml
-parser.output
-parser.automaton
-parser.conflicts
diff -Nru ocaml-3.12.1/parsing/.ignore ocaml-4.01.0/parsing/.ignore
--- ocaml-3.12.1/parsing/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/parsing/.ignore	2012-07-17 15:31:12.000000000 +0000
@@ -0,0 +1,9 @@
+parser.ml
+parser.mli
+lexer.ml
+lexer_tmp.mll
+lexer_tmp.ml
+linenum.ml
+parser.output
+parser.automaton
+parser.conflicts
diff -Nru ocaml-3.12.1/parsing/ast_mapper.ml ocaml-4.01.0/parsing/ast_mapper.ml
--- ocaml-3.12.1/parsing/ast_mapper.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/parsing/ast_mapper.ml	2013-07-23 14:48:47.000000000 +0000
@@ -0,0 +1,566 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* A generic Parsetree mapping class *)
+
+open Location
+open Config
+open Parsetree
+open Asttypes
+
+(* First, some helpers to build AST fragments *)
+
+let map_flatten f l = List.flatten (List.map f l)
+let map_snd f (x, y) = (x, f y)
+let map_tuple f1 f2 (x, y) = (f1 x, f2 y)
+let map_opt f = function None -> None | Some x -> Some (f x)
+
+let map_loc sub {loc; txt} = {loc = sub # location loc; txt}
+
+module T = struct
+  (* Type expressions for the core language *)
+
+  let mk ?(loc = Location.none) x = {ptyp_desc = x; ptyp_loc = loc}
+  let any ?loc () = mk ?loc Ptyp_any
+  let var ?loc a = mk ?loc (Ptyp_var a)
+  let arrow ?loc a b c = mk ?loc (Ptyp_arrow (a, b, c))
+  let tuple ?loc a = mk ?loc (Ptyp_tuple a)
+  let constr ?loc a b = mk ?loc (Ptyp_constr (a, b))
+  let object_ ?loc a = mk ?loc (Ptyp_object a)
+  let class_ ?loc a b c = mk ?loc (Ptyp_class (a, b, c))
+  let alias ?loc a b = mk ?loc (Ptyp_alias (a, b))
+  let variant ?loc a b c = mk ?loc (Ptyp_variant (a, b, c))
+  let poly ?loc a b = mk ?loc (Ptyp_poly (a, b))
+  let package ?loc a b = mk ?loc (Ptyp_package (a, b))
+
+  let field_type ?(loc = Location.none) x = {pfield_desc = x; pfield_loc = loc}
+  let field ?loc s t =
+    let t =
+      (* The type-checker expects the field to be a Ptyp_poly. Maybe
+         it should wrap the type automatically... *)
+      match t.ptyp_desc with
+      | Ptyp_poly _ -> t
+      | _ -> poly ?loc [] t
+    in
+    field_type ?loc (Pfield (s, t))
+  let field_var ?loc () = field_type ?loc Pfield_var
+
+  let core_field_type sub {pfield_desc = desc; pfield_loc = loc} =
+    let loc = sub # location loc in
+    match desc with
+    | Pfield (s, d) -> field ~loc:(sub # location loc) s (sub # typ d)
+    | Pfield_var -> field_var ~loc ()
+
+  let row_field sub = function
+    | Rtag (l, b, tl) -> Rtag (l, b, List.map (sub # typ) tl)
+    | Rinherit t -> Rinherit (sub # typ t)
+
+  let map sub {ptyp_desc = desc; ptyp_loc = loc} =
+    let loc = sub # location loc in
+    match desc with
+    | Ptyp_any -> any ~loc ()
+    | Ptyp_var s -> var ~loc s
+    | Ptyp_arrow (lab, t1, t2) -> arrow ~loc lab (sub # typ t1) (sub # typ t2)
+    | Ptyp_tuple tyl -> tuple ~loc (List.map (sub # typ) tyl)
+    | Ptyp_constr (lid, tl) ->
+        constr ~loc (map_loc sub lid) (List.map (sub # typ) tl)
+    | Ptyp_object l -> object_ ~loc (List.map (core_field_type sub) l)
+    | Ptyp_class (lid, tl, ll) ->
+        class_ ~loc (map_loc sub lid) (List.map (sub # typ) tl) ll
+    | Ptyp_alias (t, s) -> alias ~loc (sub # typ t) s
+    | Ptyp_variant (rl, b, ll) ->
+        variant ~loc (List.map (row_field sub) rl) b ll
+    | Ptyp_poly (sl, t) -> poly ~loc sl (sub # typ t)
+    | Ptyp_package (lid, l) ->
+        package ~loc (map_loc sub lid)
+                (List.map (map_tuple (map_loc sub) (sub # typ)) l)
+
+  let map_type_declaration sub td =
+    {td with
+     ptype_cstrs =
+     List.map
+       (fun (ct1, ct2, loc) -> sub # typ ct1, sub # typ ct2, sub # location loc)
+       td.ptype_cstrs;
+     ptype_kind = sub # type_kind td.ptype_kind;
+     ptype_manifest = map_opt (sub # typ) td.ptype_manifest;
+     ptype_loc = sub # location td.ptype_loc;
+    }
+
+  let map_type_kind sub = function
+    | Ptype_abstract -> Ptype_abstract
+    | Ptype_variant l ->
+        let f (s, tl, t, loc) =
+          (map_loc sub s,
+           List.map (sub # typ) tl,
+           map_opt (sub # typ) t,
+           sub # location loc)
+        in
+        Ptype_variant (List.map f l)
+    | Ptype_record l ->
+        let f (s, flags, t, loc) =
+          (map_loc sub s, flags, sub # typ t, sub # location loc)
+        in
+        Ptype_record (List.map f l)
+end
+
+module CT = struct
+  (* Type expressions for the class language *)
+
+  let mk ?(loc = Location.none) x = {pcty_loc = loc; pcty_desc = x}
+
+  let constr ?loc a b = mk ?loc (Pcty_constr (a, b))
+  let signature ?loc a = mk ?loc (Pcty_signature a)
+  let fun_ ?loc a b c = mk ?loc (Pcty_fun (a, b, c))
+
+  let map sub {pcty_loc = loc; pcty_desc = desc} =
+    let loc = sub # location loc in
+    match desc with
+    | Pcty_constr (lid, tys) ->
+        constr ~loc (map_loc sub lid) (List.map (sub # typ) tys)
+    | Pcty_signature x -> signature ~loc (sub # class_signature x)
+    | Pcty_fun (lab, t, ct) ->
+        fun_ ~loc lab
+          (sub # typ t)
+          (sub # class_type ct)
+
+  let mk_field ?(loc = Location.none) x = {pctf_desc = x; pctf_loc = loc}
+
+  let inher ?loc a = mk_field ?loc (Pctf_inher a)
+  let val_ ?loc a b c d = mk_field ?loc (Pctf_val (a, b, c, d))
+  let virt ?loc a b c = mk_field ?loc (Pctf_virt (a, b, c))
+  let meth ?loc a b c = mk_field ?loc (Pctf_meth (a, b, c))
+  let cstr ?loc a b = mk_field ?loc (Pctf_cstr (a, b))
+
+  let map_field sub {pctf_desc = desc; pctf_loc = loc} =
+    let loc = sub # location loc in
+    match desc with
+    | Pctf_inher ct -> inher ~loc (sub # class_type ct)
+    | Pctf_val (s, m, v, t) -> val_ ~loc s m v (sub # typ t)
+    | Pctf_virt (s, p, t) -> virt ~loc s p (sub # typ t)
+    | Pctf_meth (s, p, t) -> meth ~loc s p (sub # typ t)
+    | Pctf_cstr (t1, t2) -> cstr ~loc (sub # typ t1) (sub # typ t2)
+
+  let map_signature sub {pcsig_self; pcsig_fields; pcsig_loc} =
+    {
+     pcsig_self = sub # typ pcsig_self;
+     pcsig_fields = List.map (sub # class_type_field) pcsig_fields;
+     pcsig_loc = sub # location pcsig_loc ;
+    }
+end
+
+module MT = struct
+  (* Type expressions for the module language *)
+
+  let mk ?(loc = Location.none) x = {pmty_desc = x; pmty_loc = loc}
+  let ident ?loc a = mk ?loc (Pmty_ident a)
+  let signature ?loc a = mk ?loc (Pmty_signature a)
+  let functor_ ?loc a b c = mk ?loc (Pmty_functor (a, b, c))
+  let with_ ?loc a b = mk ?loc (Pmty_with (a, b))
+  let typeof_ ?loc a = mk ?loc (Pmty_typeof a)
+
+  let map sub {pmty_desc = desc; pmty_loc = loc} =
+    let loc = sub # location loc in
+    match desc with
+    | Pmty_ident s -> ident ~loc (map_loc sub s)
+    | Pmty_signature sg -> signature ~loc (sub # signature sg)
+    | Pmty_functor (s, mt1, mt2) ->
+        functor_ ~loc (map_loc sub s) (sub # module_type mt1)
+                 (sub # module_type mt2)
+    | Pmty_with (mt, l) ->
+        with_ ~loc (sub # module_type mt)
+              (List.map (map_tuple (map_loc sub) (sub # with_constraint)) l)
+    | Pmty_typeof me -> typeof_ ~loc (sub # module_expr me)
+
+  let map_with_constraint sub = function
+    | Pwith_type d -> Pwith_type (sub # type_declaration d)
+    | Pwith_module s -> Pwith_module (map_loc sub s)
+    | Pwith_typesubst d -> Pwith_typesubst (sub # type_declaration d)
+    | Pwith_modsubst s -> Pwith_modsubst (map_loc sub s)
+
+  let mk_item ?(loc = Location.none) x = {psig_desc = x; psig_loc = loc}
+
+  let value ?loc a b = mk_item ?loc (Psig_value (a, b))
+  let type_ ?loc a = mk_item ?loc (Psig_type a)
+  let exception_ ?loc a b = mk_item ?loc (Psig_exception (a, b))
+  let module_ ?loc a b = mk_item ?loc (Psig_module (a, b))
+  let rec_module ?loc a = mk_item ?loc (Psig_recmodule a)
+  let modtype ?loc a b = mk_item ?loc (Psig_modtype (a, b))
+  let open_ ?loc a b = mk_item ?loc (Psig_open (a, b))
+  let include_ ?loc a = mk_item ?loc (Psig_include a)
+  let class_ ?loc a = mk_item ?loc (Psig_class a)
+  let class_type ?loc a = mk_item ?loc (Psig_class_type a)
+
+  let map_signature_item sub {psig_desc = desc; psig_loc = loc} =
+    let loc = sub # location loc in
+    match desc with
+    | Psig_value (s, vd) ->
+        value ~loc (map_loc sub s) (sub # value_description vd)
+    | Psig_type l ->
+        type_ ~loc
+              (List.map (map_tuple (map_loc sub) (sub # type_declaration)) l)
+    | Psig_exception (s, ed) ->
+        exception_ ~loc (map_loc sub s) (sub # exception_declaration ed)
+    | Psig_module (s, mt) ->
+        module_ ~loc (map_loc sub s) (sub # module_type mt)
+    | Psig_recmodule l ->
+        rec_module ~loc
+                   (List.map (map_tuple (map_loc sub) (sub # module_type)) l)
+    | Psig_modtype (s, Pmodtype_manifest mt) ->
+        modtype ~loc (map_loc sub s) (Pmodtype_manifest  (sub # module_type mt))
+    | Psig_modtype (s, Pmodtype_abstract) ->
+        modtype ~loc (map_loc sub s) Pmodtype_abstract
+    | Psig_open (ovf, s) -> open_ ~loc ovf (map_loc sub s)
+    | Psig_include mt -> include_ ~loc (sub # module_type mt)
+    | Psig_class l -> class_ ~loc (List.map (sub # class_description) l)
+    | Psig_class_type l ->
+        class_type ~loc (List.map (sub # class_type_declaration) l)
+
+end
+
+
+module M = struct
+  (* Value expressions for the module language *)
+
+  let mk ?(loc = Location.none) x = {pmod_desc = x; pmod_loc = loc}
+  let ident ?loc x = mk ?loc (Pmod_ident x)
+  let structure ?loc x = mk ?loc (Pmod_structure x)
+  let functor_ ?loc arg arg_ty body = mk ?loc (Pmod_functor (arg, arg_ty, body))
+  let apply ?loc m1 m2 = mk ?loc (Pmod_apply (m1, m2))
+  let constraint_ ?loc m mty = mk ?loc (Pmod_constraint (m, mty))
+  let unpack ?loc e = mk ?loc (Pmod_unpack e)
+
+  let map sub {pmod_loc = loc; pmod_desc = desc} =
+    let loc = sub # location loc in
+    match desc with
+    | Pmod_ident x -> ident ~loc (map_loc sub x)
+    | Pmod_structure str -> structure ~loc (sub # structure str)
+    | Pmod_functor (arg, arg_ty, body) -> functor_ ~loc (map_loc sub arg) (sub # module_type arg_ty) (sub # module_expr body)
+    | Pmod_apply (m1, m2) -> apply ~loc (sub # module_expr m1) (sub # module_expr m2)
+    | Pmod_constraint (m, mty) -> constraint_ ~loc (sub # module_expr m) (sub # module_type mty)
+    | Pmod_unpack e -> unpack ~loc (sub # expr e)
+
+  let mk_item ?(loc = Location.none) x = {pstr_desc = x; pstr_loc = loc}
+  let eval ?loc a = mk_item ?loc (Pstr_eval a)
+  let value ?loc a b = mk_item ?loc (Pstr_value (a, b))
+  let primitive ?loc a b = mk_item ?loc (Pstr_primitive (a, b))
+  let type_ ?loc a = mk_item ?loc (Pstr_type a)
+  let exception_ ?loc a b = mk_item ?loc (Pstr_exception (a, b))
+  let exn_rebind ?loc a b = mk_item ?loc (Pstr_exn_rebind (a, b))
+  let module_ ?loc a b = mk_item ?loc (Pstr_module (a, b))
+  let rec_module ?loc a = mk_item ?loc (Pstr_recmodule a)
+  let modtype ?loc a b = mk_item ?loc (Pstr_modtype (a, b))
+  let open_ ?loc a b = mk_item ?loc (Pstr_open (a, b))
+  let class_ ?loc a = mk_item ?loc (Pstr_class a)
+  let class_type ?loc a = mk_item ?loc (Pstr_class_type a)
+  let include_ ?loc a = mk_item ?loc (Pstr_include a)
+
+  let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} =
+    let loc = sub # location loc in
+    match desc with
+    | Pstr_eval x -> eval ~loc (sub # expr x)
+    | Pstr_value (r, pel) -> value ~loc r (List.map (map_tuple (sub # pat) (sub # expr)) pel)
+    | Pstr_primitive (name, vd) -> primitive ~loc (map_loc sub name) (sub # value_description vd)
+    | Pstr_type l -> type_ ~loc (List.map (map_tuple (map_loc sub) (sub # type_declaration)) l)
+    | Pstr_exception (name, ed) -> exception_ ~loc (map_loc sub name) (sub # exception_declaration ed)
+    | Pstr_exn_rebind (s, lid) -> exn_rebind ~loc (map_loc sub s) (map_loc sub lid)
+    | Pstr_module (s, m) -> module_ ~loc (map_loc sub s) (sub # module_expr m)
+    | Pstr_recmodule l -> rec_module ~loc (List.map (fun (s, mty, me) -> (map_loc sub s, sub # module_type mty, sub # module_expr me)) l)
+    | Pstr_modtype (s, mty) -> modtype ~loc (map_loc sub s) (sub # module_type mty)
+    | Pstr_open (ovf, lid) -> open_ ~loc ovf (map_loc sub lid)
+    | Pstr_class l -> class_ ~loc (List.map (sub # class_declaration) l)
+    | Pstr_class_type l -> class_type ~loc (List.map (sub # class_type_declaration) l)
+    | Pstr_include e -> include_ ~loc (sub # module_expr e)
+end
+
+module E = struct
+  (* Value expressions for the core language *)
+
+  let mk ?(loc = Location.none) x = {pexp_desc = x; pexp_loc = loc}
+
+  let ident ?loc a = mk ?loc (Pexp_ident a)
+  let constant ?loc a = mk ?loc (Pexp_constant a)
+  let let_ ?loc a b c = mk ?loc (Pexp_let (a, b, c))
+  let function_ ?loc a b c = mk ?loc (Pexp_function (a, b, c))
+  let apply ?loc a b = mk ?loc (Pexp_apply (a, b))
+  let match_ ?loc a b = mk ?loc (Pexp_match (a, b))
+  let try_ ?loc a b = mk ?loc (Pexp_try (a, b))
+  let tuple ?loc a = mk ?loc (Pexp_tuple a)
+  let construct ?loc a b c = mk ?loc (Pexp_construct (a, b, c))
+  let variant ?loc a b = mk ?loc (Pexp_variant (a, b))
+  let record ?loc a b = mk ?loc (Pexp_record (a, b))
+  let field ?loc a b = mk ?loc (Pexp_field (a, b))
+  let setfield ?loc a b c = mk ?loc (Pexp_setfield (a, b, c))
+  let array ?loc a = mk ?loc (Pexp_array a)
+  let ifthenelse ?loc a b c = mk ?loc (Pexp_ifthenelse (a, b, c))
+  let sequence ?loc a b = mk ?loc (Pexp_sequence (a, b))
+  let while_ ?loc a b = mk ?loc (Pexp_while (a, b))
+  let for_ ?loc a b c d e = mk ?loc (Pexp_for (a, b, c, d, e))
+  let constraint_ ?loc a b c = mk ?loc (Pexp_constraint (a, b, c))
+  let when_ ?loc a b = mk ?loc (Pexp_when (a, b))
+  let send ?loc a b = mk ?loc (Pexp_send (a, b))
+  let new_ ?loc a = mk ?loc (Pexp_new a)
+  let setinstvar ?loc a b = mk ?loc (Pexp_setinstvar (a, b))
+  let override ?loc a = mk ?loc (Pexp_override a)
+  let letmodule ?loc (a, b, c)= mk ?loc (Pexp_letmodule (a, b, c))
+  let assert_ ?loc a = mk ?loc (Pexp_assert a)
+  let assertfalse ?loc () = mk ?loc Pexp_assertfalse
+  let lazy_ ?loc a = mk ?loc (Pexp_lazy a)
+  let poly ?loc a b = mk ?loc (Pexp_poly (a, b))
+  let object_ ?loc a = mk ?loc (Pexp_object a)
+  let newtype ?loc a b = mk ?loc (Pexp_newtype (a, b))
+  let pack ?loc a = mk ?loc (Pexp_pack a)
+  let open_ ?loc a b c = mk ?loc (Pexp_open (a, b, c))
+
+  let lid ?(loc = Location.none) lid = ident ~loc (mkloc (Longident.parse lid) loc)
+  let apply_nolabs ?loc f el = apply ?loc f (List.map (fun e -> ("", e)) el)
+  let strconst ?loc x = constant ?loc (Const_string x)
+
+  let map sub {pexp_loc = loc; pexp_desc = desc} =
+    let loc = sub # location loc in
+    match desc with
+    | Pexp_ident x -> ident ~loc (map_loc sub x)
+    | Pexp_constant x -> constant ~loc x
+    | Pexp_let (r, pel, e) -> let_ ~loc r (List.map (map_tuple (sub # pat) (sub # expr)) pel) (sub # expr e)
+    | Pexp_function (lab, def, pel) -> function_ ~loc lab (map_opt (sub # expr) def) (List.map (map_tuple (sub # pat) (sub # expr)) pel)
+    | Pexp_apply (e, l) -> apply ~loc (sub # expr e) (List.map (map_snd (sub # expr)) l)
+    | Pexp_match (e, l) -> match_ ~loc (sub # expr e) (List.map (map_tuple (sub # pat) (sub # expr)) l)
+    | Pexp_try (e, l) -> try_ ~loc (sub # expr e) (List.map (map_tuple (sub # pat) (sub # expr)) l)
+    | Pexp_tuple el -> tuple ~loc (List.map (sub # expr) el)
+    | Pexp_construct (lid, arg, b) -> construct ~loc (map_loc sub lid) (map_opt (sub # expr) arg) b
+    | Pexp_variant (lab, eo) -> variant ~loc lab (map_opt (sub # expr) eo)
+    | Pexp_record (l, eo) -> record ~loc (List.map (map_tuple (map_loc sub) (sub # expr)) l) (map_opt (sub # expr) eo)
+    | Pexp_field (e, lid) -> field ~loc (sub # expr e) (map_loc sub lid)
+    | Pexp_setfield (e1, lid, e2) -> setfield ~loc (sub # expr e1) (map_loc sub lid) (sub # expr e2)
+    | Pexp_array el -> array ~loc (List.map (sub # expr) el)
+    | Pexp_ifthenelse (e1, e2, e3) -> ifthenelse ~loc (sub # expr e1) (sub # expr e2) (map_opt (sub # expr) e3)
+    | Pexp_sequence (e1, e2) -> sequence ~loc (sub # expr e1) (sub # expr e2)
+    | Pexp_while (e1, e2) -> while_ ~loc (sub # expr e1) (sub # expr e2)
+    | Pexp_for (id, e1, e2, d, e3) -> for_ ~loc (map_loc sub id) (sub # expr e1) (sub # expr e2) d (sub # expr e3)
+    | Pexp_constraint (e, t1, t2) -> constraint_ ~loc (sub # expr e) (map_opt (sub # typ) t1) (map_opt (sub # typ) t2)
+    | Pexp_when (e1, e2) -> when_ ~loc (sub # expr e1) (sub # expr e2)
+    | Pexp_send (e, s) -> send ~loc (sub # expr e) s
+    | Pexp_new lid -> new_ ~loc (map_loc sub lid)
+    | Pexp_setinstvar (s, e) -> setinstvar ~loc (map_loc sub s) (sub # expr e)
+    | Pexp_override sel -> override ~loc (List.map (map_tuple (map_loc sub) (sub # expr)) sel)
+    | Pexp_letmodule (s, me, e) -> letmodule ~loc (map_loc sub s, sub # module_expr me, sub # expr e)
+    | Pexp_assert e -> assert_ ~loc (sub # expr e)
+    | Pexp_assertfalse -> assertfalse ~loc ()
+    | Pexp_lazy e -> lazy_ ~loc (sub # expr e)
+    | Pexp_poly (e, t) -> poly ~loc (sub # expr e) (map_opt (sub # typ) t)
+    | Pexp_object cls -> object_ ~loc (sub # class_structure cls)
+    | Pexp_newtype (s, e) -> newtype ~loc s (sub # expr e)
+    | Pexp_pack me -> pack ~loc (sub # module_expr me)
+    | Pexp_open (ovf, lid, e) -> open_ ~loc ovf (map_loc sub lid) (sub # expr e)
+end
+
+module P = struct
+  (* Patterns *)
+
+  let mk ?(loc = Location.none) x = {ppat_desc = x; ppat_loc = loc}
+  let any ?loc () = mk ?loc Ppat_any
+  let var ?loc a = mk ?loc (Ppat_var a)
+  let alias ?loc a b = mk ?loc (Ppat_alias (a, b))
+  let constant ?loc a = mk ?loc (Ppat_constant a)
+  let tuple ?loc a = mk ?loc (Ppat_tuple a)
+  let construct ?loc a b c = mk ?loc (Ppat_construct (a, b, c))
+  let variant ?loc a b = mk ?loc (Ppat_variant (a, b))
+  let record ?loc a b = mk ?loc (Ppat_record (a, b))
+  let array ?loc a = mk ?loc (Ppat_array a)
+  let or_ ?loc a b = mk ?loc (Ppat_or (a, b))
+  let constraint_ ?loc a b = mk ?loc (Ppat_constraint (a, b))
+  let type_ ?loc a = mk ?loc (Ppat_type a)
+  let lazy_ ?loc a = mk ?loc (Ppat_lazy a)
+  let unpack ?loc a = mk ?loc (Ppat_unpack a)
+
+  let map sub {ppat_desc = desc; ppat_loc = loc} =
+    let loc = sub # location loc in
+    match desc with
+    | Ppat_any -> any ~loc ()
+    | Ppat_var s -> var ~loc (map_loc sub s)
+    | Ppat_alias (p, s) -> alias ~loc (sub # pat p) (map_loc sub s)
+    | Ppat_constant c -> constant ~loc c
+    | Ppat_tuple pl -> tuple ~loc (List.map (sub # pat) pl)
+    | Ppat_construct (l, p, b) -> construct ~loc (map_loc sub l) (map_opt (sub # pat) p) b
+    | Ppat_variant (l, p) -> variant ~loc l (map_opt (sub # pat) p)
+    | Ppat_record (lpl, cf) ->
+        record ~loc (List.map (map_tuple (map_loc sub) (sub # pat)) lpl) cf
+    | Ppat_array pl -> array ~loc (List.map (sub # pat) pl)
+    | Ppat_or (p1, p2) -> or_ ~loc (sub # pat p1) (sub # pat p2)
+    | Ppat_constraint (p, t) -> constraint_ ~loc (sub # pat p) (sub # typ t)
+    | Ppat_type s -> type_ ~loc (map_loc sub s)
+    | Ppat_lazy p -> lazy_ ~loc (sub # pat p)
+    | Ppat_unpack s -> unpack ~loc (map_loc sub s)
+end
+
+module CE = struct
+  (* Value expressions for the class language *)
+
+  let mk ?(loc = Location.none) x = {pcl_loc = loc; pcl_desc = x}
+
+  let constr ?loc a b = mk ?loc (Pcl_constr (a, b))
+  let structure ?loc a = mk ?loc (Pcl_structure a)
+  let fun_ ?loc a b c d = mk ?loc (Pcl_fun (a, b, c, d))
+  let apply ?loc a b = mk ?loc (Pcl_apply (a, b))
+  let let_ ?loc a b c = mk ?loc (Pcl_let (a, b, c))
+  let constraint_ ?loc a b = mk ?loc (Pcl_constraint (a, b))
+
+  let map sub {pcl_loc = loc; pcl_desc = desc} =
+    let loc = sub # location loc in
+    match desc with
+    | Pcl_constr (lid, tys) -> constr ~loc (map_loc sub lid) (List.map (sub # typ) tys)
+    | Pcl_structure s ->
+        structure ~loc (sub # class_structure s)
+    | Pcl_fun (lab, e, p, ce) ->
+        fun_ ~loc lab
+          (map_opt (sub # expr) e)
+          (sub # pat p)
+          (sub # class_expr ce)
+    | Pcl_apply (ce, l) ->
+        apply ~loc (sub # class_expr ce) (List.map (map_snd (sub # expr)) l)
+    | Pcl_let (r, pel, ce) ->
+        let_ ~loc r
+          (List.map (map_tuple (sub # pat) (sub # expr)) pel)
+          (sub # class_expr ce)
+    | Pcl_constraint (ce, ct) ->
+        constraint_ ~loc (sub # class_expr ce) (sub # class_type ct)
+
+
+  let mk_field ?(loc = Location.none) x = {pcf_desc = x; pcf_loc = loc}
+
+  let inher ?loc a b c = mk_field ?loc (Pcf_inher (a, b, c))
+  let valvirt ?loc a b c = mk_field ?loc (Pcf_valvirt (a, b, c))
+  let val_ ?loc a b c d = mk_field ?loc (Pcf_val (a, b, c, d))
+  let virt ?loc a b c = mk_field ?loc (Pcf_virt (a, b, c))
+  let meth ?loc a b c d = mk_field ?loc (Pcf_meth (a, b, c, d))
+  let constr ?loc a b = mk_field ?loc (Pcf_constr (a, b))
+  let init ?loc a = mk_field ?loc (Pcf_init a)
+
+  let map_field sub {pcf_desc = desc; pcf_loc = loc} =
+    let loc = sub # location loc in
+    match desc with
+    | Pcf_inher (o, ce, s) -> inher ~loc o (sub # class_expr ce) s
+    | Pcf_valvirt (s, m, t) -> valvirt ~loc (map_loc sub s) m (sub # typ t)
+    | Pcf_val (s, m, o, e) -> val_ ~loc (map_loc sub s) m o (sub # expr e)
+    | Pcf_virt (s, p, t) -> virt ~loc (map_loc sub s) p (sub # typ t)
+    | Pcf_meth (s, p, o, e) -> meth ~loc (map_loc sub s) p o (sub # expr e)
+    | Pcf_constr (t1, t2) -> constr ~loc (sub # typ t1) (sub # typ t2)
+    | Pcf_init e -> init ~loc (sub # expr e)
+
+  let map_structure sub {pcstr_pat; pcstr_fields} =
+    {
+     pcstr_pat = sub # pat pcstr_pat;
+     pcstr_fields = List.map (sub # class_field) pcstr_fields;
+    }
+
+  let class_infos sub f {pci_virt; pci_params = (pl, ploc); pci_name; pci_expr; pci_variance; pci_loc} =
+    {
+     pci_virt;
+     pci_params = List.map (map_loc sub) pl, sub # location ploc;
+     pci_name = map_loc sub pci_name;
+     pci_expr = f pci_expr;
+     pci_variance;
+     pci_loc = sub # location pci_loc;
+    }
+end
+
+(* Now, a generic AST mapper class, to be extended to cover all kinds
+   and cases of the OCaml grammar.  The default behavior of the mapper
+   is the identity. *)
+
+class mapper =
+  object(this)
+    method implementation (input_name : string) ast = (input_name, this # structure ast)
+    method interface (input_name: string) ast = (input_name, this # signature ast)
+    method structure l = map_flatten (this # structure_item) l
+    method structure_item si = [ M.map_structure_item this si ]
+    method module_expr = M.map this
+
+    method signature l = map_flatten (this # signature_item) l
+    method signature_item si = [ MT.map_signature_item this si ]
+    method module_type = MT.map this
+    method with_constraint c = MT.map_with_constraint this c
+
+    method class_declaration = CE.class_infos this (this # class_expr)
+    method class_expr = CE.map this
+    method class_field = CE.map_field this
+    method class_structure = CE.map_structure this
+
+    method class_type = CT.map this
+    method class_type_field = CT.map_field this
+    method class_signature = CT.map_signature this
+
+    method class_type_declaration = CE.class_infos this (this # class_type)
+    method class_description = CE.class_infos this (this # class_type)
+
+    method type_declaration = T.map_type_declaration this
+    method type_kind = T.map_type_kind this
+    method typ = T.map this
+
+    method value_description {pval_type; pval_prim; pval_loc} =
+      {
+       pval_type = this # typ pval_type;
+       pval_prim;
+       pval_loc = this # location pval_loc;
+      }
+    method pat = P.map this
+    method expr = E.map this
+
+    method exception_declaration tl = List.map (this # typ) tl
+
+    method location l = l
+  end
+
+class type main_entry_points =
+  object
+    method implementation: string -> structure -> string * structure
+    method interface: string -> signature -> string * signature
+  end
+
+let apply ~source ~target mapper =
+  let ic = open_in_bin source in
+  let magic = String.create (String.length ast_impl_magic_number) in
+  really_input ic magic 0 (String.length magic);
+  if magic <> ast_impl_magic_number && magic <> ast_intf_magic_number then
+    failwith "Bad magic";
+  let input_name = input_value ic in
+  let ast = input_value ic in
+  close_in ic;
+
+  let (input_name, ast) =
+    if magic = ast_impl_magic_number
+    then Obj.magic (mapper # implementation input_name (Obj.magic ast))
+    else Obj.magic (mapper # interface input_name (Obj.magic ast))
+  in
+  let oc = open_out_bin target in
+  output_string oc magic;
+  output_value oc input_name;
+  output_value oc ast;
+  close_out oc
+
+let run_main mapper =
+  try
+    let a = Sys.argv in
+    let n = Array.length a in
+    if n > 2 then
+      apply ~source:a.(n - 2) ~target:a.(n - 1) (mapper (Array.to_list (Array.sub a 1 (n - 3))))
+    else begin
+      Printf.eprintf "Usage: %s [extra_args]  \n%!" Sys.executable_name;
+      exit 1
+    end
+  with exn ->
+    prerr_endline (Printexc.to_string exn);
+    exit 2
+
+let main mapper = run_main (fun _ -> mapper)
+
+let register_function = ref (fun _name f -> run_main f)
+let register name f = !register_function name (f :> string list -> mapper)
diff -Nru ocaml-3.12.1/parsing/ast_mapper.mli ocaml-4.01.0/parsing/ast_mapper.mli
--- ocaml-3.12.1/parsing/ast_mapper.mli	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/parsing/ast_mapper.mli	2013-07-23 14:48:47.000000000 +0000
@@ -0,0 +1,292 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(** Helpers to write Parsetree rewriters *)
+
+open Asttypes
+open Parsetree
+
+(** {2 A generic mapper class} *)
+
+class mapper:
+  object
+    method class_declaration: class_declaration -> class_declaration
+    method class_description: class_description -> class_description
+    method class_expr: class_expr -> class_expr
+    method class_field: class_field -> class_field
+    method class_signature: class_signature -> class_signature
+    method class_structure: class_structure -> class_structure
+    method class_type: class_type -> class_type
+    method class_type_declaration:
+             class_type_declaration -> class_type_declaration
+    method class_type_field: class_type_field -> class_type_field
+    method exception_declaration: exception_declaration -> exception_declaration
+    method expr: expression -> expression
+    method implementation: string -> structure -> string * structure
+    method interface: string -> signature -> string * signature
+    method location: Location.t -> Location.t
+    method module_expr: module_expr -> module_expr
+    method module_type: module_type -> module_type
+    method pat: pattern -> pattern
+    method signature: signature -> signature
+    method signature_item: signature_item -> signature_item list
+    method structure: structure -> structure
+    method structure_item: structure_item -> structure_item list
+    method typ: core_type -> core_type
+    method type_declaration: type_declaration -> type_declaration
+    method type_kind: type_kind -> type_kind
+    method value_description: value_description -> value_description
+    method with_constraint: with_constraint -> with_constraint
+  end
+
+class type main_entry_points =
+  object
+    method implementation: string -> structure -> string * structure
+    method interface: string -> signature -> string * signature
+  end
+
+val apply: source:string -> target:string -> #main_entry_points -> unit
+    (** Apply a mapper to a dumped parsetree found in the [source] file
+        and put the result in the [target] file. *)
+
+val main: #main_entry_points -> unit
+    (** Entry point to call to implement a standalone -ppx rewriter
+        from a mapper object. *)
+
+val run_main: (string list -> #main_entry_points) -> unit
+    (** Same as [main], but with extra arguments from the command line. *)
+
+(** {2 Registration API} *)
+
+val register_function: (string -> (string list -> mapper) -> unit) ref
+
+val register: string -> (string list -> #mapper) -> unit
+
+    (** Apply the [register_function].  The default behavior is to run
+        the mapper immediately, taking arguments from the process
+        command line.  This is to support a scenario where a mapper is
+        linked as a stand-alone executable.
+
+        It is possible to overwrite the [register_function] to define
+        "-ppx drivers", which combine several mappers in a single
+        process.  Typically, a driver starts by defining
+        [register_function] to a custom implementation, then lets ppx
+        rewriters (linked statically or dynamically) register
+        themselves, and then run all or some of them.  It is also
+        possible to have -ppx drivers apply rewriters to only specific
+        parts of an AST.  *)
+
+
+(** {2 Helpers to build Parsetree fragments} *)
+
+module T:
+  sig
+    val mk: ?loc:Location.t -> core_type_desc -> core_type
+    val any: ?loc:Location.t -> unit -> core_type
+    val var: ?loc:Location.t -> string -> core_type
+    val arrow: ?loc:Location.t -> label -> core_type -> core_type -> core_type
+    val tuple: ?loc:Location.t -> core_type list -> core_type
+    val constr:
+          ?loc:Location.t -> Longident.t loc -> core_type list -> core_type
+    val object_: ?loc:Location.t -> core_field_type list -> core_type
+    val class_:
+          ?loc:Location.t -> Longident.t loc -> core_type list ->
+            label list -> core_type
+    val alias: ?loc:Location.t -> core_type -> string -> core_type
+    val variant:
+          ?loc:Location.t -> row_field list -> bool -> label list option ->
+            core_type
+    val poly: ?loc:Location.t -> string list -> core_type -> core_type
+    val package:
+          ?loc:Location.t -> Longident.t loc ->
+            (Longident.t loc * core_type) list -> core_type
+    val field_type: ?loc:Location.t -> core_field_desc -> core_field_type
+    val field: ?loc:Location.t -> string -> core_type -> core_field_type
+    val field_var: ?loc:Location.t -> unit -> core_field_type
+    val core_field_type: mapper -> core_field_type -> core_field_type
+    val row_field: mapper -> row_field -> row_field
+    val map: mapper -> core_type -> core_type
+    val map_type_declaration: mapper -> type_declaration -> type_declaration
+    val map_type_kind: mapper -> type_kind -> type_kind
+  end
+
+module CT:
+  sig
+    val mk: ?loc:Location.t -> class_type_desc -> class_type
+    val constr:
+          ?loc:Location.t -> Longident.t loc -> core_type list -> class_type
+    val signature: ?loc:Location.t -> class_signature -> class_type
+    val fun_: ?loc:Location.t -> label -> core_type -> class_type -> class_type
+    val map: mapper -> class_type -> class_type
+    val mk_field: ?loc:Location.t -> class_type_field_desc -> class_type_field
+    val inher: ?loc:Location.t -> class_type -> class_type_field
+    val val_:
+          ?loc:Location.t -> string -> mutable_flag -> virtual_flag ->
+            core_type -> class_type_field
+    val virt:
+          ?loc:Location.t -> string -> private_flag -> core_type ->
+            class_type_field
+    val meth:
+          ?loc:Location.t -> string -> private_flag -> core_type ->
+            class_type_field
+    val cstr: ?loc:Location.t -> core_type -> core_type -> class_type_field
+    val map_field: mapper -> class_type_field -> class_type_field
+    val map_signature: mapper -> class_signature -> class_signature
+  end
+
+module MT:
+  sig
+    val mk: ?loc:Location.t -> module_type_desc -> module_type
+    val ident: ?loc:Location.t -> Longident.t loc -> module_type
+    val signature: ?loc:Location.t -> signature -> module_type
+    val functor_:
+          ?loc:Location.t -> string loc -> module_type -> module_type ->
+            module_type
+    val with_:
+          ?loc:Location.t -> module_type ->
+            (Longident.t loc * with_constraint) list -> module_type
+    val typeof_: ?loc:Location.t -> module_expr -> module_type
+    val map: mapper -> module_type -> module_type
+    val map_with_constraint: mapper -> with_constraint -> with_constraint
+    val mk_item: ?loc:Location.t -> signature_item_desc -> signature_item
+    val value:
+          ?loc:Location.t -> string loc -> value_description -> signature_item
+    val type_:
+          ?loc:Location.t -> (string loc * type_declaration) list ->
+            signature_item
+    val exception_:
+          ?loc:Location.t -> string loc -> exception_declaration ->
+            signature_item
+    val module_: ?loc:Location.t -> string loc -> module_type -> signature_item
+    val rec_module:
+          ?loc:Location.t -> (string loc * module_type) list -> signature_item
+    val modtype:
+          ?loc:Location.t -> string loc -> modtype_declaration -> signature_item
+    val open_:
+          ?loc:Location.t -> override_flag -> Longident.t loc -> signature_item
+    val include_: ?loc:Location.t -> module_type -> signature_item
+    val class_: ?loc:Location.t -> class_description list -> signature_item
+    val class_type:
+          ?loc:Location.t -> class_type_declaration list -> signature_item
+    val map_signature_item: mapper -> signature_item -> signature_item
+  end
+
+module M:
+  sig
+    val mk: ?loc:Location.t -> module_expr_desc -> module_expr
+    val ident: ?loc:Location.t -> Longident.t loc -> module_expr
+    val structure: ?loc:Location.t -> structure -> module_expr
+    val functor_: ?loc:Location.t -> string loc -> module_type -> module_expr -> module_expr
+    val apply: ?loc:Location.t -> module_expr -> module_expr -> module_expr
+    val constraint_: ?loc:Location.t -> module_expr -> module_type -> module_expr
+    val unpack: ?loc:Location.t -> expression -> module_expr
+    val map: mapper -> module_expr -> module_expr
+    val mk_item: ?loc:Location.t -> structure_item_desc -> structure_item
+    val eval: ?loc:Location.t -> expression -> structure_item
+    val value: ?loc:Location.t -> rec_flag -> (pattern * expression) list -> structure_item
+    val primitive: ?loc:Location.t -> string loc -> value_description -> structure_item
+    val type_: ?loc:Location.t -> (string loc * type_declaration) list -> structure_item
+    val exception_: ?loc:Location.t -> string loc -> exception_declaration -> structure_item
+    val exn_rebind: ?loc:Location.t -> string loc -> Longident.t loc -> structure_item
+    val module_: ?loc:Location.t -> string loc -> module_expr -> structure_item
+    val rec_module: ?loc:Location.t -> (string loc * module_type * module_expr)      list -> structure_item
+    val modtype: ?loc:Location.t -> string loc -> module_type -> structure_item
+    val open_: ?loc:Location.t -> override_flag -> Longident.t loc -> structure_item
+    val class_: ?loc:Location.t -> class_declaration list -> structure_item
+    val class_type: ?loc:Location.t -> class_type_declaration list -> structure_item
+    val include_: ?loc:Location.t -> module_expr -> structure_item
+    val map_structure_item: mapper -> structure_item -> structure_item
+  end
+
+module E:
+  sig
+    val mk: ?loc:Location.t -> expression_desc -> expression
+    val ident: ?loc:Location.t -> Longident.t loc -> expression
+    val constant: ?loc:Location.t -> constant -> expression
+    val let_: ?loc:Location.t -> rec_flag -> (pattern * expression) list -> expression -> expression
+    val function_: ?loc:Location.t -> label -> expression option -> (pattern * expression) list -> expression
+    val apply: ?loc:Location.t -> expression -> (label * expression) list -> expression
+    val match_: ?loc:Location.t -> expression -> (pattern * expression) list -> expression
+    val try_: ?loc:Location.t -> expression -> (pattern * expression) list -> expression
+    val tuple: ?loc:Location.t -> expression list -> expression
+    val construct: ?loc:Location.t -> Longident.t loc -> expression option -> bool -> expression
+    val variant: ?loc:Location.t -> label -> expression option -> expression
+    val record: ?loc:Location.t -> (Longident.t loc * expression) list -> expression option -> expression
+    val field: ?loc:Location.t -> expression -> Longident.t loc -> expression
+    val setfield: ?loc:Location.t -> expression -> Longident.t loc -> expression -> expression
+    val array: ?loc:Location.t -> expression list -> expression
+    val ifthenelse: ?loc:Location.t -> expression -> expression -> expression option -> expression
+    val sequence: ?loc:Location.t -> expression -> expression -> expression
+    val while_: ?loc:Location.t -> expression -> expression -> expression
+    val for_: ?loc:Location.t -> string loc -> expression -> expression -> direction_flag -> expression -> expression
+    val constraint_: ?loc:Location.t -> expression -> core_type option -> core_type option -> expression
+    val when_: ?loc:Location.t -> expression -> expression -> expression
+    val send: ?loc:Location.t -> expression -> string -> expression
+    val new_: ?loc:Location.t -> Longident.t loc -> expression
+    val setinstvar: ?loc:Location.t -> string loc -> expression -> expression
+    val override: ?loc:Location.t -> (string loc * expression) list -> expression
+    val letmodule: ?loc:Location.t -> string loc * module_expr * expression -> expression
+    val assert_: ?loc:Location.t -> expression -> expression
+    val assertfalse: ?loc:Location.t -> unit -> expression
+    val lazy_: ?loc:Location.t -> expression -> expression
+    val poly: ?loc:Location.t -> expression -> core_type option -> expression
+    val object_: ?loc:Location.t -> class_structure -> expression
+    val newtype: ?loc:Location.t -> string -> expression -> expression
+    val pack: ?loc:Location.t -> module_expr -> expression
+    val open_: ?loc:Location.t -> override_flag -> Longident.t loc -> expression -> expression
+    val lid: ?loc:Location.t -> string -> expression
+    val apply_nolabs: ?loc:Location.t -> expression -> expression list -> expression
+    val strconst: ?loc:Location.t -> string -> expression
+    val map: mapper -> expression -> expression
+  end
+
+module P:
+  sig
+    val mk: ?loc:Location.t -> pattern_desc -> pattern
+    val any: ?loc:Location.t -> unit -> pattern
+    val var: ?loc:Location.t -> string loc -> pattern
+    val alias: ?loc:Location.t -> pattern -> string loc -> pattern
+    val constant: ?loc:Location.t -> constant -> pattern
+    val tuple: ?loc:Location.t -> pattern list -> pattern
+    val construct: ?loc:Location.t -> Longident.t loc -> pattern option -> bool -> pattern
+    val variant: ?loc:Location.t -> label -> pattern option -> pattern
+    val record: ?loc:Location.t -> (Longident.t loc * pattern) list -> closed_flag -> pattern
+    val array: ?loc:Location.t -> pattern list -> pattern
+    val or_: ?loc:Location.t -> pattern -> pattern -> pattern
+    val constraint_: ?loc:Location.t -> pattern -> core_type -> pattern
+    val type_: ?loc:Location.t -> Longident.t loc -> pattern
+    val lazy_: ?loc:Location.t -> pattern -> pattern
+    val unpack: ?loc:Location.t -> string loc -> pattern
+    val map: mapper -> pattern -> pattern
+  end
+
+module CE:
+  sig
+    val mk: ?loc:Location.t -> class_expr_desc -> class_expr
+    val structure: ?loc:Location.t -> class_structure -> class_expr
+    val fun_: ?loc:Location.t -> label -> expression option -> pattern -> class_expr -> class_expr
+    val apply: ?loc:Location.t -> class_expr -> (label * expression) list -> class_expr
+    val let_: ?loc:Location.t -> rec_flag -> (pattern * expression) list -> class_expr -> class_expr
+    val constraint_: ?loc:Location.t -> class_expr -> class_type -> class_expr
+    val map: mapper -> class_expr -> class_expr
+    val mk_field: ?loc:Location.t -> class_field_desc -> class_field
+    val inher: ?loc:Location.t -> override_flag -> class_expr -> string option -> class_field
+    val valvirt: ?loc:Location.t -> string loc -> mutable_flag -> core_type -> class_field
+    val val_: ?loc:Location.t -> string loc -> mutable_flag -> override_flag -> expression -> class_field
+    val virt: ?loc:Location.t -> string loc -> private_flag -> core_type -> class_field
+    val meth: ?loc:Location.t -> string loc -> private_flag -> override_flag -> expression -> class_field
+    val constr: ?loc:Location.t -> core_type -> core_type -> class_field
+    val init: ?loc:Location.t -> expression -> class_field
+    val map_field: mapper -> class_field -> class_field
+    val map_structure: mapper -> class_structure -> class_structure
+    val class_infos: mapper -> ('a -> 'b) -> 'a class_infos -> 'b class_infos
+  end
diff -Nru ocaml-3.12.1/parsing/asttypes.mli ocaml-4.01.0/parsing/asttypes.mli
--- ocaml-3.12.1/parsing/asttypes.mli	2010-04-08 03:58:41.000000000 +0000
+++ ocaml-4.01.0/parsing/asttypes.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: asttypes.mli 10250 2010-04-08 03:58:41Z garrigue $ *)
-
 (* Auxiliary a.s.t. types used by parsetree and typedtree. *)
 
 type constant =
@@ -38,3 +36,8 @@
 type closed_flag = Closed | Open
 
 type label = string
+
+type 'a loc = 'a Location.loc = {
+  txt : 'a;
+  loc : Location.t;
+}
diff -Nru ocaml-3.12.1/parsing/lexer.mli ocaml-4.01.0/parsing/lexer.mli
--- ocaml-3.12.1/parsing/lexer.mli	2003-11-21 16:01:13.000000000 +0000
+++ ocaml-4.01.0/parsing/lexer.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,19 +10,18 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: lexer.mli 5961 2003-11-21 16:01:13Z xleroy $ *)
-
 (* The lexical analyzer *)
 
+val init : unit -> unit
 val token: Lexing.lexbuf -> Parser.token
 val skip_sharp_bang: Lexing.lexbuf -> unit
 
 type error =
   | Illegal_character of char
   | Illegal_escape of string
-  | Unterminated_comment
+  | Unterminated_comment of Location.t
   | Unterminated_string
-  | Unterminated_string_in_comment
+  | Unterminated_string_in_comment of Location.t
   | Keyword_as_label of string
   | Literal_overflow of string
 ;;
@@ -34,3 +33,9 @@
 val report_error: formatter -> error -> unit
 
 val in_comment : unit -> bool;;
+val in_string : unit -> bool;;
+
+
+val print_warnings : bool ref
+val comments : unit -> (string * Location.t) list
+val token_with_comments : Lexing.lexbuf -> Parser.token
diff -Nru ocaml-3.12.1/parsing/lexer.mll ocaml-4.01.0/parsing/lexer.mll
--- ocaml-3.12.1/parsing/lexer.mll	2010-04-08 03:58:41.000000000 +0000
+++ ocaml-4.01.0/parsing/lexer.mll	2013-05-28 11:05:58.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: lexer.mll 10250 2010-04-08 03:58:41Z garrigue $ *)
-
 (* The lexer definition *)
 
 {
@@ -22,9 +20,9 @@
 type error =
   | Illegal_character of char
   | Illegal_escape of string
-  | Unterminated_comment
+  | Unterminated_comment of Location.t
   | Unterminated_string
-  | Unterminated_string_in_comment
+  | Unterminated_string_in_comment of Location.t
   | Keyword_as_label of string
   | Literal_overflow of string
 ;;
@@ -113,6 +111,12 @@
   String.unsafe_set (!string_buff) (!string_index) c;
   incr string_index
 
+let store_lexeme lexbuf =
+  let s = Lexing.lexeme lexbuf in
+  for i = 0 to String.length s - 1 do
+    store_string_char s.[i];
+  done
+
 let get_stored_string () =
   let s = String.sub (!string_buff) 0 (!string_index) in
   string_buff := initial_string_buffer;
@@ -122,6 +126,9 @@
 let string_start_loc = ref Location.none;;
 let comment_start_loc = ref [];;
 let in_comment () = !comment_start_loc <> [];;
+let is_in_string = ref false
+let in_string () = !is_in_string
+let print_warnings = ref true
 
 (* To translate escape sequences *)
 
@@ -165,7 +172,8 @@
 let cvt_int64_literal s =
   Int64.neg (Int64.of_string ("-" ^ String.sub s 0 (String.length s - 1)))
 let cvt_nativeint_literal s =
-  Nativeint.neg (Nativeint.of_string ("-" ^ String.sub s 0 (String.length s - 1)))
+  Nativeint.neg (Nativeint.of_string ("-" ^ String.sub s 0
+                                                       (String.length s - 1)))
 
 (* Remove underscores from float literals *)
 
@@ -180,6 +188,16 @@
       |  c  -> s.[dst] <- c; remove (src + 1) (dst + 1)
   in remove 0 0
 
+(* recover the name from a LABEL or OPTLABEL token *)
+
+let get_label_name lexbuf =
+  let s = Lexing.lexeme lexbuf in
+  let name = String.sub s 1 (String.length s - 2) in
+  if Hashtbl.mem keyword_table name then
+    raise (Error(Keyword_as_label name, Location.curr lexbuf));
+  name
+;;
+
 (* Update the current location with file name and line number. *)
 
 let update_loc lexbuf file line absolute chars =
@@ -195,6 +213,13 @@
   }
 ;;
 
+(* Warn about Latin-1 characters used in idents *)
+
+let warn_latin1 lexbuf =
+  Location.prerr_warning (Location.curr lexbuf)
+    (Warnings.Deprecated "ISO-Latin1 characters in identifiers")
+;;
+
 (* Error report *)
 
 open Format
@@ -204,25 +229,29 @@
       fprintf ppf "Illegal character (%s)" (Char.escaped c)
   | Illegal_escape s ->
       fprintf ppf "Illegal backslash escape in string or character (%s)" s
-  | Unterminated_comment ->
+  | Unterminated_comment _ ->
       fprintf ppf "Comment not terminated"
   | Unterminated_string ->
       fprintf ppf "String literal not terminated"
-  | Unterminated_string_in_comment ->
+  | Unterminated_string_in_comment _ ->
       fprintf ppf "This comment contains an unterminated string literal"
   | Keyword_as_label kwd ->
       fprintf ppf "`%s' is a keyword, it cannot be used as label name" kwd
   | Literal_overflow ty ->
-      fprintf ppf "Integer literal exceeds the range of representable integers of type %s" ty
+      fprintf ppf "Integer literal exceeds the range of representable \
+                   integers of type %s" ty
 ;;
 
 }
 
-let newline = ('\010' | '\013' | "\013\010")
+let newline = ('\010' | "\013\010" )
 let blank = [' ' '\009' '\012']
-let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255' '_']
-let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222']
-let identchar =
+let lowercase = ['a'-'z' '_']
+let uppercase = ['A'-'Z']
+let identchar = ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9']
+let lowercase_latin1 = ['a'-'z' '\223'-'\246' '\248'-'\255' '_']
+let uppercase_latin1 = ['A'-'Z' '\192'-'\214' '\216'-'\222']
+let identchar_latin1 =
   ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9']
 let symbolchar =
   ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~']
@@ -253,27 +282,25 @@
   | "~"
       { TILDE }
   | "~" lowercase identchar * ':'
-      { let s = Lexing.lexeme lexbuf in
-        let name = String.sub s 1 (String.length s - 2) in
-        if Hashtbl.mem keyword_table name then
-          raise (Error(Keyword_as_label name, Location.curr lexbuf));
-        LABEL name }
-  | "?"  { QUESTION }
-  | "??" { QUESTIONQUESTION }
+      { LABEL (get_label_name lexbuf) }
+  | "~" lowercase_latin1 identchar_latin1 * ':'
+      { warn_latin1 lexbuf; LABEL (get_label_name lexbuf) }
+  | "?"
+      { QUESTION }
   | "?" lowercase identchar * ':'
-      { let s = Lexing.lexeme lexbuf in
-        let name = String.sub s 1 (String.length s - 2) in
-        if Hashtbl.mem keyword_table name then
-          raise (Error(Keyword_as_label name, Location.curr lexbuf));
-        OPTLABEL name }
+      { OPTLABEL (get_label_name lexbuf) }
+  | "?" lowercase_latin1 identchar_latin1 * ':'
+      { warn_latin1 lexbuf; OPTLABEL (get_label_name lexbuf) }
   | lowercase identchar *
       { let s = Lexing.lexeme lexbuf in
-          try
-            Hashtbl.find keyword_table s
-          with Not_found ->
-            LIDENT s }
+        try Hashtbl.find keyword_table s
+        with Not_found -> LIDENT s }
+  | lowercase_latin1 identchar_latin1 *
+      { warn_latin1 lexbuf; LIDENT (Lexing.lexeme lexbuf) }
   | uppercase identchar *
       { UIDENT(Lexing.lexeme lexbuf) }       (* No capitalized keywords *)
+  | uppercase_latin1 identchar_latin1 *
+      { warn_latin1 lexbuf; UIDENT(Lexing.lexeme lexbuf) }
   | int_literal
       { try
           INT (cvt_int_literal (Lexing.lexeme lexbuf))
@@ -299,9 +326,11 @@
           raise (Error(Literal_overflow "nativeint", Location.curr lexbuf)) }
   | "\""
       { reset_string_buffer();
+        is_in_string := true;
         let string_start = lexbuf.lex_start_p in
         string_start_loc := Location.curr lexbuf;
         string lexbuf;
+        is_in_string := false;
         lexbuf.lex_start_p <- string_start;
         STRING (get_stored_string()) }
   | "'" newline "'"
@@ -321,15 +350,25 @@
         raise (Error(Illegal_escape esc, Location.curr lexbuf))
       }
   | "(*"
-      { comment_start_loc := [Location.curr lexbuf];
-        comment lexbuf;
-        token lexbuf }
+      { let start_loc = Location.curr lexbuf  in
+        comment_start_loc := [start_loc];
+        reset_string_buffer ();
+        let end_loc = comment lexbuf in
+        let s = get_stored_string () in
+        reset_string_buffer ();
+        COMMENT (s, { start_loc with
+                      Location.loc_end = end_loc.Location.loc_end })
+      }
   | "(*)"
-      { let loc = Location.curr lexbuf in
-        Location.prerr_warning loc Warnings.Comment_start;
-        comment_start_loc := [Location.curr lexbuf];
-        comment lexbuf;
-        token lexbuf
+      { let loc = Location.curr lexbuf  in
+        if !print_warnings then
+          Location.prerr_warning loc Warnings.Comment_start;
+        comment_start_loc := [loc];
+        reset_string_buffer ();
+        let end_loc = comment lexbuf in
+        let s = get_stored_string () in
+        reset_string_buffer ();
+        COMMENT (s, { loc with Location.loc_end = end_loc.Location.loc_end })
       }
   | "*)"
       { let loc = Location.curr lexbuf in
@@ -411,53 +450,64 @@
 and comment = parse
     "(*"
       { comment_start_loc := (Location.curr lexbuf) :: !comment_start_loc;
+        store_lexeme lexbuf;
         comment lexbuf;
       }
   | "*)"
       { match !comment_start_loc with
         | [] -> assert false
-        | [x] -> comment_start_loc := [];
+        | [_] -> comment_start_loc := []; Location.curr lexbuf
         | _ :: l -> comment_start_loc := l;
-                    comment lexbuf;
+                  store_lexeme lexbuf;
+                  comment lexbuf;
        }
   | "\""
-      { reset_string_buffer();
+      {
         string_start_loc := Location.curr lexbuf;
+        store_string_char '"';
+        is_in_string := true;
         begin try string lexbuf
         with Error (Unterminated_string, _) ->
           match !comment_start_loc with
           | [] -> assert false
-          | loc :: _ -> comment_start_loc := [];
-                        raise (Error (Unterminated_string_in_comment, loc))
+          | loc :: _ ->
+            let start = List.hd (List.rev !comment_start_loc) in
+            comment_start_loc := [];
+            raise (Error (Unterminated_string_in_comment start, loc))
         end;
-        reset_string_buffer ();
+        is_in_string := false;
+        store_string_char '"';
         comment lexbuf }
   | "''"
-      { comment lexbuf }
+      { store_lexeme lexbuf; comment lexbuf }
   | "'" newline "'"
       { update_loc lexbuf None 1 false 1;
+        store_lexeme lexbuf;
         comment lexbuf
       }
   | "'" [^ '\\' '\'' '\010' '\013' ] "'"
-      { comment lexbuf }
+      { store_lexeme lexbuf; comment lexbuf }
   | "'\\" ['\\' '"' '\'' 'n' 't' 'b' 'r' ' '] "'"
-      { comment lexbuf }
+      { store_lexeme lexbuf; comment lexbuf }
   | "'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
-      { comment lexbuf }
+      { store_lexeme lexbuf; comment lexbuf }
   | "'\\" 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] "'"
-      { comment lexbuf }
+      { store_lexeme lexbuf; comment lexbuf }
   | eof
       { match !comment_start_loc with
         | [] -> assert false
-        | loc :: _ -> comment_start_loc := [];
-                      raise (Error (Unterminated_comment, loc))
+        | loc :: _ ->
+          let start = List.hd (List.rev !comment_start_loc) in
+          comment_start_loc := [];
+          raise (Error (Unterminated_comment start, loc))
       }
   | newline
       { update_loc lexbuf None 1 false 0;
+        store_lexeme lexbuf;
         comment lexbuf
       }
   | _
-      { comment lexbuf }
+      { store_lexeme lexbuf; comment lexbuf }
 
 and string = parse
     '"'
@@ -494,14 +544,12 @@
       { if not (in_comment ()) then
           Location.prerr_warning (Location.curr lexbuf) Warnings.Eol_in_string;
         update_loc lexbuf None 1 false 0;
-        let s = Lexing.lexeme lexbuf in
-        for i = 0 to String.length s - 1 do
-          store_string_char s.[i];
-        done;
+        store_lexeme lexbuf;
         string lexbuf
       }
   | eof
-      { raise (Error (Unterminated_string, !string_start_loc)) }
+      { is_in_string := false;
+        raise (Error (Unterminated_string, !string_start_loc)) }
   | _
       { store_string_char(Lexing.lexeme_char lexbuf 0);
         string lexbuf }
@@ -512,3 +560,21 @@
   | "#!" [^ '\n']* '\n'
        { update_loc lexbuf None 1 false 0 }
   | "" { () }
+
+{
+  let token_with_comments = token
+
+  let last_comments = ref []
+  let rec token lexbuf =
+    match token_with_comments lexbuf with
+        COMMENT (s, comment_loc) ->
+          last_comments := (s, comment_loc) :: !last_comments;
+          token lexbuf
+      | tok -> tok
+  let comments () = List.rev !last_comments
+  let init () =
+    is_in_string := false;
+    last_comments := [];
+    comment_start_loc := []
+
+}
diff -Nru ocaml-3.12.1/parsing/linenum.mli ocaml-4.01.0/parsing/linenum.mli
--- ocaml-3.12.1/parsing/linenum.mli	1999-11-17 18:59:06.000000000 +0000
+++ ocaml-4.01.0/parsing/linenum.mli	1970-01-01 00:00:00.000000000 +0000
@@ -1,23 +0,0 @@
-(***********************************************************************)
-(*                                                                     *)
-(*                           Objective Caml                            *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1997 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* $Id: linenum.mli 2553 1999-11-17 18:59:06Z xleroy $ *)
-
-(* An auxiliary lexer for determining the line number corresponding to
-   a file position, honoring the directives # linenum "filename" *)
-
-val for_position: string -> int -> string * int * int
-        (* [Linenum.for_position file loc] returns a triple describing
-           the location [loc] in the file named [file].
-           First result is name of actual source file.
-           Second result is line number in that source file.
-           Third result is position of beginning of that line in [file]. *)
diff -Nru ocaml-3.12.1/parsing/linenum.mll ocaml-4.01.0/parsing/linenum.mll
--- ocaml-3.12.1/parsing/linenum.mll	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/parsing/linenum.mll	1970-01-01 00:00:00.000000000 +0000
@@ -1,74 +0,0 @@
-(***********************************************************************)
-(*                                                                     *)
-(*                           Objective Caml                            *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1997 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* $Id: linenum.mll 9547 2010-01-22 12:48:24Z doligez $ *)
-
-(* An auxiliary lexer for determining the line number corresponding to
-   a file position, honoring the directives # linenum "filename" *)
-
-{
-let filename = ref ""
-let linenum = ref 0
-let linebeg = ref 0
-
-let parse_sharp_line s =
-  try
-    (* Update the line number and file name *)
-    let l1 = ref 0 in
-    while let c = s.[!l1] in c < '0' || c > '9' do incr l1 done;
-    let l2 = ref (!l1 + 1) in
-    while let c = s.[!l2] in c >= '0' && c <= '9' do incr l2 done;
-    linenum := int_of_string(String.sub s !l1 (!l2 - !l1));
-    let f1 = ref (!l2 + 1) in
-    while !f1 < String.length s && s.[!f1] <> '"' do incr f1 done;
-    let f2 = ref (!f1 + 1) in
-    while !f2 < String.length s && s.[!f2] <> '"' do incr f2 done;
-    if !f1 < String.length s then
-      filename := String.sub s (!f1 + 1) (!f2 - !f1 - 1)
-  with Failure _ | Invalid_argument _ ->
-    Misc.fatal_error "Linenum.parse_sharp_line"
-}
-
-rule skip_line = parse
-    "#" [' ' '\t']* ['0'-'9']+ [' ' '\t']*
-    ("\"" [^ '\n' '\r' '"' (* '"' *) ] * "\"")?
-    [^ '\n' '\r'] *
-    ('\n' | '\r' | "\r\n")
-      { parse_sharp_line(Lexing.lexeme lexbuf);
-        linebeg := Lexing.lexeme_start lexbuf;
-        Lexing.lexeme_end lexbuf }
-  | [^ '\n' '\r'] *
-    ('\n' | '\r' | "\r\n")
-      { incr linenum;
-        linebeg := Lexing.lexeme_start lexbuf;
-        Lexing.lexeme_end lexbuf }
-  | [^ '\n' '\r'] * eof
-      { incr linenum;
-        linebeg := Lexing.lexeme_start lexbuf;
-        raise End_of_file }
-
-{
-
-let for_position file loc =
-  let ic = open_in_bin file in
-  let lb = Lexing.from_channel ic in
-  filename := file;
-  linenum := 1;
-  linebeg := 0;
-  begin try
-    while skip_line lb <= loc do () done
-  with End_of_file -> ()
-  end;
-  close_in ic;
-  (!filename, !linenum - 1, !linebeg)
-
-}
diff -Nru ocaml-3.12.1/parsing/location.ml ocaml-4.01.0/parsing/location.ml
--- ocaml-3.12.1/parsing/location.ml	2011-05-17 16:14:39.000000000 +0000
+++ ocaml-4.01.0/parsing/location.ml	2013-06-12 15:32:27.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,13 +10,13 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: location.ml 11050 2011-05-17 16:14:39Z doligez $ *)
-
 open Lexing
 
-type t = { loc_start: position; loc_end: position; loc_ghost: bool };;
+let absname = ref false
+    (* This reference should be in Clflags, but it would create an additional
+       dependency and make bootstrapping Camlp4 more difficult. *)
 
-let none = { loc_start = dummy_pos; loc_end = dummy_pos; loc_ghost = true };;
+type t = { loc_start: position; loc_end: position; loc_ghost: bool };;
 
 let in_file name =
   let loc = {
@@ -28,6 +28,8 @@
   { loc_start = loc; loc_end = loc; loc_ghost = true }
 ;;
 
+let none = in_file "_none_";;
+
 let curr lexbuf = {
   loc_start = lexbuf.lex_start_p;
   loc_end = lexbuf.lex_curr_p;
@@ -130,32 +132,15 @@
   let line = ref 0 in
   let pos_at_bol = ref 0 in
   for pos = 0 to end_pos do
-    let c = lb.lex_buffer.[pos + pos0] in
-    if c <> '\n' then begin
-      if !line = !line_start && !line = !line_end then
-        (* loc is on one line: print whole line *)
-        Format.pp_print_char ppf c
-      else if !line = !line_start then
-        (* first line of multiline loc: print ... before loc_start *)
-        if pos < loc.loc_start.pos_cnum
-        then Format.pp_print_char ppf '.'
-        else Format.pp_print_char ppf c
-      else if !line = !line_end then
-        (* last line of multiline loc: print ... after loc_end *)
-        if pos < loc.loc_end.pos_cnum
-        then Format.pp_print_char ppf c
-        else Format.pp_print_char ppf '.'
-      else if !line > !line_start && !line < !line_end then
-        (* intermediate line of multiline loc: print whole line *)
-        Format.pp_print_char ppf c
-    end else begin
+    match lb.lex_buffer.[pos + pos0] with
+    | '\n' ->
       if !line = !line_start && !line = !line_end then begin
         (* loc is on one line: underline location *)
         Format.fprintf ppf "@.  ";
-        for i = !pos_at_bol to loc.loc_start.pos_cnum - 1 do
+        for _i = !pos_at_bol to loc.loc_start.pos_cnum - 1 do
           Format.pp_print_char ppf ' '
         done;
-        for i = loc.loc_start.pos_cnum to loc.loc_end.pos_cnum - 1 do
+        for _i = loc.loc_start.pos_cnum to loc.loc_end.pos_cnum - 1 do
           Format.pp_print_char ppf '^'
         done
       end;
@@ -164,8 +149,29 @@
         if pos < loc.loc_end.pos_cnum then Format.pp_print_string ppf "  "
       end;
       incr line;
-      pos_at_bol := pos + 1;
-    end
+      pos_at_bol := pos + 1
+    | '\r' -> () (* discard *)
+    | c ->
+      if !line = !line_start && !line = !line_end then
+        (* loc is on one line: print whole line *)
+        Format.pp_print_char ppf c
+      else if !line = !line_start then
+        (* first line of multiline loc:
+           print a dot for each char before loc_start *)
+        if pos < loc.loc_start.pos_cnum then
+          Format.pp_print_char ppf '.'
+        else
+          Format.pp_print_char ppf c
+      else if !line = !line_end then
+        (* last line of multiline loc: print a dot for each char
+           after loc_end, even whitespaces *)
+        if pos < loc.loc_end.pos_cnum then
+          Format.pp_print_char ppf c
+        else
+          Format.pp_print_char ppf '.'
+      else if !line > !line_start && !line < !line_end then
+        (* intermediate line of multiline loc: print whole line *)
+        Format.pp_print_char ppf c
   done
 
 (* Highlight the location using one of the supported modes. *)
@@ -196,42 +202,57 @@
 
 open Format
 
+let absolute_path s = (* This function could go into Filename *)
+  let open Filename in
+  let s = if is_relative s then concat (Sys.getcwd ()) s else s in
+  (* Now simplify . and .. components *)
+  let rec aux s =
+    let base = basename s in
+    let dir = dirname s in
+    if dir = s then dir
+    else if base = current_dir_name then aux dir
+    else if base = parent_dir_name then dirname (aux dir)
+    else concat (aux dir) base
+  in
+  aux s
+
+let show_filename file =
+  if !absname then absolute_path file else file
+
+let print_filename ppf file =
+  Format.fprintf ppf "%s" (show_filename file)
+
 let reset () =
   num_loc_lines := 0
 
-let (msg_file, msg_line, msg_chars, msg_to, msg_colon, msg_head) =
-  ("File \"", "\", line ", ", characters ", "-", ":", "")
+let (msg_file, msg_line, msg_chars, msg_to, msg_colon) =
+  ("File \"", "\", line ", ", characters ", "-", ":")
 
 (* return file, line, char from the given position *)
 let get_pos_info pos =
-  let (filename, linenum, linebeg) =
-    if pos.pos_fname = "" && !input_name = "" then
-      ("", -1, 0)
-    else if pos.pos_fname = "" then
-      Linenum.for_position !input_name pos.pos_cnum
-    else
-      (pos.pos_fname, pos.pos_lnum, pos.pos_bol)
-  in
-  (filename, linenum, pos.pos_cnum - linebeg)
+  (pos.pos_fname, pos.pos_lnum, pos.pos_cnum - pos.pos_bol)
 ;;
 
-let print ppf loc =
+let print_loc ppf loc =
   let (file, line, startchar) = get_pos_info loc.loc_start in
   let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in
-  let (startchar, endchar) =
-    if startchar < 0 then (0, 1) else (startchar, endchar)
-  in
-  if file = "" then begin
+  if file = "//toplevel//" then begin
     if highlight_locations ppf loc none then () else
-      fprintf ppf "Characters %i-%i:@."
+      fprintf ppf "Characters %i-%i"
               loc.loc_start.pos_cnum loc.loc_end.pos_cnum
   end else begin
-    fprintf ppf "%s%s%s%i" msg_file file msg_line line;
-    fprintf ppf "%s%i" msg_chars startchar;
-    fprintf ppf "%s%i%s@.%s" msg_to endchar msg_colon msg_head;
+    fprintf ppf "%s%a%s%i" msg_file print_filename file msg_line line;
+    if startchar >= 0 then
+      fprintf ppf "%s%i%s%i" msg_chars startchar msg_to endchar
   end
 ;;
 
+let print ppf loc =
+  if loc.loc_start.pos_fname = "//toplevel//"
+  && highlight_locations ppf loc none then ()
+  else fprintf ppf "%a%s@." print_loc loc msg_colon
+;;
+
 let print_error ppf loc =
   print ppf loc;
   fprintf ppf "Error: ";
@@ -245,7 +266,7 @@
       let n = Warnings.print ppf w in
       num_loc_lines := !num_loc_lines + n
     in
-    fprintf ppf "%a" print loc;
+    print ppf loc;
     fprintf ppf "Warning %a@." printw w;
     pp_print_flush ppf ();
     incr num_loc_lines;
@@ -257,3 +278,11 @@
 let echo_eof () =
   print_newline ();
   incr num_loc_lines
+
+type 'a loc = {
+  txt : 'a;
+  loc : t;
+}
+
+let mkloc txt loc = { txt ; loc }
+let mknoloc txt = mkloc txt none
diff -Nru ocaml-3.12.1/parsing/location.mli ocaml-4.01.0/parsing/location.mli
--- ocaml-3.12.1/parsing/location.mli	2007-12-04 13:38:58.000000000 +0000
+++ ocaml-4.01.0/parsing/location.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: location.mli 8705 2007-12-04 13:38:58Z doligez $ *)
-
 (* Source code locations (ranges of positions), used in parsetree. *)
 
 open Format
@@ -41,12 +39,16 @@
 
 val symbol_rloc: unit -> t
 val symbol_gloc: unit -> t
+
+(** [rhs_loc n] returns the location of the symbol at position [n], starting
+  at 1, in the current parser rule. *)
 val rhs_loc: int -> t
 
 val input_name: string ref
 val input_lexbuf: Lexing.lexbuf option ref
 
-val get_pos_info : Lexing.position -> string * int * int (* file, line, char *)
+val get_pos_info: Lexing.position -> string * int * int (* file, line, char *)
+val print_loc: formatter -> t -> unit
 val print_error: formatter -> t -> unit
 val print_error_cur_file: formatter -> unit
 val print_warning: t -> formatter -> Warnings.t -> unit
@@ -55,3 +57,21 @@
 val reset: unit -> unit
 
 val highlight_locations: formatter -> t -> t -> bool
+
+type 'a loc = {
+  txt : 'a;
+  loc : t;
+}
+
+val mknoloc : 'a -> 'a loc
+val mkloc : 'a -> t -> 'a loc
+
+val print: formatter -> t -> unit
+val print_filename: formatter -> string -> unit
+
+val show_filename: string -> string
+    (** In -absname mode, return the absolute path for this filename.
+        Otherwise, returns the filename unchanged. *)
+
+
+val absname: bool ref
diff -Nru ocaml-3.12.1/parsing/longident.ml ocaml-4.01.0/parsing/longident.ml
--- ocaml-3.12.1/parsing/longident.ml	2009-08-27 08:19:08.000000000 +0000
+++ ocaml-4.01.0/parsing/longident.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: longident.ml 9324 2009-08-27 08:19:08Z xleroy $ *)
-
 type t =
     Lident of string
   | Ldot of t * string
@@ -20,14 +18,14 @@
 let rec flat accu = function
     Lident s -> s :: accu
   | Ldot(lid, s) -> flat (s :: accu) lid
-  | Lapply(l1, l2) -> Misc.fatal_error "Longident.flat"
+  | Lapply(_, _) -> Misc.fatal_error "Longident.flat"
 
 let flatten lid = flat [] lid
 
 let last = function
     Lident s -> s
-  | Ldot(lid, s) -> s
-  | Lapply(l1, l2) -> Misc.fatal_error "Longident.last"
+  | Ldot(_, s) -> s
+  | Lapply(_, _) -> Misc.fatal_error "Longident.last"
 
 let rec split_at_dots s pos =
   try
diff -Nru ocaml-3.12.1/parsing/longident.mli ocaml-4.01.0/parsing/longident.mli
--- ocaml-3.12.1/parsing/longident.mli	2009-08-27 08:19:08.000000000 +0000
+++ ocaml-4.01.0/parsing/longident.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: longident.mli 9324 2009-08-27 08:19:08Z xleroy $ *)
-
 (* Long identifiers, used in parsetree. *)
 
 type t =
diff -Nru ocaml-3.12.1/parsing/parse.ml ocaml-4.01.0/parsing/parse.ml
--- ocaml-3.12.1/parsing/parse.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/parsing/parse.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,12 +10,8 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: parse.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* Entry points in the parser *)
 
-open Location
-
 (* Skip tokens to the end of the phrase *)
 
 let rec skip_phrase lexbuf =
@@ -24,9 +20,9 @@
       Parser.SEMISEMI | Parser.EOF -> ()
     | _ -> skip_phrase lexbuf
   with
-    | Lexer.Error (Lexer.Unterminated_comment, _) -> ()
+    | Lexer.Error (Lexer.Unterminated_comment _, _) -> ()
     | Lexer.Error (Lexer.Unterminated_string, _) -> ()
-    | Lexer.Error (Lexer.Unterminated_string_in_comment, _) -> ()
+    | Lexer.Error (Lexer.Unterminated_string_in_comment _, _) -> ()
     | Lexer.Error (Lexer.Illegal_character _, _) -> skip_phrase lexbuf
 ;;
 
@@ -38,22 +34,23 @@
 
 let wrap parsing_fun lexbuf =
   try
+    Lexer.init ();
     let ast = parsing_fun Lexer.token lexbuf in
     Parsing.clear_parser();
     ast
   with
-  | Lexer.Error(Lexer.Unterminated_comment, _) as err -> raise err
+  | Lexer.Error(Lexer.Unterminated_comment _, _) as err -> raise err
   | Lexer.Error(Lexer.Unterminated_string, _) as err -> raise err
-  | Lexer.Error(Lexer.Unterminated_string_in_comment, _) as err -> raise err
+  | Lexer.Error(Lexer.Unterminated_string_in_comment _, _) as err -> raise err
   | Lexer.Error(Lexer.Illegal_character _, _) as err ->
-      if !Location.input_name = "" then skip_phrase lexbuf;
+      if !Location.input_name = "//toplevel//" then skip_phrase lexbuf;
       raise err
   | Syntaxerr.Error _ as err ->
-      if !Location.input_name = "" then maybe_skip_phrase lexbuf;
+      if !Location.input_name = "//toplevel//" then maybe_skip_phrase lexbuf;
       raise err
   | Parsing.Parse_error | Syntaxerr.Escape_error ->
       let loc = Location.curr lexbuf in
-      if !Location.input_name = ""
+      if !Location.input_name = "//toplevel//"
       then maybe_skip_phrase lexbuf;
       raise(Syntaxerr.Error(Syntaxerr.Other loc))
 ;;
diff -Nru ocaml-3.12.1/parsing/parse.mli ocaml-4.01.0/parsing/parse.mli
--- ocaml-3.12.1/parsing/parse.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/parsing/parse.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: parse.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* Entry points in the parser *)
 
 val implementation : Lexing.lexbuf -> Parsetree.structure
diff -Nru ocaml-3.12.1/parsing/parser.mly ocaml-4.01.0/parsing/parser.mly
--- ocaml-3.12.1/parsing/parser.mly	2011-04-29 04:56:21.000000000 +0000
+++ ocaml-4.01.0/parsing/parser.mly	2013-05-16 13:34:53.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -10,8 +10,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: parser.mly 11016 2011-04-29 04:56:21Z furuse $ */
-
 /* The parser definition */
 
 %{
@@ -40,19 +38,32 @@
   { pcl_desc = d; pcl_loc = symbol_rloc() }
 let mkcty d =
   { pcty_desc = d; pcty_loc = symbol_rloc() }
+let mkctf d =
+  { pctf_desc = d; pctf_loc = symbol_rloc () }
+let mkcf d =
+  { pcf_desc = d; pcf_loc = symbol_rloc () }
+let mkrhs rhs pos = mkloc rhs (rhs_loc pos)
+let mkoption d =
+  let loc = {d.ptyp_loc with loc_ghost = true} in
+  { ptyp_desc = Ptyp_constr(mkloc (Ldot (Lident "*predef*", "option")) loc,[d]);
+    ptyp_loc = loc}
 
 let reloc_pat x = { x with ppat_loc = symbol_rloc () };;
 let reloc_exp x = { x with pexp_loc = symbol_rloc () };;
 
 let mkoperator name pos =
-  { pexp_desc = Pexp_ident(Lident name); pexp_loc = rhs_loc pos }
+  let loc = rhs_loc pos in
+  { pexp_desc = Pexp_ident(mkloc (Lident name) loc); pexp_loc = loc }
+
+let mkpatvar name pos =
+  { ppat_desc = Ppat_var (mkrhs name pos); ppat_loc = rhs_loc pos }
 
 (*
   Ghost expressions and patterns:
-  expressions and patterns that do not appear explicitely in the
+  expressions and patterns that do not appear explicitly in the
   source file they have the loc_ghost flag set to true.
   Then the profiler will not try to instrument them and the
-  -stypes option will not try to display their type.
+  -annot option will not try to display their type.
 
   Every grammar rule that generates an element with a location must
   make at most one non-ghost element, the topmost one.
@@ -67,10 +78,12 @@
 let ghexp d = { pexp_desc = d; pexp_loc = symbol_gloc () };;
 let ghpat d = { ppat_desc = d; ppat_loc = symbol_gloc () };;
 let ghtyp d = { ptyp_desc = d; ptyp_loc = symbol_gloc () };;
+let ghloc d = { txt = d; loc = symbol_gloc () };;
 
 let mkassert e =
   match e with
-  | {pexp_desc = Pexp_construct (Lident "false", None, false) } ->
+  | {pexp_desc = Pexp_construct ({ txt = Lident "false" }, None , false);
+     pexp_loc = _ } ->
          mkexp (Pexp_assertfalse)
   | _ -> mkexp (Pexp_assert (e))
 ;;
@@ -109,35 +122,47 @@
   | _ ->
       mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, ["", arg]))
 
-let rec mktailexp = function
+let mkexp_cons consloc args loc =
+  {pexp_desc = Pexp_construct(mkloc (Lident "::") consloc, Some args, false);
+   pexp_loc = loc}
+
+let mkpat_cons consloc args loc =
+  {ppat_desc = Ppat_construct(mkloc (Lident "::") consloc, Some args, false);
+   ppat_loc = loc}
+
+let rec mktailexp nilloc = function
     [] ->
-      ghexp(Pexp_construct(Lident "[]", None, false))
+      let loc = { nilloc with loc_ghost = true } in
+      let nil = { txt = Lident "[]"; loc = loc } in
+      { pexp_desc = Pexp_construct (nil, None, false); pexp_loc = loc }
   | e1 :: el ->
-      let exp_el = mktailexp el in
+      let exp_el = mktailexp nilloc el in
       let l = {loc_start = e1.pexp_loc.loc_start;
                loc_end = exp_el.pexp_loc.loc_end;
                loc_ghost = true}
       in
       let arg = {pexp_desc = Pexp_tuple [e1; exp_el]; pexp_loc = l} in
-      {pexp_desc = Pexp_construct(Lident "::", Some arg, false); pexp_loc = l}
+      mkexp_cons {l with loc_ghost = true} arg l
 
-let rec mktailpat = function
+let rec mktailpat nilloc = function
     [] ->
-      ghpat(Ppat_construct(Lident "[]", None, false))
+      let loc = { nilloc with loc_ghost = true } in
+      let nil = { txt = Lident "[]"; loc = loc } in
+      { ppat_desc = Ppat_construct (nil, None, false); ppat_loc = loc }
   | p1 :: pl ->
-      let pat_pl = mktailpat pl in
+      let pat_pl = mktailpat nilloc pl in
       let l = {loc_start = p1.ppat_loc.loc_start;
                loc_end = pat_pl.ppat_loc.loc_end;
                loc_ghost = true}
       in
       let arg = {ppat_desc = Ppat_tuple [p1; pat_pl]; ppat_loc = l} in
-      {ppat_desc = Ppat_construct(Lident "::", Some arg, false); ppat_loc = l}
+      mkpat_cons {l with loc_ghost = true} arg l
 
-let ghstrexp e =
-  { pstr_desc = Pstr_eval e; pstr_loc = {e.pexp_loc with loc_ghost = true} }
+let mkstrexp e =
+  { pstr_desc = Pstr_eval e; pstr_loc = e.pexp_loc }
 
 let array_function str name =
-  Ldot(Lident str, (if !Clflags.fast then "unsafe_" ^ name else name))
+  ghloc (Ldot(Lident str, (if !Clflags.fast then "unsafe_" ^ name else name)))
 
 let rec deep_mkrangepat c1 c2 =
   if c1 = c2 then ghpat(Ppat_constant(Const_char c1)) else
@@ -156,11 +181,14 @@
   raise(Syntaxerr.Error(Syntaxerr.Unclosed(rhs_loc opening_num, opening_name,
                                            rhs_loc closing_num, closing_name)))
 
+let expecting pos nonterm =
+    raise Syntaxerr.(Error(Expecting(rhs_loc pos, nonterm)))
+
 let bigarray_function str name =
-  Ldot(Ldot(Lident "Bigarray", str), name)
+  ghloc (Ldot(Ldot(Lident "Bigarray", str), name))
 
 let bigarray_untuplify = function
-    { pexp_desc = Pexp_tuple explist} -> explist
+    { pexp_desc = Pexp_tuple explist; pexp_loc = _ } -> explist
   | exp -> [exp]
 
 let bigarray_get arr arg =
@@ -202,11 +230,73 @@
   then Lapply(p1, p2)
   else raise (Syntaxerr.Error(Syntaxerr.Applicative_path (symbol_rloc())))
 
-let exp_of_label lbl =
-  mkexp (Pexp_ident(Lident(Longident.last lbl)))
+let exp_of_label lbl pos =
+  mkexp (Pexp_ident(mkrhs (Lident(Longident.last lbl)) pos))
+
+let pat_of_label lbl pos =
+  mkpat (Ppat_var (mkrhs (Longident.last lbl) pos))
 
-let pat_of_label lbl =
-  mkpat (Ppat_var(Longident.last lbl))
+let check_variable vl loc v =
+  if List.mem v vl then
+    raise Syntaxerr.(Error(Variable_in_scope(loc,v)))
+
+let varify_constructors var_names t =
+  let rec loop t =
+    let desc =
+      match t.ptyp_desc with
+      | Ptyp_any -> Ptyp_any
+      | Ptyp_var x ->
+          check_variable var_names t.ptyp_loc x;
+          Ptyp_var x
+      | Ptyp_arrow (label,core_type,core_type') ->
+          Ptyp_arrow(label, loop core_type, loop core_type')
+      | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst)
+      | Ptyp_constr( { txt = Lident s }, []) when List.mem s var_names ->
+          Ptyp_var s
+      | Ptyp_constr(longident, lst) ->
+          Ptyp_constr(longident, List.map loop lst)
+      | Ptyp_object lst ->
+          Ptyp_object (List.map loop_core_field lst)
+      | Ptyp_class (longident, lst, lbl_list) ->
+          Ptyp_class (longident, List.map loop lst, lbl_list)
+      | Ptyp_alias(core_type, string) ->
+          check_variable var_names t.ptyp_loc string;
+          Ptyp_alias(loop core_type, string)
+      | Ptyp_variant(row_field_list, flag, lbl_lst_option) ->
+          Ptyp_variant(List.map loop_row_field row_field_list,
+                       flag, lbl_lst_option)
+      | Ptyp_poly(string_lst, core_type) ->
+          List.iter (check_variable var_names t.ptyp_loc) string_lst;
+          Ptyp_poly(string_lst, loop core_type)
+      | Ptyp_package(longident,lst) ->
+          Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst)
+    in
+    {t with ptyp_desc = desc}
+  and loop_core_field t =
+    let desc =
+      match t.pfield_desc with
+      | Pfield(n,typ) ->
+          Pfield(n,loop typ)
+      | Pfield_var ->
+          Pfield_var
+    in
+    { t with pfield_desc=desc}
+  and loop_row_field  =
+    function
+      | Rtag(label,flag,lst) ->
+          Rtag(label,flag,List.map loop lst)
+      | Rinherit t ->
+          Rinherit (loop t)
+  in
+  loop t
+
+let wrap_type_annotation newtypes core_type body =
+  let exp = mkexp(Pexp_constraint(body,Some core_type,None)) in
+  let exp =
+    List.fold_right (fun newtype exp -> mkexp (Pexp_newtype (newtype, exp)))
+      newtypes exp
+  in
+  (exp, ghtyp(Ptyp_poly(newtypes,varify_constructors newtypes core_type)))
 
 %}
 
@@ -297,7 +387,6 @@
 %token  PREFIXOP
 %token PRIVATE
 %token QUESTION
-%token QUESTIONQUESTION
 %token QUOTE
 %token RBRACE
 %token RBRACKET
@@ -323,6 +412,7 @@
 %token WHEN
 %token WHILE
 %token WITH
+%token  COMMENT
 
 /* Precedences and associativities.
 
@@ -395,7 +485,8 @@
 %type  toplevel_phrase
 %start use_file                         /* for the #use directive */
 %type  use_file
-
+%start any_longident
+%type  any_longident
 %%
 
 /* Entry points */
@@ -408,7 +499,7 @@
 ;
 toplevel_phrase:
     top_structure SEMISEMI               { Ptop_def $1 }
-  | seq_expr SEMISEMI                    { Ptop_def[ghstrexp $1] }
+  | seq_expr SEMISEMI                    { Ptop_def[mkstrexp $1] }
   | toplevel_directive SEMISEMI          { $1 }
   | EOF                                  { raise End_of_file }
 ;
@@ -418,12 +509,12 @@
 ;
 use_file:
     use_file_tail                        { $1 }
-  | seq_expr use_file_tail               { Ptop_def[ghstrexp $1] :: $2 }
+  | seq_expr use_file_tail               { Ptop_def[mkstrexp $1] :: $2 }
 ;
 use_file_tail:
     EOF                                         { [] }
   | SEMISEMI EOF                                { [] }
-  | SEMISEMI seq_expr use_file_tail             { Ptop_def[ghstrexp $2] :: $3 }
+  | SEMISEMI seq_expr use_file_tail             { Ptop_def[mkstrexp $2] :: $3 }
   | SEMISEMI structure_item use_file_tail       { Ptop_def[$2] :: $3 }
   | SEMISEMI toplevel_directive use_file_tail   { $2 :: $3 }
   | structure_item use_file_tail                { Ptop_def[$1] :: $2 }
@@ -434,13 +525,13 @@
 
 module_expr:
     mod_longident
-      { mkmod(Pmod_ident $1) }
+      { mkmod(Pmod_ident (mkrhs $1 1)) }
   | STRUCT structure END
       { mkmod(Pmod_structure($2)) }
   | STRUCT structure error
       { unclosed "struct" 1 "end" 3 }
   | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_expr
-      { mkmod(Pmod_functor($3, $5, $8)) }
+      { mkmod(Pmod_functor(mkrhs $3 3, $5, $8)) }
   | module_expr LPAREN module_expr RPAREN
       { mkmod(Pmod_apply($1, $3)) }
   | module_expr LPAREN module_expr error
@@ -453,43 +544,58 @@
       { $2 }
   | LPAREN module_expr error
       { unclosed "(" 1 ")" 3 }
+  | LPAREN VAL expr RPAREN
+      { mkmod(Pmod_unpack $3) }
   | LPAREN VAL expr COLON package_type RPAREN
-      { mkmod(Pmod_unpack($3, $5)) }
+      { mkmod(Pmod_unpack(
+              ghexp(Pexp_constraint($3, Some(ghtyp(Ptyp_package $5)), None)))) }
+  | LPAREN VAL expr COLON package_type COLONGREATER package_type RPAREN
+      { mkmod(Pmod_unpack(
+              ghexp(Pexp_constraint($3, Some(ghtyp(Ptyp_package $5)),
+                                    Some(ghtyp(Ptyp_package $7)))))) }
+  | LPAREN VAL expr COLONGREATER package_type RPAREN
+      { mkmod(Pmod_unpack(
+              ghexp(Pexp_constraint($3, None, Some(ghtyp(Ptyp_package $5)))))) }
   | LPAREN VAL expr COLON error
       { unclosed "(" 1 ")" 5 }
+  | LPAREN VAL expr COLONGREATER error
+      { unclosed "(" 1 ")" 5 }
+  | LPAREN VAL expr error
+      { unclosed "(" 1 ")" 4 }
 ;
 structure:
     structure_tail                              { $1 }
-  | seq_expr structure_tail                     { ghstrexp $1 :: $2 }
+  | seq_expr structure_tail                     { mkstrexp $1 :: $2 }
 ;
 structure_tail:
     /* empty */                                 { [] }
   | SEMISEMI                                    { [] }
-  | SEMISEMI seq_expr structure_tail            { ghstrexp $2 :: $3 }
+  | SEMISEMI seq_expr structure_tail            { mkstrexp $2 :: $3 }
   | SEMISEMI structure_item structure_tail      { $2 :: $3 }
   | structure_item structure_tail               { $1 :: $2 }
 ;
 structure_item:
     LET rec_flag let_bindings
       { match $3 with
-          [{ppat_desc = Ppat_any}, exp] -> mkstr(Pstr_eval exp)
+          [{ ppat_desc = Ppat_any; ppat_loc = _ }, exp] -> mkstr(Pstr_eval exp)
         | _ -> mkstr(Pstr_value($2, List.rev $3)) }
   | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
-      { mkstr(Pstr_primitive($2, {pval_type = $4; pval_prim = $6})) }
+      { mkstr(Pstr_primitive(mkrhs $2 2, {pval_type = $4; pval_prim = $6;
+          pval_loc = symbol_rloc ()})) }
   | TYPE type_declarations
       { mkstr(Pstr_type(List.rev $2)) }
   | EXCEPTION UIDENT constructor_arguments
-      { mkstr(Pstr_exception($2, $3)) }
+      { mkstr(Pstr_exception(mkrhs $2 2, $3)) }
   | EXCEPTION UIDENT EQUAL constr_longident
-      { mkstr(Pstr_exn_rebind($2, $4)) }
+      { mkstr(Pstr_exn_rebind(mkrhs $2 2, mkloc $4 (rhs_loc 4))) }
   | MODULE UIDENT module_binding
-      { mkstr(Pstr_module($2, $3)) }
+      { mkstr(Pstr_module(mkrhs $2 2, $3)) }
   | MODULE REC module_rec_bindings
       { mkstr(Pstr_recmodule(List.rev $3)) }
   | MODULE TYPE ident EQUAL module_type
-      { mkstr(Pstr_modtype($3, $5)) }
-  | OPEN mod_longident
-      { mkstr(Pstr_open $2) }
+      { mkstr(Pstr_modtype(mkrhs $3 3, $5)) }
+  | OPEN override_flag mod_longident
+      { mkstr(Pstr_open ($2, mkrhs $3 3)) }
   | CLASS class_declarations
       { mkstr(Pstr_class (List.rev $2)) }
   | CLASS TYPE class_type_declarations
@@ -503,28 +609,28 @@
   | COLON module_type EQUAL module_expr
       { mkmod(Pmod_constraint($4, $2)) }
   | LPAREN UIDENT COLON module_type RPAREN module_binding
-      { mkmod(Pmod_functor($2, $4, $6)) }
+      { mkmod(Pmod_functor(mkrhs $2 2, $4, $6)) }
 ;
 module_rec_bindings:
     module_rec_binding                            { [$1] }
   | module_rec_bindings AND module_rec_binding    { $3 :: $1 }
 ;
 module_rec_binding:
-    UIDENT COLON module_type EQUAL module_expr    { ($1, $3, $5) }
+    UIDENT COLON module_type EQUAL module_expr    { (mkrhs $1 1, $3, $5) }
 ;
 
 /* Module types */
 
 module_type:
     mty_longident
-      { mkmty(Pmty_ident $1) }
+      { mkmty(Pmty_ident (mkrhs $1 1)) }
   | SIG signature END
       { mkmty(Pmty_signature(List.rev $2)) }
   | SIG signature error
       { unclosed "sig" 1 "end" 3 }
   | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_type
       %prec below_WITH
-      { mkmty(Pmty_functor($3, $5, $8)) }
+      { mkmty(Pmty_functor(mkrhs $3 3, $5, $8)) }
   | module_type WITH with_constraints
       { mkmty(Pmty_with($1, List.rev $3)) }
   | MODULE TYPE OF module_expr
@@ -541,23 +647,25 @@
 ;
 signature_item:
     VAL val_ident COLON core_type
-      { mksig(Psig_value($2, {pval_type = $4; pval_prim = []})) }
+      { mksig(Psig_value(mkrhs $2 2, {pval_type = $4; pval_prim = [];
+          pval_loc = symbol_rloc()})) }
   | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
-      { mksig(Psig_value($2, {pval_type = $4; pval_prim = $6})) }
+      { mksig(Psig_value(mkrhs $2 2, {pval_type = $4; pval_prim = $6;
+          pval_loc = symbol_rloc()})) }
   | TYPE type_declarations
       { mksig(Psig_type(List.rev $2)) }
   | EXCEPTION UIDENT constructor_arguments
-      { mksig(Psig_exception($2, $3)) }
+      { mksig(Psig_exception(mkrhs $2 2, $3)) }
   | MODULE UIDENT module_declaration
-      { mksig(Psig_module($2, $3)) }
+      { mksig(Psig_module(mkrhs $2 2, $3)) }
   | MODULE REC module_rec_declarations
       { mksig(Psig_recmodule(List.rev $3)) }
   | MODULE TYPE ident
-      { mksig(Psig_modtype($3, Pmodtype_abstract)) }
+      { mksig(Psig_modtype(mkrhs $3 3, Pmodtype_abstract)) }
   | MODULE TYPE ident EQUAL module_type
-      { mksig(Psig_modtype($3, Pmodtype_manifest $5)) }
-  | OPEN mod_longident
-      { mksig(Psig_open $2) }
+      { mksig(Psig_modtype(mkrhs $3 3, Pmodtype_manifest $5)) }
+  | OPEN override_flag mod_longident
+      { mksig(Psig_open ($2, mkrhs $3 3)) }
   | INCLUDE module_type
       { mksig(Psig_include $2) }
   | CLASS class_descriptions
@@ -570,14 +678,14 @@
     COLON module_type
       { $2 }
   | LPAREN UIDENT COLON module_type RPAREN module_declaration
-      { mkmty(Pmty_functor($2, $4, $6)) }
+      { mkmty(Pmty_functor(mkrhs $2 2, $4, $6)) }
 ;
 module_rec_declarations:
     module_rec_declaration                              { [$1] }
   | module_rec_declarations AND module_rec_declaration  { $3 :: $1 }
 ;
 module_rec_declaration:
-    UIDENT COLON module_type                            { ($1, $3) }
+    UIDENT COLON module_type                            { (mkrhs $1 1, $3) }
 ;
 
 /* Class expressions */
@@ -590,7 +698,7 @@
     virtual_flag class_type_parameters LIDENT class_fun_binding
       { let params, variance = List.split (fst $2) in
         {pci_virt = $1; pci_params = params, snd $2;
-         pci_name = $3; pci_expr = $4; pci_variance = variance;
+         pci_name = mkrhs $3 3; pci_expr = $4; pci_variance = variance;
          pci_loc = symbol_rloc ()} }
 ;
 class_fun_binding:
@@ -623,9 +731,9 @@
 ;
 class_simple_expr:
     LBRACKET core_type_comma_list RBRACKET class_longident
-      { mkclass(Pcl_constr($4, List.rev $2)) }
+      { mkclass(Pcl_constr(mkloc $4 (rhs_loc 4), List.rev $2)) }
   | class_longident
-      { mkclass(Pcl_constr($1, [])) }
+      { mkclass(Pcl_constr(mkrhs $1 1, [])) }
   | OBJECT class_structure END
       { mkclass(Pcl_structure($2)) }
   | OBJECT class_structure error
@@ -641,7 +749,7 @@
 ;
 class_structure:
     class_self_pattern class_fields
-      { $1, List.rev $2 }
+      { { pcstr_pat = $1; pcstr_fields = List.rev $2 } }
 ;
 class_self_pattern:
     LPAREN pattern RPAREN
@@ -654,20 +762,24 @@
 class_fields:
     /* empty */
       { [] }
-  | class_fields INHERIT override_flag class_expr parent_binder
-      { Pcf_inher ($3, $4, $5) :: $1 }
-  | class_fields VAL virtual_value
-      { Pcf_valvirt $3 :: $1 }
-  | class_fields VAL value
-      { Pcf_val $3 :: $1 }
-  | class_fields virtual_method
-      { Pcf_virt $2 :: $1 }
-  | class_fields concrete_method
-      { Pcf_meth $2 :: $1 }
-  | class_fields CONSTRAINT constrain
-      { Pcf_cstr $3 :: $1 }
-  | class_fields INITIALIZER seq_expr
-      { Pcf_init $3 :: $1 }
+  | class_fields class_field
+      { $2 :: $1 }
+;
+class_field:
+  | INHERIT override_flag class_expr parent_binder
+      { mkcf (Pcf_inher ($2, $3, $4)) }
+  | VAL virtual_value
+      { mkcf (Pcf_valvirt $2) }
+  | VAL value
+      { mkcf (Pcf_val $2) }
+  | virtual_method
+      { mkcf (Pcf_virt $1) }
+  | concrete_method
+      { mkcf (Pcf_meth $1) }
+  | CONSTRAINT constrain_field
+      { mkcf (Pcf_constr $2) }
+  | INITIALIZER seq_expr
+      { mkcf (Pcf_init $2) }
 ;
 parent_binder:
     AS LIDENT
@@ -678,30 +790,34 @@
 virtual_value:
     override_flag MUTABLE VIRTUAL label COLON core_type
       { if $1 = Override then syntax_error ();
-        $4, Mutable, $6, symbol_rloc () }
+        mkloc $4 (rhs_loc 4), Mutable, $6 }
   | VIRTUAL mutable_flag label COLON core_type
-      { $3, $2, $5, symbol_rloc () }
+      { mkrhs $3 3, $2, $5 }
 ;
 value:
     override_flag mutable_flag label EQUAL seq_expr
-      { $3, $2, $1, $5, symbol_rloc () }
+      { mkrhs $3 3, $2, $1, $5 }
   | override_flag mutable_flag label type_constraint EQUAL seq_expr
-      { $3, $2, $1, (let (t, t') = $4 in ghexp(Pexp_constraint($6, t, t'))),
-        symbol_rloc () }
+      { let (t, t') = $4 in
+        mkrhs $3 3, $2, $1, ghexp(Pexp_constraint($6, t, t')) }
 ;
 virtual_method:
     METHOD override_flag PRIVATE VIRTUAL label COLON poly_type
       { if $2 = Override then syntax_error ();
-        $5, Private, $7, symbol_rloc () }
+        mkloc $5 (rhs_loc 5), Private, $7 }
   | METHOD override_flag VIRTUAL private_flag label COLON poly_type
       { if $2 = Override then syntax_error ();
-        $5, $4, $7, symbol_rloc () }
+        mkloc $5 (rhs_loc 5), $4, $7 }
 ;
 concrete_method :
     METHOD override_flag private_flag label strict_binding
-      { $4, $3, $2, ghexp(Pexp_poly ($5, None)), symbol_rloc () }
+      { mkloc $4 (rhs_loc 4), $3, $2, ghexp(Pexp_poly ($5, None)) }
   | METHOD override_flag private_flag label COLON poly_type EQUAL seq_expr
-      { $4, $3, $2, ghexp(Pexp_poly($8,Some $6)), symbol_rloc () }
+      { mkloc $4 (rhs_loc 4), $3, $2, ghexp(Pexp_poly($8,Some $6)) }
+  | METHOD override_flag private_flag label COLON TYPE lident_list
+    DOT core_type EQUAL seq_expr
+      { let exp, poly = wrap_type_annotation $7 $9 $11 in
+        mkloc $4 (rhs_loc 4), $3, $2, ghexp(Pexp_poly(exp, Some poly)) }
 ;
 
 /* Class types */
@@ -710,17 +826,9 @@
     class_signature
       { $1 }
   | QUESTION LIDENT COLON simple_core_type_or_tuple MINUSGREATER class_type
-      { mkcty(Pcty_fun("?" ^ $2 ,
-                       {ptyp_desc =
-                        Ptyp_constr(Ldot (Lident "*predef*", "option"), [$4]);
-                        ptyp_loc = $4.ptyp_loc},
-                       $6)) }
+      { mkcty(Pcty_fun("?" ^ $2 , mkoption $4, $6)) }
   | OPTLABEL simple_core_type_or_tuple MINUSGREATER class_type
-      { mkcty(Pcty_fun("?" ^ $1 ,
-                       {ptyp_desc =
-                        Ptyp_constr(Ldot (Lident "*predef*", "option"), [$2]);
-                        ptyp_loc = $2.ptyp_loc},
-                       $4)) }
+      { mkcty(Pcty_fun("?" ^ $1, mkoption $2, $4)) }
   | LIDENT COLON simple_core_type_or_tuple MINUSGREATER class_type
       { mkcty(Pcty_fun($1, $3, $5)) }
   | simple_core_type_or_tuple MINUSGREATER class_type
@@ -728,9 +836,9 @@
 ;
 class_signature:
     LBRACKET core_type_comma_list RBRACKET clty_longident
-      { mkcty(Pcty_constr ($4, List.rev $2)) }
+      { mkcty(Pcty_constr (mkloc $4 (rhs_loc 4), List.rev $2)) }
   | clty_longident
-      { mkcty(Pcty_constr ($1, [])) }
+      { mkcty(Pcty_constr (mkrhs $1 1, [])) }
   | OBJECT class_sig_body END
       { mkcty(Pcty_signature $2) }
   | OBJECT class_sig_body error
@@ -738,7 +846,8 @@
 ;
 class_sig_body:
     class_self_type class_sig_fields
-      { $1, List.rev $2 }
+    { { pcsig_self = $1; pcsig_fields = List.rev $2;
+      pcsig_loc = symbol_rloc(); } }
 ;
 class_self_type:
     LPAREN core_type RPAREN
@@ -748,32 +857,38 @@
 ;
 class_sig_fields:
     /* empty */                                 { [] }
-  | class_sig_fields INHERIT class_signature    { Pctf_inher $3 :: $1 }
-  | class_sig_fields VAL value_type             { Pctf_val   $3 :: $1 }
-  | class_sig_fields virtual_method_type        { Pctf_virt  $2 :: $1 }
-  | class_sig_fields method_type                { Pctf_meth  $2 :: $1 }
-  | class_sig_fields CONSTRAINT constrain       { Pctf_cstr  $3 :: $1 }
+| class_sig_fields class_sig_field     { $2 :: $1 }
+;
+class_sig_field:
+    INHERIT class_signature       { mkctf (Pctf_inher $2) }
+  | VAL value_type              { mkctf (Pctf_val $2) }
+  | virtual_method_type         { mkctf (Pctf_virt $1) }
+  | method_type                 { mkctf (Pctf_meth $1) }
+  | CONSTRAINT constrain_field        { mkctf (Pctf_cstr $2) }
 ;
 value_type:
     VIRTUAL mutable_flag label COLON core_type
-      { $3, $2, Virtual, $5, symbol_rloc () }
+      { $3, $2, Virtual, $5 }
   | MUTABLE virtual_flag label COLON core_type
-      { $3, Mutable, $2, $5, symbol_rloc () }
+      { $3, Mutable, $2, $5 }
   | label COLON core_type
-      { $1, Immutable, Concrete, $3, symbol_rloc () }
+      { $1, Immutable, Concrete, $3 }
 ;
 method_type:
     METHOD private_flag label COLON poly_type
-      { $3, $2, $5, symbol_rloc () }
+      { $3, $2, $5 }
 ;
 virtual_method_type:
     METHOD PRIVATE VIRTUAL label COLON poly_type
-      { $4, Private, $6, symbol_rloc () }
+      { $4, Private, $6 }
   | METHOD VIRTUAL private_flag label COLON poly_type
-      { $4, $3, $6, symbol_rloc () }
+      { $4, $3, $6 }
 ;
 constrain:
-        core_type EQUAL core_type          { $1, $3, symbol_rloc () }
+        core_type EQUAL core_type          { $1, $3, symbol_rloc() }
+;
+constrain_field:
+        core_type EQUAL core_type          { $1, $3 }
 ;
 class_descriptions:
     class_descriptions AND class_description    { $3 :: $1 }
@@ -783,7 +898,7 @@
     virtual_flag class_type_parameters LIDENT COLON class_type
       { let params, variance = List.split (fst $2) in
         {pci_virt = $1; pci_params = params, snd $2;
-         pci_name = $3; pci_expr = $5; pci_variance = variance;
+         pci_name = mkrhs $3 3; pci_expr = $5; pci_variance = variance;
          pci_loc = symbol_rloc ()} }
 ;
 class_type_declarations:
@@ -794,7 +909,7 @@
     virtual_flag class_type_parameters LIDENT EQUAL class_signature
       { let params, variance = List.split (fst $2) in
         {pci_virt = $1; pci_params = params, snd $2;
-         pci_name = $3; pci_expr = $5; pci_variance = variance;
+         pci_name = mkrhs $3 3; pci_expr = $5; pci_variance = variance;
          pci_loc = symbol_rloc ()} }
 ;
 
@@ -824,7 +939,7 @@
       { ("", None, $1) }
 ;
 pattern_var:
-    LIDENT            { mkpat(Ppat_var $1) }
+    LIDENT            { mkpat(Ppat_var (mkrhs $1 1)) }
   | UNDERSCORE        { mkpat Ppat_any }
 ;
 opt_default:
@@ -838,7 +953,7 @@
       { let (lab, pat) = $1 in (lab, mkpat(Ppat_constraint(pat, $3))) }
 ;
 label_var:
-    LIDENT    { ($1, mkpat(Ppat_var $1)) }
+    LIDENT    { ($1, mkpat(Ppat_var (mkrhs $1 1))) }
 ;
 let_pattern:
     pattern
@@ -854,9 +969,9 @@
   | LET rec_flag let_bindings IN seq_expr
       { mkexp(Pexp_let($2, List.rev $3, $5)) }
   | LET MODULE UIDENT module_binding IN seq_expr
-      { mkexp(Pexp_letmodule($3, $4, $6)) }
-  | LET OPEN mod_longident IN seq_expr
-      { mkexp(Pexp_open($3, $5)) }
+      { mkexp(Pexp_letmodule(mkrhs $3 3, $4, $6)) }
+  | LET OPEN override_flag mod_longident IN seq_expr
+      { mkexp(Pexp_open($3, mkrhs $4 4, $6)) }
   | FUNCTION opt_bar match_cases
       { mkexp(Pexp_function("", None, List.rev $3)) }
   | FUN labeled_simple_pattern fun_def
@@ -872,7 +987,7 @@
   | expr_comma_list %prec below_COMMA
       { mkexp(Pexp_tuple(List.rev $1)) }
   | constr_longident simple_expr %prec below_SHARP
-      { mkexp(Pexp_construct($1, Some $2, false)) }
+      { mkexp(Pexp_construct(mkrhs $1 1, Some $2, false)) }
   | name_tag simple_expr %prec below_SHARP
       { mkexp(Pexp_variant($1, Some $2)) }
   | IF seq_expr THEN expr ELSE expr
@@ -882,15 +997,11 @@
   | WHILE seq_expr DO seq_expr DONE
       { mkexp(Pexp_while($2, $4)) }
   | FOR val_ident EQUAL seq_expr direction_flag seq_expr DO seq_expr DONE
-      { mkexp(Pexp_for($2, $4, $6, $5, $8)) }
+      { mkexp(Pexp_for(mkrhs $2 2, $4, $6, $5, $8)) }
   | expr COLONCOLON expr
-      { mkexp(Pexp_construct(Lident "::",
-                             Some(ghexp(Pexp_tuple[$1;$3])),
-                             false)) }
+      { mkexp_cons (rhs_loc 2) (ghexp(Pexp_tuple[$1;$3])) (symbol_rloc()) }
   | LPAREN COLONCOLON RPAREN LPAREN expr COMMA expr RPAREN
-      { mkexp(Pexp_construct(Lident "::",
-                             Some(ghexp(Pexp_tuple[$5;$7])),
-                             false)) }
+      { mkexp_cons (rhs_loc 2) (ghexp(Pexp_tuple[$5;$7])) (symbol_rloc()) }
   | expr INFIXOP0 expr
       { mkinfix $1 $2 $3 }
   | expr INFIXOP1 expr
@@ -932,7 +1043,7 @@
   | additive expr %prec prec_unary_plus
       { mkuplus $1 $2 }
   | simple_expr DOT label_longident LESSMINUS expr
-      { mkexp(Pexp_setfield($1, $3, $5)) }
+      { mkexp(Pexp_setfield($1, mkrhs $3 3, $5)) }
   | simple_expr DOT LPAREN seq_expr RPAREN LESSMINUS expr
       { mkexp(Pexp_apply(ghexp(Pexp_ident(array_function "Array" "set")),
                          ["",$1; "",$4; "",$7])) }
@@ -942,7 +1053,7 @@
   | simple_expr DOT LBRACE expr RBRACE LESSMINUS expr
       { bigarray_set $1 $4 $7 }
   | label LESSMINUS expr
-      { mkexp(Pexp_setinstvar($1, $3)) }
+      { mkexp(Pexp_setinstvar(mkrhs $1 1, $3)) }
   | ASSERT simple_expr %prec below_SHARP
       { mkassert $2 }
   | LAZY simple_expr %prec below_SHARP
@@ -954,11 +1065,11 @@
 ;
 simple_expr:
     val_longident
-      { mkexp(Pexp_ident $1) }
+      { mkexp(Pexp_ident (mkrhs $1 1)) }
   | constant
       { mkexp(Pexp_constant $1) }
   | constr_longident %prec prec_constant_constructor
-      { mkexp(Pexp_construct($1, None, false)) }
+      { mkexp(Pexp_construct(mkrhs $1 1, None, false)) }
   | name_tag %prec prec_constant_constructor
       { mkexp(Pexp_variant($1, None)) }
   | LPAREN seq_expr RPAREN
@@ -968,15 +1079,16 @@
   | BEGIN seq_expr END
       { reloc_exp $2 }
   | BEGIN END
-      { mkexp (Pexp_construct (Lident "()", None, false)) }
+      { mkexp (Pexp_construct (mkloc (Lident "()") (symbol_rloc ()),
+                               None, false)) }
   | BEGIN seq_expr error
       { unclosed "begin" 1 "end" 3 }
   | LPAREN seq_expr type_constraint RPAREN
       { let (t, t') = $3 in mkexp(Pexp_constraint($2, t, t')) }
   | simple_expr DOT label_longident
-      { mkexp(Pexp_field($1, $3)) }
+      { mkexp(Pexp_field($1, mkrhs $3 3)) }
   | mod_longident DOT LPAREN seq_expr RPAREN
-      { mkexp(Pexp_open($1, $4)) }
+      { mkexp(Pexp_open(Fresh, mkrhs $1 1, $4)) }
   | mod_longident DOT LPAREN seq_expr error
       { unclosed "(" 3 ")" 5 }
   | simple_expr DOT LPAREN seq_expr RPAREN
@@ -1004,7 +1116,7 @@
   | LBRACKETBAR BARRBRACKET
       { mkexp(Pexp_array []) }
   | LBRACKET expr_semi_list opt_semi RBRACKET
-      { reloc_exp (mktailexp (List.rev $2)) }
+      { reloc_exp (mktailexp (rhs_loc 4) (List.rev $2)) }
   | LBRACKET expr_semi_list opt_semi error
       { unclosed "[" 1 "]" 4 }
   | PREFIXOP simple_expr
@@ -1012,7 +1124,7 @@
   | BANG simple_expr
       { mkexp(Pexp_apply(mkoperator "!" 1, ["",$2])) }
   | NEW class_longident
-      { mkexp(Pexp_new($2)) }
+      { mkexp(Pexp_new(mkrhs $2 2)) }
   | LBRACELESS field_expr_list opt_semi GREATERRBRACE
       { mkexp(Pexp_override(List.rev $2)) }
   | LBRACELESS field_expr_list opt_semi error
@@ -1021,8 +1133,11 @@
       { mkexp(Pexp_override []) }
   | simple_expr SHARP label
       { mkexp(Pexp_send($1, $3)) }
+  | LPAREN MODULE module_expr RPAREN
+      { mkexp (Pexp_pack $3) }
   | LPAREN MODULE module_expr COLON package_type RPAREN
-      { mkexp (Pexp_pack ($3, $5)) }
+      { mkexp (Pexp_constraint (ghexp (Pexp_pack $3),
+                                Some (ghtyp (Ptyp_package $5)), None)) }
   | LPAREN MODULE module_expr COLON error
       { unclosed "(" 1 ")" 5 }
 ;
@@ -1049,19 +1164,27 @@
       { ("?" ^ $1, $2) }
 ;
 label_ident:
-    LIDENT   { ($1, mkexp(Pexp_ident(Lident $1))) }
+    LIDENT   { ($1, mkexp(Pexp_ident(mkrhs (Lident $1) 1))) }
 ;
 let_bindings:
     let_binding                                 { [$1] }
   | let_bindings AND let_binding                { $3 :: $1 }
 ;
+
+lident_list:
+    LIDENT                            { [$1] }
+  | LIDENT lident_list                { $1 :: $2 }
+;
 let_binding:
     val_ident fun_binding
-      { ({ppat_desc = Ppat_var $1; ppat_loc = rhs_loc 1}, $2) }
+      { (mkpatvar $1 1, $2) }
   | val_ident COLON typevar_list DOT core_type EQUAL seq_expr
-      { (ghpat(Ppat_constraint({ppat_desc = Ppat_var $1; ppat_loc = rhs_loc 1},
-                               ghtyp(Ptyp_poly($3,$5)))),
+      { (ghpat(Ppat_constraint(mkpatvar $1 1,
+                               ghtyp(Ptyp_poly(List.rev $3,$5)))),
          $7) }
+  | val_ident COLON TYPE lident_list DOT core_type EQUAL seq_expr
+      { let exp, poly = wrap_type_annotation $4 $6 $8 in
+        (ghpat(Ppat_constraint(mkpatvar $1 1, poly)), exp) }
   | pattern EQUAL seq_expr
       { ($1, $3) }
 ;
@@ -1092,31 +1215,32 @@
 ;
 match_action:
     MINUSGREATER seq_expr                       { $2 }
-  | WHEN seq_expr MINUSGREATER seq_expr         { mkexp(Pexp_when($2, $4)) }
+  | WHEN seq_expr MINUSGREATER seq_expr         { ghexp(Pexp_when($2, $4)) }
 ;
 expr_comma_list:
     expr_comma_list COMMA expr                  { $3 :: $1 }
   | expr COMMA expr                             { [$3; $1] }
 ;
 record_expr:
-    simple_expr WITH lbl_expr_list opt_semi     { (Some $1, List.rev $3) }
-  | lbl_expr_list opt_semi                      { (None, List.rev $1) }
+    simple_expr WITH lbl_expr_list              { (Some $1, $3) }
+  | lbl_expr_list                               { (None, $1) }
 ;
 lbl_expr_list:
+     lbl_expr { [$1] }
+  |  lbl_expr SEMI lbl_expr_list { $1 :: $3 }
+  |  lbl_expr SEMI { [$1] }
+;
+lbl_expr:
     label_longident EQUAL expr
-      { [$1,$3] }
+      { (mkrhs $1 1,$3) }
   | label_longident
-      { [$1, exp_of_label $1] }
-  | lbl_expr_list SEMI label_longident EQUAL expr
-      { ($3, $5) :: $1 }
-  | lbl_expr_list SEMI label_longident
-      { ($3, exp_of_label $3) :: $1 }
+      { (mkrhs $1 1, exp_of_label $1 1) }
 ;
 field_expr_list:
     label EQUAL expr
-      { [$1,$3] }
+      { [mkrhs $1 1,$3] }
   | field_expr_list SEMI label EQUAL expr
-      { ($3, $5) :: $1 }
+      { (mkrhs $3 3, $5) :: $1 }
 ;
 expr_semi_list:
     expr                                        { [$1] }
@@ -1136,27 +1260,33 @@
     simple_pattern
       { $1 }
   | pattern AS val_ident
-      { mkpat(Ppat_alias($1, $3)) }
+      { mkpat(Ppat_alias($1, mkrhs $3 3)) }
+  | pattern AS error
+      { expecting 3 "identifier" }
   | pattern_comma_list  %prec below_COMMA
       { mkpat(Ppat_tuple(List.rev $1)) }
   | constr_longident pattern %prec prec_constr_appl
-      { mkpat(Ppat_construct($1, Some $2, false)) }
+      { mkpat(Ppat_construct(mkrhs $1 1, Some $2, false)) }
   | name_tag pattern %prec prec_constr_appl
       { mkpat(Ppat_variant($1, Some $2)) }
   | pattern COLONCOLON pattern
-      { mkpat(Ppat_construct(Lident "::", Some(ghpat(Ppat_tuple[$1;$3])),
-                             false)) }
+      { mkpat_cons (rhs_loc 2) (ghpat(Ppat_tuple[$1;$3])) (symbol_rloc()) }
+  | pattern COLONCOLON error
+      { expecting 3 "pattern" }
   | LPAREN COLONCOLON RPAREN LPAREN pattern COMMA pattern RPAREN
-      { mkpat(Ppat_construct(Lident "::", Some(ghpat(Ppat_tuple[$5;$7])),
-                             false)) }
+      { mkpat_cons (rhs_loc 2) (ghpat(Ppat_tuple[$5;$7])) (symbol_rloc()) }
+  | LPAREN COLONCOLON RPAREN LPAREN pattern COMMA pattern error
+      { unclosed "(" 4 ")" 8 }
   | pattern BAR pattern
       { mkpat(Ppat_or($1, $3)) }
+  | pattern BAR error
+      { expecting 3 "pattern" }
   | LAZY simple_pattern
       { mkpat(Ppat_lazy $2) }
 ;
 simple_pattern:
     val_ident %prec below_EQUAL
-      { mkpat(Ppat_var $1) }
+      { mkpat(Ppat_var (mkrhs $1 1)) }
   | UNDERSCORE
       { mkpat(Ppat_any) }
   | signed_constant
@@ -1164,17 +1294,17 @@
   | CHAR DOTDOT CHAR
       { mkrangepat $1 $3 }
   | constr_longident
-      { mkpat(Ppat_construct($1, None, false)) }
+      { mkpat(Ppat_construct(mkrhs $1 1, None, false)) }
   | name_tag
       { mkpat(Ppat_variant($1, None)) }
   | SHARP type_longident
-      { mkpat(Ppat_type $2) }
-  | LBRACE lbl_pattern_list record_pattern_end RBRACE
-      { mkpat(Ppat_record(List.rev $2, $3)) }
-  | LBRACE lbl_pattern_list opt_semi error
-      { unclosed "{" 1 "}" 4 }
+      { mkpat(Ppat_type (mkrhs $2 2)) }
+  | LBRACE lbl_pattern_list RBRACE
+      { let (fields, closed) = $2 in mkpat(Ppat_record(fields, closed)) }
+  | LBRACE lbl_pattern_list error
+      { unclosed "{" 1 "}" 3 }
   | LBRACKET pattern_semi_list opt_semi RBRACKET
-      { reloc_pat (mktailpat (List.rev $2)) }
+      { reloc_pat (mktailpat (rhs_loc 4) (List.rev $2)) }
   | LBRACKET pattern_semi_list opt_semi error
       { unclosed "[" 1 "]" 4 }
   | LBRACKETBAR pattern_semi_list opt_semi BARRBRACKET
@@ -1191,25 +1321,38 @@
       { mkpat(Ppat_constraint($2, $4)) }
   | LPAREN pattern COLON core_type error
       { unclosed "(" 1 ")" 5 }
+  | LPAREN pattern COLON error
+      { expecting 4 "type" }
+  | LPAREN MODULE UIDENT RPAREN
+      { mkpat(Ppat_unpack (mkrhs $3 3)) }
+  | LPAREN MODULE UIDENT COLON package_type RPAREN
+      { mkpat(Ppat_constraint(mkpat(Ppat_unpack (mkrhs $3 3)),
+                              ghtyp(Ptyp_package $5))) }
+  | LPAREN MODULE UIDENT COLON package_type error
+      { unclosed "(" 1 ")" 6 }
 ;
 
 pattern_comma_list:
     pattern_comma_list COMMA pattern            { $3 :: $1 }
   | pattern COMMA pattern                       { [$3; $1] }
+  | pattern COMMA error                         { expecting 3 "pattern" }
 ;
 pattern_semi_list:
     pattern                                     { [$1] }
   | pattern_semi_list SEMI pattern              { $3 :: $1 }
 ;
 lbl_pattern_list:
-    label_longident EQUAL pattern               { [($1, $3)] }
-  | label_longident                             { [($1, pat_of_label $1)] }
-  | lbl_pattern_list SEMI label_longident EQUAL pattern { ($3, $5) :: $1 }
-  | lbl_pattern_list SEMI label_longident       { ($3, pat_of_label $3) :: $1 }
-;
-record_pattern_end:
-    opt_semi                                    { Closed }
-  | SEMI UNDERSCORE opt_semi                    { Open }
+    lbl_pattern { [$1], Closed }
+  | lbl_pattern SEMI { [$1], Closed }
+  | lbl_pattern SEMI UNDERSCORE opt_semi { [$1], Open }
+  | lbl_pattern SEMI lbl_pattern_list
+      { let (fields, closed) = $3 in $1 :: fields, closed }
+;
+lbl_pattern:
+    label_longident EQUAL pattern
+      { (mkrhs $1 1,$3) }
+  | label_longident
+      { (mkrhs $1 1, pat_of_label $1 1) }
 ;
 
 /* Primitive declarations */
@@ -1227,16 +1370,16 @@
 ;
 
 type_declaration:
-    type_parameters LIDENT type_kind constraints
+    optional_type_parameters LIDENT type_kind constraints
       { let (params, variance) = List.split $1 in
         let (kind, private_flag, manifest) = $3 in
-        ($2, {ptype_params = params;
+        (mkrhs $2 2, {ptype_params = params;
               ptype_cstrs = List.rev $4;
               ptype_kind = kind;
               ptype_private = private_flag;
               ptype_manifest = manifest;
               ptype_variance = variance;
-              ptype_loc = symbol_rloc()}) }
+              ptype_loc = symbol_rloc() }) }
 ;
 constraints:
         constraints CONSTRAINT constrain        { $3 :: $1 }
@@ -1262,13 +1405,29 @@
   | EQUAL core_type EQUAL private_flag LBRACE label_declarations opt_semi RBRACE
       { (Ptype_record(List.rev $6), $4, Some $2) }
 ;
+optional_type_parameters:
+    /*empty*/                                   { [] }
+  | optional_type_parameter                              { [$1] }
+  | LPAREN optional_type_parameter_list RPAREN  { List.rev $2 }
+;
+optional_type_parameter:
+    type_variance QUOTE ident                   { Some (mkrhs $3 3), $1 }
+  | type_variance UNDERSCORE                    { None, $1 }
+;
+optional_type_parameter_list:
+    optional_type_parameter                              { [$1] }
+  | optional_type_parameter_list COMMA optional_type_parameter    { $3 :: $1 }
+;
+
+
+
 type_parameters:
     /*empty*/                                   { [] }
   | type_parameter                              { [$1] }
   | LPAREN type_parameter_list RPAREN           { List.rev $2 }
 ;
 type_parameter:
-    type_variance QUOTE ident                   { $3, $1 }
+    type_variance QUOTE ident                   { mkrhs $3 3, $1 }
 ;
 type_variance:
     /* empty */                                 { false, false }
@@ -1284,18 +1443,34 @@
   | constructor_declarations BAR constructor_declaration { $3 :: $1 }
 ;
 constructor_declaration:
-    constr_ident constructor_arguments          { ($1, $2, symbol_rloc()) }
+
+  | constr_ident generalized_constructor_arguments
+      { let arg_types,ret_type = $2 in
+        (mkrhs $1 1, arg_types,ret_type, symbol_rloc()) }
 ;
+
 constructor_arguments:
     /*empty*/                                   { [] }
   | OF core_type_list                           { List.rev $2 }
 ;
+
+generalized_constructor_arguments:
+    /*empty*/                                   { ([],None) }
+  | OF core_type_list                           { (List.rev $2,None) }
+  | COLON core_type_list MINUSGREATER simple_core_type
+                                                { (List.rev $2,Some $4) }
+  | COLON simple_core_type                      { ([],Some $2) }
+;
+
+
+
 label_declarations:
     label_declaration                           { [$1] }
   | label_declarations SEMI label_declaration   { $3 :: $1 }
 ;
 label_declaration:
-    mutable_flag label COLON poly_type          { ($2, $1, $4, symbol_rloc()) }
+    mutable_flag label COLON poly_type
+      { (mkrhs $2 2, $1, $4, symbol_rloc()) }
 ;
 
 /* "with" constraints (additional type equations over signature components) */
@@ -1307,28 +1482,30 @@
 with_constraint:
     TYPE type_parameters label_longident with_type_binder core_type constraints
       { let params, variance = List.split $2 in
-        ($3, Pwith_type {ptype_params = params;
-                         ptype_cstrs = List.rev $6;
-                         ptype_kind = Ptype_abstract;
-                         ptype_manifest = Some $5;
-                         ptype_private = $4;
-                         ptype_variance = variance;
-                         ptype_loc = symbol_rloc()}) }
+        (mkrhs $3 3,
+         Pwith_type {ptype_params = List.map (fun x -> Some x) params;
+                     ptype_cstrs = List.rev $6;
+                     ptype_kind = Ptype_abstract;
+                     ptype_manifest = Some $5;
+                     ptype_private = $4;
+                     ptype_variance = variance;
+                     ptype_loc = symbol_rloc()}) }
     /* used label_longident instead of type_longident to disallow
        functor applications in type path */
-  | TYPE type_parameters label_longident COLONEQUAL core_type
+  | TYPE type_parameters label COLONEQUAL core_type
       { let params, variance = List.split $2 in
-        ($3, Pwith_typesubst {ptype_params = params;
-                              ptype_cstrs = [];
-                              ptype_kind = Ptype_abstract;
-                              ptype_manifest = Some $5;
-                              ptype_private = Public;
-                              ptype_variance = variance;
-                              ptype_loc = symbol_rloc()}) }
+        (mkrhs (Lident $3) 3,
+         Pwith_typesubst { ptype_params = List.map (fun x -> Some x) params;
+                           ptype_cstrs = [];
+                           ptype_kind = Ptype_abstract;
+                           ptype_manifest = Some $5;
+                           ptype_private = Public;
+                           ptype_variance = variance;
+                           ptype_loc = symbol_rloc()}) }
   | MODULE mod_longident EQUAL mod_ext_longident
-      { ($2, Pwith_module $4) }
-  | MODULE mod_longident COLONEQUAL mod_ext_longident
-      { ($2, Pwith_modsubst $4) }
+      { (mkrhs $2 2, Pwith_module (mkrhs $4 4)) }
+  | MODULE UIDENT COLONEQUAL mod_ext_longident
+      { (mkrhs (Lident $2) 2, Pwith_modsubst (mkrhs $4 4)) }
 ;
 with_type_binder:
     EQUAL          { Public }
@@ -1360,13 +1537,9 @@
     simple_core_type_or_tuple
       { $1 }
   | QUESTION LIDENT COLON core_type2 MINUSGREATER core_type2
-      { mktyp(Ptyp_arrow("?" ^ $2 ,
-               {ptyp_desc = Ptyp_constr(Ldot (Lident "*predef*", "option"), [$4]);
-                ptyp_loc = $4.ptyp_loc}, $6)) }
+      { mktyp(Ptyp_arrow("?" ^ $2 , mkoption $4, $6)) }
   | OPTLABEL core_type2 MINUSGREATER core_type2
-      { mktyp(Ptyp_arrow("?" ^ $1 ,
-               {ptyp_desc = Ptyp_constr(Ldot (Lident "*predef*", "option"), [$2]);
-                ptyp_loc = $2.ptyp_loc}, $4)) }
+      { mktyp(Ptyp_arrow("?" ^ $1 , mkoption $2, $4)) }
   | LIDENT COLON core_type2 MINUSGREATER core_type2
       { mktyp(Ptyp_arrow($1, $3, $5)) }
   | core_type2 MINUSGREATER core_type2
@@ -1385,25 +1558,25 @@
   | UNDERSCORE
       { mktyp(Ptyp_any) }
   | type_longident
-      { mktyp(Ptyp_constr($1, [])) }
+      { mktyp(Ptyp_constr(mkrhs $1 1, [])) }
   | simple_core_type2 type_longident
-      { mktyp(Ptyp_constr($2, [$1])) }
+      { mktyp(Ptyp_constr(mkrhs $2 2, [$1])) }
   | LPAREN core_type_comma_list RPAREN type_longident
-      { mktyp(Ptyp_constr($4, List.rev $2)) }
+      { mktyp(Ptyp_constr(mkrhs $4 4, List.rev $2)) }
   | LESS meth_list GREATER
       { mktyp(Ptyp_object $2) }
   | LESS GREATER
       { mktyp(Ptyp_object []) }
   | SHARP class_longident opt_present
-      { mktyp(Ptyp_class($2, [], $3)) }
+      { mktyp(Ptyp_class(mkrhs $2 2, [], $3)) }
   | simple_core_type2 SHARP class_longident opt_present
-      { mktyp(Ptyp_class($3, [$1], $4)) }
+      { mktyp(Ptyp_class(mkrhs $3 3, [$1], $4)) }
   | LPAREN core_type_comma_list RPAREN SHARP class_longident opt_present
-      { mktyp(Ptyp_class($5, List.rev $2, $6)) }
+      { mktyp(Ptyp_class(mkrhs $5 5, List.rev $2, $6)) }
   | LBRACKET tag_field RBRACKET
       { mktyp(Ptyp_variant([$2], true, None)) }
 /* PR#3835: this is not LR(1), would need lookahead=2
-  | LBRACKET simple_core_type2 RBRACKET
+  | LBRACKET simple_core_type RBRACKET
       { mktyp(Ptyp_variant([$2], true, None)) }
 */
   | LBRACKET BAR row_field_list RBRACKET
@@ -1422,11 +1595,11 @@
       { mktyp(Ptyp_package $3) }
 ;
 package_type:
-    mty_longident { ($1, []) }
-  | mty_longident WITH package_type_cstrs { ($1, $3) }
+    mty_longident { (mkrhs $1 1, []) }
+  | mty_longident WITH package_type_cstrs { (mkrhs $1 1, $3) }
 ;
 package_type_cstr:
-    TYPE LIDENT EQUAL core_type { ($2, $4) }
+    TYPE label_longident EQUAL core_type { (mkrhs $2 2, $4) }
 ;
 package_type_cstrs:
     package_type_cstr { [$1] }
@@ -1438,7 +1611,7 @@
 ;
 row_field:
     tag_field                                   { $1 }
-  | simple_core_type2                           { Rinherit $1 }
+  | simple_core_type                            { Rinherit $1 }
 ;
 tag_field:
     name_tag OF opt_ampersand amper_type_list
@@ -1499,17 +1672,17 @@
   | NATIVEINT                                   { Const_nativeint $1 }
 ;
 signed_constant:
-    constant                                    { $1 }
-  | MINUS INT                                   { Const_int(- $2) }
-  | MINUS FLOAT                                 { Const_float("-" ^ $2) }
-  | MINUS INT32                                 { Const_int32(Int32.neg $2) }
-  | MINUS INT64                                 { Const_int64(Int64.neg $2) }
-  | MINUS NATIVEINT                             { Const_nativeint(Nativeint.neg $2) }
-  | PLUS INT                                    { Const_int $2 }
-  | PLUS FLOAT                                  { Const_float $2 }
-  | PLUS INT32                                  { Const_int32 $2 }
-  | PLUS INT64                                  { Const_int64 $2 }
-  | PLUS NATIVEINT                              { Const_nativeint $2 }
+    constant                               { $1 }
+  | MINUS INT                              { Const_int(- $2) }
+  | MINUS FLOAT                            { Const_float("-" ^ $2) }
+  | MINUS INT32                            { Const_int32(Int32.neg $2) }
+  | MINUS INT64                            { Const_int64(Int64.neg $2) }
+  | MINUS NATIVEINT                        { Const_nativeint(Nativeint.neg $2) }
+  | PLUS INT                               { Const_int $2 }
+  | PLUS FLOAT                             { Const_float $2 }
+  | PLUS INT32                             { Const_int32 $2 }
+  | PLUS INT64                             { Const_int64 $2 }
+  | PLUS NATIVEINT                         { Const_nativeint $2 }
 ;
 
 /* Identifiers and long identifiers */
@@ -1521,6 +1694,9 @@
 val_ident:
     LIDENT                                      { $1 }
   | LPAREN operator RPAREN                      { $2 }
+  | LPAREN operator error                       { unclosed "(" 1 ")" 3 }
+  | LPAREN error                                { expecting 2 "operator" }
+  | LPAREN MODULE error                         { expecting 3 "module-expr" }
 ;
 operator:
     PREFIXOP                                    { $1 }
@@ -1594,6 +1770,15 @@
     LIDENT                                      { Lident $1 }
   | mod_longident DOT LIDENT                    { Ldot($1, $3) }
 ;
+any_longident:
+    val_ident                                   { Lident $1 }
+  | mod_ext_longident DOT val_ident             { Ldot ($1, $3) }
+  | mod_ext_longident                           { $1 }
+  | LBRACKET RBRACKET                           { Lident "[]" }
+  | LPAREN RPAREN                               { Lident "()" }
+  | FALSE                                       { Lident "false" }
+  | TRUE                                        { Lident "true" }
+;
 
 /* Toplevel directives */
 
diff -Nru ocaml-3.12.1/parsing/parsetree.mli ocaml-4.01.0/parsing/parsetree.mli
--- ocaml-3.12.1/parsing/parsetree.mli	2010-04-17 14:45:12.000000000 +0000
+++ ocaml-4.01.0/parsing/parsetree.mli	2013-05-16 13:34:53.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: parsetree.mli 10263 2010-04-17 14:45:12Z garrigue $ *)
-
 (* Abstract syntax tree produced by parsing *)
 
 open Asttypes
@@ -27,15 +25,16 @@
   | Ptyp_var of string
   | Ptyp_arrow of label * core_type * core_type
   | Ptyp_tuple of core_type list
-  | Ptyp_constr of Longident.t * core_type list
+  | Ptyp_constr of Longident.t loc * core_type list
   | Ptyp_object of core_field_type list
-  | Ptyp_class of Longident.t * core_type list * label list
+  | Ptyp_class of Longident.t loc * core_type list * label list
   | Ptyp_alias of core_type * string
   | Ptyp_variant of row_field list * bool * label list option
   | Ptyp_poly of string list * core_type
   | Ptyp_package of package_type
 
-and package_type = Longident.t * (string * core_type) list
+
+and package_type = Longident.t loc * (Longident.t loc * core_type) list
 
 and core_field_type =
   { pfield_desc: core_field_desc;
@@ -53,8 +52,8 @@
 
 type 'a class_infos =
   { pci_virt: virtual_flag;
-    pci_params: string list * Location.t;
-    pci_name: string;
+    pci_params: string loc list * Location.t;
+    pci_name: string loc;
     pci_expr: 'a;
     pci_variance: (bool * bool) list;
     pci_loc: Location.t }
@@ -67,25 +66,26 @@
 
 and pattern_desc =
     Ppat_any
-  | Ppat_var of string
-  | Ppat_alias of pattern * string
+  | Ppat_var of string loc
+  | Ppat_alias of pattern * string loc
   | Ppat_constant of constant
   | Ppat_tuple of pattern list
-  | Ppat_construct of Longident.t * pattern option * bool
+  | Ppat_construct of Longident.t loc * pattern option * bool
   | Ppat_variant of label * pattern option
-  | Ppat_record of (Longident.t * pattern) list * closed_flag
+  | Ppat_record of (Longident.t loc * pattern) list * closed_flag
   | Ppat_array of pattern list
   | Ppat_or of pattern * pattern
   | Ppat_constraint of pattern * core_type
-  | Ppat_type of Longident.t
+  | Ppat_type of Longident.t loc
   | Ppat_lazy of pattern
+  | Ppat_unpack of string loc
 
 type expression =
   { pexp_desc: expression_desc;
     pexp_loc: Location.t }
 
 and expression_desc =
-    Pexp_ident of Longident.t
+    Pexp_ident of Longident.t loc
   | Pexp_constant of constant
   | Pexp_let of rec_flag * (pattern * expression) list * expression
   | Pexp_function of label * expression option * (pattern * expression) list
@@ -93,42 +93,45 @@
   | Pexp_match of expression * (pattern * expression) list
   | Pexp_try of expression * (pattern * expression) list
   | Pexp_tuple of expression list
-  | Pexp_construct of Longident.t * expression option * bool
+  | Pexp_construct of Longident.t loc * expression option * bool
   | Pexp_variant of label * expression option
-  | Pexp_record of (Longident.t * expression) list * expression option
-  | Pexp_field of expression * Longident.t
-  | Pexp_setfield of expression * Longident.t * expression
+  | Pexp_record of (Longident.t loc * expression) list * expression option
+  | Pexp_field of expression * Longident.t loc
+  | Pexp_setfield of expression * Longident.t loc * expression
   | Pexp_array of expression list
   | Pexp_ifthenelse of expression * expression * expression option
   | Pexp_sequence of expression * expression
   | Pexp_while of expression * expression
-  | Pexp_for of string * expression * expression * direction_flag * expression
+  | Pexp_for of
+      string loc *  expression * expression * direction_flag * expression
   | Pexp_constraint of expression * core_type option * core_type option
   | Pexp_when of expression * expression
   | Pexp_send of expression * string
-  | Pexp_new of Longident.t
-  | Pexp_setinstvar of string * expression
-  | Pexp_override of (string * expression) list
-  | Pexp_letmodule of string * module_expr * expression
+  | Pexp_new of Longident.t loc
+  | Pexp_setinstvar of string loc * expression
+  | Pexp_override of (string loc * expression) list
+  | Pexp_letmodule of string loc * module_expr * expression
   | Pexp_assert of expression
   | Pexp_assertfalse
   | Pexp_lazy of expression
   | Pexp_poly of expression * core_type option
   | Pexp_object of class_structure
   | Pexp_newtype of string * expression
-  | Pexp_pack of module_expr * package_type
-  | Pexp_open of Longident.t * expression
+  | Pexp_pack of module_expr
+  | Pexp_open of override_flag * Longident.t loc * expression
 
 (* Value descriptions *)
 
 and value_description =
   { pval_type: core_type;
-    pval_prim: string list }
+    pval_prim: string list;
+    pval_loc: Location.t
+    }
 
 (* Type declarations *)
 
 and type_declaration =
-  { ptype_params: string list;
+  { ptype_params: string loc option list;
     ptype_cstrs: (core_type * core_type * Location.t) list;
     ptype_kind: type_kind;
     ptype_private: private_flag;
@@ -138,9 +141,10 @@
 
 and type_kind =
     Ptype_abstract
-  | Ptype_variant of (string * core_type list * Location.t) list
+  | Ptype_variant of
+      (string loc * core_type list * core_type option * Location.t) list
   | Ptype_record of
-      (string * mutable_flag * core_type * Location.t) list
+      (string loc * mutable_flag * core_type * Location.t) list
 
 and exception_declaration = core_type list
 
@@ -151,18 +155,27 @@
     pcty_loc: Location.t }
 
 and class_type_desc =
-    Pcty_constr of Longident.t * core_type list
+    Pcty_constr of Longident.t loc * core_type list
   | Pcty_signature of class_signature
   | Pcty_fun of label * core_type * class_type
 
-and class_signature = core_type * class_type_field list
+and class_signature = {
+    pcsig_self: core_type;
+    pcsig_fields: class_type_field list;
+    pcsig_loc: Location.t;
+  }
+
+and class_type_field = {
+    pctf_desc: class_type_field_desc;
+    pctf_loc: Location.t;
+  }
 
-and class_type_field =
+and class_type_field_desc =
     Pctf_inher of class_type
-  | Pctf_val of (string * mutable_flag * virtual_flag * core_type * Location.t)
-  | Pctf_virt  of (string * private_flag * core_type * Location.t)
-  | Pctf_meth  of (string * private_flag * core_type * Location.t)
-  | Pctf_cstr  of (core_type * core_type * Location.t)
+  | Pctf_val of (string * mutable_flag * virtual_flag * core_type)
+  | Pctf_virt  of (string * private_flag * core_type)
+  | Pctf_meth  of (string * private_flag * core_type)
+  | Pctf_cstr  of (core_type * core_type)
 
 and class_description = class_type class_infos
 
@@ -175,24 +188,31 @@
     pcl_loc: Location.t }
 
 and class_expr_desc =
-    Pcl_constr of Longident.t * core_type list
+    Pcl_constr of Longident.t loc * core_type list
   | Pcl_structure of class_structure
   | Pcl_fun of label * expression option * pattern * class_expr
   | Pcl_apply of class_expr * (label * expression) list
   | Pcl_let of rec_flag * (pattern * expression) list * class_expr
   | Pcl_constraint of class_expr * class_type
 
-and class_structure = pattern * class_field list
+and class_structure = {
+    pcstr_pat: pattern;
+    pcstr_fields: class_field list;
+  }
+
+and class_field = {
+    pcf_desc: class_field_desc;
+    pcf_loc: Location.t;
+  }
 
-and class_field =
+and class_field_desc =
     Pcf_inher of override_flag * class_expr * string option
-  | Pcf_valvirt of (string * mutable_flag * core_type * Location.t)
-  | Pcf_val of (string * mutable_flag * override_flag * expression * Location.t)
-  | Pcf_virt  of (string * private_flag * core_type * Location.t)
-  | Pcf_meth of (string * private_flag *override_flag * expression * Location.t)
-  | Pcf_cstr  of (core_type * core_type * Location.t)
-  | Pcf_let   of rec_flag * (pattern * expression) list * Location.t
-  | Pcf_init  of expression
+  | Pcf_valvirt of (string loc * mutable_flag * core_type)
+  | Pcf_val of (string loc * mutable_flag * override_flag * expression)
+  | Pcf_virt of (string loc * private_flag * core_type)
+  | Pcf_meth of (string loc * private_flag * override_flag * expression)
+  | Pcf_constr of (core_type * core_type)
+  | Pcf_init of expression
 
 and class_declaration = class_expr class_infos
 
@@ -203,10 +223,10 @@
     pmty_loc: Location.t }
 
 and module_type_desc =
-    Pmty_ident of Longident.t
+    Pmty_ident of Longident.t loc
   | Pmty_signature of signature
-  | Pmty_functor of string * module_type * module_type
-  | Pmty_with of module_type * (Longident.t * with_constraint) list
+  | Pmty_functor of string loc * module_type * module_type
+  | Pmty_with of module_type * (Longident.t loc * with_constraint) list
   | Pmty_typeof of module_expr
 
 and signature = signature_item list
@@ -216,13 +236,13 @@
     psig_loc: Location.t }
 
 and signature_item_desc =
-    Psig_value of string * value_description
-  | Psig_type of (string * type_declaration) list
-  | Psig_exception of string * exception_declaration
-  | Psig_module of string * module_type
-  | Psig_recmodule of (string * module_type) list
-  | Psig_modtype of string * modtype_declaration
-  | Psig_open of Longident.t
+    Psig_value of string loc * value_description
+  | Psig_type of (string loc * type_declaration) list
+  | Psig_exception of string loc * exception_declaration
+  | Psig_module of string loc * module_type
+  | Psig_recmodule of (string loc * module_type) list
+  | Psig_modtype of string loc * modtype_declaration
+  | Psig_open of override_flag * Longident.t loc
   | Psig_include of module_type
   | Psig_class of class_description list
   | Psig_class_type of class_type_declaration list
@@ -233,23 +253,23 @@
 
 and with_constraint =
     Pwith_type of type_declaration
-  | Pwith_module of Longident.t
+  | Pwith_module of Longident.t loc
   | Pwith_typesubst of type_declaration
-  | Pwith_modsubst of Longident.t
+  | Pwith_modsubst of Longident.t loc
 
-(* value expressions for the module language *)
+(* Value expressions for the module language *)
 
 and module_expr =
   { pmod_desc: module_expr_desc;
     pmod_loc: Location.t }
 
 and module_expr_desc =
-    Pmod_ident of Longident.t
+    Pmod_ident of Longident.t loc
   | Pmod_structure of structure
-  | Pmod_functor of string * module_type * module_expr
+  | Pmod_functor of string loc * module_type * module_expr
   | Pmod_apply of module_expr * module_expr
   | Pmod_constraint of module_expr * module_type
-  | Pmod_unpack of expression * package_type
+  | Pmod_unpack of expression
 
 and structure = structure_item list
 
@@ -260,14 +280,14 @@
 and structure_item_desc =
     Pstr_eval of expression
   | Pstr_value of rec_flag * (pattern * expression) list
-  | Pstr_primitive of string * value_description
-  | Pstr_type of (string * type_declaration) list
-  | Pstr_exception of string * exception_declaration
-  | Pstr_exn_rebind of string * Longident.t
-  | Pstr_module of string * module_expr
-  | Pstr_recmodule of (string * module_type * module_expr) list
-  | Pstr_modtype of string * module_type
-  | Pstr_open of Longident.t
+  | Pstr_primitive of string loc * value_description
+  | Pstr_type of (string loc * type_declaration) list
+  | Pstr_exception of string loc * exception_declaration
+  | Pstr_exn_rebind of string loc * Longident.t loc
+  | Pstr_module of string loc * module_expr
+  | Pstr_recmodule of (string loc * module_type * module_expr) list
+  | Pstr_modtype of string loc * module_type
+  | Pstr_open of override_flag * Longident.t loc
   | Pstr_class of class_declaration list
   | Pstr_class_type of class_type_declaration list
   | Pstr_include of module_expr
diff -Nru ocaml-3.12.1/parsing/pprintast.ml ocaml-4.01.0/parsing/pprintast.ml
--- ocaml-3.12.1/parsing/pprintast.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/parsing/pprintast.ml	2013-05-22 12:56:54.000000000 +0000
@@ -0,0 +1,1246 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                OCaml                                   *)
+(*                                                                        *)
+(*    Thomas Gazagnaire (OCamlPro), Fabrice Le Fessant (INRIA Saclay)     *)
+(*    Hongbo Zhang (University of Pennsylvania)                           *)
+(*   Copyright 2007 Institut National de Recherche en Informatique et     *)
+(*   en Automatique.  All rights reserved.  This file is distributed      *)
+(*   under the terms of the Q Public License version 1.0.                 *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Original Code from Ber-metaocaml, modified for 3.12.0 and fixed *)
+(* Printing code expressions *)
+(* Authors:  Ed Pizzi, Fabrice Le Fessant *)
+(* Extensive Rewrite: Hongbo Zhang: University of Pennsylvania *)
+(* TODO more fine-grained precedence pretty-printing *)
+
+open Asttypes
+open Format
+open Location
+open Longident
+open Parsetree
+
+let prefix_symbols  = [ '!'; '?'; '~' ] ;;
+let infix_symbols = [ '='; '<'; '>'; '@'; '^'; '|'; '&'; '+'; '-'; '*'; '/';
+                      '$'; '%' ]
+let operator_chars = [ '!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/';
+                       ':'; '<'; '='; '>'; '?'; '@'; '^'; '|'; '~' ]
+let numeric_chars  = [ '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9' ]
+
+(* type fixity = Infix| Prefix  *)
+
+
+let special_infix_strings =
+  ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; ":="; "!=" ]
+
+(* determines if the string is an infix string.
+   checks backwards, first allowing a renaming postfix ("_102") which
+   may have resulted from Pexp -> Texp -> Pexp translation, then checking
+   if all the characters in the beginning of the string are valid infix
+   characters. *)
+let fixity_of_string  = function
+  | s when List.mem s special_infix_strings -> `Infix s
+  | s when List.mem s.[0] infix_symbols -> `Infix s
+  | s when List.mem s.[0] prefix_symbols -> `Prefix s
+  | _ -> `Normal
+
+let view_fixity_of_exp = function
+  | {pexp_desc = Pexp_ident {txt=Lident l;_};_} -> fixity_of_string l
+  | _ -> `Normal  ;;
+
+let is_infix  = function  | `Infix _ -> true | _  -> false
+
+let is_predef_option = function
+  | (Ldot (Lident "*predef*","option")) -> true
+  | _ -> false
+
+type space_formatter = (unit, Format.formatter, unit) format
+
+let override = function
+  | Override -> "!"
+  | Fresh -> ""
+
+(* variance encoding: need to sync up with the [parser.mly] *)
+let type_variance = function
+  | (false,false) -> ""
+  | (true,false) -> "+"
+  | (false,true) -> "-"
+  | (_,_) -> assert false
+
+type construct =
+  [ `cons of expression list
+  | `list of expression list
+  | `nil
+  | `normal
+  | `simple of Longident.t
+  | `tuple ]
+
+let view_expr x =
+  match x.pexp_desc with
+  | Pexp_construct ( {txt= Lident "()"; _},_,_) -> `tuple
+  | Pexp_construct ( {txt= Lident "[]";_},_,_) -> `nil
+  | Pexp_construct ( {txt= Lident"::";_},Some _,_) ->
+      let rec loop exp acc = match exp with
+          | {pexp_desc=Pexp_construct ({txt=Lident "[]";_},_,_);_} ->
+              (List.rev acc,true)
+          | {pexp_desc=
+             Pexp_construct ({txt=Lident "::";_},
+                             Some ({pexp_desc= Pexp_tuple([e1;e2]);_}),_);_} ->
+              loop e2 (e1::acc)
+          | e -> (List.rev (e::acc),false) in
+      let (ls,b) = loop x []  in
+      if b then
+        `list ls
+      else `cons ls
+  | Pexp_construct (x,None,_) -> `simple (x.txt)
+  | _ -> `normal
+
+let is_simple_construct :construct -> bool = function
+  | `nil | `tuple | `list _ | `simple _  -> true
+  | `cons _ | `normal -> false
+
+let pp = fprintf
+
+let rec is_irrefut_patt x =
+  match x.ppat_desc with
+  | Ppat_any | Ppat_var _ | Ppat_unpack _ -> true
+  | Ppat_alias (p,_) -> is_irrefut_patt p
+  | Ppat_tuple (ps) -> List.for_all is_irrefut_patt ps
+  | Ppat_constraint (p,_) -> is_irrefut_patt p
+  | Ppat_or (l,r) -> is_irrefut_patt l || is_irrefut_patt r
+  | Ppat_record (ls,_) -> List.for_all (fun (_,x) -> is_irrefut_patt x) ls
+  | Ppat_lazy p -> is_irrefut_patt p
+  | Ppat_constant _ | Ppat_construct _  | Ppat_variant _ | Ppat_array _
+    | Ppat_type _ -> false (*conservative*)
+class printer  ()= object(self:'self)
+  val pipe = false
+  val semi = false
+  val ifthenelse = false
+  method under_pipe = {}
+  method under_semi = {}
+  method under_ifthenelse = {}
+  method reset_semi = {}
+  method reset_ifthenelse = {}
+  method reset_pipe = {}
+  method reset = {}
+  method list : 'a . ?sep:space_formatter -> ?first:space_formatter ->
+    ?last:space_formatter -> (Format.formatter -> 'a -> unit) ->
+    Format.formatter -> 'a list -> unit
+        = fun  ?sep ?first  ?last fu f xs ->
+          let first = match first with Some x -> x |None -> ""
+          and last = match last with Some x -> x |None -> ""
+          and sep = match sep with Some x -> x |None -> "@ " in
+          let aux f = function
+            | [] -> ()
+            | [x] -> fu f x
+            | xs ->
+                let rec loop  f = function
+                  | [x] -> fu f x
+                  | x::xs ->  pp f "%a%(%)%a" fu x sep loop xs
+                  | _ -> assert false in begin
+                      pp f "%(%)%a%(%)" first loop xs last;
+                  end in
+          aux f xs
+  method option : 'a. ?first:space_formatter -> ?last:space_formatter ->
+    (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a option -> unit =
+      fun  ?first  ?last fu f a ->
+        let first = match first with Some x -> x | None -> ""
+        and last = match last with Some x -> x | None -> "" in
+        match a with
+        | None -> ()
+        | Some x -> pp f "%(%)%a%(%)" first fu x last
+  method paren: 'a . ?first:space_formatter -> ?last:space_formatter ->
+    bool -> (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a -> unit =
+    fun  ?(first="") ?(last="") b fu f x ->
+      if b then pp f "(%(%)%a%(%))" first fu  x last
+      else fu f x
+
+
+  method longident f = function
+    | Lident s ->
+        (match s.[0] with
+        | 'a' .. 'z' | 'A' .. 'Z' | '_'
+          when not (is_infix (fixity_of_string s)) ->
+            pp f "%s" s
+        | _ -> pp f "(@;%s@;)" s )
+    | Ldot(y,s) -> (match s.[0] with
+      | 'a'..'z' | 'A' .. 'Z' | '_' when not(is_infix (fixity_of_string s)) ->
+          pp f "%a.%s" self#longident y s
+      | _ ->
+          pp f "%a.(@;%s@;)@ " self#longident y s)
+    | Lapply (y,s) ->
+        pp f "%a(%a)" self#longident y self#longident s
+  method longident_loc f x = pp f "%a" self#longident x.txt
+  method constant f  = function
+    | Const_char i -> pp f "%C"  i
+    | Const_string i -> pp f "%S" i
+    | Const_int i -> self#paren (i<0) (fun f -> pp f "%d") f i
+    | Const_float  i -> self#paren (i.[0]='-') (fun f -> pp f "%s") f i
+    | Const_int32 i -> self#paren (i<0l) (fun f -> pp f "%ldl") f i
+    | Const_int64 i -> self#paren (i<0L) (fun f -> pp f "%LdL") f i
+                                         (* pp f "%LdL" i *)
+    | Const_nativeint i -> self#paren (i<0n) (fun f -> pp f "%ndn") f i
+                                             (* pp f "%ndn" i *)
+
+  (* trailing space*)
+  method mutable_flag f   = function
+    | Immutable -> ()
+    | Mutable -> pp f "mutable@;"
+  method virtual_flag f  = function
+    | Concrete -> ()
+    | Virtual -> pp f "virtual@;"
+
+  (* trailing space added *)
+  method rec_flag f = function
+    | Nonrecursive -> ()
+    | Recursive | Default -> pp f "rec "
+  method direction_flag f = function
+    | Upto -> pp f "to@ "
+    | Downto -> pp f "downto@ "
+  method private_flag f = function
+    | Public -> ()
+    | Private -> pp f "private@ "
+
+  method constant_string f s = pp f "%S" s
+  method tyvar f str = pp f "'%s" str
+  method string_quot f x = pp f "`%s" x
+  method type_var_option f str =
+    match str with
+    | None -> pp f "_" (* wildcard*)
+    | Some {txt;_} -> self#tyvar f txt
+
+          (* c ['a,'b] *)
+  method class_params_def f =  function
+    | [] -> ()
+    | l ->
+        pp f "[%a] " (* space *)
+          (self#list (fun f ({txt;_},s) ->
+            pp f "%s%a" (type_variance s) self#tyvar txt) ~sep:",") l
+
+  method type_with_label f (label,({ptyp_desc;_}as c) ) =
+    match label with
+    | "" ->  self#core_type1 f c (* otherwise parenthesize *)
+    | s  ->
+        if s.[0]='?' then
+          match ptyp_desc with
+          | Ptyp_constr ({txt;_}, l) ->
+              assert (is_predef_option txt);
+              pp f "%s:%a" s (self#list self#core_type1) l
+          | _ -> failwith "invalid input in print_type_with_label"
+        else pp f "%s:%a" s self#core_type1 c
+  method core_type f x =
+    match x.ptyp_desc with
+    | Ptyp_arrow (l, ct1, ct2) ->
+        pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
+          self#type_with_label (l,ct1) self#core_type ct2
+    | Ptyp_alias (ct, s) ->
+        pp f "@[<2>%a@;as@;'%s@]" self#core_type1 ct s
+    | Ptyp_poly (sl, ct) ->
+        pp f "@[<2>%a%a@]"
+          (fun f l ->
+            pp f "%a"
+              (fun f l -> match l with
+              | [] -> ()
+              | _ ->
+                  pp f "%a@;.@;"
+                    (self#list self#tyvar ~sep:"@;")  l)
+              l)
+          sl  self#core_type ct
+    | _ -> pp f "@[<2>%a@]" self#core_type1 x
+  method core_type1 f x =
+    match x.ptyp_desc with
+    | Ptyp_any -> pp f "_";
+    | Ptyp_var s -> self#tyvar f  s;
+    | Ptyp_tuple l ->  pp f "(%a)" (self#list self#core_type1 ~sep:"*@;") l
+    | Ptyp_constr (li, l) ->
+        pp f (* "%a%a@;" *) "%a%a"
+          (fun f l -> match l with
+          |[] -> ()
+          |[x]-> pp f "%a@;" self#core_type1  x
+          | _ -> self#list ~first:"(" ~last:")@;" self#core_type ~sep:"," f l)
+          l self#longident_loc li
+    | Ptyp_variant (l, closed, low) ->
+        let type_variant_helper f x =
+          match x with
+          | Rtag (l, _, ctl) -> pp f "@[<2>%a%a@]"  self#string_quot l
+                (fun f l -> match l with
+                |[] -> ()
+                | _ -> pp f "@;of@;%a"
+                      (self#list self#core_type ~sep:"&")  ctl) ctl
+          | Rinherit ct -> self#core_type f ct in
+        pp f "@[<2>[%a%a]@]"
+          (fun f l
+            ->
+              match l with
+              | [] -> ()
+              | _ ->
+              pp f "%s@;%a"
+                (match (closed,low) with
+                | (true,None) -> ""
+                | (true,Some _) -> "<" (* FIXME desugar the syntax sugar *)
+                | (false,_) -> ">")
+                (self#list type_variant_helper ~sep:"@;<1 -2>| ") l) l
+          (fun f low
+            ->
+              match low with
+              |Some [] |None -> ()
+              |Some xs ->
+              pp f ">@ %a"
+                (self#list self#string_quot) xs) low
+    | Ptyp_object l ->
+        let  core_field_type f {pfield_desc;_} =
+          match pfield_desc with
+          | Pfield (s, ct) ->
+              pp f "@[%s@ :%a@ @]" s self#core_type ct
+          | Pfield_var -> pp f ".." in
+        pp f "@[<@ %a@ >@]" (self#list core_field_type ~sep:";") l
+    | Ptyp_class (li, l, low) ->   (*FIXME*)
+        pp f "@[%a#%a%a@]"
+          (self#list self#core_type ~sep:"," ~first:"(" ~last:")") l
+          self#longident_loc li
+          (fun f low -> match low with
+          | [] -> ()
+          | _ -> pp f "@ [>@ %a]" (self#list self#string_quot) low) low
+    | Ptyp_package (lid, cstrs) ->
+        let aux f (s, ct) =
+          pp f "type %a@ =@ %a" self#longident_loc s self#core_type ct  in
+        (match cstrs with
+        |[] -> pp f "@[(module@ %a)@]" self#longident_loc lid
+        |_ ->
+            pp f "@[(module@ %a@ with@ %a)@]" self#longident_loc lid
+              (self#list aux  ~sep:"@ and@ ")  cstrs)
+    | _ -> self#paren true self#core_type f x
+          (********************pattern********************)
+          (* be cautious when use [pattern], [pattern1] is preferred *)
+  method pattern f x =
+    let rec pattern_or_helper  cur = function
+      |{ppat_desc = Ppat_constant (Const_char a);_}
+        ->
+          if Char.code a = Char.code cur + 1 then
+            Some a
+          else None
+      |{ppat_desc =
+        Ppat_or({ppat_desc=Ppat_constant (Const_char a);_}, p2);_} ->
+          if Char.code a = Char.code cur + 1 then
+            pattern_or_helper a p2
+          else None
+      | _ -> None in
+    let rec list_of_pattern acc = function (* only consider ((A|B)|C)*)
+      | {ppat_desc= Ppat_or (p1,p2);_} ->
+          list_of_pattern  (p2::acc) p1
+      | x -> x::acc in
+    match x.ppat_desc with
+    | Ppat_alias (p, s) -> pp f "@[<2>%a@;as@;%a@]"
+          self#pattern p
+          (fun f s->
+            if is_infix (fixity_of_string s.txt)
+               || List.mem s.txt.[0] prefix_symbols
+            then pp f "( %s )" s.txt
+            else pp f "%s" s.txt ) s (* RA*)
+    | Ppat_or (p1, p2) -> (* *)
+        (match p1 with
+        | {ppat_desc=Ppat_constant (Const_char a);_} ->
+            (match pattern_or_helper a p2 with
+            |Some b -> pp f "@[<2>%C..%C@]" a b
+            |None ->
+                pp f "@[%a@]" (self#list ~sep:"@,|" self#pattern)
+                   (list_of_pattern [] x))
+        | _ ->
+            pp f "@[%a@]" (self#list ~sep:"@,|" self#pattern)
+               (list_of_pattern [] x)
+        )
+    | _ -> self#pattern1 f x
+  method pattern1 (f:Format.formatter) (x:pattern) :unit =
+    let rec pattern_list_helper f  =  function
+      | {ppat_desc =
+         Ppat_construct
+           ({ txt = Lident("::") ;_},
+            Some ({ppat_desc = Ppat_tuple([pat1; pat2]);_}),
+            _);_} ->
+              pp f "%a::%a"  self#simple_pattern  pat1  pattern_list_helper pat2 (*RA*)
+      | p -> self#pattern1 f p in
+    match x.ppat_desc with
+    | Ppat_variant (l, Some p) ->  pp f "@[<2>`%s@;%a@]" l self#pattern1 p (*RA*)
+    | Ppat_construct (({txt=Lident("()"|"[]");_}), _, _) -> self#simple_pattern f x
+    | Ppat_construct (({txt;_} as li), po, _) -> (* FIXME The third field always false *)
+        if txt = Lident "::" then
+          pp f "%a" pattern_list_helper x
+        else
+          (match po with
+          |Some x ->
+              pp f "%a@;%a"  self#longident_loc li self#simple_pattern x
+          | None -> pp f "%a@;"self#longident_loc li )
+    | _ -> self#simple_pattern f x
+  method simple_pattern (f:Format.formatter) (x:pattern) :unit =
+    match x.ppat_desc with
+    | Ppat_construct (({txt=Lident ("()"|"[]" as x);_}), _, _) -> pp f  "%s" x
+    | Ppat_any -> pp f "_";
+    | Ppat_var ({txt = txt;_}) ->
+        if (is_infix (fixity_of_string txt)) || List.mem txt.[0] prefix_symbols then
+          if txt.[0]='*' || txt.[String.length txt - 1] = '*' then
+            pp f "(@;%s@;)@ " txt
+          else
+            pp f "(%s)" txt
+        else
+          pp f "%s" txt
+    | Ppat_array l ->
+        pp f "@[<2>[|%a|]@]"  (self#list self#pattern1 ~sep:";") l
+    | Ppat_unpack (s) ->
+        pp f "(module@ %s)@ " s.txt
+    | Ppat_type li ->
+        pp f "#%a" self#longident_loc li
+    | Ppat_record (l, closed) ->
+        let longident_x_pattern f (li, p) =
+          match (li,p.ppat_desc) with
+          | ({txt=Lident s;_ },Ppat_var {txt;_} ) when s = txt ->
+              pp f "@[<2>%a@]"  self#longident_loc li
+          | _ ->
+            pp f "@[<2>%a@;=@;%a@]" self#longident_loc li self#pattern1 p in
+        (match closed with
+        |Closed ->
+            pp f "@[<2>{@;%a@;}@]"
+              (self#list longident_x_pattern ~sep:";@;") l
+        | _ ->
+            pp f "@[<2>{@;%a;_}@]"
+              (self#list longident_x_pattern ~sep:";@;") l)
+    | Ppat_tuple l -> pp f "@[<1>(%a)@]" (self#list  ~sep:"," self#pattern1)  l (* level1*)
+    | Ppat_constant (c) -> pp f "%a" self#constant c
+    | Ppat_variant (l,None) ->  pp f "`%s" l
+    | Ppat_constraint (p, ct) ->
+        pp f "@[<2>(%a@;:@;%a)@]" self#pattern1 p self#core_type ct
+    | Ppat_lazy p ->
+        pp f "@[<2>(lazy@;%a)@]" self#pattern1 p
+    | _ -> self#paren true self#pattern f x
+
+  method label_exp f (l,opt,p) =
+    if l = "" then
+      pp f "%a@ " self#simple_pattern p (*single case pattern parens needed here *)
+    else
+      if l.[0] = '?' then
+        let len = String.length l - 1 in
+        let rest = String.sub l 1 len in begin
+          match p.ppat_desc with
+          | Ppat_var {txt;_} when txt = rest ->
+              (match opt with
+              |Some o -> pp f "?(%s=@;%a)@;" rest  self#expression o
+              | None -> pp f "?%s@ " rest)
+          | _ -> (match opt with
+            | Some o -> pp f "%s:(%a=@;%a)@;" l self#pattern1 p self#expression o
+            | None -> pp f "%s:%a@;" l self#simple_pattern p  )
+        end
+      else
+        (match p.ppat_desc with
+        | Ppat_var {txt;_} when txt = l ->
+            pp f "~%s@;" l
+        | _ ->  pp f "~%s:%a@;" l self#simple_pattern p )
+  method sugar_expr f e =
+    match e.pexp_desc with
+    | Pexp_apply
+        ({pexp_desc=
+          Pexp_ident
+            {txt= Ldot (Lident (("Array"|"String") as s),"get");_};_},
+         [(_,e1);(_,e2)]) -> begin
+              let fmt:(_,_,_)format =
+                if s= "Array" then "@[%a.(%a)@]" else "@[%a.[%a]@]" in
+              pp f fmt   self#simple_expr e1 self#expression e2;
+              true
+            end
+    |Pexp_apply
+        ({pexp_desc=
+          Pexp_ident
+            {txt= Ldot (Lident (("Array"|"String") as s),
+                        "set");_};_},[(_,e1);(_,e2);(_,e3)])
+      ->
+        let fmt :(_,_,_) format=
+          if s= "Array" then
+            "@[%a.(%a)@ <-@;%a@]"
+          else
+            "@[%a.[%a]@ <-@;%a@]" in  (* @;< gives error here *)
+        pp f fmt self#simple_expr e1  self#expression e2  self#expression e3;
+        true
+    | Pexp_apply ({pexp_desc=Pexp_ident {txt=Lident "!";_};_}, [(_,e)]) -> begin
+        pp f "@[!%a@]" self#simple_expr e;
+        true
+    end
+    | Pexp_apply
+        ({pexp_desc=Pexp_ident
+                     {txt= Ldot (Ldot (Lident "Bigarray", array), ("get"|"set" as gs)) ;_};_},
+         label_exprs) ->
+           begin match array,gs with
+           | "Genarray","get"   ->
+               begin match label_exprs with
+               | [(_,a);(_,{pexp_desc=Pexp_array ls;_})]  -> begin
+                   pp f "@[%a.{%a}@]" self#simple_expr a
+                   (self#list ~sep:"," self#simple_expr ) ls;
+                   true
+               end
+               | _ -> false
+               end
+           | "Genarray","set" ->
+               begin match label_exprs with
+               | [(_,a);(_,{pexp_desc=Pexp_array ls;_});(_,c)]  -> begin
+                   pp f "@[%a.{%a}@ <-@ %a@]" self#simple_expr a
+                   (self#list ~sep:"," self#simple_expr ) ls self#simple_expr c;
+                   true
+               end
+               | _ -> false
+               end
+           | ("Array1"|"Array2"|"Array3"),"set" ->
+               begin
+                 match label_exprs with
+                 | (_,a)::rest ->
+                     begin match List.rev rest with
+                     | (_,v)::rest ->
+                         let args = List.map snd (List.rev rest) in
+                         pp f "@[%a.{%a}@ <-@ %a@]"
+                           self#simple_expr a (self#list ~sep:"," self#simple_expr)
+                           args self#simple_expr v;
+                         true
+                     | _ -> assert false
+                     end
+                 | _ -> assert false
+               end
+           | ("Array1"|"Array2"|"Array3"),"get" ->
+               begin match label_exprs with
+               |(_,a)::rest ->
+                 pp f "@[%a.{%a}@]"
+                     self#simple_expr a (self#list ~sep:"," self#simple_expr)
+                     (List.map snd rest);
+                   true
+               | _ -> assert false
+               end
+           | _ -> false
+           end
+
+    | _ -> false
+  method expression f x =
+    match x.pexp_desc with
+    | Pexp_function _ | Pexp_match _ | Pexp_try _ | Pexp_sequence _
+      when pipe || semi ->
+        self#paren true self#reset#expression f x
+    | Pexp_ifthenelse _ | Pexp_sequence _ when ifthenelse ->
+        self#paren true self#reset#expression f x
+    | Pexp_let _ | Pexp_letmodule _ when semi ->
+        self#paren true self#reset#expression f x
+    | Pexp_function _(* (p, eo, l) *) ->
+        let rec aux acc = function
+          | {pexp_desc = Pexp_function (l,eo, [(p',e')]);_}
+              -> aux ((l,eo,p')::acc) e'
+          | x -> (List.rev acc,x)  in
+        begin match aux [] x with
+        | [], {pexp_desc=Pexp_function(_label,_eo,l);_} -> (* label should be "" *)
+            pp f "@[function%a@]" self#case_list l
+        | ls, {pexp_desc=Pexp_when(e1,e2);_}->
+            pp f "@[<2>fun@;%a@;when@;%a@;->@;%a@]"
+            (self#list
+               (fun f (l,eo,p) ->
+                 self#label_exp  f (l,eo,p) )) ls
+              self#reset#expression e1 self#expression e2
+        | ls, e ->
+            pp f "@[<2>fun@;%a@;->@;%a@]"
+              (self#list
+                 (fun f (l,eo,p) ->
+                   self#label_exp f (l,eo,p))) ls
+              self#expression e end
+    | Pexp_match (e, l) ->
+        pp f "@[@[@[<2>match %a@]@ with@]%a@]" self#reset#expression e self#case_list l
+
+    | Pexp_try (e, l) ->
+        pp f "@[<0>@[try@ %a@]@ @[<0>with%a@]@]" (* "try@;@[<2>%a@]@\nwith@\n%a"*)
+          self#reset#expression e  self#case_list l
+    | Pexp_let (rf, l, e) ->
+        (* pp f "@[<2>let %a%a in@;<1 -2>%a@]" (\*no identation here, a new line*\) *)
+        (*   self#rec_flag rf *)
+        pp f "@[<2>%a in@;<1 -2>%a@]"
+          self#reset#bindings (rf,l)
+          self#expression e
+    | Pexp_apply (e, l) ->
+        (if not (self#sugar_expr f x) then
+          match view_fixity_of_exp e with
+          | `Infix s ->
+            (match l with
+            | [ arg1; arg2 ] ->
+                pp f "@[<2>%a@;%s@;%a@]" (* FIXME associativity lable_x_expression_parm*)
+                  self#reset#label_x_expression_param  arg1 s  self#label_x_expression_param arg2
+            | _ ->
+                pp f "@[<2>%a %a@]" self#simple_expr e  (self#list self#label_x_expression_param)  l)
+          | `Prefix s ->
+              let s =
+                if List.mem s ["~+";"~-";"~+.";"~-."] then String.sub s 1 (String.length s -1)
+                else s in
+            (match l with
+            |[v] -> pp f "@[<2>%s@;%a@]" s self#label_x_expression_param v
+            | _ -> pp f "@[<2>%s@;%a@]" s (self#list self#label_x_expression_param) l  (*FIXME assert false*)
+            )
+          | _ ->
+            pp f "@[%a@]" begin fun f (e,l) ->
+              pp f "%a@ %a" self#expression2 e
+                (self#list self#reset#label_x_expression_param)  l
+               (*reset here only because [function,match,try,sequence] are lower priority*)
+            end (e,l))
+
+    | Pexp_construct (li, Some eo, _)
+      when not (is_simple_construct (view_expr x))-> (* Not efficient FIXME*)
+        (match view_expr x with
+        | `cons ls -> self#list self#simple_expr f ls ~sep:"@;::@;"
+        | `normal ->
+            pp f "@[<2>%a@;%a@]" self#longident_loc li
+              self#simple_expr  eo
+        | _ -> assert false)
+    | Pexp_setfield (e1, li, e2) ->
+        pp f "@[<2>%a.%a@ <-@ %a@]" self#simple_expr  e1  self#longident_loc li self#expression e2;
+    | Pexp_ifthenelse (e1, e2, eo) ->
+        (* @;@[<2>else@ %a@]@] *)
+        let fmt:(_,_,_)format ="@[@[<2>if@ %a@]@;@[<2>then@ %a@]%a@]" in
+        pp f fmt  self#under_ifthenelse#expression e1 self#under_ifthenelse#expression e2
+          (fun f eo -> match eo with
+          | Some x -> pp f "@;@[<2>else@;%a@]" self#under_semi#expression  x
+          | None -> () (* pp f "()" *)) eo
+    | Pexp_sequence _ ->
+        let rec sequence_helper acc = function
+          | {pexp_desc=Pexp_sequence(e1,e2);_} ->
+              sequence_helper (e1::acc) e2
+          | v -> List.rev (v::acc) in
+        let lst = sequence_helper [] x in
+        pp f "@[%a@]"
+          (self#list self#under_semi#expression ~sep:";@;") lst
+    | Pexp_when (_e1, _e2) ->  assert false (*FIXME handled already in pattern *)
+    | Pexp_new (li) ->
+        pp f "@[new@ %a@]" self#longident_loc li;
+    | Pexp_setinstvar (s, e) ->
+        pp f "@[%s@ <-@ %a@]" s.txt self#expression e
+    | Pexp_override l -> (* FIXME *)
+        let string_x_expression f (s, e) =
+          pp f "@[%s@ =@ %a@]" s.txt self#expression e in
+        pp f "@[{<%a>}@]"
+          (self#list string_x_expression  ~sep:";"  )  l;
+    | Pexp_letmodule (s, me, e) ->
+        pp f "@[let@ module@ %s@ =@ %a@ in@ %a@]" s.txt
+          self#reset#module_expr me  self#expression e
+    | Pexp_assert e ->
+        pp f "@[assert@ %a@]" self#simple_expr e
+    | Pexp_assertfalse ->
+        pp f "@[<2>assert@;false@]" ;
+    | Pexp_lazy (e) ->
+        pp f "@[lazy@ %a@]" self#simple_expr e
+    | Pexp_poly _ ->
+        assert false
+    | Pexp_open (ovf, lid, e) ->
+        pp f "@[<2>let open%s %a in@;%a@]" (override ovf) self#longident_loc lid
+          self#expression  e
+    | Pexp_variant (l,Some eo) ->
+        pp f "@[<2>`%s@;%a@]" l  self#simple_expr eo
+    | _ -> self#expression1 f x
+  method expression1 f x =
+    match x.pexp_desc with
+    | Pexp_object cs -> pp f "%a" self#class_structure cs
+    | _ -> self#expression2 f x
+  (* used in [Pexp_apply] *)
+  method expression2 f x =
+    match x.pexp_desc with
+    | Pexp_field (e, li) -> pp f "@[%a.%a@]" self#simple_expr e self#longident_loc li
+    | Pexp_send (e, s) ->  pp f "@[%a#%s@]" self#simple_expr e  s
+
+    | _ -> self#simple_expr f x
+  method simple_expr f x =
+    match x.pexp_desc with
+    | Pexp_construct _  when is_simple_construct (view_expr x) ->
+        (match view_expr x with
+        | `nil -> pp f "[]"
+        | `tuple -> pp f "()"
+        | `list xs -> pp f "@[[%a]@]"  (self#list self#under_semi#expression ~sep:";@;") xs
+        | `simple x -> self#longident f x
+        | _ -> assert false)
+    | Pexp_ident li ->
+        self#longident_loc f li
+        (* (match view_fixity_of_exp x with *)
+        (* |`Normal -> self#longident_loc f li *)
+        (* | `Prefix _ | `Infix _ -> pp f "( %a )" self#longident_loc li) *)
+    | Pexp_constant c -> self#constant f c;
+    | Pexp_pack me ->
+        pp f "(module@;%a)"  self#module_expr me
+    | Pexp_newtype (lid, e) ->
+        pp f "fun@;(type@;%s)@;->@;%a"  lid  self#expression  e
+    | Pexp_tuple l ->
+        pp f "@[(%a)@]"  (self#list self#simple_expr  ~sep:",@;")  l
+    | Pexp_constraint (e, cto1, cto2) ->
+        pp f "(%a%a%a)" self#expression e
+          (self#option self#core_type ~first:" : " ~last:" ") cto1 (* no sep hint*)
+          (self#option self#core_type ~first:" :>") cto2
+    | Pexp_variant (l, None) -> pp f "`%s" l
+    | Pexp_record (l, eo) ->
+        let longident_x_expression f ( li, e) =
+          match e.pexp_desc with
+          |  Pexp_ident {txt;_} when li.txt = txt ->
+              pp f "@[%a@]" self#longident_loc li
+          | _ ->
+              pp f "@[%a@;=@;%a@]" self#longident_loc li self#simple_expr e in
+        pp f "@[@[{@;%a%a@]@;}@]"(* "@[{%a%a}@]" *)
+          (self#option ~last:" with@;" self#simple_expr) eo
+          (self#list longident_x_expression ~sep:";@;")  l
+    | Pexp_array (l) ->
+        pp f "@[<0>@[<2>[|%a|]@]@]"
+          (self#list self#under_semi#simple_expr ~sep:";") l
+    | Pexp_while (e1, e2) ->
+        let fmt:(_,_,_)format = "@[<2>while@;%a@;do@;%a@;done@]" in
+        pp f fmt self#expression e1 self#expression e2
+    | Pexp_for (s, e1, e2, df, e3) ->
+        let fmt:(_,_,_)format =
+          "@[@[@[<2>for %s =@;%a@;%a%a@;do@]@;%a@]@;done@]" in
+        pp f fmt s.txt self#expression e1 self#direction_flag df self#expression e2  self#expression e3
+    | _ ->  self#paren true self#expression f x
+
+
+  method value_description f x =
+    pp f "@[%a%a@]" self#core_type x.pval_type
+      (fun f x ->
+        if x.pval_prim<>[] then begin
+          pp f "@ =@ %a"
+            (self#list self#constant_string)
+            x.pval_prim ;
+        end) x
+
+
+  method exception_declaration f (s,ed) =
+    pp f "@[exception@ %s%a@]" s
+      (fun f ed -> match ed with
+      |[] -> ()
+      |_ -> pp f "@ of@ %a" (self#list ~sep:"*" self#core_type) ed) ed
+
+
+  method class_signature f { pcsig_self = ct; pcsig_fields = l ;_} =
+    let class_type_field f x =
+      match x.pctf_desc with
+      | Pctf_inher (ct) ->
+          pp f "@[<2>inherit@ %a@]" self#class_type ct
+      | Pctf_val (s, mf, vf, ct) ->
+          pp f "@[<2>val @ %a%a%s@ :@ %a@]"
+            self#mutable_flag mf self#virtual_flag vf s  self#core_type  ct
+      | Pctf_virt (s, pf, ct) ->    (* todo: test this *)
+          pp f "@[<2>method@ %a@ virtual@ %s@ :@ %a@]"
+            self#private_flag pf s  self#core_type ct
+      | Pctf_meth (s, pf, ct) ->
+          pp f "@[<2>method %a%s :@;%a@]"
+            self#private_flag pf s self#core_type ct
+      | Pctf_cstr (ct1, ct2) ->
+          pp f "@[<2>constraint@ %a@ =@ %a@]"
+            self#core_type ct1 self#core_type ct2 in
+    pp f "@[@[object @[<1>%a@]@ %a@]@ end@]"
+      (fun f ct -> match ct.ptyp_desc with
+      | Ptyp_any -> ()
+      | _ -> pp f "(%a)" self#core_type ct) ct
+      (self#list   class_type_field ~sep:"@;") l  ;
+
+  (* call [class_signature] called by [class_signature] *)
+  method class_type f x =
+    match x.pcty_desc with
+    | Pcty_signature cs -> self#class_signature f cs;
+    | Pcty_constr (li, l) ->
+        pp f "%a%a"
+          (fun f l -> match l with
+          | [] -> ()
+          | _  -> pp f "[%a]@ " (self#list self#core_type ~sep:"," ) l) l
+          self#longident_loc li
+    | Pcty_fun (l, co, cl) ->
+        pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
+          self#type_with_label (l,co) self#class_type cl
+
+
+  (* [class type a = object end] *)
+  method class_type_declaration_list f  l =
+    let class_type_declaration f ({pci_params=(ls,_);pci_name={txt;_};pci_variance;_} as x) =
+      pp f "%a%a%s@ =@ %a" self#virtual_flag x.pci_virt
+        self#class_params_def (List.combine ls pci_variance) txt
+        self#class_type x.pci_expr in
+    match l with
+    | [] -> ()
+    | [h] -> pp f "@[class type %a@]" class_type_declaration   h
+    | _ ->
+        pp f "@[<2>class type %a@]"
+          (self#list class_type_declaration ~sep:"@]@;@[<2>and@;") l
+
+  method class_field f x =
+    match x.pcf_desc with
+    | Pcf_inher (ovf, ce, so) ->
+        pp f "@[<2>inherit@ %s@ %a%a@]"  (override ovf) self#class_expr ce
+          (fun f so -> match so with
+          | None -> ();
+          | Some (s) -> pp f "@ as %s" s ) so
+    | Pcf_val (s, mf, ovf, e) ->
+        pp f "@[<2>val%s %a%s =@;%a@]" (override ovf)  self#mutable_flag mf
+          s.txt  self#expression  e
+    | Pcf_virt (s, pf, ct) ->
+        pp f "@[<2>method virtual %a %s :@;%a@]"
+          self#private_flag pf s.txt self#core_type  ct
+    | Pcf_valvirt (s, mf, ct) ->
+        pp f "@[<2>val virtual %a%s :@ %a@]"
+          self#mutable_flag mf s.txt
+          self#core_type  ct
+    | Pcf_meth (s, pf, ovf, e) ->
+        pp f "@[<2>method%s %a%a@]"
+          (override ovf)
+          self#private_flag pf
+          (fun f e -> match e.pexp_desc with
+          | Pexp_poly (e, Some ct) ->
+              pp f "%s :@;%a=@;%a"
+                s.txt (self#core_type) ct self#expression e
+          | Pexp_poly (e,None) ->
+              self#binding f ({ppat_desc=Ppat_var s;ppat_loc=Location.none} ,e)
+          | _ ->
+              self#expression f e ) e
+    | Pcf_constr (ct1, ct2) ->
+        pp f "@[<2>constraint %a =@;%a@]" self#core_type  ct1 self#core_type  ct2
+    | Pcf_init (e) ->
+        pp f "@[<2>initializer@ %a@]" self#expression e
+
+  method class_structure f { pcstr_pat = p; pcstr_fields =  l } =
+    pp f "@[@[object %a@;%a@]@;end@]"
+      (fun f p -> match p.ppat_desc with
+      | Ppat_any -> ()
+      | Ppat_constraint _ -> pp f "%a"  self#pattern  p
+      | _ -> pp f "(%a)" self#pattern p) p
+      (self#list self#class_field ) l
+
+  method class_expr f x =
+    match x.pcl_desc with
+    | Pcl_structure (cs) ->  self#class_structure f cs ;
+    | Pcl_fun (l, eo, p, e) ->
+        pp f "fun@ %a@ ->@ %a" self#label_exp (l,eo,p)  self#class_expr e
+    | Pcl_let (rf, l, ce) ->
+        (* pp f "let@;%a%a@ in@ %a" *)
+          pp f "%a@ in@ %a"
+          (* self#rec_flag rf *)
+          self#bindings  (rf,l)
+          self#class_expr ce
+    | Pcl_apply (ce, l) ->
+        pp f "(%a@ %a)"  self#class_expr ce (self#list self#label_x_expression_param) l
+    | Pcl_constr (li, l) ->
+        pp f "%a%a"
+          (fun f l-> if l <>[] then
+            pp f "[%a]@ "
+              (self#list self#core_type  ~sep:"," ) l ) l
+          self#longident_loc li
+    | Pcl_constraint (ce, ct) ->
+        pp f "(%a@ :@ %a)"
+          self#class_expr ce
+          self#class_type ct
+
+
+
+  method module_type f x =
+    match x.pmty_desc with
+    | Pmty_ident li ->
+        pp f "%a" self#longident_loc li;
+    | Pmty_signature (s) ->
+        pp f "@[@[sig@ %a@]@ end@]" (* "@[sig@ %a@ end@]" *)
+          (self#list self#signature_item  ) s (* FIXME wrong indentation*)
+    | Pmty_functor (s, mt1, mt2) ->
+        pp f "@[functor@ (%s@ :@ %a)@ ->@ %a@]" s.txt
+          self#module_type mt1  self#module_type mt2
+    | Pmty_with (mt, l) ->
+        let longident_x_with_constraint f (li, wc) =
+          match wc with
+          | Pwith_type ({ptype_params= ls ;_} as td) ->
+              pp f "type@ %a %a =@ %a"
+                (self#list self#type_var_option ~sep:"," ~first:"(" ~last:")")
+                ls self#longident_loc li  self#type_declaration  td
+          | Pwith_module (li2) ->
+              pp f "module %a =@ %a" self#longident_loc li self#longident_loc li2;
+          | Pwith_typesubst ({ptype_params=ls;_} as td) ->
+              pp f "type@ %a %a :=@ %a"
+                (self#list self#type_var_option ~sep:"," ~first:"(" ~last:")")
+                ls self#longident_loc li
+                self#type_declaration  td
+          | Pwith_modsubst (li2) ->
+              pp f "module %a :=@ %a" self#longident_loc li self#longident_loc li2 in
+        (match l with
+        | [] -> pp f "@[%a@]" self#module_type mt
+        | _ -> pp f "@[(%a@ with@ %a)@]"
+              self#module_type mt (self#list longident_x_with_constraint ~sep:"@ and@ ") l )
+    | Pmty_typeof me ->
+        pp f "@[module@ type@ of@ %a@]"
+          self#module_expr me
+  method signature f x =  self#list ~sep:"@\n" self#signature_item f x
+
+  method signature_item f x :unit= begin
+    match x.psig_desc with
+    | Psig_type l ->
+        self#type_def_list f l
+    | Psig_value (s, vd) ->
+        pp f "@[<2>%a@]"
+          (fun f (s,vd) ->
+            let intro = if vd.pval_prim = [] then "val" else "external" in
+            if (is_infix (fixity_of_string s.txt)) || List.mem s.txt.[0] prefix_symbols then
+              pp f "%s@ (@ %s@ )@ :@ " intro s.txt
+            else
+              pp f "%s@ %s@ :@ " intro s.txt;
+            self#value_description f vd;) (s,vd)
+    | Psig_exception (s, ed) ->
+        self#exception_declaration f (s.txt,ed)
+    | Psig_class l ->
+        let class_description f ({pci_params=(ls,_);pci_name={txt;_};pci_variance;_} as x) =
+          pp f "%a%a%s@;:@;%a" (* "@[<2>class %a%a%s@;:@;%a@]" *)
+            self#virtual_flag x.pci_virt
+            self#class_params_def
+            (List.combine ls pci_variance)
+            txt  self#class_type x.pci_expr in
+        pp f  "@[<0>%a@]"
+          (fun f l ->  match l with
+            |[]  ->()
+            |[x] -> pp f "@[<2>class %a@]" class_description x
+            |_ -> self#list ~first:"@[class @[<2>" ~sep:"@]@;and @[" ~last:"@]@]"
+                  class_description f l) l
+    | Psig_module (s, mt) ->
+        pp f "@[module@ %s@ :@ %a@]"
+          s.txt
+          self#module_type  mt
+    | Psig_open (ovf, li) ->
+        pp f "@[open%s@ %a@]" (override ovf) self#longident_loc li
+    | Psig_include (mt) ->
+        pp f "@[include@ %a@]"
+          self#module_type  mt
+    | Psig_modtype (s, md) ->
+        pp f "@[module@ type@ %s%a@]"
+          s.txt
+          (fun f md -> match md with
+          | Pmodtype_abstract -> ()
+          | Pmodtype_manifest (mt) ->
+              pp_print_space f () ;
+              pp f "@ =@ %a"  self#module_type mt
+          ) md
+    | Psig_class_type (l) ->
+        self#class_type_declaration_list f l ;
+    | Psig_recmodule decls ->
+        let rec  string_x_module_type_list f ?(first=true) l =
+          match l with
+          | [] -> () ;
+          | (s,mty) :: tl ->
+              if not first then
+                pp f "@ @[and@ %s:@ %a@]"
+                  s.txt self#module_type mty
+              else
+                pp f "@ @[module@ rec@ %s:@ %a@]"
+                  s.txt self#module_type mty;
+              string_x_module_type_list f ~first:false tl  in
+        string_x_module_type_list f decls
+  end
+  method module_expr f x =
+    match x.pmod_desc with
+    | Pmod_structure (s) ->
+        pp f "@[struct@;@[<0>%a@]@;<1 -2>end@]"
+          (self#list self#structure_item  ~sep:"@\n") s;
+    | Pmod_constraint (me, mt) ->
+        pp f "@[(%a@ :@ %a)@]"
+          self#module_expr  me
+          self#module_type mt
+    | Pmod_ident (li) ->
+        pp f "%a" self#longident_loc li;
+    | Pmod_functor (s, mt, me) ->
+        pp f "functor@ (%s@ :@ %a)@;->@;%a"
+          s.txt  self#module_type mt  self#module_expr me
+    | Pmod_apply (me1, me2) ->
+        pp f "%a(%a)" self#module_expr me1  self#module_expr  me2
+    | Pmod_unpack e ->
+        pp f "(val@ %a)"  self#expression  e
+
+  method structure f x = self#list ~sep:"@\n" self#structure_item f x
+
+  (* transform [f = fun g h -> ..] to [f g h = ... ] could be improved *)
+  method binding f ((p:pattern),(x:expression)) =
+    let rec pp_print_pexp_function f x =
+      match x.pexp_desc with
+      | Pexp_function (label,eo,[(p,e)]) ->
+          if label="" then
+            match e.pexp_desc with
+            | Pexp_when _  -> pp f "=@;%a" self#expression x
+            | _ ->
+                pp f "%a@ %a" self#simple_pattern p pp_print_pexp_function e
+          else
+            pp f "%a@ %a" self#label_exp (label,eo,p) pp_print_pexp_function e
+      | Pexp_newtype (str,e) ->
+          pp f "(type@ %s)@ %a" str pp_print_pexp_function e
+      | _ -> pp f "=@;%a" self#expression x in
+    match (x.pexp_desc,p.ppat_desc) with
+    | (Pexp_when (e1,e2),_) ->
+        pp f "=@[<2>fun@ %a@ when@ %a@ ->@ %a@]"
+          self#simple_pattern p self#expression e1 self#expression e2
+    | ( _ , Ppat_constraint( p ,ty)) -> (* special case for the first*)
+        (match ty.ptyp_desc with
+        | Ptyp_poly _ ->
+            pp f "%a@;:@;%a=@;%a" self#simple_pattern p  self#core_type ty self#expression x
+        | _ ->
+            pp f "(%a@;:%a)=@;%a" self#simple_pattern p  self#core_type ty self#expression x)
+    | Pexp_constraint (e,Some t1,None),Ppat_var {txt;_} ->
+        pp f "%s:@ %a@;=@;%a" txt self#core_type t1  self#expression e
+    | (_, Ppat_var _) ->
+        pp f "%a@ %a" self#simple_pattern p pp_print_pexp_function x
+    | _ ->
+        pp f "%a@;=@;%a" self#pattern p self#expression x
+  (* [in] is not printed *)
+  method bindings f (rf,l) =
+    begin match l with
+    | [] -> ()
+    | [x] -> pp f "@[<2>let %a%a@]" self#rec_flag rf self#binding x
+    | x::xs ->
+        (* pp f "@[let %a@[<2>%a%a@]" *)
+        (* FIXME the indentation is not good see [Insert].ml*)
+        pp f "@[@[<2>let %a%a%a@]"
+          self#rec_flag rf  self#binding x
+          (fun f l -> match l with
+          | [] -> assert false
+          | [x] ->
+              pp f
+                (* "@]@;and @[<2>%a@]" *)
+                "@]@;@[<2>and %a@]"
+                self#binding x
+          | xs ->
+              self#list self#binding
+                (* ~first:"@]@;and @[<2>" *)
+                ~first:"@]@;@[<2>and "
+                (* ~sep:"@]@;and @[<2>" *)
+                ~sep:"@]@;@[<2>and "
+                ~last:"@]" f xs )  xs
+    end
+
+  method structure_item f x = begin
+    match x.pstr_desc with
+    | Pstr_eval (e) ->
+        pp f "@[let@ _ =@ %a@]" self#expression e
+    | Pstr_type [] -> assert false
+    | Pstr_type l  -> self#type_def_list f l
+    | Pstr_value (rf, l) -> (* pp f "@[let %a%a@]"  self#rec_flag rf self#bindings l *)
+        pp f "@[<2>%a@]" self#bindings (rf,l)
+    | Pstr_exception (s, ed) -> self#exception_declaration f (s.txt,ed)
+    | Pstr_module (s, me) ->
+        let rec module_helper me = match me.pmod_desc with
+        | Pmod_functor(s,mt,me) ->
+            pp f "(%s:%a)"  s.txt  self#module_type mt ;
+            module_helper me
+        | _ -> me in
+        pp f "@[module %s%a@]"
+          s.txt
+          (fun f me ->
+            let me = module_helper me  in
+            (match me.pmod_desc with
+            | Pmod_constraint
+                (me,
+                 ({pmty_desc=(Pmty_ident (_)
+            | Pmty_signature (_));_} as mt)) ->
+                pp f " :@;%a@;=@;%a@;"  self#module_type mt self#module_expr  me
+            | _ ->
+                pp f " =@ %a"  self#module_expr  me
+            )) me
+    | Pstr_open (ovf, li) ->
+        pp f "@[<2>open%s@;%a@]" (override ovf) self#longident_loc li;
+    | Pstr_modtype (s, mt) ->
+        pp f "@[<2>module type %s =@;%a@]" s.txt self#module_type mt
+    | Pstr_class l ->
+        let class_declaration f  (* for the second will be changed to and FIXME*)
+            ({pci_params=(ls,_);
+              pci_name={txt;_};
+              pci_virt;
+              pci_expr={pcl_desc;_};
+              pci_variance;_ } as x) =
+          let ls = List.combine ls pci_variance in
+          let rec  class_fun_helper f e = match e.pcl_desc with
+          | Pcl_fun (l, eo, p, e) ->
+              self#label_exp f (l,eo,p);
+              class_fun_helper f e
+          | _ -> e in
+          pp f "%a%a%s %a"  self#virtual_flag pci_virt self#class_params_def ls txt
+            (fun f _ ->
+              let ce =
+                (match pcl_desc with
+                | Pcl_fun _ ->
+                    class_fun_helper f x.pci_expr;
+                | _ -> x.pci_expr) in
+              let ce =
+                (match ce.pcl_desc with
+                | Pcl_constraint (ce, ct) ->
+                    pp f ": @[%a@] " self#class_type  ct ;
+                    ce
+                | _ -> ce ) in
+              pp f "=@;%a" self#class_expr ce ) x in
+        (match l with
+        | [] -> ()
+        | [x] -> pp f "@[<2>class %a@]" class_declaration x
+        | xs ->  self#list
+              ~first:"@[class @[<2>"
+              ~sep:"@]@;and @["
+              ~last:"@]@]" class_declaration f xs)
+    | Pstr_class_type (l) ->
+        self#class_type_declaration_list f l ;
+    | Pstr_primitive (s, vd) ->
+        let need_parens =
+          match s.txt with
+          | "or" | "mod" | "land"| "lor" | "lxor" | "lsl" | "lsr" | "asr" -> true
+          | _ -> match s.txt.[0] with
+              'a'..'z' -> false | _ -> true in
+        pp f "@[external@ %s@ :@ %a@]"
+          (if need_parens then "( "^s.txt^" )" else s.txt)
+          self#value_description  vd
+    | Pstr_include me ->
+        pp f "@[include@ %a@]"  self#module_expr  me
+    | Pstr_exn_rebind (s, li) ->        (* todo: check this *)
+        pp f "@[exception@ %s@ =@ %a@]" s.txt self#longident_loc li
+    | Pstr_recmodule decls -> (* 3.07 *)
+        let text_x_modtype_x_module f (s, mt, me) =
+          pp f "@[and@ %s:%a@ =@ %a@]"
+            s.txt self#module_type mt self#module_expr me
+        in match decls with
+        | (s,mt,me):: l2 ->
+            pp f "@[@[module@ rec@ %s:%a@ =@ %a@]@ %a@]"
+              s.txt
+              self#module_type mt
+              self#module_expr me
+              (fun f l2 -> List.iter (text_x_modtype_x_module f) l2) l2
+        | _ -> assert false
+  end
+  method type_param f  = function
+    | (a,opt) -> pp f "%s%a" (type_variance a ) self#type_var_option opt
+          (* shared by [Pstr_type,Psig_type]*)
+  method  type_def_list f  l =
+    let aux f (s, ({ptype_params;ptype_kind;ptype_manifest;ptype_variance;_} as td )) =
+      let ptype_params = List.combine  ptype_variance ptype_params in
+      pp f "%a%s%a"
+        (fun f l -> match l with
+        |[] -> ()
+        | _ ->  pp f "%a@;" (self#list self#type_param ~first:"(" ~last:")" ~sep:",") l)
+        ptype_params s.txt
+        (fun f td ->begin match ptype_kind, ptype_manifest with
+        | Ptype_abstract, None -> ()
+        | _ , _ -> pp f " =@;" end;
+          pp f "%a" self#type_declaration td ) td  in
+    match l with
+    | [] -> () ;
+    | [x] -> pp f "@[<2>type %a@]" aux x
+    | xs -> pp f "@[@[<2>type %a"
+          (self#list aux ~sep:"@]@,@[<2>and " ~last:"@]@]") xs
+          (* called by type_def_list *)
+  method type_declaration f x = begin
+    let  type_variant_leaf f  (s, l,gadt, _loc)  = match gadt with
+    |None ->
+        pp f "@\n|@;%s%a" s.txt
+          (fun f l -> match l with
+          | [] -> ()
+          | _ -> pp f "@;of@;%a" (self#list self#core_type1 ~sep:"*@;") l) l
+    |Some x ->
+        pp f "@\n|@;%s:@;%a" s.txt
+          (self#list self#core_type1 ~sep:"@;->@;") (l@[x]) in
+    pp f "%a%a@ %a"
+      (fun f x -> match (x.ptype_manifest,x.ptype_kind,x.ptype_private) with
+      | (None,_,Public) ->  pp f "@;"
+      | (None,Ptype_abstract,Private) -> pp f "@;" (* private type without print*)
+      | (None,_,Private) -> pp f "private@;"
+      | (Some y, Ptype_abstract,Private) ->
+          pp f "private@;%a" self#core_type y;
+      | (Some y, _, Private) ->
+          pp f "%a = private@;" self#core_type y
+      | (Some y,Ptype_abstract, Public) ->  self#core_type f y;
+      | (Some y, _,Public) -> begin
+          pp f "%a =@;" self#core_type y (* manifest types*)
+      end) x
+      (fun f x -> match x.ptype_kind with
+        (*here only normal variant types allowed here*)
+      | Ptype_variant xs ->
+          pp f "%a"
+            (self#list ~sep:"" type_variant_leaf) xs
+      | Ptype_abstract -> ()
+      | Ptype_record l ->
+          let type_record_field f (s, mf, ct,_) =
+            pp f "@[<2>%a%s:@;%a@]" self#mutable_flag mf s.txt self#core_type ct in
+          pp f "{@\n%a}"
+            (self#list type_record_field ~sep:";@\n" )  l ;
+      ) x
+      (self#list
+         (fun f (ct1,ct2,_) ->
+           pp f "@[constraint@ %a@ =@ %a@]"
+             self#core_type ct1 self#core_type ct2 ))  x.ptype_cstrs  ;
+  end
+  method case_list f (l:(pattern * expression) list) :unit=
+    let aux f (p,e) =
+      let (e,w) =
+        (match e with
+        | {pexp_desc = Pexp_when (e1, e2);_} -> (e2, Some (e1))
+        | _ -> (e, None)) in
+      pp f "@;| @[<2>%a%a@;->@;%a@]"
+        self#pattern p (self#option self#expression ~first:"@;when@;") w self#under_pipe#expression e in
+    self#list aux f l ~sep:""
+  method label_x_expression_param f (l,e) =
+    match l with
+    | ""  -> self#expression2 f e ; (* level 2*)
+    | lbl ->
+        let simple_name = match e.pexp_desc with
+        | Pexp_ident {txt=Lident l;_} -> Some l
+        | _ -> None in
+        if  lbl.[0] = '?' then
+          let str = String.sub lbl 1 (String.length lbl-1) in
+          if Some str = simple_name then
+            pp f "%s" lbl
+          else
+            pp f "%s:%a" lbl self#simple_expr e
+        else
+          if Some lbl = simple_name then
+            pp f "~%s" lbl
+          else
+            pp f "~%s:%a" lbl self#simple_expr e
+
+  method directive_argument f x =
+    (match x with
+    | Pdir_none -> ()
+    | Pdir_string (s) -> pp f "@ %S" s
+    | Pdir_int (i) -> pp f "@ %d" i
+    | Pdir_ident (li) -> pp f "@ %a" self#longident li
+    | Pdir_bool (b) -> pp f "@ %s" (string_of_bool b))
+
+  method toplevel_phrase f x =
+    match x with
+    | Ptop_def (s) ->
+        pp_open_hvbox f 0;
+        self#list self#structure_item f s ;
+        pp_close_box f ();
+    | Ptop_dir (s, da) ->
+        pp f "@[#%s@ %a@]" s self#directive_argument da
+end;;
+
+
+let default = new printer ()
+
+
+let toplevel_phrase f x =
+  match x with
+  | Ptop_def (s) ->pp f "@[%a@]"  (default#list default#structure_item) s
+   (* pp_open_hvbox f 0; *)
+   (* pp_print_list structure_item f s ; *)
+   (* pp_close_box f (); *)
+  | Ptop_dir (s, da) ->
+   pp f "@[#%s@ %a@]" s default#directive_argument da
+   (* pp f "@[#%s@ %a@]" s directive_argument da *)
+
+let expression f x =
+  pp f "@[%a@]" default#expression x
+
+
+let string_of_expression x =
+  ignore (flush_str_formatter ()) ;
+  let f = str_formatter in
+  default#expression f x ;
+  flush_str_formatter () ;;
+let string_of_structure x =
+  ignore (flush_str_formatter ());
+  let f = str_formatter in
+  default#structure f x;
+  flush_str_formatter ();;
+
+let top_phrase f x =
+  pp_print_newline f () ;
+  toplevel_phrase f x;
+  pp f ";;" ;
+  pp_print_newline f ();;
+
+let core_type=default#core_type
+let pattern=default#pattern
+let signature=default#signature
+let structure=default#structure
diff -Nru ocaml-3.12.1/parsing/pprintast.mli ocaml-4.01.0/parsing/pprintast.mli
--- ocaml-3.12.1/parsing/pprintast.mli	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/parsing/pprintast.mli	2013-04-04 15:25:42.000000000 +0000
@@ -0,0 +1,129 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Hongbo Zhang (University of Pennsylvania)                *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+type space_formatter = (unit, Format.formatter, unit) format
+class printer :
+  unit ->
+  object ('b)
+    val pipe : bool
+    val semi : bool
+    method binding :
+      Format.formatter -> Parsetree.pattern * Parsetree.expression -> unit
+    method bindings:
+        Format.formatter ->
+          Asttypes.rec_flag * (Parsetree.pattern * Parsetree.expression) list ->
+            unit
+    method case_list :
+      Format.formatter ->
+      (Parsetree.pattern * Parsetree.expression) list -> unit
+    method class_expr : Format.formatter -> Parsetree.class_expr -> unit
+    method class_field : Format.formatter -> Parsetree.class_field -> unit
+    method class_params_def :
+      Format.formatter -> (string Asttypes.loc * (bool * bool)) list -> unit
+    method class_signature :
+      Format.formatter -> Parsetree.class_signature -> unit
+    method class_structure :
+      Format.formatter -> Parsetree.class_structure -> unit
+    method class_type : Format.formatter -> Parsetree.class_type -> unit
+    method class_type_declaration_list :
+      Format.formatter -> Parsetree.class_type_declaration list -> unit
+    method constant : Format.formatter -> Asttypes.constant -> unit
+    method constant_string : Format.formatter -> string -> unit
+    method core_type : Format.formatter -> Parsetree.core_type -> unit
+    method core_type1 : Format.formatter -> Parsetree.core_type -> unit
+    method direction_flag :
+      Format.formatter -> Asttypes.direction_flag -> unit
+    method directive_argument :
+      Format.formatter -> Parsetree.directive_argument -> unit
+    method exception_declaration :
+      Format.formatter -> string * Parsetree.exception_declaration -> unit
+    method expression : Format.formatter -> Parsetree.expression -> unit
+    method expression1 : Format.formatter -> Parsetree.expression -> unit
+    method expression2 : Format.formatter -> Parsetree.expression -> unit
+    method label_exp :
+      Format.formatter ->
+      Asttypes.label * Parsetree.expression option * Parsetree.pattern ->
+      unit
+    method label_x_expression_param :
+      Format.formatter -> Asttypes.label * Parsetree.expression -> unit
+    method list :
+      ?sep:space_formatter ->
+      ?first:space_formatter ->
+      ?last:space_formatter ->
+      (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a list -> unit
+    method longident : Format.formatter -> Longident.t -> unit
+    method longident_loc :
+      Format.formatter -> Longident.t Asttypes.loc -> unit
+    method module_expr : Format.formatter -> Parsetree.module_expr -> unit
+    method module_type : Format.formatter -> Parsetree.module_type -> unit
+    method mutable_flag : Format.formatter -> Asttypes.mutable_flag -> unit
+    method option :
+      ?first:space_formatter ->
+      ?last:space_formatter ->
+      (Format.formatter -> 'a -> unit) ->
+      Format.formatter -> 'a option -> unit
+    method paren :
+        ?first:space_formatter -> ?last:space_formatter -> bool ->
+          (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a -> unit
+    method pattern : Format.formatter -> Parsetree.pattern -> unit
+    method pattern1 : Format.formatter -> Parsetree.pattern -> unit
+    method private_flag : Format.formatter -> Asttypes.private_flag -> unit
+    method rec_flag : Format.formatter -> Asttypes.rec_flag -> unit
+
+    method reset : 'b
+    method reset_semi : 'b
+    method reset_ifthenelse : 'b
+    method reset_pipe : 'b
+
+    method signature :
+      Format.formatter -> Parsetree.signature_item list -> unit
+    method signature_item :
+      Format.formatter -> Parsetree.signature_item -> unit
+    method simple_expr : Format.formatter -> Parsetree.expression -> unit
+    method simple_pattern : Format.formatter -> Parsetree.pattern -> unit
+    method string_quot : Format.formatter -> Asttypes.label -> unit
+    method structure :
+      Format.formatter -> Parsetree.structure_item list -> unit
+    method structure_item :
+      Format.formatter -> Parsetree.structure_item -> unit
+    method sugar_expr : Format.formatter -> Parsetree.expression -> bool
+    method toplevel_phrase :
+      Format.formatter -> Parsetree.toplevel_phrase -> unit
+    method type_declaration :
+      Format.formatter -> Parsetree.type_declaration -> unit
+    method type_def_list :
+      Format.formatter ->
+      (string Asttypes.loc * Parsetree.type_declaration) list -> unit
+    method type_param :
+      Format.formatter -> (bool * bool) * string Asttypes.loc option -> unit
+    method type_var_option :
+      Format.formatter -> string Asttypes.loc option -> unit
+    method type_with_label :
+      Format.formatter -> Asttypes.label * Parsetree.core_type -> unit
+    method tyvar : Format.formatter -> string -> unit
+    method under_pipe : 'b
+    method under_semi : 'b
+    method under_ifthenelse : 'b
+    method value_description :
+      Format.formatter -> Parsetree.value_description -> unit
+    method virtual_flag : Format.formatter -> Asttypes.virtual_flag -> unit
+  end
+val default : printer
+val toplevel_phrase : Format.formatter -> Parsetree.toplevel_phrase -> unit
+val expression : Format.formatter -> Parsetree.expression -> unit
+val string_of_expression : Parsetree.expression -> string
+val top_phrase: Format.formatter -> Parsetree.toplevel_phrase -> unit
+val core_type: Format.formatter -> Parsetree.core_type -> unit
+val pattern: Format.formatter -> Parsetree.pattern -> unit
+val signature: Format.formatter -> Parsetree.signature -> unit
+val structure: Format.formatter -> Parsetree.structure -> unit
+val string_of_structure: Parsetree.structure -> string
diff -Nru ocaml-3.12.1/parsing/printast.ml ocaml-4.01.0/parsing/printast.ml
--- ocaml-3.12.1/parsing/printast.ml	2010-04-17 14:45:12.000000000 +0000
+++ ocaml-4.01.0/parsing/printast.ml	2013-05-16 13:34:53.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*             Damien Doligez, projet Para, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,25 +10,24 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: printast.ml 10263 2010-04-17 14:45:12Z garrigue $ *)
-
 open Asttypes;;
 open Format;;
 open Lexing;;
 open Location;;
 open Parsetree;;
 
-let fmt_position f l =
-  if l.pos_fname = "" && l.pos_lnum = 1
-  then fprintf f "%d" l.pos_cnum
-  else if l.pos_lnum = -1
-  then fprintf f "%s[%d]" l.pos_fname l.pos_cnum
-  else fprintf f "%s[%d,%d+%d]" l.pos_fname l.pos_lnum l.pos_bol
+let fmt_position with_name f l =
+  let fname = if with_name then l.pos_fname else "" in
+  if l.pos_lnum = -1
+  then fprintf f "%s[%d]" fname l.pos_cnum
+  else fprintf f "%s[%d,%d+%d]" fname l.pos_lnum l.pos_bol
                (l.pos_cnum - l.pos_bol)
 ;;
 
 let fmt_location f loc =
-  fprintf f "(%a..%a)" fmt_position loc.loc_start fmt_position loc.loc_end;
+  let p_2nd_name = loc.loc_start.pos_fname <> loc.loc_end.pos_fname in
+  fprintf f "(%a..%a)" (fmt_position true) loc.loc_start
+                       (fmt_position p_2nd_name) loc.loc_end;
   if loc.loc_ghost then fprintf f " ghost";
 ;;
 
@@ -42,6 +41,14 @@
 
 let fmt_longident f x = fprintf f "\"%a\"" fmt_longident_aux x;;
 
+let fmt_longident_loc f x =
+  fprintf f "\"%a\" %a" fmt_longident_aux x.txt fmt_location x.loc;
+;;
+
+let fmt_string_loc f x =
+  fprintf f "\"%s\" %a" x.txt fmt_location x.loc;
+;;
+
 let fmt_constant f x =
   match x with
   | Const_int (i) -> fprintf f "Const_int %d" i;
@@ -91,14 +98,14 @@
 ;;
 
 let line i f s (*...*) =
-  fprintf f "%s" (String.make (2*i) ' ');
+  fprintf f "%s" (String.make ((2*i) mod 72) ' ');
   fprintf f s (*...*)
 ;;
 
 let list i f ppf l =
   match l with
   | [] -> line i ppf "[]\n";
-  | h::t ->
+  | _ :: _ ->
      line i ppf "[\n";
      List.iter (f (i+1) ppf) l;
      line i ppf "]\n";
@@ -112,8 +119,9 @@
       f (i+1) ppf x;
 ;;
 
-let longident i ppf li = line i ppf "%a\n" fmt_longident li;;
+let longident_loc i ppf li = line i ppf "%a\n" fmt_longident_loc li;;
 let string i ppf s = line i ppf "\"%s\"\n" s;;
+let string_loc i ppf s = line i ppf "%a\n" fmt_string_loc s;;
 let bool i ppf x = line i ppf "%s\n" (string_of_bool x);;
 let label i ppf x = line i ppf "label=\"%s\"\n" x;;
 
@@ -132,7 +140,7 @@
       line i ppf "Ptyp_tuple\n";
       list i core_type ppf l;
   | Ptyp_constr (li, l) ->
-      line i ppf "Ptyp_constr %a\n" fmt_longident li;
+      line i ppf "Ptyp_constr %a\n" fmt_longident_loc li;
       list i core_type ppf l;
   | Ptyp_variant (l, closed, low) ->
       line i ppf "Ptyp_variant closed=%s\n" (string_of_bool closed);
@@ -142,7 +150,7 @@
       line i ppf "Ptyp_object\n";
       list i core_field_type ppf l;
   | Ptyp_class (li, l, low) ->
-      line i ppf "Ptyp_class %a\n" fmt_longident li;
+      line i ppf "Ptyp_class %a\n" fmt_longident_loc li;
       list i core_type ppf l;
       list i string ppf low
   | Ptyp_alias (ct, s) ->
@@ -153,11 +161,11 @@
         (fun ppf -> List.iter (fun x -> fprintf ppf " '%s" x)) sl;
       core_type i ppf ct;
   | Ptyp_package (s, l) ->
-      line i ppf "Ptyp_package %a\n" fmt_longident s;
-      list i package_with ppf l
+      line i ppf "Ptyp_package %a\n" fmt_longident_loc s;
+      list i package_with ppf l;
 
 and package_with i ppf (s, t) =
-  line i ppf "with type %s\n" s;
+  line i ppf "with type %a\n" fmt_longident_loc s;
   core_type i ppf t
 
 and core_field_type i ppf x =
@@ -174,16 +182,16 @@
   let i = i+1 in
   match x.ppat_desc with
   | Ppat_any -> line i ppf "Ppat_any\n";
-  | Ppat_var (s) -> line i ppf "Ppat_var \"%s\"\n" s;
+  | Ppat_var (s) -> line i ppf "Ppat_var %a\n" fmt_string_loc s;
   | Ppat_alias (p, s) ->
-      line i ppf "Ppat_alias \"%s\"\n" s;
+      line i ppf "Ppat_alias %a\n" fmt_string_loc s;
       pattern i ppf p;
   | Ppat_constant (c) -> line i ppf "Ppat_constant %a\n" fmt_constant c;
   | Ppat_tuple (l) ->
       line i ppf "Ppat_tuple\n";
       list i pattern ppf l;
   | Ppat_construct (li, po, b) ->
-      line i ppf "Ppat_construct %a\n" fmt_longident li;
+      line i ppf "Ppat_construct %a\n" fmt_longident_loc li;
       option i pattern ppf po;
       bool i ppf b;
   | Ppat_variant (l, po) ->
@@ -203,18 +211,20 @@
       line i ppf "Ppat_lazy\n";
       pattern i ppf p;
   | Ppat_constraint (p, ct) ->
-      line i ppf "Ppat_constraint";
+      line i ppf "Ppat_constraint\n";
       pattern i ppf p;
       core_type i ppf ct;
-  | Ppat_type li ->
-      line i ppf "Ppat_type";
-      longident i ppf li
+  | Ppat_type (li) ->
+      line i ppf "Ppat_type\n";
+      longident_loc i ppf li
+  | Ppat_unpack s ->
+      line i ppf "Ppat_unpack %a\n" fmt_string_loc s;
 
 and expression i ppf x =
   line i ppf "expression %a\n" fmt_location x.pexp_loc;
   let i = i+1 in
   match x.pexp_desc with
-  | Pexp_ident (li) -> line i ppf "Pexp_ident %a\n" fmt_longident li;
+  | Pexp_ident (li) -> line i ppf "Pexp_ident %a\n" fmt_longident_loc li;
   | Pexp_constant (c) -> line i ppf "Pexp_constant %a\n" fmt_constant c;
   | Pexp_let (rf, l, e) ->
       line i ppf "Pexp_let %a\n" fmt_rec_flag rf;
@@ -240,7 +250,7 @@
       line i ppf "Pexp_tuple\n";
       list i expression ppf l;
   | Pexp_construct (li, eo, b) ->
-      line i ppf "Pexp_construct %a\n" fmt_longident li;
+      line i ppf "Pexp_construct %a\n" fmt_longident_loc li;
       option i expression ppf eo;
       bool i ppf b;
   | Pexp_variant (l, eo) ->
@@ -253,11 +263,11 @@
   | Pexp_field (e, li) ->
       line i ppf "Pexp_field\n";
       expression i ppf e;
-      longident i ppf li;
+      longident_loc i ppf li;
   | Pexp_setfield (e1, li, e2) ->
       line i ppf "Pexp_setfield\n";
       expression i ppf e1;
-      longident i ppf li;
+      longident_loc i ppf li;
       expression i ppf e2;
   | Pexp_array (l) ->
       line i ppf "Pexp_array\n";
@@ -276,7 +286,7 @@
       expression i ppf e1;
       expression i ppf e2;
   | Pexp_for (s, e1, e2, df, e3) ->
-      line i ppf "Pexp_for \"%s\" %a\n" s fmt_direction_flag df;
+      line i ppf "Pexp_for %a %a\n" fmt_direction_flag df fmt_string_loc s;
       expression i ppf e1;
       expression i ppf e2;
       expression i ppf e3;
@@ -292,53 +302,60 @@
   | Pexp_send (e, s) ->
       line i ppf "Pexp_send \"%s\"\n" s;
       expression i ppf e;
-  | Pexp_new (li) -> line i ppf "Pexp_new %a\n" fmt_longident li;
+  | Pexp_new (li) -> line i ppf "Pexp_new %a\n" fmt_longident_loc li;
   | Pexp_setinstvar (s, e) ->
-      line i ppf "Pexp_setinstvar \"%s\"\n" s;
+      line i ppf "Pexp_setinstvar %a\n" fmt_string_loc s;
       expression i ppf e;
   | Pexp_override (l) ->
       line i ppf "Pexp_override\n";
       list i string_x_expression ppf l;
   | Pexp_letmodule (s, me, e) ->
-      line i ppf "Pexp_letmodule \"%s\"\n" s;
+      line i ppf "Pexp_letmodule %a\n" fmt_string_loc s;
       module_expr i ppf me;
       expression i ppf e;
   | Pexp_assert (e) ->
-      line i ppf "Pexp_assert";
+      line i ppf "Pexp_assert\n";
       expression i ppf e;
   | Pexp_assertfalse ->
-      line i ppf "Pexp_assertfalse";
+      line i ppf "Pexp_assertfalse\n";
   | Pexp_lazy (e) ->
-      line i ppf "Pexp_lazy";
+      line i ppf "Pexp_lazy\n";
       expression i ppf e;
   | Pexp_poly (e, cto) ->
       line i ppf "Pexp_poly\n";
       expression i ppf e;
       option i core_type ppf cto;
   | Pexp_object s ->
-      line i ppf "Pexp_object";
+      line i ppf "Pexp_object\n";
       class_structure i ppf s
   | Pexp_newtype (s, e) ->
       line i ppf "Pexp_newtype \"%s\"\n" s;
       expression i ppf e
-  | Pexp_pack (me, (p,l)) ->
-      line i ppf "Pexp_pack %a" fmt_longident p;
-      list i package_with ppf l;
+  | Pexp_pack me ->
+      line i ppf "Pexp_pack\n";
       module_expr i ppf me
-  | Pexp_open (m, e) ->
-      line i ppf "Pexp_open \"%a\"\n" fmt_longident m;
+  | Pexp_open (ovf, m, e) ->
+      line i ppf "Pexp_open %a \"%a\"\n" fmt_override_flag ovf
+        fmt_longident_loc m;
       expression i ppf e
 
 and value_description i ppf x =
-  line i ppf "value_description\n";
+  line i ppf "value_description %a\n" fmt_location x.pval_loc;
   core_type (i+1) ppf x.pval_type;
   list (i+1) string ppf x.pval_prim;
 
+and string_option_underscore i ppf =
+  function
+    | Some x ->
+        string_loc i ppf x
+    | None ->
+        string i ppf "_"
+
 and type_declaration i ppf x =
   line i ppf "type_declaration %a\n" fmt_location x.ptype_loc;
   let i = i+1 in
   line i ppf "ptype_params =\n";
-  list (i+1) string ppf x.ptype_params;
+  list (i+1) string_option_underscore ppf x.ptype_params;
   line i ppf "ptype_cstrs =\n";
   list (i+1) core_type_x_core_type_x_location ppf x.ptype_cstrs;
   line i ppf "ptype_kind =\n";
@@ -365,7 +382,7 @@
   let i = i+1 in
   match x.pcty_desc with
   | Pcty_constr (li, l) ->
-      line i ppf "Pcty_constr %a\n" fmt_longident li;
+      line i ppf "Pcty_constr %a\n" fmt_longident_loc li;
       list i core_type ppf l;
   | Pcty_signature (cs) ->
       line i ppf "Pcty_signature\n";
@@ -375,33 +392,32 @@
       core_type i ppf co;
       class_type i ppf cl;
 
-and class_signature i ppf (ct, l) =
-  line i ppf "class_signature\n";
-  core_type (i+1) ppf ct;
-  list (i+1) class_type_field ppf l;
+and class_signature i ppf cs =
+  line i ppf "class_signature %a\n" fmt_location cs.pcsig_loc;
+  core_type (i+1) ppf cs.pcsig_self;
+  list (i+1) class_type_field ppf cs.pcsig_fields;
 
 and class_type_field i ppf x =
-  match x with
+  line i ppf "class_type_field %a\n" fmt_location x.pctf_loc;
+  let i = i+1 in
+  match x.pctf_desc with
   | Pctf_inher (ct) ->
       line i ppf "Pctf_inher\n";
       class_type i ppf ct;
-  | Pctf_val (s, mf, vf, ct, loc) ->
-      line i ppf
-        "Pctf_val \"%s\" %a %a %a\n" s
-        fmt_mutable_flag mf fmt_virtual_flag vf fmt_location loc;
+  | Pctf_val (s, mf, vf, ct) ->
+      line i ppf "Pctf_val \"%s\" %a %a\n" s fmt_mutable_flag mf
+           fmt_virtual_flag vf;
       core_type (i+1) ppf ct;
-  | Pctf_virt (s, pf, ct, loc) ->
-      line i ppf
-        "Pctf_virt \"%s\" %a %a\n" s fmt_private_flag pf fmt_location loc;
+  | Pctf_virt (s, pf, ct) ->
+      line i ppf "Pctf_virt \"%s\" %a\n" s fmt_private_flag pf;
       core_type (i+1) ppf ct;
-  | Pctf_meth (s, pf, ct, loc) ->
-      line i ppf
-        "Pctf_meth \"%s\" %a %a\n" s fmt_private_flag pf fmt_location loc;
+  | Pctf_meth (s, pf, ct) ->
+      line i ppf "Pctf_meth \"%s\" %a\n" s fmt_private_flag pf;
       core_type (i+1) ppf ct;
-  | Pctf_cstr (ct1, ct2, loc) ->
-      line i ppf "Pctf_cstr %a\n" fmt_location loc;
-      core_type i ppf ct1;
-      core_type i ppf ct2;
+  | Pctf_cstr (ct1, ct2) ->
+      line i ppf "Pctf_cstr\n";
+      core_type (i+1) ppf ct1;
+      core_type (i+1) ppf ct2;
 
 and class_description i ppf x =
   line i ppf "class_description %a\n" fmt_location x.pci_loc;
@@ -409,7 +425,7 @@
   line i ppf "pci_virt = %a\n" fmt_virtual_flag x.pci_virt;
   line i ppf "pci_params =\n";
   string_list_x_location (i+1) ppf x.pci_params;
-  line i ppf "pci_name = \"%s\"\n" x.pci_name;
+  line i ppf "pci_name = %a\n" fmt_string_loc x.pci_name;
   line i ppf "pci_expr =\n";
   class_type (i+1) ppf x.pci_expr;
 
@@ -419,7 +435,7 @@
   line i ppf "pci_virt = %a\n" fmt_virtual_flag x.pci_virt;
   line i ppf "pci_params =\n";
   string_list_x_location (i+1) ppf x.pci_params;
-  line i ppf "pci_name = \"%s\"\n" x.pci_name;
+  line i ppf "pci_name = %a\n" fmt_string_loc x.pci_name;
   line i ppf "pci_expr =\n";
   class_type (i+1) ppf x.pci_expr;
 
@@ -428,7 +444,7 @@
   let i = i+1 in
   match x.pcl_desc with
   | Pcl_constr (li, l) ->
-      line i ppf "Pcl_constr %a\n" fmt_longident li;
+      line i ppf "Pcl_constr %a\n" fmt_longident_loc li;
       list i core_type ppf l;
   | Pcl_structure (cs) ->
       line i ppf "Pcl_structure\n";
@@ -452,40 +468,39 @@
       class_expr i ppf ce;
       class_type i ppf ct;
 
-and class_structure i ppf (p, l) =
+and class_structure i ppf { pcstr_pat = p; pcstr_fields = l } =
   line i ppf "class_structure\n";
   pattern (i+1) ppf p;
   list (i+1) class_field ppf l;
 
 and class_field i ppf x =
-  match x with
+  line i ppf "class_field %a\n" fmt_location x.pcf_loc;
+  let i = i + 1 in
+  match x.pcf_desc with
   | Pcf_inher (ovf, ce, so) ->
       line i ppf "Pcf_inher %a\n" fmt_override_flag ovf;
       class_expr (i+1) ppf ce;
       option (i+1) string ppf so;
-  | Pcf_valvirt (s, mf, ct, loc) ->
-      line i ppf "Pcf_valvirt \"%s\" %a %a\n"
-        s fmt_mutable_flag mf fmt_location loc;
+  | Pcf_valvirt (s, mf, ct) ->
+      line i ppf "Pcf_valvirt %a\n" fmt_mutable_flag mf;
+      line (i+1) ppf "%a\n" fmt_string_loc s;
       core_type (i+1) ppf ct;
-  | Pcf_val (s, mf, ovf, e, loc) ->
-      line i ppf "Pcf_val \"%s\" %a %a %a\n"
-        s fmt_mutable_flag mf fmt_override_flag ovf fmt_location loc;
+  | Pcf_val (s, mf, ovf, e) ->
+      line i ppf "Pcf_val %a %a\n" fmt_mutable_flag mf fmt_override_flag ovf;
+      line (i+1) ppf "%a\n" fmt_string_loc s;
       expression (i+1) ppf e;
-  | Pcf_virt (s, pf, ct, loc) ->
-      line i ppf "Pcf_virt \"%s\" %a %a\n"
-        s fmt_private_flag pf fmt_location loc;
+  | Pcf_virt (s, pf, ct) ->
+      line i ppf "Pcf_virt %a\n" fmt_private_flag pf;
+      line (i+1) ppf "%a\n" fmt_string_loc s;
       core_type (i+1) ppf ct;
-  | Pcf_meth (s, pf, ovf, e, loc) ->
-      line i ppf "Pcf_meth \"%s\" %a %a %a\n"
-        s fmt_private_flag pf fmt_override_flag ovf fmt_location loc;
+  | Pcf_meth (s, pf, ovf, e) ->
+      line i ppf "Pcf_meth %a %a\n" fmt_private_flag pf fmt_override_flag ovf;
+      line (i+1) ppf "%a\n" fmt_string_loc s;
       expression (i+1) ppf e;
-  | Pcf_cstr (ct1, ct2, loc) ->
-      line i ppf "Pcf_cstr %a\n" fmt_location loc;
+  | Pcf_constr (ct1, ct2) ->
+      line i ppf "Pcf_constr\n";
       core_type (i+1) ppf ct1;
       core_type (i+1) ppf ct2;
-  | Pcf_let (rf, l, loc) ->
-      line i ppf "Pcf_let %a %a\n" fmt_rec_flag rf fmt_location loc;
-      list (i+1) pattern_x_expression_def ppf l;
   | Pcf_init (e) ->
       line i ppf "Pcf_init\n";
       expression (i+1) ppf e;
@@ -496,7 +511,7 @@
   line i ppf "pci_virt = %a\n" fmt_virtual_flag x.pci_virt;
   line i ppf "pci_params =\n";
   string_list_x_location (i+1) ppf x.pci_params;
-  line i ppf "pci_name = \"%s\"\n" x.pci_name;
+  line i ppf "pci_name = %a\n" fmt_string_loc x.pci_name;
   line i ppf "pci_expr =\n";
   class_expr (i+1) ppf x.pci_expr;
 
@@ -504,12 +519,12 @@
   line i ppf "module_type %a\n" fmt_location x.pmty_loc;
   let i = i+1 in
   match x.pmty_desc with
-  | Pmty_ident (li) -> line i ppf "Pmty_ident %a\n" fmt_longident li;
+  | Pmty_ident li -> line i ppf "Pmty_ident %a\n" fmt_longident_loc li;
   | Pmty_signature (s) ->
       line i ppf "Pmty_signature\n";
       signature i ppf s;
   | Pmty_functor (s, mt1, mt2) ->
-      line i ppf "Pmty_functor \"%s\"\n" s;
+      line i ppf "Pmty_functor %a\n" fmt_string_loc s;
       module_type i ppf mt1;
       module_type i ppf mt2;
   | Pmty_with (mt, l) ->
@@ -518,7 +533,7 @@
       list i longident_x_with_constraint ppf l;
   | Pmty_typeof m ->
       line i ppf "Pmty_typeof\n";
-      module_expr i ppf m
+      module_expr i ppf m;
 
 and signature i ppf x = list i signature_item ppf x
 
@@ -527,24 +542,27 @@
   let i = i+1 in
   match x.psig_desc with
   | Psig_value (s, vd) ->
-      line i ppf "Psig_value \"%s\"\n" s;
+      line i ppf "Psig_value %a\n" fmt_string_loc s;
       value_description i ppf vd;
   | Psig_type (l) ->
       line i ppf "Psig_type\n";
       list i string_x_type_declaration ppf l;
   | Psig_exception (s, ed) ->
-      line i ppf "Psig_exception \"%s\"\n" s;
+      line i ppf "Psig_exception %a\n" fmt_string_loc s;
       exception_declaration i ppf ed;
   | Psig_module (s, mt) ->
-      line i ppf "Psig_module \"%s\"\n" s;
+      line i ppf "Psig_module %a\n" fmt_string_loc s;
       module_type i ppf mt;
   | Psig_recmodule decls ->
       line i ppf "Psig_recmodule\n";
       list i string_x_module_type ppf decls;
   | Psig_modtype (s, md) ->
-      line i ppf "Psig_modtype \"%s\"\n" s;
+      line i ppf "Psig_modtype %a\n" fmt_string_loc s;
       modtype_declaration i ppf md;
-  | Psig_open (li) -> line i ppf "Psig_open %a\n" fmt_longident li;
+  | Psig_open (ovf, li) ->
+    line i ppf "Psig_open %a %a\n"
+      fmt_override_flag ovf
+      fmt_longident_loc li;
   | Psig_include (mt) ->
       line i ppf "Psig_include\n";
       module_type i ppf mt;
@@ -570,19 +588,19 @@
   | Pwith_typesubst (td) ->
       line i ppf "Pwith_typesubst\n";
       type_declaration (i+1) ppf td;
-  | Pwith_module (li) -> line i ppf "Pwith_module %a\n" fmt_longident li;
-  | Pwith_modsubst (li) -> line i ppf "Pwith_modsubst %a\n" fmt_longident li;
+  | Pwith_module li -> line i ppf "Pwith_module %a\n" fmt_longident_loc li;
+  | Pwith_modsubst li -> line i ppf "Pwith_modsubst %a\n" fmt_longident_loc li;
 
 and module_expr i ppf x =
   line i ppf "module_expr %a\n" fmt_location x.pmod_loc;
   let i = i+1 in
   match x.pmod_desc with
-  | Pmod_ident (li) -> line i ppf "Pmod_ident %a\n" fmt_longident li;
+  | Pmod_ident (li) -> line i ppf "Pmod_ident %a\n" fmt_longident_loc li;
   | Pmod_structure (s) ->
       line i ppf "Pmod_structure\n";
       structure i ppf s;
   | Pmod_functor (s, mt, me) ->
-      line i ppf "Pmod_functor \"%s\"\n" s;
+      line i ppf "Pmod_functor %a\n" fmt_string_loc s;
       module_type i ppf mt;
       module_expr i ppf me;
   | Pmod_apply (me1, me2) ->
@@ -593,9 +611,8 @@
       line i ppf "Pmod_constraint\n";
       module_expr i ppf me;
       module_type i ppf mt;
-  | Pmod_unpack (e, (p, l)) ->
-      line i ppf "Pmod_unpack %a\n" fmt_longident p;
-      list i package_with ppf l;
+  | Pmod_unpack (e) ->
+      line i ppf "Pmod_unpack\n";
       expression i ppf e;
 
 and structure i ppf x = list i structure_item ppf x
@@ -611,26 +628,31 @@
       line i ppf "Pstr_value %a\n" fmt_rec_flag rf;
       list i pattern_x_expression_def ppf l;
   | Pstr_primitive (s, vd) ->
-      line i ppf "Pstr_primitive \"%s\"\n" s;
+      line i ppf "Pstr_primitive %a\n" fmt_string_loc s;
       value_description i ppf vd;
-  | Pstr_type (l) ->
+  | Pstr_type l ->
       line i ppf "Pstr_type\n";
       list i string_x_type_declaration ppf l;
   | Pstr_exception (s, ed) ->
-      line i ppf "Pstr_exception \"%s\"\n" s;
+      line i ppf "Pstr_exception %a\n" fmt_string_loc s;
       exception_declaration i ppf ed;
   | Pstr_exn_rebind (s, li) ->
-      line i ppf "Pstr_exn_rebind \"%s\" %a\n" s fmt_longident li;
+      line i ppf "Pstr_exn_rebind\n";
+      line (i+1) ppf "%a\n" fmt_string_loc s;
+      line (i+1) ppf "%a\n" fmt_longident_loc li;
   | Pstr_module (s, me) ->
-      line i ppf "Pstr_module \"%s\"\n" s;
+      line i ppf "Pstr_module %a\n" fmt_string_loc s;
       module_expr i ppf me;
   | Pstr_recmodule bindings ->
       line i ppf "Pstr_recmodule\n";
       list i string_x_modtype_x_module ppf bindings;
   | Pstr_modtype (s, mt) ->
-      line i ppf "Pstr_modtype \"%s\"\n" s;
+      line i ppf "Pstr_modtype %a\n" fmt_string_loc s;
       module_type i ppf mt;
-  | Pstr_open (li) -> line i ppf "Pstr_open %a\n" fmt_longident li;
+  | Pstr_open (ovf, li) ->
+    line i ppf "Pstr_open %a %a\n"
+      fmt_override_flag ovf
+      fmt_longident_loc li;
   | Pstr_class (l) ->
       line i ppf "Pstr_class\n";
       list i class_declaration ppf l;
@@ -642,20 +664,20 @@
       module_expr i ppf me
 
 and string_x_type_declaration i ppf (s, td) =
-  string i ppf s;
+  string_loc i ppf s;
   type_declaration (i+1) ppf td;
 
 and string_x_module_type i ppf (s, mty) =
-  string i ppf s;
+  string_loc i ppf s;
   module_type (i+1) ppf mty;
 
 and string_x_modtype_x_module i ppf (s, mty, modl) =
-  string i ppf s;
+  string_loc i ppf s;
   module_type (i+1) ppf mty;
   module_expr (i+1) ppf modl;
 
 and longident_x_with_constraint i ppf (li, wc) =
-  line i ppf "%a\n" fmt_longident li;
+  line i ppf "%a\n" fmt_longident_loc li;
   with_constraint (i+1) ppf wc;
 
 and core_type_x_core_type_x_location i ppf (ct1, ct2, l) =
@@ -663,20 +685,24 @@
   core_type (i+1) ppf ct1;
   core_type (i+1) ppf ct2;
 
-and string_x_core_type_list_x_location i ppf (s, l, loc) =
-  line i ppf "\"%s\" %a\n" s fmt_location loc;
+and string_x_core_type_list_x_location i ppf (s, l, r_opt, loc) =
+  line i ppf "%a\n" fmt_location loc;
+  line (i+1) ppf "%a\n" fmt_string_loc s;
   list (i+1) core_type ppf l;
+  option (i+1) core_type ppf r_opt;
 
 and string_x_mutable_flag_x_core_type_x_location i ppf (s, mf, ct, loc) =
-  line i ppf "\"%s\" %a %a\n" s fmt_mutable_flag mf fmt_location loc;
+  line i ppf "%a\n" fmt_location loc;
+  line (i+1) ppf "%a\n" fmt_mutable_flag mf;
+  line (i+1) ppf "%a" fmt_string_loc s;
   core_type (i+1) ppf ct;
 
 and string_list_x_location i ppf (l, loc) =
   line i ppf " %a\n" fmt_location loc;
-  list (i+1) string ppf l;
+  list (i+1) string_loc ppf l;
 
 and longident_x_pattern i ppf (li, p) =
-  line i ppf "%a\n" fmt_longident li;
+  line i ppf "%a\n" fmt_longident_loc li;
   pattern (i+1) ppf p;
 
 and pattern_x_expression_case i ppf (p, e) =
@@ -690,11 +716,11 @@
   expression (i+1) ppf e;
 
 and string_x_expression i ppf (s, e) =
-  line i ppf " \"%s\"\n" s;
+  line i ppf " %a\n" fmt_string_loc s;
   expression (i+1) ppf e;
 
 and longident_x_expression i ppf (li, e) =
-  line i ppf "%a\n" fmt_longident li;
+  line i ppf "%a\n" fmt_longident_loc li;
   expression (i+1) ppf e;
 
 and label_x_expression i ppf (l,e) =
diff -Nru ocaml-3.12.1/parsing/printast.mli ocaml-4.01.0/parsing/printast.mli
--- ocaml-3.12.1/parsing/printast.mli	2000-03-06 22:12:09.000000000 +0000
+++ ocaml-4.01.0/parsing/printast.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*             Damien Doligez, projet Para, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: printast.mli 2908 2000-03-06 22:12:09Z weis $ *)
-
 open Parsetree;;
 open Format;;
 
diff -Nru ocaml-3.12.1/parsing/syntaxerr.ml ocaml-4.01.0/parsing/syntaxerr.ml
--- ocaml-3.12.1/parsing/syntaxerr.ml	2009-07-15 14:06:37.000000000 +0000
+++ ocaml-4.01.0/parsing/syntaxerr.ml	2012-10-16 14:04:33.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,24 +10,26 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: syntaxerr.ml 9316 2009-07-15 14:06:37Z xleroy $ *)
-
 (* Auxiliary type for reporting syntax errors *)
 
 open Format
 
 type error =
     Unclosed of Location.t * string * Location.t * string
+  | Expecting of Location.t * string
   | Applicative_path of Location.t
+  | Variable_in_scope of Location.t * string
   | Other of Location.t
 
+
+
 exception Error of error
 exception Escape_error
 
 let report_error ppf = function
   | Unclosed(opening_loc, opening, closing_loc, closing) ->
-      if String.length !Location.input_name = 0
-      && Location.highlight_locations ppf opening_loc closing_loc
+      if !Location.input_name = "//toplevel//"
+         && Location.highlight_locations ppf opening_loc closing_loc
       then fprintf ppf "Syntax error: '%s' expected, \
                    the highlighted '%s' might be unmatched" closing opening
       else begin
@@ -36,8 +38,27 @@
         fprintf ppf "%aThis '%s' might be unmatched"
           Location.print_error opening_loc opening
       end
+  | Expecting (loc, nonterm) ->
+      fprintf ppf
+        "%a@[Syntax error: %s expected.@]"
+        Location.print_error loc nonterm
   | Applicative_path loc ->
-      fprintf ppf "%aSyntax error: applicative paths of the form F(X).t are not supported when the option -no-app-func is set."
+      fprintf ppf
+        "%aSyntax error: applicative paths of the form F(X).t \
+         are not supported when the option -no-app-func is set."
         Location.print_error loc
+  | Variable_in_scope (loc, var) ->
+      fprintf ppf
+        "%a@[In this scoped type, variable '%s@ \
+         is reserved for the local type %s.@]"
+        Location.print_error loc var var
   | Other loc ->
       fprintf ppf "%aSyntax error" Location.print_error loc
+
+
+let location_of_error = function
+  | Unclosed(l,_,_,_)
+  | Applicative_path l
+  | Variable_in_scope(l,_)
+  | Other l
+  | Expecting (l, _) -> l
diff -Nru ocaml-3.12.1/parsing/syntaxerr.mli ocaml-4.01.0/parsing/syntaxerr.mli
--- ocaml-3.12.1/parsing/syntaxerr.mli	2009-07-15 14:06:37.000000000 +0000
+++ ocaml-4.01.0/parsing/syntaxerr.mli	2012-10-16 14:04:33.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,18 +10,20 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: syntaxerr.mli 9316 2009-07-15 14:06:37Z xleroy $ *)
-
 (* Auxiliary type for reporting syntax errors *)
 
 open Format
 
 type error =
     Unclosed of Location.t * string * Location.t * string
+  | Expecting of Location.t * string
   | Applicative_path of Location.t
+  | Variable_in_scope of Location.t * string
   | Other of Location.t
 
 exception Error of error
 exception Escape_error
 
 val report_error: formatter -> error -> unit
+
+val location_of_error: error -> Location.t
diff -Nru ocaml-3.12.1/stdlib/.cvsignore ocaml-4.01.0/stdlib/.cvsignore
--- ocaml-3.12.1/stdlib/.cvsignore	2010-01-20 16:26:46.000000000 +0000
+++ ocaml-4.01.0/stdlib/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,7 +0,0 @@
-camlheader
-camlheader_ur
-labelled-*
-caml
-*.annot
-sys.ml
-*.a
diff -Nru ocaml-3.12.1/stdlib/.depend ocaml-4.01.0/stdlib/.depend
--- ocaml-3.12.1/stdlib/.depend	2010-04-26 12:54:11.000000000 +0000
+++ ocaml-4.01.0/stdlib/.depend	2013-08-15 16:13:16.000000000 +0000
@@ -1,248 +1,264 @@
-arg.cmi:
-array.cmi:
-arrayLabels.cmi:
-buffer.cmi:
-callback.cmi:
-camlinternalLazy.cmi:
-camlinternalMod.cmi: obj.cmi
-camlinternalOO.cmi: obj.cmi
-char.cmi:
-complex.cmi:
-digest.cmi:
-filename.cmi:
-format.cmi: pervasives.cmi buffer.cmi
-gc.cmi:
-genlex.cmi: stream.cmi
-hashtbl.cmi:
-int32.cmi:
-int64.cmi:
-lazy.cmi:
-lexing.cmi:
-list.cmi:
-listLabels.cmi:
-map.cmi:
-marshal.cmi:
-moreLabels.cmi: set.cmi map.cmi hashtbl.cmi
-nativeint.cmi:
-obj.cmi: int32.cmi
-oo.cmi: camlinternalOO.cmi
-parsing.cmi: obj.cmi lexing.cmi
-pervasives.cmi:
-printexc.cmi:
-printf.cmi: obj.cmi buffer.cmi
-queue.cmi:
-random.cmi: nativeint.cmi int64.cmi int32.cmi
-scanf.cmi: pervasives.cmi
-set.cmi:
-sort.cmi:
-stack.cmi:
-stdLabels.cmi:
-stream.cmi:
-string.cmi:
-stringLabels.cmi:
-sys.cmi:
-weak.cmi: hashtbl.cmi
-arg.cmo: sys.cmi string.cmi printf.cmi list.cmi buffer.cmi array.cmi arg.cmi
-arg.cmx: sys.cmx string.cmx printf.cmx list.cmx buffer.cmx array.cmx arg.cmi
-array.cmo: array.cmi
-array.cmx: array.cmi
-arrayLabels.cmo: array.cmi arrayLabels.cmi
-arrayLabels.cmx: array.cmx arrayLabels.cmi
-buffer.cmo: sys.cmi string.cmi buffer.cmi
-buffer.cmx: sys.cmx string.cmx buffer.cmi
-callback.cmo: obj.cmi callback.cmi
-callback.cmx: obj.cmx callback.cmi
-camlinternalLazy.cmo: obj.cmi camlinternalLazy.cmi
-camlinternalLazy.cmx: obj.cmx camlinternalLazy.cmi
-camlinternalMod.cmo: obj.cmi camlinternalOO.cmi array.cmi camlinternalMod.cmi
-camlinternalMod.cmx: obj.cmx camlinternalOO.cmx array.cmx camlinternalMod.cmi
-camlinternalOO.cmo: sys.cmi string.cmi obj.cmi map.cmi list.cmi char.cmi \
-    array.cmi camlinternalOO.cmi
-camlinternalOO.cmx: sys.cmx string.cmx obj.cmx map.cmx list.cmx char.cmx \
-    array.cmx camlinternalOO.cmi
-char.cmo: char.cmi
-char.cmx: char.cmi
-complex.cmo: complex.cmi
-complex.cmx: complex.cmi
-digest.cmo: string.cmi printf.cmi digest.cmi
-digest.cmx: string.cmx printf.cmx digest.cmi
-filename.cmo: sys.cmi string.cmi random.cmi printf.cmi buffer.cmi \
+arg.cmi :
+array.cmi :
+arrayLabels.cmi :
+buffer.cmi :
+callback.cmi :
+camlinternalLazy.cmi :
+camlinternalMod.cmi : obj.cmi
+camlinternalOO.cmi : obj.cmi
+char.cmi :
+complex.cmi :
+digest.cmi :
+filename.cmi :
+format.cmi : pervasives.cmi buffer.cmi
+gc.cmi :
+genlex.cmi : stream.cmi
+hashtbl.cmi :
+int32.cmi :
+int64.cmi :
+lazy.cmi :
+lexing.cmi :
+list.cmi :
+listLabels.cmi :
+map.cmi :
+marshal.cmi :
+moreLabels.cmi : set.cmi map.cmi hashtbl.cmi
+nativeint.cmi :
+obj.cmi : int32.cmi
+oo.cmi : camlinternalOO.cmi
+parsing.cmi : obj.cmi lexing.cmi
+pervasives.cmi :
+printexc.cmi :
+printf.cmi : obj.cmi buffer.cmi
+queue.cmi :
+random.cmi : nativeint.cmi int64.cmi int32.cmi
+scanf.cmi : pervasives.cmi
+set.cmi :
+sort.cmi :
+stack.cmi :
+stdLabels.cmi :
+stream.cmi :
+string.cmi :
+stringLabels.cmi :
+sys.cmi :
+weak.cmi : hashtbl.cmi
+arg.cmo : sys.cmi string.cmi printf.cmi list.cmi buffer.cmi array.cmi \
+    arg.cmi
+arg.cmx : sys.cmx string.cmx printf.cmx list.cmx buffer.cmx array.cmx \
+    arg.cmi
+array.cmo : array.cmi
+array.cmx : array.cmi
+arrayLabels.cmo : array.cmi arrayLabels.cmi
+arrayLabels.cmx : array.cmx arrayLabels.cmi
+buffer.cmo : sys.cmi string.cmi buffer.cmi
+buffer.cmx : sys.cmx string.cmx buffer.cmi
+callback.cmo : obj.cmi callback.cmi
+callback.cmx : obj.cmx callback.cmi
+camlinternalLazy.cmo : obj.cmi camlinternalLazy.cmi
+camlinternalLazy.cmx : obj.cmx camlinternalLazy.cmi
+camlinternalMod.cmo : obj.cmi camlinternalOO.cmi array.cmi \
+    camlinternalMod.cmi
+camlinternalMod.cmx : obj.cmx camlinternalOO.cmx array.cmx \
+    camlinternalMod.cmi
+camlinternalOO.cmo : sys.cmi string.cmi obj.cmi map.cmi list.cmi char.cmi \
+    callback.cmi array.cmi camlinternalOO.cmi
+camlinternalOO.cmx : sys.cmx string.cmx obj.cmx map.cmx list.cmx char.cmx \
+    callback.cmx array.cmx camlinternalOO.cmi
+char.cmo : char.cmi
+char.cmx : char.cmi
+complex.cmo : complex.cmi
+complex.cmx : complex.cmi
+digest.cmo : string.cmi printf.cmi char.cmi digest.cmi
+digest.cmx : string.cmx printf.cmx char.cmx digest.cmi
+filename.cmo : sys.cmi string.cmi random.cmi printf.cmi lazy.cmi buffer.cmi \
     filename.cmi
-filename.cmx: sys.cmx string.cmx random.cmx printf.cmx buffer.cmx \
+filename.cmx : sys.cmx string.cmx random.cmx printf.cmx lazy.cmx buffer.cmx \
     filename.cmi
-format.cmo: string.cmi printf.cmi pervasives.cmi obj.cmi list.cmi buffer.cmi \
-    format.cmi
-format.cmx: string.cmx printf.cmx pervasives.cmx obj.cmx list.cmx buffer.cmx \
-    format.cmi
-gc.cmo: sys.cmi printf.cmi gc.cmi
-gc.cmx: sys.cmx printf.cmx gc.cmi
-genlex.cmo: string.cmi stream.cmi list.cmi hashtbl.cmi char.cmi genlex.cmi
-genlex.cmx: string.cmx stream.cmx list.cmx hashtbl.cmx char.cmx genlex.cmi
-hashtbl.cmo: sys.cmi array.cmi hashtbl.cmi
-hashtbl.cmx: sys.cmx array.cmx hashtbl.cmi
-int32.cmo: pervasives.cmi int32.cmi
-int32.cmx: pervasives.cmx int32.cmi
-int64.cmo: pervasives.cmi int64.cmi
-int64.cmx: pervasives.cmx int64.cmi
-lazy.cmo: obj.cmi camlinternalLazy.cmi lazy.cmi
-lazy.cmx: obj.cmx camlinternalLazy.cmx lazy.cmi
-lexing.cmo: sys.cmi string.cmi array.cmi lexing.cmi
-lexing.cmx: sys.cmx string.cmx array.cmx lexing.cmi
-list.cmo: list.cmi
-list.cmx: list.cmi
-listLabels.cmo: list.cmi listLabels.cmi
-listLabels.cmx: list.cmx listLabels.cmi
-map.cmo: map.cmi
-map.cmx: map.cmi
-marshal.cmo: string.cmi marshal.cmi
-marshal.cmx: string.cmx marshal.cmi
-moreLabels.cmo: set.cmi map.cmi hashtbl.cmi moreLabels.cmi
-moreLabels.cmx: set.cmx map.cmx hashtbl.cmx moreLabels.cmi
-nativeint.cmo: sys.cmi pervasives.cmi nativeint.cmi
-nativeint.cmx: sys.cmx pervasives.cmx nativeint.cmi
-obj.cmo: marshal.cmi int32.cmi array.cmi obj.cmi
-obj.cmx: marshal.cmx int32.cmx array.cmx obj.cmi
-oo.cmo: camlinternalOO.cmi oo.cmi
-oo.cmx: camlinternalOO.cmx oo.cmi
-parsing.cmo: obj.cmi lexing.cmi array.cmi parsing.cmi
-parsing.cmx: obj.cmx lexing.cmx array.cmx parsing.cmi
-pervasives.cmo: pervasives.cmi
-pervasives.cmx: pervasives.cmi
-printexc.cmo: printf.cmi obj.cmi buffer.cmi array.cmi printexc.cmi
-printexc.cmx: printf.cmx obj.cmx buffer.cmx array.cmx printexc.cmi
-printf.cmo: string.cmi pervasives.cmi obj.cmi list.cmi char.cmi buffer.cmi \
-    array.cmi printf.cmi
-printf.cmx: string.cmx pervasives.cmx obj.cmx list.cmx char.cmx buffer.cmx \
-    array.cmx printf.cmi
-queue.cmo: obj.cmi queue.cmi
-queue.cmx: obj.cmx queue.cmi
-random.cmo: string.cmi pervasives.cmi nativeint.cmi int64.cmi int32.cmi \
+format.cmo : string.cmi printf.cmi pervasives.cmi obj.cmi list.cmi \
+    buffer.cmi format.cmi
+format.cmx : string.cmx printf.cmx pervasives.cmx obj.cmx list.cmx \
+    buffer.cmx format.cmi
+gc.cmo : sys.cmi printf.cmi gc.cmi
+gc.cmx : sys.cmx printf.cmx gc.cmi
+genlex.cmo : string.cmi stream.cmi list.cmi hashtbl.cmi char.cmi genlex.cmi
+genlex.cmx : string.cmx stream.cmx list.cmx hashtbl.cmx char.cmx genlex.cmi
+hashtbl.cmo : sys.cmi string.cmi random.cmi obj.cmi lazy.cmi array.cmi \
+    hashtbl.cmi
+hashtbl.cmx : sys.cmx string.cmx random.cmx obj.cmx lazy.cmx array.cmx \
+    hashtbl.cmi
+int32.cmo : pervasives.cmi int32.cmi
+int32.cmx : pervasives.cmx int32.cmi
+int64.cmo : pervasives.cmi int64.cmi
+int64.cmx : pervasives.cmx int64.cmi
+lazy.cmo : obj.cmi camlinternalLazy.cmi lazy.cmi
+lazy.cmx : obj.cmx camlinternalLazy.cmx lazy.cmi
+lexing.cmo : sys.cmi string.cmi array.cmi lexing.cmi
+lexing.cmx : sys.cmx string.cmx array.cmx lexing.cmi
+list.cmo : list.cmi
+list.cmx : list.cmi
+listLabels.cmo : list.cmi listLabels.cmi
+listLabels.cmx : list.cmx listLabels.cmi
+map.cmo : map.cmi
+map.cmx : map.cmi
+marshal.cmo : string.cmi marshal.cmi
+marshal.cmx : string.cmx marshal.cmi
+moreLabels.cmo : set.cmi map.cmi hashtbl.cmi moreLabels.cmi
+moreLabels.cmx : set.cmx map.cmx hashtbl.cmx moreLabels.cmi
+nativeint.cmo : sys.cmi pervasives.cmi nativeint.cmi
+nativeint.cmx : sys.cmx pervasives.cmx nativeint.cmi
+obj.cmo : marshal.cmi int32.cmi array.cmi obj.cmi
+obj.cmx : marshal.cmx int32.cmx array.cmx obj.cmi
+oo.cmo : camlinternalOO.cmi oo.cmi
+oo.cmx : camlinternalOO.cmx oo.cmi
+parsing.cmo : obj.cmi lexing.cmi array.cmi parsing.cmi
+parsing.cmx : obj.cmx lexing.cmx array.cmx parsing.cmi
+pervasives.cmo : pervasives.cmi
+pervasives.cmx : pervasives.cmi
+printexc.cmo : printf.cmi obj.cmi buffer.cmi array.cmi printexc.cmi
+printexc.cmx : printf.cmx obj.cmx buffer.cmx array.cmx printexc.cmi
+printf.cmo : string.cmi obj.cmi list.cmi char.cmi buffer.cmi array.cmi \
+    printf.cmi
+printf.cmx : string.cmx obj.cmx list.cmx char.cmx buffer.cmx array.cmx \
+    printf.cmi
+queue.cmo : obj.cmi queue.cmi
+queue.cmx : obj.cmx queue.cmi
+random.cmo : string.cmi pervasives.cmi nativeint.cmi int64.cmi int32.cmi \
     digest.cmi char.cmi array.cmi random.cmi
-random.cmx: string.cmx pervasives.cmx nativeint.cmx int64.cmx int32.cmx \
+random.cmx : string.cmx pervasives.cmx nativeint.cmx int64.cmx int32.cmx \
     digest.cmx char.cmx array.cmx random.cmi
-scanf.cmo: string.cmi printf.cmi pervasives.cmi obj.cmi list.cmi hashtbl.cmi \
-    buffer.cmi array.cmi scanf.cmi
-scanf.cmx: string.cmx printf.cmx pervasives.cmx obj.cmx list.cmx hashtbl.cmx \
-    buffer.cmx array.cmx scanf.cmi
-set.cmo: set.cmi
-set.cmx: set.cmi
-sort.cmo: array.cmi sort.cmi
-sort.cmx: array.cmx sort.cmi
-stack.cmo: list.cmi stack.cmi
-stack.cmx: list.cmx stack.cmi
-stdLabels.cmo: stringLabels.cmi listLabels.cmi arrayLabels.cmi stdLabels.cmi
-stdLabels.cmx: stringLabels.cmx listLabels.cmx arrayLabels.cmx stdLabels.cmi
-std_exit.cmo:
-std_exit.cmx:
-stream.cmo: string.cmi obj.cmi list.cmi lazy.cmi stream.cmi
-stream.cmx: string.cmx obj.cmx list.cmx lazy.cmx stream.cmi
-string.cmo: pervasives.cmi list.cmi char.cmi string.cmi
-string.cmx: pervasives.cmx list.cmx char.cmx string.cmi
-stringLabels.cmo: string.cmi stringLabels.cmi
-stringLabels.cmx: string.cmx stringLabels.cmi
-sys.cmo: sys.cmi
-sys.cmx: sys.cmi
-weak.cmo: sys.cmi obj.cmi hashtbl.cmi array.cmi weak.cmi
-weak.cmx: sys.cmx obj.cmx hashtbl.cmx array.cmx weak.cmi
-arg.cmo: sys.cmi string.cmi printf.cmi list.cmi buffer.cmi array.cmi arg.cmi
-arg.p.cmx: sys.p.cmx string.p.cmx printf.p.cmx list.p.cmx buffer.p.cmx array.p.cmx arg.cmi
-array.cmo: array.cmi
-array.p.cmx: array.cmi
-arrayLabels.cmo: array.cmi arrayLabels.cmi
-arrayLabels.p.cmx: array.p.cmx arrayLabels.cmi
-buffer.cmo: sys.cmi string.cmi buffer.cmi
-buffer.p.cmx: sys.p.cmx string.p.cmx buffer.cmi
-callback.cmo: obj.cmi callback.cmi
-callback.p.cmx: obj.p.cmx callback.cmi
-camlinternalLazy.cmo: obj.cmi camlinternalLazy.cmi
-camlinternalLazy.p.cmx: obj.p.cmx camlinternalLazy.cmi
-camlinternalMod.cmo: obj.cmi camlinternalOO.cmi array.cmi camlinternalMod.cmi
-camlinternalMod.p.cmx: obj.p.cmx camlinternalOO.p.cmx array.p.cmx camlinternalMod.cmi
-camlinternalOO.cmo: sys.cmi string.cmi obj.cmi map.cmi list.cmi char.cmi \
-    array.cmi camlinternalOO.cmi
-camlinternalOO.p.cmx: sys.p.cmx string.p.cmx obj.p.cmx map.p.cmx list.p.cmx char.p.cmx \
-    array.p.cmx camlinternalOO.cmi
-char.cmo: char.cmi
-char.p.cmx: char.cmi
-complex.cmo: complex.cmi
-complex.p.cmx: complex.cmi
-digest.cmo: string.cmi printf.cmi digest.cmi
-digest.p.cmx: string.p.cmx printf.p.cmx digest.cmi
-filename.cmo: sys.cmi string.cmi random.cmi printf.cmi buffer.cmi \
+scanf.cmo : string.cmi printf.cmi pervasives.cmi obj.cmi list.cmi \
+    hashtbl.cmi buffer.cmi array.cmi scanf.cmi
+scanf.cmx : string.cmx printf.cmx pervasives.cmx obj.cmx list.cmx \
+    hashtbl.cmx buffer.cmx array.cmx scanf.cmi
+set.cmo : set.cmi
+set.cmx : set.cmi
+sort.cmo : array.cmi sort.cmi
+sort.cmx : array.cmx sort.cmi
+stack.cmo : list.cmi stack.cmi
+stack.cmx : list.cmx stack.cmi
+stdLabels.cmo : stringLabels.cmi listLabels.cmi arrayLabels.cmi \
+    stdLabels.cmi
+stdLabels.cmx : stringLabels.cmx listLabels.cmx arrayLabels.cmx \
+    stdLabels.cmi
+std_exit.cmo :
+std_exit.cmx :
+stream.cmo : string.cmi obj.cmi list.cmi lazy.cmi stream.cmi
+stream.cmx : string.cmx obj.cmx list.cmx lazy.cmx stream.cmi
+string.cmo : pervasives.cmi list.cmi char.cmi string.cmi
+string.cmx : pervasives.cmx list.cmx char.cmx string.cmi
+stringLabels.cmo : string.cmi stringLabels.cmi
+stringLabels.cmx : string.cmx stringLabels.cmi
+sys.cmo : sys.cmi
+sys.cmx : sys.cmi
+weak.cmo : sys.cmi obj.cmi hashtbl.cmi array.cmi weak.cmi
+weak.cmx : sys.cmx obj.cmx hashtbl.cmx array.cmx weak.cmi
+arg.cmo : sys.cmi string.cmi printf.cmi list.cmi buffer.cmi array.cmi \
+    arg.cmi
+arg.p.cmx : sys.p.cmx string.p.cmx printf.p.cmx list.p.cmx buffer.p.cmx array.p.cmx \
+    arg.cmi
+array.cmo : array.cmi
+array.p.cmx : array.cmi
+arrayLabels.cmo : array.cmi arrayLabels.cmi
+arrayLabels.p.cmx : array.p.cmx arrayLabels.cmi
+buffer.cmo : sys.cmi string.cmi buffer.cmi
+buffer.p.cmx : sys.p.cmx string.p.cmx buffer.cmi
+callback.cmo : obj.cmi callback.cmi
+callback.p.cmx : obj.p.cmx callback.cmi
+camlinternalLazy.cmo : obj.cmi camlinternalLazy.cmi
+camlinternalLazy.p.cmx : obj.p.cmx camlinternalLazy.cmi
+camlinternalMod.cmo : obj.cmi camlinternalOO.cmi array.cmi \
+    camlinternalMod.cmi
+camlinternalMod.p.cmx : obj.p.cmx camlinternalOO.p.cmx array.p.cmx \
+    camlinternalMod.cmi
+camlinternalOO.cmo : sys.cmi string.cmi obj.cmi map.cmi list.cmi char.cmi \
+    callback.cmi array.cmi camlinternalOO.cmi
+camlinternalOO.p.cmx : sys.p.cmx string.p.cmx obj.p.cmx map.p.cmx list.p.cmx char.p.cmx \
+    callback.p.cmx array.p.cmx camlinternalOO.cmi
+char.cmo : char.cmi
+char.p.cmx : char.cmi
+complex.cmo : complex.cmi
+complex.p.cmx : complex.cmi
+digest.cmo : string.cmi printf.cmi char.cmi digest.cmi
+digest.p.cmx : string.p.cmx printf.p.cmx char.p.cmx digest.cmi
+filename.cmo : sys.cmi string.cmi random.cmi printf.cmi lazy.cmi buffer.cmi \
     filename.cmi
-filename.p.cmx: sys.p.cmx string.p.cmx random.p.cmx printf.p.cmx buffer.p.cmx \
+filename.p.cmx : sys.p.cmx string.p.cmx random.p.cmx printf.p.cmx lazy.p.cmx buffer.p.cmx \
     filename.cmi
-format.cmo: string.cmi printf.cmi pervasives.cmi obj.cmi list.cmi buffer.cmi \
-    format.cmi
-format.p.cmx: string.p.cmx printf.p.cmx pervasives.p.cmx obj.p.cmx list.p.cmx buffer.p.cmx \
-    format.cmi
-gc.cmo: sys.cmi printf.cmi gc.cmi
-gc.p.cmx: sys.p.cmx printf.p.cmx gc.cmi
-genlex.cmo: string.cmi stream.cmi list.cmi hashtbl.cmi char.cmi genlex.cmi
-genlex.p.cmx: string.p.cmx stream.p.cmx list.p.cmx hashtbl.p.cmx char.p.cmx genlex.cmi
-hashtbl.cmo: sys.cmi array.cmi hashtbl.cmi
-hashtbl.p.cmx: sys.p.cmx array.p.cmx hashtbl.cmi
-int32.cmo: pervasives.cmi int32.cmi
-int32.p.cmx: pervasives.p.cmx int32.cmi
-int64.cmo: pervasives.cmi int64.cmi
-int64.p.cmx: pervasives.p.cmx int64.cmi
-lazy.cmo: obj.cmi camlinternalLazy.cmi lazy.cmi
-lazy.p.cmx: obj.p.cmx camlinternalLazy.p.cmx lazy.cmi
-lexing.cmo: sys.cmi string.cmi array.cmi lexing.cmi
-lexing.p.cmx: sys.p.cmx string.p.cmx array.p.cmx lexing.cmi
-list.cmo: list.cmi
-list.p.cmx: list.cmi
-listLabels.cmo: list.cmi listLabels.cmi
-listLabels.p.cmx: list.p.cmx listLabels.cmi
-map.cmo: map.cmi
-map.p.cmx: map.cmi
-marshal.cmo: string.cmi marshal.cmi
-marshal.p.cmx: string.p.cmx marshal.cmi
-moreLabels.cmo: set.cmi map.cmi hashtbl.cmi moreLabels.cmi
-moreLabels.p.cmx: set.p.cmx map.p.cmx hashtbl.p.cmx moreLabels.cmi
-nativeint.cmo: sys.cmi pervasives.cmi nativeint.cmi
-nativeint.p.cmx: sys.p.cmx pervasives.p.cmx nativeint.cmi
-obj.cmo: marshal.cmi int32.cmi array.cmi obj.cmi
-obj.p.cmx: marshal.p.cmx int32.p.cmx array.p.cmx obj.cmi
-oo.cmo: camlinternalOO.cmi oo.cmi
-oo.p.cmx: camlinternalOO.p.cmx oo.cmi
-parsing.cmo: obj.cmi lexing.cmi array.cmi parsing.cmi
-parsing.p.cmx: obj.p.cmx lexing.p.cmx array.p.cmx parsing.cmi
-pervasives.cmo: pervasives.cmi
-pervasives.p.cmx: pervasives.cmi
-printexc.cmo: printf.cmi obj.cmi buffer.cmi array.cmi printexc.cmi
-printexc.p.cmx: printf.p.cmx obj.p.cmx buffer.p.cmx array.p.cmx printexc.cmi
-printf.cmo: string.cmi pervasives.cmi obj.cmi list.cmi char.cmi buffer.cmi \
-    array.cmi printf.cmi
-printf.p.cmx: string.p.cmx pervasives.p.cmx obj.p.cmx list.p.cmx char.p.cmx buffer.p.cmx \
-    array.p.cmx printf.cmi
-queue.cmo: obj.cmi queue.cmi
-queue.p.cmx: obj.p.cmx queue.cmi
-random.cmo: string.cmi pervasives.cmi nativeint.cmi int64.cmi int32.cmi \
+format.cmo : string.cmi printf.cmi pervasives.cmi obj.cmi list.cmi \
+    buffer.cmi format.cmi
+format.p.cmx : string.p.cmx printf.p.cmx pervasives.p.cmx obj.p.cmx list.p.cmx \
+    buffer.p.cmx format.cmi
+gc.cmo : sys.cmi printf.cmi gc.cmi
+gc.p.cmx : sys.p.cmx printf.p.cmx gc.cmi
+genlex.cmo : string.cmi stream.cmi list.cmi hashtbl.cmi char.cmi genlex.cmi
+genlex.p.cmx : string.p.cmx stream.p.cmx list.p.cmx hashtbl.p.cmx char.p.cmx genlex.cmi
+hashtbl.cmo : sys.cmi string.cmi random.cmi obj.cmi lazy.cmi array.cmi \
+    hashtbl.cmi
+hashtbl.p.cmx : sys.p.cmx string.p.cmx random.p.cmx obj.p.cmx lazy.p.cmx array.p.cmx \
+    hashtbl.cmi
+int32.cmo : pervasives.cmi int32.cmi
+int32.p.cmx : pervasives.p.cmx int32.cmi
+int64.cmo : pervasives.cmi int64.cmi
+int64.p.cmx : pervasives.p.cmx int64.cmi
+lazy.cmo : obj.cmi camlinternalLazy.cmi lazy.cmi
+lazy.p.cmx : obj.p.cmx camlinternalLazy.p.cmx lazy.cmi
+lexing.cmo : sys.cmi string.cmi array.cmi lexing.cmi
+lexing.p.cmx : sys.p.cmx string.p.cmx array.p.cmx lexing.cmi
+list.cmo : list.cmi
+list.p.cmx : list.cmi
+listLabels.cmo : list.cmi listLabels.cmi
+listLabels.p.cmx : list.p.cmx listLabels.cmi
+map.cmo : map.cmi
+map.p.cmx : map.cmi
+marshal.cmo : string.cmi marshal.cmi
+marshal.p.cmx : string.p.cmx marshal.cmi
+moreLabels.cmo : set.cmi map.cmi hashtbl.cmi moreLabels.cmi
+moreLabels.p.cmx : set.p.cmx map.p.cmx hashtbl.p.cmx moreLabels.cmi
+nativeint.cmo : sys.cmi pervasives.cmi nativeint.cmi
+nativeint.p.cmx : sys.p.cmx pervasives.p.cmx nativeint.cmi
+obj.cmo : marshal.cmi int32.cmi array.cmi obj.cmi
+obj.p.cmx : marshal.p.cmx int32.p.cmx array.p.cmx obj.cmi
+oo.cmo : camlinternalOO.cmi oo.cmi
+oo.p.cmx : camlinternalOO.p.cmx oo.cmi
+parsing.cmo : obj.cmi lexing.cmi array.cmi parsing.cmi
+parsing.p.cmx : obj.p.cmx lexing.p.cmx array.p.cmx parsing.cmi
+pervasives.cmo : pervasives.cmi
+pervasives.p.cmx : pervasives.cmi
+printexc.cmo : printf.cmi obj.cmi buffer.cmi array.cmi printexc.cmi
+printexc.p.cmx : printf.p.cmx obj.p.cmx buffer.p.cmx array.p.cmx printexc.cmi
+printf.cmo : string.cmi obj.cmi list.cmi char.cmi buffer.cmi array.cmi \
+    printf.cmi
+printf.p.cmx : string.p.cmx obj.p.cmx list.p.cmx char.p.cmx buffer.p.cmx array.p.cmx \
+    printf.cmi
+queue.cmo : obj.cmi queue.cmi
+queue.p.cmx : obj.p.cmx queue.cmi
+random.cmo : string.cmi pervasives.cmi nativeint.cmi int64.cmi int32.cmi \
     digest.cmi char.cmi array.cmi random.cmi
-random.p.cmx: string.p.cmx pervasives.p.cmx nativeint.p.cmx int64.p.cmx int32.p.cmx \
+random.p.cmx : string.p.cmx pervasives.p.cmx nativeint.p.cmx int64.p.cmx int32.p.cmx \
     digest.p.cmx char.p.cmx array.p.cmx random.cmi
-scanf.cmo: string.cmi printf.cmi pervasives.cmi obj.cmi list.cmi hashtbl.cmi \
-    buffer.cmi array.cmi scanf.cmi
-scanf.p.cmx: string.p.cmx printf.p.cmx pervasives.p.cmx obj.p.cmx list.p.cmx hashtbl.p.cmx \
-    buffer.p.cmx array.p.cmx scanf.cmi
-set.cmo: set.cmi
-set.p.cmx: set.cmi
-sort.cmo: array.cmi sort.cmi
-sort.p.cmx: array.p.cmx sort.cmi
-stack.cmo: list.cmi stack.cmi
-stack.p.cmx: list.p.cmx stack.cmi
-stdLabels.cmo: stringLabels.cmi listLabels.cmi arrayLabels.cmi stdLabels.cmi
-stdLabels.p.cmx: stringLabels.p.cmx listLabels.p.cmx arrayLabels.p.cmx stdLabels.cmi
-std_exit.cmo:
-std_exit.p.cmx:
-stream.cmo: string.cmi obj.cmi list.cmi lazy.cmi stream.cmi
-stream.p.cmx: string.p.cmx obj.p.cmx list.p.cmx lazy.p.cmx stream.cmi
-string.cmo: pervasives.cmi list.cmi char.cmi string.cmi
-string.p.cmx: pervasives.p.cmx list.p.cmx char.p.cmx string.cmi
-stringLabels.cmo: string.cmi stringLabels.cmi
-stringLabels.p.cmx: string.p.cmx stringLabels.cmi
-sys.cmo: sys.cmi
-sys.p.cmx: sys.cmi
-weak.cmo: sys.cmi obj.cmi hashtbl.cmi array.cmi weak.cmi
-weak.p.cmx: sys.p.cmx obj.p.cmx hashtbl.p.cmx array.p.cmx weak.cmi
+scanf.cmo : string.cmi printf.cmi pervasives.cmi obj.cmi list.cmi \
+    hashtbl.cmi buffer.cmi array.cmi scanf.cmi
+scanf.p.cmx : string.p.cmx printf.p.cmx pervasives.p.cmx obj.p.cmx list.p.cmx \
+    hashtbl.p.cmx buffer.p.cmx array.p.cmx scanf.cmi
+set.cmo : set.cmi
+set.p.cmx : set.cmi
+sort.cmo : array.cmi sort.cmi
+sort.p.cmx : array.p.cmx sort.cmi
+stack.cmo : list.cmi stack.cmi
+stack.p.cmx : list.p.cmx stack.cmi
+stdLabels.cmo : stringLabels.cmi listLabels.cmi arrayLabels.cmi \
+    stdLabels.cmi
+stdLabels.p.cmx : stringLabels.p.cmx listLabels.p.cmx arrayLabels.p.cmx \
+    stdLabels.cmi
+std_exit.cmo :
+std_exit.p.cmx :
+stream.cmo : string.cmi obj.cmi list.cmi lazy.cmi stream.cmi
+stream.p.cmx : string.p.cmx obj.p.cmx list.p.cmx lazy.p.cmx stream.cmi
+string.cmo : pervasives.cmi list.cmi char.cmi string.cmi
+string.p.cmx : pervasives.p.cmx list.p.cmx char.p.cmx string.cmi
+stringLabels.cmo : string.cmi stringLabels.cmi
+stringLabels.p.cmx : string.p.cmx stringLabels.cmi
+sys.cmo : sys.cmi
+sys.p.cmx : sys.cmi
+weak.cmo : sys.cmi obj.cmi hashtbl.cmi array.cmi weak.cmi
+weak.p.cmx : sys.p.cmx obj.p.cmx hashtbl.p.cmx array.p.cmx weak.cmi
diff -Nru ocaml-3.12.1/stdlib/.ignore ocaml-4.01.0/stdlib/.ignore
--- ocaml-3.12.1/stdlib/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/stdlib/.ignore	2012-07-17 15:31:12.000000000 +0000
@@ -0,0 +1,6 @@
+camlheader
+camlheaderd
+camlheader_ur
+labelled-*
+caml
+sys.ml
diff -Nru ocaml-3.12.1/stdlib/Compflags ocaml-4.01.0/stdlib/Compflags
--- ocaml-3.12.1/stdlib/Compflags	2010-05-20 09:44:25.000000000 +0000
+++ ocaml-4.01.0/stdlib/Compflags	2013-07-11 21:49:31.000000000 +0000
@@ -1,7 +1,7 @@
 #!/bin/sh
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                OCaml                                  #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -12,12 +12,13 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Compflags 10443 2010-05-20 09:44:25Z doligez $
-
 case $1 in
   pervasives.cm[iox]|pervasives.p.cmx) echo ' -nopervasives';;
   camlinternalOO.cmi) echo ' -nopervasives';;
   camlinternalOO.cmx|camlinternalOO.p.cmx) echo ' -inline 0';;
+  buffer.cmx|buffer.p.cmx) echo ' -inline 3';;
+                           # make sure add_char is inlined (PR#5872)
+  buffer.cm[io]|printf.cm[io]|format.cm[io]|scanf.cm[io]) echo ' -w A';;
   scanf.cmx|scanf.p.cmx) echo ' -inline 9';;
   arrayLabels.cm[ox]|arrayLabels.p.cmx) echo ' -nolabels';;
   listLabels.cm[ox]|listLabels.p.cmx) echo ' -nolabels';;
diff -Nru ocaml-3.12.1/stdlib/Makefile ocaml-4.01.0/stdlib/Makefile
--- ocaml-3.12.1/stdlib/Makefile	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/stdlib/Makefile	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,8 +11,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile 9547 2010-01-22 12:48:24Z doligez $
-
 include Makefile.shared
 
 allopt: stdlib.cmxa std_exit.cmx allopt-$(PROFILING)
@@ -42,9 +40,10 @@
 stdlib.p.cmxa: $(OBJS:.cmo=.p.cmx)
 	$(CAMLOPT) -a -o stdlib.p.cmxa $(OBJS:.cmo=.p.cmx)
 
-camlheader camlheader_ur: header.c ../config/Makefile
+camlheader camlheaderd camlheader_ur: header.c ../config/Makefile
 	if $(SHARPBANGSCRIPTS); then \
 	  echo '#!$(BINDIR)/ocamlrun' > camlheader && \
+	  echo '#!$(BINDIR)/ocamlrund' > camlheaderd && \
 	  echo '#!' | tr -d '\012' > camlheader_ur; \
 	else \
 	  $(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) \
@@ -52,7 +51,12 @@
 	            header.c -o tmpheader$(EXE) && \
 	  strip tmpheader$(EXE) && \
 	  mv tmpheader$(EXE) camlheader && \
-	  cp camlheader camlheader_ur; \
+	  cp camlheader camlheader_ur && \
+	  $(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) \
+	            -DRUNTIME_NAME='"$(BINDIR)/ocamlrund"' \
+	            header.c -o tmpheader$(EXE) && \
+	  strip tmpheader$(EXE) && \
+	  mv tmpheader$(EXE) camlheaderd; \
 	fi
 
 .PHONY: all allopt allopt-noprof allopt-prof install installopt
diff -Nru ocaml-3.12.1/stdlib/Makefile.nt ocaml-4.01.0/stdlib/Makefile.nt
--- ocaml-3.12.1/stdlib/Makefile.nt	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/stdlib/Makefile.nt	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,8 +11,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile.nt 9547 2010-01-22 12:48:24Z doligez $
-
 include Makefile.shared
 
 allopt: stdlib.cmxa std_exit.cmx
@@ -21,11 +19,18 @@
 	cp stdlib.cmxa stdlib.$(A) std_exit.$(O) *.cmx $(LIBDIR)
 
 camlheader camlheader_ur: headernt.c ../config/Makefile
-	$(BYTECC) $(BYTECCCOMPOPTS) -c -I../byterun headernt.c
+	$(BYTECC) $(BYTECCCOMPOPTS) -c -I../byterun \
+	          -DRUNTIME_NAME='"ocamlrun"' headernt.c
 	$(MKEXE) -o tmpheader.exe headernt.$(O) $(EXTRALIBS)
 	rm -f camlheader.exe
 	mv tmpheader.exe camlheader
 	cp camlheader camlheader_ur
 
+camlheaderd: headernt.c ../config/Makefile
+	$(BYTECC) $(BYTECCCOMPOPTS) -c -I../byterun \
+	          -DRUNTIME_NAME='"ocamlrund"' headernt.c
+	$(MKEXE) -o tmpheader.exe headernt.$(O) $(EXTRALIBS)
+	mv tmpheader.exe camlheaderd
+
 # TODO: do not call flexlink to build tmpheader.exe (we don't need
 # the export table)
diff -Nru ocaml-3.12.1/stdlib/Makefile.shared ocaml-4.01.0/stdlib/Makefile.shared
--- ocaml-3.12.1/stdlib/Makefile.shared	2010-05-21 11:28:21.000000000 +0000
+++ ocaml-4.01.0/stdlib/Makefile.shared	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -11,13 +11,11 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile.shared 10448 2010-05-21 11:28:21Z doligez $
-
 include ../config/Makefile
 RUNTIME=../boot/ocamlrun
 COMPILER=../ocamlc
 CAMLC=$(RUNTIME) $(COMPILER)
-COMPFLAGS=-strict-sequence -g -warn-error A -nostdlib
+COMPFLAGS=-strict-sequence -w +33..39 -g -warn-error A -nostdlib
 OPTCOMPILER=../ocamlopt
 CAMLOPT=$(RUNTIME) $(OPTCOMPILER)
 OPTCOMPFLAGS=-warn-error A -nostdlib -g
@@ -25,14 +23,14 @@
 
 OBJS=pervasives.cmo $(OTHERS)
 OTHERS=array.cmo list.cmo char.cmo string.cmo sys.cmo \
-  hashtbl.cmo sort.cmo marshal.cmo obj.cmo \
+  sort.cmo marshal.cmo obj.cmo \
   int32.cmo int64.cmo nativeint.cmo \
   lexing.cmo parsing.cmo \
   set.cmo map.cmo stack.cmo queue.cmo \
   camlinternalLazy.cmo lazy.cmo stream.cmo \
-  buffer.cmo printf.cmo format.cmo scanf.cmo \
+  buffer.cmo printf.cmo \
   arg.cmo printexc.cmo gc.cmo \
-  digest.cmo random.cmo callback.cmo \
+  digest.cmo random.cmo hashtbl.cmo format.cmo scanf.cmo callback.cmo \
   camlinternalOO.cmo oo.cmo camlinternalMod.cmo \
   genlex.cmo weak.cmo \
   filename.cmo complex.cmo \
@@ -40,8 +38,16 @@
 
 all: stdlib.cma std_exit.cmo camlheader camlheader_ur
 
-install:
-	cp stdlib.cma std_exit.cmo *.cmi *.mli *.ml camlheader camlheader_ur $(LIBDIR)
+install: install-$(RUNTIMED)
+	cp stdlib.cma std_exit.cmo *.cmi *.mli *.ml camlheader camlheader_ur \
+	  $(LIBDIR)
+
+install-noruntimed:
+.PHONY: install-noruntimed
+
+install-runtimed: camlheaderd
+	cp camlheaderd $(LIBDIR)
+.PHONY: install-runtimed
 
 stdlib.cma: $(OBJS)
 	$(CAMLC) -a -o stdlib.cma $(OBJS)
@@ -56,7 +62,7 @@
 	rm -f sys.ml
 
 clean::
-	rm -f camlheader camlheader_ur
+	rm -f camlheader camlheader_ur camlheaderd
 
 .SUFFIXES: .mli .ml .cmi .cmo .cmx .p.cmx
 
diff -Nru ocaml-3.12.1/stdlib/StdlibModules ocaml-4.01.0/stdlib/StdlibModules
--- ocaml-3.12.1/stdlib/StdlibModules	2008-08-01 16:57:10.000000000 +0000
+++ ocaml-4.01.0/stdlib/StdlibModules	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,20 @@
-# This file lists all standard library modules. -*- Makefile -*-
+# -*- Makefile -*-
+
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
+#                                                                       #
+#   Copyright 2002 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the GNU Library General Public License, with     #
+#   the special exception on linking described in file ../LICENSE.      #
+#                                                                       #
+#########################################################################
+
+# This file lists all standard library modules.
 # It is used in particular to know what to expunge in toplevels.
-# $Id: StdlibModules 8974 2008-08-01 16:57:10Z mauny $
 
 STDLIB_MODULES=\
   arg \
diff -Nru ocaml-3.12.1/stdlib/arg.ml ocaml-4.01.0/stdlib/arg.ml
--- ocaml-3.12.1/stdlib/arg.ml	2011-05-09 07:28:57.000000000 +0000
+++ ocaml-4.01.0/stdlib/arg.ml	2013-06-13 11:26:16.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*             Damien Doligez, projet Para, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: arg.ml 11028 2011-05-09 07:28:57Z xclerc $ *)
-
 type key = string
 type doc = string
 type usage_msg = string
@@ -64,10 +62,12 @@
 ;;
 
 let print_spec buf (key, spec, doc) =
-  match spec with
-  | Symbol (l, _) -> bprintf buf "  %s %s%s\n" key (make_symlist "{" "|" "}" l)
-                             doc
-  | _ -> bprintf buf "  %s %s\n" key doc
+  if String.length doc > 0 then
+    match spec with
+    | Symbol (l, _) ->
+        bprintf buf "  %s %s%s\n" key (make_symlist "{" "|" "}" l) doc
+    | _ ->
+        bprintf buf "  %s %s\n" key doc
 ;;
 
 let help_action () = raise (Stop (Unknown "-help"));;
@@ -102,7 +102,7 @@
 
 let current = ref 0;;
 
-let parse_argv ?(current=current) argv speclist anonfun errmsg =
+let parse_argv_dynamic ?(current=current) argv speclist anonfun errmsg =
   let l = Array.length argv in
   let b = Buffer.create 200 in
   let initpos = !current in
@@ -121,7 +121,7 @@
       | Message s ->
           bprintf b "%s: %s.\n" progname s
     end;
-    usage_b b speclist errmsg;
+    usage_b b !speclist errmsg;
     if error = Unknown "-help" || error = Unknown "--help"
     then raise (Help (Buffer.contents b))
     else raise (Bad (Buffer.contents b))
@@ -131,7 +131,7 @@
     let s = argv.(!current) in
     if String.length s >= 1 && String.get s 0 = '-' then begin
       let action =
-        try assoc3 s speclist
+        try assoc3 s !speclist
         with Not_found -> stop (Unknown s)
       in
       begin try
@@ -210,6 +210,10 @@
   done;
 ;;
 
+let parse_argv ?(current=current) argv speclist anonfun errmsg =
+  parse_argv_dynamic ~current:current argv (ref speclist) anonfun errmsg;
+;;
+
 let parse l f msg =
   try
     parse_argv Sys.argv l f msg;
@@ -218,7 +222,15 @@
   | Help msg -> printf "%s" msg; exit 0;
 ;;
 
-let rec second_word s =
+let parse_dynamic l f msg =
+  try
+    parse_argv_dynamic Sys.argv l f msg;
+  with
+  | Bad msg -> eprintf "%s" msg; exit 2;
+  | Help msg -> printf "%s" msg; exit 0;
+;;
+
+let second_word s =
   let len = String.length s in
   let rec loop n =
     if n >= len then len
@@ -237,6 +249,10 @@
 
 let add_padding len ksd =
   match ksd with
+  | (_, _, "") ->
+      (* Do not pad undocumented options, so that they still don't show up when
+       * run through [usage] or [parse]. *)
+      ksd
   | (kwd, (Symbol (l, _) as spec), msg) ->
       let cutcol = second_word msg in
       let spaces = String.make (len - cutcol + 3) ' ' in
diff -Nru ocaml-3.12.1/stdlib/arg.mli ocaml-4.01.0/stdlib/arg.mli
--- ocaml-3.12.1/stdlib/arg.mli	2011-05-09 11:39:33.000000000 +0000
+++ ocaml-4.01.0/stdlib/arg.mli	2013-06-13 11:26:16.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*             Damien Doligez, projet Para, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: arg.mli 11031 2011-05-09 11:39:33Z doligez $ *)
-
 (** Parsing of command line arguments.
 
    This module provides a general mechanism for extracting options and
@@ -83,6 +81,8 @@
 -   The reason for the error: unknown option, invalid or missing argument, etc.
 -   [usage_msg]
 -   The list of options, each followed by the corresponding [doc] string.
+    Beware: options that have an empty [doc] string will not be included in the
+    list.
 
     For the user to be able to specify anonymous arguments starting with a
     [-], include for example [("-", String anon_fun, doc)] in [speclist].
@@ -93,6 +93,15 @@
     by specifying your own [-help] and [--help] options in [speclist].
 *)
 
+val parse_dynamic :
+  (string * spec * string) list ref -> anon_fun -> string -> unit
+(** Same as {!Arg.parse}, except that the [speclist] argument is a reference
+    and may be updated during the parsing. A typical use for this feature
+    is to parse command lines of the form:
+-     command subcommand [options]
+    where the list of options depends on the value of the subcommand argument.
+*)
+
 val parse_argv : ?current: int ref -> string array ->
   (key * spec * doc) list -> anon_fun -> usage_msg -> unit
 (** [Arg.parse_argv ~current args speclist anon_fun usage_msg] parses
@@ -106,6 +115,13 @@
   as argument.
 *)
 
+val parse_argv_dynamic : ?current:int ref -> string array ->
+  (string * spec * string) list ref -> anon_fun -> string -> unit
+(** Same as {!Arg.parse_argv}, except that the [speclist] argument is a
+    reference and may be updated during the parsing.
+    See {!Arg.parse_dynamic}.
+*)
+
 exception Help of string
 (** Raised by [Arg.parse_argv] when the user asks for help. *)
 
diff -Nru ocaml-3.12.1/stdlib/array.ml ocaml-4.01.0/stdlib/array.ml
--- ocaml-3.12.1/stdlib/array.ml	2010-05-31 12:46:27.000000000 +0000
+++ ocaml-4.01.0/stdlib/array.ml	2013-03-09 22:38:52.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                           OCaml                                     *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: array.ml 10482 2010-05-31 12:46:27Z doligez $ *)
-
 (* Array operations *)
 
 external length : 'a array -> int = "%array_length"
@@ -22,6 +20,11 @@
 external unsafe_set: 'a array -> int -> 'a -> unit = "%array_unsafe_set"
 external make: int -> 'a -> 'a array = "caml_make_vect"
 external create: int -> 'a -> 'a array = "caml_make_vect"
+external unsafe_sub : 'a array -> int -> int -> 'a array = "caml_array_sub"
+external append_prim : 'a array -> 'a array -> 'a array = "caml_array_append"
+external concat : 'a array list -> 'a array = "caml_array_concat"
+external unsafe_blit :
+  'a array -> int -> 'a array -> int -> int -> unit = "caml_array_blit"
 
 let init l f =
   if l = 0 then [||] else
@@ -41,58 +44,18 @@
 let create_matrix = make_matrix
 
 let copy a =
-  let l = length a in
-  if l = 0 then [||] else begin
-    let res = create l (unsafe_get a 0) in
-    for i = 1 to pred l do
-      unsafe_set res i (unsafe_get a i)
-    done;
-    res
-  end
+  let l = length a in if l = 0 then [||] else unsafe_sub a 0 l
 
 let append a1 a2 =
-  let l1 = length a1 and l2 = length a2 in
-  if l1 = 0 && l2 = 0 then [||] else begin
-    let r = create (l1 + l2) (unsafe_get (if l1 > 0 then a1 else a2) 0) in
-    for i = 0 to l1 - 1 do unsafe_set r i (unsafe_get a1 i) done;
-    for i = 0 to l2 - 1 do unsafe_set r (i + l1) (unsafe_get a2 i) done;
-    r
-  end
-
-let concat_aux init al =
-  let rec size accu = function
-    | [] -> accu
-    | h::t -> size (accu + length h) t
-  in
-  let res = create (size 0 al) init in
-  let rec fill pos = function
-    | [] -> ()
-    | h::t ->
-        for i = 0 to length h - 1 do
-          unsafe_set res (pos + i) (unsafe_get h i);
-        done;
-        fill (pos + length h) t;
-  in
-  fill 0 al;
-  res
-;;
-
-let concat al =
-  let rec find_init aa =
-    match aa with
-    | [] -> [||]
-    | a :: rem ->
-        if length a > 0 then concat_aux (unsafe_get a 0) aa else find_init rem
-  in find_init al
+  let l1 = length a1 in
+  if l1 = 0 then copy a2
+  else if length a2 = 0 then unsafe_sub a1 0 l1
+  else append_prim a1 a2
 
 let sub a ofs len =
-  if ofs < 0 || len < 0 || ofs > length a - len then invalid_arg "Array.sub"
-  else if len = 0 then [||]
-  else begin
-    let r = create len (unsafe_get a ofs) in
-    for i = 1 to len - 1 do unsafe_set r i (unsafe_get a (ofs + i)) done;
-    r
-  end
+  if len < 0 || ofs > length a - len
+  then invalid_arg "Array.sub"
+  else unsafe_sub a ofs len
 
 let fill a ofs len v =
   if ofs < 0 || len < 0 || ofs > length a - len
@@ -103,16 +66,7 @@
   if len < 0 || ofs1 < 0 || ofs1 > length a1 - len
              || ofs2 < 0 || ofs2 > length a2 - len
   then invalid_arg "Array.blit"
-  else if ofs1 < ofs2 then
-    (* Top-down copy *)
-    for i = len - 1 downto 0 do
-      unsafe_set a2 (ofs2 + i) (unsafe_get a1 (ofs1 + i))
-    done
-  else
-    (* Bottom-up copy *)
-    for i = 0 to len - 1 do
-      unsafe_set a2 (ofs2 + i) (unsafe_get a1 (ofs1 + i))
-    done
+  else unsafe_blit a1 ofs1 a2 ofs2 len
 
 let iter f a =
   for i = 0 to length a - 1 do f(unsafe_get a i) done
@@ -197,7 +151,7 @@
       set a i e;
     end;
   in
-  let rec trickle l i e = try trickledown l i e with Bottom i -> set a i e in
+  let trickle l i e = try trickledown l i e with Bottom i -> set a i e in
   let rec bubbledown l i =
     let j = maxson l i in
     set a i (get a j);
diff -Nru ocaml-3.12.1/stdlib/array.mli ocaml-4.01.0/stdlib/array.mli
--- ocaml-3.12.1/stdlib/array.mli	2005-10-25 18:34:07.000000000 +0000
+++ ocaml-4.01.0/stdlib/array.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: array.mli 7164 2005-10-25 18:34:07Z doligez $ *)
-
 (** Array operations. *)
 
 external length : 'a array -> int = "%array_length"
@@ -201,5 +199,7 @@
 (**/**)
 (** {6 Undocumented functions} *)
 
+(* The following is for system use only. Do not call directly. *)
+
 external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get"
 external unsafe_set : 'a array -> int -> 'a -> unit = "%array_unsafe_set"
diff -Nru ocaml-3.12.1/stdlib/arrayLabels.ml ocaml-4.01.0/stdlib/arrayLabels.ml
--- ocaml-3.12.1/stdlib/arrayLabels.ml	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/stdlib/arrayLabels.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*               Jacques Garrigue, Kyoto University RIMS               *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: arrayLabels.ml 4144 2001-12-07 13:41:02Z xleroy $ *)
-
 (* Module [ArrayLabels]: labelled Array module *)
 
 include Array
diff -Nru ocaml-3.12.1/stdlib/arrayLabels.mli ocaml-4.01.0/stdlib/arrayLabels.mli
--- ocaml-3.12.1/stdlib/arrayLabels.mli	2007-01-22 08:06:09.000000000 +0000
+++ ocaml-4.01.0/stdlib/arrayLabels.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: arrayLabels.mli 7805 2007-01-22 08:06:09Z garrigue $ *)
-
 (** Array operations. *)
 
 external length : 'a array -> int = "%array_length"
@@ -205,5 +203,7 @@
 
 (** {6 Undocumented functions} *)
 
+(* The following is for system use only. Do not call directly. *)
+
 external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get"
 external unsafe_set : 'a array -> int -> 'a -> unit = "%array_unsafe_set"
diff -Nru ocaml-3.12.1/stdlib/buffer.ml ocaml-4.01.0/stdlib/buffer.ml
--- ocaml-3.12.1/stdlib/buffer.ml	2010-03-28 08:16:45.000000000 +0000
+++ ocaml-4.01.0/stdlib/buffer.ml	2012-10-17 21:01:38.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*   Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt  *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: buffer.ml 10216 2010-03-28 08:16:45Z xleroy $ *)
-
 (* Extensible buffers *)
 
 type t =
@@ -131,12 +129,7 @@
   let rec advance i lim =
     if i >= lim then lim else
     match s.[i] with
-    | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' |
-      'é'|'à'|'á'|'è'|'ù'|'â'|'ê'|
-      'î'|'ô'|'û'|'ë'|'ï'|'ü'|'ç'|
-      'É'|'À'|'Á'|'È'|'Ù'|'Â'|'Ê'|
-      'Î'|'Ô'|'Û'|'Ë'|'Ï'|'Ü'|'Ç' ->
-      advance (i + 1) lim
+    | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> advance (i + 1) lim
     | _ -> i in
   advance start (String.length s);;
 
diff -Nru ocaml-3.12.1/stdlib/buffer.mli ocaml-4.01.0/stdlib/buffer.mli
--- ocaml-3.12.1/stdlib/buffer.mli	2010-05-21 18:30:12.000000000 +0000
+++ ocaml-4.01.0/stdlib/buffer.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*  Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt   *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: buffer.mli 10457 2010-05-21 18:30:12Z doligez $ *)
-
 (** Extensible string buffers.
 
    This module implements string buffers that automatically expand
diff -Nru ocaml-3.12.1/stdlib/callback.ml ocaml-4.01.0/stdlib/callback.ml
--- ocaml-3.12.1/stdlib/callback.ml	2003-12-31 14:20:40.000000000 +0000
+++ ocaml-4.01.0/stdlib/callback.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,9 +11,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: callback.ml 6044 2003-12-31 14:20:40Z doligez $ *)
-
-(* Registering Caml values with the C runtime for later callbacks *)
+(* Registering OCaml values with the C runtime for later callbacks *)
 
 external register_named_value : string -> Obj.t -> unit
                               = "caml_register_named_value"
diff -Nru ocaml-3.12.1/stdlib/callback.mli ocaml-4.01.0/stdlib/callback.mli
--- ocaml-3.12.1/stdlib/callback.mli	2005-10-25 18:34:07.000000000 +0000
+++ ocaml-4.01.0/stdlib/callback.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,13 +11,11 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: callback.mli 7164 2005-10-25 18:34:07Z doligez $ *)
+(** Registering OCaml values with the C runtime.
 
-(** Registering Caml values with the C runtime.
-
-   This module allows Caml values to be registered with the C runtime
+   This module allows OCaml values to be registered with the C runtime
    under a symbolic name, so that C code can later call back registered
-   Caml functions, or raise registered Caml exceptions.
+   OCaml functions, or raise registered OCaml exceptions.
 *)
 
 val register : string -> 'a -> unit
@@ -30,5 +28,5 @@
    exception contained in the exception value [exn]
    under the name [n]. C code can later retrieve a handle to
    the exception by calling [caml_named_value(n)]. The exception
-   value thus obtained is suitable for passign as first argument
+   value thus obtained is suitable for passing as first argument
    to [raise_constant] or [raise_with_arg]. *)
diff -Nru ocaml-3.12.1/stdlib/camlinternalLazy.ml ocaml-4.01.0/stdlib/camlinternalLazy.ml
--- ocaml-3.12.1/stdlib/camlinternalLazy.ml	2008-08-01 16:57:10.000000000 +0000
+++ ocaml-4.01.0/stdlib/camlinternalLazy.ml	2013-03-09 22:38:52.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Damien Doligez, projet Para, INRIA Rocquencourt          *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: camlinternalLazy.ml 8974 2008-08-01 16:57:10Z mauny $ *)
-
 (* Internals of forcing lazy values. *)
 
 exception Undefined;;
@@ -25,7 +23,8 @@
   Obj.set_field (Obj.repr blk) 0 raise_undefined;
   try
     let result = closure () in
-    Obj.set_field (Obj.repr blk) 0 (Obj.repr result);  (* do set_field BEFORE set_tag *)
+    (* do set_field BEFORE set_tag *)
+    Obj.set_field (Obj.repr blk) 0 (Obj.repr result);
     Obj.set_tag (Obj.repr blk) Obj.forward_tag;
     result
   with e ->
@@ -38,7 +37,8 @@
   let closure = (Obj.obj (Obj.field (Obj.repr blk) 0) : unit -> 'arg) in
   Obj.set_field (Obj.repr blk) 0 raise_undefined;
   let result = closure () in
-  Obj.set_field (Obj.repr blk) 0 (Obj.repr result);  (* do set_field BEFORE set_tag *)
+  (* do set_field BEFORE set_tag *)
+  Obj.set_field (Obj.repr blk) 0 (Obj.repr result);
   Obj.set_tag (Obj.repr blk) (Obj.forward_tag);
   result
 ;;
diff -Nru ocaml-3.12.1/stdlib/camlinternalLazy.mli ocaml-4.01.0/stdlib/camlinternalLazy.mli
--- ocaml-3.12.1/stdlib/camlinternalLazy.mli	2008-08-01 16:57:10.000000000 +0000
+++ ocaml-4.01.0/stdlib/camlinternalLazy.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Damien Doligez, projet Para, INRIA Rocquencourt          *)
 (*                                                                     *)
@@ -11,9 +11,9 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: camlinternalLazy.mli 8974 2008-08-01 16:57:10Z mauny $ *)
-
-(* Internals of forcing lazy values *)
+(** Run-time support for lazy values.
+    All functions in this module are for system use only, not for the
+    casual user. *)
 
 exception Undefined;;
 
diff -Nru ocaml-3.12.1/stdlib/camlinternalMod.ml ocaml-4.01.0/stdlib/camlinternalMod.ml
--- ocaml-3.12.1/stdlib/camlinternalMod.ml	2008-01-11 16:13:18.000000000 +0000
+++ ocaml-4.01.0/stdlib/camlinternalMod.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*         Xavier Leroy, projet Cristal, INRIA Rocquencourt            *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: camlinternalMod.ml 8768 2008-01-11 16:13:18Z doligez $ *)
-
 type shape =
   | Function
   | Lazy
diff -Nru ocaml-3.12.1/stdlib/camlinternalMod.mli ocaml-4.01.0/stdlib/camlinternalMod.mli
--- ocaml-3.12.1/stdlib/camlinternalMod.mli	2004-08-12 12:57:00.000000000 +0000
+++ ocaml-4.01.0/stdlib/camlinternalMod.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*         Xavier Leroy, projet Cristal, INRIA Rocquencourt            *)
 (*                                                                     *)
@@ -11,7 +11,9 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: camlinternalMod.mli 6586 2004-08-12 12:57:00Z xleroy $ *)
+(** Run-time support for recursive modules.
+    All functions in this module are for system use only, not for the
+    casual user. *)
 
 type shape =
   | Function
diff -Nru ocaml-3.12.1/stdlib/camlinternalOO.ml ocaml-4.01.0/stdlib/camlinternalOO.ml
--- ocaml-3.12.1/stdlib/camlinternalOO.ml	2008-01-11 16:13:18.000000000 +0000
+++ ocaml-4.01.0/stdlib/camlinternalOO.ml	2013-03-19 07:22:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*         Jerome Vouillon, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,15 +11,12 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: camlinternalOO.ml 8768 2008-01-11 16:13:18Z doligez $ *)
-
 open Obj
 
 (**** Object representation ****)
 
 let last_id = ref 0
-let new_id () =
-  let id = !last_id in incr last_id; id
+let () = Callback.register "CamlinternalOO.last_id" last_id
 
 let set_id o id =
   let id0 = !id in
@@ -59,6 +56,7 @@
 (**** Items ****)
 
 type item = DummyA | DummyB | DummyC of int
+let _ = [DummyA; DummyB; DummyC 0] (* to avoid warnings *)
 
 let dummy_item = (magic () : item)
 
@@ -68,6 +66,8 @@
 type label = int
 type closure = item
 type t = DummyA | DummyB | DummyC of int
+let _ = [DummyA; DummyB; DummyC 0] (* to avoid warnings *)
+
 type obj = t array
 external ret : (obj -> 'a) -> closure = "%identity"
 
@@ -87,12 +87,15 @@
 
 (**** Sparse array ****)
 
-module Vars = Map.Make(struct type t = string let compare = compare end)
+module Vars =
+  Map.Make(struct type t = string let compare (x:t) y = compare x y end)
 type vars = int Vars.t
 
-module Meths = Map.Make(struct type t = string let compare = compare end)
+module Meths =
+  Map.Make(struct type t = string let compare (x:t) y = compare x y end)
 type meths = label Meths.t
-module Labs = Map.Make(struct type t = label let compare = compare end)
+module Labs =
+  Map.Make(struct type t = label let compare (x:t) y = compare x y end)
 type labs = bool Labs.t
 
 (* The compiler assumes that the first field of this structure is [size]. *)
@@ -290,7 +293,8 @@
   table.initializers <- f::table.initializers
 
 (*
-module Keys = Map.Make(struct type t = tag array let compare = compare end)
+module Keys =
+  Map.Make(struct type t = tag array let compare (x:t) y = compare x y end)
 let key_map = ref Keys.empty
 let get_key tags : item =
   try magic (Keys.find tags !key_map : tag array)
diff -Nru ocaml-3.12.1/stdlib/camlinternalOO.mli ocaml-4.01.0/stdlib/camlinternalOO.mli
--- ocaml-3.12.1/stdlib/camlinternalOO.mli	2006-04-05 02:28:13.000000000 +0000
+++ ocaml-4.01.0/stdlib/camlinternalOO.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*         Jerome Vouillon, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: camlinternalOO.mli 7372 2006-04-05 02:28:13Z garrigue $ *)
-
 (** Run-time support for objects and classes.
     All functions in this module are for system use only, not for the
     casual user. *)
diff -Nru ocaml-3.12.1/stdlib/char.ml ocaml-4.01.0/stdlib/char.ml
--- ocaml-3.12.1/stdlib/char.ml	2007-04-16 11:06:51.000000000 +0000
+++ ocaml-4.01.0/stdlib/char.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: char.ml 8189 2007-04-16 11:06:51Z weis $ *)
-
 (* Character operations *)
 
 external code: char -> int = "%identity"
diff -Nru ocaml-3.12.1/stdlib/char.mli ocaml-4.01.0/stdlib/char.mli
--- ocaml-3.12.1/stdlib/char.mli	2005-10-25 18:34:07.000000000 +0000
+++ ocaml-4.01.0/stdlib/char.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: char.mli 7164 2005-10-25 18:34:07Z doligez $ *)
-
 (** Character operations. *)
 
 external code : char -> int = "%identity"
@@ -26,7 +24,7 @@
 val escaped : char -> string
 (** Return a string representing the given character,
    with special characters escaped following the lexical conventions
-   of Objective Caml. *)
+   of OCaml. *)
 
 val lowercase : char -> char
 (** Convert the given character to its equivalent lowercase character. *)
@@ -45,4 +43,6 @@
 
 (**/**)
 
+(* The following is for system use only. Do not call directly. *)
+
 external unsafe_chr : int -> char = "%identity"
diff -Nru ocaml-3.12.1/stdlib/complex.ml ocaml-4.01.0/stdlib/complex.ml
--- ocaml-3.12.1/stdlib/complex.ml	2005-10-25 18:34:07.000000000 +0000
+++ ocaml-4.01.0/stdlib/complex.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: complex.ml 7164 2005-10-25 18:34:07Z doligez $ *)
-
 (* Complex numbers *)
 
 type t = { re: float; im: float }
diff -Nru ocaml-3.12.1/stdlib/complex.mli ocaml-4.01.0/stdlib/complex.mli
--- ocaml-3.12.1/stdlib/complex.mli	2005-10-25 18:34:07.000000000 +0000
+++ ocaml-4.01.0/stdlib/complex.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: complex.mli 7164 2005-10-25 18:34:07Z doligez $ *)
-
 (** Complex numbers.
 
     This module provides arithmetic operations on complex numbers.
diff -Nru ocaml-3.12.1/stdlib/digest.ml ocaml-4.01.0/stdlib/digest.ml
--- ocaml-3.12.1/stdlib/digest.ml	2003-12-31 14:20:40.000000000 +0000
+++ ocaml-4.01.0/stdlib/digest.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,12 +11,12 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: digest.ml 6044 2003-12-31 14:20:40Z doligez $ *)
-
 (* Message digest (MD5) *)
 
 type t = string
 
+let compare = String.compare
+
 external unsafe_string: string -> int -> int -> t = "caml_md5_string"
 external channel: in_channel -> int -> t = "caml_md5_chan"
 
@@ -48,4 +48,19 @@
     String.blit (Printf.sprintf "%02x" (int_of_char d.[i])) 0 result (2*i) 2;
   done;
   result
-;;
+
+let from_hex s =
+  if String.length s <> 32 then raise (Invalid_argument "Digest.from_hex");
+  let digit c =
+    match c with
+    | '0'..'9' -> Char.code c - Char.code '0'
+    | 'A'..'F' -> Char.code c - Char.code 'A' + 10
+    | 'a'..'f' -> Char.code c - Char.code 'a' + 10
+    | _ -> raise (Invalid_argument "Digest.from_hex")
+  in
+  let byte i = digit s.[i] lsl 4 + digit s.[i+1] in
+  let result = String.create 16 in
+  for i = 0 to 15 do
+    result.[i] <- Char.chr (byte (2 * i));
+  done;
+  result
diff -Nru ocaml-3.12.1/stdlib/digest.mli ocaml-4.01.0/stdlib/digest.mli
--- ocaml-3.12.1/stdlib/digest.mli	2005-10-25 18:34:07.000000000 +0000
+++ ocaml-4.01.0/stdlib/digest.mli	2013-05-29 18:03:55.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,19 +11,28 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: digest.mli 7164 2005-10-25 18:34:07Z doligez $ *)
-
 (** MD5 message digest.
 
-   This module provides functions to compute 128-bit ``digests'' of
+   This module provides functions to compute 128-bit 'digests' of
    arbitrary-length strings or files. The digests are of cryptographic
    quality: it is very hard, given a digest, to forge a string having
-   that digest. The algorithm used is MD5.
+   that digest. The algorithm used is MD5. This module should not be
+   used for secure and sensitive cryptographic applications. For these
+   kind of applications more recent and stronger cryptographic
+   primitives should be used instead.
 *)
 
 type t = string
 (** The type of digests: 16-character strings. *)
 
+val compare : t -> t -> int
+(** The comparison function for 16-character digest, with the same
+    specification as {!Pervasives.compare} and the implementation
+    shared with {!String.compare}. Along with the type [t], this
+    function [compare] allows the module [Digest] to be passed as
+    argument to the functors {!Set.Make} and {!Map.Make}.
+    @since 4.00.0 *)
+
 val string : string -> t
 (** Return the digest of the given string. *)
 
@@ -51,3 +60,9 @@
 
 val to_hex : t -> string
 (** Return the printable hexadecimal representation of the given digest. *)
+
+val from_hex : string -> t
+(** Convert a hexadecimal representation back into the corresponding digest.
+   Raise [Invalid_argument] if the argument is not exactly 32 hexadecimal
+   characters.
+   @since 4.00.0 *)
diff -Nru ocaml-3.12.1/stdlib/filename.ml ocaml-4.01.0/stdlib/filename.ml
--- ocaml-3.12.1/stdlib/filename.ml	2010-01-20 16:26:46.000000000 +0000
+++ ocaml-4.01.0/stdlib/filename.ml	2013-03-09 22:38:52.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*          Xavier Leroy and Damien Doligez, INRIA Rocquencourt        *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: filename.ml 9540 2010-01-20 16:26:46Z doligez $ *)
-
 let generic_quote quotequote s =
   let l = String.length s in
   let b = Buffer.create (l + 20) in
@@ -25,30 +23,55 @@
   Buffer.add_char b '\'';
   Buffer.contents b
 
-let generic_basename rindex_dir_sep current_dir_name name =
-  let raw_name =
-    try
-      let p = rindex_dir_sep name + 1 in
-      String.sub name p (String.length name - p)
-    with Not_found ->
-      name
+(* This function implements the Open Group specification found here:
+  [[1]] http://pubs.opengroup.org/onlinepubs/9699919799/utilities/basename.html
+  In step 1 of [[1]], we choose to return "." for empty input.
+    (for compatibility with previous versions of OCaml)
+  In step 2, we choose to process "//" normally.
+  Step 6 is not implemented: we consider that the [suffix] operand is
+    always absent.  Suffixes are handled by [chop_suffix] and [chop_extension].
+*)
+let generic_basename is_dir_sep current_dir_name name =
+  let rec find_end n =
+    if n < 0 then String.sub name 0 1
+    else if is_dir_sep name n then find_end (n - 1)
+    else find_beg n (n + 1)
+  and find_beg n p =
+    if n < 0 then String.sub name 0 p
+    else if is_dir_sep name n then String.sub name (n + 1) (p - n - 1)
+    else find_beg (n - 1) p
   in
-  if raw_name = "" then current_dir_name else raw_name
-
-let generic_dirname rindex_dir_sep current_dir_name dir_sep name =
-  try
-    match rindex_dir_sep name with
-      0 -> dir_sep
-    | n -> String.sub name 0 n
-  with Not_found ->
-    current_dir_name
+  if name = ""
+  then current_dir_name
+  else find_end (String.length name - 1)
+
+(* This function implements the Open Group specification found here:
+  [[2]] http://pubs.opengroup.org/onlinepubs/9699919799/utilities/dirname.html
+  In step 6 of [[2]], we choose to process "//" normally.
+*)
+let generic_dirname is_dir_sep current_dir_name name =
+  let rec trailing_sep n =
+    if n < 0 then String.sub name 0 1
+    else if is_dir_sep name n then trailing_sep (n - 1)
+    else base n
+  and base n =
+    if n < 0 then current_dir_name
+    else if is_dir_sep name n then intermediate_sep n
+    else base (n - 1)
+  and intermediate_sep n =
+    if n < 0 then String.sub name 0 1
+    else if is_dir_sep name n then intermediate_sep (n - 1)
+    else String.sub name 0 (n + 1)
+  in
+  if name = ""
+  then current_dir_name
+  else trailing_sep (String.length name - 1)
 
 module Unix = struct
   let current_dir_name = "."
   let parent_dir_name = ".."
   let dir_sep = "/"
   let is_dir_sep s i = s.[i] = '/'
-  let rindex_dir_sep s = String.rindex s '/'
   let is_relative n = String.length n < 1 || n.[0] <> '/';;
   let is_implicit n =
     is_relative n
@@ -61,8 +84,8 @@
   let temp_dir_name =
     try Sys.getenv "TMPDIR" with Not_found -> "/tmp"
   let quote = generic_quote "'\\''"
-  let basename = generic_basename rindex_dir_sep current_dir_name
-  let dirname = generic_dirname rindex_dir_sep current_dir_name dir_sep
+  let basename = generic_basename is_dir_sep current_dir_name
+  let dirname = generic_dirname is_dir_sep current_dir_name
 end
 
 module Win32 = struct
@@ -70,12 +93,6 @@
   let parent_dir_name = ".."
   let dir_sep = "\\"
   let is_dir_sep s i = let c = s.[i] in c = '/' || c = '\\' || c = ':'
-  let rindex_dir_sep s =
-    let rec pos i =
-      if i < 0 then raise Not_found
-      else if is_dir_sep s i then i
-      else pos (i - 1)
-    in pos (String.length s - 1)
   let is_relative n =
     (String.length n < 1 || n.[0] <> '/')
     && (String.length n < 1 || n.[0] <> '\\')
@@ -113,7 +130,7 @@
         | '\\' -> loop_bs (n+1) (i+1);
         | c    -> add_bs n; loop i
       end
-    and add_bs n = for j = 1 to n do Buffer.add_char b '\\'; done
+    and add_bs n = for _j = 1 to n do Buffer.add_char b '\\'; done
     in
     loop 0;
     Buffer.contents b
@@ -129,11 +146,11 @@
     else ("", s)
   let dirname s =
     let (drive, path) = drive_and_path s in
-    let dir = generic_dirname rindex_dir_sep current_dir_name dir_sep path in
+    let dir = generic_dirname is_dir_sep current_dir_name path in
     drive ^ dir
   let basename s =
     let (drive, path) = drive_and_path s in
-    generic_basename rindex_dir_sep current_dir_name path
+    generic_basename is_dir_sep current_dir_name path
 end
 
 module Cygwin = struct
@@ -141,33 +158,32 @@
   let parent_dir_name = ".."
   let dir_sep = "/"
   let is_dir_sep = Win32.is_dir_sep
-  let rindex_dir_sep = Win32.rindex_dir_sep
   let is_relative = Win32.is_relative
   let is_implicit = Win32.is_implicit
   let check_suffix = Win32.check_suffix
   let temp_dir_name = Unix.temp_dir_name
   let quote = Unix.quote
-  let basename = generic_basename rindex_dir_sep current_dir_name
-  let dirname = generic_dirname rindex_dir_sep current_dir_name dir_sep
+  let basename = generic_basename is_dir_sep current_dir_name
+  let dirname = generic_dirname is_dir_sep current_dir_name
 end
 
-let (current_dir_name, parent_dir_name, dir_sep, is_dir_sep, rindex_dir_sep,
+let (current_dir_name, parent_dir_name, dir_sep, is_dir_sep,
      is_relative, is_implicit, check_suffix, temp_dir_name, quote, basename,
      dirname) =
   match Sys.os_type with
     "Unix" ->
       (Unix.current_dir_name, Unix.parent_dir_name, Unix.dir_sep,
-       Unix.is_dir_sep, Unix.rindex_dir_sep,
+       Unix.is_dir_sep,
        Unix.is_relative, Unix.is_implicit, Unix.check_suffix,
        Unix.temp_dir_name, Unix.quote, Unix.basename, Unix.dirname)
   | "Win32" ->
       (Win32.current_dir_name, Win32.parent_dir_name, Win32.dir_sep,
-       Win32.is_dir_sep, Win32.rindex_dir_sep,
+       Win32.is_dir_sep,
        Win32.is_relative, Win32.is_implicit, Win32.check_suffix,
        Win32.temp_dir_name, Win32.quote, Win32.basename, Win32.dirname)
   | "Cygwin" ->
       (Cygwin.current_dir_name, Cygwin.parent_dir_name, Cygwin.dir_sep,
-       Cygwin.is_dir_sep, Cygwin.rindex_dir_sep,
+       Cygwin.is_dir_sep,
        Cygwin.is_relative, Cygwin.is_implicit, Cygwin.check_suffix,
        Cygwin.temp_dir_name, Cygwin.quote, Cygwin.basename, Cygwin.dirname)
   | _ -> assert false
@@ -192,14 +208,19 @@
 external open_desc: string -> open_flag list -> int -> int = "caml_sys_open"
 external close_desc: int -> unit = "caml_sys_close"
 
-let prng = Random.State.make_self_init ();;
+let prng = lazy(Random.State.make_self_init ());;
 
 let temp_file_name temp_dir prefix suffix =
-  let rnd = (Random.State.bits prng) land 0xFFFFFF in
+  let rnd = (Random.State.bits (Lazy.force prng)) land 0xFFFFFF in
   concat temp_dir (Printf.sprintf "%s%06x%s" prefix rnd suffix)
 ;;
 
-let temp_file ?(temp_dir=temp_dir_name) prefix suffix =
+let current_temp_dir_name = ref temp_dir_name
+
+let set_temp_dir_name s = current_temp_dir_name := s
+let get_temp_dir_name () = !current_temp_dir_name
+
+let temp_file ?(temp_dir = !current_temp_dir_name) prefix suffix =
   let rec try_name counter =
     let name = temp_file_name temp_dir prefix suffix in
     try
@@ -209,7 +230,8 @@
       if counter >= 1000 then raise e else try_name (counter + 1)
   in try_name 0
 
-let open_temp_file ?(mode = [Open_text]) ?(temp_dir=temp_dir_name) prefix suffix =
+let open_temp_file ?(mode = [Open_text]) ?(temp_dir = !current_temp_dir_name)
+                   prefix suffix =
   let rec try_name counter =
     let name = temp_file_name temp_dir prefix suffix in
     try
diff -Nru ocaml-3.12.1/stdlib/filename.mli ocaml-4.01.0/stdlib/filename.mli
--- ocaml-3.12.1/stdlib/filename.mli	2011-02-21 15:17:38.000000000 +0000
+++ ocaml-4.01.0/stdlib/filename.mli	2013-03-09 22:38:52.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: filename.mli 10957 2011-02-21 15:17:38Z xclerc $ *)
-
 (** Operations on file names. *)
 
 val current_dir_name : string
@@ -59,17 +57,19 @@
 
 val basename : string -> string
 (** Split a file name into directory name / base file name.
-   [concat (dirname name) (basename name)] returns a file name
-   which is equivalent to [name]. Moreover, after setting the
-   current directory to [dirname name] (with {!Sys.chdir}),
+   If [name] is a valid file name, then [concat (dirname name) (basename name)]
+   returns a file name which is equivalent to [name]. Moreover,
+   after setting the current directory to [dirname name] (with {!Sys.chdir}),
    references to [basename name] (which is a relative file name)
    designate the same file as [name] before the call to {!Sys.chdir}.
 
-   The result is not specified if the argument is not a valid file name
-   (for example, under Unix if there is a NUL character in the string). *)
+   This function conforms to the specification of POSIX.1-2008 for the
+   [basename] utility. *)
 
 val dirname : string -> string
-(** See {!Filename.basename}. *)
+(** See {!Filename.basename}.
+   This function conforms to the specification of POSIX.1-2008 for the
+   [dirname] utility. *)
 
 val temp_file : ?temp_dir: string -> string -> string -> string
 (** [temp_file prefix suffix] returns the name of a
@@ -77,7 +77,7 @@
    The base name of the temporary file is formed by concatenating
    [prefix], then a suitably chosen integer number, then [suffix].
    The optional argument [temp_dir] indicates the temporary directory
-   to use, defaulting to {!Filename.temp_dir_name}.
+   to use, defaulting to the current result of {!Filename.get_temp_dir_name}.
    The temporary file is created empty, with permissions [0o600]
    (readable and writable only by the file owner).  The file is
    guaranteed to be different from any other file that existed when
@@ -87,7 +87,8 @@
 *)
 
 val open_temp_file :
-      ?mode: open_flag list -> ?temp_dir: string -> string -> string -> string * out_channel
+      ?mode: open_flag list -> ?temp_dir: string -> string -> string ->
+      string * out_channel
 (** Same as {!Filename.temp_file}, but returns both the name of a fresh
    temporary file, and an output channel opened (atomically) on
    this file.  This function is more secure than [temp_file]: there
@@ -100,12 +101,30 @@
    @before 3.11.2 no ?temp_dir optional argument
 *)
 
-val temp_dir_name : string
+val get_temp_dir_name : unit -> string
 (** The name of the temporary directory:
     Under Unix, the value of the [TMPDIR] environment variable, or "/tmp"
     if the variable is not set.
     Under Windows, the value of the [TEMP] environment variable, or "."
     if the variable is not set.
+    The temporary directory can be changed with {!Filename.set_temp_dir_name}.
+    @since 4.00.0
+*)
+
+val set_temp_dir_name : string -> unit
+(** Change the temporary directory returned by {!Filename.get_temp_dir_name}
+    and used by {!Filename.temp_file} and {!Filename.open_temp_file}.
+    @since 4.00.0
+*)
+
+val temp_dir_name : string
+(** @deprecated  The name of the initial temporary directory:
+    Under Unix, the value of the [TMPDIR] environment variable, or "/tmp"
+    if the variable is not set.
+    Under Windows, the value of the [TEMP] environment variable, or "."
+    if the variable is not set.
+    This function is deprecated; {!Filename.get_temp_dir_name} should be
+    used instead.
     @since 3.09.1
 *)
 
diff -Nru ocaml-3.12.1/stdlib/format.ml ocaml-4.01.0/stdlib/format.ml
--- ocaml-3.12.1/stdlib/format.ml	2010-05-03 09:18:20.000000000 +0000
+++ ocaml-4.01.0/stdlib/format.ml	2013-05-29 18:03:55.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Pierre Weis, projet Cristal, INRIA Rocquencourt          *)
 (*                                                                     *)
@@ -11,9 +11,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: format.ml 10348 2010-05-03 09:18:20Z weis $ *)
-
-(* A pretty-printing facility and definition of formatters for ``parallel''
+(* A pretty-printing facility and definition of formatters for 'parallel'
    (i.e. unrelated or independent) pretty-printing on multiple out channels. *)
 
 (**************************************************************
@@ -43,7 +41,7 @@
 | Pp_newline                   (* to force a newline inside a block *)
 | Pp_if_newline                (* to do something only if this very
                                   line has been broken *)
-| Pp_open_tag of string        (* opening a tag name *)
+| Pp_open_tag of tag           (* opening a tag name *)
 | Pp_close_tag                 (* closing the most recently opened tag *)
 
 and tag = string
@@ -60,7 +58,8 @@
                when it leads to a new indentation of the current line *)
 | Pp_fits   (* Internal usage: when a block fits on a single line *)
 
-and tblock = Pp_tbox of int list ref  (* Tabulation box *)
+and tblock =
+  | Pp_tbox of int list ref  (* Tabulation box *)
 ;;
 
 (* The Queue:
@@ -146,13 +145,13 @@
   (* Ellipsis string. *)
   mutable pp_ellipsis : string;
   (* Output function. *)
-  mutable pp_output_function : string -> int -> int -> unit;
+  mutable pp_out_string : string -> int -> int -> unit;
   (* Flushing function. *)
-  mutable pp_flush_function : unit -> unit;
+  mutable pp_out_flush : unit -> unit;
   (* Output of new lines. *)
-  mutable pp_output_newline : unit -> unit;
+  mutable pp_out_newline : unit -> unit;
   (* Output of indentation spaces. *)
-  mutable pp_output_spaces : int -> unit;
+  mutable pp_out_spaces : int -> unit;
   (* Are tags printed ? *)
   mutable pp_print_tags : bool;
   (* Are tags marked ? *)
@@ -182,28 +181,30 @@
 let add_queue x q =
   let c = Cons { head = x; tail = Nil; } in
   match q with
-  | { insert = Cons cell } ->
+  | { insert = Cons cell; body = _; } ->
     q.insert <- c; cell.tail <- c
   (* Invariant: when insert is Nil body should be Nil. *)
-  | _ -> q.insert <- c; q.body <- c;;
+  | { insert = Nil; body = _; } ->
+    q.insert <- c; q.body <- c
+;;
 
 exception Empty_queue;;
 
 let peek_queue = function
-  | { body = Cons { head = x; }; } -> x
-  | _ -> raise Empty_queue
+  | { body = Cons { head = x; tail = _; }; _ } -> x
+  | { body = Nil; insert = _; } -> raise Empty_queue
 ;;
 
 let take_queue = function
-  | { body = Cons { head = x; tail = tl; }; } as q ->
+  | { body = Cons { head = x; tail = tl; }; _ } as q ->
     q.body <- tl;
     if tl = Nil then q.insert <- Nil; (* Maintain the invariant. *)
     x
-  | _ -> raise Empty_queue
+  | { body = Nil; insert = _; } -> raise Empty_queue
 ;;
 
 (* Enter a token in the pretty-printer queue. *)
-let pp_enqueue state ({length = len} as token) =
+let pp_enqueue state ({ length = len; _} as token) =
   state.pp_right_total <- state.pp_right_total + len;
   add_queue token state.pp_queue
 ;;
@@ -216,7 +217,7 @@
 (* Pp_infinity: large value for default tokens size.
 
    Pp_infinity is documented as being greater than 1e10; to avoid
-   confusion about the word ``greater'', we choose pp_infinity greater
+   confusion about the word 'greater', we choose pp_infinity greater
    than 1e10 + 1; for correct handling of tests in the algorithm,
    pp_infinity must be even one more than 1e10 + 1; let's stand on the
    safe side by choosing 1.e10+10.
@@ -237,9 +238,9 @@
 let pp_infinity = 1000000010;;
 
 (* Output functions for the formatter. *)
-let pp_output_string state s = state.pp_output_function s 0 (String.length s)
-and pp_output_newline state = state.pp_output_newline ()
-and pp_display_blanks state n = state.pp_output_spaces n
+let pp_output_string state s = state.pp_out_string s 0 (String.length s)
+and pp_output_newline state = state.pp_out_newline ()
+and pp_output_spaces state n = state.pp_out_spaces n
 ;;
 
 (* To format a break, indenting a new line. *)
@@ -251,7 +252,7 @@
   let real_indent = min state.pp_max_indent indent in
   state.pp_current_indent <- real_indent;
   state.pp_space_left <- state.pp_margin - state.pp_current_indent;
-  pp_display_blanks state state.pp_current_indent
+  pp_output_spaces state state.pp_current_indent
 ;;
 
 (* To force a line break inside a block: no offset is added. *)
@@ -260,7 +261,7 @@
 (* To format a break that fits on the current line. *)
 let break_same_line state width =
   state.pp_space_left <- state.pp_space_left - width;
-  pp_display_blanks state width
+  pp_output_spaces state width
 ;;
 
 (* To indent no more than pp_max_indent, if one tries to open a block
@@ -272,15 +273,16 @@
     if width > state.pp_space_left then
       (match bl_ty with
        | Pp_fits -> () | Pp_hbox -> ()
-       | _ -> break_line state width)
-  | _ -> pp_output_newline state
+       | Pp_vbox | Pp_hvbox | Pp_hovbox | Pp_box ->
+         break_line state width)
+  | [] -> pp_output_newline state
 ;;
 
 (* To skip a token, if the previous line has been broken. *)
 let pp_skip_token state =
   (* When calling pp_skip_token the queue cannot be empty. *)
   match take_queue state.pp_queue with
-  | { elem_size = size; length = len; } ->
+  | { elem_size = size; length = len; token = _; } ->
     state.pp_left_total <- state.pp_left_total - len;
     state.pp_space_left <- state.pp_space_left + int_of_size size
 ;;
@@ -308,15 +310,16 @@
     let bl_type =
       begin match ty with
       | Pp_vbox -> Pp_vbox
-      | _ -> if size > state.pp_space_left then ty else Pp_fits
+      | Pp_hbox | Pp_hvbox | Pp_hovbox | Pp_box | Pp_fits ->
+        if size > state.pp_space_left then ty else Pp_fits
       end in
     state.pp_format_stack <-
       Format_elem (bl_type, offset) :: state.pp_format_stack
 
   | Pp_end ->
     begin match state.pp_format_stack with
-    | x :: (y :: l as ls) -> state.pp_format_stack <- ls
-    | _ -> () (* No more block to close. *)
+    | _ :: ls -> state.pp_format_stack <- ls
+    | [] -> () (* No more block to close. *)
     end
 
   | Pp_tbegin (Pp_tbox _ as tbox) ->
@@ -324,8 +327,8 @@
 
   | Pp_tend ->
     begin match state.pp_tbox_stack with
-    | x :: ls -> state.pp_tbox_stack <- ls
-    | _ -> () (* No more tabulation block to close. *)
+    | _ :: ls -> state.pp_tbox_stack <- ls
+    | [] -> () (* No more tabulation block to close. *)
     end
 
   | Pp_stab ->
@@ -335,7 +338,7 @@
         | [] -> [n]
         | x :: l as ls -> if n < x then n :: ls else x :: add_tab n l in
       tabs := add_tab (state.pp_margin - state.pp_space_left) !tabs
-    | _ -> () (* No opened tabulation block. *)
+    | [] -> () (* No opened tabulation block. *)
     end
 
   | Pp_tbreak (n, off) ->
@@ -347,7 +350,7 @@
         | [] -> raise Not_found in
       let tab =
         match !tabs with
-        | x :: l ->
+        | x :: _ ->
           begin
             try find insertion_point !tabs with
             | Not_found -> x
@@ -357,13 +360,13 @@
       if offset >= 0
       then break_same_line state (offset + n)
       else break_new_line state (tab + off) state.pp_margin
-    | _ -> () (* No opened tabulation block. *)
+    | [] -> () (* No opened tabulation block. *)
     end
 
   | Pp_newline ->
     begin match state.pp_format_stack with
     | Format_elem (_, width) :: _ -> break_line state width
-    | _ -> pp_output_newline state
+    | [] -> pp_output_newline state (* No opened block. *)
     end
 
   | Pp_if_newline ->
@@ -392,7 +395,7 @@
       | Pp_vbox -> break_new_line state off width
       | Pp_hbox -> break_same_line state n
       end
-    | _ -> () (* No opened block. *)
+    | [] -> () (* No opened block. *)
     end
 
    | Pp_open_tag tag_name ->
@@ -406,7 +409,7 @@
        let marker = state.pp_mark_close_tag tag_name in
        pp_output_string state marker;
        state.pp_mark_stack <- tags
-     | _ -> () (* No more tag to close. *)
+     | [] -> () (* No more tag to close. *)
      end
 ;;
 
@@ -474,7 +477,7 @@
   match state.pp_scan_stack with
   | Scan_elem
       (left_tot,
-       ({elem_size = size; token = tok} as queue_elem)) :: t ->
+       ({ elem_size = size; token = tok; length = _; } as queue_elem)) :: t ->
     let size = int_of_size size in
     (* test if scan stack contains any data that is not obsolete. *)
     if left_tot < state.pp_left_total then clear_scan_stack state else
@@ -491,9 +494,12 @@
           queue_elem.elem_size <- size_of_int (state.pp_right_total + size);
           state.pp_scan_stack <- t
         end
-      | _ -> () (* scan_push is only used for breaks and boxes. *)
+      | Pp_text _ | Pp_stab | Pp_tbegin _ | Pp_tend | Pp_end
+      | Pp_newline | Pp_if_newline
+      | Pp_open_tag _ | Pp_close_tag ->
+        () (* scan_push is only used for breaks and boxes. *)
       end
-  | _ -> () (* scan_stack is never empty. *)
+  | [] -> () (* scan_stack is never empty. *)
 ;;
 
 (* Push a token on scan stack. If b is true set_size is called. *)
@@ -667,9 +673,9 @@
 (* Print a new line after printing all queued text
    (same for print_flush but without a newline). *)
 let pp_print_newline state () =
-  pp_flush_queue state true; state.pp_flush_function ()
+  pp_flush_queue state true; state.pp_out_flush ()
 and pp_print_flush state () =
-  pp_flush_queue state false; state.pp_flush_function ();;
+  pp_flush_queue state false; state.pp_out_flush ();;
 
 (* To get a newline when one does not want to close the current block. *)
 let pp_force_newline state () =
@@ -800,42 +806,70 @@
 
 let pp_get_margin state () = state.pp_margin;;
 
+type formatter_out_functions = {
+  out_string : string -> int -> int -> unit;
+  out_flush : unit -> unit;
+  out_newline : unit -> unit;
+  out_spaces : int -> unit;
+}
+;;
+
+let pp_set_formatter_out_functions state {
+      out_string = f;
+      out_flush = g;
+      out_newline = h;
+      out_spaces = i;
+    } =
+  state.pp_out_string <- f;
+  state.pp_out_flush <- g;
+  state.pp_out_newline <- h;
+  state.pp_out_spaces <- i;
+;;
+
+let pp_get_formatter_out_functions state () = {
+  out_string = state.pp_out_string;
+  out_flush = state.pp_out_flush;
+  out_newline = state.pp_out_newline;
+  out_spaces = state.pp_out_spaces;
+}
+;;
+
 let pp_set_formatter_output_functions state f g =
-  state.pp_output_function <- f; state.pp_flush_function <- g;;
+  state.pp_out_string <- f; state.pp_out_flush <- g;;
 let pp_get_formatter_output_functions state () =
-  (state.pp_output_function, state.pp_flush_function)
+  (state.pp_out_string, state.pp_out_flush)
 ;;
 
 let pp_set_all_formatter_output_functions state
     ~out:f ~flush:g ~newline:h ~spaces:i =
   pp_set_formatter_output_functions state f g;
-  state.pp_output_newline <- h;
-  state.pp_output_spaces <- i;
+  state.pp_out_newline <- h;
+  state.pp_out_spaces <- i;
 ;;
 let pp_get_all_formatter_output_functions state () =
-  (state.pp_output_function, state.pp_flush_function,
-   state.pp_output_newline, state.pp_output_spaces)
+  (state.pp_out_string, state.pp_out_flush,
+   state.pp_out_newline, state.pp_out_spaces)
 ;;
 
 (* Default function to output new lines. *)
-let display_newline state () = state.pp_output_function "\n" 0  1;;
+let display_newline state () = state.pp_out_string "\n" 0  1;;
 
 (* Default function to output spaces. *)
 let blank_line = String.make 80 ' ';;
 let rec display_blanks state n =
   if n > 0 then
-  if n <= 80 then state.pp_output_function blank_line 0 n else
+  if n <= 80 then state.pp_out_string blank_line 0 n else
   begin
-    state.pp_output_function blank_line 0 80;
+    state.pp_out_string blank_line 0 80;
     display_blanks state (n - 80)
   end
 ;;
 
 let pp_set_formatter_out_channel state os =
-  state.pp_output_function <- output os;
-  state.pp_flush_function <- (fun () -> flush os);
-  state.pp_output_newline <- display_newline state;
-  state.pp_output_spaces <- display_blanks state;
+  state.pp_out_string <- output os;
+  state.pp_out_flush <- (fun () -> flush os);
+  state.pp_out_newline <- display_newline state;
+  state.pp_out_spaces <- display_blanks state;
 ;;
 
 (**************************************************************
@@ -847,8 +881,8 @@
 let default_pp_mark_open_tag s = "<" ^ s ^ ">";;
 let default_pp_mark_close_tag s = "";;
 
-let default_pp_print_open_tag s = ();;
-let default_pp_print_close_tag = default_pp_print_open_tag;;
+let default_pp_print_open_tag = ignore;;
+let default_pp_print_close_tag = ignore;;
 
 let pp_make_formatter f g h i =
   (* The initial state of the formatter contains a dummy box. *)
@@ -875,10 +909,10 @@
    pp_curr_depth = 1;
    pp_max_boxes = max_int;
    pp_ellipsis = ".";
-   pp_output_function = f;
-   pp_flush_function = g;
-   pp_output_newline = h;
-   pp_output_spaces = i;
+   pp_out_string = f;
+   pp_out_flush = g;
+   pp_out_newline = h;
+   pp_out_spaces = i;
    pp_print_tags = false;
    pp_mark_tags = false;
    pp_mark_open_tag = default_pp_mark_open_tag;
@@ -892,8 +926,8 @@
 (* Make a formatter with default functions to output spaces and new lines. *)
 let make_formatter output flush =
   let ppf = pp_make_formatter output flush ignore ignore in
-  ppf.pp_output_newline <- display_newline ppf;
-  ppf.pp_output_spaces <- display_blanks ppf;
+  ppf.pp_out_newline <- display_newline ppf;
+  ppf.pp_out_spaces <- display_blanks ppf;
   ppf
 ;;
 
@@ -971,6 +1005,11 @@
 and set_formatter_out_channel =
   pp_set_formatter_out_channel std_formatter
 
+and set_formatter_out_functions =
+  pp_set_formatter_out_functions std_formatter
+and get_formatter_out_functions =
+  pp_get_formatter_out_functions std_formatter
+
 and set_formatter_output_functions =
   pp_set_formatter_output_functions std_formatter
 and get_formatter_output_functions =
@@ -1011,11 +1050,12 @@
 
 (* Trailer: giving up at character number ... *)
 let giving_up mess fmt i =
-  "fprintf: " ^ mess ^ " ``" ^ Sformat.to_string fmt ^ "'', \
-   giving up at character number " ^ string_of_int i ^
-  (if i < Sformat.length fmt
-   then " (" ^ String.make 1 (Sformat.get fmt i) ^ ")."
-   else String.make 1 '.')
+  Printf.sprintf
+    "Format.fprintf: %s \'%s\', giving up at character number %d%s"
+    mess (Sformat.to_string fmt) i
+    (if i < Sformat.length fmt
+     then Printf.sprintf " (%c)." (Sformat.get fmt i)
+     else Printf.sprintf "%c" '.')
 ;;
 
 (* When an invalid format deserves a special error explanation. *)
@@ -1028,11 +1068,11 @@
 let invalid_integer fmt i =
   invalid_arg (giving_up "bad integer specification" fmt i);;
 
-(* Finding an integer out of a sub-string of the format. *)
+(* Finding an integer size out of a sub-string of the format. *)
 let format_int_of_string fmt i s =
   let sz =
     try int_of_string s with
-    | Failure s -> invalid_integer fmt i in
+    | Failure _ -> invalid_integer fmt i in
   size_of_int sz
 ;;
 
@@ -1076,225 +1116,228 @@
    according to the format string.
    Regular [fprintf]-like functions of this module are obtained via partial
    applications of [mkprintf]. *)
-let mkprintf to_s get_out =
+let mkprintf to_s get_out k fmt =
 
-  let rec kprintf k fmt =
+  (* [out] is global to this definition of [pr], and must be shared by all its
+     recursive calls (if any). *)
+  let out = get_out fmt in
+  let print_as = ref None in
+  let outc c =
+    match !print_as with
+    | None -> pp_print_char out c
+    | Some size ->
+      pp_print_as_size out size (String.make 1 c);
+      print_as := None
+  and outs s =
+    match !print_as with
+    | None -> pp_print_string out s
+    | Some size ->
+      pp_print_as_size out size s;
+      print_as := None
+  and flush out = pp_print_flush out () in
+
+  let rec pr k n fmt v =
 
     let len = Sformat.length fmt in
 
-    let kpr fmt v =
-      let ppf = get_out fmt in
-      let print_as = ref None in
-      let pp_print_as_char c =
-        match !print_as with
-        | None -> pp_print_char ppf c
-        | Some size ->
-          pp_print_as_size ppf size (String.make 1 c);
-          print_as := None
-      and pp_print_as_string s =
-        match !print_as with
-        | None -> pp_print_string ppf s
-        | Some size ->
-          pp_print_as_size ppf size s;
-          print_as := None in
-
-      let rec doprn n i =
-        if i >= len then Obj.magic (k ppf) else
-        match Sformat.get fmt i with
-        | '%' ->
-          Tformat.scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
+    let rec doprn n i =
+      if i >= len then Obj.magic (k out) else
+      match Sformat.get fmt i with
+      | '%' ->
+        Tformat.scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
+      | '@' ->
+        let i = succ i in
+        if i >= len then invalid_format fmt i else
+        begin match Sformat.get fmt i with
+        | '[' ->
+          do_pp_open_box out n (succ i)
+        | ']' ->
+          pp_close_box out ();
+          doprn n (succ i)
+        | '{' ->
+          do_pp_open_tag out n (succ i)
+        | '}' ->
+          pp_close_tag out ();
+          doprn n (succ i)
+        | ' ' ->
+          pp_print_space out ();
+          doprn n (succ i)
+        | ',' ->
+          pp_print_cut out ();
+          doprn n (succ i)
+        | '?' ->
+          pp_print_flush out ();
+          doprn n (succ i)
+        | '.' ->
+          pp_print_newline out ();
+          doprn n (succ i)
+        | '\n' ->
+          pp_force_newline out ();
+          doprn n (succ i)
+        | ';' ->
+          do_pp_break out n (succ i)
+        | '<' ->
+          let got_size size n i =
+            print_as := Some size;
+            doprn n (skip_gt i) in
+          get_int n (succ i) got_size
         | '@' ->
-          let i = succ i in
-          if i >= len then invalid_format fmt i else
-          begin match Sformat.get fmt i with
-          | '[' ->
-            do_pp_open_box ppf n (succ i)
-          | ']' ->
-             pp_close_box ppf ();
-            doprn n (succ i)
-          | '{' ->
-            do_pp_open_tag ppf n (succ i)
-          | '}' ->
-            pp_close_tag ppf ();
-            doprn n (succ i)
-          | ' ' ->
-            pp_print_space ppf ();
-            doprn n (succ i)
-          | ',' ->
-            pp_print_cut ppf ();
-            doprn n (succ i)
-          | '?' ->
-            pp_print_flush ppf ();
-            doprn n (succ i)
-          | '.' ->
-            pp_print_newline ppf ();
-            doprn n (succ i)
-          | '\n' ->
-            pp_force_newline ppf ();
-            doprn n (succ i)
-          | ';' ->
-            do_pp_break ppf n (succ i)
-          | '<' ->
-            let got_size size n i =
-              print_as := Some size;
-              doprn n (skip_gt i) in
-            get_int n (succ i) got_size
-          | '@' as c ->
-            pp_print_as_char c;
-            doprn n (succ i)
-          | c -> invalid_format fmt i
-          end
-        | c ->
-          pp_print_as_char c;
+          outc '@';
           doprn n (succ i)
-
-      and cont_s n s i =
-        pp_print_as_string s; doprn n i
-      and cont_a n printer arg i =
-        if to_s then
-          pp_print_as_string ((Obj.magic printer : unit -> _ -> string) () arg)
-        else
-          printer ppf arg;
-        doprn n i
-      and cont_t n printer i =
-        if to_s then
-          pp_print_as_string ((Obj.magic printer : unit -> string) ())
-        else
-          printer ppf;
-        doprn n i
-      and cont_f n i =
-        pp_print_flush ppf (); doprn n i
-      and cont_m n sfmt i =
-        kprintf (Obj.magic (fun _ -> doprn n i)) sfmt
-
-      and get_int n i c =
-        if i >= len then invalid_integer fmt i else
-        match Sformat.get fmt i with
-        | ' ' -> get_int n (succ i) c
-        | '%' ->
-          let cont_s n s i = c (format_int_of_string fmt i s) n i
-          and cont_a n printer arg i = invalid_integer fmt i
-          and cont_t n printer i = invalid_integer fmt i
-          and cont_f n i = invalid_integer fmt i
-          and cont_m n sfmt i = invalid_integer fmt i in
-          Tformat.scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
-        | _ ->
-          let rec get j =
-            if j >= len then invalid_integer fmt j else
-            match Sformat.get fmt j with
-            | '0' .. '9' | '-' -> get (succ j)
-            | _ ->
-              let size =
-              if j = i then size_of_int 0 else
-                let s = Sformat.sub fmt (Sformat.index_of_int i) (j - i) in
-                format_int_of_string fmt j s in
-              c size n j in
-          get i
-
-      and skip_gt i =
-        if i >= len then invalid_format fmt i else
-        match Sformat.get fmt i with
-        | ' ' -> skip_gt (succ i)
-        | '>' -> succ i
         | _ -> invalid_format fmt i
+        end
+      | c -> outc c; doprn n (succ i)
 
-      and get_box_kind i =
-        if i >= len then Pp_box, i else
-        match Sformat.get fmt i with
-        | 'h' ->
+    and cont_s n s i =
+      outs s; doprn n i
+    and cont_a n printer arg i =
+      if to_s then
+        outs ((Obj.magic printer : unit -> _ -> string) () arg)
+      else
+        printer out arg;
+      doprn n i
+    and cont_t n printer i =
+      if to_s then
+        outs ((Obj.magic printer : unit -> string) ())
+      else
+        printer out;
+      doprn n i
+    and cont_f n i =
+      flush out; doprn n i
+    and cont_m n xf i =
+      let m =
+        Sformat.add_int_index
+          (Tformat.count_printing_arguments_of_format xf) n in
+      pr (Obj.magic (fun _ -> doprn m i)) n xf v
+
+    and get_int n i c =
+      if i >= len then invalid_integer fmt i else
+      match Sformat.get fmt i with
+      | ' ' -> get_int n (succ i) c
+      | '%' ->
+        let cont_s n s i = c (format_int_of_string fmt i s) n i
+        and cont_a _n _printer _arg i = invalid_integer fmt i
+        and cont_t _n _printer i = invalid_integer fmt i
+        and cont_f _n i = invalid_integer fmt i
+        and cont_m _n _sfmt i = invalid_integer fmt i in
+        Tformat.scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
+      | _ ->
+        let rec get j =
+          if j >= len then invalid_integer fmt j else
+          match Sformat.get fmt j with
+          | '0' .. '9' | '-' -> get (succ j)
+          | _ ->
+            let size =
+              if j = i then size_of_int 0 else
+              let s = Sformat.sub fmt (Sformat.index_of_int i) (j - i) in
+              format_int_of_string fmt j s in
+            c size n j in
+        get i
+
+    and skip_gt i =
+      if i >= len then invalid_format fmt i else
+      match Sformat.get fmt i with
+      | ' ' -> skip_gt (succ i)
+      | '>' -> succ i
+      | _ -> invalid_format fmt i
+
+    and get_box_kind i =
+      if i >= len then Pp_box, i else
+      match Sformat.get fmt i with
+      | 'h' ->
+         let i = succ i in
+         if i >= len then Pp_hbox, i else
+         begin match Sformat.get fmt i with
+         | 'o' ->
            let i = succ i in
-           if i >= len then Pp_hbox, i else
+           if i >= len then format_invalid_arg "bad box format" fmt i else
            begin match Sformat.get fmt i with
-           | 'o' ->
-             let i = succ i in
-             if i >= len then format_invalid_arg "bad box format" fmt i else
-             begin match Sformat.get fmt i with
-             | 'v' -> Pp_hovbox, succ i
-             | c ->
-               format_invalid_arg
-                 ("bad box name ho" ^ String.make 1 c) fmt i
-             end
-           | 'v' -> Pp_hvbox, succ i
-           | c -> Pp_hbox, i
+           | 'v' -> Pp_hovbox, succ i
+           | c ->
+             format_invalid_arg
+               ("bad box name ho" ^ String.make 1 c) fmt i
            end
-        | 'b' -> Pp_box, succ i
-        | 'v' -> Pp_vbox, succ i
-        | _ -> Pp_box, i
-
-      and get_tag_name n i c =
-        let rec get accu n i j =
-          if j >= len then
-            c (implode_rev
-                 (Sformat.sub fmt (Sformat.index_of_int i) (j - i))
-                 accu)
-              n j else
-          match Sformat.get fmt j with
-          | '>' ->
-            c (implode_rev
-                 (Sformat.sub fmt (Sformat.index_of_int i) (j - i))
-                 accu)
-              n j
-          | '%' ->
-            let s0 = Sformat.sub fmt (Sformat.index_of_int i) (j - i) in
-            let cont_s n s i = get (s :: s0 :: accu) n i i
-            and cont_a n printer arg i =
-              let s =
-                if to_s
-                then (Obj.magic printer : unit -> _ -> string) () arg
-                else exstring printer arg in
-              get (s :: s0 :: accu) n i i
-            and cont_t n printer i =
-              let s =
-                if to_s
-                then (Obj.magic printer : unit -> string) ()
-                else exstring (fun ppf () -> printer ppf) () in
-              get (s :: s0 :: accu) n i i
-            and cont_f n i =
-              format_invalid_arg "bad tag name specification" fmt i
-            and cont_m n sfmt i =
-              format_invalid_arg "bad tag name specification" fmt i in
-            Tformat.scan_format fmt v n j cont_s cont_a cont_t cont_f cont_m
-          | c -> get accu n i (succ j) in
-        get [] n i i
-
-      and do_pp_break ppf n i =
-        if i >= len then begin pp_print_space ppf (); doprn n i end else
-        match Sformat.get fmt i with
-        | '<' ->
-          let rec got_nspaces nspaces n i =
-            get_int n i (got_offset nspaces)
-          and got_offset nspaces offset n i =
-            pp_print_break ppf (int_of_size nspaces) (int_of_size offset);
-            doprn n (skip_gt i) in
-          get_int n (succ i) got_nspaces
-        | c -> pp_print_space ppf (); doprn n i
-
-      and do_pp_open_box ppf n i =
-        if i >= len then begin pp_open_box_gen ppf 0 Pp_box; doprn n i end else
-        match Sformat.get fmt i with
-        | '<' ->
-          let kind, i = get_box_kind (succ i) in
-          let got_size size n i =
-            pp_open_box_gen ppf (int_of_size size) kind;
-            doprn n (skip_gt i) in
-          get_int n i got_size
-        | c -> pp_open_box_gen ppf 0 Pp_box; doprn n i
-
-      and do_pp_open_tag ppf n i =
-        if i >= len then begin pp_open_tag ppf ""; doprn n i end else
-        match Sformat.get fmt i with
-        | '<' ->
-          let got_name tag_name n i =
-            pp_open_tag ppf tag_name;
-            doprn n (skip_gt i) in
-          get_tag_name n (succ i) got_name
-        | c -> pp_open_tag ppf ""; doprn n i in
+         | 'v' -> Pp_hvbox, succ i
+         | _ -> Pp_hbox, i
+         end
+      | 'b' -> Pp_box, succ i
+      | 'v' -> Pp_vbox, succ i
+      | _ -> Pp_box, i
+
+    and get_tag_name n i c =
+      let rec get accu n i j =
+        if j >= len then
+          c (implode_rev
+               (Sformat.sub fmt (Sformat.index_of_int i) (j - i))
+               accu)
+            n j else
+        match Sformat.get fmt j with
+        | '>' ->
+          c (implode_rev
+               (Sformat.sub fmt (Sformat.index_of_int i) (j - i))
+               accu)
+            n j
+        | '%' ->
+          let s0 = Sformat.sub fmt (Sformat.index_of_int i) (j - i) in
+          let cont_s n s i = get (s :: s0 :: accu) n i i
+          and cont_a n printer arg i =
+            let s =
+              if to_s
+              then (Obj.magic printer : unit -> _ -> string) () arg
+              else exstring printer arg in
+            get (s :: s0 :: accu) n i i
+          and cont_t n printer i =
+            let s =
+              if to_s
+              then (Obj.magic printer : unit -> string) ()
+              else exstring (fun ppf () -> printer ppf) () in
+            get (s :: s0 :: accu) n i i
+          and cont_f _n i =
+            format_invalid_arg "bad tag name specification" fmt i
+          and cont_m _n _sfmt i =
+            format_invalid_arg "bad tag name specification" fmt i in
+          Tformat.scan_format fmt v n j cont_s cont_a cont_t cont_f cont_m
+        | _ -> get accu n i (succ j) in
+      get [] n i i
+
+    and do_pp_break ppf n i =
+      if i >= len then begin pp_print_space ppf (); doprn n i end else
+      match Sformat.get fmt i with
+      | '<' ->
+        let rec got_nspaces nspaces n i =
+          get_int n i (got_offset nspaces)
+        and got_offset nspaces offset n i =
+          pp_print_break ppf (int_of_size nspaces) (int_of_size offset);
+          doprn n (skip_gt i) in
+        get_int n (succ i) got_nspaces
+      | _c -> pp_print_space ppf (); doprn n i
+
+    and do_pp_open_box ppf n i =
+      if i >= len then begin pp_open_box_gen ppf 0 Pp_box; doprn n i end else
+      match Sformat.get fmt i with
+      | '<' ->
+        let kind, i = get_box_kind (succ i) in
+        let got_size size n i =
+          pp_open_box_gen ppf (int_of_size size) kind;
+          doprn n (skip_gt i) in
+        get_int n i got_size
+      | _c -> pp_open_box_gen ppf 0 Pp_box; doprn n i
+
+    and do_pp_open_tag ppf n i =
+      if i >= len then begin pp_open_tag ppf ""; doprn n i end else
+      match Sformat.get fmt i with
+      | '<' ->
+        let got_name tag_name n i =
+          pp_open_tag ppf tag_name;
+          doprn n (skip_gt i) in
+        get_tag_name n (succ i) got_name
+      | _c -> pp_open_tag ppf ""; doprn n i in
 
-      doprn (Sformat.index_of_int 0) 0 in
+    doprn n 0 in
 
-    Tformat.kapr kpr fmt in
+  let kpr = pr k (Sformat.index_of_int 0) in
 
-  kprintf
+  Tformat.kapr kpr fmt
 ;;
 
 (**************************************************************
@@ -1314,11 +1357,20 @@
 let ksprintf k =
   let b = Buffer.create 512 in
   let k ppf = k (string_out b ppf) in
-  mkprintf true (fun _ -> formatter_of_buffer b) k
+  let ppf = formatter_of_buffer b in
+  let get_out _ = ppf in
+  mkprintf true get_out k
 ;;
 
 let sprintf fmt = ksprintf (fun s -> s) fmt;;
 
+let asprintf fmt =
+  let b = Buffer.create 512 in
+  let k ppf = string_out b ppf in
+  let ppf = formatter_of_buffer b in
+  let get_out _ = ppf in
+  mkprintf false get_out k fmt;;
+
 (**************************************************************
 
   Deprecated stuff.
@@ -1338,5 +1390,6 @@
 (* Deprecated alias for ksprintf. *)
 let kprintf = ksprintf;;
 
+(* Output everything left in the pretty printer queue at end of execution. *)
 at_exit print_flush
 ;;
diff -Nru ocaml-3.12.1/stdlib/format.mli ocaml-4.01.0/stdlib/format.mli
--- ocaml-3.12.1/stdlib/format.mli	2011-03-06 16:13:14.000000000 +0000
+++ ocaml-4.01.0/stdlib/format.mli	2013-05-29 18:03:55.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Pierre Weis, projet Cristal, INRIA Rocquencourt          *)
 (*                                                                     *)
@@ -11,18 +11,17 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: format.mli 10970 2011-03-06 16:13:14Z weis $ *)
-
 (** Pretty printing.
 
    This module implements a pretty-printing facility to format text
-   within ``pretty-printing boxes''. The pretty-printer breaks lines
+   within 'pretty-printing boxes'. The pretty-printer breaks lines
    at specified break hints, and indents lines according to the box
    structure.
 
    For a gentle introduction to the basics of pretty-printing using
    [Format], read
-   {{:http://caml.inria.fr/resources/doc/guides/format.html}http://caml.inria.fr/resources/doc/guides/format.html}.
+   {{:http://caml.inria.fr/resources/doc/guides/format.en.html}
+    http://caml.inria.fr/resources/doc/guides/format.en.html}.
 
    You may consider this module as providing an extension to the
    [printf] facility to provide automatic line breaking. The addition of
@@ -79,7 +78,7 @@
 (** [open_box d] opens a new pretty-printing box
    with offset [d].
    This box is the general purpose pretty-printing box.
-   Material in this box is displayed ``horizontal or vertical'':
+   Material in this box is displayed 'horizontal or vertical':
    break hints inside the box may lead to a new line, if there
    is no more room on the line to print the remainder of the box,
    or if a new line may lead to a new indentation
@@ -163,7 +162,7 @@
    overflows that leads to split lines.
    Nothing happens if [d] is smaller than 2.
    If [d] is too large, the right margin is set to the maximum
-   admissible value (which is greater than [10^10]). *)
+   admissible value (which is greater than [10^9]). *)
 
 val get_margin : unit -> int;;
 (** Returns the position of the right margin. *)
@@ -177,7 +176,7 @@
    if they do not fit on the current line.
    Nothing happens if [d] is smaller than 2.
    If [d] is too large, the limit is set to the maximum
-   admissible value (which is greater than [10^10]). *)
+   admissible value (which is greater than [10^9]). *)
 
 val get_max_indent : unit -> int;;
 (** Return the value of the maximum indentation limit (in characters). *)
@@ -185,11 +184,10 @@
 (** {6 Formatting depth: maximum number of boxes allowed before ellipsis} *)
 
 val set_max_boxes : int -> unit;;
-(** [set_max_boxes max] sets the maximum number
-   of boxes simultaneously opened.
-   Material inside boxes nested deeper is printed as an
-   ellipsis (more precisely as the text returned by
-   [get_ellipsis_text ()]).
+(** [set_max_boxes max] sets the maximum number of boxes simultaneously
+   opened.
+   Material inside boxes nested deeper is printed as an ellipsis (more
+   precisely as the text returned by [get_ellipsis_text ()]).
    Nothing happens if [max] is smaller than 2. *)
 
 val get_max_boxes : unit -> int;;
@@ -202,13 +200,13 @@
 
 val open_hbox : unit -> unit;;
 (** [open_hbox ()] opens a new pretty-printing box.
-   This box is ``horizontal'': the line is not split in this box
+   This box is 'horizontal': the line is not split in this box
    (new lines may still occur inside boxes nested deeper). *)
 
 val open_vbox : int -> unit;;
 (** [open_vbox d] opens a new pretty-printing box
    with offset [d].
-   This box is ``vertical'': every break hint inside this
+   This box is 'vertical': every break hint inside this
    box leads to a new line.
    When a new line is printed in the box, [d] is added to the
    current indentation. *)
@@ -216,16 +214,16 @@
 val open_hvbox : int -> unit;;
 (** [open_hvbox d] opens a new pretty-printing box
    with offset [d].
-   This box is ``horizontal-vertical'': it behaves as an
-   ``horizontal'' box if it fits on a single line,
-   otherwise it behaves as a ``vertical'' box.
+   This box is 'horizontal-vertical': it behaves as an
+   'horizontal' box if it fits on a single line,
+   otherwise it behaves as a 'vertical' box.
    When a new line is printed in the box, [d] is added to the
    current indentation. *)
 
 val open_hovbox : int -> unit;;
 (** [open_hovbox d] opens a new pretty-printing box
    with offset [d].
-   This box is ``horizontal or vertical'': break hints
+   This box is 'horizontal or vertical': break hints
    inside this box may lead to a new line, if there is no more room
    on the line to print the remainder of the box.
    When a new line is printed in the box, [d] is added to the
@@ -276,13 +274,13 @@
    entities (e.g. HTML or TeX elements or terminal escape sequences).
 
    By default, those tags do not influence line breaking calculation:
-   the tag ``markers'' are not considered as part of the printing
+   the tag 'markers' are not considered as part of the printing
    material that drives line breaking (in other words, the length of
    those strings is considered as zero for line breaking).
 
    Thus, tag handling is in some sense transparent to pretty-printing
-   and does not interfere with usual pretty-printing. Hence, a single
-   pretty printing routine can output both simple ``verbatim''
+   and does not interfere with usual indentation. Hence, a single
+   pretty printing routine can output both simple 'verbatim'
    material or richer decorated output depending on the treatment of
    tags. By default, tags are not active, hence the output is not
    decorated with tag information. Once [set_tags] is set to [true],
@@ -290,14 +288,14 @@
    accordingly.
 
    When a tag has been opened (or closed), it is both and successively
-   ``printed'' and ``marked''. Printing a tag means calling a
+   'printed' and 'marked'. Printing a tag means calling a
    formatter specific function with the name of the tag as argument:
-   that ``tag printing'' function can then print any regular material
+   that 'tag printing' function can then print any regular material
    to the formatter (so that this material is enqueued as usual in the
    formatter queue for further line-breaking computation). Marking a
-   tag means to output an arbitrary string (the ``tag marker''),
+   tag means to output an arbitrary string (the 'tag marker'),
    directly into the output device of the formatter. Hence, the
-   formatter specific ``tag marking'' function must return the tag
+   formatter specific 'tag marking' function must return the tag
    marker string associated to its tag argument. Being flushed
    directly into the output device of the formatter, tag marker
    strings are not considered as part of the printing material that
@@ -322,6 +320,7 @@
    function of the formatter is called with [t] as argument;
    the tag marker [mark_open_tag t] will be flushed into the output
    device of the formatter. *)
+
 val close_tag : unit -> unit;;
 (** [close_tag ()] closes the most recently opened tag [t].
    In addition, the [print_close_tag] function of the formatter is called
@@ -349,15 +348,17 @@
   (string -> int -> int -> unit) -> (unit -> unit) -> unit
 ;;
 (** [set_formatter_output_functions out flush] redirects the
-   relevant pretty-printer output functions to the functions [out] and
+   pretty-printer output functions to the functions [out] and
    [flush].
 
-   The [out] function performs the pretty-printer string output. It is called
-   with a string [s], a start position [p], and a number of characters
-   [n]; it is supposed to output characters [p] to [p + n - 1] of
-   [s]. The [flush] function is called whenever the pretty-printer is
-   flushed (via conversion [%!], pretty-printing indications [@?] or [@.],
-   or using low level function [print_flush] or [print_newline]). *)
+   The [out] function performs all the pretty-printer string output.
+   It is called with a string [s], a start position [p], and a number of
+   characters [n]; it is supposed to output characters [p] to [p + n - 1] of
+   [s].
+
+   The [flush] function is called whenever the pretty-printer is flushed
+   (via conversion [%!], or pretty-printing indications [@?] or [@.], or
+   using low level functions [print_flush] or [print_newline]). *)
 
 val get_formatter_output_functions :
   unit -> (string -> int -> int -> unit) * (unit -> unit)
@@ -371,40 +372,37 @@
  how to handle indentation, line breaking, and even printing of all the
  characters that have to be printed! *)
 
-val set_all_formatter_output_functions :
-  out:(string -> int -> int -> unit) ->
-  flush:(unit -> unit) ->
-  newline:(unit -> unit) ->
-  spaces:(int -> unit) ->
-  unit
+type formatter_out_functions = {
+  out_string : string -> int -> int -> unit;
+  out_flush : unit -> unit;
+  out_newline : unit -> unit;
+  out_spaces : int -> unit;
+}
 ;;
-(** [set_all_formatter_output_functions out flush outnewline outspace]
-   redirects the pretty-printer output to the functions [out] and
-   [flush] as described in [set_formatter_output_functions]. In
-   addition, the pretty-printer function that outputs a newline is set
-   to the function [outnewline] and the function that outputs
-   indentation spaces is set to the function [outspace].
+
+val set_formatter_out_functions : formatter_out_functions -> unit;;
+(** [set_formatter_out_functions out_funs]
+   Redirect the pretty-printer output to the functions [out_funs.out_string]
+   and [out_funs.out_flush] as described in
+   [set_formatter_output_functions]. In addition, the pretty-printer function
+   that outputs a newline is set to the function [out_funs.out_newline] and
+   the function that outputs indentation spaces is set to the function
+   [out_funs.out_spaces].
 
    This way, you can change the meaning of indentation (which can be
-   something else than just printing space characters) and the
-   meaning of new lines opening (which can be connected to any other
-   action needed by the application at hand). The two functions
-   [outspace] and [outnewline] are normally connected to [out] and
-   [flush]: respective default values for [outspace] and [outnewline]
-   are [out (String.make n ' ') 0 n] and [out "\n" 0 1]. *)
+   something else than just printing space characters) and the meaning of new
+   lines opening (which can be connected to any other action needed by the
+   application at hand). The two functions [out_spaces] and [out_newline] are
+   normally connected to [out_string] and [out_flush]: respective default
+   values for [out_space] and [out_newline] are
+   [out_string (String.make n ' ') 0 n] and [out_string "\n" 0 1]. *)
 
-val get_all_formatter_output_functions :
-  unit ->
-  (string -> int -> int -> unit) *
-  (unit -> unit) *
-  (unit -> unit) *
-  (int -> unit)
-;;
+val get_formatter_out_functions : unit -> formatter_out_functions;;
 (** Return the current output functions of the pretty-printer,
    including line breaking and indentation functions. Useful to record the
    current setting and restore it afterwards. *)
 
-(** {6:tags Changing the meaning of printing semantics tags} *)
+(** {6:tagsmeaning Changing the meaning of printing semantics tags} *)
 
 type formatter_tag_functions = {
   mark_open_tag : tag -> string;
@@ -414,16 +412,13 @@
 }
 ;;
 (** The tag handling functions specific to a formatter:
-   [mark] versions are the ``tag marking'' functions that associate a string
+   [mark] versions are the 'tag marking' functions that associate a string
    marker to a tag in order for the pretty-printing engine to flush
    those markers as 0 length tokens in the output device of the formatter.
-   [print] versions are the ``tag printing'' functions that can perform
+   [print] versions are the 'tag printing' functions that can perform
    regular printing when a tag is closed or opened. *)
 
-val set_formatter_tag_functions :
-  formatter_tag_functions -> unit
-;;
-
+val set_formatter_tag_functions : formatter_tag_functions -> unit;;
 (** [set_formatter_tag_functions tag_funs] changes the meaning of
    opening and closing tags to use the functions in [tag_funs].
 
@@ -439,9 +434,7 @@
    called at tag opening and tag closing time, to output regular
    material in the pretty-printer queue. *)
 
-val get_formatter_tag_functions :
-  unit -> formatter_tag_functions
-;;
+val get_formatter_tag_functions : unit -> formatter_tag_functions;;
 (** Return the current tag functions of the pretty-printer. *)
 
 (** {6 Multiple formatted output} *)
@@ -545,28 +538,27 @@
 val pp_over_max_boxes : formatter -> unit -> bool;;
 val pp_set_ellipsis_text : formatter -> string -> unit;;
 val pp_get_ellipsis_text : formatter -> unit -> string;;
-val pp_set_formatter_out_channel : formatter -> Pervasives.out_channel -> unit;;
+val pp_set_formatter_out_channel :
+  formatter -> Pervasives.out_channel -> unit
+;;
 val pp_set_formatter_output_functions :
   formatter -> (string -> int -> int -> unit) -> (unit -> unit) -> unit
 ;;
 val pp_get_formatter_output_functions :
   formatter -> unit -> (string -> int -> int -> unit) * (unit -> unit)
 ;;
-val pp_set_all_formatter_output_functions :
-  formatter -> out:(string -> int -> int -> unit) -> flush:(unit -> unit) ->
-  newline:(unit -> unit) -> spaces:(int -> unit) -> unit
-;;
-val pp_get_all_formatter_output_functions :
-  formatter -> unit ->
-  (string -> int -> int -> unit) * (unit -> unit) * (unit -> unit) *
-  (int -> unit)
-;;
 val pp_set_formatter_tag_functions :
   formatter -> formatter_tag_functions -> unit
 ;;
 val pp_get_formatter_tag_functions :
   formatter -> unit -> formatter_tag_functions
 ;;
+val pp_set_formatter_out_functions :
+  formatter -> formatter_out_functions -> unit
+;;
+val pp_get_formatter_out_functions :
+  formatter -> unit -> formatter_out_functions
+;;
 (** These functions are the basic ones: usual functions
    operating on the standard formatter are defined via partial
    evaluation of these primitives. For instance,
@@ -593,31 +585,28 @@
      then an optional integer offset, and the closing [>] character.
      Box type is one of [h], [v], [hv], [b], or [hov],
      which stand respectively for an horizontal box, a vertical box,
-     an ``horizontal-vertical'' box, or an ``horizontal or
-     vertical'' box ([b] standing for an ``horizontal or
-     vertical'' box demonstrating indentation and [hov] standing
-     for a regular``horizontal or vertical'' box).
-     For instance, [@\[] opens an ``horizontal or vertical''
+     an 'horizontal-vertical' box, or an 'horizontal or
+     vertical' box ([b] standing for an 'horizontal or
+     vertical' box demonstrating indentation and [hov] standing
+     for a regular'horizontal or vertical' box).
+     For instance, [@\[] opens an 'horizontal or vertical'
      box with indentation 2 as obtained with [open_hovbox 2].
      For more details about boxes, see the various box opening
      functions [open_*box].
    - [@\]]: close the most recently opened pretty-printing box.
-   - [@,]: output a good break as with [print_cut ()].
-   - [@ ]: output a space, as with [print_space ()].
-   - [@\n]: force a newline, as with [force_newline ()].
-   - [@;]: output a good break as with [print_break]. The
+   - [@,]: output a good break hint, as with [print_cut ()].
+   - [@ ]: output a good break space, as with [print_space ()].
+   - [@;]: output a fully specified good break as with [print_break]. The
      [nspaces] and [offset] parameters of the break may be
      optionally specified with the following syntax:
      the [<] character, followed by an integer [nspaces] value,
      then an integer [offset], and a closing [>] character.
      If no parameters are provided, the good break defaults to a
-     space.
-   - [@?]: flush the pretty printer as with [print_flush ()].
-     This is equivalent to the conversion [%!].
+     good break space.
    - [@.]: flush the pretty printer and output a new line, as with
      [print_newline ()].
    - [@]: print the following item as if it were of length [n].
-     Hence, [printf "@<0>%s" arg] is equivalent to [print_as 0 arg].
+     Hence, [printf "@<0>%s" arg] prints [arg] as a zero length string.
      If [@] is not followed by a conversion specification,
      then the following character of the format is printed as if
      it were of length [n].
@@ -631,12 +620,21 @@
      For more details about tags, see the functions [open_tag] and
      [close_tag].
    - [@\}]: close the most recently opened tag.
-   - [@@]: print a plain [@] character.
+   - [@?]: flush the pretty printer as with [print_flush ()].
+     This is equivalent to the conversion [%!].
+   - [@\n]: force a newline, as with [force_newline ()].
+   - [@@]: print a single [@] character.
 
    Example: [printf "@[%s@ %d@]@." "x =" 1] is equivalent to
    [open_box (); print_string "x ="; print_space ();
     print_int 1; close_box (); print_newline ()].
    It prints [x = 1] within a pretty-printing box.
+
+   Note: If you need to prevent the interpretation of a [@] character as a
+   pretty-printing indication, escape it with a [%] character, as usual in
+   format strings.
+   @since 3.12.2
+
 *)
 
 val printf : ('a, formatter, unit) format -> 'a;;
@@ -658,7 +656,16 @@
 
    Alternatively, you can use [Format.fprintf] with a formatter writing to a
    buffer of your own: flushing the formatter and the buffer at the end of
-   pretty-printing returns the desired string. *)
+   pretty-printing returns the desired string.
+*)
+
+val asprintf : ('a, formatter, unit, string) format4 -> 'a;;
+(** Same as [printf] above, but instead of printing on a formatter,
+   returns a string containing the result of formatting the arguments.
+   The type of [asprintf] is general enough to interact nicely with [%a]
+   conversions.
+   @since 4.01.0
+ *)
 
 val ifprintf : formatter -> ('a, formatter, unit) format -> 'a;;
 (** Same as [fprintf] above, but does not print anything.
@@ -697,3 +704,41 @@
 
 val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b;;
 (** A deprecated synonym for [ksprintf]. *)
+
+val set_all_formatter_output_functions :
+  out:(string -> int -> int -> unit) ->
+  flush:(unit -> unit) ->
+  newline:(unit -> unit) ->
+  spaces:(int -> unit) ->
+  unit
+;;
+(** Deprecated. Subsumed by [set_formatter_out_functions].
+  @since 4.00.0
+*)
+
+val get_all_formatter_output_functions :
+  unit ->
+  (string -> int -> int -> unit) *
+  (unit -> unit) *
+  (unit -> unit) *
+  (int -> unit)
+;;
+(** Deprecated. Subsumed by [get_formatter_out_functions].
+  @since 4.00.0
+*)
+val pp_set_all_formatter_output_functions :
+  formatter -> out:(string -> int -> int -> unit) -> flush:(unit -> unit) ->
+  newline:(unit -> unit) -> spaces:(int -> unit) -> unit
+;;
+(** Deprecated. Subsumed by [pp_set_formatter_out_functions].
+  @since 4.01.0
+*)
+
+val pp_get_all_formatter_output_functions :
+  formatter -> unit ->
+  (string -> int -> int -> unit) * (unit -> unit) * (unit -> unit) *
+  (int -> unit)
+;;
+(** Deprecated. Subsumed by [pp_get_formatter_out_functions].
+  @since 4.01.0
+*)
diff -Nru ocaml-3.12.1/stdlib/gc.ml ocaml-4.01.0/stdlib/gc.ml
--- ocaml-3.12.1/stdlib/gc.ml	2010-04-27 07:55:08.000000000 +0000
+++ ocaml-4.01.0/stdlib/gc.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Damien Doligez, projet Para, INRIA Rocquencourt          *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: gc.ml 10315 2010-04-27 07:55:08Z xleroy $ *)
-
 type stat = {
   minor_words : float;
   promoted_words : float;
diff -Nru ocaml-3.12.1/stdlib/gc.mli ocaml-4.01.0/stdlib/gc.mli
--- ocaml-3.12.1/stdlib/gc.mli	2010-05-21 18:30:12.000000000 +0000
+++ ocaml-4.01.0/stdlib/gc.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*             Damien Doligez, projet Para, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: gc.mli 10457 2010-05-21 18:30:12Z doligez $ *)
-
 (** Memory management control and statistics; finalised values. *)
 
 type stat =
@@ -123,6 +121,8 @@
        compaction is triggered at the end of each major GC cycle
        (this setting is intended for testing purposes only).
        If [max_overhead >= 1000000], compaction is never triggered.
+       If compaction is permanently disabled, it is strongly suggested
+       to set [allocation_policy] to 1.
        Default: 500. *)
 
     mutable stack_limit : int;
@@ -141,7 +141,7 @@
 (** The GC parameters are given as a [control] record.  Note that
     these parameters can also be initialised by setting the
     OCAMLRUNPARAM environment variable.  See the documentation of
-    ocamlrun. *)
+    [ocamlrun]. *)
 
 external stat : unit -> stat = "caml_gc_stat"
 (** Return the current values of the memory management counters in a
@@ -156,7 +156,7 @@
 
 external counters : unit -> float * float * float = "caml_gc_counters"
 (** Return [(minor_words, promoted_words, major_words)].  This function
-    is as fast at [quick_stat]. *)
+    is as fast as [quick_stat]. *)
 
 external get : unit -> control = "caml_gc_get"
 (** Return the current values of the GC parameters in a [control] record. *)
@@ -221,7 +221,7 @@
    - [ let f = fun x -> ... ;; let v = ... in Gc.finalise f v ]
 
 
-   The [f] function can use all features of O'Caml, including
+   The [f] function can use all features of OCaml, including
    assignments that make the value reachable again.  It can also
    loop forever (in this case, the other
    finalisation functions will not be called during the execution of f,
diff -Nru ocaml-3.12.1/stdlib/genlex.ml ocaml-4.01.0/stdlib/genlex.ml
--- ocaml-3.12.1/stdlib/genlex.ml	2002-04-18 07:27:47.000000000 +0000
+++ ocaml-4.01.0/stdlib/genlex.ml	2013-05-29 18:03:55.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*              Xavier Leroy, projet Cristal, INRIA Rocquencourt       *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: genlex.ml 4694 2002-04-18 07:27:47Z garrigue $ *)
-
 type token =
     Kwd of string
   | Ident of string
@@ -21,7 +19,6 @@
   | String of string
   | Char of char
 
-
 (* The string buffering machinery *)
 
 let initial_buffer = String.create 32
@@ -81,7 +78,7 @@
           Some '\'' -> Stream.junk strm__; Some (Char c)
         | _ -> raise (Stream.Error "")
         end
-    | Some '"' ->
+    | Some '\"' ->
         Stream.junk strm__;
         let s = strm__ in reset_buffer (); Some (String (string s))
     | Some '-' -> Stream.junk strm__; neg_number strm__
@@ -135,7 +132,7 @@
     | _ -> Some (Float (float_of_string (get_string ())))
   and string (strm__ : _ Stream.t) =
     match Stream.peek strm__ with
-      Some '"' -> Stream.junk strm__; get_string ()
+      Some '\"' -> Stream.junk strm__; get_string ()
     | Some '\\' ->
         Stream.junk strm__;
         let c =
diff -Nru ocaml-3.12.1/stdlib/genlex.mli ocaml-4.01.0/stdlib/genlex.mli
--- ocaml-3.12.1/stdlib/genlex.mli	2005-10-25 18:34:07.000000000 +0000
+++ ocaml-4.01.0/stdlib/genlex.mli	2013-05-29 18:03:55.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*              Xavier Leroy, projet Cristal, INRIA Rocquencourt       *)
 (*                                                                     *)
@@ -11,14 +11,12 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: genlex.mli 7164 2005-10-25 18:34:07Z doligez $ *)
-
 (** A generic lexical analyzer.
 
 
-   This module implements a simple ``standard'' lexical analyzer, presented
+   This module implements a simple 'standard' lexical analyzer, presented
    as a function from character streams to token streams. It implements
-   roughly the lexical conventions of Caml, but is parameterized by the
+   roughly the lexical conventions of OCaml, but is parameterized by the
    set of keywords of your language.
 
 
@@ -29,14 +27,20 @@
    to, for instance, [int], and would have rules such as:
 
    {[
-           let parse_expr = parser
-                  [< 'Int n >] -> n
-                | [< 'Kwd "("; n = parse_expr; 'Kwd ")" >] -> n
-                | [< n1 = parse_expr; n2 = parse_remainder n1 >] -> n2
+           let rec parse_expr = parser
+             | [< n1 = parse_atom; n2 = parse_remainder n1 >] -> n2
+           and parse_atom = parser
+             | [< 'Int n >] -> n
+             | [< 'Kwd "("; n = parse_expr; 'Kwd ")" >] -> n
            and parse_remainder n1 = parser
-                  [< 'Kwd "+"; n2 = parse_expr >] -> n1+n2
-                | ...
+             | [< 'Kwd "+"; n2 = parse_expr >] -> n1+n2
+             | [< >] -> n1
    ]}
+
+   One should notice that the use of the [parser] keyword and associated
+   notation for streams are only available through camlp4 extensions. This
+   means that one has to preprocess its sources {i e. g.} by using the
+   ["-pp"] command-line switch of the compilers.
 *)
 
 (** The type of tokens. The lexical classes are: [Int] and [Float]
@@ -44,9 +48,9 @@
    string literals, enclosed in double quotes; [Char] for
    character literals, enclosed in single quotes; [Ident] for
    identifiers (either sequences of letters, digits, underscores
-   and quotes, or sequences of ``operator characters'' such as
+   and quotes, or sequences of 'operator characters' such as
    [+], [*], etc); and [Kwd] for keywords (either identifiers or
-   single ``special characters'' such as [(], [}], etc). *)
+   single 'special characters' such as [(], [}], etc). *)
 type token =
     Kwd of string
   | Ident of string
@@ -61,6 +65,7 @@
    belongs to this list, and as [Ident s] otherwise.
    A special character [s] is returned as [Kwd s] if [s]
    belongs to this list, and cause a lexical error (exception
-   [Parse_error]) otherwise. Blanks and newlines are skipped.
-   Comments delimited by [(*] and [*)] are skipped as well,
-   and can be nested. *)
+   [Stream.Error] with the offending lexeme as its parameter) otherwise.
+   Blanks and newlines are skipped. Comments delimited by [(*] and [*)]
+   are skipped as well, and can be nested. A [Stream.Failure] exception
+   is raised if end of stream is unexpectedly reached.*)
diff -Nru ocaml-3.12.1/stdlib/hashtbl.ml ocaml-4.01.0/stdlib/hashtbl.ml
--- ocaml-3.12.1/stdlib/hashtbl.ml	2005-10-25 18:34:07.000000000 +0000
+++ ocaml-4.01.0/stdlib/hashtbl.ml	2013-03-09 22:38:52.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,123 +11,166 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: hashtbl.ml 7164 2005-10-25 18:34:07Z doligez $ *)
-
 (* Hash tables *)
 
-external hash_param : int -> int -> 'a -> int = "caml_hash_univ_param" "noalloc"
-
-let hash x = hash_param 10 100 x
+external seeded_hash_param :
+  int -> int -> int -> 'a -> int = "caml_hash" "noalloc"
+external old_hash_param :
+  int -> int -> 'a -> int = "caml_hash_univ_param" "noalloc"
+
+let hash x = seeded_hash_param 10 100 0 x
+let hash_param n1 n2 x = seeded_hash_param n1 n2 0 x
+let seeded_hash seed x = seeded_hash_param 10 100 seed x
 
 (* We do dynamic hashing, and resize the table and rehash the elements
    when buckets become too long. *)
 
 type ('a, 'b) t =
-  { mutable size: int;                        (* number of elements *)
-    mutable data: ('a, 'b) bucketlist array } (* the buckets *)
+  { mutable size: int;                        (* number of entries *)
+    mutable data: ('a, 'b) bucketlist array;  (* the buckets *)
+    mutable seed: int;                        (* for randomization *)
+    initial_size: int;                        (* initial array size *)
+  }
 
 and ('a, 'b) bucketlist =
     Empty
   | Cons of 'a * 'b * ('a, 'b) bucketlist
 
-let create initial_size =
-  let s = min (max 1 initial_size) Sys.max_array_length in
-  { size = 0; data = Array.make s Empty }
+(* To pick random seeds if requested *)
+
+let randomized_default =
+  let params =
+    try Sys.getenv "OCAMLRUNPARAM" with Not_found ->
+    try Sys.getenv "CAMLRUNPARAM" with Not_found -> "" in
+  String.contains params 'R'
+
+let randomized = ref randomized_default
+
+let randomize () = randomized := true
+
+let prng = lazy (Random.State.make_self_init())
+
+(* Creating a fresh, empty table *)
+
+let rec power_2_above x n =
+  if x >= n then x
+  else if x * 2 > Sys.max_array_length then x
+  else power_2_above (x * 2) n
+
+let create ?(random = !randomized) initial_size =
+  let s = power_2_above 16 initial_size in
+  let seed = if random then Random.State.bits (Lazy.force prng) else 0 in
+  { initial_size = s; size = 0; seed = seed; data = Array.make s Empty }
 
 let clear h =
-  for i = 0 to Array.length h.data - 1 do
+  h.size <- 0;
+  let len = Array.length h.data in
+  for i = 0 to len - 1 do
     h.data.(i) <- Empty
-  done;
-  h.size <- 0
+  done
+
+let reset h =
+  let len = Array.length h.data in
+  if Obj.size (Obj.repr h) < 4 (* compatibility with old hash tables *)
+    || len = h.initial_size then
+    clear h
+  else begin
+    h.size <- 0;
+    h.data <- Array.make h.initial_size Empty
+  end
 
-let copy h =
-  { size = h.size;
-    data = Array.copy h.data }
+let copy h = { h with data = Array.copy h.data }
 
 let length h = h.size
 
-let resize hashfun tbl =
-  let odata = tbl.data in
+let resize indexfun h =
+  let odata = h.data in
   let osize = Array.length odata in
-  let nsize = min (2 * osize + 1) Sys.max_array_length in
-  if nsize <> osize then begin
-    let ndata = Array.create nsize Empty in
+  let nsize = osize * 2 in
+  if nsize < Sys.max_array_length then begin
+    let ndata = Array.make nsize Empty in
+    h.data <- ndata;          (* so that indexfun sees the new bucket count *)
     let rec insert_bucket = function
         Empty -> ()
       | Cons(key, data, rest) ->
           insert_bucket rest; (* preserve original order of elements *)
-          let nidx = (hashfun key) mod nsize in
+          let nidx = indexfun h key in
           ndata.(nidx) <- Cons(key, data, ndata.(nidx)) in
     for i = 0 to osize - 1 do
       insert_bucket odata.(i)
-    done;
-    tbl.data <- ndata;
+    done
   end
 
+let key_index h key =
+  (* compatibility with old hash tables *)
+  if Obj.size (Obj.repr h) >= 3
+  then (seeded_hash_param 10 100 h.seed key) land (Array.length h.data - 1)
+  else (old_hash_param 10 100 key) mod (Array.length h.data)
+
 let add h key info =
-  let i = (hash key) mod (Array.length h.data) in
+  let i = key_index h key in
   let bucket = Cons(key, info, h.data.(i)) in
   h.data.(i) <- bucket;
-  h.size <- succ h.size;
-  if h.size > Array.length h.data lsl 1 then resize hash h
+  h.size <- h.size + 1;
+  if h.size > Array.length h.data lsl 1 then resize key_index h
 
 let remove h key =
   let rec remove_bucket = function
-      Empty ->
+    | Empty ->
         Empty
     | Cons(k, i, next) ->
         if compare k key = 0
-        then begin h.size <- pred h.size; next end
+        then begin h.size <- h.size - 1; next end
         else Cons(k, i, remove_bucket next) in
-  let i = (hash key) mod (Array.length h.data) in
+  let i = key_index h key in
   h.data.(i) <- remove_bucket h.data.(i)
 
 let rec find_rec key = function
-    Empty ->
+  | Empty ->
       raise Not_found
   | Cons(k, d, rest) ->
       if compare key k = 0 then d else find_rec key rest
 
 let find h key =
-  match h.data.((hash key) mod (Array.length h.data)) with
-    Empty -> raise Not_found
+  match h.data.(key_index h key) with
+  | Empty -> raise Not_found
   | Cons(k1, d1, rest1) ->
       if compare key k1 = 0 then d1 else
       match rest1 with
-        Empty -> raise Not_found
+      | Empty -> raise Not_found
       | Cons(k2, d2, rest2) ->
           if compare key k2 = 0 then d2 else
           match rest2 with
-            Empty -> raise Not_found
+          | Empty -> raise Not_found
           | Cons(k3, d3, rest3) ->
               if compare key k3 = 0 then d3 else find_rec key rest3
 
 let find_all h key =
   let rec find_in_bucket = function
-    Empty ->
+  | Empty ->
       []
   | Cons(k, d, rest) ->
       if compare k key = 0
       then d :: find_in_bucket rest
       else find_in_bucket rest in
-  find_in_bucket h.data.((hash key) mod (Array.length h.data))
+  find_in_bucket h.data.(key_index h key)
 
 let replace h key info =
   let rec replace_bucket = function
-      Empty ->
+    | Empty ->
         raise Not_found
     | Cons(k, i, next) ->
         if compare k key = 0
-        then Cons(k, info, next)
+        then Cons(key, info, next)
         else Cons(k, i, replace_bucket next) in
-  let i = (hash key) mod (Array.length h.data) in
+  let i = key_index h key in
   let l = h.data.(i) in
   try
     h.data.(i) <- replace_bucket l
   with Not_found ->
     h.data.(i) <- Cons(key, info, l);
-    h.size <- succ h.size;
-    if h.size > Array.length h.data lsl 1 then resize hash h
+    h.size <- h.size + 1;
+    if h.size > Array.length h.data lsl 1 then resize key_index h
 
 let mem h key =
   let rec mem_in_bucket = function
@@ -135,11 +178,11 @@
       false
   | Cons(k, d, rest) ->
       compare k key = 0 || mem_in_bucket rest in
-  mem_in_bucket h.data.((hash key) mod (Array.length h.data))
+  mem_in_bucket h.data.(key_index h key)
 
 let iter f h =
   let rec do_bucket = function
-      Empty ->
+    | Empty ->
         ()
     | Cons(k, d, rest) ->
         f k d; do_bucket rest in
@@ -162,6 +205,31 @@
   done;
   !accu
 
+type statistics = {
+  num_bindings: int;
+  num_buckets: int;
+  max_bucket_length: int;
+  bucket_histogram: int array
+}
+
+let rec bucket_length accu = function
+  | Empty -> accu
+  | Cons(_, _, rest) -> bucket_length (accu + 1) rest
+
+let stats h =
+  let mbl =
+    Array.fold_left (fun m b -> max m (bucket_length 0 b)) 0 h.data in
+  let histo = Array.make (mbl + 1) 0 in
+  Array.iter
+    (fun b ->
+      let l = bucket_length 0 b in
+      histo.(l) <- histo.(l) + 1)
+    h.data;
+  { num_bindings = h.size;
+    num_buckets = Array.length h.data;
+    max_bucket_length = mbl;
+    bucket_histogram = histo }
+
 (* Functorial interface *)
 
 module type HashedType =
@@ -171,12 +239,20 @@
     val hash: t -> int
   end
 
+module type SeededHashedType =
+  sig
+    type t
+    val equal: t -> t -> bool
+    val hash: int -> t -> int
+  end
+
 module type S =
   sig
     type key
     type 'a t
     val create: int -> 'a t
-    val clear: 'a t -> unit
+    val clear : 'a t -> unit
+    val reset : 'a t -> unit
     val copy: 'a t -> 'a t
     val add: 'a t -> key -> 'a -> unit
     val remove: 'a t -> key -> unit
@@ -187,83 +263,106 @@
     val iter: (key -> 'a -> unit) -> 'a t -> unit
     val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
     val length: 'a t -> int
+    val stats: 'a t -> statistics
   end
 
-module Make(H: HashedType): (S with type key = H.t) =
+module type SeededS =
+  sig
+    type key
+    type 'a t
+    val create : ?random:bool -> int -> 'a t
+    val clear : 'a t -> unit
+    val reset : 'a t -> unit
+    val copy : 'a t -> 'a t
+    val add : 'a t -> key -> 'a -> unit
+    val remove : 'a t -> key -> unit
+    val find : 'a t -> key -> 'a
+    val find_all : 'a t -> key -> 'a list
+    val replace : 'a t -> key -> 'a -> unit
+    val mem : 'a t -> key -> bool
+    val iter : (key -> 'a -> unit) -> 'a t -> unit
+    val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val length : 'a t -> int
+    val stats: 'a t -> statistics
+  end
+
+module MakeSeeded(H: SeededHashedType): (SeededS with type key = H.t) =
   struct
     type key = H.t
     type 'a hashtbl = (key, 'a) t
     type 'a t = 'a hashtbl
     let create = create
     let clear = clear
+    let reset = reset
     let copy = copy
 
-    let safehash key = (H.hash key) land max_int
+    let key_index h key =
+      (H.hash h.seed key) land (Array.length h.data - 1)
 
     let add h key info =
-      let i = (safehash key) mod (Array.length h.data) in
+      let i = key_index h key in
       let bucket = Cons(key, info, h.data.(i)) in
       h.data.(i) <- bucket;
-      h.size <- succ h.size;
-      if h.size > Array.length h.data lsl 1 then resize safehash h
+      h.size <- h.size + 1;
+      if h.size > Array.length h.data lsl 1 then resize key_index h
 
     let remove h key =
       let rec remove_bucket = function
-          Empty ->
+        | Empty ->
             Empty
         | Cons(k, i, next) ->
             if H.equal k key
-            then begin h.size <- pred h.size; next end
+            then begin h.size <- h.size - 1; next end
             else Cons(k, i, remove_bucket next) in
-      let i = (safehash key) mod (Array.length h.data) in
+      let i = key_index h key in
       h.data.(i) <- remove_bucket h.data.(i)
 
     let rec find_rec key = function
-        Empty ->
+      | Empty ->
           raise Not_found
       | Cons(k, d, rest) ->
           if H.equal key k then d else find_rec key rest
 
     let find h key =
-      match h.data.((safehash key) mod (Array.length h.data)) with
-        Empty -> raise Not_found
+      match h.data.(key_index h key) with
+      | Empty -> raise Not_found
       | Cons(k1, d1, rest1) ->
           if H.equal key k1 then d1 else
           match rest1 with
-            Empty -> raise Not_found
+          | Empty -> raise Not_found
           | Cons(k2, d2, rest2) ->
               if H.equal key k2 then d2 else
               match rest2 with
-                Empty -> raise Not_found
+              | Empty -> raise Not_found
               | Cons(k3, d3, rest3) ->
                   if H.equal key k3 then d3 else find_rec key rest3
 
     let find_all h key =
       let rec find_in_bucket = function
-        Empty ->
+      | Empty ->
           []
       | Cons(k, d, rest) ->
           if H.equal k key
           then d :: find_in_bucket rest
           else find_in_bucket rest in
-      find_in_bucket h.data.((safehash key) mod (Array.length h.data))
+      find_in_bucket h.data.(key_index h key)
 
     let replace h key info =
       let rec replace_bucket = function
-          Empty ->
+        | Empty ->
             raise Not_found
         | Cons(k, i, next) ->
             if H.equal k key
-            then Cons(k, info, next)
+            then Cons(key, info, next)
             else Cons(k, i, replace_bucket next) in
-      let i = (safehash key) mod (Array.length h.data) in
+      let i = key_index h key in
       let l = h.data.(i) in
       try
         h.data.(i) <- replace_bucket l
       with Not_found ->
         h.data.(i) <- Cons(key, info, l);
-        h.size <- succ h.size;
-        if h.size > Array.length h.data lsl 1 then resize safehash h
+        h.size <- h.size + 1;
+        if h.size > Array.length h.data lsl 1 then resize key_index h
 
     let mem h key =
       let rec mem_in_bucket = function
@@ -271,9 +370,20 @@
           false
       | Cons(k, d, rest) ->
           H.equal k key || mem_in_bucket rest in
-      mem_in_bucket h.data.((safehash key) mod (Array.length h.data))
+      mem_in_bucket h.data.(key_index h key)
 
     let iter = iter
     let fold = fold
     let length = length
+    let stats = stats
+  end
+
+module Make(H: HashedType): (S with type key = H.t) =
+  struct
+    include MakeSeeded(struct
+        type t = H.t
+        let equal = H.equal
+        let hash (seed: int) x = H.hash x
+      end)
+    let create sz = create ~random:false sz
   end
diff -Nru ocaml-3.12.1/stdlib/hashtbl.mli ocaml-4.01.0/stdlib/hashtbl.mli
--- ocaml-3.12.1/stdlib/hashtbl.mli	2005-05-04 13:36:47.000000000 +0000
+++ ocaml-4.01.0/stdlib/hashtbl.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: hashtbl.mli 6854 2005-05-04 13:36:47Z doligez $ *)
-
 (** Hash tables and hash functions.
 
    Hash tables are hashed association tables, with in-place modification.
@@ -25,16 +23,55 @@
 type ('a, 'b) t
 (** The type of hash tables from type ['a] to type ['b]. *)
 
-val create : int -> ('a, 'b) t
+val create : ?random:bool -> int -> ('a, 'b) t
 (** [Hashtbl.create n] creates a new, empty hash table, with
    initial size [n].  For best results, [n] should be on the
    order of the expected number of elements that will be in
    the table.  The table grows as needed, so [n] is just an
-   initial guess. *)
+   initial guess.
+
+   The optional [random] parameter (a boolean) controls whether
+   the internal organization of the hash table is randomized at each
+   execution of [Hashtbl.create] or deterministic over all executions.
+
+   A hash table that is created with [~random:false] uses a
+   fixed hash function ({!Hashtbl.hash}) to distribute keys among
+   buckets.  As a consequence, collisions between keys happen
+   deterministically.  In Web-facing applications or other
+   security-sensitive applications, the deterministic collision
+   patterns can be exploited by a malicious user to create a
+   denial-of-service attack: the attacker sends input crafted to
+   create many collisions in the table, slowing the application down.
+
+   A hash table that is created with [~random:true] uses the seeded
+   hash function {!Hashtbl.seeded_hash} with a seed that is randomly
+   chosen at hash table creation time.  In effect, the hash function
+   used is randomly selected among [2^{30}] different hash functions.
+   All these hash functions have different collision patterns,
+   rendering ineffective the denial-of-service attack described above.
+   However, because of randomization, enumerating all elements of the
+   hash table using {!Hashtbl.fold} or {!Hashtbl.iter} is no longer
+   deterministic: elements are enumerated in different orders at
+   different runs of the program.
+
+   If no [~random] parameter is given, hash tables are created
+   in non-random mode by default.  This default can be changed
+   either programmatically by calling {!Hashtbl.randomize} or by
+   setting the [R] flag in the [OCAMLRUNPARAM] environment variable.
+
+   @before 4.00.0 the [random] parameter was not present and all
+   hash tables were created in non-randomized mode. *)
 
 val clear : ('a, 'b) t -> unit
-(** Empty a hash table. *)
+(** Empty a hash table. Use [reset] instead of [clear] to shrink the
+    size of the bucket table to its initial size. *)
 
+val reset : ('a, 'b) t -> unit
+(** Empty a hash table and shrink the size of the bucket table
+    to its initial size. *)
+
+val copy : ('a, 'b) t -> ('a, 'b) t
+(** Return a copy of the given hashtable. *)
 
 val add : ('a, 'b) t -> 'a -> 'b -> unit
 (** [Hashtbl.add tbl x y] adds a binding of [x] to [y] in table [tbl].
@@ -43,9 +80,6 @@
    the previous binding for [x], if any, is restored.
    (Same behavior as with association lists.) *)
 
-val copy : ('a, 'b) t -> ('a, 'b) t
-(** Return a copy of the given hashtable. *)
-
 val find : ('a, 'b) t -> 'a -> 'b
 (** [Hashtbl.find tbl x] returns the current binding of [x] in [tbl],
    or raises [Not_found] if no such binding exists. *)
@@ -75,10 +109,17 @@
 (** [Hashtbl.iter f tbl] applies [f] to all bindings in table [tbl].
    [f] receives the key as first argument, and the associated value
    as second argument. Each binding is presented exactly once to [f].
+
    The order in which the bindings are passed to [f] is unspecified.
    However, if the table contains several bindings for the same key,
    they are passed to [f] in reverse order of introduction, that is,
-   the most recent binding is passed first. *)
+   the most recent binding is passed first.
+
+   If the hash table was created in non-randomized mode, the order
+   in which the bindings are enumerated is reproducible between
+   successive runs of the program, and even between minor versions
+   of OCaml.  For randomized hash tables, the order of enumeration
+   is entirely random. *)
 
 val fold : ('a -> 'b -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c
 (** [Hashtbl.fold f tbl init] computes
@@ -86,17 +127,62 @@
    where [k1 ... kN] are the keys of all bindings in [tbl],
    and [d1 ... dN] are the associated values.
    Each binding is presented exactly once to [f].
+
    The order in which the bindings are passed to [f] is unspecified.
    However, if the table contains several bindings for the same key,
    they are passed to [f] in reverse order of introduction, that is,
-   the most recent binding is passed first. *)
+   the most recent binding is passed first.
 
+   If the hash table was created in non-randomized mode, the order
+   in which the bindings are enumerated is reproducible between
+   successive runs of the program, and even between minor versions
+   of OCaml.  For randomized hash tables, the order of enumeration
+   is entirely random. *)
 
 val length : ('a, 'b) t -> int
 (** [Hashtbl.length tbl] returns the number of bindings in [tbl].
-   Multiple bindings are counted multiply, so [Hashtbl.length]
-   gives the number of times [Hashtbl.iter] calls its first argument. *)
-
+   It takes constant time.  Multiple bindings are counted once each, so
+   [Hashtbl.length] gives the number of times [Hashtbl.iter] calls its
+   first argument. *)
+
+val randomize : unit -> unit
+(** After a call to [Hashtbl.randomize()], hash tables are created in
+    randomized mode by default: {!Hashtbl.create} returns randomized
+    hash tables, unless the [~random:false] optional parameter is given.
+    The same effect can be achieved by setting the [R] parameter in
+    the [OCAMLRUNPARAM] environment variable.
+
+    It is recommended that applications or Web frameworks that need to
+    protect themselves against the denial-of-service attack described
+    in {!Hashtbl.create} call [Hashtbl.randomize()] at initialization
+    time.
+
+    Note that once [Hashtbl.randomize()] was called, there is no way
+    to revert to the non-randomized default behavior of {!Hashtbl.create}.
+    This is intentional.  Non-randomized hash tables can still be
+    created using [Hashtbl.create ~random:false].
+
+    @since 4.00.0 *)
+
+type statistics = {
+  num_bindings: int;
+    (** Number of bindings present in the table.
+        Same value as returned by {!Hashtbl.length}. *)
+  num_buckets: int;
+    (** Number of buckets in the table. *)
+  max_bucket_length: int;
+    (** Maximal number of bindings per bucket. *)
+  bucket_histogram: int array
+    (** Histogram of bucket sizes.  This array [histo] has
+        length [max_bucket_length + 1].  The value of
+        [histo.(i)] is the number of buckets whose size is [i]. *)
+}
+
+val stats : ('a, 'b) t -> statistics
+(** [Hashtbl.stats tbl] returns statistics about the table [tbl]:
+   number of buckets, size of the biggest bucket, distribution of
+   buckets by size.
+   @since 4.00.0 *)
 
 (** {6 Functorial interface} *)
 
@@ -113,12 +199,13 @@
           as computed by [hash].
           Examples: suitable ([equal], [hash]) pairs for arbitrary key
           types include
-          ([(=)], {!Hashtbl.hash}) for comparing objects by structure,
-          ([(fun x y -> compare x y = 0)], {!Hashtbl.hash})
-          for comparing objects by structure and handling {!Pervasives.nan}
-          correctly, and
-          ([(==)], {!Hashtbl.hash}) for comparing objects by addresses
-          (e.g. for cyclic keys). *)
+-         ([(=)], {!Hashtbl.hash}) for comparing objects by structure
+              (provided objects do not contain floats)
+-         ([(fun x y -> compare x y = 0)], {!Hashtbl.hash})
+              for comparing objects by structure
+              and handling {!Pervasives.nan} correctly
+-         ([(==)], {!Hashtbl.hash}) for comparing objects by physical
+              equality (e.g. for mutable or cyclic objects). *)
    end
 (** The input signature of the functor {!Hashtbl.Make}. *)
 
@@ -128,6 +215,7 @@
     type 'a t
     val create : int -> 'a t
     val clear : 'a t -> unit
+    val reset : 'a t -> unit
     val copy : 'a t -> 'a t
     val add : 'a t -> key -> 'a -> unit
     val remove : 'a t -> key -> unit
@@ -138,6 +226,7 @@
     val iter : (key -> 'a -> unit) -> 'a t -> unit
     val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
     val length : 'a t -> int
+    val stats: 'a t -> statistics
   end
 (** The output signature of the functor {!Hashtbl.Make}. *)
 
@@ -149,29 +238,96 @@
     The operations perform similarly to those of the generic
     interface, but use the hashing and equality functions
     specified in the functor argument [H] instead of generic
-    equality and hashing. *)
+    equality and hashing.  Since the hash function is not seeded,
+    the [create] operation of the result structure always returns
+    non-randomized hash tables. *)
+
+module type SeededHashedType =
+  sig
+    type t
+      (** The type of the hashtable keys. *)
+    val equal: t -> t -> bool
+      (** The equality predicate used to compare keys. *)
+    val hash: int -> t -> int
+      (** A seeded hashing function on keys.  The first argument is
+          the seed.  It must be the case that if [equal x y] is true,
+          then [hash seed x = hash seed y] for any value of [seed].
+          A suitable choice for [hash] is the function {!Hashtbl.seeded_hash}
+          below. *)
+  end
+(** The input signature of the functor {!Hashtbl.MakeSeeded}.
+    @since 4.00.0 *)
+
+module type SeededS =
+  sig
+    type key
+    type 'a t
+    val create : ?random:bool -> int -> 'a t
+    val clear : 'a t -> unit
+    val reset : 'a t -> unit
+    val copy : 'a t -> 'a t
+    val add : 'a t -> key -> 'a -> unit
+    val remove : 'a t -> key -> unit
+    val find : 'a t -> key -> 'a
+    val find_all : 'a t -> key -> 'a list
+    val replace : 'a t -> key -> 'a -> unit
+    val mem : 'a t -> key -> bool
+    val iter : (key -> 'a -> unit) -> 'a t -> unit
+    val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val length : 'a t -> int
+    val stats: 'a t -> statistics
+  end
+(** The output signature of the functor {!Hashtbl.MakeSeeded}.
+    @since 4.00.0 *)
+
+module MakeSeeded (H : SeededHashedType) : SeededS with type key = H.t
+(** Functor building an implementation of the hashtable structure.
+    The functor [Hashtbl.MakeSeeded] returns a structure containing
+    a type [key] of keys and a type ['a t] of hash tables
+    associating data of type ['a] to keys of type [key].
+    The operations perform similarly to those of the generic
+    interface, but use the seeded hashing and equality functions
+    specified in the functor argument [H] instead of generic
+    equality and hashing.  The [create] operation of the
+    result structure supports the [~random] optional parameter
+    and returns randomized hash tables if [~random:true] is passed
+    or if randomization is globally on (see {!Hashtbl.randomize}).
+    @since 4.00.0 *)
 
 
-(** {6 The polymorphic hash primitive} *)
+(** {6 The polymorphic hash functions} *)
 
 
 val hash : 'a -> int
-(** [Hashtbl.hash x] associates a positive integer to any value of
+(** [Hashtbl.hash x] associates a nonnegative integer to any value of
    any type. It is guaranteed that
    if [x = y] or [Pervasives.compare x y = 0], then [hash x = hash y].
-   Moreover, [hash] always terminates, even on cyclic
-   structures. *)
+   Moreover, [hash] always terminates, even on cyclic structures. *)
 
-external hash_param : int -> int -> 'a -> int = "caml_hash_univ_param" "noalloc"
-(** [Hashtbl.hash_param n m x] computes a hash value for [x], with the
-   same properties as for [hash]. The two extra parameters [n] and
-   [m] give more precise control over hashing. Hashing performs a
-   depth-first, right-to-left traversal of the structure [x], stopping
-   after [n] meaningful nodes were encountered, or [m] nodes,
-   meaningful or not, were encountered. Meaningful nodes are: integers;
-   floating-point numbers; strings; characters; booleans; and constant
-   constructors. Larger values of [m] and [n] means that more
-   nodes are taken into account to compute the final hash
-   value, and therefore collisions are less likely to happen.
-   However, hashing takes longer. The parameters [m] and [n]
-   govern the tradeoff between accuracy and speed. *)
+val seeded_hash : int -> 'a -> int
+(** A variant of {!Hashtbl.hash} that is further parameterized by
+   an integer seed.
+   @since 4.00.0 *)
+
+val hash_param : int -> int -> 'a -> int
+(** [Hashtbl.hash_param meaningful total x] computes a hash value for [x],
+   with the same properties as for [hash]. The two extra integer
+   parameters [meaningful] and [total] give more precise control over
+   hashing. Hashing performs a breadth-first, left-to-right traversal
+   of the structure [x], stopping after [meaningful] meaningful nodes
+   were encountered, or [total] nodes (meaningful or not) were
+   encountered. Meaningful nodes are: integers; floating-point
+   numbers; strings; characters; booleans; and constant
+   constructors. Larger values of [meaningful] and [total] means that
+   more nodes are taken into account to compute the final hash value,
+   and therefore collisions are less likely to happen.  However,
+   hashing takes longer. The parameters [meaningful] and [total]
+   govern the tradeoff between accuracy and speed.  As default
+   choices, {!Hashtbl.hash} and {!Hashtbl.seeded_hash} take
+   [meaningful = 10] and [total = 100]. *)
+
+val seeded_hash_param : int -> int -> int -> 'a -> int
+(** A variant of {!Hashtbl.hash_param} that is further parameterized by
+   an integer seed.  Usage:
+   [Hashtbl.seeded_hash_param meaningful total seed x].
+   @since 4.00.0 *)
diff -Nru ocaml-3.12.1/stdlib/header.c ocaml-4.01.0/stdlib/header.c
--- ocaml-3.12.1/stdlib/header.c	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/stdlib/header.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: header.c 9547 2010-01-22 12:48:24Z doligez $ */
-
 /* The launcher for bytecode executables (if #! is not working) */
 
 #include 
diff -Nru ocaml-3.12.1/stdlib/headernt.c ocaml-4.01.0/stdlib/headernt.c
--- ocaml-3.12.1/stdlib/headernt.c	2007-02-07 10:31:36.000000000 +0000
+++ ocaml-4.01.0/stdlib/headernt.c	2013-03-09 22:38:52.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -11,8 +11,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: headernt.c 7829 2007-02-07 10:31:36Z ertai $ */
-
 #define STRICT
 #define WIN32_LEAN_AND_MEAN
 
@@ -26,7 +24,7 @@
 #pragma comment(lib , "kernel32")
 #endif
 
-char * default_runtime_name = "ocamlrun";
+char * default_runtime_name = RUNTIME_NAME;
 
 static
 #if _MSC_VER >= 1200
@@ -157,7 +155,8 @@
     DWORD numwritten;
     errh = GetStdHandle(STD_ERROR_HANDLE);
     WriteFile(errh, truename, strlen(truename), &numwritten, NULL);
-    WriteFile(errh, msg_and_length(" not found or is not a bytecode executable file\r\n"),
+    WriteFile(errh, msg_and_length(" not found or is not a bytecode"
+                                   " executable file\r\n"),
               &numwritten, NULL);
     ExitProcess(2);
 #if _MSC_VER >= 1200
diff -Nru ocaml-3.12.1/stdlib/int32.ml ocaml-4.01.0/stdlib/int32.ml
--- ocaml-3.12.1/stdlib/int32.ml	2007-01-30 09:34:36.000000000 +0000
+++ ocaml-4.01.0/stdlib/int32.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: int32.ml 7818 2007-01-30 09:34:36Z xleroy $ *)
-
 (* Module [Int32]: 32-bit integers *)
 
 external neg : int32 -> int32 = "%int32_neg"
diff -Nru ocaml-3.12.1/stdlib/int32.mli ocaml-4.01.0/stdlib/int32.mli
--- ocaml-3.12.1/stdlib/int32.mli	2008-01-11 16:13:18.000000000 +0000
+++ ocaml-4.01.0/stdlib/int32.mli	2013-05-29 18:03:55.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: int32.mli 8768 2008-01-11 16:13:18Z doligez $ *)
-
 (** 32-bit integers.
 
    This module provides operations on the type [int32]
@@ -136,14 +134,14 @@
 
 external bits_of_float : float -> int32 = "caml_int32_bits_of_float"
 (** Return the internal representation of the given float according
-   to the IEEE 754 floating-point ``single format'' bit layout.
+   to the IEEE 754 floating-point 'single format' bit layout.
    Bit 31 of the result represents the sign of the float;
    bits 30 to 23 represent the (biased) exponent; bits 22 to 0
    represent the mantissa. *)
 
 external float_of_bits : int32 -> float = "caml_int32_float_of_bits"
 (** Return the floating-point number whose internal representation,
-   according to the IEEE 754 floating-point ``single format'' bit layout,
+   according to the IEEE 754 floating-point 'single format' bit layout,
    is the given [int32]. *)
 
 type t = int32
diff -Nru ocaml-3.12.1/stdlib/int64.ml ocaml-4.01.0/stdlib/int64.ml
--- ocaml-3.12.1/stdlib/int64.ml	2007-01-30 09:34:36.000000000 +0000
+++ ocaml-4.01.0/stdlib/int64.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: int64.ml 7818 2007-01-30 09:34:36Z xleroy $ *)
-
 (* Module [Int64]: 64-bit integers *)
 
 external neg : int64 -> int64 = "%int64_neg"
diff -Nru ocaml-3.12.1/stdlib/int64.mli ocaml-4.01.0/stdlib/int64.mli
--- ocaml-3.12.1/stdlib/int64.mli	2008-01-11 16:13:18.000000000 +0000
+++ ocaml-4.01.0/stdlib/int64.mli	2013-05-29 18:03:55.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: int64.mli 8768 2008-01-11 16:13:18Z doligez $ *)
-
 (** 64-bit integers.
 
    This module provides operations on the type [int64] of
@@ -158,14 +156,14 @@
 
 external bits_of_float : float -> int64 = "caml_int64_bits_of_float"
 (** Return the internal representation of the given float according
-   to the IEEE 754 floating-point ``double format'' bit layout.
+   to the IEEE 754 floating-point 'double format' bit layout.
    Bit 63 of the result represents the sign of the float;
    bits 62 to 52 represent the (biased) exponent; bits 51 to 0
    represent the mantissa. *)
 
 external float_of_bits : int64 -> float = "caml_int64_float_of_bits"
 (** Return the floating-point number whose internal representation,
-   according to the IEEE 754 floating-point ``double format'' bit layout,
+   according to the IEEE 754 floating-point 'double format' bit layout,
    is the given [int64]. *)
 
 type t = int64
diff -Nru ocaml-3.12.1/stdlib/lazy.ml ocaml-4.01.0/stdlib/lazy.ml
--- ocaml-3.12.1/stdlib/lazy.ml	2008-08-01 16:57:10.000000000 +0000
+++ ocaml-4.01.0/stdlib/lazy.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Damien Doligez, projet Para, INRIA Rocquencourt          *)
 (*                                                                     *)
@@ -11,14 +11,12 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: lazy.ml 8974 2008-08-01 16:57:10Z mauny $ *)
-
 (* Module [Lazy]: deferred computations *)
 
 
 (*
    WARNING: some purple magic is going on here.  Do not take this file
-   as an example of how to program in Objective Caml.
+   as an example of how to program in OCaml.
 *)
 
 
@@ -57,13 +55,13 @@
 
 let force_val = CamlinternalLazy.force_val;;
 
-let lazy_from_fun (f : unit -> 'arg) =
+let from_fun (f : unit -> 'arg) =
   let x = Obj.new_block Obj.lazy_tag 1 in
   Obj.set_field x 0 (Obj.repr f);
   (Obj.obj x : 'arg t)
 ;;
 
-let lazy_from_val (v : 'arg) =
+let from_val (v : 'arg) =
   let t = Obj.tag (Obj.repr v) in
   if t = Obj.forward_tag || t = Obj.lazy_tag || t = Obj.double_tag then begin
     make_forward v
@@ -72,4 +70,10 @@
   end
 ;;
 
-let lazy_is_val (l : 'arg t) = Obj.tag (Obj.repr l) <> Obj.lazy_tag;;
+let is_val (l : 'arg t) = Obj.tag (Obj.repr l) <> Obj.lazy_tag;;
+
+let lazy_from_fun = from_fun;;
+
+let lazy_from_val = from_val;;
+
+let lazy_is_val = is_val;;
diff -Nru ocaml-3.12.1/stdlib/lazy.mli ocaml-4.01.0/stdlib/lazy.mli
--- ocaml-3.12.1/stdlib/lazy.mli	2010-05-12 14:56:09.000000000 +0000
+++ ocaml-4.01.0/stdlib/lazy.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Damien Doligez, projet Para, INRIA Rocquencourt          *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: lazy.mli 10394 2010-05-12 14:56:09Z doligez $ *)
-
 (** Deferred computations. *)
 
 type 'a t = 'a lazy_t;;
@@ -42,8 +40,8 @@
 
 exception Undefined;;
 
-external force : 'a t -> 'a = "%lazy_force";;
 (* val force : 'a t -> 'a ;; *)
+external force : 'a t -> 'a = "%lazy_force";;
 (** [force x] forces the suspension [x] and returns its result.
    If [x] has already been forced, [Lazy.force x] returns the
    same value again without recomputing it.  If it raised an exception,
@@ -62,15 +60,26 @@
     whether [force_val x] raises the same exception or [Undefined].
 *)
 
+val from_fun : (unit -> 'a) -> 'a t;;
+(** [from_fun f] is the same as [lazy (f ())] but slightly more efficient.
+    @since 4.00.0 *)
+
+val from_val : 'a -> 'a t;;
+(** [from_val v] returns an already-forced suspension of [v].
+    This is for special purposes only and should not be confused with
+    [lazy (v)].
+    @since 4.00.0 *)
+
+val is_val : 'a t -> bool;;
+(** [is_val x] returns [true] if [x] has already been forced and
+    did not raise an exception.
+    @since 4.00.0 *)
+
 val lazy_from_fun : (unit -> 'a) -> 'a t;;
-(** [lazy_from_fun f] is the same as [lazy (f ())] but slightly more
-    efficient. *)
+(** @deprecated synonym for [from_fun]. *)
 
 val lazy_from_val : 'a -> 'a t;;
-(** [lazy_from_val v] returns an already-forced suspension of [v]
-    This is for special purposes only and should not be confused with
-    [lazy (v)]. *)
+(** @deprecated synonym for [from_val]. *)
 
 val lazy_is_val : 'a t -> bool;;
-(** [lazy_is_val x] returns [true] if [x] has already been forced and
-    did not raise an exception. *)
+(** @deprecated synonym for [is_val]. *)
diff -Nru ocaml-3.12.1/stdlib/lexing.ml ocaml-4.01.0/stdlib/lexing.ml
--- ocaml-3.12.1/stdlib/lexing.ml	2008-01-22 16:27:53.000000000 +0000
+++ ocaml-4.01.0/stdlib/lexing.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: lexing.ml 8787 2008-01-22 16:27:53Z doligez $ *)
-
 (* The run-time library for lexers generated by camllex *)
 
 type position = {
diff -Nru ocaml-3.12.1/stdlib/lexing.mli ocaml-4.01.0/stdlib/lexing.mli
--- ocaml-3.12.1/stdlib/lexing.mli	2010-05-21 18:30:12.000000000 +0000
+++ ocaml-4.01.0/stdlib/lexing.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: lexing.mli 10457 2010-05-21 18:30:12Z doligez $ *)
-
 (** The run-time library for lexers generated by [ocamllex]. *)
 
 (** {6 Positions} *)
@@ -26,9 +24,12 @@
 (** A value of type [position] describes a point in a source file.
    [pos_fname] is the file name; [pos_lnum] is the line number;
    [pos_bol] is the offset of the beginning of the line (number
-   of characters between the beginning of the file and the beginning
+   of characters between the beginning of the lexbuf and the beginning
    of the line); [pos_cnum] is the offset of the position (number of
-   characters between the beginning of the file and the position).
+   characters between the beginning of the lexbuf and the position).
+   The difference between [pos_cnum] and [pos_bol] is the character
+   offset within the line (i.e. the column number, assuming each
+   character is one column wide).
 
    See the documentation of type [lexbuf] for information about
    how the lexing engine will manage positions.
@@ -149,7 +150,7 @@
 (** {6  } *)
 
 (** The following definitions are used by the generated scanners only.
-   They are not intended to be used by user programs. *)
+   They are not intended to be used directly by user programs. *)
 
 val sub_lexeme : lexbuf -> int -> int -> string
 val sub_lexeme_opt : lexbuf -> int -> int -> string option
diff -Nru ocaml-3.12.1/stdlib/list.ml ocaml-4.01.0/stdlib/list.ml
--- ocaml-3.12.1/stdlib/list.ml	2006-09-11 12:18:00.000000000 +0000
+++ ocaml-4.01.0/stdlib/list.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: list.ml 7597 2006-09-11 12:18:00Z doligez $ *)
-
 (* List operations *)
 
 let rec length_aux len = function
@@ -56,6 +54,12 @@
     [] -> []
   | a::l -> let r = f a in r :: map f l
 
+let rec mapi i f = function
+    [] -> []
+  | a::l -> let r = f i a in r :: mapi (i + 1) f l
+
+let mapi f l = mapi 0 f l
+
 let rev_map f l =
   let rec rmap_f accu = function
     | [] -> accu
@@ -68,6 +72,12 @@
     [] -> ()
   | a::l -> f a; iter f l
 
+let rec iteri i f = function
+    [] -> ()
+  | a::l -> f i a; iteri (i + 1) f l
+
+let iteri f l = iteri 0 f l
+
 let rec fold_left f accu l =
   match l with
     [] -> accu
diff -Nru ocaml-3.12.1/stdlib/list.mli ocaml-4.01.0/stdlib/list.mli
--- ocaml-3.12.1/stdlib/list.mli	2006-09-11 12:18:00.000000000 +0000
+++ ocaml-4.01.0/stdlib/list.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: list.mli 7597 2006-09-11 12:18:00Z doligez $ *)
-
 (** List operations.
 
    Some functions are flagged as not tail-recursive.  A tail-recursive
@@ -75,11 +73,25 @@
    [a1; ...; an]. It is equivalent to
    [begin f a1; f a2; ...; f an; () end]. *)
 
+val iteri : (int -> 'a -> unit) -> 'a list -> unit
+(** Same as {!List.iter}, but the function is applied to the index of
+   the element as first argument (counting from 0), and the element
+   itself as second argument.
+   @since 4.00.0
+*)
+
 val map : ('a -> 'b) -> 'a list -> 'b list
 (** [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an],
    and builds the list [[f a1; ...; f an]]
    with the results returned by [f].  Not tail-recursive. *)
 
+val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
+(** Same as {!List.map}, but the function is applied to the index of
+   the element as first argument (counting from 0), and the element
+   itself as second argument.  Not tail-recursive.
+   @since 4.00.0
+*)
+
 val rev_map : ('a -> 'b) -> 'a list -> 'b list
 (** [List.rev_map f l] gives the same result as
    {!List.rev}[ (]{!List.map}[ f l)], but is tail-recursive and
diff -Nru ocaml-3.12.1/stdlib/listLabels.ml ocaml-4.01.0/stdlib/listLabels.ml
--- ocaml-3.12.1/stdlib/listLabels.ml	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/stdlib/listLabels.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*               Jacques Garrigue, Kyoto University RIMS               *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: listLabels.ml 4144 2001-12-07 13:41:02Z xleroy $ *)
-
 (* Module [ListLabels]: labelled List module *)
 
 include List
diff -Nru ocaml-3.12.1/stdlib/listLabels.mli ocaml-4.01.0/stdlib/listLabels.mli
--- ocaml-3.12.1/stdlib/listLabels.mli	2007-01-22 08:06:09.000000000 +0000
+++ ocaml-4.01.0/stdlib/listLabels.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: listLabels.mli 7805 2007-01-22 08:06:09Z garrigue $ *)
-
 (** List operations.
 
    Some functions are flagged as not tail-recursive.  A tail-recursive
@@ -75,11 +73,25 @@
    [a1; ...; an]. It is equivalent to
    [begin f a1; f a2; ...; f an; () end]. *)
 
+val iteri : f:(int -> 'a -> unit) -> 'a list -> unit
+(** Same as {!List.iter}, but the function is applied to the index of
+   the element as first argument (counting from 0), and the element
+   itself as second argument.
+   @since 4.00.0
+*)
+
 val map : f:('a -> 'b) -> 'a list -> 'b list
 (** [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an],
    and builds the list [[f a1; ...; f an]]
    with the results returned by [f].  Not tail-recursive. *)
 
+val mapi : f:(int -> 'a -> 'b) -> 'a list -> 'b list
+(** Same as {!List.map}, but the function is applied to the index of
+   the element as first argument (counting from 0), and the element
+   itself as second argument.
+   @since 4.00.0
+*)
+
 val rev_map : f:('a -> 'b) -> 'a list -> 'b list
 (** [List.rev_map f l] gives the same result as
    {!ListLabels.rev}[ (]{!ListLabels.map}[ f l)], but is tail-recursive and
diff -Nru ocaml-3.12.1/stdlib/map.ml ocaml-4.01.0/stdlib/map.ml
--- ocaml-3.12.1/stdlib/map.ml	2010-05-25 13:29:43.000000000 +0000
+++ ocaml-4.01.0/stdlib/map.ml	2013-03-09 22:38:52.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: map.ml 10468 2010-05-25 13:29:43Z frisch $ *)
-
 module type OrderedType =
   sig
     type t
@@ -29,7 +27,8 @@
     val add: key -> 'a -> 'a t -> 'a t
     val singleton: key -> 'a -> 'a t
     val remove: key -> 'a t -> 'a t
-    val merge: (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+    val merge:
+          (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
     val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
     val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
     val iter: (key -> 'a -> unit) -> 'a t -> unit
@@ -200,27 +199,31 @@
         Empty -> false
       | Node(l, v, d, r, _) -> p v d || exists p l || exists p r
 
-    let filter p s =
-      let rec filt accu = function
-        | Empty -> accu
-        | Node(l, v, d, r, _) ->
-            filt (filt (if p v d then add v d accu else accu) l) r in
-      filt Empty s
-
-    let partition p s =
-      let rec part (t, f as accu) = function
-        | Empty -> accu
-        | Node(l, v, d, r, _) ->
-            part (part (if p v d then (add v d t, f) else (t, add v d f)) l) r in
-      part (Empty, Empty) s
+    (* Beware: those two functions assume that the added k is *strictly*
+       smaller (or bigger) than all the present keys in the tree; it
+       does not test for equality with the current min (or max) key.
+
+       Indeed, they are only used during the "join" operation which
+       respects this precondition.
+    *)
+
+    let rec add_min_binding k v = function
+      | Empty -> singleton k v
+      | Node (l, x, d, r, h) ->
+        bal (add_min_binding k v l) x d r
+
+    let rec add_max_binding k v = function
+      | Empty -> singleton k v
+      | Node (l, x, d, r, h) ->
+        bal l x d (add_max_binding k v r)
 
     (* Same as create and bal, but no assumptions are made on the
        relative heights of l and r. *)
 
     let rec join l v d r =
       match (l, r) with
-        (Empty, _) -> add v d r
-      | (_, Empty) -> add v d l
+        (Empty, _) -> add_min_binding v d r
+      | (_, Empty) -> add_max_binding v d l
       | (Node(ll, lv, ld, lr, lh), Node(rl, rv, rd, rr, rh)) ->
           if lh > rh + 2 then bal ll lv ld (join lr v d r) else
           if rh > lh + 2 then bal (join l v d rl) rv rd rr else
@@ -266,6 +269,26 @@
       | _ ->
           assert false
 
+    let rec filter p = function
+        Empty -> Empty
+      | Node(l, v, d, r, _) ->
+          (* call [p] in the expected left-to-right order *)
+          let l' = filter p l in
+          let pvd = p v d in
+          let r' = filter p r in
+          if pvd then join l' v d r' else concat l' r'
+
+    let rec partition p = function
+        Empty -> (Empty, Empty)
+      | Node(l, v, d, r, _) ->
+          (* call [p] in the expected left-to-right order *)
+          let (lt, lf) = partition p l in
+          let pvd = p v d in
+          let (rt, rf) = partition p r in
+          if pvd
+          then (join lt v d rt, concat lf rf)
+          else (concat lt rt, join lf v d rf)
+
     type 'a enumeration = End | More of key * 'a * 'a t * 'a enumeration
 
     let rec cons_enum m e =
diff -Nru ocaml-3.12.1/stdlib/map.mli ocaml-4.01.0/stdlib/map.mli
--- ocaml-3.12.1/stdlib/map.mli	2010-07-24 14:16:58.000000000 +0000
+++ ocaml-4.01.0/stdlib/map.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: map.mli 10632 2010-07-24 14:16:58Z garrigue $ *)
-
 (** Association tables over ordered types.
 
    This module implements applicative association tables, also known as
diff -Nru ocaml-3.12.1/stdlib/marshal.ml ocaml-4.01.0/stdlib/marshal.ml
--- ocaml-3.12.1/stdlib/marshal.ml	2005-10-25 18:34:07.000000000 +0000
+++ ocaml-4.01.0/stdlib/marshal.ml	2013-04-18 11:58:59.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,11 +11,11 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: marshal.ml 7164 2005-10-25 18:34:07Z doligez $ *)
-
 type extern_flags =
     No_sharing
   | Closures
+  | Compat_32
+(* note: this type definition is used in 'byterun/debugger.c' *)
 
 external to_channel: out_channel -> 'a -> extern_flags list -> unit
     = "caml_output_value"
diff -Nru ocaml-3.12.1/stdlib/marshal.mli ocaml-4.01.0/stdlib/marshal.mli
--- ocaml-3.12.1/stdlib/marshal.mli	2005-10-25 18:34:07.000000000 +0000
+++ ocaml-4.01.0/stdlib/marshal.mli	2013-05-29 18:03:55.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: marshal.mli 7164 2005-10-25 18:34:07Z doligez $ *)
-
 (** Marshaling of data structures.
 
    This module provides functions to encode arbitrary data structures
@@ -20,14 +18,14 @@
    sent over a pipe or network connection.  The bytes can then
    be read back later, possibly in another process, and decoded back
    into a data structure. The format for the byte sequences
-   is compatible across all machines for a given version of Objective Caml.
+   is compatible across all machines for a given version of OCaml.
 
    Warning: marshaling is currently not type-safe. The type
    of marshaled data is not transmitted along the value of the data,
    making it impossible to check that the data read back possesses the
    type expected by the context. In particular, the result type of
    the [Marshal.from_*] functions is given as ['a], but this is
-   misleading: the returned Caml value does not possess type ['a]
+   misleading: the returned OCaml value does not possess type ['a]
    for all ['a]; it has one, unique type which cannot be determined
    at compile-type.  The programmer should explicitly give the expected
    type of the returned value, using the following syntax:
@@ -35,6 +33,13 @@
    Anything can happen at run-time if the object in the file does not
    belong to the given type.
 
+   OCaml exception values (of type [exn]) returned by the unmarhsaller
+   should not be pattern-matched over through [match ... with] or [try
+   ... with], because unmarshalling does not preserve the information
+   required for matching their exception constructor. Structural
+   equalities with other exception values, or most other uses such as
+   Printexc.to_string, will still work as expected.
+
    The representation of marshaled values is not human-readable,
    and uses bytes that are not printable characters. Therefore,
    input and output channels used in conjunction with [Marshal.to_channel]
@@ -47,20 +52,22 @@
 type extern_flags =
     No_sharing                          (** Don't preserve sharing *)
   | Closures                            (** Send function closures *)
+  | Compat_32                           (** Ensure 32-bit compatibility *)
 (** The flags to the [Marshal.to_*] functions below. *)
 
 val to_channel : out_channel -> 'a -> extern_flags list -> unit
 (** [Marshal.to_channel chan v flags] writes the representation
    of [v] on channel [chan]. The [flags] argument is a
    possibly empty list of flags that governs the marshaling
-   behavior with respect to sharing and functional values.
+   behavior with respect to sharing, functional values, and compatibility
+   between 32- and 64-bit platforms.
 
    If [flags] does not contain [Marshal.No_sharing], circularities
    and sharing inside the value [v] are detected and preserved
    in the sequence of bytes produced. In particular, this
    guarantees that marshaling always terminates. Sharing
    between values marshaled by successive calls to
-   [Marshal.to_channel] is not detected, though.
+   [Marshal.to_channel] is neither detected nor preserved, though.
    If [flags] contains [Marshal.No_sharing], sharing is ignored.
    This results in faster marshaling if [v] contains no shared
    substructures, but may cause slower marshaling and larger
@@ -69,7 +76,7 @@
 
    If [flags] does not contain [Marshal.Closures],
    marshaling fails when it encounters a functional value
-   inside [v]: only ``pure'' data structures, containing neither
+   inside [v]: only 'pure' data structures, containing neither
    functions nor objects, can safely be transmitted between
    different programs. If [flags] contains [Marshal.Closures],
    functional values will be marshaled as a position in the code
@@ -77,7 +84,20 @@
    only be read back in processes that run exactly the same program,
    with exactly the same compiled code. (This is checked
    at un-marshaling time, using an MD5 digest of the code
-   transmitted along with the code position.) *)
+   transmitted along with the code position.)
+
+   If [flags] contains [Marshal.Compat_32], marshaling fails when
+   it encounters an integer value outside the range [[-2{^30}, 2{^30}-1]]
+   of integers that are representable on a 32-bit platform.  This
+   ensures that marshaled data generated on a 64-bit platform can be
+   safely read back on a 32-bit platform.  If [flags] does not
+   contain [Marshal.Compat_32], integer values outside the
+   range [[-2{^30}, 2{^30}-1]] are marshaled, and can be read back on
+   a 64-bit platform, but will cause an error at un-marshaling time
+   when read back on a 32-bit platform.  The [Mashal.Compat_32] flag
+   only matters when marshaling is performed on a 64-bit platform;
+   it has no effect if marshaling is performed on a 32-bit platform.
+ *)
 
 external to_string :
   'a -> extern_flags list -> string = "caml_output_value_to_string"
@@ -115,7 +135,7 @@
    {!Marshal.data_size}[ buff ofs] is the size, in characters,
    of the data part, assuming a valid header is stored in
    [buff] starting at position [ofs].
-   Finally, {!Marshal.total_size}[ buff ofs] is the total size,
+   Finally, {!Marshal.total_size} [buff ofs] is the total size,
    in characters, of the marshaled value.
    Both {!Marshal.data_size} and {!Marshal.total_size} raise [Failure]
    if [buff], [ofs] does not contain a valid header.
diff -Nru ocaml-3.12.1/stdlib/moreLabels.ml ocaml-4.01.0/stdlib/moreLabels.ml
--- ocaml-3.12.1/stdlib/moreLabels.ml	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/stdlib/moreLabels.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*               Jacques Garrigue, Kyoto University RIMS               *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: moreLabels.ml 4144 2001-12-07 13:41:02Z xleroy $ *)
-
 (* Module [MoreLabels]: meta-module for compatibility labelled libraries *)
 
 module Hashtbl = Hashtbl
diff -Nru ocaml-3.12.1/stdlib/moreLabels.mli ocaml-4.01.0/stdlib/moreLabels.mli
--- ocaml-3.12.1/stdlib/moreLabels.mli	2010-05-25 13:29:43.000000000 +0000
+++ ocaml-4.01.0/stdlib/moreLabels.mli	2013-03-09 22:38:52.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*               Jacques Garrigue, Kyoto University RIMS               *)
 (*                                                                     *)
@@ -11,24 +11,23 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: moreLabels.mli 10468 2010-05-25 13:29:43Z frisch $ *)
-
 (** Extra labeled libraries.
 
    This meta-module provides labelized version of the {!Hashtbl},
    {!Map} and {!Set} modules.
 
    They only differ by their labels. They are provided to help
-   porting from previous versions of Objective Caml.
+   porting from previous versions of OCaml.
    The contents of this module are subject to change.
 *)
 
 module Hashtbl : sig
   type ('a, 'b) t = ('a, 'b) Hashtbl.t
-  val create : int -> ('a, 'b) t
+  val create : ?random:bool -> int -> ('a, 'b) t
   val clear : ('a, 'b) t -> unit
-  val add : ('a, 'b) t -> key:'a -> data:'b -> unit
+  val reset : ('a, 'b) t -> unit
   val copy : ('a, 'b) t -> ('a, 'b) t
+  val add : ('a, 'b) t -> key:'a -> data:'b -> unit
   val find : ('a, 'b) t -> 'a -> 'b
   val find_all : ('a, 'b) t -> 'a -> 'b list
   val mem : ('a, 'b) t -> 'a -> bool
@@ -39,13 +38,39 @@
       f:(key:'a -> data:'b -> 'c -> 'c) ->
         ('a, 'b) t -> init:'c -> 'c
   val length : ('a, 'b) t -> int
+  val randomize : unit -> unit
+  type statistics = Hashtbl.statistics
+  val stats : ('a, 'b) t -> statistics
   module type HashedType = Hashtbl.HashedType
+  module type SeededHashedType = Hashtbl.SeededHashedType
   module type S =
     sig
       type key
       and 'a t
       val create : int -> 'a t
       val clear : 'a t -> unit
+      val reset : 'a t -> unit
+      val copy : 'a t -> 'a t
+      val add : 'a t -> key:key -> data:'a -> unit
+      val remove : 'a t -> key -> unit
+      val find : 'a t -> key -> 'a
+      val find_all : 'a t -> key -> 'a list
+      val replace : 'a t -> key:key -> data:'a -> unit
+      val mem : 'a t -> key -> bool
+      val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit
+      val fold :
+          f:(key:key -> data:'a -> 'b -> 'b) ->
+          'a t -> init:'b -> 'b
+      val length : 'a t -> int
+      val stats: 'a t -> statistics
+    end
+  module type SeededS =
+    sig
+      type key
+      and 'a t
+      val create : ?random:bool -> int -> 'a t
+      val clear : 'a t -> unit
+      val reset : 'a t -> unit
       val copy : 'a t -> 'a t
       val add : 'a t -> key:key -> data:'a -> unit
       val remove : 'a t -> key -> unit
@@ -58,11 +83,14 @@
           f:(key:key -> data:'a -> 'b -> 'b) ->
           'a t -> init:'b -> 'b
       val length : 'a t -> int
+      val stats: 'a t -> statistics
     end
   module Make : functor (H : HashedType) -> S with type key = H.t
+  module MakeSeeded (H : SeededHashedType) : SeededS with type key = H.t
   val hash : 'a -> int
-  external hash_param : int -> int -> 'a -> int
-      = "caml_hash_univ_param" "noalloc"
+  val seeded_hash : int -> 'a -> int
+  val hash_param : int -> int -> 'a -> int
+  val seeded_hash_param : int -> int -> int -> 'a -> int
 end
 
 module Map : sig
@@ -77,7 +105,8 @@
       val add : key:key -> data:'a -> 'a t -> 'a t
       val singleton: key -> 'a -> 'a t
       val remove : key -> 'a t -> 'a t
-      val merge: f:(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+      val merge:
+          f:(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
       val compare: cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
       val equal: cmp:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
       val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit
@@ -131,6 +160,7 @@
       val max_elt : t -> elt
       val choose : t -> elt
       val split: elt -> t -> t * bool * t
+      val find: elt -> t -> elt
     end
   module Make : functor (Ord : OrderedType) -> S with type elt = Ord.t
 end
diff -Nru ocaml-3.12.1/stdlib/nativeint.ml ocaml-4.01.0/stdlib/nativeint.ml
--- ocaml-3.12.1/stdlib/nativeint.ml	2007-01-30 09:34:36.000000000 +0000
+++ ocaml-4.01.0/stdlib/nativeint.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: nativeint.ml 7818 2007-01-30 09:34:36Z xleroy $ *)
-
 (* Module [Nativeint]: processor-native integers *)
 
 external neg: nativeint -> nativeint = "%nativeint_neg"
diff -Nru ocaml-3.12.1/stdlib/nativeint.mli ocaml-4.01.0/stdlib/nativeint.mli
--- ocaml-3.12.1/stdlib/nativeint.mli	2005-10-25 18:34:07.000000000 +0000
+++ ocaml-4.01.0/stdlib/nativeint.mli	2013-03-09 22:38:52.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: nativeint.mli 7164 2005-10-25 18:34:07Z doligez $ *)
-
 (** Processor-native integers.
 
    This module provides operations on the type [nativeint] of
@@ -60,7 +58,8 @@
 (** Integer remainder.  If [y] is not zero, the result
    of [Nativeint.rem x y] satisfies the following properties:
    [Nativeint.zero <= Nativeint.rem x y < Nativeint.abs y] and
-   [x = Nativeint.add (Nativeint.mul (Nativeint.div x y) y) (Nativeint.rem x y)].
+   [x = Nativeint.add (Nativeint.mul (Nativeint.div x y) y)
+                      (Nativeint.rem x y)].
    If [y = 0], [Nativeint.rem x y] raises [Division_by_zero]. *)
 
 val succ : nativeint -> nativeint
diff -Nru ocaml-3.12.1/stdlib/obj.ml ocaml-4.01.0/stdlib/obj.ml
--- ocaml-3.12.1/stdlib/obj.ml	2010-01-25 11:55:30.000000000 +0000
+++ ocaml-4.01.0/stdlib/obj.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: obj.ml 9561 2010-01-25 11:55:30Z doligez $ *)
-
 (* Operations on internal representations of values *)
 
 type t
diff -Nru ocaml-3.12.1/stdlib/obj.mli ocaml-4.01.0/stdlib/obj.mli
--- ocaml-3.12.1/stdlib/obj.mli	2010-05-21 18:30:12.000000000 +0000
+++ ocaml-4.01.0/stdlib/obj.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: obj.mli 10457 2010-05-21 18:30:12Z doligez $ *)
-
 (** Operations on internal representations of values.
 
    Not for the casual user.
diff -Nru ocaml-3.12.1/stdlib/oo.ml ocaml-4.01.0/stdlib/oo.ml
--- ocaml-3.12.1/stdlib/oo.ml	2004-05-26 11:10:52.000000000 +0000
+++ ocaml-4.01.0/stdlib/oo.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*         Jerome Vouillon, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: oo.ml 6331 2004-05-26 11:10:52Z garrigue $ *)
-
 let copy = CamlinternalOO.copy
 external id : < .. > -> int = "%field1"
 let new_method = CamlinternalOO.public_method_label
diff -Nru ocaml-3.12.1/stdlib/oo.mli ocaml-4.01.0/stdlib/oo.mli
--- ocaml-3.12.1/stdlib/oo.mli	2004-05-26 11:10:52.000000000 +0000
+++ ocaml-4.01.0/stdlib/oo.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*         Jerome Vouillon, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,19 +11,26 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: oo.mli 6331 2004-05-26 11:10:52Z garrigue $ *)
-
 (** Operations on objects *)
 
 val copy : (< .. > as 'a) -> 'a
 (** [Oo.copy o] returns a copy of object [o], that is a fresh
-   object with the same methods and instance variables as [o]  *)
+   object with the same methods and instance variables as [o]. *)
 
 external id : < .. > -> int = "%field1"
 (** Return an integer identifying this object, unique for
-    the current execution of the program. *)
+    the current execution of the program. The generic comparison
+    and hashing functions are based on this integer. When an object
+    is obtained by unmarshaling, the id is refreshed, and thus
+    different from the original object. As a consequence, the internal
+    invariants of data structures such as hash table or sets containing
+    objects are broken after unmarshaling the data structures.
+  *)
 
 (**/**)
+
+(* The following is for system use only. Do not call directly. *)
+
 (** For internal use (CamlIDL) *)
 val new_method : string -> CamlinternalOO.tag
 val public_method_label : string -> CamlinternalOO.tag
diff -Nru ocaml-3.12.1/stdlib/parsing.ml ocaml-4.01.0/stdlib/parsing.ml
--- ocaml-3.12.1/stdlib/parsing.ml	2010-12-22 13:05:55.000000000 +0000
+++ ocaml-4.01.0/stdlib/parsing.ml	2013-03-09 22:38:52.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: parsing.ml 10908 2010-12-22 13:05:55Z xleroy $ *)
-
 (* The parsing engine *)
 
 open Lexing
@@ -74,6 +72,10 @@
   | Compute_semantic_action
   | Call_error_function
 
+(* to avoid warnings *)
+let _ = [Read_token; Raise_parse_error; Grow_stacks_1; Grow_stacks_2;
+         Compute_semantic_action; Call_error_function]
+
 external parse_engine :
     parse_tables -> parser_env -> parser_input -> Obj.t -> parser_output
     = "caml_parse_engine"
diff -Nru ocaml-3.12.1/stdlib/parsing.mli ocaml-4.01.0/stdlib/parsing.mli
--- ocaml-3.12.1/stdlib/parsing.mli	2010-05-21 18:30:12.000000000 +0000
+++ ocaml-4.01.0/stdlib/parsing.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: parsing.mli 10457 2010-05-21 18:30:12Z doligez $ *)
-
 (** The run-time library for parsers generated by [ocamlyacc]. *)
 
 val symbol_start : unit -> int
@@ -74,7 +72,7 @@
 (** {6  } *)
 
 (** The following definitions are used by the generated parsers only.
-   They are not intended to be used by user programs. *)
+   They are not intended to be used directly by user programs. *)
 
 type parser_env
 
diff -Nru ocaml-3.12.1/stdlib/pervasives.ml ocaml-4.01.0/stdlib/pervasives.ml
--- ocaml-3.12.1/stdlib/pervasives.ml	2010-06-09 10:27:01.000000000 +0000
+++ ocaml-4.01.0/stdlib/pervasives.ml	2013-06-19 11:46:11.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: pervasives.ml 10549 2010-06-09 10:27:01Z weis $ *)
-
 (* type 'a option = None | Some of 'a *)
 
 (* Exceptions *)
@@ -24,65 +22,70 @@
 
 exception Exit
 
+(* Composition operators *)
+
+external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
+
 (* Comparisons *)
 
-external (=) : 'a -> 'a -> bool = "%equal"
-external (<>) : 'a -> 'a -> bool = "%notequal"
-external (<) : 'a -> 'a -> bool = "%lessthan"
-external (>) : 'a -> 'a -> bool = "%greaterthan"
-external (<=) : 'a -> 'a -> bool = "%lessequal"
-external (>=) : 'a -> 'a -> bool = "%greaterequal"
-external compare: 'a -> 'a -> int = "%compare"
+external ( = ) : 'a -> 'a -> bool = "%equal"
+external ( <> ) : 'a -> 'a -> bool = "%notequal"
+external ( < ) : 'a -> 'a -> bool = "%lessthan"
+external ( > ) : 'a -> 'a -> bool = "%greaterthan"
+external ( <= ) : 'a -> 'a -> bool = "%lessequal"
+external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
+external compare : 'a -> 'a -> int = "%compare"
 
 let min x y = if x <= y then x else y
 let max x y = if x >= y then x else y
 
-external (==) : 'a -> 'a -> bool = "%eq"
-external (!=) : 'a -> 'a -> bool = "%noteq"
+external ( == ) : 'a -> 'a -> bool = "%eq"
+external ( != ) : 'a -> 'a -> bool = "%noteq"
 
 (* Boolean operations *)
 
 external not : bool -> bool = "%boolnot"
-external (&) : bool -> bool -> bool = "%sequand"
-external (&&) : bool -> bool -> bool = "%sequand"
-external (or) : bool -> bool -> bool = "%sequor"
-external (||) : bool -> bool -> bool = "%sequor"
+external ( & ) : bool -> bool -> bool = "%sequand"
+external ( && ) : bool -> bool -> bool = "%sequand"
+external ( or ) : bool -> bool -> bool = "%sequor"
+external ( || ) : bool -> bool -> bool = "%sequor"
 
 (* Integer operations *)
 
-external (~-) : int -> int = "%negint"
-external (~+) : int -> int = "%identity"
+external ( ~- ) : int -> int = "%negint"
+external ( ~+ ) : int -> int = "%identity"
 external succ : int -> int = "%succint"
 external pred : int -> int = "%predint"
-external (+) : int -> int -> int = "%addint"
-external (-) : int -> int -> int = "%subint"
-external ( * ) : int -> int -> int = "%mulint"
-external (/) : int -> int -> int = "%divint"
-external (mod) : int -> int -> int = "%modint"
+external ( + ) : int -> int -> int = "%addint"
+external ( - ) : int -> int -> int = "%subint"
+external ( *  ) : int -> int -> int = "%mulint"
+external ( / ) : int -> int -> int = "%divint"
+external ( mod ) : int -> int -> int = "%modint"
 
 let abs x = if x >= 0 then x else -x
 
-external (land) : int -> int -> int = "%andint"
-external (lor) : int -> int -> int = "%orint"
-external (lxor) : int -> int -> int = "%xorint"
+external ( land ) : int -> int -> int = "%andint"
+external ( lor ) : int -> int -> int = "%orint"
+external ( lxor ) : int -> int -> int = "%xorint"
 
 let lnot x = x lxor (-1)
 
-external (lsl) : int -> int -> int = "%lslint"
-external (lsr) : int -> int -> int = "%lsrint"
-external (asr) : int -> int -> int = "%asrint"
+external ( lsl ) : int -> int -> int = "%lslint"
+external ( lsr ) : int -> int -> int = "%lsrint"
+external ( asr ) : int -> int -> int = "%asrint"
 
 let min_int = 1 lsl (if 1 lsl 31 = 0 then 30 else 62)
 let max_int = min_int - 1
 
 (* Floating-point operations *)
 
-external (~-.) : float -> float = "%negfloat"
-external (~+.) : float -> float = "%identity"
-external (+.) : float -> float -> float = "%addfloat"
-external (-.) : float -> float -> float = "%subfloat"
+external ( ~-. ) : float -> float = "%negfloat"
+external ( ~+. ) : float -> float = "%identity"
+external ( +. ) : float -> float -> float = "%addfloat"
+external ( -. ) : float -> float -> float = "%subfloat"
 external ( *. ) : float -> float -> float = "%mulfloat"
-external (/.) : float -> float -> float = "%divfloat"
+external ( /. ) : float -> float -> float = "%divfloat"
 external ( ** ) : float -> float -> float = "caml_power_float" "pow" "float"
 external exp : float -> float = "caml_exp_float" "exp" "float"
 external expm1 : float -> float = "caml_expm1_float" "caml_expm1" "float"
@@ -90,6 +93,8 @@
 external asin : float -> float = "caml_asin_float" "asin" "float"
 external atan : float -> float = "caml_atan_float" "atan" "float"
 external atan2 : float -> float -> float = "caml_atan2_float" "atan2" "float"
+external hypot : float -> float -> float
+               = "caml_hypot_float" "caml_hypot" "float"
 external cos : float -> float = "caml_cos_float" "cos" "float"
 external cosh : float -> float = "caml_cosh_float" "cosh" "float"
 external log : float -> float = "caml_log_float" "log" "float"
@@ -103,6 +108,8 @@
 external ceil : float -> float = "caml_ceil_float" "ceil" "float"
 external floor : float -> float = "caml_floor_float" "floor" "float"
 external abs_float : float -> float = "%absfloat"
+external copysign : float -> float -> float
+                  = "caml_copysign_float" "caml_copysign" "float"
 external mod_float : float -> float -> float = "caml_fmod_float" "fmod" "float"
 external frexp : float -> float * int = "caml_frexp_float"
 external ldexp : float -> int -> float = "caml_ldexp_float"
@@ -131,16 +138,16 @@
   | FP_zero
   | FP_infinite
   | FP_nan
-external classify_float: float -> fpclass = "caml_classify_float"
+external classify_float : float -> fpclass = "caml_classify_float"
 
 (* String operations -- more in module String *)
 
 external string_length : string -> int = "%string_length"
-external string_create: int -> string = "caml_create_string"
+external string_create : int -> string = "caml_create_string"
 external string_blit : string -> int -> string -> int -> int -> unit
                      = "caml_blit_string" "noalloc"
 
-let (^) s1 s2 =
+let ( ^ ) s1 s2 =
   let l1 = string_length s1 and l2 = string_length s2 in
   let s = string_create (l1 + l2) in
   string_blit s1 0 s 0 l1;
@@ -165,8 +172,8 @@
 
 (* String conversion functions *)
 
-external format_int: string -> int -> string = "caml_format_int"
-external format_float: string -> float -> string = "caml_format_float"
+external format_int : string -> int -> string = "caml_format_int"
+external format_float : string -> float -> string = "caml_format_float"
 
 let string_of_bool b =
   if b then "true" else "false"
@@ -189,7 +196,7 @@
   let rec loop i =
     if i >= l then s ^ "." else
     match s.[i] with
-    | '0' .. '9' | '-' -> loop (i+1)
+    | '0' .. '9' | '-' -> loop (i + 1)
     | _ -> s
   in
   loop 0
@@ -201,7 +208,7 @@
 
 (* List operations -- more in module List *)
 
-let rec (@) l1 l2 =
+let rec ( @ ) l1 l2 =
   match l1 with
     [] -> l2
   | hd :: tl -> hd :: (tl @ l2)
@@ -211,8 +218,9 @@
 type in_channel
 type out_channel
 
-external open_descriptor_out: int -> out_channel = "caml_ml_open_descriptor_out"
-external open_descriptor_in: int -> in_channel = "caml_ml_open_descriptor_in"
+external open_descriptor_out : int -> out_channel
+                             = "caml_ml_open_descriptor_out"
+external open_descriptor_in : int -> in_channel = "caml_ml_open_descriptor_in"
 
 let stdin = open_descriptor_in 0
 let stdout = open_descriptor_out 1
@@ -225,7 +233,7 @@
   | Open_creat | Open_trunc | Open_excl
   | Open_binary | Open_text | Open_nonblock
 
-external open_desc: string -> open_flag list -> int -> int = "caml_sys_open"
+external open_desc : string -> open_flag list -> int -> int = "caml_sys_open"
 
 let open_out_gen mode perm name =
   open_descriptor_out(open_desc name mode perm)
@@ -244,7 +252,7 @@
 let flush_all () =
   let rec iter = function
       [] -> ()
-    | a::l -> (try flush a with _ -> ()); iter l
+    | a :: l -> (try flush a with _ -> ()); iter l
   in iter (out_channels_list ())
 
 external unsafe_output : out_channel -> string -> int -> int -> unit
@@ -304,7 +312,7 @@
     let r = unsafe_input ic s ofs len in
     if r = 0
     then raise End_of_file
-    else unsafe_really_input ic s (ofs+r) (len-r)
+    else unsafe_really_input ic s (ofs + r) (len - r)
   end
 
 let really_input ic s ofs len =
@@ -328,8 +336,8 @@
         [] -> raise End_of_file
       | _  -> build_result (string_create len) len accu
     end else if n > 0 then begin          (* n > 0: newline found in buffer *)
-      let res = string_create (n-1) in
-      ignore (unsafe_input chan res 0 (n-1));
+      let res = string_create (n - 1) in
+      ignore (unsafe_input chan res 0 (n - 1));
       ignore (input_char chan);           (* skip the newline *)
       match accu with
         [] -> res
@@ -394,12 +402,12 @@
 
 (* References *)
 
-type 'a ref = { mutable contents: 'a }
-external ref: 'a -> 'a ref = "%makemutable"
-external (!): 'a ref -> 'a = "%field0"
-external (:=): 'a ref -> 'a -> unit = "%setfield0"
-external incr: int ref -> unit = "%incr"
-external decr: int ref -> unit = "%decr"
+type 'a ref = { mutable contents : 'a }
+external ref : 'a -> 'a ref = "%makemutable"
+external ( ! ) : 'a ref -> 'a = "%field0"
+external ( := ) : 'a ref -> 'a -> unit = "%setfield0"
+external incr : int ref -> unit = "%incr"
+external decr : int ref -> unit = "%decr"
 
 (* Formats *)
 type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
diff -Nru ocaml-3.12.1/stdlib/pervasives.mli ocaml-4.01.0/stdlib/pervasives.mli
--- ocaml-3.12.1/stdlib/pervasives.mli	2011-05-17 13:31:32.000000000 +0000
+++ ocaml-4.01.0/stdlib/pervasives.mli	2013-07-24 09:21:49.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: pervasives.mli 11048 2011-05-17 13:31:32Z doligez $ *)
-
 (** The initially opened module.
 
    This module provides the basic operations over the built-in types
@@ -38,7 +36,7 @@
 
 exception Exit
 (** The [Exit] exception is not raised by any library function.  It is
-    provided for use in your programs.*)
+    provided for use in your programs. *)
 
 
 (** {6 Comparisons} *)
@@ -52,24 +50,24 @@
    Equality between cyclic data structures may not terminate. *)
 
 external ( <> ) : 'a -> 'a -> bool = "%notequal"
-(** Negation of {!Pervasives.(=)}. *)
+(** Negation of {!Pervasives.( = )}. *)
 
 external ( < ) : 'a -> 'a -> bool = "%lessthan"
-(** See {!Pervasives.(>=)}. *)
+(** See {!Pervasives.( >= )}. *)
 
 external ( > ) : 'a -> 'a -> bool = "%greaterthan"
-(** See {!Pervasives.(>=)}. *)
+(** See {!Pervasives.( >= )}. *)
 
 external ( <= ) : 'a -> 'a -> bool = "%lessequal"
-(** See {!Pervasives.(>=)}. *)
+(** See {!Pervasives.( >= )}. *)
 
 external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
 (** Structural ordering functions. These functions coincide with
    the usual orderings over integers, characters, strings
    and floating-point numbers, and extend them to a
    total ordering over all types.
-   The ordering is compatible with [(=)]. As in the case
-   of [(=)], mutable structures are compared by contents.
+   The ordering is compatible with [( = )]. As in the case
+   of [( = )], mutable structures are compared by contents.
    Comparison between functional values raises [Invalid_argument].
    Comparison between cyclic structures may not terminate. *)
 
@@ -108,12 +106,12 @@
    mutable fields and objects with mutable instance variables,
    [e1 == e2] is true if and only if physical modification of [e1]
    also affects [e2].
-   On non-mutable types, the behavior of [(==)] is
+   On non-mutable types, the behavior of [( == )] is
    implementation-dependent; however, it is guaranteed that
    [e1 == e2] implies [compare e1 e2 = 0]. *)
 
 external ( != ) : 'a -> 'a -> bool = "%noteq"
-(** Negation of {!Pervasives.(==)}. *)
+(** Negation of {!Pervasives.( == )}. *)
 
 
 (** {6 Boolean operations} *)
@@ -122,7 +120,7 @@
 (** The boolean negation. *)
 
 external ( && ) : bool -> bool -> bool = "%sequand"
-(** The boolean ``and''. Evaluation is sequential, left-to-right:
+(** The boolean 'and'. Evaluation is sequential, left-to-right:
    in [e1 && e2], [e1] is evaluated first, and if it returns [false],
    [e2] is not evaluated at all. *)
 
@@ -130,7 +128,7 @@
 (** @deprecated {!Pervasives.( && )} should be used instead. *)
 
 external ( || ) : bool -> bool -> bool = "%sequor"
-(** The boolean ``or''. Evaluation is sequential, left-to-right:
+(** The boolean 'or'. Evaluation is sequential, left-to-right:
    in [e1 || e2], [e1] is evaluated first, and if it returns [true],
    [e2] is not evaluated at all. *)
 
@@ -138,6 +136,20 @@
 (** @deprecated {!Pervasives.( || )} should be used instead.*)
 
 
+(** {6 Composition operators} *)
+
+external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+(** Reverse-application operator: [x |> f |> g] is exactly equivalent
+ to [g (f (x))].
+   @since 4.01
+*)
+
+external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
+(** Application operator: [g @@ f @@ x] is exactly equivalent to
+ [g (f (x))].
+   @since 4.01
+*)
+
 (** {6 Integer arithmetic} *)
 
 (** Integers are 31 bits wide (or 63 bits on 64-bit processors).
@@ -229,12 +241,12 @@
 
 (** {6 Floating-point arithmetic}
 
-   Caml's floating-point numbers follow the
+   OCaml's floating-point numbers follow the
    IEEE 754 standard, using double precision (64 bits) numbers.
    Floating-point operations never raise an exception on overflow,
    underflow, division by zero, etc.  Instead, special IEEE numbers
    are returned as appropriate, such as [infinity] for [1.0 /. 0.0],
-   [neg_infinity] for [-1.0 /. 0.0], and [nan] (``not a number'')
+   [neg_infinity] for [-1.0 /. 0.0], and [nan] ('not a number')
    for [0.0 /. 0.0].  These special numbers then propagate through
    floating-point computations as expected: for instance,
    [1.0 /. infinity] is [0.0], and any arithmetic operation with [nan]
@@ -314,6 +326,14 @@
     and [y] are used to determine the quadrant of the result.
     Result is in radians and is between [-pi] and [pi]. *)
 
+external hypot : float -> float -> float
+               = "caml_hypot_float" "caml_hypot" "float"
+(** [hypot x y] returns [sqrt(x *. x + y *. y)], that is, the length
+  of the hypotenuse of a right-angled triangle with sides of length
+  [x] and [y], or, equivalently, the distance of the point [(x,y)]
+  to origin.
+  @since 4.00.0  *)
+
 external cosh : float -> float = "caml_cosh_float" "cosh" "float"
 (** Hyperbolic cosine.  Argument is in radians. *)
 
@@ -337,6 +357,14 @@
 external abs_float : float -> float = "%absfloat"
 (** [abs_float f] returns the absolute value of [f]. *)
 
+external copysign : float -> float -> float
+                  = "caml_copysign_float" "caml_copysign" "float"
+(** [copysign x y] returns a float whose absolute value is that of [x]
+  and whose sign is that of [y].  If [x] is [nan], returns [nan].
+  If [y] is [nan], returns either [x] or [-. x], but it is not
+  specified which.
+  @since 4.00.0  *)
+
 external mod_float : float -> float -> float = "caml_fmod_float" "fmod" "float"
 (** [mod_float a b] returns the remainder of [a] with respect to
    [b].  The returned value is [a -. n *. b], where [n]
@@ -379,7 +407,7 @@
 val nan : float
 (** A special floating-point value denoting the result of an
    undefined operation such as [0.0 /. 0.0].  Stands for
-   ``not a number''.  Any floating-point operation with [nan] as
+   'not a number'.  Any floating-point operation with [nan] as
    argument returns [nan] as result.  As for floating-point comparisons,
    [=], [<], [<=], [>] and [>=] return [false] and [<>] returns [true]
    if one or both of their arguments is [nan]. *)
@@ -445,7 +473,9 @@
 (** {6 String conversion functions} *)
 
 val string_of_bool : bool -> string
-(** Return the string representation of a boolean. *)
+(** Return the string representation of a boolean. As the returned values
+   may be shared, the user should not modify them directly.
+*)
 
 val bool_of_string : string -> bool
 (** Convert the given string to a boolean.
@@ -490,7 +520,9 @@
 (** List concatenation. *)
 
 
-(** {6 Input/output} *)
+(** {6 Input/output}
+    Note: all input/output functions can raise [Sys_error] when the system
+    calls they invoke fail. *)
 
 type in_channel
 (** The type of input channel. *)
@@ -593,8 +625,7 @@
 (** Open the named file for writing, and return a new output channel
    on that file, positionned at the beginning of the file. The
    file is truncated to zero length if it already exists. It
-   is created if it does not already exists.
-   Raise [Sys_error] if the file could not be opened. *)
+   is created if it does not already exists. *)
 
 val open_out_bin : string -> out_channel
 (** Same as {!Pervasives.open_out}, but the file is opened in binary mode,
@@ -642,7 +673,7 @@
    The given integer is taken modulo 2{^32}.
    The only reliable way to read it back is through the
    {!Pervasives.input_binary_int} function. The format is compatible across
-   all machines for a given version of Objective Caml. *)
+   all machines for a given version of OCaml. *)
 
 val output_value : out_channel -> 'a -> unit
 (** Write the representation of a structured value of any type
@@ -694,8 +725,7 @@
 
 val open_in : string -> in_channel
 (** Open the named file for reading, and return a new input channel
-   on that file, positionned at the beginning of the file.
-   Raise [Sys_error] if the file could not be opened. *)
+   on that file, positionned at the beginning of the file. *)
 
 val open_in_bin : string -> in_channel
 (** Same as {!Pervasives.open_in}, but the file is opened in binary mode,
@@ -784,8 +814,7 @@
 (** Close the given channel.  Input functions raise a [Sys_error]
   exception when they are applied to a closed input channel,
   except [close_in], which does nothing when applied to an already
-  closed channel.  Note that [close_in] may raise [Sys_error] if
-  the operating system signals an error. *)
+  closed channel. *)
 
 val close_in_noerr : in_channel -> unit
 (** Same as [close_in], but ignore all errors. *)
@@ -848,24 +877,73 @@
 
 (** {6 Operations on format strings} *)
 
-(** Format strings are used to read and print data using formatted input
-    functions in module {!Scanf} and formatted output in modules {!Printf} and
-    {!Format}. *)
+(** Format strings are character strings with special lexical conventions
+  that defines the functionality of formatted input/output functions. Format
+  strings are used to read data with formatted input functions from module
+  {!Scanf} and to print data with formatted output functions from modules
+  {!Printf} and {!Format}.
+
+  Format strings are made of three kinds of entities:
+  - {e conversions specifications}, introduced by the special character ['%']
+    followed by one or more characters specifying what kind of argument to
+    read or print,
+  - {e formatting indications}, introduced by the special character ['@']
+    followed by one or more characters specifying how to read or print the
+    argument,
+  - {e plain characters} that are regular characters with usual lexical
+    conventions. Plain characters specify string literals to be read in the
+    input or printed in the output.
+
+  There is an additional lexical rule to escape the special characters ['%']
+  and ['@'] in format strings: if a special character follows a ['%']
+  character, it is treated as a plain character. In other words, ["%%"] is
+  considered as a plain ['%'] and ["%@"] as a plain ['@'].
+
+  For more information about conversion specifications and formatting
+  indications available, read the documentation of modules {!Scanf},
+  {!Printf} and {!Format}.
+*)
 
 (** Format strings have a general and highly polymorphic type
     [('a, 'b, 'c, 'd, 'e, 'f) format6]. Type [format6] is built in.
     The two simplified types, [format] and [format4] below are
-    included for backward compatibility with earlier releases of Objective
-    Caml.
-    ['a] is the type of the parameters of the format,
-    ['b] is the type of the first argument given to
-         [%a] and [%t] printing functions,
-    ['c] is the type of the argument transmitted to the first argument of
-         "kprintf"-style functions,
-    ['d] is the result type for the "scanf"-style functions,
-    ['e] is the type of the receiver function for the "scanf"-style functions,
-    ['f] is the result type for the "printf"-style function.
- *)
+    included for backward compatibility with earlier releases of
+    OCaml.
+
+    The meaning of format string type parameters is as follows:
+
+    - ['a] is the type of the parameters of the format for formatted output
+      functions ([printf]-style functions);
+      ['a] is the type of the values read by the format for formatted input
+      functions ([scanf]-style functions).
+
+    - ['b] is the type of input source for formatted input functions and the
+      type of output target for formatted output functions.
+      For [printf]-style functions from module [Printf], ['b] is typically
+      [out_channel];
+      for [printf]-style functions from module [Format], ['b] is typically
+      [Format.formatter];
+      for [scanf]-style functions from module [Scanf], ['b] is typically
+      [Scanf.Scanning.in_channel].
+
+      Type argument ['b] is also the type of the first argument given to
+      user's defined printing functions for [%a] and [%t] conversions,
+      and user's defined reading functions for [%r] conversion.
+
+    - ['c] is the type of the result of the [%a] and [%t] printing
+      functions, and also the type of the argument transmitted to the
+      first argument of [kprintf]-style functions or to the
+      [kscanf]-style functions.
+
+    - ['d] is the type of parameters for the [scanf]-style functions.
+
+    - ['e] is the type of the receiver function for the [scanf]-style functions.
+
+    - ['f] is the final result type of a formatted input/output function
+      invocation: for the [printf]-style functions, it is typically [unit];
+      for the [scanf]-style functions, it is typically the result type of the
+      receiver function.
+*)
 type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
 
 type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
@@ -877,14 +955,22 @@
   ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
   ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity"
 (** [format_of_string s] returns a format string read from the string
-    literal [s]. *)
+    literal [s].
+    Note: [format_of_string] can not convert a string argument that is not a
+    literal. If you need this functionality, use the more general
+    {!Scanf.format_from_string} function.
+*)
 
 val ( ^^ ) :
       ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
       ('f, 'b, 'c, 'e, 'g, 'h) format6 ->
       ('a, 'b, 'c, 'd, 'g, 'h) format6
-(** [f1 ^^ f2] catenates formats [f1] and [f2].  The result is a format
-  that accepts arguments from [f1], then arguments from [f2]. *)
+(** [f1 ^^ f2] catenates format strings [f1] and [f2]. The result is a
+  format string that behaves as the concatenation of format strings [f1] and
+  [f2]: in case of formatted output, it accepts arguments from [f1], then
+  arguments from [f2]; in case of formatted input, it returns results from
+  [f1], then results from [f2].
+*)
 
 
 (** {6 Program termination} *)
@@ -893,7 +979,7 @@
 (** Terminate the process, returning the given status code
    to the operating system: usually 0 to indicate no errors,
    and a small positive integer to indicate failure.
-   All open output channels are flushed with flush_all.
+   All open output channels are flushed with [flush_all].
    An implicit [exit 0] is performed each time a program
    terminates normally.  An implicit [exit 2] is performed if the program
    terminates early because of an uncaught exception. *)
@@ -903,13 +989,12 @@
    termination time. The functions registered with [at_exit]
    will be called when the program executes {!Pervasives.exit},
    or terminates, either normally or because of an uncaught exception.
-   The functions are called in ``last in, first out'' order:
+   The functions are called in 'last in, first out' order:
    the function most recently added with [at_exit] is called first. *)
 
 (**/**)
 
-
-(** {6 For system use only, not for the casual user} *)
+(* The following is for system use only. Do not call directly. *)
 
 val valid_float_lexem : string -> string
 
diff -Nru ocaml-3.12.1/stdlib/printexc.ml ocaml-4.01.0/stdlib/printexc.ml
--- ocaml-3.12.1/stdlib/printexc.ml	2010-04-19 12:25:46.000000000 +0000
+++ ocaml-4.01.0/stdlib/printexc.ml	2013-07-11 12:34:31.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: printexc.ml 10272 2010-04-19 12:25:46Z frisch $ *)
-
 open Printf;;
 
 let printers = ref []
@@ -56,9 +54,12 @@
             sprintf locfmt file line char (char+5) "Pattern matching failed"
         | Assert_failure(file, line, char) ->
             sprintf locfmt file line char (char+6) "Assertion failed"
+        | Undefined_recursive_module(file, line, char) ->
+            sprintf locfmt file line char (char+6) "Undefined recursive module"
         | _ ->
             let x = Obj.repr x in
-            let constructor = (Obj.magic(Obj.field (Obj.field x 0) 0) : string) in
+            let constructor =
+              (Obj.magic (Obj.field (Obj.field x 0) 0) : string) in
             constructor ^ (fields x) in
   conv !printers
 
@@ -78,6 +79,11 @@
     eprintf "Uncaught exception: %s\n" (to_string x);
     exit 2
 
+type raw_backtrace
+
+external get_raw_backtrace:
+  unit -> raw_backtrace = "caml_get_exception_raw_backtrace"
+
 type loc_info =
   | Known_location of bool   (* is_raise *)
                     * string (* filename *)
@@ -86,8 +92,13 @@
                     * int    (* end char *)
   | Unknown_location of bool (*is_raise*)
 
-external get_exception_backtrace:
-  unit -> loc_info array option = "caml_get_exception_backtrace"
+(* to avoid warning *)
+let _ = [Known_location (false, "", 0, 0, 0); Unknown_location false]
+
+type backtrace = loc_info array
+
+external convert_raw_backtrace:
+  raw_backtrace -> backtrace option = "caml_convert_raw_backtrace"
 
 let format_loc_info pos li =
   let is_raise =
@@ -108,8 +119,8 @@
       sprintf "%s unknown location"
               info
 
-let print_backtrace outchan =
-  match get_exception_backtrace() with
+let print_exception_backtrace outchan backtrace =
+  match backtrace with
   | None ->
       fprintf outchan
         "(Program not linked with -g, cannot print stack backtrace)\n"
@@ -119,8 +130,15 @@
           fprintf outchan "%s\n" (format_loc_info i a.(i))
       done
 
-let get_backtrace () =
-  match get_exception_backtrace() with
+let print_raw_backtrace outchan raw_backtrace =
+  print_exception_backtrace outchan (convert_raw_backtrace raw_backtrace)
+
+(* confusingly named: prints the global current backtrace *)
+let print_backtrace outchan =
+  print_raw_backtrace outchan (get_raw_backtrace ())
+
+let backtrace_to_string backtrace =
+  match backtrace with
   | None ->
      "(Program not linked with -g, cannot print stack backtrace)\n"
   | Some a ->
@@ -131,8 +149,22 @@
       done;
       Buffer.contents b
 
+let raw_backtrace_to_string raw_backtrace =
+  backtrace_to_string (convert_raw_backtrace raw_backtrace)
+
+(* confusingly named:
+   returns the *string* corresponding to the global current backtrace *)
+let get_backtrace () =
+  (* we could use the caml_get_exception_backtrace primitive here, but
+     we hope to deprecate it so it's better to just compose the
+     raw stuff *)
+  backtrace_to_string (convert_raw_backtrace (get_raw_backtrace ()))
+
 external record_backtrace: bool -> unit = "caml_record_backtrace"
 external backtrace_status: unit -> bool = "caml_backtrace_status"
 
 let register_printer fn =
   printers := fn :: !printers
+
+
+external get_callstack: int -> raw_backtrace = "caml_get_current_callstack"
diff -Nru ocaml-3.12.1/stdlib/printexc.mli ocaml-4.01.0/stdlib/printexc.mli
--- ocaml-3.12.1/stdlib/printexc.mli	2010-05-21 18:30:12.000000000 +0000
+++ ocaml-4.01.0/stdlib/printexc.mli	2013-07-11 12:34:31.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,9 +11,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: printexc.mli 10457 2010-05-21 18:30:12Z doligez $ *)
-
-(** Facilities for printing exceptions. *)
+(** Facilities for printing exceptions and inspecting current call stack. *)
 
 val to_string: exn -> string
 (** [Printexc.to_string e] returns a string representation of
@@ -77,5 +75,40 @@
     in the reverse order of their registrations, until a printer returns
     a [Some s] value (if no such printer exists, the runtime will use a
     generic printer).
+
+    When using this mechanism, one should be aware that an exception backtrace
+    is attached to the thread that saw it raised, rather than to the exception
+    itself. Practically, it means that the code related to [fn] should not use
+    the backtrace if it has itself raised an exception before.
     @since 3.11.2
 *)
+
+(** {6 Raw backtraces} *)
+
+type raw_backtrace
+
+(** The abstract type [backtrace] stores exception backtraces in
+    a low-level format, instead of directly exposing them as string as
+    the [get_backtrace()] function does.
+
+    This allows to pay the performance overhead of representation
+    conversion and formatting only at printing time, which is useful
+    if you want to record more backtrace than you actually print.
+*)
+
+val get_raw_backtrace: unit -> raw_backtrace
+val print_raw_backtrace: out_channel -> raw_backtrace -> unit
+val raw_backtrace_to_string: raw_backtrace -> string
+
+
+(** {6 Current call stack} *)
+
+val get_callstack: int -> raw_backtrace
+
+(** [Printexc.get_callstack n] returns a description of the top of the
+    call stack on the current program point (for the current thread),
+    with at most [n] entries.  (Note: this function is not related to
+    exceptions at all, despite being part of the [Printexc] module.)
+
+    @since 4.01.0
+*)
diff -Nru ocaml-3.12.1/stdlib/printf.ml ocaml-4.01.0/stdlib/printf.ml
--- ocaml-3.12.1/stdlib/printf.ml	2011-03-06 16:11:50.000000000 +0000
+++ ocaml-4.01.0/stdlib/printf.ml	2013-07-19 09:06:44.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*  Xavier Leroy and Pierre Weis, projet Cristal, INRIA Rocquencourt   *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: printf.ml 10969 2011-03-06 16:11:50Z weis $ *)
-
 external format_float: string -> float -> string
   = "caml_format_float"
 external format_int: string -> int -> string
@@ -66,7 +64,7 @@
 let bad_conversion sfmt i c =
   invalid_arg
     ("Printf: bad conversion %" ^ String.make 1 c ^ ", at char number " ^
-     string_of_int i ^ " in format string ``" ^ sfmt ^ "''")
+     string_of_int i ^ " in format string \'" ^ sfmt ^ "\'")
 ;;
 
 let bad_conversion_format fmt i c =
@@ -75,11 +73,12 @@
 
 let incomplete_format fmt =
   invalid_arg
-    ("Printf: premature end of format string ``" ^
-     Sformat.to_string fmt ^ "''")
+    ("Printf: premature end of format string \'" ^
+     Sformat.to_string fmt ^ "\'")
 ;;
 
-(* Parses a string conversion to return the specified length and the padding direction. *)
+(* Parses a string conversion to return the specified length and the
+   padding direction. *)
 let parse_string_conversion sfmt =
   let rec parse neg i =
     if i >= String.length sfmt then (0, neg) else
@@ -150,21 +149,21 @@
 ;;
 
 let extract_format_int conv fmt start stop widths =
-   let sfmt = extract_format fmt start stop widths in
-   match conv with
-   | 'n' | 'N' ->
-     sfmt.[String.length sfmt - 1] <- 'u';
-     sfmt
-   | _ -> sfmt
+  let sfmt = extract_format fmt start stop widths in
+  match conv with
+  | 'n' | 'N' ->
+    sfmt.[String.length sfmt - 1] <- 'u';
+    sfmt
+  | _ -> sfmt
 ;;
 
 let extract_format_float conv fmt start stop widths =
-   let sfmt = extract_format fmt start stop widths in
-   match conv with
-   | 'F' ->
-     sfmt.[String.length sfmt - 1] <- 'g';
-     sfmt
-   | _ -> sfmt
+  let sfmt = extract_format fmt start stop widths in
+  match conv with
+  | 'F' ->
+    sfmt.[String.length sfmt - 1] <- 'g';
+    sfmt
+  | _ -> sfmt
 ;;
 
 (* Returns the position of the next character following the meta format
@@ -217,7 +216,7 @@
   and scan_conv skip i =
     if i > lim then incomplete_format fmt else
     match Sformat.unsafe_get fmt i with
-    | '%' | '!' | ',' -> succ i
+    | '%' | '@' | '!' | ',' -> succ i
     | 's' | 'S' | '[' -> add_conv skip i 's'
     | 'c' | 'C' -> add_conv skip i 'c'
     | 'd' | 'i' |'o' | 'u' | 'x' | 'X' | 'N' -> add_conv skip i 'i'
@@ -230,7 +229,7 @@
         match Sformat.get fmt j with
         | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' ->
           add_char (add_conv skip i conv) 'i'
-        | c -> add_conv skip i 'i' end
+        | _ -> add_conv skip i 'i' end
     | '{' as conv ->
       (* Just get a regular argument, skipping the specification. *)
       let i = add_conv skip i conv in
@@ -301,13 +300,13 @@
     (* Just finishing a meta format: no additional argument to record. *)
     if c <> ')' && c <> '}' then incr_ac skip c;
     succ i
-  and add_char i c = succ i in
+  and add_char i _ = succ i in
 
   iter_on_format_args fmt add_conv add_char;
   ac
 ;;
 
-let count_arguments_of_format fmt =
+let count_printing_arguments_of_format fmt =
   let ac = ac_of_format fmt in
   (* For printing, only the regular arguments have to be counted. *)
   ac.ac_rglr
@@ -321,12 +320,12 @@
   loop 0 l
 ;;
 
-(* ``Abstracting'' version of kprintf: returns a (curried) function that
+(* 'Abstracting' version of kprintf: returns a (curried) function that
    will print when totally applied.
    Note: in the following, we are careful not to be badly caught
    by the compiler optimizations for the representation of arrays. *)
 let kapr kpr fmt =
-  match count_arguments_of_format fmt with
+  match count_printing_arguments_of_format fmt with
   | 0 -> kpr fmt [||]
   | 1 -> Obj.magic (fun x ->
       let a = Array.make 1 (Obj.repr 0) in
@@ -372,17 +371,17 @@
 (* To scan an optional positional parameter specification,
    i.e. an integer followed by a [$].
 
-   Calling [got_spec] with appropriate arguments, we ``return'' a positional
+   Calling [got_spec] with appropriate arguments, we 'return' a positional
    specification and an index to go on scanning the [fmt] format at hand.
 
    Note that this is optimized for the regular case, i.e. no positional
-   parameter, since in this case we juste ``return'' the constant
-   [Spec_none]; in case we have a positional parameter, we ``return'' a
+   parameter, since in this case we juste 'return' the constant
+   [Spec_none]; in case we have a positional parameter, we 'return' a
    [Spec_index] [positional_specification] which is a bit more costly.
 
    Note also that we do not support [*$] specifications, since this would
    lead to type checking problems: a [*$] positional specification means
-   ``take the next argument to [printf] (which must be an integer value)'',
+   'take the next argument to [printf] (which must be an integer value)',
    name this integer value $n$; [*$] now designates parameter $n$.
 
    Unfortunately, the type of a parameter specified via a [*$] positional
@@ -391,9 +390,9 @@
    with $n$ being the {\em value} of the integer argument defining [*]; we
    clearly cannot statically guess the value of this parameter in the general
    case. Put it another way: this means type dependency, which is completely
-   out of scope of the Caml type algebra. *)
+   out of scope of the OCaml type algebra. *)
 
-let scan_positional_spec fmt got_spec n i =
+let scan_positional_spec fmt got_spec i =
   match Sformat.unsafe_get fmt i with
   | '0'..'9' as d ->
     let rec get_int_literal accu j =
@@ -430,7 +429,7 @@
   | Spec_index p -> p
 ;;
 
-(* Format a float argument as a valid Caml lexeme. *)
+(* Format a float argument as a valid OCaml lexeme. *)
 let format_float_lexeme =
 
   (* To be revised: this procedure should be a unique loop that performs the
@@ -443,7 +442,7 @@
   let make_valid_float_lexeme s =
     (* Check if s is already a valid lexeme:
        in this case do nothing,
-       otherwise turn s into a valid Caml lexeme. *)
+       otherwise turn s into a valid OCaml lexeme. *)
     let l = String.length s in
     let rec valid_float_loop i =
       if i >= l then s ^ "." else
@@ -455,10 +454,13 @@
     valid_float_loop 0 in
 
   (fun sfmt x ->
-   let s = format_float sfmt x in
    match classify_float x with
-   | FP_normal | FP_subnormal | FP_zero -> make_valid_float_lexeme s
-   | FP_nan | FP_infinite -> s)
+   | FP_normal | FP_subnormal | FP_zero ->
+       make_valid_float_lexeme (format_float sfmt x)
+   | FP_infinite ->
+       if x < 0.0 then "neg_infinity" else "infinity"
+   | FP_nan ->
+       "nan")
 ;;
 
 (* Decode a format string and act on it.
@@ -467,11 +469,16 @@
    After consuming the appropriate number of arguments and formatting
    them, one of the following five continuations described below is called:
 
-   - [cont_s] for outputting a string (arguments: arg num, string, next pos)
-   - [cont_a] for performing a %a action (arguments: arg num, fn, arg, next pos)
-   - [cont_t] for performing a %t action (arguments: arg num, fn, next pos)
-   - [cont_f] for performing a flush action (arguments: arg num, next pos)
-   - [cont_m] for performing a %( action (arguments: arg num, sfmt, next pos)
+   - [cont_s] for outputting a string
+     (arguments: arg num, string, next pos)
+   - [cont_a] for performing a %a action
+     (arguments: arg num, fn, arg, next pos)
+   - [cont_t] for performing a %t action
+     (arguments: arg num, fn, next pos)
+   - [cont_f] for performing a flush action
+     (arguments: arg num, next pos)
+   - [cont_m] for performing a %( action
+     (arguments: arg num, sfmt, next pos)
 
    "arg num" is the index in array [args] of the next argument to [printf].
    "next pos" is the position in [fmt] of the first character following
@@ -490,7 +497,7 @@
 
   let rec scan_positional n widths i =
     let got_spec spec i = scan_flags spec n widths i in
-    scan_positional_spec fmt got_spec n i
+    scan_positional_spec fmt got_spec i
 
   and scan_flags spec n widths i =
     match Sformat.unsafe_get fmt i with
@@ -498,15 +505,17 @@
       let got_spec wspec i =
         let (width : int) = get_arg wspec n in
         scan_flags spec (next_index wspec n) (width :: widths) i in
-      scan_positional_spec fmt got_spec n (succ i)
+      scan_positional_spec fmt got_spec (succ i)
     | '0'..'9'
     | '.' | '#' | '-' | ' ' | '+' -> scan_flags spec n widths (succ i)
     | _ -> scan_conv spec n widths i
 
   and scan_conv spec n widths i =
     match Sformat.unsafe_get fmt i with
-    | '%' ->
-      cont_s n "%" (succ i)
+    | '%' | '@' as c ->
+      cont_s n (String.make 1 c) (succ i)
+    | '!' -> cont_f n (succ i)
+    | ',' -> cont_s n "" (succ i)
     | 's' | 'S' as conv ->
       let (x : string) = get_arg spec n in
       let x = if conv = 's' then x else "\"" ^ String.escaped x ^ "\"" in
@@ -515,6 +524,8 @@
         if i = succ pos then x else
         format_string (extract_format fmt pos i widths) x in
       cont_s (next_index spec n) s (succ i)
+    | '[' as conv ->
+      bad_conversion_format fmt i conv
     | 'c' | 'C' as conv ->
       let (x : char) = get_arg spec n in
       let s =
@@ -532,8 +543,11 @@
     | 'F' as conv ->
       let (x : float) = get_arg spec n in
       let s =
-        if widths = [] then Pervasives.string_of_float x else
-        format_float_lexeme (extract_format_float conv fmt pos i widths) x in
+        format_float_lexeme
+          (if widths = []
+           then "%.12g"
+           else extract_format_float conv fmt pos i widths)
+          x in
       cont_s (next_index spec n) s (succ i)
     | 'B' | 'b' ->
       let (x : bool) = get_arg spec n in
@@ -546,6 +560,8 @@
       let n = Sformat.succ_index (get_index spec n) in
       let arg = get_arg Spec_none n in
       cont_a (next_index spec n) printer arg (succ i)
+    | 'r' as conv ->
+      bad_conversion_format fmt i conv
     | 't' ->
       let printer = get_arg spec n in
       cont_t (next_index spec n) printer (succ i)
@@ -570,20 +586,18 @@
         let s = format_int (extract_format_int 'n' fmt pos i widths) x in
         cont_s (next_index spec n) s (succ i)
       end
-    | ',' -> cont_s n "" (succ i)
-    | '!' -> cont_f n (succ i)
     | '{' | '(' as conv (* ')' '}' *) ->
       let (xf : ('a, 'b, 'c, 'd, 'e, 'f) format6) = get_arg spec n in
       let i = succ i in
-      let j = sub_format_for_printf conv fmt i in
+      let i = sub_format_for_printf conv fmt i in
       if conv = '{' (* '}' *) then
         (* Just print the format argument as a specification. *)
         cont_s
           (next_index spec n)
           (summarize_format_type xf)
-          j else
+          i else
         (* Use the format argument instead of the format specification. *)
-        cont_m (next_index spec n) xf j
+        cont_m (next_index spec n) xf i
     | (* '(' *) ')' ->
       cont_s n "" (succ i)
     | conv ->
@@ -597,6 +611,8 @@
   (* [out] is global to this definition of [pr], and must be shared by all its
      recursive calls (if any). *)
   let out = get_out fmt in
+  let outc c = outc out c in
+  let outs s = outs out s in
 
   let rec pr k n fmt v =
 
@@ -606,25 +622,28 @@
        if i >= len then Obj.magic (k out) else
        match Sformat.unsafe_get fmt i with
        | '%' -> scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
-       |  c  -> outc out c; doprn n (succ i)
+       |  c  -> outc c; doprn n (succ i)
+
     and cont_s n s i =
-      outs out s; doprn n i
+      outs s; doprn n i
     and cont_a n printer arg i =
       if to_s then
-        outs out ((Obj.magic printer : unit -> _ -> string) () arg)
+        outs ((Obj.magic printer : unit -> _ -> string) () arg)
       else
         printer out arg;
       doprn n i
     and cont_t n printer i =
       if to_s then
-        outs out ((Obj.magic printer : unit -> string) ())
+        outs ((Obj.magic printer : unit -> string) ())
       else
         printer out;
       doprn n i
     and cont_f n i =
       flush out; doprn n i
     and cont_m n xf i =
-      let m = Sformat.add_int_index (count_arguments_of_format xf) n in
+      let m =
+        Sformat.add_int_index
+          (count_printing_arguments_of_format xf) n in
       pr (Obj.magic (fun _ -> doprn m i)) n xf v in
 
     doprn n 0 in
@@ -634,12 +653,19 @@
   kapr kpr fmt
 ;;
 
+(**************************************************************
+
+  Defining [fprintf] and various flavors of [fprintf].
+
+ **************************************************************)
+
 let kfprintf k oc =
   mkprintf false (fun _ -> oc) output_char output_string flush k
 ;;
-let ifprintf oc = kapr (fun _ -> Obj.magic ignore);;
+let ikfprintf k oc = kapr (fun _ _ -> Obj.magic (k oc));;
 
 let fprintf oc = kfprintf ignore oc;;
+let ifprintf oc = ikfprintf ignore oc;;
 let printf fmt = fprintf stdout fmt;;
 let eprintf fmt = fprintf stderr fmt;;
 
@@ -667,10 +693,15 @@
 
 let sprintf fmt = ksprintf (fun s -> s) fmt;;
 
-(* Obsolete and deprecated. *)
+(**************************************************************
+
+  Deprecated stuff.
+
+ **************************************************************)
+
 let kprintf = ksprintf;;
 
-(* For Caml system internal use only: needed to implement modules [Format]
+(* For OCaml system internal use only: needed to implement modules [Format]
   and [Scanf]. *)
 
 module CamlinternalPr = struct
@@ -689,6 +720,9 @@
 
     let ac_of_format = ac_of_format;;
 
+    let count_printing_arguments_of_format =
+      count_printing_arguments_of_format;;
+
     let sub_format = sub_format;;
 
     let summarize_format_type = summarize_format_type;;
diff -Nru ocaml-3.12.1/stdlib/printf.mli ocaml-4.01.0/stdlib/printf.mli
--- ocaml-3.12.1/stdlib/printf.mli	2011-03-06 16:10:59.000000000 +0000
+++ ocaml-4.01.0/stdlib/printf.mli	2013-05-29 16:44:12.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*  Xavier Leroy and Pierre Weis, projet Cristal, INRIA Rocquencourt   *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: printf.mli 10968 2011-03-06 16:10:59Z weis $ *)
-
 (** Formatted output functions. *)
 
 val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a
@@ -20,71 +18,80 @@
    [arg1] to [argN] according to the format string [format], and
    outputs the resulting string on the channel [outchan].
 
-   The format is a character string which contains two types of
+   The format string is a character string which contains two types of
    objects: plain characters, which are simply copied to the output
    channel, and conversion specifications, each of which causes
    conversion and printing of arguments.
 
    Conversion specifications have the following form:
 
-   [% \[flags\] \[width\] \[.precision\] type]
+   [% [flags] [width] [.precision] type]
 
    In short, a conversion specification consists in the [%] character,
    followed by optional modifiers and a type which is made of one or
-   two characters. The types and their meanings are:
+   two characters.
+
+   The types and their meanings are:
 
-   - [d], [i], [n], [l], [L], or [N]: convert an integer argument to
-     signed decimal.
-   - [u]: convert an integer argument to unsigned decimal.
+   - [d], [i]: convert an integer argument to signed decimal.
+   - [u], [n], [l], [L], or [N]: convert an integer argument to
+     unsigned decimal.  Warning: [n], [l], [L], and [N] are
+     used for [scanf], and should not be used for [printf].
    - [x]: convert an integer argument to unsigned hexadecimal,
      using lowercase letters.
    - [X]: convert an integer argument to unsigned hexadecimal,
      using uppercase letters.
    - [o]: convert an integer argument to unsigned octal.
    - [s]: insert a string argument.
-   - [S]: insert a string argument in Caml syntax (double quotes, escapes).
+   - [S]: convert a string argument to OCaml syntax (double quotes, escapes).
    - [c]: insert a character argument.
-   - [C]: insert a character argument in Caml syntax (single quotes, escapes).
+   - [C]: convert a character argument to OCaml syntax
+     (single quotes, escapes).
    - [f]: convert a floating-point argument to decimal notation,
      in the style [dddd.ddd].
-   - [F]: convert a floating-point argument to Caml syntax ([dddd.]
+   - [F]: convert a floating-point argument to OCaml syntax ([dddd.]
      or [dddd.ddd] or [d.ddd e+-dd]).
    - [e] or [E]: convert a floating-point argument to decimal notation,
      in the style [d.ddd e+-dd] (mantissa and exponent).
    - [g] or [G]: convert a floating-point argument to decimal notation,
      in style [f] or [e], [E] (whichever is more compact).
    - [B]: convert a boolean argument to the string [true] or [false]
-   - [b]: convert a boolean argument (for backward compatibility; do not
-     use in new programs).
+   - [b]: convert a boolean argument (deprecated; do not use in new
+     programs).
    - [ld], [li], [lu], [lx], [lX], [lo]: convert an [int32] argument to
      the format specified by the second letter (decimal, hexadecimal, etc).
    - [nd], [ni], [nu], [nx], [nX], [no]: convert a [nativeint] argument to
      the format specified by the second letter.
    - [Ld], [Li], [Lu], [Lx], [LX], [Lo]: convert an [int64] argument to
      the format specified by the second letter.
-   - [a]: user-defined printer. Takes two arguments and applies the
+   - [a]: user-defined printer. Take two arguments and apply the
      first one to [outchan] (the current output channel) and to the
      second argument. The first argument must therefore have type
      [out_channel -> 'b -> unit] and the second ['b].
      The output produced by the function is inserted in the output of
      [fprintf] at the current point.
-   - [t]: same as [%a], but takes only one argument (with type
+   - [t]: same as [%a], but take only one argument (with type
      [out_channel -> unit]) and apply it to [outchan].
-   - [\{ fmt %\}]: convert a format string argument. The argument must
-     have the same type as the internal format string [fmt].
-   - [( fmt %)]: format string substitution. Takes a format string
-     argument and substitutes it to the internal format string [fmt]
+   - [\{ fmt %\}]: convert a format string argument to its type digest.
+     The argument must have the same type as the internal format string
+     [fmt].
+   - [( fmt %)]: format string substitution. Take a format string
+     argument and substitute it to the internal format string [fmt]
      to print following arguments. The argument must have the same
      type as the internal format string [fmt].
    - [!]: take no argument and flush the output.
    - [%]: take no argument and output one [%] character.
-   - [,]: the no-op delimiter for conversion specifications.
+   - [\@]: take no argument and output one [\@] character.
+   - [,]: take no argument and output nothing: a no-op delimiter for
+     conversion specifications.
 
    The optional [flags] are:
    - [-]: left-justify the output (default is right justification).
    - [0]: for numerical conversions, pad with zeroes instead of spaces.
-   - [+]: for numerical conversions, prefix number with a [+] sign if positive.
-   - space: for numerical conversions, prefix number with a space if positive.
+   - [+]: for signed numerical conversions, prefix number with a [+]
+     sign if positive.
+   - space: for signed numerical conversions, prefix number with a
+     space if positive.
    - [#]: request an alternate formatting style for numbers.
 
    The optional [width] is an integer indicating the minimal
@@ -109,12 +116,6 @@
 val eprintf : ('a, out_channel, unit) format -> 'a
 (** Same as {!Printf.fprintf}, but output on [stderr]. *)
 
-val ifprintf : 'a -> ('b, 'a, unit) format -> 'b
-(** Same as {!Printf.fprintf}, but does not print anything.
-    Useful to ignore some material when conditionally printing.
-    @since 3.10.0
-*)
-
 val sprintf : ('a, unit, string) format -> 'a
 (** Same as {!Printf.fprintf}, but instead of printing on an output channel,
    return a string containing the result of formatting the arguments. *)
@@ -124,6 +125,12 @@
    append the formatted arguments to the given extensible buffer
    (see module {!Buffer}). *)
 
+val ifprintf : 'a -> ('b, 'a, unit) format -> 'b
+(** Same as {!Printf.fprintf}, but does not print anything.
+    Useful to ignore some material when conditionally printing.
+    @since 3.10.0
+*)
+
 (** Formatted output functions with continuations. *)
 
 val kfprintf : (out_channel -> 'a) -> out_channel ->
@@ -133,6 +140,14 @@
    @since 3.09.0
 *)
 
+val ikfprintf : (out_channel -> 'a) -> out_channel ->
+              ('b, out_channel, unit, 'a) format4 -> 'b
+;;
+(** Same as [kfprintf] above, but does not print anything.
+   Useful to ignore some material when conditionally printing.
+   @since 4.0
+*)
+
 val ksprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b;;
 (** Same as [sprintf] above, but instead of returning the string,
    passes it to the first argument.
@@ -153,7 +168,7 @@
 
 (**/**)
 
-(* For Caml system internal use only. Don't call directly. *)
+(* The following is for system use only. Do not call directly. *)
 
 module CamlinternalPr : sig
 
@@ -165,6 +180,7 @@
     external unsafe_index_of_int : int -> index = "%identity";;
 
     val succ_index : index -> index;;
+    val add_int_index : int -> index -> index;;
 
     val sub : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> index -> int -> string;;
     val to_string : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string;;
@@ -188,6 +204,8 @@
     };;
 
     val ac_of_format : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> ac;;
+    val count_printing_arguments_of_format :
+      ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int;;
 
     val sub_format :
         (('a, 'b, 'c, 'd, 'e, 'f) format6 -> int) ->
diff -Nru ocaml-3.12.1/stdlib/queue.ml ocaml-4.01.0/stdlib/queue.ml
--- ocaml-3.12.1/stdlib/queue.ml	2005-08-26 12:10:47.000000000 +0000
+++ ocaml-4.01.0/stdlib/queue.ml	2013-06-16 16:18:42.000000000 +0000
@@ -1,8 +1,8 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
-(*        François Pottier, projet Cristal, INRIA Rocquencourt         *)
+(*        Francois Pottier, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
 (*  Copyright 2002 Institut National de Recherche en Informatique et   *)
 (*  en Automatique.  All rights reserved.  This file is distributed    *)
@@ -11,11 +11,9 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: queue.ml 7032 2005-08-26 12:10:47Z doligez $ *)
-
 exception Empty
 
-(* O'Caml currently does not allow the components of a sum type to be
+(* OCaml currently does not allow the components of a sum type to be
    mutable. Yet, for optimal space efficiency, we must have cons cells
    whose [next] field is mutable. This leads us to define a type of
    cyclic lists, so as to eliminate the [Nil] case and the sum
@@ -54,12 +52,12 @@
   q.tail <- Obj.magic None
 
 let add x q =
-  q.length <- q.length + 1;
-  if q.length = 1 then
+  if q.length = 0 then
     let rec cell = {
       content = x;
       next = cell
     } in
+    q.length <- 1;
     q.tail <- cell
   else
     let tail = q.tail in
@@ -68,6 +66,7 @@
       content = x;
       next = head
     } in
+    q.length <- q.length + 1;
     tail.next <- cell;
     q.tail <- cell
 
@@ -108,14 +107,15 @@
       next = tail'
     } in
 
-    let rec copy cell =
-      if cell == tail then tail'
-      else {
+    let rec copy prev cell =
+      if cell != tail
+      then let res = {
         content = cell.content;
-        next = copy cell.next
-      } in
+        next = tail'
+      } in prev.next <- res;
+      copy res cell.next in
 
-    tail'.next <- copy tail.next;
+    copy tail' tail.next;
     {
       length = q.length;
       tail = tail'
diff -Nru ocaml-3.12.1/stdlib/queue.mli ocaml-4.01.0/stdlib/queue.mli
--- ocaml-3.12.1/stdlib/queue.mli	2002-06-27 08:48:26.000000000 +0000
+++ ocaml-4.01.0/stdlib/queue.mli	2013-07-24 08:52:55.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,11 +11,13 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: queue.mli 4956 2002-06-27 08:48:26Z xleroy $ *)
-
 (** First-in first-out queues.
 
    This module implements queues (FIFOs), with in-place modification.
+
+   {b Warning} This module is not thread-safe: each {!Queue.t} value
+   must be protected from concurrent access (e.g. with a {!Mutex.t}).
+   Failure to do so can lead to a crash.
 *)
 
 type 'a t
diff -Nru ocaml-3.12.1/stdlib/random.ml ocaml-4.01.0/stdlib/random.ml
--- ocaml-3.12.1/stdlib/random.ml	2010-02-05 17:34:14.000000000 +0000
+++ ocaml-4.01.0/stdlib/random.ml	2013-04-09 12:17:05.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*              Damien Doligez, projet Para, INRIA Rocquencourt        *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: random.ml 9621 2010-02-05 17:34:14Z doligez $ *)
-
 (* Pseudo-random number generator
    This is a lagged-Fibonacci F(55, 24, +) with a modified addition
    function to enhance the mixing of bits.
@@ -25,7 +23,7 @@
    passes all the Diehard tests.
 *)
 
-external random_seed: unit -> int = "caml_sys_random_seed";;
+external random_seed: unit -> int array = "caml_sys_random_seed";;
 
 module State = struct
 
@@ -43,7 +41,7 @@
       Char.code d.[0] + (Char.code d.[1] lsl 8) + (Char.code d.[2] lsl 16)
       + (Char.code d.[3] lsl 24)
     in
-    let seed = if seed = [| |] then [| 0 |] else seed in
+    let seed = if Array.length seed = 0 then [| 0 |] else seed in
     let l = Array.length seed in
     for i = 0 to 54 do
       s.st.(i) <- i;
@@ -53,7 +51,7 @@
       let j = i mod 55 in
       let k = i mod l in
       accu := combine !accu seed.(k);
-      s.st.(j) <- s.st.(j) lxor extract !accu;
+      s.st.(j) <- (s.st.(j) lxor extract !accu) land 0x3FFFFFFF;  (* PR#5575 *)
     done;
     s.idx <- 0;
   ;;
@@ -64,7 +62,7 @@
     result
   ;;
 
-  let make_self_init () = make [| random_seed () |];;
+  let make_self_init () = make (random_seed ());;
 
   let copy s =
     let result = new_state () in
@@ -75,10 +73,12 @@
   (* Returns 30 random bits as an integer 0 <= x < 1073741824 *)
   let bits s =
     s.idx <- (s.idx + 1) mod 55;
+    let curval = s.st.(s.idx) in
     let newval = s.st.((s.idx + 24) mod 55)
-                 + (s.st.(s.idx) lxor ((s.st.(s.idx) lsr 25) land 31)) in
-    s.st.(s.idx) <- newval;
-    newval land 0x3FFFFFFF   (* land is needed for 64-bit arch *)
+                 + (curval lxor ((curval lsr 25) land 0x1F)) in
+    let newval30 = newval land 0x3FFFFFFF in  (* PR#5575 *)
+    s.st.(s.idx) <- newval30;
+    newval30
   ;;
 
   let rec intaux s n =
@@ -129,13 +129,12 @@
     else fun s bound -> Int64.to_nativeint (int64 s (Int64.of_nativeint bound))
   ;;
 
-  (* Returns a float 0 <= x < 1 with at most 90 bits of precision. *)
+  (* Returns a float 0 <= x <= 1 with at most 60 bits of precision. *)
   let rawfloat s =
-    let scale = 1073741824.0
-    and r0 = Pervasives.float (bits s)
+    let scale = 1073741824.0  (* 2^30 *)
     and r1 = Pervasives.float (bits s)
     and r2 = Pervasives.float (bits s)
-    in ((r0 /. scale +. r1) /. scale +. r2) /. scale
+    in (r1 /. scale +. r2) /. scale
   ;;
 
   let float s bound = rawfloat s *. bound;;
@@ -144,18 +143,19 @@
 
 end;;
 
-(* This is the state you get with [init 27182818]. *)
+(* This is the state you get with [init 27182818] and then applying
+   the "land 0x3FFFFFFF" filter to them.  See #5575, #5793, #5977. *)
 let default = {
   State.st = [|
-      0x7ae2522b; 0x5d8d4634; 0x15b4fad0; 0x18b14ace; 0x12f8a3c4; 0x7b086c47;
-      0x16d467d6; 0x501d91c7; 0x321df177; 0x4176c193; 0x1ff72bf1; 0x5e889109;
-      0x0b464b18; 0x6b86b97c; 0x4891da48; 0x03137463; 0x485ac5a1; 0x15d61f2f;
-      0x7bced359; 0x69c1c132; 0x7a86766e; 0x366d8c86; 0x1f5b6222; 0x7ce1b59f;
-      0x2ebf78e1; 0x67cd1b86; 0x658f3dc3; 0x789a8194; 0x42e4c44c; 0x58c43f7d;
-      0x0f6e534f; 0x1e7df359; 0x455d0b7e; 0x10e84e7e; 0x126198e4; 0x4e7722cb;
-      0x5cbede28; 0x7391b964; 0x7d40e92a; 0x4c59933d; 0x0b8cd0b7; 0x64efff1c;
-      0x2803fdaa; 0x08ebc72e; 0x4f522e32; 0x45398edc; 0x2144a04c; 0x4aef3cbd;
-      0x41ad4719; 0x75b93cd6; 0x2a559d4f; 0x5e6fd768; 0x66e27f36; 0x186f18c3;
+      0x3ae2522b; 0x1d8d4634; 0x15b4fad0; 0x18b14ace; 0x12f8a3c4; 0x3b086c47;
+      0x16d467d6; 0x101d91c7; 0x321df177; 0x0176c193; 0x1ff72bf1; 0x1e889109;
+      0x0b464b18; 0x2b86b97c; 0x0891da48; 0x03137463; 0x085ac5a1; 0x15d61f2f;
+      0x3bced359; 0x29c1c132; 0x3a86766e; 0x366d8c86; 0x1f5b6222; 0x3ce1b59f;
+      0x2ebf78e1; 0x27cd1b86; 0x258f3dc3; 0x389a8194; 0x02e4c44c; 0x18c43f7d;
+      0x0f6e534f; 0x1e7df359; 0x055d0b7e; 0x10e84e7e; 0x126198e4; 0x0e7722cb;
+      0x1cbede28; 0x3391b964; 0x3d40e92a; 0x0c59933d; 0x0b8cd0b7; 0x24efff1c;
+      0x2803fdaa; 0x08ebc72e; 0x0f522e32; 0x05398edc; 0x2144a04c; 0x0aef3cbd;
+      0x01ad4719; 0x35b93cd6; 0x2a559d4f; 0x1e6fd768; 0x26e27f36; 0x186f18c3;
       0x2fbf967a;
     |];
   State.idx = 0;
@@ -171,7 +171,7 @@
 
 let full_init seed = State.full_init default seed;;
 let init seed = State.full_init default [| seed |];;
-let self_init () = init (random_seed());;
+let self_init () = full_init (random_seed());;
 
 (* Manipulating the current state. *)
 
diff -Nru ocaml-3.12.1/stdlib/random.mli ocaml-4.01.0/stdlib/random.mli
--- ocaml-3.12.1/stdlib/random.mli	2010-05-21 18:30:12.000000000 +0000
+++ ocaml-4.01.0/stdlib/random.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*              Damien Doligez, projet Para, INRIA Rocquencourt        *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: random.mli 10457 2010-05-21 18:30:12Z doligez $ *)
-
 (** Pseudo-random number generators (PRNG). *)
 
 (** {6 Basic functions} *)
@@ -25,8 +23,11 @@
 (** Same as {!Random.init} but takes more data as seed. *)
 
 val self_init : unit -> unit
-(** Initialize the generator with a more-or-less random seed chosen
-   in a system-dependent way. *)
+(** Initialize the generator with a random seed chosen
+   in a system-dependent way.  If [/dev/urandom] is available on
+   the host machine, it is used to provide a highly random initial
+   seed.  Otherwise, a less random seed is computed from system
+   parameters (current time, process IDs). *)
 
 val bits : unit -> int
 (** Return 30 random bits in a nonnegative integer.
@@ -53,7 +54,7 @@
 
 val float : float -> float
 (** [Random.float bound] returns a random floating-point number
-   between 0 (inclusive) and [bound] (exclusive).  If [bound] is
+   between 0 and [bound] (inclusive).  If [bound] is
    negative, the result is negative or zero.  If [bound] is 0,
    the result is 0. *)
 
@@ -64,7 +65,7 @@
 (** {6 Advanced functions} *)
 
 (** The functions from module [State] manipulate the current state
-    of the random generator explicitely.
+    of the random generator explicitly.
     This allows using one or several deterministic PRNGs,
     even in a multi-threaded program, without interference from
     other parts of the program.
diff -Nru ocaml-3.12.1/stdlib/scanf.ml ocaml-4.01.0/stdlib/scanf.ml
--- ocaml-3.12.1/stdlib/scanf.ml	2010-05-05 17:49:19.000000000 +0000
+++ ocaml-4.01.0/stdlib/scanf.ml	2013-06-02 14:42:33.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Pierre Weis, projet Cristal, INRIA Rocquencourt          *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: scanf.ml 10377 2010-05-05 17:49:19Z weis $ *)
-
 (* The run-time library for scanners. *)
 
 (* Scanning buffers. *)
@@ -22,6 +20,8 @@
 
   type scanbuf = in_channel;;
 
+  type file_name = string;;
+
   val stdin : in_channel;;
   (* The scanning buffer reading from [Pervasives.stdin].
       [stdib] is equivalent to [Scanning.from_channel Pervasives.stdin]. *)
@@ -104,15 +104,15 @@
   (* [Scanning.name_of_input ib] returns the name of the character
       source for input buffer [ib]. *)
 
-  val open_in : string -> scanbuf;;
-  val open_in_bin : string -> scanbuf;;
-  val from_file : string -> scanbuf;;
-  val from_file_bin : string -> scanbuf;;
-  val from_string : string -> scanbuf;;
-  val from_function : (unit -> char) -> scanbuf;;
-  val from_channel : Pervasives.in_channel -> scanbuf;;
+  val open_in : file_name -> in_channel;;
+  val open_in_bin : file_name -> in_channel;;
+  val from_file : file_name -> in_channel;;
+  val from_file_bin : file_name -> in_channel;;
+  val from_string : string -> in_channel;;
+  val from_function : (unit -> char) -> in_channel;;
+  val from_channel : Pervasives.in_channel -> in_channel;;
 
-  val close_in : scanbuf -> unit;;
+  val close_in : in_channel -> unit;;
 
 end
 ;;
@@ -142,6 +142,8 @@
 
   type scanbuf = in_channel;;
 
+  type file_name = string;;
+
   let null_char = '\000';;
 
   (* Reads a new character from input buffer.  Next_char never fails,
@@ -210,16 +212,16 @@
 
   let token_count ib = ib.token_count;;
 
-  let skip_char max ib =
+  let skip_char width ib =
     invalidate_current_char ib;
-    max
+    width
   ;;
 
-  let ignore_char max ib = skip_char (max - 1) ib;;
+  let ignore_char width ib = skip_char (width - 1) ib;;
 
-  let store_char max ib c =
+  let store_char width ib c =
     Buffer.add_char ib.tokbuf c;
-    ignore_char max ib
+    ignore_char width ib
   ;;
 
   let default_token_buffer_size = 1024;;
@@ -256,7 +258,7 @@
 
      We cannot prevent the scanning mechanism to use one lookahead character,
      if needed by the semantics of the format string specifications (e.g. a
-     trailing ``skip space'' specification in the format string); in this case,
+     trailing 'skip space' specification in the format string); in this case,
      the mandatory lookahead character is indeed read from the input and not
      used to return the token read. It is thus mandatory to be able to store
      an unused lookahead character somewhere to get it as the first character
@@ -290,8 +292,8 @@
      This phenomenon of reading mess is even worse when one defines more than
      one scanning buffer reading from the same input channel
      [ic]. Unfortunately, we have no simple way to get rid of this problem
-     (unless the basic input channel API is modified to offer a ``consider this
-     char as unread'' procedure to keep back the unused lookahead character as
+     (unless the basic input channel API is modified to offer a 'consider this
+     char as unread' procedure to keep back the unused lookahead character as
      available in the input channel for further reading).
 
      To prevent some of the confusion the scanning buffer allocation function
@@ -335,16 +337,17 @@
   let from_ic_close_at_end = from_ic scan_close_at_end;;
 
   (* The scanning buffer reading from [Pervasives.stdin].
-     One could try to define [stdib] as a scanning buffer reading a character at a
-     time (no bufferization at all), but unfortunately the top-level
-     interaction would be wrong.
-     This is due to some kind of ``race condition'' when reading from [Pervasives.stdin],
+     One could try to define [stdib] as a scanning buffer reading a character
+     at a time (no bufferization at all), but unfortunately the top-level
+     interaction would be wrong. This is due to some kind of
+     'race condition' when reading from [Pervasives.stdin],
      since the interactive compiler and [scanf] will simultaneously read the
-     material they need from [Pervasives.stdin]; then, confusion will result from what should
-     be read by the top-level and what should be read by [scanf].
+     material they need from [Pervasives.stdin]; then, confusion will result
+     from what should be read by the top-level and what should be read
+     by [scanf].
      This is even more complicated by the one character lookahead that [scanf]
-     is sometimes obliged to maintain: the lookahead character will be available
-     for the next ([scanf]) entry, seemingly coming from nowhere.
+     is sometimes obliged to maintain: the lookahead character will be
+     available for the next ([scanf]) entry, seemingly coming from nowhere.
      Also no [End_of_file] is raised when reading from stdin: if not enough
      characters have been read, we simply ask to read more. *)
   let stdin =
@@ -428,19 +431,14 @@
         premature end of file occurred before end of token" message)
 ;;
 
-let int_max = function
+let int_of_width_opt = function
   | None -> max_int
-  | Some max -> max
+  | Some width -> width
 ;;
 
-let int_min = function
-  | None -> 0
-  | Some max -> max
-;;
-
-let float_min = function
+let int_of_prec_opt = function
   | None -> max_int
-  | Some min -> min
+  | Some prec -> prec
 ;;
 
 module Sformat = Printf.CamlinternalPr.Sformat;;
@@ -450,12 +448,12 @@
   invalid_arg
     (Printf.sprintf
        "scanf: bad conversion %%%C, at char number %i \
-        in format string ``%s''" c i (Sformat.to_string fmt))
+        in format string \'%s\'" c i (Sformat.to_string fmt))
 ;;
 
 let incomplete_format fmt =
   invalid_arg
-    (Printf.sprintf "scanf: premature end of format string ``%s''"
+    (Printf.sprintf "scanf: premature end of format string \'%s\'"
        (Sformat.to_string fmt))
 ;;
 
@@ -473,7 +471,7 @@
 
 let format_mismatch_err fmt1 fmt2 =
   Printf.sprintf
-    "format read ``%s'' does not match specification ``%s''" fmt1 fmt2
+    "format read \'%s\' does not match specification \'%s\'" fmt1 fmt2
 ;;
 
 let format_mismatch fmt1 fmt2 = bad_input (format_mismatch_err fmt1 fmt2);;
@@ -484,19 +482,19 @@
   Tformat.summarize_format_type (string_to_format fmt2);;
 
 (* Checking that [c] is indeed in the input, then skips it.
-   In this case, the character c has been explicitely specified in the
+   In this case, the character [c] has been explicitly specified in the
    format as being mandatory in the input; hence we should fail with
    End_of_file in case of end_of_input. (Remember that Scan_failure is raised
    only when (we can prove by evidence) that the input does not match the
    format string given. We must thus differentiate End_of_file as an error
    due to lack of input, and Scan_failure which is due to provably wrong
-   input. I am not sure this is worth to burden: it is complex and somehow
+   input. I am not sure this is worth the burden: it is complex and somehow
    subliminal; should be clearer to fail with Scan_failure "Not enough input
    to complete scanning"!)
 
    That's why, waiting for a better solution, we use checked_peek_char here.
-   We are also careful to treat "\r\n" in the input as a end of line marker: it
-   always matches a '\n' specification in the input format string. *)
+   We are also careful to treat "\r\n" in the input as an end of line marker:
+   it always matches a '\n' specification in the input format string. *)
 let rec check_char ib c =
   let ci = Scanning.checked_peek_char ib in
   if ci = c then Scanning.invalidate_current_char ib else begin
@@ -589,57 +587,57 @@
    available before calling one of the digit scanning functions). *)
 
 (* The decimal case is treated especially for optimization purposes. *)
-let rec scan_decimal_digits max ib =
-  if max = 0 then max else
+let rec scan_decimal_digits width ib =
+  if width = 0 then width else
   let c = Scanning.peek_char ib in
-  if Scanning.eof ib then max else
+  if Scanning.eof ib then width else
   match c with
   | '0' .. '9' as c ->
-    let max = Scanning.store_char max ib c in
-    scan_decimal_digits max ib
+    let width = Scanning.store_char width ib c in
+    scan_decimal_digits width ib
   | '_' ->
-    let max = Scanning.ignore_char max ib in
-    scan_decimal_digits max ib
-  | _ -> max
+    let width = Scanning.ignore_char width ib in
+    scan_decimal_digits width ib
+  | _ -> width
 ;;
 
-let scan_decimal_digits_plus max ib =
-  if max = 0 then bad_token_length "decimal digits" else
+let scan_decimal_digits_plus width ib =
+  if width = 0 then bad_token_length "decimal digits" else
   let c = Scanning.checked_peek_char ib in
   match c with
   | '0' .. '9' ->
-    let max = Scanning.store_char max ib c in
-    scan_decimal_digits max ib
+    let width = Scanning.store_char width ib c in
+    scan_decimal_digits width ib
   | c ->
     bad_input (Printf.sprintf "character %C is not a decimal digit" c)
 ;;
 
-let scan_digits_plus digitp max ib =
+let scan_digits_plus basis digitp width ib =
   (* To scan numbers from other bases, we use a predicate argument to
      scan_digits. *)
-  let rec scan_digits max =
-    if max = 0 then max else
+  let rec scan_digits width =
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     match c with
     | c when digitp c ->
-      let max = Scanning.store_char max ib c in
-      scan_digits max
+      let width = Scanning.store_char width ib c in
+      scan_digits width
     | '_' ->
-      let max = Scanning.ignore_char max ib in
-      scan_digits max
-    | _ -> max in
+      let width = Scanning.ignore_char width ib in
+      scan_digits width
+    | _ -> width in
 
   (* Ensure we have got enough width left,
      and read at list one digit. *)
-  if max = 0 then bad_token_length "digits" else
+  if width = 0 then bad_token_length "digits" else
   let c = Scanning.checked_peek_char ib in
 
   if digitp c then
-    let max = Scanning.store_char max ib c in
-    scan_digits max
+    let width = Scanning.store_char width ib c in
+    scan_digits width
   else
-    bad_input (Printf.sprintf "character %C is not a digit" c)
+    bad_input (Printf.sprintf "character %C is not a valid %s digit" c basis)
 ;;
 
 let is_binary_digit = function
@@ -647,164 +645,166 @@
   | _ -> false
 ;;
 
-let scan_binary_int = scan_digits_plus is_binary_digit;;
+let scan_binary_int = scan_digits_plus "binary" is_binary_digit;;
 
 let is_octal_digit = function
   | '0' .. '7' -> true
   | _ -> false
 ;;
 
-let scan_octal_int = scan_digits_plus is_octal_digit;;
+let scan_octal_int = scan_digits_plus "octal" is_octal_digit;;
 
 let is_hexa_digit = function
   | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true
   | _ -> false
 ;;
 
-let scan_hexadecimal_int = scan_digits_plus is_hexa_digit;;
+let scan_hexadecimal_int = scan_digits_plus "hexadecimal" is_hexa_digit;;
 
 (* Scan a decimal integer. *)
 let scan_unsigned_decimal_int = scan_decimal_digits_plus;;
 
-let scan_sign max ib =
+let scan_sign width ib =
   let c = Scanning.checked_peek_char ib in
   match c with
-  | '+' -> Scanning.store_char max ib c
-  | '-' -> Scanning.store_char max ib c
-  | c -> max
+  | '+' -> Scanning.store_char width ib c
+  | '-' -> Scanning.store_char width ib c
+  | _ -> width
 ;;
 
-let scan_optionally_signed_decimal_int max ib =
-  let max = scan_sign max ib in
-  scan_unsigned_decimal_int max ib
+let scan_optionally_signed_decimal_int width ib =
+  let width = scan_sign width ib in
+  scan_unsigned_decimal_int width ib
 ;;
 
 (* Scan an unsigned integer that could be given in any (common) basis.
    If digits are prefixed by one of 0x, 0X, 0o, or 0b, the number is
    assumed to be written respectively in hexadecimal, hexadecimal,
    octal, or binary. *)
-let scan_unsigned_int max ib =
+let scan_unsigned_int width ib =
   match Scanning.checked_peek_char ib with
   | '0' as c ->
-    let max = Scanning.store_char max ib c in
-    if max = 0 then max else
+    let width = Scanning.store_char width ib c in
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     begin match c with
-    | 'x' | 'X' -> scan_hexadecimal_int (Scanning.store_char max ib c) ib
-    | 'o' -> scan_octal_int (Scanning.store_char max ib c) ib
-    | 'b' -> scan_binary_int (Scanning.store_char max ib c) ib
-    | c -> scan_decimal_digits max ib end
-  | c -> scan_unsigned_decimal_int max ib
+    | 'x' | 'X' -> scan_hexadecimal_int (Scanning.store_char width ib c) ib
+    | 'o' -> scan_octal_int (Scanning.store_char width ib c) ib
+    | 'b' -> scan_binary_int (Scanning.store_char width ib c) ib
+    | _ -> scan_decimal_digits width ib end
+  | _ -> scan_unsigned_decimal_int width ib
 ;;
 
-let scan_optionally_signed_int max ib =
-  let max = scan_sign max ib in
-  scan_unsigned_int max ib
+let scan_optionally_signed_int width ib =
+  let width = scan_sign width ib in
+  scan_unsigned_int width ib
 ;;
 
-let scan_int_conv conv max _min ib =
+let scan_int_conv conv width _prec ib =
   match conv with
-  | 'b' -> scan_binary_int max ib
-  | 'd' -> scan_optionally_signed_decimal_int max ib
-  | 'i' -> scan_optionally_signed_int max ib
-  | 'o' -> scan_octal_int max ib
-  | 'u' -> scan_unsigned_decimal_int max ib
-  | 'x' | 'X' -> scan_hexadecimal_int max ib
-  | c -> assert false
+  | 'b' -> scan_binary_int width ib
+  | 'd' -> scan_optionally_signed_decimal_int width ib
+  | 'i' -> scan_optionally_signed_int width ib
+  | 'o' -> scan_octal_int width ib
+  | 'u' -> scan_unsigned_decimal_int width ib
+  | 'x' | 'X' -> scan_hexadecimal_int width ib
+  | _ -> assert false
 ;;
 
 (* Scanning floating point numbers. *)
 (* Fractional part is optional and can be reduced to 0 digits. *)
-let scan_frac_part max ib =
-  if max = 0 then max else
+let scan_frac_part width ib =
+  if width = 0 then width else
   let c = Scanning.peek_char ib in
-  if Scanning.eof ib then max else
+  if Scanning.eof ib then width else
   match c with
   | '0' .. '9' as c ->
-    scan_decimal_digits (Scanning.store_char max ib c) ib
-  | _ -> max
+    scan_decimal_digits (Scanning.store_char width ib c) ib
+  | _ -> width
 ;;
 
 (* Exp part is optional and can be reduced to 0 digits. *)
-let scan_exp_part max ib =
-  if max = 0 then max else
+let scan_exp_part width ib =
+  if width = 0 then width else
   let c = Scanning.peek_char ib in
-  if Scanning.eof ib then max else
+  if Scanning.eof ib then width else
   match c with
   | 'e' | 'E' as c ->
-    scan_optionally_signed_decimal_int (Scanning.store_char max ib c) ib
-  | _ -> max
+    scan_optionally_signed_decimal_int (Scanning.store_char width ib c) ib
+  | _ -> width
 ;;
 
 (* Scan the integer part of a floating point number, (not using the
-   Caml lexical convention since the integer part can be empty):
+   OCaml lexical convention since the integer part can be empty):
    an optional sign, followed by a possibly empty sequence of decimal
    digits (e.g. -.1). *)
-let scan_int_part max ib =
-  let max = scan_sign max ib in
-  scan_decimal_digits max ib
+let scan_int_part width ib =
+  let width = scan_sign width ib in
+  scan_decimal_digits width ib
 ;;
 
 (*
-    For the time being we have (as found in scanf.mli):
-    The field width is composed of an optional integer literal
-    indicating the maximal width of the token to read.
-    Unfortunately, the type-checker let the user write an optional precision,
-    since this is valid for printf format strings.
-
-   Thus, the next step for Scanf is to support a full width indication, more
-   or less similar to the one for printf, possibly extended to the
-   specification of a [max, min] range for the width of the token read for
-   strings. Something like the following spec for scanf.mli:
+   For the time being we have (as found in scanf.mli):
+   The field width is composed of an optional integer literal
+   indicating the maximal width of the token to read.
+   Unfortunately, the type-checker let the user write an optional precision,
+   since this is valid for printf format strings.
+
+   Thus, the next step for Scanf is to support a full width and precision
+   indication, more or less similar to the one for printf, possibly extended
+   to the specification of a [max, min] range for the width of the token read
+   for strings. Something like the following spec for scanf.mli:
 
    The optional [width] is an integer indicating the maximal
    width of the token read. For instance, [%6d] reads an integer,
    having at most 6 characters.
 
    The optional [precision] is a dot [.] followed by an integer:
-   - in the floating point number conversions ([%f], [%e], [%g], [%F], [%E], and
-   [%F] conversions, the [precision] indicates the maximum number of digits
-   that may follow the decimal point. For instance, [%.4f] reads a [float]
-   with at most 4 fractional digits,
+
+   - in the floating point number conversions ([%f], [%e], [%g], [%F], [%E],
+   and [%F] conversions, the [precision] indicates the maximum number of
+   digits that may follow the decimal point. For instance, [%.4f] reads a
+   [float] with at most 4 fractional digits,
+
    - in the string conversions ([%s], [%S], [%\[ range \]]), and in the
    integer number conversions ([%i], [%d], [%u], [%x], [%o], and their
-   [int32], [int64], and [native_int] correspondent), the
-   [precision] indicates the required minimum width of the token read,
+   [int32], [int64], and [native_int] correspondent), the [precision]
+   indicates the required minimum width of the token read,
+
    - on all other conversions, the width and precision are meaningless and
    ignored (FIXME: lead to a runtime error ? type checking error ?).
-
 *)
-let scan_float max max_frac_part ib =
-  let max = scan_int_part max ib in
-  if max = 0 then max, max_frac_part else
+
+let scan_float width precision ib =
+  let width = scan_int_part width ib in
+  if width = 0 then width, precision else
   let c = Scanning.peek_char ib in
-  if Scanning.eof ib then max, max_frac_part else
+  if Scanning.eof ib then width, precision else
   match c with
   | '.' ->
-    let max = Scanning.store_char max ib c in
-    let max_precision = min max max_frac_part in
-    let max = max - (max_precision - scan_frac_part max_precision ib) in
-    scan_exp_part max ib, max_frac_part
-  | c ->
-    scan_exp_part max ib, max_frac_part
+    let width = Scanning.store_char width ib c in
+    let precision = min width precision in
+    let width = width - (precision - scan_frac_part precision ib) in
+    scan_exp_part width ib, precision
+  | _ ->
+    scan_exp_part width ib, precision
 ;;
 
-let scan_Float max max_frac_part ib =
-  let max = scan_optionally_signed_decimal_int max ib in
-  if max = 0 then bad_float () else
+let scan_Float width precision ib =
+  let width = scan_optionally_signed_decimal_int width ib in
+  if width = 0 then bad_float () else
   let c = Scanning.peek_char ib in
   if Scanning.eof ib then bad_float () else
   match c with
   | '.' ->
-    let max = Scanning.store_char max ib c in
-    let max_precision = min max max_frac_part in
-    let max = max - (max_precision - scan_frac_part max_precision ib) in
-    let max = scan_frac_part max ib in
-    scan_exp_part max ib
+    let width = Scanning.store_char width ib c in
+    let precision = min width precision in
+    let width = width - (precision - scan_frac_part precision ib) in
+    scan_exp_part width ib
   | 'e' | 'E' ->
-    scan_exp_part max ib
-  | c -> bad_float ()
+    scan_exp_part width ib
+  | _ -> bad_float ()
 ;;
 
 (* Scan a regular string:
@@ -813,26 +813,26 @@
    indication list [stp].
    It also stops at end of file or when the maximum number of characters has
    been read.*)
-let scan_string stp max ib =
-  let rec loop max =
-    if max = 0 then max else
+let scan_string stp width ib =
+  let rec loop width =
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     if stp = [] then
       match c with
-      | ' ' | '\t' | '\n' | '\r' -> max
-      | c -> loop (Scanning.store_char max ib c) else
-    if List.memq c stp then Scanning.skip_char max ib else
-    loop (Scanning.store_char max ib c) in
-  loop max
+      | ' ' | '\t' | '\n' | '\r' -> width
+      | c -> loop (Scanning.store_char width ib c) else
+    if List.memq c stp then Scanning.skip_char width ib else
+    loop (Scanning.store_char width ib c) in
+  loop width
 ;;
 
 (* Scan a char: peek strictly one character in the input, whatsoever. *)
-let scan_char max ib =
-  (* The case max = 0 could not happen here, since it is tested before
+let scan_char width ib =
+  (* The case width = 0 could not happen here, since it is tested before
      calling scan_char, in the main scanning function.
-    if max = 0 then bad_token_length "a character" else *)
-  Scanning.store_char max ib (Scanning.checked_peek_char ib)
+    if width = 0 then bad_token_length "a character" else *)
+  Scanning.store_char width ib (Scanning.checked_peek_char ib)
 ;;
 
 let char_for_backslash = function
@@ -887,8 +887,8 @@
 
 (* Called in particular when encountering '\\' as starter of a char.
    Stops before the corresponding '\''. *)
-let check_next_char message max ib =
-  if max = 0 then bad_token_length message else
+let check_next_char message width ib =
+  if width = 0 then bad_token_length message else
   let c = Scanning.peek_char ib in
   if Scanning.eof ib then bad_end_of_input message else
   c
@@ -897,10 +897,10 @@
 let check_next_char_for_char = check_next_char "a Char";;
 let check_next_char_for_string = check_next_char "a String";;
 
-let scan_backslash_char max ib =
-  match check_next_char_for_char max ib with
+let scan_backslash_char width ib =
+  match check_next_char_for_char width ib with
   | '\\' | '\'' | '\"' | 'n' | 't' | 'b' | 'r' as c ->
-    Scanning.store_char max ib (char_for_backslash c)
+    Scanning.store_char width ib (char_for_backslash c)
   | '0' .. '9' as c ->
     let get_digit () =
       let c = Scanning.next_char ib in
@@ -910,7 +910,7 @@
     let c0 = c in
     let c1 = get_digit () in
     let c2 = get_digit () in
-    Scanning.store_char (max - 2) ib (char_for_decimal_code c0 c1 c2)
+    Scanning.store_char (width - 2) ib (char_for_decimal_code c0 c1 c2)
   | 'x' ->
     let get_digit () =
       let c = Scanning.next_char ib in
@@ -919,68 +919,70 @@
       | c -> bad_input_escape c in
     let c1 = get_digit () in
     let c2 = get_digit () in
-    Scanning.store_char (max - 2) ib (char_for_hexadecimal_code c1 c2)
+    Scanning.store_char (width - 2) ib (char_for_hexadecimal_code c1 c2)
   | c ->
     bad_input_escape c
 ;;
 
-(* Scan a character (a Caml token). *)
-let scan_Char max ib =
+(* Scan a character (an OCaml token). *)
+let scan_Char width ib =
 
-  let rec find_start max =
+  let rec find_start width =
     match Scanning.checked_peek_char ib with
-    | '\'' -> find_char (Scanning.ignore_char max ib)
+    | '\'' -> find_char (Scanning.ignore_char width ib)
     | c -> character_mismatch '\'' c
 
-  and find_char max =
-    match check_next_char_for_char max ib with
-    | '\\' -> find_stop (scan_backslash_char (Scanning.ignore_char max ib) ib)
-    | c -> find_stop (Scanning.store_char max ib c)
-
-  and find_stop max =
-    match check_next_char_for_char max ib with
-    | '\'' -> Scanning.ignore_char max ib
+  and find_char width =
+    match check_next_char_for_char width ib with
+    | '\\' ->
+      find_stop (scan_backslash_char (Scanning.ignore_char width ib) ib)
+    | c ->
+      find_stop (Scanning.store_char width ib c)
+
+  and find_stop width =
+    match check_next_char_for_char width ib with
+    | '\'' -> Scanning.ignore_char width ib
     | c -> character_mismatch '\'' c in
 
-  find_start max
+  find_start width
 ;;
 
-(* Scan a delimited string (a Caml token). *)
-let scan_String max ib =
+(* Scan a delimited string (an OCaml token). *)
+let scan_String width ib =
 
-  let rec find_start max =
+  let rec find_start width =
     match Scanning.checked_peek_char ib with
-    | '\"' -> find_stop (Scanning.ignore_char max ib)
+    | '\"' -> find_stop (Scanning.ignore_char width ib)
     | c -> character_mismatch '\"' c
 
-  and find_stop max =
-    match check_next_char_for_string max ib with
-    | '\"' -> Scanning.ignore_char max ib
-    | '\\' -> scan_backslash (Scanning.ignore_char max ib)
-    | c -> find_stop (Scanning.store_char max ib c)
-
-  and scan_backslash max =
-    match check_next_char_for_string max ib with
-    | '\r' -> skip_newline (Scanning.ignore_char max ib)
-    | '\n' -> skip_spaces (Scanning.ignore_char max ib)
-    | c -> find_stop (scan_backslash_char max ib)
-
-  and skip_newline max =
-    match check_next_char_for_string max ib with
-    | '\n' -> skip_spaces (Scanning.ignore_char max ib)
-    | _ -> find_stop (Scanning.store_char max ib '\r')
-
-  and skip_spaces max =
-    match check_next_char_for_string max ib with
-    | ' ' -> skip_spaces (Scanning.ignore_char max ib)
-    | _ -> find_stop max in
-
-  find_start max
-;;
-
-(* Scan a boolean (a Caml token). *)
-let scan_bool max ib =
-  if max < 4 then bad_token_length "a boolean" else
+  and find_stop width =
+    match check_next_char_for_string width ib with
+    | '\"' -> Scanning.ignore_char width ib
+    | '\\' -> scan_backslash (Scanning.ignore_char width ib)
+    | c -> find_stop (Scanning.store_char width ib c)
+
+  and scan_backslash width =
+    match check_next_char_for_string width ib with
+    | '\r' -> skip_newline (Scanning.ignore_char width ib)
+    | '\n' -> skip_spaces (Scanning.ignore_char width ib)
+    | _ -> find_stop (scan_backslash_char width ib)
+
+  and skip_newline width =
+    match check_next_char_for_string width ib with
+    | '\n' -> skip_spaces (Scanning.ignore_char width ib)
+    | _ -> find_stop (Scanning.store_char width ib '\r')
+
+  and skip_spaces width =
+    match check_next_char_for_string width ib with
+    | ' ' -> skip_spaces (Scanning.ignore_char width ib)
+    | _ -> find_stop width in
+
+  find_start width
+;;
+
+(* Scan a boolean (an OCaml token). *)
+let scan_bool width ib =
+  if width < 4 then bad_token_length "a boolean" else
   let c = Scanning.checked_peek_char ib in
   let m =
     match c with
@@ -989,7 +991,7 @@
     | c ->
       bad_input
         (Printf.sprintf "the character %C cannot start a boolean" c) in
-  scan_string [] (min max m) ib
+  scan_string [] (min width m) ib
 ;;
 
 (* Reading char sets in %[...] conversions. *)
@@ -998,31 +1000,51 @@
    | Neg_set of string (* Negative (complementary) set. *)
 ;;
 
+
 (* Char sets are read as sub-strings in the format string. *)
-let read_char_set fmt i =
-  let lim = Sformat.length fmt - 1 in
+let scan_range fmt j =
+
+  let len = Sformat.length fmt in
+
+  let buffer = Buffer.create len in
 
-  let rec find_in_set j =
-    if j > lim then incomplete_format fmt else
+  let rec scan_closing j =
+    if j >= len then incomplete_format fmt else
     match Sformat.get fmt j with
-    | ']' -> j
-    | c -> find_in_set (succ j)
+    | ']' -> j, Buffer.contents buffer
+    | '%' ->
+      let j = j + 1 in
+      if j >= len then incomplete_format fmt else
+      begin match Sformat.get fmt j with
+      | '%' | '@' as c ->
+        Buffer.add_char buffer c;
+        scan_closing (j + 1)
+      | c -> bad_conversion fmt j c
+      end
+    | c ->
+      Buffer.add_char buffer c;
+      scan_closing (j + 1) in
 
-  and find_set i =
-    if i > lim then incomplete_format fmt else
-    match Sformat.get fmt i with
-    | ']' -> find_in_set (succ i)
-    | c -> find_in_set i in
-
-  if i > lim then incomplete_format fmt else
-  match Sformat.get fmt i with
-  | '^' ->
-    let i = succ i in
-    let j = find_set i in
-    j, Neg_set (Sformat.sub fmt (Sformat.index_of_int i) (j - i))
-  | _ ->
-    let j = find_set i in
-    j, Pos_set (Sformat.sub fmt (Sformat.index_of_int i) (j - i))
+  let scan_first_pos j =
+    if j >= len then incomplete_format fmt else
+    match Sformat.get fmt j with
+    | ']' as c ->
+      Buffer.add_char buffer c;
+      scan_closing (j + 1)
+    | _ -> scan_closing j in
+
+  let scan_first_neg j =
+    if j >= len then incomplete_format fmt else
+    match Sformat.get fmt j with
+    | '^' ->
+      let j = j + 1 in
+      let k, char_set = scan_first_pos j in
+      k, Neg_set char_set
+    | _ ->
+      let k, char_set = scan_first_pos j in
+      k, Pos_set char_set in
+
+  scan_first_neg j
 ;;
 
 (* Char sets are now represented as bit vectors that are represented as
@@ -1082,7 +1104,7 @@
       for j = int_of_char c1 to int_of_char c2 do
         set_bit_of_range r j bit done;
       loop bit false (succ i)
-    | c ->
+    | _ ->
       set_bit_of_range r (int_of_char set.[i]) bit;
       loop bit true (succ i) in
   loop bit false 0;
@@ -1090,7 +1112,7 @@
 ;;
 
 (* Compute the predicate on chars corresponding to a char set. *)
-let make_pred bit set stp =
+let make_predicate bit set stp =
   let r = make_char_bit_vect bit set in
   List.iter
     (fun c -> set_bit_of_range r (int_of_char c) (bit_not bit)) stp;
@@ -1101,7 +1123,7 @@
   match char_set with
   | Pos_set set ->
     begin match String.length set with
-    | 0 -> (fun c -> 0)
+    | 0 -> (fun _ -> 0)
     | 1 ->
       let p = set.[0] in
       (fun c -> if c == p then 1 else 0)
@@ -1110,13 +1132,13 @@
       (fun c -> if c == p1 || c == p2 then 1 else 0)
     | 3 ->
       let p1 = set.[0] and p2 = set.[1] and p3 = set.[2] in
-      if p2 = '-' then make_pred 1 set stp else
+      if p2 = '-' then make_predicate 1 set stp else
       (fun c -> if c == p1 || c == p2 || c == p3 then 1 else 0)
-    | n -> make_pred 1 set stp
+    | _ -> make_predicate 1 set stp
     end
   | Neg_set set ->
     begin match String.length set with
-    | 0 -> (fun c -> 1)
+    | 0 -> (fun _ -> 1)
     | 1 ->
       let p = set.[0] in
       (fun c -> if c != p then 1 else 0)
@@ -1125,9 +1147,9 @@
       (fun c -> if c != p1 && c != p2 then 1 else 0)
     | 3 ->
       let p1 = set.[0] and p2 = set.[1] and p3 = set.[2] in
-      if p2 = '-' then make_pred 0 set stp else
+      if p2 = '-' then make_predicate 0 set stp else
       (fun c -> if c != p1 && c != p2 && c != p3 then 1 else 0)
-    | n -> make_pred 0 set stp
+    | _ -> make_predicate 0 set stp
     end
 ;;
 
@@ -1151,75 +1173,75 @@
     setp
 ;;
 
-let scan_chars_in_char_set stp char_set max ib =
-  let rec loop_pos1 cp1 max =
-    if max = 0 then max else
+let scan_chars_in_char_set stp char_set width ib =
+  let rec loop_pos1 cp1 width =
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     if c == cp1
-    then loop_pos1 cp1 (Scanning.store_char max ib c)
-    else max
-  and loop_pos2 cp1 cp2 max =
-    if max = 0 then max else
+    then loop_pos1 cp1 (Scanning.store_char width ib c)
+    else width
+  and loop_pos2 cp1 cp2 width =
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     if c == cp1 || c == cp2
-    then loop_pos2 cp1 cp2 (Scanning.store_char max ib c)
-    else max
-  and loop_pos3 cp1 cp2 cp3 max =
-    if max = 0 then max else
+    then loop_pos2 cp1 cp2 (Scanning.store_char width ib c)
+    else width
+  and loop_pos3 cp1 cp2 cp3 width =
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     if c == cp1 || c == cp2 || c == cp3
-    then loop_pos3 cp1 cp2 cp3 (Scanning.store_char max ib c)
-    else max
-  and loop_neg1 cp1 max =
-    if max = 0 then max else
+    then loop_pos3 cp1 cp2 cp3 (Scanning.store_char width ib c)
+    else width
+  and loop_neg1 cp1 width =
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     if c != cp1
-    then loop_neg1 cp1 (Scanning.store_char max ib c)
-    else max
-  and loop_neg2 cp1 cp2 max =
-    if max = 0 then max else
+    then loop_neg1 cp1 (Scanning.store_char width ib c)
+    else width
+  and loop_neg2 cp1 cp2 width =
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     if c != cp1 && c != cp2
-    then loop_neg2 cp1 cp2 (Scanning.store_char max ib c)
-    else max
-  and loop_neg3 cp1 cp2 cp3 max =
-    if max = 0 then max else
+    then loop_neg2 cp1 cp2 (Scanning.store_char width ib c)
+    else width
+  and loop_neg3 cp1 cp2 cp3 width =
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     if c != cp1 && c != cp2 && c != cp3
-    then loop_neg3 cp1 cp2 cp3 (Scanning.store_char max ib c)
-    else max
-  and loop setp max =
-    if max = 0 then max else
+    then loop_neg3 cp1 cp2 cp3 (Scanning.store_char width ib c)
+    else width
+  and loop setp width =
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     if setp c == 1
-    then loop setp (Scanning.store_char max ib c)
-    else max in
+    then loop setp (Scanning.store_char width ib c)
+    else width in
 
-  let max =
+  let width =
     match char_set with
     | Pos_set set ->
       begin match String.length set with
-      | 0 -> loop (fun c -> 0) max
-      | 1 -> loop_pos1 set.[0] max
-      | 2 -> loop_pos2 set.[0] set.[1] max
-      | 3 when set.[1] != '-' -> loop_pos3 set.[0] set.[1] set.[2] max
-      | n -> loop (find_setp stp char_set) max end
+      | 0 -> loop (fun _ -> 0) width
+      | 1 -> loop_pos1 set.[0] width
+      | 2 -> loop_pos2 set.[0] set.[1] width
+      | 3 when set.[1] != '-' -> loop_pos3 set.[0] set.[1] set.[2] width
+      | _ -> loop (find_setp stp char_set) width end
     | Neg_set set ->
       begin match String.length set with
-      | 0 -> loop (fun c -> 1) max
-      | 1 -> loop_neg1 set.[0] max
-      | 2 -> loop_neg2 set.[0] set.[1] max
-      | 3 when set.[1] != '-' -> loop_neg3 set.[0] set.[1] set.[2] max
-      | n -> loop (find_setp stp char_set) max end in
+      | 0 -> loop (fun _ -> 1) width
+      | 1 -> loop_neg1 set.[0] width
+      | 2 -> loop_neg2 set.[0] set.[1] width
+      | 3 when set.[1] != '-' -> loop_neg3 set.[0] set.[1] set.[2] width
+      | _ -> loop (find_setp stp char_set) width end in
   ignore_stoppers stp ib;
-  max
+  width
 ;;
 
 let get_count t ib =
@@ -1243,7 +1265,7 @@
 let scanf_bad_input ib = function
   | Scan_failure s | Failure s ->
     let i = Scanning.char_count ib in
-    bad_input (Printf.sprintf "scanf: bad input at char number %i: ``%s''" i s)
+    bad_input (Printf.sprintf "scanf: bad input at char number %i: \'%s\'" i s)
   | x -> raise x
 ;;
 
@@ -1305,7 +1327,7 @@
   let return v = Obj.magic v () in
   let delay f x () = f x in
   let stack f = delay (return f) in
-  let no_stack f x = f in
+  let no_stack f _x = f in
 
   let rec scan fmt =
 
@@ -1313,14 +1335,9 @@
 
     let rec scan_fmt ir f i =
       if i > lim then ir, f else
-      match Sformat.get fmt i with
-      | ' ' -> skip_whites ib; scan_fmt ir f (succ i)
+      match Sformat.unsafe_get fmt i with
       | '%' -> scan_skip ir f (succ i)
-      | '@' ->
-        let i = succ i in
-        if i > lim then incomplete_format fmt else begin
-        check_char ib (Sformat.get fmt i);
-        scan_fmt ir f (succ i) end
+      | ' ' -> skip_whites ib; scan_fmt ir f (succ i)
       | c -> check_char ib c; scan_fmt ir f (succ i)
 
     and scan_skip ir f i =
@@ -1330,78 +1347,89 @@
       | _ -> scan_limits false ir f i
 
     and scan_limits skip ir f i =
-      if i > lim then ir, f else
-      let max_opt, min_opt, i =
+
+      let rec scan_width i =
+        if i > lim then incomplete_format fmt else
         match Sformat.get fmt i with
         | '0' .. '9' as conv ->
-          let rec read_width accu i =
-            if i > lim then accu, i else
-            match Sformat.get fmt i with
-            | '0' .. '9' as c ->
-              let accu = 10 * accu + decimal_value_of_char c in
-              read_width accu (succ i)
-            | _ -> accu, i in
-
-          let max, i = read_width (decimal_value_of_char conv) (succ i) in
-
-          if i > lim then incomplete_format fmt else
-          begin
-            match Sformat.get fmt i with
-            | '.' ->
-              let min, i = read_width 0 (succ i) in
-              (Some max, Some min, i)
-            | _ -> Some max, None, i
-          end
-        | _ -> None, None, i in
+          let width, i =
+            read_int_literal (decimal_value_of_char conv) (succ i) in
+          Some width, i
+        | _ -> None, i
+
+      and scan_precision i =
+        begin
+          match Sformat.get fmt i with
+          | '.' ->
+            let precision, i = read_int_literal 0 (succ i) in
+            (Some precision, i)
+          | _ -> None, i
+        end
 
-      scan_conversion skip max_opt min_opt ir f i
+      and read_int_literal accu i =
+        if i > lim then accu, i else
+        match Sformat.unsafe_get fmt i with
+        | '0' .. '9' as c ->
+          let accu = 10 * accu + decimal_value_of_char c in
+          read_int_literal accu (succ i)
+        | _ -> accu, i in
 
-    and scan_conversion skip max_opt min_opt ir f i =
+      if i > lim then ir, f else
+      let width_opt, i = scan_width i in
+      let prec_opt, i = scan_precision i in
+      scan_conversion skip width_opt prec_opt ir f i
+
+    and scan_conversion skip width_opt prec_opt ir f i =
       let stack = if skip then no_stack else stack in
-      let max = int_max max_opt in
-      let min = int_min min_opt in
+      let width = int_of_width_opt width_opt in
+      let prec = int_of_prec_opt prec_opt in
       match Sformat.get fmt i with
-      | '%' as conv ->
-        check_char ib conv; scan_fmt ir f (succ i)
+      | '%' | '@' as c ->
+        check_char ib c;
+        scan_fmt ir f (succ i)
+      | '!' ->
+        if not (Scanning.end_of_input ib)
+        then bad_input "end of input not found" else
+        scan_fmt ir f (succ i)
+      | ',' ->
+        scan_fmt ir f (succ i)
       | 's' ->
-        let i, stp = scan_fmt_stoppers (succ i) in
-        let _x = scan_string stp max ib in
+        let i, stp = scan_indication (succ i) in
+        let _x = scan_string stp width ib in
         scan_fmt ir (stack f (token_string ib)) (succ i)
       | 'S' ->
-        let _x = scan_String max ib in
+        let _x = scan_String width ib in
         scan_fmt ir (stack f (token_string ib)) (succ i)
       | '[' (* ']' *) ->
-        let i, char_set = read_char_set fmt (succ i) in
-        let i, stp = scan_fmt_stoppers (succ i) in
-        let _x = scan_chars_in_char_set stp char_set max ib in
+        let i, char_set = scan_range fmt (succ i) in
+        let i, stp = scan_indication (succ i) in
+        let _x = scan_chars_in_char_set stp char_set width ib in
         scan_fmt ir (stack f (token_string ib)) (succ i)
-      | ('c' | 'C') when max = 0 ->
+      | ('c' | 'C') when width = 0 ->
         let c = Scanning.checked_peek_char ib in
         scan_fmt ir (stack f c) (succ i)
       | 'c' ->
-        let _x = scan_char max ib in
+        let _x = scan_char width ib in
         scan_fmt ir (stack f (token_char ib)) (succ i)
       | 'C' ->
-        let _x = scan_Char max ib in
+        let _x = scan_Char width ib in
         scan_fmt ir (stack f (token_char ib)) (succ i)
       | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' as conv ->
-        let _x = scan_int_conv conv max min ib in
+        let _x = scan_int_conv conv width prec ib in
         scan_fmt ir (stack f (token_int conv ib)) (succ i)
       | 'N' as conv ->
         scan_fmt ir (stack f (get_count conv ib)) (succ i)
       | 'f' | 'e' | 'E' | 'g' | 'G' ->
-        let min = float_min min_opt in
-        let _x = scan_float max min ib in
+        let _x = scan_float width prec ib in
         scan_fmt ir (stack f (token_float ib)) (succ i)
       | 'F' ->
-        let min = float_min min_opt in
-        let _x = scan_Float max min ib in
+        let _x = scan_Float width prec ib in
         scan_fmt ir (stack f (token_float ib)) (succ i)
-(*      | 'B' | 'b' when max = Some 0 ->
-        let _x = scan_bool max ib in
+(*      | 'B' | 'b' when width = Some 0 ->
+        let _x = scan_bool width ib in
         scan_fmt ir (stack f (token_int ib)) (succ i) *)
       | 'B' | 'b' ->
-        let _x = scan_bool max ib in
+        let _x = scan_bool width ib in
         scan_fmt ir (stack f (token_bool ib)) (succ i)
       | 'r' ->
         if ir > limr then assert false else
@@ -1413,7 +1441,7 @@
         match Sformat.get fmt i with
         (* This is in fact an integer conversion (e.g. %ld, %ni, or %Lo). *)
         | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' as conv1 ->
-          let _x = scan_int_conv conv1 max min ib in
+          let _x = scan_int_conv conv1 width prec ib in
           (* Look back to the character that triggered the integer conversion
              (this character is either 'l', 'n' or 'L') to find the
              conversion to apply to the integer token read. *)
@@ -1423,27 +1451,36 @@
           | _ -> scan_fmt ir (stack f (token_int64 conv1 ib)) (succ i) end
         (* This is not an integer conversion, but a regular %l, %n or %L. *)
         | _ -> scan_fmt ir (stack f (get_count conv0 ib)) i end
-      | '!' ->
-        if Scanning.end_of_input ib then scan_fmt ir f (succ i)
-        else bad_input "end of input not found"
-      | ',' ->
-        scan_fmt ir f (succ i)
       | '(' | '{' as conv (* ')' '}' *) ->
         let i = succ i in
-        (* Find the static specification for the format to read. *)
+        (* Find [mf], the static specification for the format to read. *)
         let j =
           Tformat.sub_format
             incomplete_format bad_conversion conv fmt i in
         let mf = Sformat.sub fmt (Sformat.index_of_int i) (j - 2 - i) in
-        (* Read the specified format string in the input buffer,
-           and check its correctness. *)
-        let _x = scan_String max ib in
+        (* Read [rf], the specified format string in the input buffer,
+           and check its correctness w.r.t. [mf]. *)
+        let _x = scan_String width ib in
         let rf = token_string ib in
         if not (compatible_format_type rf mf) then format_mismatch rf mf else
+        (* Proceed according to the kind of metaformat found:
+           - %{ mf %} simply returns [rf] as the token read,
+           - %( mf %) returns [rf] as the first token read, then
+             returns a second token obtained by scanning the input with
+             format string [rf].
+           Behaviour for %( mf %) is mandatory for sake of format string
+           typechecking specification. To get pure format string
+           substitution behaviour, you should use %_( mf %) that skips the
+           first (format string) token and hence properly substitutes [mf] by
+           [rf] in the format string argument.
+        *)
         (* For conversion %{%}, just return this format string as the token
-           read. *)
+           read and go on with the rest of the format string argument. *)
         if conv = '{' (* '}' *) then scan_fmt ir (stack f rf) j else
-        (* Or else, read according to the format string just read. *)
+        (* Or else, return this format string as the first token read;
+           then continue scanning using this format string to get
+           the following token read;
+           finally go on with the rest of the format string argument. *)
         let ir, nf = scan (string_to_format rf) ir (stack f rf) 0 in
         (* Return the format string read and the value just read,
            then go on with the rest of the format. *)
@@ -1451,12 +1488,23 @@
 
       | c -> bad_conversion fmt i c
 
-    and scan_fmt_stoppers i =
-      if i > lim then i - 1, [] else
-      match Sformat.get fmt i with
-      | '@' when i < lim -> let i = succ i in i, [Sformat.get fmt i]
-      | '@' when i = lim -> incomplete_format fmt
-      | _ -> i - 1, [] in
+    and scan_indication j =
+      if j > lim then j - 1, [] else
+      match Sformat.get fmt j with
+      | '@' ->
+        let k = j + 1 in
+        if k > lim then j - 1, [] else
+        begin match Sformat.get fmt k with
+        | '%' ->
+          let k = k + 1 in
+          if k > lim then j - 1, [] else
+          begin match Sformat.get fmt k with
+          | '%' | '@' as c  -> k, [ c ]
+          | _c -> j - 1, []
+          end
+        | c -> k, [ c ]
+        end
+      | _c -> j - 1, [] in
 
     scan_fmt in
 
@@ -1481,7 +1529,8 @@
 
 let fscanf ic = bscanf (Scanning.from_channel ic);;
 
-let sscanf s = bscanf (Scanning.from_string s);;
+let sscanf : string -> ('a, 'b, 'c, 'd) scanner
+  = fun s -> bscanf (Scanning.from_string s);;
 
 let scanf fmt = bscanf Scanning.stdib fmt;;
 
@@ -1513,3 +1562,13 @@
 let format_from_string s fmt =
   sscanf_format (string_to_String s) fmt (fun x -> x)
 ;;
+
+let unescaped s =
+  sscanf ("\"" ^ s ^ "\"") "%S%!" (fun x -> x)
+;;
+
+(*
+ Local Variables:
+  compile-command: "cd ..; make world"
+  End:
+*)
diff -Nru ocaml-3.12.1/stdlib/scanf.mli ocaml-4.01.0/stdlib/scanf.mli
--- ocaml-3.12.1/stdlib/scanf.mli	2011-03-06 16:08:33.000000000 +0000
+++ ocaml-4.01.0/stdlib/scanf.mli	2013-05-29 18:03:55.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Pierre Weis, projet Cristal, INRIA Rocquencourt          *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: scanf.mli 10967 2011-03-06 16:08:33Z weis $ *)
-
 (** Formatted input functions. *)
 
 (** {6 Introduction} *)
@@ -25,7 +23,8 @@
     strings, files, or anything that can return characters. The more general
     source of characters is named a {e formatted input channel} (or {e
     scanning buffer}) and has type {!Scanning.in_channel}. The more general
-    formatted input function reads from any scanning buffer and is named [bscanf].
+    formatted input function reads from any scanning buffer and is named
+    [bscanf].
 
     Generally speaking, the formatted input functions have 3 arguments:
     - the first argument is a source of characters for the input,
@@ -44,7 +43,8 @@
     material with module {!Printf} or {!Format}),
 
     - [f] is a function that has as many arguments as the number of values to
-    read in the input. *)
+    read in the input.
+*)
 
 (** {7 A simple example} *)
 
@@ -58,30 +58,33 @@
 
     - if we define the receiver [f] as [let f x = x + 1],
 
-    then [bscanf Scanning.stdin "%d" f] reads an integer [n] from the standard input
-    and returns [f n] (that is [n + 1]). Thus, if we evaluate [bscanf stdin
-    "%d" f], and then enter [41] at the keyboard, we get [42] as the final
-    result. *)
+    then [bscanf Scanning.stdin "%d" f] reads an integer [n] from the
+    standard input and returns [f n] (that is [n + 1]). Thus, if we
+    evaluate [bscanf stdin "%d" f], and then enter [41] at the
+    keyboard, we get [42] as the final result.
+*)
 
 (** {7 Formatted input as a functional feature} *)
 
-(** The Caml scanning facility is reminiscent of the corresponding C feature.
+(** The OCaml scanning facility is reminiscent of the corresponding C feature.
     However, it is also largely different, simpler, and yet more powerful:
     the formatted input functions are higher-order functionals and the
     parameter passing mechanism is just the regular function application not
     the variable assignment based mechanism which is typical for formatted
-    input in imperative languages; the Caml format strings also feature
+    input in imperative languages; the OCaml format strings also feature
     useful additions to easily define complex tokens; as expected within a
     functional programming language, the formatted input functions also
     support polymorphism, in particular arbitrary interaction with
-    polymorphic user-defined scanners.  Furthermore, the Caml formatted input
-    facility is fully type-checked at compile time. *)
+    polymorphic user-defined scanners. Furthermore, the OCaml formatted input
+    facility is fully type-checked at compile time.
+*)
 
 (** {6 Formatted input channel} *)
+
 module Scanning : sig
 
 type in_channel;;
-(* The notion of input channel for the [Scanf] module:
+(** The notion of input channel for the [Scanf] module:
    those channels provide all the machinery necessary to read from a given
    [Pervasives.in_channel] value.
    A [Scanf.Scanning.in_channel] value is also called a {i formatted input
@@ -97,9 +100,10 @@
     input, and a token buffer to store the string matched so far.
 
     Note: a scanning action may often require to examine one character in
-    advance; when this ``lookahead'' character does not belong to the token
+    advance; when this 'lookahead' character does not belong to the token
     read, it is stored back in the scanning buffer and becomes the next
-    character yet to be read. *)
+    character yet to be read.
+*)
 
 val stdin : in_channel;;
 (** The standard input notion for the [Scanf] module.
@@ -114,9 +118,14 @@
     @since 3.12.0
 *)
 
-val open_in : string -> in_channel;;
+type file_name = string;;
+(** A convenient alias to designate a file name.
+    @since 4.00.0
+*)
+
+val open_in : file_name -> in_channel;;
 (** [Scanning.open_in fname] returns a formatted input channel for bufferized
-    reading in text mode of file [fname].
+    reading in text mode from file [fname].
 
     Note:
     [open_in] returns a formatted input channel that efficiently reads
@@ -126,19 +135,19 @@
     @since 3.12.0
 *)
 
-val open_in_bin : string -> in_channel;;
-(** [Scanning.open_in_bin fname] returns a formatted input channel for bufferized
-    reading in binary mode of file [fname].
+val open_in_bin : file_name -> in_channel;;
+(** [Scanning.open_in_bin fname] returns a formatted input channel for
+    bufferized reading in binary mode from file [fname].
     @since 3.12.0
 *)
 
 val close_in : in_channel -> unit;;
-(** Closes the [Pervasives.input_channel] associated with the given
+(** Closes the [Pervasives.in_channel] associated with the given
   [Scanning.in_channel] formatted input channel.
   @since 3.12.0
 *)
 
-val from_file : string -> in_channel;;
+val from_file : file_name -> in_channel;;
 (** An alias for [open_in] above. *)
 val from_file_bin : string -> in_channel;;
 (** An alias for [open_in_bin] above. *)
@@ -147,7 +156,8 @@
 (** [Scanning.from_string s] returns a formatted input channel which reads
     from the given string.
     Reading starts from the first character in the string.
-    The end-of-input condition is set when the end of the string is reached. *)
+    The end-of-input condition is set when the end of the string is reached.
+*)
 
 val from_function : (unit -> char) -> in_channel;;
 (** [Scanning.from_function f] returns a formatted input channel with the
@@ -156,20 +166,24 @@
     When scanning needs one more character, the given function is called.
 
     When the function has no more character to provide, it {e must} signal an
-    end-of-input condition by raising the exception [End_of_file]. *)
+    end-of-input condition by raising the exception [End_of_file].
+*)
 
 val from_channel : Pervasives.in_channel -> in_channel;;
 (** [Scanning.from_channel ic] returns a formatted input channel which reads
     from the regular input channel [ic] argument, starting at the current
-    reading position. *)
+    reading position.
+*)
 
 val end_of_input : in_channel -> bool;;
 (** [Scanning.end_of_input ic] tests the end-of-input condition of the given
-    formatted input channel. *)
+    formatted input channel.
+*)
 
 val beginning_of_input : in_channel -> bool;;
 (** [Scanning.beginning_of_input ic] tests the beginning of input condition of
-    the given formatted input channel. *)
+    the given formatted input channel.
+*)
 
 val name_of_input : in_channel -> string;;
 (** [Scanning.name_of_input ic] returns the name of the character source
@@ -179,7 +193,8 @@
 
 val stdib : in_channel;;
 (** A deprecated alias for [Scanning.stdin], the scanning buffer reading from
-    [Pervasives.stdin]. *)
+    [Pervasives.stdin].
+*)
 
 end;;
 
@@ -187,12 +202,13 @@
 
 type ('a, 'b, 'c, 'd) scanner =
      ('a, Scanning.in_channel, 'b, 'c, 'a -> 'd, 'd) format6 -> 'c;;
-(** The type of formatted input scanners: [('a, 'b, 'c, 'd) scanner] is the
-    type of a formatted input function that reads from some formatted input channel
-    according to some format string; more precisely, if [scan] is some
-    formatted input function, then [scan ic fmt f] applies [f] to the arguments
-    specified by the format string [fmt], when [scan] has read those arguments
-    from the formatted input channel [ic].
+(** The type of formatted input scanners: [('a, 'b, 'c, 'd) scanner]
+    is the type of a formatted input function that reads from some
+    formatted input channel according to some format string; more
+    precisely, if [scan] is some formatted input function, then [scan
+    ic fmt f] applies [f] to the arguments specified by the format
+    string [fmt], when [scan] has read those arguments from the
+    formatted input channel [ic].
 
     For instance, the [scanf] function below has type [('a, 'b, 'c, 'd)
     scanner], since it is a formatted input function that reads from
@@ -208,8 +224,9 @@
 *)
 
 exception Scan_failure of string;;
-(** The exception that formatted input functions raise when the input cannot be
-    read according to the given format. *)
+(** The exception that formatted input functions raise when the input cannot
+    be read according to the given format.
+*)
 
 (** {6 The general formatted input function} *)
 
@@ -223,18 +240,21 @@
     [Scanf.sscanf "x=  1" "%s = %i" f] returns [2].
 
     Arguments [r1] to [rN] are user-defined input functions that read the
-    argument corresponding to a [%r] conversion. *)
+    argument corresponding to the [%r] conversions specified in the format
+    string.
+*)
 
 (** {6 Format string description} *)
 
-(** The format is a character string which contains three types of
+(** The format string is a character string which contains three types of
     objects:
     - plain characters, which are simply matched with the characters of the
       input (with a special case for space and line feed, see {!Scanf.space}),
     - conversion specifications, each of which causes reading and conversion of
       one argument for the function [f] (see {!Scanf.conversion}),
     - scanning indications to specify boundaries of tokens
-      (see scanning {!Scanf.indication}). *)
+      (see scanning {!Scanf.indication}).
+*)
 
 (** {7:space The space character in format strings} *)
 
@@ -243,7 +263,7 @@
     special exceptions to this rule: the space character ([' '] or ASCII code
     32) and the line feed character (['\n'] or ASCII code 10).
     A space does not match a single space character, but any amount of
-    ``whitespace'' in the input. More precisely, a space inside the format
+    'whitespace' in the input. More precisely, a space inside the format
     string matches {e any number} of tab, space, line feed and carriage
     return characters. Similarly, a line feed character in the format string
     matches either a single line feed or a carriage return followed by a line
@@ -253,7 +273,8 @@
     also matches no amount of whitespace at all; hence, the call [bscanf ib
     "Price = %d $" (fun p -> p)] succeeds and returns [1] when reading an
     input with various whitespace in it, such as [Price = 1 $],
-    [Price  =  1    $], or even [Price=1$]. *)
+    [Price  =  1    $], or even [Price=1$].
+*)
 
 (** {7:conversion Conversion specifications in format strings} *)
 
@@ -268,7 +289,7 @@
        ([0x[0-9a-f]+] and [0X[0-9A-F]+]), octal ([0o[0-7]+]), and binary
        ([0b[0-1]+]) notations are understood).
     - [u]: reads an unsigned decimal integer.
-    - [x] or [X]: reads an unsigned hexadecimal integer ([[0-9a-f]+] or [[0-9A-F]+]).
+    - [x] or [X]: reads an unsigned hexadecimal integer ([[0-9a-fA-F]+]).
     - [o]: reads an unsigned octal integer ([[0-7]+]).
     - [s]: reads a string argument that spreads as much as possible, until the
       following bounding condition holds: {ul
@@ -277,20 +298,20 @@
          encountered,}
       {- the end-of-input has been reached.}}
       Hence, this conversion always succeeds: it returns an empty
-      string, if the bounding condition holds when the scan begins.
+      string if the bounding condition holds when the scan begins.
     - [S]: reads a delimited string argument (delimiters and special
-      escaped characters follow the lexical conventions of Caml).
+      escaped characters follow the lexical conventions of OCaml).
     - [c]: reads a single character. To test the current input character
       without reading it, specify a null field width, i.e. use
       specification [%0c]. Raise [Invalid_argument], if the field width
       specification is greater than 1.
     - [C]: reads a single delimited character (delimiters and special
-      escaped characters follow the lexical conventions of Caml).
+      escaped characters follow the lexical conventions of OCaml).
     - [f], [e], [E], [g], [G]: reads an optionally signed
       floating-point number in decimal notation, in the style [dddd.ddd
       e/E+-dd].
     - [F]: reads a floating point number according to the lexical
-      conventions of Caml (hence the decimal point is mandatory if the
+      conventions of OCaml (hence the decimal point is mandatory if the
       exponent part is not mentioned).
     - [B]: reads a boolean argument ([true] or [false]).
     - [b]: reads a boolean argument (for backward compatibility; do not use
@@ -313,41 +334,45 @@
       first character of the range (or just after the [^] in case of
       range negation); hence [\[\]\]] matches a [\]] character and
       [\[^\]\]] matches any character that is not [\]].
-    - [r]: user-defined reader. Takes the next [ri] formatted input function and
-      applies it to the scanning buffer [ib] to read the next argument. The
-      input function [ri] must therefore have type [Scanning.in_channel -> 'a] and
-      the argument read has type ['a].
-    - [\{ fmt %\}]: reads a format string argument.
-      The format string read must have the same type as the format string
-      specification [fmt].
-      For instance, ["%{ %i %}"] reads any format string that can read a value of
-      type [int]; hence, if [s] is the string ["fmt:\"number is %u\""], then
-      [Scanf.sscanf s "fmt: %{%i%}"] succeeds and returns the format string
-      ["number is %u"].
-    - [\( fmt %\)]: scanning format substitution.
-      Reads a format string and then goes on scanning with the format string
-      read, instead of using [fmt].
-      The format string read must have the same type as the format string
+      Use [%%] and [%\@] to include a [%] or a [\@] in a range.
+    - [r]: user-defined reader. Takes the next [ri] formatted input
+      function and applies it to the scanning buffer [ib] to read the
+      next argument. The input function [ri] must therefore have type
+      [Scanning.in_channel -> 'a] and the argument read has type ['a].
+    - [\{ fmt %\}]: reads a format string argument. The format string
+      read must have the same type as the format string specification
+      [fmt]. For instance, ["%{ %i %}"] reads any format string that
+      can read a value of type [int]; hence, if [s] is the string
+      ["fmt:\"number is %u\""], then [Scanf.sscanf s "fmt: %{%i%}"]
+      succeeds and returns the format string ["number is %u"].
+    - [\( fmt %\)]: scanning sub-format substitution.
+      Reads a format string [rf] in the input, then goes on scanning with
+      [rf] instead of scanning with [fmt].
+      The format string [rf] must have the same type as the format string
       specification [fmt] that it replaces.
       For instance, ["%( %i %)"] reads any format string that can read a value
       of type [int].
-      Returns the format string read, and the value read using the format
-      string read.
+      The conversion returns the format string read [rf], and then a value
+      read using [rf].
       Hence, if [s] is the string ["\"%4d\"1234.00"], then
       [Scanf.sscanf s "%(%i%)" (fun fmt i -> fmt, i)] evaluates to
       [("%4d", 1234)].
-      If the special flag [_] is used, the conversion discards the
-      format string read and only returns the value read with the format
-      string read.
-      Hence, if [s] is the string ["\"%4d\"1234.00"], then
-      [Scanf.sscanf s "%_(%i%)"] is simply equivalent to
-      [Scanf.sscanf "1234.00" "%4d"].
+
+      This behaviour is not mere format substitution, since the conversion
+      returns the format string read as additional argument. If you need
+      pure format substitution, use special flag [_] to discard the
+      extraneous argument: conversion [%_\( fmt %\)] reads a format string
+      [rf] and then behaves the same as format string [rf].  Hence, if [s] is
+      the string ["\"%4d\"1234.00"], then [Scanf.sscanf s "%_(%i%)"] is
+      simply equivalent to [Scanf.sscanf "1234.00" "%4d"].
+
     - [l]: returns the number of lines read so far.
     - [n]: returns the number of characters read so far.
     - [N] or [L]: returns the number of tokens read so far.
     - [!]: matches the end of input condition.
     - [%]: matches one [%] character in the input.
-    - [,]: the no-op delimiter for conversion specifications.
+    - [\@]: matches one [\@] character in the input.
+    - [,]: does nothing.
 
     Following the [%] character that introduces a conversion, there may be
     the special flag [_]: the conversion that follows occurs as usual,
@@ -358,7 +383,7 @@
     The field width is composed of an optional integer literal
     indicating the maximal width of the token to read.
     For instance, [%6d] reads an integer, having at most 6 decimal digits;
-    [%4f] reads a float with at most 4 characters; and [%8\[\\000-\\255\]]
+    [%4f] reads a float with at most 4 characters; and [%8[\\000-\\255]]
     returns the next 8 characters (or all the characters still available,
     if fewer than 8 characters are available in the input).
 
@@ -368,7 +393,7 @@
       nothing to read in the input: in this case, it simply returns [""].
 
     - in addition to the relevant digits, ['_'] characters may appear
-    inside numbers (this is reminiscent to the usual Caml lexical
+    inside numbers (this is reminiscent to the usual OCaml lexical
     conventions). If stricter scanning is desired, use the range
     conversion facility instead of the number conversions.
 
@@ -376,31 +401,36 @@
     analysis and parsing. If it appears not expressive enough for your
     needs, several alternative exists: regular expressions (module
     [Str]), stream parsers, [ocamllex]-generated lexers,
-    [ocamlyacc]-generated parsers. *)
+    [ocamlyacc]-generated parsers.
+*)
 
 (** {7:indication Scanning indications in format strings} *)
 
 (** Scanning indications appear just after the string conversions [%s]
-    and [%\[ range \]] to delimit the end of the token. A scanning
-    indication is introduced by a [@] character, followed by some
-    constant character [c]. It means that the string token should end
+    and [%[ range ]] to delimit the end of the token. A scanning
+    indication is introduced by a [\@] character, followed by some
+    plain character [c]. It means that the string token should end
     just before the next matching [c] (which is skipped). If no [c]
     character is encountered, the string token spreads as much as
     possible. For instance, ["%s@\t"] reads a string up to the next
-    tab character or to the end of input. If a scanning
-    indication [\@c] does not follow a string conversion, it is treated
-    as a plain [c] character.
+    tab character or to the end of input. If a [\@] character appears
+    anywhere else in the format string, it is treated as a plain character.
 
     Note:
 
-    - the scanning indications introduce slight differences in the syntax of
+    - As usual in format strings, [%] and [\@] characters must be escaped
+    using [%%] and [%\@]; this rule still holds within range specifications
+    and scanning indications.
+    For instance, ["%s@%%"] reads a string up to the next [%] character.
+    - The scanning indications introduce slight differences in the syntax of
     [Scanf] format strings, compared to those used for the [Printf]
     module. However, the scanning indications are similar to those used in
     the [Format] module; hence, when producing formatted text to be scanned
     by [!Scanf.bscanf], it is wise to use printing functions from the
     [Format] module (or, if you need to use functions from [Printf], banish
     or carefully double check the format strings that contain ['\@']
-    characters). *)
+    characters).
+*)
 
 (** {7 Exceptions during scanning} *)
 
@@ -420,7 +450,8 @@
 
     - as a consequence, scanning a [%s] conversion never raises exception
     [End_of_file]: if the end of input is reached the conversion succeeds and
-    simply returns the characters read so far, or [""] if none were ever read. *)
+    simply returns the characters read so far, or [""] if none were ever read.
+*)
 
 (** {6 Specialised formatted input functions} *)
 
@@ -435,14 +466,16 @@
     position, and so on).
 
     As a consequence, never mix direct low level reading and high level
-    scanning from the same regular input channel. *)
+    scanning from the same regular input channel.
+*)
 
 val sscanf : string -> ('a, 'b, 'c, 'd) scanner;;
 (** Same as {!Scanf.bscanf}, but reads from the given string. *)
 
 val scanf : ('a, 'b, 'c, 'd) scanner;;
 (** Same as {!Scanf.bscanf}, but reads from the predefined formatted input
-    channel {!Scanf.Scanning.stdin} that is connected to [Pervasives.stdin]. *)
+    channel {!Scanf.Scanning.stdin} that is connected to [Pervasives.stdin].
+*)
 
 val kscanf :
   Scanning.in_channel -> (Scanning.in_channel -> exn -> 'd) ->
@@ -451,7 +484,8 @@
     [ef] that is called in case of error: if the scanning process or
     some conversion fails, the scanning function aborts and calls the
     error handling function [ef] with the formatted input channel and the
-    exception that aborted the scanning process as arguments. *)
+    exception that aborted the scanning process as arguments.
+*)
 
 (** {6 Reading format strings from input} *)
 
@@ -482,3 +516,11 @@
     have the same type as [fmt].
     @since 3.10.0
 *)
+
+val unescaped : string -> string;;
+(** Return a copy of the argument with escape sequences, following the
+    lexical conventions of OCaml, replaced by their corresponding
+    special characters. If there is no escape sequence in the
+    argument, still return a copy, contrary to String.escaped.
+    @since 4.00.0
+*)
diff -Nru ocaml-3.12.1/stdlib/set.ml ocaml-4.01.0/stdlib/set.ml
--- ocaml-3.12.1/stdlib/set.ml	2004-11-25 00:06:06.000000000 +0000
+++ ocaml-4.01.0/stdlib/set.ml	2013-01-08 09:01:02.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: set.ml 6694 2004-11-25 00:06:06Z doligez $ *)
-
 (* Sets over ordered types *)
 
 module type OrderedType =
@@ -49,6 +47,7 @@
     val max_elt: t -> elt
     val choose: t -> elt
     val split: elt -> t -> t * bool * t
+    val find: elt -> t -> elt
   end
 
 module Make(Ord: OrderedType) =
@@ -117,13 +116,32 @@
           if c = 0 then t else
           if c < 0 then bal (add x l) v r else bal l v (add x r)
 
+    let singleton x = Node(Empty, x, Empty, 1)
+
+    (* Beware: those two functions assume that the added v is *strictly*
+       smaller (or bigger) than all the present elements in the tree; it
+       does not test for equality with the current min (or max) element.
+       Indeed, they are only used during the "join" operation which
+       respects this precondition.
+    *)
+
+    let rec add_min_element v = function
+      | Empty -> singleton v
+      | Node (l, x, r, h) ->
+        bal (add_min_element v l) x r
+
+    let rec add_max_element v = function
+      | Empty -> singleton v
+      | Node (l, x, r, h) ->
+        bal l x (add_max_element v r)
+
     (* Same as create and bal, but no assumptions are made on the
        relative heights of l and r. *)
 
     let rec join l v r =
       match (l, r) with
-        (Empty, _) -> add v r
-      | (_, Empty) -> add v l
+        (Empty, _) -> add_min_element v r
+      | (_, Empty) -> add_max_element v l
       | (Node(ll, lv, lr, lh), Node(rl, rv, rr, rh)) ->
           if lh > rh + 2 then bal ll lv (join lr v r) else
           if rh > lh + 2 then bal (join l v rl) rv rr else
@@ -197,8 +215,6 @@
           let c = Ord.compare x v in
           c = 0 || mem x (if c < 0 then l else r)
 
-    let singleton x = Node(Empty, x, Empty, 1)
-
     let rec remove x = function
         Empty -> Empty
       | Node(l, v, r, _) ->
@@ -300,19 +316,25 @@
         Empty -> false
       | Node(l, v, r, _) -> p v || exists p l || exists p r
 
-    let filter p s =
-      let rec filt accu = function
-        | Empty -> accu
-        | Node(l, v, r, _) ->
-            filt (filt (if p v then add v accu else accu) l) r in
-      filt Empty s
-
-    let partition p s =
-      let rec part (t, f as accu) = function
-        | Empty -> accu
-        | Node(l, v, r, _) ->
-            part (part (if p v then (add v t, f) else (t, add v f)) l) r in
-      part (Empty, Empty) s
+    let rec filter p = function
+        Empty -> Empty
+      | Node(l, v, r, _) ->
+          (* call [p] in the expected left-to-right order *)
+          let l' = filter p l in
+          let pv = p v in
+          let r' = filter p r in
+          if pv then join l' v r' else concat l' r'
+
+    let rec partition p = function
+        Empty -> (Empty, Empty)
+      | Node(l, v, r, _) ->
+          (* call [p] in the expected left-to-right order *)
+          let (lt, lf) = partition p l in
+          let pv = p v in
+          let (rt, rf) = partition p r in
+          if pv
+          then (join lt v rt, concat lf rf)
+          else (concat lt rt, join lf v rf)
 
     let rec cardinal = function
         Empty -> 0
@@ -327,4 +349,10 @@
 
     let choose = min_elt
 
+    let rec find x = function
+        Empty -> raise Not_found
+      | Node(l, v, r, _) ->
+          let c = Ord.compare x v in
+          if c = 0 then v
+          else find x (if c < 0 then l else r)
   end
diff -Nru ocaml-3.12.1/stdlib/set.mli ocaml-4.01.0/stdlib/set.mli
--- ocaml-3.12.1/stdlib/set.mli	2005-07-21 14:52:45.000000000 +0000
+++ ocaml-4.01.0/stdlib/set.mli	2013-02-26 12:46:09.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: set.mli 6974 2005-07-21 14:52:45Z doligez $ *)
-
 (** Sets over ordered types.
 
    This module implements the set data structure, given a total ordering
@@ -72,8 +70,8 @@
     val inter: t -> t -> t
     (** Set intersection. *)
 
-    (** Set difference. *)
     val diff: t -> t -> t
+    (** Set difference. *)
 
     val compare: t -> t -> int
     (** Total ordering between sets. Can be used as the ordering function
@@ -145,6 +143,12 @@
           strictly greater than [x];
           [present] is [false] if [s] contains no element equal to [x],
           or [true] if [s] contains an element equal to [x]. *)
+
+    val find: elt -> t -> elt
+    (** [find x s] returns the element of [s] equal to [x] (according
+        to [Ord.compare]), or raise [Not_found] if no such element
+        exists.
+        @since 4.01.0 *)
   end
 (** Output signature of the functor {!Set.Make}. *)
 
diff -Nru ocaml-3.12.1/stdlib/sort.ml ocaml-4.01.0/stdlib/sort.ml
--- ocaml-3.12.1/stdlib/sort.ml	2005-10-25 18:34:07.000000000 +0000
+++ ocaml-4.01.0/stdlib/sort.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: sort.ml 7164 2005-10-25 18:34:07Z doligez $ *)
-
 (* Merging and sorting *)
 
 open Array
diff -Nru ocaml-3.12.1/stdlib/sort.mli ocaml-4.01.0/stdlib/sort.mli
--- ocaml-3.12.1/stdlib/sort.mli	2005-10-25 18:34:07.000000000 +0000
+++ ocaml-4.01.0/stdlib/sort.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: sort.mli 7164 2005-10-25 18:34:07Z doligez $ *)
-
 (** Sorting and merging lists.
 
    @deprecated This module is obsolete and exists only for backward
diff -Nru ocaml-3.12.1/stdlib/stack.ml ocaml-4.01.0/stdlib/stack.ml
--- ocaml-3.12.1/stdlib/stack.ml	2002-06-27 08:48:26.000000000 +0000
+++ ocaml-4.01.0/stdlib/stack.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: stack.ml 4956 2002-06-27 08:48:26Z xleroy $ *)
-
 type 'a t = { mutable c : 'a list }
 
 exception Empty
diff -Nru ocaml-3.12.1/stdlib/stack.mli ocaml-4.01.0/stdlib/stack.mli
--- ocaml-3.12.1/stdlib/stack.mli	2005-10-25 18:34:07.000000000 +0000
+++ ocaml-4.01.0/stdlib/stack.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: stack.mli 7164 2005-10-25 18:34:07Z doligez $ *)
-
 (** Last-in first-out stacks.
 
    This module implements stacks (LIFOs), with in-place modification.
diff -Nru ocaml-3.12.1/stdlib/stdLabels.ml ocaml-4.01.0/stdlib/stdLabels.ml
--- ocaml-3.12.1/stdlib/stdLabels.ml	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/stdlib/stdLabels.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*               Jacques Garrigue, Kyoto University RIMS               *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: stdLabels.ml 4144 2001-12-07 13:41:02Z xleroy $ *)
-
 (* Module [StdLabels]: meta-module for labelled libraries *)
 
 module Array = ArrayLabels
diff -Nru ocaml-3.12.1/stdlib/stdLabels.mli ocaml-4.01.0/stdlib/stdLabels.mli
--- ocaml-3.12.1/stdlib/stdLabels.mli	2004-11-25 00:06:06.000000000 +0000
+++ ocaml-4.01.0/stdlib/stdLabels.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*               Jacques Garrigue, Kyoto University RIMS               *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: stdLabels.mli 6694 2004-11-25 00:06:06Z doligez $ *)
-
 (** Standard labeled libraries.
 
    This meta-module provides labelized version of the {!Array},
@@ -117,6 +115,9 @@
         unit
     val concat : sep:string -> string list -> string
     val iter : f:(char -> unit) -> string -> unit
+    val iteri : f:(int -> char -> unit) -> string -> unit
+    val map : f:(char -> char) -> string -> string
+    val trim : string -> string
     val escaped : string -> string
     val index : string -> char -> int
     val rindex : string -> char -> int
diff -Nru ocaml-3.12.1/stdlib/std_exit.ml ocaml-4.01.0/stdlib/std_exit.ml
--- ocaml-3.12.1/stdlib/std_exit.ml	2001-12-07 13:41:02.000000000 +0000
+++ ocaml-4.01.0/stdlib/std_exit.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: std_exit.ml 4144 2001-12-07 13:41:02Z xleroy $ *)
-
 (* Ensure that [at_exit] functions are called at the end of every program *)
 
 let _ = do_at_exit()
diff -Nru ocaml-3.12.1/stdlib/stdlib.mllib ocaml-4.01.0/stdlib/stdlib.mllib
--- ocaml-3.12.1/stdlib/stdlib.mllib	2010-01-20 16:26:46.000000000 +0000
+++ ocaml-4.01.0/stdlib/stdlib.mllib	2012-10-15 17:50:56.000000000 +0000
@@ -1,7 +1,6 @@
 # This file lists all standard library modules
 # (in the same order as Makefile.shared).
 # It is used in particular to know what to expunge in toplevels.
-# $Id: stdlib.mllib 9540 2010-01-20 16:26:46Z doligez $
 
 Pervasives
 Array
diff -Nru ocaml-3.12.1/stdlib/stream.ml ocaml-4.01.0/stdlib/stream.ml
--- ocaml-3.12.1/stdlib/stream.ml	2008-06-18 15:35:02.000000000 +0000
+++ ocaml-4.01.0/stdlib/stream.ml	2013-07-21 20:12:39.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                             Ocaml                                   *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*        Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: stream.ml 8893 2008-06-18 15:35:02Z mauny $ *)
-
 (* The fields of type t are not mutable to preserve polymorphism of
    the empty stream. This is type safe because the empty stream is never
    patched. *)
@@ -147,7 +145,18 @@
 ;;
 
 let of_string s =
-  from (fun c -> if c < String.length s then Some s.[c] else None)
+  let count = ref 0 in
+  from (fun _ ->
+    (* We cannot use the index passed by the [from] function directly
+       because it returns the current stream count, with absolutely no
+       guarantee that it will start from 0. For example, in the case
+       of [Stream.icons 'c' (Stream.from_string "ab")], the first
+       access to the string will be made with count [1] already.
+    *)
+    let c = !count in
+    if c < String.length s
+    then (incr count; Some s.[c])
+    else None)
 ;;
 
 let of_channel ic =
diff -Nru ocaml-3.12.1/stdlib/stream.mli ocaml-4.01.0/stdlib/stream.mli
--- ocaml-3.12.1/stdlib/stream.mli	2005-10-25 18:34:07.000000000 +0000
+++ ocaml-4.01.0/stdlib/stream.mli	2013-07-21 20:12:39.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                             Ocaml                                   *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*        Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: stream.mli 7164 2005-10-25 18:34:07Z doligez $ *)
-
 (** Streams and parsers. *)
 
 type 'a t
@@ -27,19 +25,19 @@
    accepted, but one of the following components is rejected. *)
 
 
-(** {6 Stream builders}
-
-   Warning: these functions create streams with fast access; it is illegal
-   to mix them with streams built with [[< >]]; would raise [Failure]
-   when accessing such mixed streams.
-*)
+(** {6 Stream builders} *)
 
 val from : (int -> 'a option) -> 'a t
 (** [Stream.from f] returns a stream built from the function [f].
    To create a new stream element, the function [f] is called with
    the current stream count. The user function [f] must return either
    [Some ] for a value or [None] to specify the end of the
-   stream. *)
+   stream.
+
+   Do note that the indices passed to [f] may not start at [0] in the
+   general case. For example, [[< '0; '1; Stream.from f >]] would call
+   [f] the first time with count [2].
+*)
 
 val of_list : 'a list -> 'a t
 (** Return the stream holding the elements of the list in the same
@@ -90,7 +88,7 @@
 
 (**/**)
 
-(** {6 For system use only, not for the casual user} *)
+(* The following is for system use only. Do not call directly. *)
 
 val iapp : 'a t -> 'a t -> 'a t
 val icons : 'a -> 'a t -> 'a t
diff -Nru ocaml-3.12.1/stdlib/string.ml ocaml-4.01.0/stdlib/string.ml
--- ocaml-3.12.1/stdlib/string.ml	2011-05-16 15:00:33.000000000 +0000
+++ ocaml-4.01.0/stdlib/string.ml	2013-06-05 17:54:20.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: string.ml 11043 2011-05-16 15:00:33Z doligez $ *)
-
 (* String operations *)
 
 external length : string -> int = "%string_length"
@@ -60,6 +58,9 @@
 let iter f a =
   for i = 0 to length a - 1 do f(unsafe_get a i) done
 
+let iteri f a =
+  for i = 0 to length a - 1 do f i (unsafe_get a i) done
+
 let concat sep l =
   match l with
     [] -> ""
@@ -82,6 +83,27 @@
 external char_code: char -> int = "%identity"
 external char_chr: int -> char = "%identity"
 
+let is_space = function
+  | ' ' | '\012' | '\n' | '\r' | '\t' -> true
+  | _ -> false
+
+let trim s =
+  let len = length s in
+  let i = ref 0 in
+  while !i < len && is_space (unsafe_get s !i) do
+    incr i
+  done;
+  let j = ref (len - 1) in
+  while !j >= !i && is_space (unsafe_get s !j) do
+    decr j
+  done;
+  if !i = 0 && !j = len - 1 then
+    s
+  else if !j >= !i then
+    sub s !i (!j - !i + 1)
+  else
+    ""
+
 let escaped s =
   let n = ref 0 in
     for i = 0 to length s - 1 do
diff -Nru ocaml-3.12.1/stdlib/string.mli ocaml-4.01.0/stdlib/string.mli
--- ocaml-3.12.1/stdlib/string.mli	2008-12-03 18:09:09.000000000 +0000
+++ ocaml-4.01.0/stdlib/string.mli	2013-06-05 17:54:20.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,9 +11,8 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: string.mli 9153 2008-12-03 18:09:09Z doligez $ *)
-
 (** String operations.
+
   Given a string [s] of length [l], we call character number in [s]
   the index of a character in [s].  Indexes start at [0], and we will
   call a character number valid in [s] if it falls within the range
@@ -25,6 +24,31 @@
   Two parameters [start] and [len] are said to designate a valid
   substring of [s] if [len >= 0] and [start] and [start+len] are
   valid positions in [s].
+
+  OCaml strings can be modified in place, for instance via the
+  {!String.set} and {!String.blit} functions described below.  This
+  possibility should be used rarely and with much care, however, since
+  both the OCaml compiler and most OCaml libraries share strings as if
+  they were immutable, rather than copying them.  In particular,
+  string literals are shared: a single copy of the string is created
+  at program loading time and returned by all evaluations of the
+  string literal.  Consider for example:
+
+  {[
+      # let f () = "foo";;
+      val f : unit -> string = 
+      # (f ()).[0] <- 'b';;
+      - : unit = ()
+      # f ();;
+      - : string = "boo"
+  ]}
+
+  Likewise, many functions from the standard library can return string
+  literals or one of their string arguments.  Therefore, the returned strings
+  must not be modified directly.  If mutation is absolutely necessary,
+  it should be performed on a fresh copy of the string, as produced by
+  {!String.copy}.
+
  *)
 
 external length : string -> int = "%string_length"
@@ -94,12 +118,33 @@
    the characters of [s].  It is equivalent to
    [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. *)
 
+val iteri : (int -> char -> unit) -> string -> unit
+(** Same as {!String.iter}, but the
+   function is applied to the index of the element as first argument
+   (counting from 0), and the character itself as second argument.
+   @since 4.00.0
+*)
+
+val map : (char -> char) -> string -> string
+(** [String.map f s] applies function [f] in turn to all
+   the characters of [s] and stores the results in a new string that
+   is returned.
+   @since 4.00.0 *)
+
+val trim : string -> string
+(** Return a copy of the argument, without leading and trailing
+   whitespace.  The characters regarded as whitespace are: [' '],
+   ['\012'], ['\n'], ['\r'], and ['\t'].  If there is no leading nor
+   trailing whitespace character in the argument, return the original
+   string itself, not a copy.
+   @since 4.00.0 *)
+
 val escaped : string -> string
 (** Return a copy of the argument, with special characters
    represented by escape sequences, following the lexical
-   conventions of Objective Caml.  If there is no special
+   conventions of OCaml.  If there is no special
    character in the argument, return the original string itself,
-   not a copy. *)
+   not a copy. Its inverse function is Scanf.unescaped. *)
 
 val index : string -> char -> int
 (** [String.index s c] returns the character number of the first
@@ -176,6 +221,8 @@
 
 (**/**)
 
+(* The following is for system use only. Do not call directly. *)
+
 external unsafe_get : string -> int -> char = "%string_unsafe_get"
 external unsafe_set : string -> int -> char -> unit = "%string_unsafe_set"
 external unsafe_blit :
diff -Nru ocaml-3.12.1/stdlib/stringLabels.ml ocaml-4.01.0/stdlib/stringLabels.ml
--- ocaml-3.12.1/stdlib/stringLabels.ml	2004-01-03 22:08:38.000000000 +0000
+++ ocaml-4.01.0/stdlib/stringLabels.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*               Jacques Garrigue, Kyoto University RIMS               *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: stringLabels.ml 6054 2004-01-03 22:08:38Z doligez $ *)
-
 (* Module [StringLabels]: labelled String module *)
 
 include String
diff -Nru ocaml-3.12.1/stdlib/stringLabels.mli ocaml-4.01.0/stdlib/stringLabels.mli
--- ocaml-3.12.1/stdlib/stringLabels.mli	2007-01-22 08:06:09.000000000 +0000
+++ ocaml-4.01.0/stdlib/stringLabels.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: stringLabels.mli 7805 2007-01-22 08:06:09Z garrigue $ *)
-
 (** String operations. *)
 
 external length : string -> int = "%string_length"
@@ -84,10 +82,30 @@
    the characters of [s].  It is equivalent to
    [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. *)
 
+val iteri : f:(int -> char -> unit) -> string -> unit
+(** Same as {!String.iter}, but the
+   function is applied to the index of the element as first argument
+   (counting from 0), and the character itself as second argument.
+   @since 4.00.0
+*)
+
+val map : f:(char -> char) -> string -> string
+(** [String.map f s] applies function [f] in turn to all
+   the characters of [s] and stores the results in a new string that
+   is returned.
+   @since 4.00.0 *)
+
+val trim : string -> string
+(** Return a copy of the argument, without leading and trailing whitespace.
+   The characters regarded as whitespace are: [' '], ['\012'], ['\n'],
+   ['\r'], and ['\t'].  If there is no whitespace character in the argument,
+   return the original string itself, not a copy.
+   @since 4.00.0 *)
+
 val escaped : string -> string
 (** Return a copy of the argument, with special characters
    represented by escape sequences, following the lexical
-   conventions of Objective Caml.  If there is no special
+   conventions of OCaml.  If there is no special
    character in the argument, return the original string itself,
    not a copy. *)
 
@@ -155,6 +173,8 @@
 
 (**/**)
 
+(* The following is for system use only. Do not call directly. *)
+
 external unsafe_get : string -> int -> char = "%string_unsafe_get"
 external unsafe_set : string -> int -> char -> unit = "%string_unsafe_set"
 external unsafe_blit :
diff -Nru ocaml-3.12.1/stdlib/sys.mli ocaml-4.01.0/stdlib/sys.mli
--- ocaml-3.12.1/stdlib/sys.mli	2010-10-12 09:55:46.000000000 +0000
+++ ocaml-4.01.0/stdlib/sys.mli	2013-01-08 13:23:49.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: sys.mli 10715 2010-10-12 09:55:46Z doligez $ *)
-
 (** System interface. *)
 
 val argv : string array
@@ -75,15 +73,31 @@
    the interactive toplevel system [ocaml]. *)
 
 val os_type : string
-(** Operating system currently executing the Caml program. One of
+(** Operating system currently executing the OCaml program. One of
 -  ["Unix"] (for all Unix versions, including Linux and Mac OS X),
 -  ["Win32"] (for MS-Windows, OCaml compiled with MSVC++ or Mingw),
 -  ["Cygwin"] (for MS-Windows, OCaml compiled with Cygwin). *)
 
+val unix : bool
+(** True if [Sys.os_type = "Unix"].
+    @since 4.01.0 *)
+
+val win32 : bool
+(** True if [Sys.os_type = "Win32"].
+    @since 4.01.0 *)
+
+val cygwin : bool
+(** True if [Sys.os_type = "Cygwin"].
+    @since 4.01.0 *)
+
 val word_size : int
-(** Size of one word on the machine currently executing the Caml
+(** Size of one word on the machine currently executing the OCaml
    program, in bits: 32 or 64. *)
 
+val big_endian : bool
+(** Whether the machine currently executing the Caml program is big-endian.
+    @since 4.00.0 *)
+
 val max_string_length : int
 (** Maximum length of a string. *)
 
@@ -99,7 +113,7 @@
 type signal_behavior =
     Signal_default
   | Signal_ignore
-  | Signal_handle of (int -> unit)
+  | Signal_handle of (int -> unit)   (** *)
 (** What to do when receiving a signal:
    - [Signal_default]: take the default behavior
      (usually: abort the program)
@@ -199,7 +213,7 @@
 
 
 val ocaml_version : string;;
-(** [ocaml_version] is the version of Objective Caml.
+(** [ocaml_version] is the version of OCaml.
     It is a string of the form ["major.minor[.patchlevel][+additional-info]"],
     where [major], [minor], and [patchlevel] are integers, and
     [additional-info] is an arbitrary string. The [[.patchlevel]] and
diff -Nru ocaml-3.12.1/stdlib/sys.mlp ocaml-4.01.0/stdlib/sys.mlp
--- ocaml-3.12.1/stdlib/sys.mlp	2007-02-26 14:21:57.000000000 +0000
+++ ocaml-4.01.0/stdlib/sys.mlp	2012-11-29 09:55:00.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -11,19 +11,27 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: sys.mlp 7927 2007-02-26 14:21:57Z xleroy $ *)
-
 (* WARNING: sys.ml is generated from sys.mlp.  DO NOT EDIT sys.ml or
    your changes will be lost.
 *)
 
 (* System interface *)
 
-external get_config: unit -> string * int = "caml_sys_get_config"
+external get_config: unit -> string * int * bool = "caml_sys_get_config"
 external get_argv: unit -> string * string array = "caml_sys_get_argv"
+external big_endian : unit -> bool = "%big_endian"
+external word_size : unit -> int = "%word_size"
+external unix : unit -> bool = "%ostype_unix"
+external win32 : unit -> bool = "%ostype_win32"
+external cygwin : unit -> bool = "%ostype_cygwin"
 
 let (executable_name, argv) = get_argv()
-let (os_type, word_size) = get_config()
+let (os_type, _, _) = get_config()
+let big_endian = big_endian ()
+let word_size = word_size ()
+let unix = unix ()
+let win32 = win32 ()
+let cygwin = cygwin ()
 let max_array_length = (1 lsl (word_size - 10)) - 1;;
 let max_string_length = word_size / 8 * max_array_length - 1;;
 
diff -Nru ocaml-3.12.1/stdlib/weak.ml ocaml-4.01.0/stdlib/weak.ml
--- ocaml-3.12.1/stdlib/weak.ml	2008-02-29 14:21:22.000000000 +0000
+++ ocaml-4.01.0/stdlib/weak.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Damien Doligez, projet Para, INRIA Rocquencourt          *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: weak.ml 8823 2008-02-29 14:21:22Z doligez $ *)
-
 (** Weak array operations *)
 
 type 'a t;;
@@ -209,7 +207,7 @@
         t.hashes.(index) <- newhashes;
         if sz <= t.limit && newsz > t.limit then begin
           t.oversize <- t.oversize + 1;
-          for i = 0 to over_limit do test_shrink_bucket t done;
+          for _i = 0 to over_limit do test_shrink_bucket t done;
         end;
         if t.oversize > Array.length t.table / over_limit then resize t;
       end else if check bucket i then begin
diff -Nru ocaml-3.12.1/stdlib/weak.mli ocaml-4.01.0/stdlib/weak.mli
--- ocaml-3.12.1/stdlib/weak.mli	2008-12-03 18:09:09.000000000 +0000
+++ ocaml-4.01.0/stdlib/weak.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Damien Doligez, projet Para, INRIA Rocquencourt          *)
 (*                                                                     *)
@@ -11,8 +11,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: weak.mli 9153 2008-12-03 18:09:09Z doligez $ *)
-
 (** Arrays of weak pointers and hash tables of weak pointers. *)
 
 
diff -Nru ocaml-3.12.1/testlabl/.cvsignore ocaml-4.01.0/testlabl/.cvsignore
--- ocaml-3.12.1/testlabl/.cvsignore	2002-02-16 14:46:24.000000000 +0000
+++ ocaml-4.01.0/testlabl/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1 +0,0 @@
-*.out *.out2
\ No newline at end of file
diff -Nru ocaml-3.12.1/testlabl/coerce.diffs ocaml-4.01.0/testlabl/coerce.diffs
--- ocaml-3.12.1/testlabl/coerce.diffs	2006-05-17 23:49:04.000000000 +0000
+++ ocaml-4.01.0/testlabl/coerce.diffs	1970-01-01 00:00:00.000000000 +0000
@@ -1,93 +0,0 @@
-Index: typing/ctype.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/ctype.ml,v
-retrieving revision 1.201
-diff -u -r1.201 ctype.ml
---- typing/ctype.ml	5 Apr 2006 02:28:13 -0000	1.201
-+++ typing/ctype.ml	17 May 2006 23:48:22 -0000
-@@ -490,6 +490,31 @@
-     unmark_class_signature sign;
-     Some reason
- 
-+(* Variant for checking principality *)
-+
-+let rec free_nodes_rec ty =
-+  let ty = repr ty in
-+  if ty.level >= lowest_level then begin
-+    if ty.level <= !current_level then raise Exit;
-+    ty.level <- pivot_level - ty.level;
-+    begin match ty.desc with
-+      Tvar ->
-+        raise Exit
-+    | Tobject (ty, _) ->
-+        free_nodes_rec ty
-+    | Tfield (_, _, ty1, ty2) ->
-+        free_nodes_rec ty1; free_nodes_rec ty2
-+    | Tvariant row ->
-+        let row = row_repr row in
-+        iter_row free_nodes_rec {row with row_bound = []};
-+        if not (static_row row) then free_nodes_rec row.row_more
-+    | _    ->
-+        iter_type_expr free_nodes_rec ty
-+    end;
-+  end
-+
-+let has_free_nodes ty =
-+  try free_nodes_rec ty; false with Exit -> true
- 
-                             (**********************)
-                             (*  Type duplication  *)
-Index: typing/ctype.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/ctype.mli,v
-retrieving revision 1.54
-diff -u -r1.54 ctype.mli
---- typing/ctype.mli	5 Apr 2006 02:28:13 -0000	1.54
-+++ typing/ctype.mli	17 May 2006 23:48:22 -0000
-@@ -228,6 +228,9 @@
- val closed_class:
-         type_expr list -> class_signature -> closed_class_failure option
-         (* Check whether all type variables are bound *)
-+val has_free_nodes: type_expr -> bool
-+        (* Check whether there are free type variables, or nodes with
-+           level lower or equal to !current_level *)
- 
- val unalias: type_expr -> type_expr
- val signature_of_class_type: class_type -> class_signature
-Index: typing/typecore.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typecore.ml,v
-retrieving revision 1.181
-diff -u -r1.181 typecore.ml
---- typing/typecore.ml	16 Apr 2006 23:28:22 -0000	1.181
-+++ typing/typecore.ml	17 May 2006 23:48:22 -0000
-@@ -1183,12 +1183,29 @@
-             let (ty', force) =
-               Typetexp.transl_simple_type_delayed env sty'
-             in
-+            if !Clflags.principal then begin_def ();
-             let arg = type_exp env sarg in
-+            let has_fv =
-+              if !Clflags.principal then begin
-+                end_def ();
-+                let b = has_free_nodes arg.exp_type in
-+                Ctype.unify env arg.exp_type (newvar ());
-+                b
-+              end else
-+                free_variables arg.exp_type <> []
-+            in
-             begin match arg.exp_desc, !self_coercion, (repr ty').desc with
-               Texp_ident(_, {val_kind=Val_self _}), (path,r) :: _,
-               Tconstr(path',_,_) when Path.same path path' ->
-                 r := sexp.pexp_loc :: !r;
-                 force ()
-+            | _ when not has_fv ->
-+                begin try
-+                  let force' = subtype env arg.exp_type ty' in
-+                  force (); force' ()
-+                with Subtype (tr1, tr2) ->
-+                  raise(Error(sexp.pexp_loc, Not_subtype(tr1, tr2)))
-+                end
-             | _ ->
-                 let ty, b = enlarge_type env ty' in
-                 force ();
diff -Nru ocaml-3.12.1/testlabl/dirs_multimatch ocaml-4.01.0/testlabl/dirs_multimatch
--- ocaml-3.12.1/testlabl/dirs_multimatch	2002-11-08 07:13:53.000000000 +0000
+++ ocaml-4.01.0/testlabl/dirs_multimatch	1970-01-01 00:00:00.000000000 +0000
@@ -1 +0,0 @@
-parsing typing bytecomp driver toplevel
\ No newline at end of file
diff -Nru ocaml-3.12.1/testlabl/dirs_poly ocaml-4.01.0/testlabl/dirs_poly
--- ocaml-3.12.1/testlabl/dirs_poly	2002-04-18 03:43:06.000000000 +0000
+++ ocaml-4.01.0/testlabl/dirs_poly	1970-01-01 00:00:00.000000000 +0000
@@ -1 +0,0 @@
-bytecomp byterun driver parsing stdlib tools toplevel typing utils otherlibs/labltk/browser/searchpos.ml
diff -Nru ocaml-3.12.1/testlabl/els.ml ocaml-4.01.0/testlabl/els.ml
--- ocaml-3.12.1/testlabl/els.ml	2010-04-17 14:45:12.000000000 +0000
+++ ocaml-4.01.0/testlabl/els.ml	1970-01-01 00:00:00.000000000 +0000
@@ -1,92 +0,0 @@
-(* Adapted from: An Expressive Language of Signatures
-   by Norman Ramsey, Kathleen Fisher and Paul Govereau *)
-
-module type VALUE = sig
-  type value (* a Lua value *)
-  type state (* the state of a Lua interpreter *)
-  type usert (* a user-defined value *)
-end
-
-module type CORE0 = sig
-  module V : VALUE
-  val setglobal : V.state -> string -> V.value -> unit
-  (* five more functions common to core and evaluator *)
-end
-
-module type CORE = sig
-  include CORE0
-  val apply : V.value -> V.state -> V.value list -> V.value
-  (* apply function f in state s to list of args *)
-end
-
-module type AST = sig
-  module Value : VALUE
-  type chunk
-  type program
-  val get_value : chunk -> Value.value
-end
-
-module type EVALUATOR = sig
-  module Value : VALUE
-  module Ast : (AST with module Value := Value)
-  type state = Value.state
-  type value = Value.value
-  exception Error of string
-  val compile : Ast.program -> string
-  include CORE0 with module V := Value
-end
-
-module type PARSER = sig
-  type chunk
-  val parse : string -> chunk
-end
-
-module type INTERP = sig
-  include EVALUATOR
-  module Parser : PARSER with type chunk = Ast.chunk
-  val dostring : state -> string -> value list
-  val mk	: unit -> state
-end
-
-module type USERTYPE = sig
-  type t
-  val eq	: t -> t -> bool
-  val to_string : t -> string
-end
-
-module type TYPEVIEW = sig
-  type combined
-  type t
-  val map : (combined -> t) * (t -> combined)
-end
-
-module type COMBINED_COMMON = sig
-  module T : sig type t end
-  module TV1 : TYPEVIEW with type combined := T.t
-  module TV2 : TYPEVIEW with type combined := T.t
-end
-
-module type COMBINED_TYPE = sig
-  module T : USERTYPE
-  include COMBINED_COMMON with module T := T
-end
-
-module type BARECODE = sig
-  type state
-  val init : state -> unit
-end
-
-module USERCODE(X : TYPEVIEW) = struct
-  module type F =
-      functor (C : CORE with type V.usert = X.combined) ->
-        BARECODE with type state := C.V.state
-end
-
-module Weapon = struct type t end
-
-module type WEAPON_LIB = sig
-  type t = Weapon.t
-  module T : USERTYPE with type t = t
-  module Make :
-    functor (TV : TYPEVIEW with type t = t) -> USERCODE(TV).F
-end
diff -Nru ocaml-3.12.1/testlabl/fixedtypes.ml ocaml-4.01.0/testlabl/fixedtypes.ml
--- ocaml-3.12.1/testlabl/fixedtypes.ml	2005-08-16 01:11:02.000000000 +0000
+++ ocaml-4.01.0/testlabl/fixedtypes.ml	1970-01-01 00:00:00.000000000 +0000
@@ -1,77 +0,0 @@
-(* cvs update -r fixedtypes parsing typing *)
-
-(* recursive types *)
-class c = object (self) method m = 1 method s = self end
-module type S = sig type t = private #c end;;
-
-module M : S = struct type t = c end
-module type S' = S with type t = c;;
-
-class d = object inherit c method n = 2 end
-module type S2 = S with type t = private #d;;
-module M2 : S = struct type t = d end;;
-module M3 : S = struct type t = private #d end;;
-
-module T1 = struct
-  type ('a,'b) a = [`A of 'a | `B of 'b]
-  type ('a,'b) b = [`Z | ('a,'b) a]
-end
-module type T2 = sig
-  type a and b
-  val evala : a -> int
-  val evalb : b -> int
-end
-module type T3 = sig
-  type a0 = private [> (a0,b0) T1.a]
-  and b0 = private [> (a0,b0) T1.b]
-end
-module type T4 = sig
-  include T3
-  include T2 with type a = a0 and type b = b0
-end
-module F(X:T4) = struct
-  type a = X.a and b = X.b
-  let a = X.evala (`B `Z)
-  let b = X.evalb (`A(`B `Z))
-  let a2b (x : a) : b = `A x
-  let b2a (x : b) : a = `B x
-end
-module M4 = struct
-  type a = [`A of a | `B of b | `ZA]
-  and b = [`A of a | `B of b | `Z]
-  type a0 = a
-  type b0 = b
-  let rec eval0 = function
-      `A a -> evala a
-    | `B b -> evalb b
-  and evala : a -> int = function
-      #T1.a as x -> 1 + eval0 x
-    | `ZA -> 3
-  and evalb : b -> int = function
-      #T1.a as x -> 1 + eval0 x
-    | `Z -> 7
-end
-module M5 = F(M4)
-
-module M6 : sig
-  class ci : int ->
-    object
-      val x : int
-      method x : int
-      method move : int -> unit
-    end      
-  type c = private #ci
-  val create : int -> c
-end = struct
-  class ci x = object
-    val mutable x : int = x
-    method x = x
-    method move d = x <- x+d
-  end
-  type c = ci
-  let create = new ci
-end
-let f (x : M6.c) = x#move 3; x#x;;
-
-module M : sig type t = private [> `A of bool] end =
-  struct type t = [`A of int] end
diff -Nru ocaml-3.12.1/testlabl/marshal_objects.diffs ocaml-4.01.0/testlabl/marshal_objects.diffs
--- ocaml-3.12.1/testlabl/marshal_objects.diffs	2006-02-02 23:54:20.000000000 +0000
+++ ocaml-4.01.0/testlabl/marshal_objects.diffs	1970-01-01 00:00:00.000000000 +0000
@@ -1,800 +0,0 @@
-? bytecomp/alpha_eq.ml
-Index: bytecomp/lambda.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/lambda.ml,v
-retrieving revision 1.44
-diff -u -r1.44 lambda.ml
---- bytecomp/lambda.ml	25 Aug 2005 15:35:16 -0000	1.44
-+++ bytecomp/lambda.ml	2 Feb 2006 05:08:56 -0000
-@@ -287,9 +287,10 @@
-     let compare = compare
-   end)
- 
--let free_ids get l =
-+let free_ids get used l =
-   let fv = ref IdentSet.empty in
-   let rec free l =
-+    let old = !fv in
-     iter free l;
-     fv := List.fold_right IdentSet.add (get l) !fv;
-     match l with
-@@ -307,17 +308,20 @@
-         fv := IdentSet.remove v !fv
-     | Lassign(id, e) ->
-         fv := IdentSet.add id !fv
-+    | Lifused(id, e) ->
-+        if used && not (IdentSet.mem id old) then fv := IdentSet.remove id !fv
-     | Lvar _ | Lconst _ | Lapply _
-     | Lprim _ | Lswitch _ | Lstaticraise _
-     | Lifthenelse _ | Lsequence _ | Lwhile _
--    | Lsend _ | Levent _ | Lifused _ -> ()
-+    | Lsend _ | Levent _ -> ()
-   in free l; !fv
- 
--let free_variables l =
--  free_ids (function Lvar id -> [id] | _ -> []) l
-+let free_variables ?(ifused=false) l =
-+  free_ids (function Lvar id -> [id] | _ -> []) ifused l
- 
- let free_methods l =
--  free_ids (function Lsend(Self, Lvar meth, obj, _) -> [meth] | _ -> []) l
-+  free_ids (function Lsend(Self, Lvar meth, obj, _) -> [meth] | _ -> [])
-+    false l
- 
- (* Check if an action has a "when" guard *)
- let raise_count = ref 0
-Index: bytecomp/lambda.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/lambda.mli,v
-retrieving revision 1.42
-diff -u -r1.42 lambda.mli
---- bytecomp/lambda.mli	25 Aug 2005 15:35:16 -0000	1.42
-+++ bytecomp/lambda.mli	2 Feb 2006 05:08:56 -0000
-@@ -177,7 +177,7 @@
- 
- val iter: (lambda -> unit) -> lambda -> unit
- module IdentSet: Set.S with type elt = Ident.t
--val free_variables: lambda -> IdentSet.t
-+val free_variables: ?ifused:bool -> lambda -> IdentSet.t
- val free_methods: lambda -> IdentSet.t
- 
- val transl_path: Path.t -> lambda
-Index: bytecomp/translclass.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/translclass.ml,v
-retrieving revision 1.38
-diff -u -r1.38 translclass.ml
---- bytecomp/translclass.ml	13 Aug 2005 20:59:37 -0000	1.38
-+++ bytecomp/translclass.ml	2 Feb 2006 05:08:56 -0000
-@@ -46,6 +46,10 @@
- 
- let lfield v i = Lprim(Pfield i, [Lvar v])
- 
-+let ltuple l = Lprim(Pmakeblock(0,Immutable), l)
-+
-+let lprim name args = Lapply(oo_prim name, args)
-+
- let transl_label l = share (Const_immstring l)
- 
- let rec transl_meth_list lst =
-@@ -68,8 +72,8 @@
-                                                     Lvar offset])])]))
- 
- let transl_val tbl create name =
--  Lapply (oo_prim (if create then "new_variable" else "get_variable"),
--          [Lvar tbl; transl_label name])
-+  lprim (if create then "new_variable" else "get_variable")
-+    [Lvar tbl; transl_label name]
- 
- let transl_vals tbl create vals rem =
-   List.fold_right
-@@ -82,7 +86,7 @@
-     (fun (nm, id) rem ->
-        try
-          (nm, id,
--          Lapply(oo_prim "get_method", [Lvar tbl; Lvar (Meths.find nm meths)]))
-+          lprim "get_method" [Lvar tbl; Lvar (Meths.find nm meths)])
-          :: rem
-        with Not_found -> rem)
-     inh_meths []
-@@ -97,17 +101,15 @@
-   let (inh_init, obj_init, has_init) = init obj' in
-   if obj_init = lambda_unit then
-     (inh_init,
--     Lapply (oo_prim (if has_init then "create_object_and_run_initializers"
--                      else"create_object_opt"),
--             [obj; Lvar cl]))
-+     lprim (if has_init then "create_object_and_run_initializers"
-+            else"create_object_opt")
-+       [obj; Lvar cl])
-   else begin
-    (inh_init,
--    Llet(Strict, obj',
--            Lapply (oo_prim "create_object_opt", [obj; Lvar cl]),
-+    Llet(Strict, obj', lprim "create_object_opt" [obj; Lvar cl],
-          Lsequence(obj_init,
-                    if not has_init then Lvar obj' else
--                   Lapply (oo_prim "run_initializers_opt",
--			   [obj; Lvar obj'; Lvar cl]))))
-+                   lprim "run_initializers_opt" [obj; Lvar obj'; Lvar cl])))
-   end
- 
- let rec build_object_init cl_table obj params inh_init obj_init cl =
-@@ -203,14 +205,13 @@
- 
- 
- let bind_method tbl lab id cl_init =
--  Llet(StrictOpt, id, Lapply (oo_prim "get_method_label",
--                              [Lvar tbl; transl_label lab]),
-+  Llet(StrictOpt, id, lprim "get_method_label" [Lvar tbl; transl_label lab],
-        cl_init)
- 
--let bind_methods tbl meths vals cl_init =
--  let methl = Meths.fold (fun lab id tl -> (lab,id) :: tl) meths [] in
-+let bind_methods tbl methl vals cl_init =
-   let len = List.length methl and nvals = List.length vals in
--  if len < 2 && nvals = 0 then Meths.fold (bind_method tbl) meths cl_init else
-+  if len < 2 && nvals = 0 then
-+    List.fold_right (fun (n,i) -> bind_method tbl n i) methl cl_init else
-   if len = 0 && nvals < 2 then transl_vals tbl true vals cl_init else
-   let ids = Ident.create "ids" in
-   let i = ref len in
-@@ -229,21 +230,19 @@
- 	       vals' cl_init)
-   in
-   Llet(StrictOpt, ids,
--       Lapply (oo_prim getter,
--               [Lvar tbl; transl_meth_list (List.map fst methl)] @ names),
-+       lprim getter
-+         ([Lvar tbl; transl_meth_list (List.map fst methl)] @ names),
-        List.fold_right
--         (fun (lab,id) lam -> decr i; Llet(StrictOpt, id, lfield ids !i, lam))
-+         (fun (lab,id) lam -> decr i; Llet(Alias, id, lfield ids !i, lam))
-          methl cl_init)
- 
- let output_methods tbl methods lam =
-   match methods with
-     [] -> lam
-   | [lab; code] ->
--      lsequence (Lapply(oo_prim "set_method", [Lvar tbl; lab; code])) lam
-+      lsequence (lprim "set_method" [Lvar tbl; lab; code]) lam
-   | _ ->
--      lsequence (Lapply(oo_prim "set_methods",
--                        [Lvar tbl; Lprim(Pmakeblock(0,Immutable), methods)]))
--        lam
-+      lsequence (lprim "set_methods" [Lvar tbl; ltuple methods]) lam
- 
- let rec ignore_cstrs cl =
-   match cl.cl_desc with
-@@ -266,7 +265,8 @@
-            Llet (Strict, obj_init, 
-                  Lapply(Lprim(Pfield 1, [lpath]), Lvar cla ::
- 			if top then [Lprim(Pfield 3, [lpath])] else []),
--                 bind_super cla super cl_init))
-+                 bind_super cla super cl_init),
-+           [], [])
-       | _ ->
-           assert false
-       end
-@@ -278,10 +278,11 @@
-             match field with
-               Cf_inher (cl, vals, meths) ->
-                 let cl_init = output_methods cla methods cl_init in
--                let inh_init, cl_init =
-+                let (inh_init, cl_init, meths', vals') =
-                   build_class_init cla false
-                     (vals, meths_super cla str.cl_meths meths)
-                     inh_init cl_init msubst top cl in
-+                let cl_init = bind_methods cla meths' vals' cl_init in
-                 (inh_init, cl_init, [], values)
-             | Cf_val (name, id, exp) ->
-                 (inh_init, cl_init, methods, (name, id)::values)
-@@ -304,29 +305,37 @@
-                 (inh_init, cl_init, methods, vals @ values)
-             | Cf_init exp ->
-                 (inh_init,
--                 Lsequence(Lapply (oo_prim "add_initializer",
--                                   Lvar cla :: msubst false (transl_exp exp)),
-+                 Lsequence(lprim "add_initializer"
-+                             (Lvar cla :: msubst false (transl_exp exp)),
-                            cl_init),
-                  methods, values))
-           str.cl_field
-           (inh_init, cl_init, [], [])
-       in
-       let cl_init = output_methods cla methods cl_init in
--      (inh_init, bind_methods cla str.cl_meths values cl_init)
-+      (* inh_init, bind_methods cla str.cl_meths values cl_init *)
-+      let methods =  Meths.fold (fun n i l -> (n,i)::l) str.cl_meths [] in
-+      (inh_init, cl_init, methods, values)
-   | Tclass_fun (pat, vals, cl, _) ->
--      let (inh_init, cl_init) =
-+      let (inh_init, cl_init, methods, values) =
-         build_class_init cla cstr super inh_init cl_init msubst top cl
-       in
-+      let fv = free_variables ~ifused:true cl_init in
-+      let vals = List.filter (fun (id,_) -> IdentSet.mem id fv) vals in
-       let vals = List.map (function (id, _) -> (Ident.name id, id)) vals in
--      (inh_init, transl_vals cla true vals cl_init)
-+      (* inh_init, transl_vals cla true vals cl_init *)
-+      (inh_init, cl_init, methods, vals @ values)
-   | Tclass_apply (cl, exprs) ->
-       build_class_init cla cstr super inh_init cl_init msubst top cl
-   | Tclass_let (rec_flag, defs, vals, cl) ->
--      let (inh_init, cl_init) =
-+      let (inh_init, cl_init, methods, values) =
-         build_class_init cla cstr super inh_init cl_init msubst top cl
-       in
-+      let fv = free_variables ~ifused:true cl_init in
-+      let vals = List.filter (fun (id,_) -> IdentSet.mem id fv) vals in
-       let vals = List.map (function (id, _) -> (Ident.name id, id)) vals in
--      (inh_init, transl_vals cla true vals cl_init)
-+      (* inh_init, transl_vals cla true vals cl_init *)
-+      (inh_init, cl_init, methods, vals @ values)
-   | Tclass_constraint (cl, vals, meths, concr_meths) ->
-       let virt_meths =
-         List.filter (fun lab -> not (Concr.mem lab concr_meths)) meths in
-@@ -358,23 +367,34 @@
-               cl_init valids in
-           (inh_init,
-            Llet (Strict, inh, 
--		 Lapply(oo_prim "inherits", narrow_args @
--			[lpath; Lconst(Const_pointer(if top then 1 else 0))]),
-+		 lprim "inherits"
-+                   (narrow_args @
-+                    [lpath; Lconst(Const_pointer(if top then 1 else 0))]),
-                  Llet(StrictOpt, obj_init, lfield inh 0,
-                  Llet(Alias, inh_vals, lfield inh 1,
--                 Llet(Alias, inh_meths, lfield inh 2, cl_init)))))
-+                 Llet(Alias, inh_meths, lfield inh 2, cl_init)))),
-+          [], [])
-       | _ ->
- 	  let core cl_init =
-             build_class_init cla true super inh_init cl_init msubst top cl
- 	  in
- 	  if cstr then core cl_init else
--          let (inh_init, cl_init) =
--            core (Lsequence (Lapply (oo_prim "widen", [Lvar cla]), cl_init))
-+          let (inh_init, cl_init, methods, values) =
-+            core (Lsequence (lprim "widen" [Lvar cla], cl_init))
-           in
--          (inh_init,
--           Lsequence(Lapply (oo_prim "narrow", narrow_args), cl_init))
-+          let cl_init = bind_methods cla methods values cl_init in
-+          (inh_init, Lsequence(lprim "narrow" narrow_args, cl_init), [], [])
-       end
- 
-+let build_class_init cla env inh_init obj_init msubst top cl =
-+  let inh_init = List.rev inh_init in
-+  let (inh_init, cl_init, methods, values) =
-+    build_class_init cla true ([],[]) inh_init obj_init msubst top cl in
-+  assert (inh_init = []);
-+  if IdentSet.mem env (free_variables ~ifused:true cl_init)
-+  then bind_methods cla methods (("", env) :: values) cl_init
-+  else Llet(Alias, env, lambda_unit, bind_methods cla methods values cl_init)
-+
- let rec build_class_lets cl =
-   match cl.cl_desc with
-     Tclass_let (rec_flag, defs, vals, cl) ->
-@@ -459,16 +479,16 @@
-     Strict, new_init, lfunction [obj_init] obj_init',
-     Llet(
-     Alias, cla, transl_path path,
--    Lprim(Pmakeblock(0, Immutable),
--          [Lapply(Lvar new_init, [lfield cla 0]);
--           lfunction [table]
--             (Llet(Strict, env_init,
--                   Lapply(lfield cla 1, [Lvar table]),
--                   lfunction [envs]
--                     (Lapply(Lvar new_init,
--                             [Lapply(Lvar env_init, [Lvar envs])]))));
--           lfield cla 2;
--           lfield cla 3])))
-+    ltuple
-+      [Lapply(Lvar new_init, [lfield cla 0]);
-+       lfunction [table]
-+         (Llet(Strict, env_init,
-+               Lapply(lfield cla 1, [Lvar table]),
-+               lfunction [envs]
-+                 (Lapply(Lvar new_init,
-+                         [Lapply(Lvar env_init, [Lvar envs])]))));
-+       lfield cla 2;
-+       lfield cla 3]))
-   with Exit ->
-     lambda_unit
- 
-@@ -541,7 +561,7 @@
-   open CamlinternalOO
-   let builtin_meths arr self env env2 body =
-     let builtin, args = builtin_meths self env env2 body in
--    if not arr then [Lapply(oo_prim builtin, args)] else
-+    if not arr then [lprim builtin args] else
-     let tag = match builtin with
-       "get_const" -> GetConst
-     | "get_var"   -> GetVar
-@@ -599,7 +619,8 @@
- 
-   (* Prepare for heavy environment handling *)
-   let tables = Ident.create (Ident.name cl_id ^ "_tables") in
--  let (top_env, req) = oo_add_class tables in
-+  let table_init = ref None in
-+  let (top_env, req) = oo_add_class tables table_init in
-   let top = not req in
-   let cl_env, llets = build_class_lets cl in
-   let new_ids = if top then [] else Env.diff top_env cl_env in
-@@ -633,6 +654,7 @@
-         begin try
-           (* Doesn't seem to improve size for bytecode *)
-           (* if not !Clflags.native_code then raise Not_found; *)
-+          if !Clflags.debug then raise Not_found;
-           builtin_meths arr [self] env env2 (lfunction args body')
-         with Not_found ->
-           [lfunction (self :: args)
-@@ -665,15 +687,8 @@
-     build_object_init_0 cla [] cl copy_env subst_env top ids in
-   if not (Translcore.check_recursive_lambda ids obj_init) then
-     raise(Error(cl.cl_loc, Illegal_class_expr));
--  let inh_init' = List.rev inh_init in
--  let (inh_init', cl_init) =
--    build_class_init cla true ([],[]) inh_init' obj_init msubst top cl
--  in
--  assert (inh_init' = []);
--  let table = Ident.create "table"
--  and class_init = Ident.create (Ident.name cl_id ^ "_init")
--  and env_init = Ident.create "env_init"
--  and obj_init = Ident.create "obj_init" in
-+  let cl_init = build_class_init cla env2 inh_init obj_init msubst top cl in
-+  let obj_init = Ident.create "obj_init" in
-   let pub_meths =
-     List.sort
-       (fun s s' -> compare (Btype.hash_variant s) (Btype.hash_variant s'))
-@@ -685,42 +700,44 @@
-       let name' = List.assoc tag rev_map in
-       if name' <> name then raise(Error(cl.cl_loc, Tags(name, name'))))
-     tags pub_meths;
-+  let pos = cl.cl_loc.Location.loc_end in
-+  let filepos = [transl_label pos.Lexing.pos_fname;
-+                 Lconst(Const_base(Const_int pos.Lexing.pos_cnum))] in
-   let ltable table lam =
--    Llet(Strict, table,
--         Lapply (oo_prim "create_table", [transl_meth_list pub_meths]), lam)
-+    Llet(Strict, table, lprim "create_table" [transl_meth_list pub_meths], lam)
-   and ldirect obj_init =
-     Llet(Strict, obj_init, cl_init,
--         Lsequence(Lapply (oo_prim "init_class", [Lvar cla]),
-+         Lsequence(lprim "init_class_shared" (Lvar cla :: filepos),
-                    Lapply(Lvar obj_init, [lambda_unit])))
-   in
-   (* Simplest case: an object defined at toplevel (ids=[]) *)
-   if top && ids = [] then llets (ltable cla (ldirect obj_init)) else
- 
-+  let table = Ident.create "table"
-+  and class_init = Ident.create (Ident.name cl_id ^ "_init")
-+  and env_init = Ident.create (Ident.name cl_id ^ "_env_init") in
-+  let cl_init_fun = Lfunction(Curried, [cla], cl_init) in
-   let concrete =
-     ids = [] ||
-     Typeclass.virtual_methods (Ctype.signature_of_class_type cl.cl_type) = []
--  and lclass lam =
--    let cl_init = llets (Lfunction(Curried, [cla], cl_init)) in
-+  and lclass cl_init lam =
-     Llet(Strict, class_init, cl_init, lam (free_variables cl_init))
-   and lbody fv =
-     if List.for_all (fun id -> not (IdentSet.mem id fv)) ids then
--      Lapply (oo_prim "make_class",[transl_meth_list pub_meths;
--				    Lvar class_init])
-+      lprim "make_class"
-+        (transl_meth_list pub_meths :: Lvar class_init :: filepos)
-     else
-       ltable table (
-       Llet(
-       Strict, env_init, Lapply(Lvar class_init, [Lvar table]),
--      Lsequence(
--      Lapply (oo_prim "init_class", [Lvar table]),
--      Lprim(Pmakeblock(0, Immutable),
--	    [Lapply(Lvar env_init, [lambda_unit]);
--	     Lvar class_init; Lvar env_init; lambda_unit]))))
-+      Lsequence(lprim "init_class_shared" (Lvar table :: filepos),
-+                ltuple [Lapply(Lvar env_init, [lambda_unit]);
-+	                Lvar class_init; Lvar env_init; lambda_unit])))
-   and lbody_virt lenvs =
--    Lprim(Pmakeblock(0, Immutable),
--          [lambda_unit; Lfunction(Curried,[cla], cl_init); lambda_unit; lenvs])
-+    ltuple [lambda_unit; cl_init_fun; lambda_unit; lenvs]
-   in
-   (* Still easy: a class defined at toplevel *)
--  if top && concrete then lclass lbody else
-+  if top && concrete then lclass (llets cl_init_fun) lbody else
-   if top then llets (lbody_virt lambda_unit) else
- 
-   (* Now for the hard stuff: prepare for table cacheing *)
-@@ -733,23 +750,16 @@
-   let lenv =
-     let menv =
-       if !new_ids_meths = [] then lambda_unit else
--      Lprim(Pmakeblock(0, Immutable),
--            List.map (fun id -> Lvar id) !new_ids_meths) in
-+      ltuple (List.map (fun id -> Lvar id) !new_ids_meths) in
-     if !new_ids_init = [] then menv else
--    Lprim(Pmakeblock(0, Immutable),
--          menv :: List.map (fun id -> Lvar id) !new_ids_init)
-+    ltuple (menv :: List.map (fun id -> Lvar id) !new_ids_init)
-   and linh_envs =
-     List.map (fun (_, p) -> Lprim(Pfield 3, [transl_path p]))
-       (List.rev inh_init)
-   in
-   let make_envs lam =
-     Llet(StrictOpt, envs,
--         (if linh_envs = [] then lenv else
--         Lprim(Pmakeblock(0, Immutable), lenv :: linh_envs)),
--         lam)
--  and def_ids cla lam =
--    Llet(StrictOpt, env2,
--         Lapply (oo_prim "new_variable", [Lvar cla; transl_label ""]),
-+         (if linh_envs = [] then lenv else ltuple (lenv :: linh_envs)),
-          lam)
-   in
-   let inh_paths =
-@@ -757,46 +767,53 @@
-       (fun (_,path) -> List.mem (Path.head path) new_ids) inh_init in
-   let inh_keys =
-     List.map (fun (_,p) -> Lprim(Pfield 1, [transl_path p])) inh_paths in
--  let lclass lam =
--    Llet(Strict, class_init,
--         Lfunction(Curried, [cla], def_ids cla cl_init), lam)
-+  let lclass_init lam =
-+    Llet(Strict, class_init, cl_init_fun, lam)
-   and lcache lam =
-     if inh_keys = [] then Llet(Alias, cached, Lvar tables, lam) else
--    Llet(Strict, cached,
--         Lapply(oo_prim "lookup_tables",
--                [Lvar tables; Lprim(Pmakeblock(0, Immutable), inh_keys)]),
-+    Llet(Strict, cached, lprim "lookup_tables" [Lvar tables; ltuple inh_keys],
-          lam)
-   and lset cached i lam =
-     Lprim(Psetfield(i, true), [Lvar cached; lam])
-   in
--  let ldirect () =
--    ltable cla
--      (Llet(Strict, env_init, def_ids cla cl_init,
--            Lsequence(Lapply (oo_prim "init_class", [Lvar cla]),
--                      lset cached 0 (Lvar env_init))))
--  and lclass_virt () =
--    lset cached 0 (Lfunction(Curried, [cla], def_ids cla cl_init))
-+  let ldirect prim pos =
-+    ltable cla (
-+    Llet(Strict, env_init, cl_init,
-+         Lsequence(lprim prim (Lvar cla :: pos), Lvar env_init)))
-+  and lclass_concrete cached =
-+    ltuple [Lapply (lfield cached 0, [lenvs]);
-+            lfield cached 1; lfield cached 0; lenvs]
-   in
-+
-   llets (
--  lcache (
--  Lsequence(
--  Lifthenelse(lfield cached 0, lambda_unit,
--              if ids = [] then ldirect () else
--              if not concrete then lclass_virt () else
--              lclass (
--              Lapply (oo_prim "make_class_store",
--                      [transl_meth_list pub_meths;
--                       Lvar class_init; Lvar cached]))),
-   make_envs (
--  if ids = [] then Lapply(lfield cached 0, [lenvs]) else
--  Lprim(Pmakeblock(0, Immutable),
--        if concrete then
--          [Lapply(lfield cached 0, [lenvs]);
--           lfield cached 1;
--           lfield cached 0;
--           lenvs]
--        else [lambda_unit; lfield cached 0; lambda_unit; lenvs]
--       )))))
-+  if inh_paths = [] && concrete then
-+    if ids = [] then begin
-+      table_init := Some (ldirect "init_class_shared" filepos);
-+      Lapply (Lvar tables, [lenvs])
-+    end else begin
-+      let init =
-+        lclass cl_init_fun (fun _ ->
-+          lprim "make_class_env"
-+            (transl_meth_list pub_meths :: Lvar class_init :: filepos))
-+      in table_init := Some init;
-+      lclass_concrete tables
-+    end
-+  else begin
-+    lcache (
-+    Lsequence(
-+    Lifthenelse(lfield cached 0, lambda_unit,
-+                if ids = [] then lset cached 0 (ldirect "init_class" []) else
-+                if not concrete then lset cached 0 cl_init_fun else
-+                lclass_init (
-+                lprim "make_class_store"
-+                  [transl_meth_list pub_meths; Lvar class_init; Lvar cached])),
-+    llets (
-+    make_envs (
-+    if ids = [] then Lapply(lfield cached 0, [lenvs]) else
-+    if concrete then lclass_concrete cached else
-+    ltuple [lambda_unit; lfield cached 0; lambda_unit; lenvs]))))
-+  end))
- 
- (* Wrapper for class compilation *)
- 
-Index: bytecomp/translobj.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/translobj.ml,v
-retrieving revision 1.9
-diff -u -r1.9 translobj.ml
---- bytecomp/translobj.ml	26 May 2004 11:10:51 -0000	1.9
-+++ bytecomp/translobj.ml	2 Feb 2006 05:08:56 -0000
-@@ -88,7 +88,6 @@
- 
- (* Insert labels *)
- 
--let string s = Lconst (Const_base (Const_string s))
- let int n = Lconst (Const_base (Const_int n))
- 
- let prim_makearray =
-@@ -124,8 +123,8 @@
- let top_env = ref Env.empty
- let classes = ref []
- 
--let oo_add_class id =
--  classes := id :: !classes;
-+let oo_add_class id init =
-+  classes := (id, init) :: !classes;
-   (!top_env, !cache_required)
- 
- let oo_wrap env req f x =
-@@ -141,10 +140,12 @@
-     let lambda = f x in
-     let lambda =
-       List.fold_left
--        (fun lambda id ->
-+        (fun lambda (id, init) ->
-           Llet(StrictOpt, id,
--               Lprim(Pmakeblock(0, Mutable),
--                     [lambda_unit; lambda_unit; lambda_unit]),
-+               (match !init with
-+                 Some lam -> lam
-+               | None -> Lprim(Pmakeblock(0, Mutable),
-+                               [lambda_unit; lambda_unit; lambda_unit])),
-                lambda))
-         lambda !classes
-     in
-Index: bytecomp/translobj.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/translobj.mli,v
-retrieving revision 1.6
-diff -u -r1.6 translobj.mli
---- bytecomp/translobj.mli	26 May 2004 11:10:51 -0000	1.6
-+++ bytecomp/translobj.mli	2 Feb 2006 05:08:56 -0000
-@@ -25,4 +25,4 @@
-     Ident.t -> int -> ('a -> lambda) -> 'a -> int * lambda
- 
- val oo_wrap: Env.t -> bool -> ('a -> lambda) -> 'a -> lambda
--val oo_add_class: Ident.t -> Env.t * bool
-+val oo_add_class: Ident.t -> Lambda.lambda option ref -> Env.t * bool
-Index: byterun/compare.h
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/byterun/compare.h,v
-retrieving revision 1.2
-diff -u -r1.2 compare.h
---- byterun/compare.h	31 Dec 2003 14:20:35 -0000	1.2
-+++ byterun/compare.h	2 Feb 2006 05:08:56 -0000
-@@ -17,5 +17,6 @@
- #define CAML_COMPARE_H
- 
- CAMLextern int caml_compare_unordered;
-+CAMLextern value caml_compare(value, value);
- 
- #endif /* CAML_COMPARE_H */
-Index: byterun/extern.c
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/byterun/extern.c,v
-retrieving revision 1.59
-diff -u -r1.59 extern.c
---- byterun/extern.c	4 Jan 2006 16:55:49 -0000	1.59
-+++ byterun/extern.c	2 Feb 2006 05:08:56 -0000
-@@ -411,6 +411,22 @@
-       extern_record_location(v);
-       break;
-     }
-+    case Object_tag: {
-+      value field0;
-+      mlsize_t i;
-+      i = Wosize_val(Field(v, 0)) - 1;
-+      field0 = Field(Field(v, 0),i);
-+      if (Wosize_val(field0) > 0) {
-+        writecode32(CODE_OBJECT, Wosize_hd (hd));
-+        extern_record_location(v);
-+        extern_rec(field0);
-+        for (i = 1; i < sz - 1; i++) extern_rec(Field(v, i));
-+        v = Field(v, i);
-+        goto tailcall;
-+      }
-+      if (!extern_closures)
-+        extern_invalid_argument("output_value: dynamic class");
-+    } /* may fall through */
-     default: {
-       value field0;
-       mlsize_t i;
-Index: byterun/intern.c
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/byterun/intern.c,v
-retrieving revision 1.60
-diff -u -r1.60 intern.c
---- byterun/intern.c	22 Sep 2005 14:21:50 -0000	1.60
-+++ byterun/intern.c	2 Feb 2006 05:08:56 -0000
-@@ -28,6 +28,8 @@
- #include "mlvalues.h"
- #include "misc.h"
- #include "reverse.h"
-+#include "callback.h"
-+#include "compare.h"
- 
- static unsigned char * intern_src;
- /* Reading pointer in block holding input data. */
-@@ -98,6 +100,25 @@
- #define readblock(dest,len) \
-   (memmove((dest), intern_src, (len)), intern_src += (len))
- 
-+static value get_method_table (value key)
-+{
-+  static value *classes = NULL;
-+  value current;
-+  if (classes == NULL) {
-+    classes = caml_named_value("caml_oo_classes");
-+    if (classes == NULL) return 0;
-+    caml_register_global_root(classes);
-+  }
-+  for (current = Field(*classes, 0); Is_block(current);
-+       current = Field(current, 1))
-+  {
-+    value head = Field(current, 0);
-+    if (caml_compare(key, Field(head, 0)) == Val_int(0))
-+      return Field(head, 1);
-+  }
-+  return 0;
-+}
-+
- static void intern_cleanup(void)
- {
-   if (intern_input_malloced) caml_stat_free(intern_input);
-@@ -315,6 +336,24 @@
-         Custom_ops_val(v) = ops;
-         intern_dest += 1 + size;
-         break;
-+      case CODE_OBJECT:
-+        size = read32u();
-+        v = Val_hp(intern_dest);
-+        *dest = v;
-+        if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
-+        dest = (value *) (intern_dest + 1);
-+        *intern_dest = Make_header(size, Object_tag, intern_color);
-+        intern_dest += 1 + size;
-+        intern_rec(dest);
-+        *dest = get_method_table(*dest);
-+        if (*dest == 0) {
-+          intern_cleanup();
-+          caml_failwith("input_value: unknown class");
-+        }
-+        for(size--, dest++; size > 1; size--, dest++)
-+          intern_rec(dest);
-+        goto tailcall;
-+        
-       default:
-         intern_cleanup();
-         caml_failwith("input_value: ill-formed message");
-Index: byterun/intext.h
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/byterun/intext.h,v
-retrieving revision 1.32
-diff -u -r1.32 intext.h
---- byterun/intext.h	22 Sep 2005 14:21:50 -0000	1.32
-+++ byterun/intext.h	2 Feb 2006 05:08:56 -0000
-@@ -56,6 +56,7 @@
- #define CODE_CODEPOINTER 0x10
- #define CODE_INFIXPOINTER 0x11
- #define CODE_CUSTOM 0x12
-+#define CODE_OBJECT 0x14
- 
- #if ARCH_FLOAT_ENDIANNESS == 0x76543210
- #define CODE_DOUBLE_NATIVE CODE_DOUBLE_BIG
-Index: stdlib/camlinternalOO.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/stdlib/camlinternalOO.ml,v
-retrieving revision 1.14
-diff -u -r1.14 camlinternalOO.ml
---- stdlib/camlinternalOO.ml	25 Oct 2005 18:34:07 -0000	1.14
-+++ stdlib/camlinternalOO.ml	2 Feb 2006 05:08:56 -0000
-@@ -305,10 +305,38 @@
-     public_methods;
-   table
- 
-+(*
-+let create_table_variables pub_meths priv_meths vars =
-+  let tbl = create_table pub_meths in
-+  let pub_meths = to_array pub_meths
-+  and priv_meths = to_array priv_meths
-+  and vars = to_array vars in
-+  let len = 2 + Array.length pub_meths + Array.length priv_meths in
-+  let res = Array.create len tbl in
-+  let mv = new_methods_variables tbl pub_meths vars in
-+  Array.blit mv 0 res 1;
-+  res
-+*)
-+
- let init_class table =
-   inst_var_count := !inst_var_count + table.size - 1;
-   table.initializers <- List.rev table.initializers;
--  resize table (3 + magic table.methods.(1) * 16 / Sys.word_size)
-+  let len = 3 + magic table.methods.(1) * 16 / Sys.word_size in
-+  (* keep 1 more for extra info *)
-+  let len = if len > Array.length table.methods then len else len+1 in
-+  resize table len
-+
-+let classes = ref []
-+let () = Callback.register "caml_oo_classes" classes
-+
-+let init_class_shared table (file : string) (pos : int) =
-+  init_class table;
-+  let rec unique_pos pos =
-+    if List.mem_assoc (file, pos) !classes then unique_pos (pos + 0x100000)
-+    else pos in
-+  let pos = unique_pos pos in
-+  table.methods.(Array.length table.methods - 1) <- Obj.magic (file, pos);
-+  classes := ((file, pos), table.methods) :: !classes
- 
- let inherits cla vals virt_meths concr_meths (_, super, _, env) top =
-   narrow cla vals virt_meths concr_meths;
-@@ -319,12 +347,18 @@
-    Array.map (fun nm -> get_method cla (get_method_label cla nm))
-      (to_array concr_meths))
- 
--let make_class pub_meths class_init =
-+let make_class pub_meths class_init file pos =
-   let table = create_table pub_meths in
-   let env_init = class_init table in
--  init_class table;
-+  init_class_shared table file pos;
-   (env_init (Obj.repr 0), class_init, env_init, Obj.repr 0)
- 
-+let make_class_env pub_meths class_init file pos =
-+  let table = create_table pub_meths in
-+  let env_init = class_init table in
-+  init_class_shared table file pos;
-+  (env_init, class_init)
-+
- type init_table = { mutable env_init: t; mutable class_init: table -> t }
- 
- let make_class_store pub_meths class_init init_table =
-Index: stdlib/camlinternalOO.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/stdlib/camlinternalOO.mli,v
-retrieving revision 1.9
-diff -u -r1.9 camlinternalOO.mli
---- stdlib/camlinternalOO.mli	25 Oct 2005 18:34:07 -0000	1.9
-+++ stdlib/camlinternalOO.mli	2 Feb 2006 05:08:56 -0000
-@@ -43,14 +43,20 @@
- val add_initializer : table -> (obj -> unit) -> unit
- val dummy_table : table
- val create_table : string array -> table
-+(* val create_table_variables :
-+    string array -> string array -> string array -> table *)
- val init_class : table -> unit
-+val init_class_shared : table -> string -> int -> unit
- val inherits :
-     table -> string array -> string array -> string array ->
-     (t * (table -> obj -> Obj.t) * t * obj) -> bool ->
-     (Obj.t * int array * closure array)
- val make_class :
--    string array -> (table -> Obj.t -> t) ->
-+    string array -> (table -> Obj.t -> t) -> string -> int ->
-     (t * (table -> Obj.t -> t) * (Obj.t -> t) * Obj.t)
-+val make_class_env :
-+    string array -> (table -> Obj.t -> t) -> string -> int ->
-+    (Obj.t -> t) * (table -> Obj.t -> t)
- type init_table
- val make_class_store :
-     string array -> (table -> t) -> init_table -> unit
diff -Nru ocaml-3.12.1/testlabl/multimatch.diffs ocaml-4.01.0/testlabl/multimatch.diffs
--- ocaml-3.12.1/testlabl/multimatch.diffs	2006-02-02 06:39:55.000000000 +0000
+++ ocaml-4.01.0/testlabl/multimatch.diffs	1970-01-01 00:00:00.000000000 +0000
@@ -1,1418 +0,0 @@
-Index: parsing/lexer.mll
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/parsing/lexer.mll,v
-retrieving revision 1.73
-diff -u -r1.73 lexer.mll
---- parsing/lexer.mll	11 Apr 2005 16:44:26 -0000	1.73
-+++ parsing/lexer.mll	2 Feb 2006 06:28:32 -0000
-@@ -63,6 +63,8 @@
-     "match", MATCH;
-     "method", METHOD;
-     "module", MODULE;
-+    "multifun", MULTIFUN;
-+    "multimatch", MULTIMATCH;
-     "mutable", MUTABLE;
-     "new", NEW;
-     "object", OBJECT;
-Index: parsing/parser.mly
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/parsing/parser.mly,v
-retrieving revision 1.123
-diff -u -r1.123 parser.mly
---- parsing/parser.mly	23 Mar 2005 03:08:37 -0000	1.123
-+++ parsing/parser.mly	2 Feb 2006 06:28:32 -0000
-@@ -257,6 +257,8 @@
- %token MINUSDOT
- %token MINUSGREATER
- %token MODULE
-+%token MULTIFUN
-+%token MULTIMATCH
- %token MUTABLE
- %token  NATIVEINT
- %token NEW
-@@ -325,7 +327,7 @@
- %nonassoc SEMI                          /* below EQUAL ({lbl=...; lbl=...}) */
- %nonassoc LET                           /* above SEMI ( ...; let ... in ...) */
- %nonassoc below_WITH
--%nonassoc FUNCTION WITH                 /* below BAR  (match ... with ...) */
-+%nonassoc FUNCTION WITH MULTIFUN        /* below BAR  (match ... with ...) */
- %nonassoc AND             /* above WITH (module rec A: SIG with ... and ...) */
- %nonassoc THEN                          /* below ELSE (if ... then ...) */
- %nonassoc ELSE                          /* (if ... then ... else ...) */
-@@ -804,8 +806,12 @@
-       { mkexp(Pexp_function("", None, List.rev $3)) }
-   | FUN labeled_simple_pattern fun_def
-       { let (l,o,p) = $2 in mkexp(Pexp_function(l, o, [p, $3])) }
-+  | MULTIFUN opt_bar match_cases
-+      { mkexp(Pexp_multifun(List.rev $3)) }
-   | MATCH seq_expr WITH opt_bar match_cases
--      { mkexp(Pexp_match($2, List.rev $5)) }
-+      { mkexp(Pexp_match($2, List.rev $5, false)) }
-+  | MULTIMATCH seq_expr WITH opt_bar match_cases
-+      { mkexp(Pexp_match($2, List.rev $5, true)) }
-   | TRY seq_expr WITH opt_bar match_cases
-       { mkexp(Pexp_try($2, List.rev $5)) }
-   | TRY seq_expr WITH error
-@@ -1318,10 +1324,10 @@
-   | simple_core_type2                           { Rinherit $1 }
- ;
- tag_field:
--    name_tag OF opt_ampersand amper_type_list
--      { Rtag ($1, $3, List.rev $4) }
--  | name_tag
--      { Rtag ($1, true, []) }
-+    name_tag OF opt_ampersand amper_type_list amper_type_pair_list
-+      { Rtag ($1, $3, List.rev $4, $5) }
-+  | name_tag amper_type_pair_list
-+      { Rtag ($1, true, [], $2) }
- ;
- opt_ampersand:
-     AMPERSAND                                   { true }
-@@ -1331,6 +1337,11 @@
-     core_type                                   { [$1] }
-   | amper_type_list AMPERSAND core_type         { $3 :: $1 }
- ;
-+amper_type_pair_list:
-+    AMPERSAND core_type EQUAL core_type amper_type_pair_list
-+      { ($2, $4) :: $5 }
-+  | /* empty */
-+      { [] }
- opt_present:
-     LBRACKETGREATER name_tag_list RBRACKET      { List.rev $2 }
-   | /* empty */                                 { [] }
-Index: parsing/parsetree.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/parsing/parsetree.mli,v
-retrieving revision 1.42
-diff -u -r1.42 parsetree.mli
---- parsing/parsetree.mli	23 Mar 2005 03:08:37 -0000	1.42
-+++ parsing/parsetree.mli	2 Feb 2006 06:28:32 -0000
-@@ -43,7 +43,7 @@
-   | Pfield_var
- 
- and row_field =
--    Rtag of label * bool * core_type list
-+    Rtag of label * bool * core_type list * (core_type * core_type) list
-   | Rinherit of core_type
- 
- (* XXX Type expressions for the class language *)
-@@ -86,7 +86,7 @@
-   | Pexp_let of rec_flag * (pattern * expression) list * expression
-   | Pexp_function of label * expression option * (pattern * expression) list
-   | Pexp_apply of expression * (label * expression) list
--  | Pexp_match of expression * (pattern * expression) list
-+  | Pexp_match of expression * (pattern * expression) list * bool
-   | Pexp_try of expression * (pattern * expression) list
-   | Pexp_tuple of expression list
-   | Pexp_construct of Longident.t * expression option * bool
-@@ -111,6 +111,7 @@
-   | Pexp_lazy of expression
-   | Pexp_poly of expression * core_type option
-   | Pexp_object of class_structure
-+  | Pexp_multifun of (pattern * expression) list
- 
- (* Value descriptions *)
- 
-Index: parsing/printast.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/parsing/printast.ml,v
-retrieving revision 1.29
-diff -u -r1.29 printast.ml
---- parsing/printast.ml	4 Jan 2006 16:55:50 -0000	1.29
-+++ parsing/printast.ml	2 Feb 2006 06:28:32 -0000
-@@ -205,10 +205,14 @@
-       line i ppf "Pexp_apply\n";
-       expression i ppf e;
-       list i label_x_expression ppf l;
--  | Pexp_match (e, l) ->
-+  | Pexp_match (e, l, b) ->
-       line i ppf "Pexp_match\n";
-       expression i ppf e;
-       list i pattern_x_expression_case ppf l;
-+      bool i ppf b
-+  | Pexp_multifun l ->
-+      line i ppf "Pexp_multifun\n";
-+      list i pattern_x_expression_case ppf l;
-   | Pexp_try (e, l) ->
-       line i ppf "Pexp_try\n";
-       expression i ppf e;
-@@ -653,7 +657,7 @@
- 
- and label_x_bool_x_core_type_list i ppf x =
-   match x with
--    Rtag (l, b, ctl) ->
-+    Rtag (l, b, ctl, cstr) ->
-       line i ppf "Rtag \"%s\" %s\n" l (string_of_bool b);
-       list (i+1) core_type ppf ctl
-   | Rinherit (ct) ->
-Index: typing/btype.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/btype.ml,v
-retrieving revision 1.38
-diff -u -r1.38 btype.ml
---- typing/btype.ml	4 Jan 2006 16:55:50 -0000	1.38
-+++ typing/btype.ml	2 Feb 2006 06:28:32 -0000
-@@ -66,16 +66,16 @@
-     Clink r when !r <> Cunknown -> commu_repr !r
-   | c -> c
- 
--let rec row_field_repr_aux tl = function
--    Reither(_, tl', _, {contents = Some fi}) ->
--      row_field_repr_aux (tl@tl') fi
--  | Reither(c, tl', m, r) ->
--      Reither(c, tl@tl', m, r)
-+let rec row_field_repr_aux tl tl2 = function
-+    Reither(_, tl', _, tl2', {contents = Some fi}) ->
-+      row_field_repr_aux (tl@tl') (tl2@tl2') fi
-+  | Reither(c, tl', m, tl2', r) ->
-+      Reither(c, tl@tl', m, tl2@tl2', r)
-   | Rpresent (Some _) when tl <> [] ->
-       Rpresent (Some (List.hd tl))
-   | fi -> fi
- 
--let row_field_repr fi = row_field_repr_aux [] fi
-+let row_field_repr fi = row_field_repr_aux [] [] fi
- 
- let rec rev_concat l ll =
-   match ll with
-@@ -170,7 +170,8 @@
-     (fun (_, fi) ->
-       match row_field_repr fi with
-       | Rpresent(Some ty) -> f ty
--      | Reither(_, tl, _, _) -> List.iter f tl
-+      | Reither(_, tl, _, tl2, _) ->
-+          List.iter f tl; List.iter (fun (t1,t2) -> f t1; f t2) tl2
-       | _ -> ())
-     row.row_fields;
-   match (repr row.row_more).desc with
-@@ -208,15 +209,17 @@
-       (fun (l, fi) -> l,
-         match row_field_repr fi with
-         | Rpresent(Some ty) -> Rpresent(Some(f ty))
--        | Reither(c, tl, m, e) ->
-+        | Reither(c, tl, m, tpl, e) ->
-             let e = if keep then e else ref None in
-             let m = if row.row_fixed then fixed else m in
-             let tl = List.map f tl in
-+            let tl1 = List.map (fun (t1,_) -> repr (f t1)) tpl
-+            and tl2 = List.map (fun (_,t2) -> repr (f t2)) tpl in
-             bound := List.filter
-                 (function {desc=Tconstr(_,[],_)} -> false | _ -> true)
--                (List.map repr tl)
-+                (List.map repr tl @ tl1 @ tl2)
-               @ !bound;
--            Reither(c, tl, m, e)
-+            Reither(c, tl, m, List.combine tl1 tl2, e)
-         | _ -> fi)
-       row.row_fields in
-   let name =
-Index: typing/ctype.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/ctype.ml,v
-retrieving revision 1.200
-diff -u -r1.200 ctype.ml
---- typing/ctype.ml	6 Jan 2006 02:16:24 -0000	1.200
-+++ typing/ctype.ml	2 Feb 2006 06:28:32 -0000
-@@ -340,7 +340,7 @@
-       let fi = filter_row_fields erase fi in
-       match row_field_repr f with
-         Rabsent -> fi
--      | Reither(_,_,false,e) when erase -> set_row_field e Rabsent; fi
-+      | Reither(_,_,false,_,e) when erase -> set_row_field e Rabsent; fi
-       | _ -> p :: fi
- 
-                     (**************************************)
-@@ -1286,6 +1286,10 @@
- 
- module TypeMap = Map.Make (TypeOps)
- 
-+
-+(* A list of univars which may appear free in a type, but only if generic *)
-+let allowed_univars = ref TypeSet.empty
-+
- (* Test the occurence of free univars in a type *)
- (* that's way too expansive. Must do some kind of cacheing *)
- let occur_univar env ty =
-@@ -1307,7 +1311,12 @@
-     then
-       match ty.desc with
-         Tunivar ->
--          if not (TypeSet.mem ty bound) then raise (Unify [ty, newgenvar()])
-+          if TypeSet.mem ty bound then () else
-+          if TypeSet.mem ty !allowed_univars &&
-+            (ty.level = generic_level ||
-+             ty.level = pivot_level - generic_level)
-+          then ()
-+          else raise (Unify [ty, newgenvar()])
-       | Tpoly (ty, tyl) ->
-           let bound = List.fold_right TypeSet.add (List.map repr tyl) bound in
-           occur_rec bound  ty
-@@ -1393,6 +1402,7 @@
-   with exn -> univar_pairs := old_univars; raise exn
- 
- let univar_pairs = ref []
-+let delayed_conditionals = ref []
- 
- 
-                               (*****************)
-@@ -1691,9 +1701,11 @@
-               with Not_found -> (h,l)::hl)
-             (List.map (fun (l,_) -> (hash_variant l, l)) row1.row_fields)
-             (List.map fst r2));
-+  let fixed1 = row1.row_fixed || rm1.desc <> Tvar
-+  and fixed2 = row2.row_fixed || rm2.desc <> Tvar in
-   let more =
--    if row1.row_fixed then rm1 else
--    if row2.row_fixed then rm2 else
-+    if fixed1 then rm1 else
-+    if fixed2 then rm2 else
-     newgenvar ()
-   in update_level env (min rm1.level rm2.level) more;
-   let fixed = row1.row_fixed || row2.row_fixed
-@@ -1726,18 +1738,18 @@
-   let bound = row1.row_bound @ row2.row_bound in
-   let row0 = {row_fields = []; row_more = more; row_bound = bound;
-               row_closed = closed; row_fixed = fixed; row_name = name} in
--  let set_more row rest =
-+  let set_more row row_fixed rest =
-     let rest =
-       if closed then
-         filter_row_fields row.row_closed rest
-       else rest in
--    if rest <> [] && (row.row_closed || row.row_fixed)
--    || closed && row.row_fixed && not row.row_closed then begin
-+    if rest <> [] && (row.row_closed || row_fixed)
-+    || closed && row_fixed && not row.row_closed then begin
-       let t1 = mkvariant [] true and t2 = mkvariant rest false in
-       raise (Unify [if row == row1 then (t1,t2) else (t2,t1)])
-     end;
-     let rm = row_more row in
--    if row.row_fixed then
-+    if row_fixed then
-       if row0.row_more == rm then () else
-       if rm.desc = Tvar then link_type rm row0.row_more else
-       unify env rm row0.row_more
-@@ -1748,11 +1760,11 @@
-   in
-   let md1 = rm1.desc and md2 = rm2.desc in
-   begin try
--    set_more row1 r2;
--    set_more row2 r1;
-+    set_more row1 fixed1 r2;
-+    set_more row2 fixed2 r1;
-     List.iter
-       (fun (l,f1,f2) ->
--        try unify_row_field env row1.row_fixed row2.row_fixed l f1 f2
-+        try unify_row_field env fixed1 fixed2 row1 row2 l f1 f2
-         with Unify trace ->
-           raise (Unify ((mkvariant [l,f1] true,
-                          mkvariant [l,f2] true) :: trace)))
-@@ -1761,13 +1773,13 @@
-     log_type rm1; rm1.desc <- md1; log_type rm2; rm2.desc <- md2; raise exn
-   end
- 
--and unify_row_field env fixed1 fixed2 l f1 f2 =
-+and unify_row_field env fixed1 fixed2 row1 row2 l f1 f2 =
-   let f1 = row_field_repr f1 and f2 = row_field_repr f2 in
-   if f1 == f2 then () else
-   match f1, f2 with
-     Rpresent(Some t1), Rpresent(Some t2) -> unify env t1 t2
-   | Rpresent None, Rpresent None -> ()
--  | Reither(c1, tl1, m1, e1), Reither(c2, tl2, m2, e2) ->
-+  | Reither(c1, tl1, m1, tp1, e1), Reither(c2, tl2, m2, tp2, e2) ->
-       if e1 == e2 then () else
-       let redo =
-         (m1 || m2) &&
-@@ -1777,32 +1789,70 @@
-             List.iter (unify env t1) tl;
-             !e1 <> None || !e2 <> None
-         end in
--      if redo then unify_row_field env fixed1 fixed2 l f1 f2 else
-+      let redo =
-+        redo || begin
-+          if tp1 = [] && fixed1 then unify_pairs env tp2;
-+          if tp2 = [] && fixed2 then unify_pairs env tp1;
-+          !e1 <> None || !e2 <> None
-+        end
-+      in
-+      if redo then unify_row_field env fixed1 fixed2 row1 row2 l f1 f2 else
-       let tl1 = List.map repr tl1 and tl2 = List.map repr tl2 in
-       let rec remq tl = function [] -> []
-         | ty :: tl' ->
-             if List.memq ty tl then remq tl tl' else ty :: remq tl tl'
-       in
-       let tl2' = remq tl2 tl1 and tl1' = remq tl1 tl2 in
-+      let repr_pairs = List.map (fun (t1,t2) -> repr t1, repr t2) in
-+      let tp1 = repr_pairs tp1 and tp2 = repr_pairs tp2 in
-+      let rec rempq tp = function [] -> []
-+        | (t1,t2 as p) :: tp' ->
-+            if List.exists (fun (t1',t2') -> t1==t1' && t2==t2') (tp@tp') then
-+              rempq tp tp'
-+            else p :: rempq tp tp'
-+      in
-+      let tp1' =
-+        if fixed2 then begin
-+          delayed_conditionals :=
-+            (!univar_pairs, tp1, l, row2) :: !delayed_conditionals;
-+          []
-+        end else rempq tp2 tp1
-+      and tp2' =
-+        if fixed1 then begin
-+          delayed_conditionals :=
-+            (!univar_pairs, tp2, l, row1) :: !delayed_conditionals;
-+          []
-+        end else rempq tp1 tp2
-+      in
-       let e = ref None in
--      let f1' = Reither(c1 || c2, tl1', m1 || m2, e)
--      and f2' = Reither(c1 || c2, tl2', m1 || m2, e) in
--      set_row_field e1 f1'; set_row_field e2 f2';
--  | Reither(_, _, false, e1), Rabsent -> set_row_field e1 f2
--  | Rabsent, Reither(_, _, false, e2) -> set_row_field e2 f1
-+      let f1' = Reither(c1 || c2, tl1', m1 || m2, tp2', e)
-+      and f2' = Reither(c1 || c2, tl2', m1 || m2, tp1', e) in
-+      set_row_field e1 f1'; set_row_field e2 f2'
-+  | Reither(_, _, false, _, e1), Rabsent -> set_row_field e1 f2
-+  | Rabsent, Reither(_, _, false, _, e2) -> set_row_field e2 f1
-   | Rabsent, Rabsent -> ()
--  | Reither(false, tl, _, e1), Rpresent(Some t2) when not fixed1 ->
-+  | Reither(false, tl, _, tp, e1), Rpresent(Some t2) when not fixed1 ->
-       set_row_field e1 f2;
--      (try List.iter (fun t1 -> unify env t1 t2) tl
-+      begin try
-+        List.iter (fun t1 -> unify env t1 t2) tl;
-+        List.iter (fun (t1,t2) -> unify env t1 t2) tp
-+      with exn -> e1 := None; raise exn
-+      end
-+  | Rpresent(Some t1), Reither(false, tl, _, tp, e2) when not fixed2 ->
-+      set_row_field e2 f1;
-+      begin try
-+        List.iter (unify env t1) tl;
-+        List.iter (fun (t1,t2) -> unify env t1 t2) tp
-+      with exn -> e2 := None; raise exn
-+      end
-+  | Reither(true, [], _, tpl, e1), Rpresent None when not fixed1 ->
-+      set_row_field e1 f2;
-+      (try List.iter (fun (t1,t2) -> unify env t1 t2) tpl
-       with exn -> e1 := None; raise exn)
--  | Rpresent(Some t1), Reither(false, tl, _, e2) when not fixed2 ->
-+  | Rpresent None, Reither(true, [], _, tpl, e2) when not fixed2 ->
-       set_row_field e2 f1;
--      (try List.iter (unify env t1) tl
-+      (try List.iter (fun (t1,t2) -> unify env t1 t2) tpl
-       with exn -> e2 := None; raise exn)
--  | Reither(true, [], _, e1), Rpresent None when not fixed1 ->
--      set_row_field e1 f2
--  | Rpresent None, Reither(true, [], _, e2) when not fixed2 ->
--      set_row_field e2 f1
-   | _ -> raise (Unify [])
-     
- 
-@@ -1920,6 +1970,166 @@
-                         (*  Matching between type schemes  *)
-                         (***********************************)
- 
-+(* Forward declaration (order should be reversed...) *)
-+let equal' = ref (fun _ -> failwith "Ctype.equal'")
-+
-+let make_generics_univars tyl =
-+  let polyvars = ref TypeSet.empty in
-+  let rec make_rec ty =
-+    let ty = repr ty in
-+    if ty.level = generic_level then begin
-+      if ty.desc = Tvar  then begin
-+        log_type ty;
-+        ty.desc <- Tunivar;
-+        polyvars := TypeSet.add ty !polyvars
-+      end
-+      else if ty.desc = Tunivar then set_level ty (generic_level - 1);
-+      ty.level <- pivot_level - generic_level;
-+      iter_type_expr make_rec ty
-+    end
-+  in
-+  List.iter make_rec tyl;
-+  List.iter unmark_type tyl;
-+  !polyvars
-+
-+(* New version of moregeneral, using unification *)
-+
-+let copy_cond (p,tpl,l,row) =
-+  let row =
-+    match repr (copy (newgenty (Tvariant row))) with
-+      {desc=Tvariant row} -> row
-+    | _ -> assert false
-+  and pairs =
-+    List.map (fun (t1,t2) -> copy t1, copy t2) tpl in
-+  (p, pairs, l, row)
-+
-+let get_row_field l row =
-+  try row_field_repr (List.assoc l (row_repr row).row_fields)
-+  with Not_found -> Rabsent
-+
-+let rec check_conditional_list env cdtls pattvars tpls =
-+  match cdtls with
-+    [] ->
-+      let finished =
-+        List.for_all (fun (_,t1,t2) -> !equal' env false [t1] [t2]) tpls in
-+      if not finished then begin
-+        let polyvars = make_generics_univars pattvars in
-+        delayed_conditionals := [];
-+        allowed_univars := polyvars;
-+        List.iter (fun (pairs, ty1, ty2) -> unify_pairs env ty1 ty2 pairs)
-+          tpls;
-+        check_conditionals env polyvars !delayed_conditionals
-+      end
-+  | (pairs, tpl1, l, row2 as cond) :: cdtls ->
-+      let cont = check_conditional_list env cdtls pattvars in
-+      let tpl1 =
-+        List.filter (fun (t1,t2) -> not (!equal' env false [t1] [t2])) tpl1 in
-+      let included =
-+        List.for_all
-+          (fun (t1,t2) ->
-+            List.exists
-+              (fun (_,t1',t2') -> !equal' env false [t1;t2] [t1';t2'])
-+              tpls)
-+          tpl1 in
-+      if included then cont tpls else
-+      match get_row_field l row2 with
-+        Rpresent _ ->
-+          cont (List.map (fun (t1,t2) -> (pairs,t1,t2)) tpl1 @ tpls)
-+      | Rabsent -> cont tpls
-+      | Reither (c, tl2, _, _, _) ->
-+          cont tpls;
-+          if c && tl2 <> [] then () (* cannot succeed *) else
-+          let (pairs, tpl1, l, row2) = copy_cond cond
-+          and tpls = List.map (fun (p,t1,t2) -> p, copy t1, copy t2) tpls
-+          and pattvars = List.map copy pattvars
-+          and cdtls = List.map copy_cond cdtls in
-+          cleanup_types ();
-+          let tl2, tpl2, e2 =
-+            match get_row_field l row2 with
-+              Reither (c, tl2, _, tpl2, e2) -> tl2, tpl2, e2
-+            | _ -> assert false
-+          in
-+          let snap = Btype.snapshot () in
-+          let ok =
-+            try
-+              begin match tl2 with
-+                [] ->
-+                  set_row_field e2 (Rpresent None)
-+              | t::tl ->
-+                  set_row_field e2 (Rpresent (Some t));
-+                  List.iter (unify env t) tl
-+              end;
-+              List.iter (fun (t1,t2) -> unify_pairs env t1 t2 pairs) tpl2;
-+              true
-+            with exn ->
-+              Btype.backtrack snap;
-+              false
-+          in
-+            (* This is not [cont] : types have been copied *)
-+          if ok then
-+            check_conditional_list env cdtls pattvars
-+              (List.map (fun (t1,t2) -> (pairs,t1,t2)) tpl1 @ tpls)
-+
-+and check_conditionals env polyvars cdtls =
-+  let cdtls = List.map copy_cond cdtls in
-+  let pattvars = ref [] in
-+  TypeSet.iter
-+    (fun ty ->
-+      let ty = repr ty in
-+      match ty.desc with
-+        Tsubst ty ->
-+          let ty = repr ty in
-+          begin match ty.desc with
-+            Tunivar ->
-+              log_type ty;
-+              ty.desc <- Tvar;
-+              pattvars := ty :: !pattvars
-+          | Ttuple [tv;_] ->
-+              if tv.desc = Tunivar then
-+                (log_type tv; tv.desc <- Tvar; pattvars := ty :: !pattvars)
-+              else if tv.desc <> Tvar then assert false
-+          | Tvar -> ()
-+          | _ -> assert false
-+          end
-+      | _ -> ())
-+    polyvars;
-+  cleanup_types ();
-+  check_conditional_list env cdtls !pattvars []
-+  
-+
-+(* Must empty univar_pairs first *)
-+let unify_poly env polyvars subj patt =
-+  let old_level = !current_level in
-+  current_level := generic_level;
-+  delayed_conditionals := [];
-+  allowed_univars := polyvars;
-+  try
-+    unify env subj patt;
-+    check_conditionals env polyvars !delayed_conditionals;
-+    current_level := old_level;
-+    allowed_univars := TypeSet.empty;
-+    delayed_conditionals := []
-+  with exn ->
-+    current_level := old_level;
-+    allowed_univars := TypeSet.empty;
-+    delayed_conditionals := [];
-+    raise exn
-+
-+let moregeneral env _ subj patt =
-+  let old_level = !current_level in
-+  current_level := generic_level;
-+  let subj = instance subj
-+  and patt = instance patt in
-+  let polyvars = make_generics_univars [patt] in
-+  current_level := old_level;
-+  let snap = Btype.snapshot () in
-+  try
-+    unify_poly env polyvars subj patt;
-+    true
-+  with Unify _ ->
-+    Btype.backtrack snap;
-+    false
-+
- (*
-    Update the level of [ty]. First check that the levels of generic
-    variables from the subject are not lowered.
-@@ -2072,35 +2282,101 @@
-         Rpresent(Some t1), Rpresent(Some t2) ->
-           moregen inst_nongen type_pairs env t1 t2
-       | Rpresent None, Rpresent None -> ()
--      | Reither(false, tl1, _, e1), Rpresent(Some t2) when not univ ->
-+      | Reither(false, tl1, _, [], e1), Rpresent(Some t2) when not univ ->
-           set_row_field e1 f2;
-           List.iter (fun t1 -> moregen inst_nongen type_pairs env t1 t2) tl1
--      | Reither(c1, tl1, _, e1), Reither(c2, tl2, m2, e2) ->
-+      | Reither(c1, tl1, _, tpl1, e1), Reither(c2, tl2, m2, tpl2, e2) ->
-           if e1 != e2 then begin
-             if c1 && not c2 then raise(Unify []);
--            set_row_field e1 (Reither (c2, [], m2, e2));
--            if List.length tl1 = List.length tl2 then
--              List.iter2 (moregen inst_nongen type_pairs env) tl1 tl2
--            else match tl2 with
--              t2 :: _ ->
-+            let tpl' = if tpl1 = [] then tpl2 else [] in
-+            set_row_field e1 (Reither (c2, [], m2, tpl', e2));
-+            begin match tl2 with
-+              [t2] ->
-                 List.iter (fun t1 -> moregen inst_nongen type_pairs env t1 t2)
-                   tl1
--            | [] ->
--                if tl1 <> [] then raise (Unify [])
-+            | _ ->
-+                if List.length tl1 <> List.length tl2 then raise (Unify []);
-+                List.iter2 (moregen inst_nongen type_pairs env) tl1 tl2
-+            end;
-+            if tpl1 <> [] then
-+              delayed_conditionals :=
-+                (!univar_pairs, tpl1, l, row2) :: !delayed_conditionals
-           end
--      | Reither(true, [], _, e1), Rpresent None when not univ ->
-+      | Reither(true, [], _, [], e1), Rpresent None when not univ ->
-           set_row_field e1 f2
--      | Reither(_, _, _, e1), Rabsent when not univ ->
-+      | Reither(_, _, _, [], e1), Rabsent when not univ ->
-           set_row_field e1 f2
-       | Rabsent, Rabsent -> ()
-       | _ -> raise (Unify []))
-     pairs
- 
-+let check_conditional env (pairs, tpl1, l, row2) tpls cont =
-+  let tpl1 =
-+    List.filter (fun (t1,t2) -> not (!equal' env false [t1] [t2])) tpl1 in
-+  let included =
-+    List.for_all
-+      (fun (t1,t2) ->
-+        List.exists (fun (t1',t2') -> !equal' env false [t1;t2] [t1';t2'])
-+          tpls)
-+      tpl1 in
-+  if tpl1 = [] || included then cont tpls else
-+  match get_row_field l row2 with
-+    Rpresent _ -> cont (tpl1 @ tpls)
-+  | Rabsent -> cont tpls
-+  | Reither (c, tl2, _, tpl2, e2) ->
-+      if not c || tl2 = [] then begin
-+        let snap = Btype.snapshot () in
-+        let ok =
-+          try
-+            begin match tl2 with
-+              [] ->
-+                set_row_field e2 (Rpresent None)
-+            | t::tl ->
-+                set_row_field e2 (Rpresent (Some t));
-+                List.iter (unify env t) tl
-+            end;
-+            List.iter (fun (t1,t2) -> unify_pairs env t1 t2 pairs) tpl2;
-+            true
-+          with Unify _ -> false
-+        in
-+        if ok then cont (tpl1 @ tpls);
-+        Btype.backtrack snap
-+      end;
-+      cont tpls
-+
-+let rec check_conditionals inst_nongen env cdtls tpls =
-+  match cdtls with
-+    [] ->
-+      let tpls =
-+        List.filter (fun (t1,t2) -> not (!equal' env false [t1] [t2])) tpls in
-+      if tpls = [] then () else begin
-+        delayed_conditionals := [];
-+        let tl1, tl2 = List.split tpls in
-+        let type_pairs = TypePairs.create 13 in
-+        List.iter2 (moregen false type_pairs env) tl2 tl1;
-+        check_conditionals inst_nongen env !delayed_conditionals []
-+      end
-+  | cdtl :: cdtls ->
-+      check_conditional env cdtl tpls
-+        (check_conditionals inst_nongen env cdtls)
-+
-+
- (* Must empty univar_pairs first *)
- let moregen inst_nongen type_pairs env patt subj =
-   univar_pairs := [];
--  moregen inst_nongen type_pairs env patt subj
-+  delayed_conditionals := [];
-+  try
-+    moregen inst_nongen type_pairs env patt subj;
-+    check_conditionals inst_nongen env !delayed_conditionals [];
-+    univar_pairs := [];
-+    delayed_conditionals := []
-+  with exn ->
-+    univar_pairs := [];
-+    delayed_conditionals := [];
-+    raise exn
-+
- 
-+(* old implementation
- (*
-    Non-generic variable can be instanciated only if [inst_nongen] is
-    true. So, [inst_nongen] should be set to false if the subject might
-@@ -2128,6 +2404,7 @@
-   in
-   current_level := old_level;
-   res
-+*)
- 
- 
- (* Alternative approach: "rigidify" a type scheme,
-@@ -2296,30 +2573,36 @@
-     {desc=Tvariant row2} -> eqtype_row rename type_pairs subst env row1 row2
-   | _ -> raise Cannot_expand
-   with Cannot_expand ->
-+  let eqtype_rec = eqtype rename type_pairs subst env in
-   let row1 = row_repr row1 and row2 = row_repr row2 in
-   let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
-   if row1.row_closed <> row2.row_closed
-   || not row1.row_closed && (r1 <> [] || r2 <> [])
-   || filter_row_fields false (r1 @ r2) <> []
-   then raise (Unify []);
--  if not (static_row row1) then
--    eqtype rename type_pairs subst env row1.row_more row2.row_more;
-+  if not (static_row row1) then eqtype_rec row1.row_more row2.row_more;
-   List.iter
-     (fun (_,f1,f2) ->
-       match row_field_repr f1, row_field_repr f2 with
-         Rpresent(Some t1), Rpresent(Some t2) ->
--          eqtype rename type_pairs subst env t1 t2
--      | Reither(true, [], _, _), Reither(true, [], _, _) ->
--          ()
--      | Reither(false, t1::tl1, _, _), Reither(false, t2::tl2, _, _) ->
--          eqtype rename type_pairs subst env t1 t2;
-+          eqtype_rec t1 t2
-+      | Reither(true, [], _, tp1, _), Reither(true, [], _, tp2, _) ->
-+          List.iter2
-+            (fun (t1,t1') (t2,t2') -> eqtype_rec t1 t2; eqtype_rec t1' t2')
-+            tp1 tp2
-+      | Reither(false, t1::tl1, _, tpl1, _),
-+        Reither(false, t2::tl2, _, tpl2, _) ->
-+          eqtype_rec t1 t2;
-+          List.iter2
-+            (fun (t1,t1') (t2,t2') -> eqtype_rec t1 t2; eqtype_rec t1' t2')
-+            tpl1 tpl2;
-           if List.length tl1 = List.length tl2 then
-             (* if same length allow different types (meaning?) *)
--            List.iter2 (eqtype rename type_pairs subst env) tl1 tl2
-+            List.iter2 eqtype_rec tl1 tl2
-           else begin
-             (* otherwise everything must be equal *)
--            List.iter (eqtype rename type_pairs subst env t1) tl2;
--            List.iter (fun t1 -> eqtype rename type_pairs subst env t1 t2) tl1
-+            List.iter (eqtype_rec t1) tl2;
-+            List.iter (fun t1 -> eqtype_rec t1 t2) tl1
-           end
-       | Rpresent None, Rpresent None -> ()
-       | Rabsent, Rabsent -> ()
-@@ -2334,6 +2617,8 @@
-   with
-     Unify _ -> false
- 
-+let () = equal' := equal
-+
- (* Must empty univar_pairs first *)  
- let eqtype rename type_pairs subst env t1 t2 =
-   univar_pairs := [];
-@@ -2770,14 +3055,14 @@
-           (fun (l,f as orig) -> match row_field_repr f with
-             Rpresent None ->
-               if posi then
--                (l, Reither(true, [], false, ref None)), Unchanged
-+                (l, Reither(true, [], false, [], ref None)), Unchanged
-               else
-                 orig, Unchanged
-           | Rpresent(Some t) ->
-               let (t', c) = build_subtype env visited loops posi level' t in
-               if posi && level > 0 then begin
-                 bound := t' :: !bound;
--                (l, Reither(false, [t'], false, ref None)), c
-+                (l, Reither(false, [t'], false, [], ref None)), c
-               end else
-                 (l, Rpresent(Some t')), c
-           | _ -> assert false)
-@@ -2960,11 +3245,11 @@
-       List.fold_left
-         (fun cstrs (_,f1,f2) ->
-           match row_field_repr f1, row_field_repr f2 with
--            (Rpresent None|Reither(true,_,_,_)), Rpresent None ->
-+            (Rpresent None|Reither(true,_,_,[],_)), Rpresent None ->
-               cstrs
-           | Rpresent(Some t1), Rpresent(Some t2) ->
-               subtype_rec env ((t1, t2)::trace) t1 t2 cstrs
--          | Reither(false, t1::_, _, _), Rpresent(Some t2) ->
-+          | Reither(false, t1::_, _, [], _), Rpresent(Some t2) ->
-               subtype_rec env ((t1, t2)::trace) t1 t2 cstrs
-           | Rabsent, _ -> cstrs
-           | _ -> raise Exit)
-@@ -2977,11 +3262,11 @@
-         (fun cstrs (_,f1,f2) ->
-           match row_field_repr f1, row_field_repr f2 with
-             Rpresent None, Rpresent None
--          | Reither(true,[],_,_), Reither(true,[],_,_)
-+          | Reither(true,[],_,[],_), Reither(true,[],_,[],_)
-           | Rabsent, Rabsent ->
-               cstrs
-           | Rpresent(Some t1), Rpresent(Some t2)
--          | Reither(false,[t1],_,_), Reither(false,[t2],_,_) ->
-+          | Reither(false,[t1],_,[],_), Reither(false,[t2],_,[],_) ->
-               subtype_rec env ((t1, t2)::trace) t1 t2 cstrs
-           | _ -> raise Exit)
-         cstrs pairs
-@@ -3079,16 +3364,26 @@
-       let fields = List.map
-           (fun (l,f) ->
-             let f = row_field_repr f in l,
--            match f with Reither(b, ty::(_::_ as tyl), m, e) ->
--              let tyl' =
--                List.fold_left
--                  (fun tyl ty ->
--                    if List.exists (fun ty' -> equal env false [ty] [ty']) tyl
--                    then tyl else ty::tyl)
--                  [ty] tyl
-+            match f with Reither(b, tyl, m, tp, e) ->
-+              let rem_dbl eq l =
-+                List.rev
-+                  (List.fold_left
-+                     (fun xs x -> if List.exists (eq x) xs then xs else x::xs)
-+                     [] l)
-+              in
-+              let tyl' = rem_dbl (fun t1 t2 -> equal env false [t1] [t2]) tyl
-+              and tp' =
-+                  List.filter
-+                    (fun (ty1,ty2) -> not (equal env false [ty1] [ty2])) tp
-+              in
-+              let tp' =
-+                rem_dbl
-+                  (fun (t1,t2) (t1',t2') -> equal env false [t1;t2] [t1';t2'])
-+                  tp'
-               in
--              if List.length tyl' <= List.length tyl then
--                let f = Reither(b, List.rev tyl', m, ref None) in
-+              if List.length tyl' < List.length tyl
-+              || List.length tp' < List.length tp then
-+                let f = Reither(b, tyl', m, tp', ref None) in
-                 set_row_field e f;
-                 f
-               else f
-@@ -3344,9 +3639,9 @@
-       List.iter
-         (fun (l,fi) ->
-           match row_field_repr fi with
--            Reither (c, t1::(_::_ as tl), m, e) ->
-+            Reither (c, t1::(_::_ as tl), m, tp, e) ->
-               List.iter (unify env t1) tl;
--              set_row_field e (Reither (c, [t1], m, ref None))
-+              set_row_field e (Reither (c, [t1], m, tp, ref None))
-           | _ ->
-               ())
-         row.row_fields;
-Index: typing/includecore.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/includecore.ml,v
-retrieving revision 1.32
-diff -u -r1.32 includecore.ml
---- typing/includecore.ml	8 Aug 2005 05:40:52 -0000	1.32
-+++ typing/includecore.ml	2 Feb 2006 06:28:32 -0000
-@@ -71,10 +71,10 @@
- 	(fun (_, f1, f2) ->
- 	  match Btype.row_field_repr f1, Btype.row_field_repr f2 with
- 	    Rpresent(Some t1),
--	    (Rpresent(Some t2) | Reither(false, [t2], _, _)) ->
-+	    (Rpresent(Some t2) | Reither(false,[t2],_,[],_)) ->
- 	      to_equal := (t1,t2) :: !to_equal; true
--	  | Rpresent None, (Rpresent None | Reither(true, [], _, _)) -> true
--	  | Reither(c1,tl1,_,_), Reither(c2,tl2,_,_)
-+	  | Rpresent None, (Rpresent None | Reither(true,[],_,[],_)) -> true
-+	  | Reither(c1,tl1,_,[],_), Reither(c2,tl2,_,[],_)
- 	    when List.length tl1 = List.length tl2 && c1 = c2 ->
- 	      to_equal := List.combine tl1 tl2 @ !to_equal; true
- 	  | Rabsent, (Reither _ | Rabsent) -> true
-Index: typing/oprint.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/oprint.ml,v
-retrieving revision 1.22
-diff -u -r1.22 oprint.ml
---- typing/oprint.ml	23 Mar 2005 03:08:37 -0000	1.22
-+++ typing/oprint.ml	2 Feb 2006 06:28:33 -0000
-@@ -223,14 +223,18 @@
-       print_fields rest ppf []
-   | (s, t) :: l ->
-       fprintf ppf "%s : %a;@ %a" s print_out_type t (print_fields rest) l
--and print_row_field ppf (l, opt_amp, tyl) =
-+and print_row_field ppf (l, opt_amp, tyl, tpl) =
-   let pr_of ppf =
-     if opt_amp then fprintf ppf " of@ &@ "
-     else if tyl <> [] then fprintf ppf " of@ "
--    else fprintf ppf ""
--  in
--  fprintf ppf "@[`%s%t%a@]" l pr_of (print_typlist print_out_type " &")
--    tyl
-+  and pr_tp ppf (t1,t2) =
-+    fprintf ppf "@[%a =@ %a@]"
-+      print_out_type t1
-+      print_out_type t2
-+  in
-+  fprintf ppf "@[`%s%t%a%a@]" l pr_of
-+    (print_typlist print_out_type " &") tyl
-+    (print_list_init pr_tp (fun ppf -> fprintf ppf " &@ ")) tpl
- and print_typlist print_elem sep ppf =
-   function
-     [] -> ()
-Index: typing/outcometree.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/outcometree.mli,v
-retrieving revision 1.14
-diff -u -r1.14 outcometree.mli
---- typing/outcometree.mli	23 Mar 2005 03:08:37 -0000	1.14
-+++ typing/outcometree.mli	2 Feb 2006 06:28:33 -0000
-@@ -61,7 +61,8 @@
-       bool * out_variant * bool * (string list) option
-   | Otyp_poly of string list * out_type
- and out_variant =
--  | Ovar_fields of (string * bool * out_type list) list
-+  | Ovar_fields of
-+      (string * bool * out_type list * (out_type * out_type) list ) list
-   | Ovar_name of out_ident * out_type list
- 
- type out_class_type =
-Index: typing/parmatch.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/parmatch.ml,v
-retrieving revision 1.70
-diff -u -r1.70 parmatch.ml
---- typing/parmatch.ml	24 Mar 2005 17:20:54 -0000	1.70
-+++ typing/parmatch.ml	2 Feb 2006 06:28:33 -0000
-@@ -568,11 +568,11 @@
-     List.fold_left
-       (fun nm (tag,f) ->
-         match Btype.row_field_repr f with
--        | Reither(_, _, false, e) ->
-+        | Reither(_, _, false, _, e) ->
-             (* m=false means that this tag is not explicitly matched *)
-             Btype.set_row_field e Rabsent;
-             None
--        | Rabsent | Reither (_, _, true, _) | Rpresent _ -> nm)
-+        | Rabsent | Reither (_, _, true, _, _) | Rpresent _ -> nm)
-       row.row_name row.row_fields in
-   if not row.row_closed || nm != row.row_name then begin
-     (* this unification cannot fail *)
-@@ -605,8 +605,8 @@
-       List.for_all
-         (fun (tag,f) ->
-           match Btype.row_field_repr f with
--            Rabsent | Reither(_, _, false, _) -> true
--          | Reither (_, _, true, _)
-+            Rabsent | Reither(_, _, false, _, _) -> true
-+          | Reither (_, _, true, _, _)
-               (* m=true, do not discard matched tags, rather warn *)
-           | Rpresent _ -> List.mem tag fields)
-         row.row_fields
-@@ -739,7 +739,7 @@
-           match Btype.row_field_repr f with
-             Rabsent (* | Reither _ *) -> others
-           (* This one is called after erasing pattern info *)
--          | Reither (c, _, _, _) -> make_other_pat tag c :: others
-+          | Reither (c, _, _, _, _) -> make_other_pat tag c :: others
-           | Rpresent arg -> make_other_pat tag (arg = None) :: others)
-         [] row.row_fields
-     with
-Index: typing/printtyp.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/printtyp.ml,v
-retrieving revision 1.140
-diff -u -r1.140 printtyp.ml
---- typing/printtyp.ml	4 Jan 2006 16:55:50 -0000	1.140
-+++ typing/printtyp.ml	2 Feb 2006 06:28:33 -0000
-@@ -157,9 +157,12 @@
- and raw_field ppf = function
-     Rpresent None -> fprintf ppf "Rpresent None"
-   | Rpresent (Some t) -> fprintf ppf "@[<1>Rpresent(Some@,%a)@]" raw_type t
--  | Reither (c,tl,m,e) ->
--      fprintf ppf "@[Reither(%b,@,%a,@,%b,@,@[<1>ref%t@])@]" c
--        raw_type_list tl m
-+  | Reither (c,tl,m,tpl,e) ->
-+      fprintf ppf "@[Reither(%b,@,%a,@,%b,@,%a,@,@[<1>ref%t@])@]"
-+        c raw_type_list tl m
-+        (raw_list
-+           (fun ppf (t1,t2) ->
-+             fprintf ppf "@[%a,@,%a@]" raw_type t1 raw_type t2)) tpl
-         (fun ppf ->
-           match !e with None -> fprintf ppf " None"
-           | Some f -> fprintf ppf "@,@[<1>(%a)@]" raw_field f)
-@@ -219,8 +222,9 @@
-   List.for_all
-     (fun (_, f) ->
-        match row_field_repr f with
--       | Reither(c, l, _, _) ->
--           row.row_closed && if c then l = [] else List.length l = 1
-+       | Reither(c, l, _, pl, _) ->
-+           row.row_closed && pl = [] &&
-+           if c then l = [] else List.length l = 1
-        | _ -> true)
-     row.row_fields
- 
-@@ -392,13 +396,16 @@
- 
- and tree_of_row_field sch (l, f) =
-   match row_field_repr f with
--  | Rpresent None | Reither(true, [], _, _) -> (l, false, [])
--  | Rpresent(Some ty) -> (l, false, [tree_of_typexp sch ty])
--  | Reither(c, tyl, _, _) ->
--      if c (* contradiction: un constructeur constant qui a un argument *)
--      then (l, true, tree_of_typlist sch tyl)
--      else (l, false, tree_of_typlist sch tyl)
--  | Rabsent -> (l, false, [] (* une erreur, en fait *))
-+  | Rpresent None | Reither(true, [], _, [], _) -> (l, false, [], [])
-+  | Rpresent(Some ty) -> (l, false, [tree_of_typexp sch ty], [])
-+  | Reither(c, tyl, _, tpl, _) ->
-+      let ttpl =
-+        List.map
-+          (fun (t1,t2) -> tree_of_typexp sch t1, tree_of_typexp sch t2)
-+          tpl
-+      in
-+      (l, c && tpl = [], tree_of_typlist sch tyl, ttpl)
-+  | Rabsent -> (l, false, [], [] (* une erreur, en fait *))
- 
- and tree_of_typlist sch tyl =
-   List.map (tree_of_typexp sch) tyl
-Index: typing/typeclass.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typeclass.ml,v
-retrieving revision 1.85
-diff -u -r1.85 typeclass.ml
---- typing/typeclass.ml	22 Jul 2005 06:42:36 -0000	1.85
-+++ typing/typeclass.ml	2 Feb 2006 06:28:33 -0000
-@@ -727,7 +727,7 @@
-         {pexp_loc = loc; pexp_desc =
-          Pexp_match({pexp_loc = loc; pexp_desc =
-                      Pexp_ident(Longident.Lident"*opt*")},
--                    scases)} in
-+                    scases, false)} in
-       let sfun =
-         {pcl_loc = scl.pcl_loc; pcl_desc =
-          Pcl_fun(l, None, {ppat_loc = loc; ppat_desc = Ppat_var"*opt*"},
-Index: typing/typecore.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typecore.ml,v
-retrieving revision 1.178
-diff -u -r1.178 typecore.ml
---- typing/typecore.ml	6 Jan 2006 02:25:37 -0000	1.178
-+++ typing/typecore.ml	2 Feb 2006 06:28:33 -0000
-@@ -156,15 +156,21 @@
-       let field = row_field tag row in
-       begin match field with
-       | Rabsent -> assert false
--      | Reither (true, [], _, e) when not row.row_closed ->
--          set_row_field e (Rpresent None)
--      | Reither (false, ty::tl, _, e) when not row.row_closed ->
-+      | Reither (true, [], _, tpl, e) when not row.row_closed ->
-+          set_row_field e (Rpresent None);
-+          List.iter
-+            (fun (t1,t2) -> unify_pat pat.pat_env {pat with pat_type=t1} t2)
-+            tpl
-+      | Reither (false, ty::tl, _, tpl, e) when not row.row_closed ->
-           set_row_field e (Rpresent (Some ty));
-+          List.iter
-+            (fun (t1,t2) -> unify_pat pat.pat_env {pat with pat_type=t1} t2)
-+            tpl;
-           begin match opat with None -> assert false
-           | Some pat -> List.iter (unify_pat pat.pat_env pat) (ty::tl)
-           end
--      | Reither (c, l, true, e) when not row.row_fixed ->
--          set_row_field e (Reither (c, [], false, ref None))
-+      | Reither (c, l, true, tpl, e) when not row.row_fixed ->
-+          set_row_field e (Reither (c, [], false, [], ref None))
-       | _ -> ()
-       end;
-       (* Force check of well-formedness *)
-@@ -307,13 +313,13 @@
-         match row_field_repr f with
-           Rpresent None ->
-             (l,None) :: pats,
--            (l, Reither(true,[], true, ref None)) :: fields
-+            (l, Reither(true,[], true, [], ref None)) :: fields
-         | Rpresent (Some ty) ->
-             bound := ty :: !bound;
-             (l, Some {pat_desc=Tpat_any; pat_loc=Location.none; pat_env=env;
-                       pat_type=ty})
-             :: pats,
--            (l, Reither(false, [ty], true, ref None)) :: fields
-+            (l, Reither(false, [ty], true, [], ref None)) :: fields
-         | _ -> pats, fields)
-       ([],[]) fields in
-   let row =
-@@ -337,6 +343,18 @@
-           pat pats in
-       rp { r with pat_loc = loc }
- 
-+let rec flatten_or_pat pat =
-+  match pat.pat_desc with
-+    Tpat_or (p1, p2, _) ->
-+      flatten_or_pat p1 @ flatten_or_pat p2
-+  | _ ->
-+      [pat]
-+
-+let all_variants pat =
-+  List.for_all
-+    (function {pat_desc=Tpat_variant _} -> true | _ -> false)
-+    (flatten_or_pat pat)
-+
- let rec find_record_qual = function
-   | [] -> None
-   | (Longident.Ldot (modname, _), _) :: _ -> Some modname
-@@ -423,7 +441,7 @@
-       let arg = may_map (type_pat env) sarg in
-       let arg_type = match arg with None -> [] | Some arg -> [arg.pat_type]  in
-       let row = { row_fields =
--                    [l, Reither(arg = None, arg_type, true, ref None)];
-+                    [l, Reither(arg = None, arg_type, true, [], ref None)];
-                   row_bound = arg_type;
-                   row_closed = false;
-                   row_more = newvar ();
-@@ -788,7 +806,7 @@
-        newty (Tarrow(p, type_option (newvar ()), type_approx env e, Cok))
-   | Pexp_function (p,_,(_,e)::_) ->
-        newty (Tarrow(p, newvar (), type_approx env e, Cok))
--  | Pexp_match (_, (_,e)::_) -> type_approx env e
-+  | Pexp_match (_, (_,e)::_, false) -> type_approx env e
-   | Pexp_try (e, _) -> type_approx env e
-   | Pexp_tuple l -> newty (Ttuple(List.map (type_approx env) l))
-   | Pexp_ifthenelse (_,e,_) -> type_approx env e
-@@ -939,17 +957,26 @@
-         exp_loc = sexp.pexp_loc;
-         exp_type = ty_res;
-         exp_env = env }
--  | Pexp_match(sarg, caselist) ->
-+  | Pexp_match(sarg, caselist, multi) ->
-       let arg = type_exp env sarg in
-       let ty_res = newvar() in
-       let cases, partial =
--        type_cases env arg.exp_type ty_res (Some sexp.pexp_loc) caselist
-+        type_cases env arg.exp_type ty_res (Some sexp.pexp_loc) caselist ~multi
-       in
-       re {
-         exp_desc = Texp_match(arg, cases, partial);
-         exp_loc = sexp.pexp_loc;
-         exp_type = ty_res;
-         exp_env = env }
-+  | Pexp_multifun caselist ->
-+      let ty_arg = newvar() and ty_res = newvar() in
-+      let cases, partial =
-+        type_cases env ty_arg ty_res (Some sexp.pexp_loc) caselist ~multi:true
-+      in
-+      { exp_desc = Texp_function (cases, partial);
-+        exp_loc = sexp.pexp_loc;
-+        exp_type = newty (Tarrow ("", ty_arg, ty_res, Cok));
-+        exp_env = env }
-   | Pexp_try(sbody, caselist) ->
-       let body = type_exp env sbody in
-       let cases, _ =
-@@ -1758,7 +1785,7 @@
-         {pexp_loc = loc; pexp_desc =
-          Pexp_match({pexp_loc = loc; pexp_desc =
-                      Pexp_ident(Longident.Lident"*opt*")},
--                    scases)} in
-+                    scases, false)} in
-       let sfun =
-         {pexp_loc = sexp.pexp_loc; pexp_desc =
-          Pexp_function(l, None,[{ppat_loc = loc; ppat_desc = Ppat_var"*opt*"},
-@@ -1864,7 +1891,8 @@
- 
- (* Typing of match cases *)
- 
--and type_cases ?in_function env ty_arg ty_res partial_loc caselist =
-+and type_cases ?in_function ?(multi=false)
-+    env ty_arg ty_res partial_loc caselist =
-   let ty_arg' = newvar () in
-   let pattern_force = ref [] in
-   let pat_env_list =
-@@ -1898,10 +1926,64 @@
-   let cases =
-     List.map2
-       (fun (pat, ext_env) (spat, sexp) ->
--        let exp = type_expect ?in_function ext_env sexp ty_res in
--        (pat, exp))
--      pat_env_list caselist
--  in
-+        let add_variant_case lab row ty_res ty_res' =
-+          let fi = List.assoc lab (row_repr row).row_fields in
-+          begin match row_field_repr fi with
-+            Reither (c, _, m, _, e) ->
-+              let row' =
-+                { row_fields =
-+                  [lab, Reither(c,[],false,[ty_res,ty_res'], ref None)];
-+                  row_more = newvar (); row_bound = [ty_res; ty_res'];
-+                  row_closed = false; row_fixed = false; row_name = None }
-+              in
-+              unify_pat ext_env {pat with pat_type= newty (Tvariant row)}
-+                (newty (Tvariant row'))
-+          | _ ->
-+              unify_exp ext_env
-+                { exp_desc = Texp_tuple []; exp_type = ty_res;
-+                  exp_env = ext_env; exp_loc = sexp.pexp_loc }
-+                ty_res'
-+          end
-+        in
-+        pat,
-+        match pat.pat_desc with
-+          _ when multi && all_variants pat ->
-+            let ty_res' = newvar () in
-+            List.iter
-+              (function {pat_desc=Tpat_variant(lab,_,row)} ->
-+                add_variant_case lab row ty_res ty_res'
-+              | _ -> assert false)
-+              (flatten_or_pat pat);
-+            type_expect ?in_function ext_env sexp ty_res'
-+        | Tpat_alias (p, id) when multi && all_variants p ->
-+            let vd = Env.find_value (Path.Pident id) ext_env in
-+            let row' =
-+              match repr vd.val_type with
-+                {desc=Tvariant row'} -> row'
-+              | _ -> assert false
-+            in
-+            begin_def ();
-+            let tv = newvar () in
-+            let env = Env.add_value id {vd with val_type=tv} ext_env in
-+            let exp = type_exp env sexp in
-+            end_def ();
-+            generalize exp.exp_type;
-+            generalize tv;
-+            List.iter
-+              (function {pat_desc=Tpat_variant(lab,_,row)}, [tv'; ty'] ->
-+                let fi' = List.assoc lab (row_repr row').row_fields in
-+                let row' =
-+                  {row' with row_fields=[lab,fi']; row_more=newvar()} in
-+                unify_pat ext_env {pat with pat_type=tv'}
-+                  (newty (Tvariant row'));
-+                add_variant_case lab row ty_res ty'
-+              | _ -> assert false)
-+              (List.map (fun p -> p, instance_list [tv; exp.exp_type])
-+                 (flatten_or_pat p));
-+            {exp with exp_type = instance exp.exp_type}
-+        | _ ->
-+            type_expect ?in_function ext_env sexp ty_res)
-+      pat_env_list caselist in
-   let partial =
-     match partial_loc with None -> Partial
-     | Some loc -> Parmatch.check_partial loc cases
-Index: typing/typedecl.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typedecl.ml,v
-retrieving revision 1.75
-diff -u -r1.75 typedecl.ml
---- typing/typedecl.ml	16 Aug 2005 00:48:56 -0000	1.75
-+++ typing/typedecl.ml	2 Feb 2006 06:28:33 -0000
-@@ -432,8 +432,10 @@
-               match Btype.row_field_repr f with
-                 Rpresent (Some ty) ->
-                   compute_same ty
--              | Reither (_, tyl, _, _) ->
--                  List.iter compute_same tyl
-+              | Reither (_, tyl, _, tpl, _) ->
-+                  List.iter compute_same tyl;
-+                  List.iter (compute_variance_rec true true true)
-+                    (List.map fst tpl @ List.map snd tpl)
-               | _ -> ())
-             row.row_fields;
-           compute_same row.row_more
-@@ -856,8 +858,8 @@
-               explain row.row_fields
-                 (fun (l,f) -> match Btype.row_field_repr f with
-                   Rpresent (Some t) -> t
--                | Reither (_,[t],_,_) -> t
--                | Reither (_,tl,_,_) -> Btype.newgenty (Ttuple tl)
-+                | Reither (_,[t],_,_,_) -> t
-+                | Reither (_,tl,_,_,_) -> Btype.newgenty (Ttuple tl)
-                 | _ -> Btype.newgenty (Ttuple[]))
-                 "case" (fun (lab,_) -> "`" ^ lab ^ " of ")
-           | _ -> trivial ty'
-Index: typing/types.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/types.ml,v
-retrieving revision 1.25
-diff -u -r1.25 types.ml
---- typing/types.ml	9 Dec 2004 12:40:53 -0000	1.25
-+++ typing/types.ml	2 Feb 2006 06:28:33 -0000
-@@ -48,7 +48,9 @@
- 
- and row_field =
-     Rpresent of type_expr option
--  | Reither of bool * type_expr list * bool * row_field option ref
-+  | Reither of
-+      bool * type_expr list * bool *
-+      (type_expr * type_expr) list * row_field option ref
-   | Rabsent
- 
- and abbrev_memo =
-Index: typing/types.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/types.mli,v
-retrieving revision 1.25
-diff -u -r1.25 types.mli
---- typing/types.mli	9 Dec 2004 12:40:53 -0000	1.25
-+++ typing/types.mli	2 Feb 2006 06:28:33 -0000
-@@ -47,7 +47,9 @@
- 
- and row_field =
-     Rpresent of type_expr option
--  | Reither of bool * type_expr list * bool * row_field option ref
-+  | Reither of
-+      bool * type_expr list * bool *
-+      (type_expr * type_expr) list * row_field option ref
-         (* 1st true denotes a constant constructor *)
-         (* 2nd true denotes a tag in a pattern matching, and
-            is erased later *)
-Index: typing/typetexp.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typetexp.ml,v
-retrieving revision 1.54
-diff -u -r1.54 typetexp.ml
---- typing/typetexp.ml	22 Jul 2005 06:42:36 -0000	1.54
-+++ typing/typetexp.ml	2 Feb 2006 06:28:33 -0000
-@@ -207,9 +207,9 @@
-                 match Btype.row_field_repr f with
-                 | Rpresent (Some ty) ->
-                     bound := ty :: !bound;
--                    Reither(false, [ty], false, ref None)
-+                    Reither(false, [ty], false, [], ref None)
-                 | Rpresent None ->
--                    Reither (true, [], false, ref None)
-+                    Reither (true, [], false, [], ref None)
-                 | _ -> f)
-               row.row_fields
-           in
-@@ -273,13 +273,16 @@
-           (l, f) :: fields
-       in
-       let rec add_field fields = function
--          Rtag (l, c, stl) ->
-+          Rtag (l, c, stl, stpl) ->
-             name := None;
-             let f = match present with
-               Some present when not (List.mem l present) ->
--                let tl = List.map (transl_type env policy) stl in
--                bound := tl @ !bound;
--                Reither(c, tl, false, ref None)
-+                let transl_list = List.map (transl_type env policy) in
-+                let tl = transl_list stl in
-+                let stpl1, stpl2 = List.split stpl in
-+                let tpl1 = transl_list stpl1 and tpl2 = transl_list stpl2 in
-+                bound := tl @ tpl1 @ tpl2 @ !bound;
-+                Reither(c, tl, false, List.combine tpl1 tpl2, ref None)
-             | _ ->
-                 if List.length stl > 1 || c && stl <> [] then
-                   raise(Error(styp.ptyp_loc, Present_has_conjunction l));
-@@ -311,9 +314,9 @@
-                     begin match f with
-                       Rpresent(Some ty) ->
-                         bound := ty :: !bound;
--                        Reither(false, [ty], false, ref None)
-+                        Reither(false, [ty], false, [], ref None)
-                     | Rpresent None ->
--                        Reither(true, [], false, ref None)
-+                        Reither(true, [], false, [], ref None)
-                     | _ ->
-                         assert false
-                     end
-@@ -406,7 +409,8 @@
-               {row with row_fixed=true;
-                row_fields = List.map
-                  (fun (s,f as p) -> match Btype.row_field_repr f with
--                   Reither (c, tl, m, r) -> s, Reither (c, tl, true, r)
-+                   Reither (c, tl, m, tpl, r) ->
-+                     s, Reither (c, tl, true, tpl, r)
-                  | _ -> p)
-                  row.row_fields};
-         Btype.iter_row make_fixed_univars row
-Index: typing/unused_var.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/unused_var.ml,v
-retrieving revision 1.5
-diff -u -r1.5 unused_var.ml
---- typing/unused_var.ml	4 Jan 2006 16:55:50 -0000	1.5
-+++ typing/unused_var.ml	2 Feb 2006 06:28:33 -0000
-@@ -122,9 +122,11 @@
-   | Pexp_apply (e, lel) ->
-       expression ppf tbl e;
-       List.iter (fun (_, e) -> expression ppf tbl e) lel;
--  | Pexp_match (e, pel) ->
-+  | Pexp_match (e, pel, _) ->
-       expression ppf tbl e;
-       match_pel ppf tbl pel;
-+  | Pexp_multifun pel ->
-+      match_pel ppf tbl pel;
-   | Pexp_try (e, pel) ->
-       expression ppf tbl e;
-       match_pel ppf tbl pel;
-Index: bytecomp/matching.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/matching.ml,v
-retrieving revision 1.67
-diff -u -r1.67 matching.ml
---- bytecomp/matching.ml	7 Sep 2005 16:07:48 -0000	1.67
-+++ bytecomp/matching.ml	2 Feb 2006 06:28:33 -0000
-@@ -1991,7 +1991,7 @@
-     List.iter
-       (fun (_, f) ->
-         match Btype.row_field_repr f with
--          Rabsent | Reither(true, _::_, _, _) -> ()
-+          Rabsent | Reither(true, _::_, _, _, _) -> ()
-         | _ -> incr num_constr)
-       row.row_fields
-   else
-Index: toplevel/genprintval.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/toplevel/genprintval.ml,v
-retrieving revision 1.38
-diff -u -r1.38 genprintval.ml
---- toplevel/genprintval.ml	13 Jun 2005 04:55:53 -0000	1.38
-+++ toplevel/genprintval.ml	2 Feb 2006 06:28:33 -0000
-@@ -293,7 +293,7 @@
-                   | (l, f) :: fields ->
-                       if Btype.hash_variant l = tag then
-                         match Btype.row_field_repr f with
--                        | Rpresent(Some ty) | Reither(_,[ty],_,_) ->
-+                        | Rpresent(Some ty) | Reither(_,[ty],_,_,_) ->
-                             let args =
-                               tree_of_val (depth - 1) (O.field obj 1) ty in
-                             Oval_variant (l, Some args)
diff -Nru ocaml-3.12.1/testlabl/multimatch.ml ocaml-4.01.0/testlabl/multimatch.ml
--- ocaml-3.12.1/testlabl/multimatch.ml	2006-02-02 06:39:55.000000000 +0000
+++ ocaml-4.01.0/testlabl/multimatch.ml	1970-01-01 00:00:00.000000000 +0000
@@ -1,158 +0,0 @@
-(* Simple example *)
-let f x =
-  (multimatch x with `A -> 1 | `B -> true),
-  (multimatch x with `A -> 1. | `B -> "1");;
-
-(* OK *)
-module M : sig
-  val f :
-    [< `A & 'a = int & 'b = float | `B &   'b =string & 'a =  bool] -> 'a * 'b
-end = struct let f = f end;;
-
-(* Bad *)
-module M : sig
-  val f :
-    [< `A & 'a = int & 'b = float | `B &   'b =string & 'a =   int] -> 'a * 'b
-end = struct let f = f end;;
-
-(* Should be good! *)
-module M : sig
-  val f :
-    [< `A & 'a = int * float | `B & 'a = bool * string] -> 'a
-end = struct let f = f end;;
-
-let f = multifun `A|`B as x -> f x;;
-
-(* Two-level example *)
-let f = multifun
-    `A -> (multifun `C -> 1 | `D -> 1.)
-  | `B -> (multifun `C -> true | `D -> "1");;
-
-(* OK *)
-module M : sig
-  val f :
-    [< `A & 'b = [< `C & 'a = int | `D & 'a = float & 'c = bool] -> 'a
-     | `B & 'b = [< `C & 'c = bool | `D & 'c = string] -> 'c] -> 'b
-end = struct let f = f end;;
-
-(* Bad *)
-module M : sig
-  val f :
-    [< `A & 'b = [< `C & 'a = int | `D & 'a = bool] -> 'a
-     | `B & 'b = [< `C & 'c = bool | `D & 'c = string] -> 'c] -> 'b
-end = struct let f = f end;;
-
-module M : sig
-  val f :
-    [< `A & 'b = [< `C & 'a = int | `D] -> 'a
-     | `B & 'b = [< `C & 'c = bool | `D & 'c = string] -> 'c] -> 'b
-end = struct let f = f end;;
-
-
-(* Examples with hidden sharing *)
-let r = ref []
-let f = multifun `A -> 1 | `B -> true
-let g x = r := [f x];;
-
-(* Bad! *)
-module M : sig
-  val g : [< `A & 'a = int | `B & 'a = bool] -> unit
-end = struct let g = g end;;
-
-let r = ref []
-let f = multifun `A -> r | `B -> ref [];;
-(* Now OK *)
-module M : sig
-  val f : [< `A & 'b = int list ref | `B & 'b = 'c list ref] -> 'b
-end = struct let f = f end;;
-(* Still OK *)
-let l : int list ref = r;;
-module M : sig
-  val f : [< `A & 'b = int list ref | `B & 'b = 'c list ref] -> 'b
-end = struct let f = f end;;
-
-
-(* Examples that would need unification *)
-let f = multifun `A -> (1, []) | `B -> (true, [])
-let g x = fst (f x);;
-(* Didn't work, now Ok *)
-module M : sig
-  val g : [< `A & 'a * 'b = int * bool | `B & 'a * 'b = bool * int] -> 'a
-end = struct let g = g end;;
-let g = multifun (`A|`B) as x -> g x;;
-
-(* Other examples *)
-
-let f x =
-  let a = multimatch x with `A -> 1 | `B -> "1" in
-  (multifun `A -> print_int | `B -> print_string) x a
-;;
-
-let f = multifun (`A|`B) as x -> f x;;
-
-type unit_op = [`Set of int | `Move of int]
-type int_op = [`Get]
-
-let op r =
-  multifun
-    `Get     -> !r
-  | `Set x   -> r := x
-  | `Move dx -> r := !r + dx
-;;
-
-let rec trace r = function
-    [] -> []
-  | op1 :: ops ->
-      multimatch op1 with
-        #int_op as op1 ->
-          let x = op r op1 in
-          x :: trace r ops
-      | #unit_op as op1 ->
-          op r op1;
-          trace r ops
-;;
-
-class point x = object
-  val mutable x : int = x
-  method get = x
-  method set y = x <- y
-  method move dx = x <- x + dx
-end;;
-
-let poly sort coeffs x =
-  let add, mul, zero =
-    multimatch sort with
-      `Int -> (+), ( * ), 0
-    | `Float -> (+.), ( *. ), 0.
-  in
-  let rec compute = function
-      []     -> zero
-    | c :: cs -> add c (mul x (compute cs))
-  in
-  compute coeffs
-;;
-
-module M : sig
-  val poly : [< `Int & 'a = int | `Float & 'a = float] -> 'a list -> 'a -> 'a
-end = struct let poly = poly end;;
-
-type ('a,'b) num_sort =
-  'b constraint 'b = [< `Int & 'a = int | `Float & 'a = float]
-module M : sig
-  val poly : ('a,_) num_sort -> 'a list -> 'a -> 'a
-end = struct let poly = poly end;;
-
-
-(* type dispatch *)
-
-type num = [ `Int | `Float ]
-let print0 = multifun
-    `Int -> print_int
-  | `Float -> print_float
-;;
-let print1 = multifun
-    #num as x -> print0 x
-  | `List t -> List.iter (print0 t)
-  | `Pair(t1,t2) -> (fun (x,y) -> print0 t1 x; print0 t2 y)
-;;
-print1 (`Pair(`Int,`Float)) (1,1.0);;
diff -Nru ocaml-3.12.1/testlabl/newlabels.ps ocaml-4.01.0/testlabl/newlabels.ps
--- ocaml-3.12.1/testlabl/newlabels.ps	1999-11-30 16:07:38.000000000 +0000
+++ ocaml-4.01.0/testlabl/newlabels.ps	1970-01-01 00:00:00.000000000 +0000
@@ -1,1458 +0,0 @@
-%!PS-Adobe-2.0
-%%Creator: dvipsk 5.78 p1.4 Copyright 1996-98 ASCII Corp.(www-ptex@ascii.co.jp)
-%%dvipsk 5.78 Copyright 1998 Radical Eye Software (www.radicaleye.com)
-%%Title: newlabels.dvi
-%%Pages: 2 0
-%%PageOrder: Ascend
-%%BoundingBox: 0 0 596 842
-%%EndComments
-%%BeginProcSet: PStoPS 1 15
-userdict begin
-[/showpage/erasepage/copypage]{dup where{pop dup load
- type/operatortype eq{1 array cvx dup 0 3 index cvx put
- bind def}{pop}ifelse}{pop}ifelse}forall
-[/letter/legal/executivepage/a4/a4small/b5/com10envelope
- /monarchenvelope/c5envelope/dlenvelope/lettersmall/note
- /folio/quarto/a5]{dup where{dup wcheck{exch{}put}
- {pop{}def}ifelse}{pop}ifelse}forall
-/setpagedevice {pop}bind 1 index where{dup wcheck{3 1 roll put}
- {pop def}ifelse}{def}ifelse
-/PStoPSmatrix matrix currentmatrix def
-/PStoPSxform matrix def/PStoPSclip{clippath}def
-/defaultmatrix{PStoPSmatrix exch PStoPSxform exch concatmatrix}bind def
-/initmatrix{matrix defaultmatrix setmatrix}bind def
-/initclip[{matrix currentmatrix PStoPSmatrix setmatrix
- [{currentpoint}stopped{$error/newerror false put{newpath}}
- {/newpath cvx 3 1 roll/moveto cvx 4 array astore cvx}ifelse]
- {[/newpath cvx{/moveto cvx}{/lineto cvx}
- {/curveto cvx}{/closepath cvx}pathforall]cvx exch pop}
- stopped{$error/errorname get/invalidaccess eq{cleartomark
- $error/newerror false put cvx exec}{stop}ifelse}if}bind aload pop
- /initclip dup load dup type dup/operatortype eq{pop exch pop}
- {dup/arraytype eq exch/packedarraytype eq or
-  {dup xcheck{exch pop aload pop}{pop cvx}ifelse}
-  {pop cvx}ifelse}ifelse
- {newpath PStoPSclip clip newpath exec setmatrix} bind aload pop]cvx def
-/initgraphics{initmatrix newpath initclip 1 setlinewidth
- 0 setlinecap 0 setlinejoin []0 setdash 0 setgray
- 10 setmiterlimit}bind def
-end
-%%EndProcSet
-%DVIPSCommandLine: dvips -f newlabels
-%DVIPSParameters: dpi=300
-%DVIPSSource:  TeX output 1999.10.26:1616
-%%BeginProcSet: tex.pro
-%!
-/TeXDict 300 dict def TeXDict begin /N{def}def /B{bind def}N /S{exch}N
-/X{S N}B /TR{translate}N /isls false N /vsize 11 72 mul N /hsize 8.5 72
-mul N /landplus90{false}def /@rigin{isls{[0 landplus90{1 -1}{-1 1}
-ifelse 0 0 0]concat}if 72 Resolution div 72 VResolution div neg scale
-isls{landplus90{VResolution 72 div vsize mul 0 exch}{Resolution -72 div
-hsize mul 0}ifelse TR}if Resolution VResolution vsize -72 div 1 add mul
-TR[matrix currentmatrix{dup dup round sub abs 0.00001 lt{round}if}
-forall round exch round exch]setmatrix}N /@landscape{/isls true N}B
-/@manualfeed{statusdict /manualfeed true put}B /@copies{/#copies X}B
-/FMat[1 0 0 -1 0 0]N /FBB[0 0 0 0]N /nn 0 N /IE 0 N /ctr 0 N /df-tail{
-/nn 8 dict N nn begin /FontType 3 N /FontMatrix fntrx N /FontBBox FBB N
-string /base X array /BitMaps X /BuildChar{CharBuilder}N /Encoding IE N
-end dup{/foo setfont}2 array copy cvx N load 0 nn put /ctr 0 N[}B /df{
-/sf 1 N /fntrx FMat N df-tail}B /dfs{div /sf X /fntrx[sf 0 0 sf neg 0 0]
-N df-tail}B /E{pop nn dup definefont setfont}B /ch-width{ch-data dup
-length 5 sub get}B /ch-height{ch-data dup length 4 sub get}B /ch-xoff{
-128 ch-data dup length 3 sub get sub}B /ch-yoff{ch-data dup length 2 sub
-get 127 sub}B /ch-dx{ch-data dup length 1 sub get}B /ch-image{ch-data
-dup type /stringtype ne{ctr get /ctr ctr 1 add N}if}B /id 0 N /rw 0 N
-/rc 0 N /gp 0 N /cp 0 N /G 0 N /sf 0 N /CharBuilder{save 3 1 roll S dup
-/base get 2 index get S /BitMaps get S get /ch-data X pop /ctr 0 N ch-dx
-0 ch-xoff ch-yoff ch-height sub ch-xoff ch-width add ch-yoff
-setcachedevice ch-width ch-height true[1 0 0 -1 -.1 ch-xoff sub ch-yoff
-.1 sub]{ch-image}imagemask restore}B /D{/cc X dup type /stringtype ne{]}
-if nn /base get cc ctr put nn /BitMaps get S ctr S sf 1 ne{dup dup
-length 1 sub dup 2 index S get sf div put}if put /ctr ctr 1 add N}B /I{
-cc 1 add D}B /bop{userdict /bop-hook known{bop-hook}if /SI save N @rigin
-0 0 moveto /V matrix currentmatrix dup 1 get dup mul exch 0 get dup mul
-add .99 lt{/QV}{/RV}ifelse load def pop pop}N /eop{SI restore userdict
-/eop-hook known{eop-hook}if showpage}N /@start{userdict /start-hook
-known{start-hook}if pop /VResolution X /Resolution X 1000 div /DVImag X
-/IE 256 array N 2 string 0 1 255{IE S dup 360 add 36 4 index cvrs cvn
-put}for pop 65781.76 div /vsize X 65781.76 div /hsize X}N /p{show}N
-/RMat[1 0 0 -1 0 0]N /BDot 260 string N /rulex 0 N /ruley 0 N /v{/ruley
-X /rulex X V}B /V{}B /RV statusdict begin /product where{pop false[
-(Display)(NeXT)(LaserWriter 16/600)]{dup length product length le{dup
-length product exch 0 exch getinterval eq{pop true exit}if}{pop}ifelse}
-forall}{false}ifelse end{{gsave TR -.1 .1 TR 1 1 scale rulex ruley false
-RMat{BDot}imagemask grestore}}{{gsave TR -.1 .1 TR rulex ruley scale 1 1
-false RMat{BDot}imagemask grestore}}ifelse B /QV{gsave newpath transform
-round exch round exch itransform moveto rulex 0 rlineto 0 ruley neg
-rlineto rulex neg 0 rlineto fill grestore}B /a{moveto}B /delta 0 N /tail
-{dup /delta X 0 rmoveto}B /M{S p delta add tail}B /b{S p tail}B /c{-4 M}
-B /d{-3 M}B /e{-2 M}B /f{-1 M}B /g{0 M}B /h{1 M}B /i{2 M}B /j{3 M}B /k{
-4 M}B /w{0 rmoveto}B /l{p -4 w}B /m{p -3 w}B /n{p -2 w}B /o{p -1 w}B /q{
-p 1 w}B /r{p 2 w}B /s{p 3 w}B /t{p 4 w}B /x{0 S rmoveto}B /y{3 2 roll p
-a}B /bos{/SS save N}B /eos{SS restore}B end
-
-%%EndProcSet
-TeXDict begin 39158280 55380996 1000 300 300 (newlabels.dvi)
-@start
-%DVIPSBitmapFont: Fa cmr6 6 2
-/Fa 2 51 df<187898181818181818181818181818FF08107D8F0F> 49
-D<1F00618040C08060C0600060006000C00180030006000C00102020207FC0FFC00B107F
-8F0F> I E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fb cmmi8 8 4
-/Fb 4 111 df 85 D<0300038003000000000000000000000000001C00240046
-0046008C000C0018001800180031003100320032001C0009177F960C> 105
-D<383C1E0044C6630047028100460301008E0703000C0603000C0603000C060300180C06
-00180C0620180C0C20180C0C40301804C0301807001B0E7F8D1F> 109
-D<383C0044C6004702004602008E06000C06000C06000C0600180C00180C401818401818
-80300980300E00120E7F8D15> I E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fc cmbx8 8 4
-/Fc 4 111 df<01800780FF80FF80078007800780078007800780078007800780078007
-800780078007800780FFF8FFF80D157D9414> 49 D<387C7C7C3800000000FCFC3C3C3C
-3C3C3C3C3C3C3C3CFFFF08187F970B> 105 D 109 D I
-E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fd cmsy8 8 3
-/Fd 3 93 df 0 D<020002000200C218F2783AE00F800F80
-3AE0F278C2180200020002000D0E7E8E12> 3 D<03F8001FFF003C07806000C0C00060C0
-0060C00060C00060C00060C00060C00060C00060C00060C00060C00060C00060C00060C0
-006040002013137E9218> 92 D E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fe cmtt12 12 43
-/Fe 43 125 df<01818003C3C003C3C003C3C003C3C003C3C003C3C07FFFF0FFFFF8FFFF
-F87FFFF00787800787800787800F8F800F0F000F0F000F0F000F0F007FFFF0FFFFF8FFFF
-F87FFFF01E1E001E1E001E1E001E1E001E1E001E1E000C0C00151E7E9D1A> 35
-D<00E00003F00007F8000738000E1C000E1C000E1C000E1C000E38000E39FC0E71FC07F1
-FC07E1C007C1C00781C00783800F83801FC3803DC70078E70070EE00E07E00E07E00E03C
-08E03C1CE07E1C70FF1C7FE7F83FC3F80F00E0161E7F9D1A> 38
-D<0038007800F001E003C007800F000E001C001C0038003800700070007000E000E000E0
-00E000E000E000E000E000E000E000700070007000380038001C001C000E000F00078003
-C001E000F8007800380D2878A21A> 40 D<6000F00078003C001E000F000780038001C0
-01C000E000E0007000700070003800380038003800380038003800380038003800700070
-007000E000E001C001C0038007800F001E003C007800F00060000D287CA21A> I<7FFFC0
-FFFFE0FFFFE07FFFC013047D901A> 45 D<00C001C001C003C007C00FC07FC0FDC071C0
-01C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C0
-7FFF7FFF7FFF101E7B9D1A> 49 D<03F8000FFE001FFF803C07C07801E07000E0E00070
-F00070F000706000700000700000700000E00000E00001C00003C0000780000F00001E00
-003C0000780000F00003E00007C0000F00001E00703C00707FFFF0FFFFF07FFFF0141E7D
-9D1A> I<03FC000FFF003FFFC03C03E07800E07800707800700000700000700000E00001
-E00007C003FF8003FF0003FFC00003E00000E0000070000078000038000038600038F000
-38F00078E000707000E07E03E03FFFC00FFF0001FC00151E7E9D1A> I<01FC0007FF001F
-FFC01F07C03C01E07800F07000707000707000707800F03800E01E03C00FFF8003FE0007
-FF001F8FC03C01E07800F0700070E00038E00038E00038E00038F000787000707800F03E
-03E01FFFC007FF0001FC00151E7E9D1A> 56 D<01F00007FC001FFE003E0F0038078070
-03807001C0E001C0E001C0E001E0E000E0E000E0E001E07001E07803E03C0FE01FFFE00F
-FCE003F0E00001C00001C00001C0000380600380F00700F00F00F03E007FFC003FF0000F
-C000131E7D9D1A> I<3078FCFC78300000000000000000003078FCFC7830061576941A>
-I<183C7E7E3C18000000000000000000183C7E7E3E1E0E0E1C3CF8F060071C77941A> I<
-0000C00003E00007E0000FC0003F80007E0000FC0003F80007E0000FC0003F80007E0000
-FC0000FC00007E00003F80000FC00007E00003F80000FC00007E00003F80000FC00007E0
-0003E00000C0131A7D9B1A> I<7FFFF0FFFFF8FFFFF87FFFF00000000000000000000000
-007FFFF0FFFFF8FFFFF87FFFF0150C7E941A> I<600000F80000FC00007E00003F80000F
-C00007E00003F80000FC00007E00003F80000FC00007E00007E0000FC0003F80007E0000
-FC0003F80007E0000FC0003F80007E0000FC0000F80000600000131A7D9B1A> I<007C38
-01FF3807FFF80F83F81E00F81C0078380078380038700038700038700000E00000E00000
-E00000E00000E00000E00000E00000E000007000007000387000383800383800381C0070
-1E00F00F83E007FFC001FF80007C00151E7E9D1A> 67 D 78 D<03F8E00FFEE01FFFE03C07E07801E0F001E0E000E0
-E000E0E000E0E000007000007800003F80001FF80007FF00007FC00007E00000F0000070
-000038000038600038E00038E00038E00070F000F0FE01E0FFFFC0EFFF80E1FE00151E7E
-9D1A> 83 D<7FFFFEFFFFFEFFFFFEE0380EE0380EE0380EE0380E003800003800003800
-003800003800003800003800003800003800003800003800003800003800003800003800
-00380000380000380000380000380003FF8003FF8003FF80171E7F9D1A> I 91 D 93 D<1FF0003FFC007FFE00780F
-00300700000380000380007F8007FF801FFF803F8380780380700380E00380E00380E003
-80700780780F803FFFFC1FFDFC07F0FC16157D941A> 97 D<7E0000FE00007E00000E00
-000E00000E00000E00000E00000E00000E3E000EFF800FFFE00FC1F00F80700F00380E00
-380E001C0E001C0E001C0E001C0E001C0E001C0E001C0F00380F00780F80F00FC1E00FFF
-C00EFF80063E00161E7F9D1A> I<00FF8003FFC00FFFE01F01E03C00C078000070000070
-0000E00000E00000E00000E00000E000007000007000007800703C00701F01F00FFFE003
-FFC000FE0014157D941A> I<000FC0001FC0000FC00001C00001C00001C00001C00001C0
-0001C001F1C007FDC00FFFC01E0FC03C07C07803C07001C0E001C0E001C0E001C0E001C0
-E001C0E001C0E001C07003C07003C03807C03E0FC01FFFF807FDFC01F1F8161E7E9D1A>
-I<01F80007FF000FFF801E07C03C01C07800E07000E0E00070E00070FFFFF0FFFFF0FFFF
-F0E000007000007000007800703C00701F01F00FFFE003FF8000FE0014157D941A> I<00
-07E0001FF0003FF800787800F03000E00000E00000E00000E0007FFFF0FFFFF0FFFFF000
-E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000
-E00000E00000E0003FFF807FFFC03FFF80151E7F9D1A> I<7E0000FE00007E00000E0000
-0E00000E00000E00000E00000E00000E3E000EFF800FFFC00FC1C00F80E00F00E00E00E0
-0E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E07FC3FC
-FFE7FE7FC3FC171E7F9D1A> 104 D<00C00001E00001E00000C000000000000000000000
-0000000000000000007FE0007FE0007FE00000E00000E00000E00000E00000E00000E000
-00E00000E00000E00000E00000E00000E00000E00000E00000E0007FFF80FFFFC07FFF80
-121F7C9E1A> I<7FE000FFE0007FE00000E00000E00000E00000E00000E00000E00000E0
-0000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E0
-0000E00000E00000E00000E00000E0007FFFC0FFFFE07FFFC0131E7D9D1A> 108
-D<7CE0E000FFFBF8007FFFF8001F1F1C001E1E1C001E1E1C001C1C1C001C1C1C001C1C1C
-001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C
-007F1F1F00FFBFBF807F1F1F00191580941A> I<7E3E00FEFF807FFFC00FC1C00F80E00F
-00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E
-00E07FC3FCFFE7FE7FC3FC17157F941A> I<01F00007FC001FFF003E0F803C07807803C0
-7001C0E000E0E000E0E000E0E000E0E000E0E000E0F001E07001C07803C03C07803E0F80
-1FFF0007FC0001F00013157D941A> I<7E3E00FEFF807FFFE00FC1F00F80700F00380E00
-380E001C0E001C0E001C0E001C0E001C0E001C0E001C0F00380F00780F80F00FC1E00FFF
-C00EFF800E3E000E00000E00000E00000E00000E00000E00000E00000E00007FC000FFE0
-007FC00016207F941A> I<7F81F8FF8FFC7F9FFE03FE1E03F80C03E00003E00003C00003
-80000380000380000380000380000380000380000380000380000380007FFF00FFFF007F
-FF0017157F941A> 114 D<07FB801FFF807FFF80780780E00380E00380E003807800007F
-C0001FFC0007FE00003F800007806001C0E001C0E001C0F003C0FC0780FFFF00EFFE00E3
-F80012157C941A> I<0180000380000380000380000380000380000380007FFFE0FFFFE0
-FFFFE0038000038000038000038000038000038000038000038000038000038000038070
-03807003807003807001C1E001FFE000FF80003F00141C7F9B1A> I<7E07E0FE0FE07E07
-E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00
-E00E00E00E01E00F03E007FFFC03FFFE00FCFC17157F941A> I<7F83FCFFC7FE7F83FC0E
-00E00E00E00E00E00701C00701C00701C003838003838003838001C70001C70001C70000
-EE0000EE0000EE00007C00007C0000380017157F941A> I I<7FC7F87FCFFC7FC7F80703C00383
-8003C70001EF0000FE00007C00007800003800007C0000EE0001EE0001C7000383800783
-C00F01C07FC7FCFFC7FE7FC7FC17157F941A> I<7F83FCFFC7FE7F83FC0E00E00E00E007
-00E00701C00701C00381C003838003C38001C38001C70000E70000E70000E60000660000
-6E00003C00003C00003C0000380000380000380000700000700030F00078E00071E0007F
-C0003F80001E000017207F941A> I<60F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0
-F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F060042775A21A> 124 D
-E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Ff cmr8 8 3
-/Ff 3 51 df<003000003000003000003000003000003000003000003000003000003000
-003000FFFFFCFFFFFC003000003000003000003000003000003000003000003000003000
-00300000300016187E931B> 43 D<06000E00FE000E000E000E000E000E000E000E000E
-000E000E000E000E000E000E000E000E000E00FFE00B157D9412> 49
-D<0F8030E040708030C038E0384038003800700070006000C00180030006000C08080810
-183FF07FF0FFF00D157E9412> I E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fg cmmi12 12 13
-/Fg 13 121 df<0FFFF81FFFFC3FFFF870200040200080200080600000600000600000C0
-0000C00000C00000C00001C0000180000180000380000380000380000700000300001615
-7E9415> 28 D<0000100000002000000020000000200000002000000040000000400000
-004000000040000000800000008000000080000000800000010000000FE00000711C0001
-C10600030203000E0203801C020180180201C0380401C0700401C0700401C0700401C0E0
-080380E0080380E00807006008070070100E0030101C00301038001C10E0000623800001
-FE0000002000000020000000400000004000000040000000400000008000000080000000
-800000008000001A2D7EA21D> 30 D<70F8F8F87005057C840E> 58
-D<70F8FCFC7404040404080810102040060F7C840E> I<00008000018000018000030000
-0300000300000600000600000600000C00000C00000C0000180000180000180000300000
-300000300000600000600000600000C00000C00000C00001800001800001800001800003
-00000300000300000600000600000600000C00000C00000C000018000018000018000030
-0000300000300000600000600000600000C00000C00000C0000011317DA418> 61
-D<00FFFC00000F8000000F0000000F0000001E0000001E0000001E0000001E0000003C00
-00003C0000003C0000003C00000078000000780000007800000078000000F0000000F000
-0000F0000000F0000001E0000001E0000001E0002001E0002003C0004003C0004003C000
-8003C0008007800180078001000780030007800F000F803E00FFFFFE001B227DA121> 76
-D<1FFFFFFE1E01E00E1801E0063001E0062003C0062003C0064003C0044003C004400780
-04800780048007800400078000000F0000000F0000000F0000000F0000001E0000001E00
-00001E0000001E0000003C0000003C0000003C0000003C00000078000000780000007800
-000078000000F0000000F0000000F0000000F0000001F000007FFFC0001F227EA11D> 84
-D<3FFE01FF8003C0003C0003C000300003C0001000078000200007800020000780002000
-07800020000F000040000F000040000F000040000F000040001E000080001E000080001E
-000080001E000080003C000100003C000100003C000100003C0001000078000200007800
-020000780002000078000200007000040000F000040000F0000800007000080000700010
-00007000200000380040000038008000001C01000000060600000001F800000021237DA1
-21> I<007E000381000700800E00801C0080380080780100700600FFF800F00000F00000
-E00000E00000E00000E00000E00080E000807003003004001838000FC00011157D9417>
-101 D<01E00FC001C001C001C0038003800380038007000700070007000E000E000E000E
-001C001C001C001C0038003800380038007000700070007080E100E100E100620062003C
-000B237EA20F> 108 D<03C0F004631C04740E08780E08700708700708700F00E00F00E0
-0F00E00F00E00F01C01E01C01E01C01E01C03C03803803803803C07003C0E0072180071E
-000700000700000E00000E00000E00000E00001C00001C00001C0000FF8000181F819418
-> 112 D<3C0F004630C04741C08783C08783C08701808700000E00000E00000E00000E00
-001C00001C00001C00001C000038000038000038000038000070000030000012157E9416
-> 114 D<01E0F006310C081A1C101A3C201C3C201C18201C000038000038000038000038
-0000700000700000700000700860E010F0E010F0E020E170404230803C1F0016157E941C
-> 120 D E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fh cmti12 12 22
-/Fh 22 122 df 45 D<70F8F8F0E005057A840F> I<00F8
-C00185C00705C00E03800E03801C03803C0380380700780700780700780700F00E00F00E
-00F00E00F00E10F01C20701C20703C20305C40308C400F078014157B9419> 97
-D<03C01F8003800380038007000700070007000E000E000E000E001C001CF81D0C1E0E3C
-0638073807380F700F700F700F700FE01EE01EE01EE03CE038E038607060E031C01F0010
-237BA216> I<007E0001C1000301800703800E07801C07803C0000380000780000780000
-780000F00000F00000F00000F00000F00100700100700200300C001830000FC00011157B
-9416> I<00003C0003F80000380000380000380000700000700000700000700000E00000
-E00000E00000E00001C000F9C00185C00705C00E03800E03801C03803C03803807007807
-00780700780700F00E00F00E00F00E00F00E10F01C20701C20703C20305C40308C400F07
-8016237BA219> I<00F803840E021C023C0238027804F018FFE0F000F000E000E000E000
-E000E002E0026004701830600F800F157A9416> I<00003E0000470000CF00018F000186
-000380000380000380000700000700000700000700000700000E0000FFF0000E00000E00
-000E00001C00001C00001C00001C00001C00003800003800003800003800003800007000
-00700000700000700000700000E00000E00000E00000E00000C00001C00001C000718000
-F18000F300006200003C0000182D82A20F> I<001F180030B800E0B801C07001C0700380
-700780700700E00F00E00F00E00F00E01E01C01E01C01E01C01E01C01E03800E03800E07
-80060B8006170001E700000700000700000E00000E00000E00701C00F01800F0300060E0
-003F8000151F7E9416> I<00C001E001C001C0000000000000000000000000000000001E
-002300430043008700870087000E000E001C001C001C0038003800384070807080708071
-0032001C000B217BA00F> 105 D<00F00007E00000E00000E00000E00001C00001C00001
-C00001C0000380000380000380000380000700000701E00702100704700E08F00E10F00E
-20600E40001D80001E00001FC0001C7000383800383800381C00381C2070384070384070
-3840701880E01880600F0014237DA216> 107 D<01E00FC001C001C001C0038003800380
-038007000700070007000E000E000E000E001C001C001C001C0038003800380038007000
-700070007100E200E200E200E200640038000B237CA20C> I<1C0F80F8002610C10C0047
-6066060087807807008780780700870070070087007007000E00E00E000E00E00E000E00
-E00E000E00E00E001C01C01C001C01C01C001C01C01C001C01C038203803803840380380
-70403803807080380380308070070031003003001E0023157B9428> I<380F804C30C04E
-40608E80708F00708E00708E00701C00E01C00E01C00E01C00E03801C03801C03801C038
-0384700388700308700708700310E003106001E016157B941B> I<007E0001C300038180
-0701C00E01C01C01E03C01E03801E07801E07801E07801E0F003C0F003C0F00380F00780
-700700700E00700C0030180018700007C00013157B9419> I<01C1F002621804741C0878
-0C08700E08700E08701E00E01E00E01E00E01E00E01E01C03C01C03C01C03C01C0780380
-7003807003C0E003C1C0072380071E000700000700000E00000E00000E00000E00001C00
-001C00001C0000FFC000171F7F9419> I<1C1F002620804741C08783C08703C087018087
-00000E00000E00000E00000E00001C00001C00001C00001C000038000038000038000038
-000070000030000012157B9415> 114 D<00FC000183000200800401800C03800C03000C
-00000F00000FF00007FC0003FE00003E00000F00000700700700F00600F00600E0040040
-08002030001FC00011157D9414> I<00C001C001C001C001C003800380038003800700FF
-F8070007000E000E000E000E001C001C001C001C00380038003800381070207020704070
-8031001E000D1F7C9E10> I<1E0060E02300E0F04380E1F04381C0F08381C0708701C030
-8701C030070380200E0380200E0380200E0380201C0700401C0700401C0700401C070080
-1C0700801C0701001C0F01000C0B02000613840003E0F8001C157B9420> 119
-D<03C1E0046210083470103CF02038F020386020380000700000700000700000700000E0
-0000E00000E00000E02061C040F1C040F1C080E2C100446200383C0014157D9416> I<1E
-00302300704380704380E08380E08700E08700E00701C00E01C00E01C00E01C01C03801C
-03801C03801C03801C07001C07001C07001C0F000C3E0003CE00000E00000E00001C0060
-1C00F03800F03000E0600080C0004380003E0000141F7B9418> I
-E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fi cmbx12 12 20
-/Fi 20 122 df 68 D<01FE0207FF861F01FE3C007E7C001E78000E78000EF80006F80006FC0006
-FC0000FF0000FFE0007FFF007FFFC03FFFF01FFFF80FFFFC03FFFE003FFE0003FE00007F
-00003F00003FC0001FC0001FC0001FE0001EE0001EF0003CFC003CFF00F8C7FFE080FF80
-18227DA11F> 83 D<7FFFFFFF807FFFFFFF807E03F80F807803F807807003F803806003
-F80180E003F801C0E003F801C0C003F800C0C003F800C0C003F800C0C003F800C00003F8
-00000003F800000003F800000003F800000003F800000003F800000003F800000003F800
-000003F800000003F800000003F800000003F800000003F800000003F800000003F80000
-0003F800000003F800000003F800000003F800000003F8000001FFFFF00001FFFFF00022
-227EA127> I<0FFC003FFF807E07C07E03E07E01E07E01F03C01F00001F00001F0003FF0
-03FDF01FC1F03F01F07E01F0FC01F0FC01F0FC01F0FC01F07E02F07E0CF81FF87F07E03F
-18167E951B> 97 D I<00FF8007FFE00F83F01F03F03E03F07E03F07C01E07C0000
-FC0000FC0000FC0000FC0000FC0000FC00007C00007E00007E00003E00181F00300FC060
-07FFC000FF0015167E9519> I<00FE0007FF800F87C01E01E03E01F07C00F07C00F8FC00
-F8FC00F8FFFFF8FFFFF8FC0000FC0000FC00007C00007C00007E00003E00181F00300FC0
-7003FFC000FF0015167E951A> 101 D<001FC0007FE000F1F001E3F003E3F007C3F007C1
-E007C00007C00007C00007C00007C00007C000FFFE00FFFE0007C00007C00007C00007C0
-0007C00007C00007C00007C00007C00007C00007C00007C00007C00007C00007C00007C0
-0007C00007C0003FFC003FFC00142380A211> I<01FE0F0007FFBF800F87C7801F03E780
-1E01E0003E01F0003E01F0003E01F0003E01F0003E01F0001E01E0001F03E0000F87C000
-0FFF800009FE000018000000180000001C0000001FFFE0000FFFF80007FFFE001FFFFF00
-3C003F0078000F80F0000780F0000780F0000780F000078078000F003C001E001F007C00
-0FFFF80001FFC00019217F951C> I<1C003E007F007F007F003E001C0000000000000000
-00000000000000FF00FF001F001F001F001F001F001F001F001F001F001F001F001F001F
-001F001F001F001F001F00FFE0FFE00B247EA310> 105 D 108
-D I I<00FE0007FFC00F83E01E00F03E00F87C00
-7C7C007C7C007CFC007EFC007EFC007EFC007EFC007EFC007EFC007E7C007C7C007C3E00
-F81F01F00F83E007FFC000FE0017167E951C> I I<0FF3003FFF00781F00600700E00300E00300F00300FC00007F
-E0007FF8003FFE000FFF0001FF00000F80C00780C00380E00380E00380F00700FC0E00EF
-FC00C7F00011167E9516> 115 D<01800001800001800001800003800003800007800007
-80000F80003F8000FFFF00FFFF000F80000F80000F80000F80000F80000F80000F80000F
-80000F80000F80000F80000F81800F81800F81800F81800F81800F830007C30003FE0000
-F80011207F9F16> I I 120 D I E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fj cmsy10 12 15
-/Fj 15 107 df 0 D<03F0000FFC001FFE003FFF007F
-FF807FFF80FFFFC0FFFFC0FFFFC0FFFFC0FFFFC0FFFFC0FFFFC0FFFFC07FFF807FFF803F
-FF001FFE000FFC0003F00012147D9519> 15 D<000FFFFC007FFFFC01F0000003800000
-060000000C0000001800000030000000300000006000000060000000C0000000C0000000
-C0000000C0000000C0000000C0000000C0000000C0000000600000006000000030000000
-30000000180000000C000000060000000380000001E00000007FFFFC001FFFFC1E1E7C9A
-27> 26 D<00000001800000000001800000000001800000000001800000000000C00000
-000000C000000000006000000000003000000000003000000000001C00000000000E0000
-0000000700FFFFFFFFFFE0FFFFFFFFFFE0000000000700000000000E00000000001C0000
-000000300000000000300000000000600000000000C00000000000C00000000001800000
-00000180000000000180000000000180002B1A7D9832> 33 D<001FFF007FFF01E00003
-80000600000C0000180000300000300000600000600000600000C00000C00000FFFFFFFF
-FFFFC00000C000006000006000006000003000003000001800000C000006000003800001
-E000007FFF001FFF181E7C9A21> 50 D<00000300000300000600000600000C00000C00
-00180000180000300000300000600000600000C00000C00000C000018000018000030000
-0300000600000600000C00000C0000180000180000300000300000600000600000C00000
-C0000180000180000300000300000300000600000600000C00000C000018000018000030
-0000300000600000600000C00000400000183079A300> 54 D I<00008000018001F980070F000C0300180380180780
-3006C03006C0700CE0600C60600C60600C60E01870E01870E01870E03070E03070E03070
-E06070E06070E06070E06070E0C070E0C070E0C070E18070E180706180606300607300E0
-7300E03300C03600C01E01801E01800C03000F0E000DF800180000180000180000142A7E
-A519> 59 D<000100000003000000030000000300000003000000030000000300000003
-000000030000000300000003000000030000000300000003000000030000000300000003
-000000030000000300000003000000030000000300000003000000030000000300000003
-000000030000000300000003000000030000FFFFFFFEFFFFFFFE1F207C9F27> 63
-D<40000040C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000
-C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000
-C0C00000C0C00000C0C00000C0C00000C0C00000C0600001806000018030000300180006
-000E001C000780780001FFE000007F80001A1F7D9D21> 91 D<007F800001FFE0000780
-78000E001C0018000600300003006000018060000180C00000C0C00000C0C00000C0C000
-00C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C000
-00C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C000
-00C0400000401A1F7D9D21> I<000C0000000C0000001E0000001E0000001E0000003300
-0000330000006180000061800000C0C00000C0C00000C0C0000180600001806000030030
-00030030000300300006001800060018000C000C000C000C000C000C0018000600180006
-003000030030000300600001806000018060000180C00000C0C00000401A1F7D9D21> 94
-D<0003C0001E0000380000700000E00000E00000E00000E00000E00000E00000E00000E0
-0000E00000E00000E00000E00000E00000E00000E00000E00000E00001C0000380000F00
-00F800000F000003800001C00000E00000E00000E00000E00000E00000E00000E00000E0
-0000E00000E00000E00000E00000E00000E00000E00000E00000E000007000003800001E
-000003C012317DA419> 102 D I 106 D E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fk cmr12 12 65
-/Fk 65 125 df<001FC1F00070371800C03E3C01807C3C0380783C070038000700380007
-003800070038000700380007003800070038000700380007003800FFFFFFC00700380007
-003800070038000700380007003800070038000700380007003800070038000700380007
-0038000700380007003800070038000700380007003800070038000700380007003C007F
-E1FFC01E2380A21C> 11 D<001FC0000070200000C01000018038000380780007007800
-0700300007000000070000000700000007000000070000000700000007000000FFFFF800
-070078000700380007003800070038000700380007003800070038000700380007003800
-070038000700380007003800070038000700380007003800070038000700380007003800
-070038007FE1FF80192380A21B> I<001FD8000070380000C07800018078000380780007
-0038000700380007003800070038000700380007003800070038000700380007003800FF
-FFF800070038000700380007003800070038000700380007003800070038000700380007
-003800070038000700380007003800070038000700380007003800070038000700380007
-003800070038007FF3FF80192380A21B> I<000FC07F00007031C08000E00B004001801E
-00E003803E01E007003C01E007001C00C007001C000007001C000007001C000007001C00
-0007001C000007001C000007001C0000FFFFFFFFE007001C01E007001C00E007001C00E0
-07001C00E007001C00E007001C00E007001C00E007001C00E007001C00E007001C00E007
-001C00E007001C00E007001C00E007001C00E007001C00E007001C00E007001C00E00700
-1C00E007001C00E07FF1FFCFFE272380A229> I<70F8FCFC740404040408081010204006
-0F7CA20E> 39 D<00200040008001000300060004000C000C0018001800300030003000
-7000600060006000E000E000E000E000E000E000E000E000E000E000E000E000E000E000
-6000600060007000300030003000180018000C000C000400060003000100008000400020
-0B327CA413> I<800040002000100018000C000400060006000300030001800180018001
-C000C000C000C000E000E000E000E000E000E000E000E000E000E000E000E000E000E000
-C000C000C001C0018001800180030003000600060004000C00180010002000400080000B
-327DA413> I<70F8FCFC7404040404080810102040060F7C840E> 44
-D I<70F8F8F87005057C840E> I<01F000071C000C0600180300
-3803803803807001C07001C07001C07001C0F001E0F001E0F001E0F001E0F001E0F001E0
-F001E0F001E0F001E0F001E0F001E0F001E0F001E0F001E07001C07001C07001C07803C0
-3803803803801C07000C0600071C0001F00013227EA018> 48 D<008003800F80F38003
-800380038003800380038003800380038003800380038003800380038003800380038003
-800380038003800380038003800380038007C0FFFE0F217CA018> I<03F0000C1C001007
-002007804003C04003C08003E0F003E0F801E0F801E0F801E02003E00003E00003C00003
-C0000780000700000E00001C0000180000300000600000C0000180000100000200200400
-200800201800603000403FFFC07FFFC0FFFFC013217EA018> I<03F8000C1E00100F0020
-07804007C07807C07803C07807C03807C0000780000780000700000F00000C0000380003
-F000001C00000F000007800007800003C00003C00003E02003E07003E0F803E0F803E0F0
-03C04003C0400780200780100F000C1C0003F00013227EA018> I<000300000300000700
-000700000F00001700001700002700006700004700008700018700010700020700060700
-040700080700080700100700200700200700400700C00700FFFFF8000700000700000700
-000700000700000700000700000F80007FF015217FA018> I<70F8F8F870000000000000
-000000000070F8F8F87005157C940E> 58 D 61 D<07E01838201C400E800FF00FF00FF00F000F000E001C00380030006000C000C0
-00800080018001000100010001000100010000000000000000000000038007C007C007C0
-038010237DA217> 63 D<0001800000018000000180000003C0000003C0000003C00000
-05E0000005E0000009F0000008F0000008F00000107800001078000010780000203C0000
-203C0000203C0000401E0000401E0000C01F0000800F0000800F0001FFFF800100078001
-000780020003C0020003C0020003C0040001E0040001E0040001E0080000F01C0000F03E
-0001F8FF800FFF20237EA225> 65 D I<0007E0100038183000E0063001C00170038000F007
-0000F00E0000701E0000701C0000303C0000303C0000307C0000107800001078000010F8
-000000F8000000F8000000F8000000F8000000F8000000F8000000F80000007800000078
-0000107C0000103C0000103C0000101C0000201E0000200E000040070000400380008001
-C0010000E0020000381C000007E0001C247DA223> I I 70 D<0007F008003C0C1800E0021801C0
-01B8038000F8070000780F0000381E0000381E0000183C0000183C0000187C0000087800
-000878000008F8000000F8000000F8000000F8000000F8000000F8000000F8000000F800
-1FFF780000F8780000787C0000783C0000783C0000781E0000781E0000780F0000780700
-0078038000B801C000B800E00318003C0C080007F00020247DA226> I I I 75
-D I
-78 D<000FE00000783C0000E00E0003C00780078003C00F0001E00E0000E01E0000F03C
-0000783C0000787C00007C7C00007C7800003C7800003CF800003EF800003EF800003EF8
-00003EF800003EF800003EF800003EF800003EF800003E7800003C7C00007C7C00007C3C
-0000783E0000F81E0000F00F0001E00F0001E0078003C003C0078000E00E0000783C0000
-0FE0001F247DA226> I I 82 D<03F0200C0C601802603001E07000E0600060E00060E000
-60E00020E00020E00020F00000F000007800007F00003FF0001FFE000FFF0003FF80003F
-C00007E00001E00000F00000F0000070800070800070800070800070C00060C00060E000
-C0F000C0C80180C6070081FC0014247DA21B> I<7FFFFFF8780780786007801840078008
-4007800840078008C007800C800780048007800480078004800780040007800000078000
-000780000007800000078000000780000007800000078000000780000007800000078000
-000780000007800000078000000780000007800000078000000780000007800000078000
-00078000000FC00001FFFE001E227EA123> I 86 D I 91 D 93
-D<1FE000303800780C00780E0030070000070000070000070000FF0007C7001E07003C07
-00780700700700F00708F00708F00708F00F087817083C23900FC1E015157E9418> 97
-D<0E0000FE00001E00000E00000E00000E00000E00000E00000E00000E00000E00000E00
-000E00000E00000E1F000E61C00E80600F00300E00380E003C0E001C0E001E0E001E0E00
-1E0E001E0E001E0E001E0E001E0E001C0E003C0E00380F00700C80600C41C0083F001723
-7FA21B> I<01FE000703000C07801C0780380300780000700000F00000F00000F00000F0
-0000F00000F00000F000007000007800403800401C00800C010007060001F80012157E94
-16> I<0000E0000FE00001E00000E00000E00000E00000E00000E00000E00000E00000E0
-0000E00000E00000E001F8E00704E00C02E01C01E03800E07800E07000E0F000E0F000E0
-F000E0F000E0F000E0F000E0F000E07000E07800E03800E01801E00C02E0070CF001F0FE
-17237EA21B> I<01FC000707000C03801C01C03801C07801E07000E0F000E0FFFFE0F000
-00F00000F00000F00000F000007000007800203800201C00400E008007030000FC001315
-7F9416> I<003E0000E30001C78003878003078007000007000007000007000007000007
-0000070000070000070000FFF80007000007000007000007000007000007000007000007
-00000700000700000700000700000700000700000700000700000700000700000780007F
-F000112380A20F> I<00007003F1980E1E181C0E18380700380700780780780780780780
-7807803807003807001C0E001E1C0033F0002000002000003000003800003FFE001FFFC0
-0FFFE03000F0600030C00018C00018C00018C000186000306000303800E00E038003FE00
-15217F9518> I<0E0000FE00001E00000E00000E00000E00000E00000E00000E00000E00
-000E00000E00000E00000E00000E1F800E60C00E80E00F00700F00700E00700E00700E00
-700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00
-70FFE7FF18237FA21B> I<1C003E003E003E001C00000000000000000000000000000000
-000E007E001E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E
-000E000E00FFC00A227FA10E> I<00E001F001F001F000E0000000000000000000000000
-00000000007007F000F00070007000700070007000700070007000700070007000700070
-00700070007000700070007000700070007000706070F0E0F0C061803F000C2C83A10F>
-I<0E0000FE00001E00000E00000E00000E00000E00000E00000E00000E00000E00000E00
-000E00000E00000E03FC0E01F00E01C00E01800E02000E04000E08000E10000E38000EF8
-000F1C000E1E000E0E000E07000E07800E03C00E01C00E01E00E00F00E00F8FFE3FE1723
-7FA21A> I<0E00FE001E000E000E000E000E000E000E000E000E000E000E000E000E000E
-000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E
-00FFE00B237FA20E> I<0E1FC07F00FE60E183801E807201C00F003C00E00F003C00E00E
-003800E00E003800E00E003800E00E003800E00E003800E00E003800E00E003800E00E00
-3800E00E003800E00E003800E00E003800E00E003800E00E003800E00E003800E00E0038
-00E0FFE3FF8FFE27157F942A> I<0E1F80FE60C01E80E00F00700F00700E00700E00700E
-00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E
-0070FFE7FF18157F941B> I<01FC000707000C01801800C03800E0700070700070F00078
-F00078F00078F00078F00078F00078F000787000707800F03800E01C01C00E0380070700
-01FC0015157F9418> I<0E1F00FE61C00E80600F00700E00380E003C0E003C0E001E0E00
-1E0E001E0E001E0E001E0E001E0E001E0E003C0E003C0E00380F00700E80E00E41C00E3F
-000E00000E00000E00000E00000E00000E00000E00000E00000E0000FFE000171F7F941B
-> I<01F8200704600E02601C01603801E07800E07800E0F000E0F000E0F000E0F000E0F0
-00E0F000E0F000E07800E07800E03801E01C01E00C02E0070CE001F0E00000E00000E000
-00E00000E00000E00000E00000E00000E00000E0000FFE171F7E941A> I<0E3CFE461E8F
-0F0F0F060F000E000E000E000E000E000E000E000E000E000E000E000E000E000F00FFF0
-10157F9413> I<0F8830786018C018C008C008E008F0007F003FE00FF001F8003C801C80
-0C800CC00CC008E018D0308FC00E157E9413> I<02000200020002000600060006000E00
-1E003E00FFFC0E000E000E000E000E000E000E000E000E000E000E000E040E040E040E04
-0E040E040708030801F00E1F7F9E13> I<0E0070FE07F01E00F00E00700E00700E00700E
-00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00F00E00F006
-017003827800FC7F18157F941B> I I I I I<3FFFC0380380300780200700600E
-00401C00403C0040380000700000E00001E00001C0000380400700400F00400E00C01C00
-80380080780180700780FFFF8012157F9416> I 124
-D E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fl cmbx12 14.4 19
-/Fl 19 118 df<00007FE0030007FFFC07001FFFFF0F007FF00F9F00FF0001FF01FC0000
-FF03F800007F07F000003F0FE000001F1FC000001F1FC000000F3F8000000F3F80000007
-7F800000077F800000077F00000000FF00000000FF00000000FF00000000FF00000000FF
-00000000FF00000000FF00000000FF00000000FF000000007F000000007F800000007F80
-0000073F800000073F800000071FC00000071FC000000E0FE000000E07F000001C03F800
-003C01FC00007800FF0001F0007FF007C0001FFFFF800007FFFE0000007FF00028297CA8
-31> 67 D
-76 D<0000FFC00000000FFFFC0000003F807F000000FE001FC00001F80007E00003F000
-03F00007E00001F8000FE00001FC001FC00000FE001FC00000FE003F8000007F003F8000
-007F007F8000007F807F0000003F807F0000003F807F0000003F80FF0000003FC0FF0000
-003FC0FF0000003FC0FF0000003FC0FF0000003FC0FF0000003FC0FF0000003FC0FF0000
-003FC0FF0000003FC0FF0000003FC07F0000003F807F8000007F807F8000007F803F8000
-007F003F8000007F001FC00000FE001FC00000FE000FE00001FC0007F00003F80003F800
-07F00001FC000FE00000FE001FC000003FC0FF0000000FFFFC00000000FFC000002A297C
-A833> 79 D 86 D<03FF80000FFFF0001F01FC003F80FE003F807F003F803F003F803F
-801F003F8000003F8000003F8000003F8000003F80003FFF8001FC3F800FE03F801F803F
-803F003F807E003F80FC003F80FC003F80FC003F80FC003F80FC005F807E00DF803F839F
-FC1FFE0FFC03FC03FC1E1B7E9A21> 97 D I<00007FF000007FF000007FF0000007F0000007F0000007
-F0000007F0000007F0000007F0000007F0000007F0000007F0000007F0000007F0000007
-F0003F87F001FFF7F007F03FF00FC00FF01F8007F03F0007F03F0007F07E0007F07E0007
-F07E0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007
-F07E0007F07E0007F03F0007F03F0007F01F800FF00FC01FF007E07FFF01FFE7FF007F87
-FF202A7EA925> 100 D<003FC00001FFF00003E07C000F803E001F801F001F001F003F00
-0F807E000F807E000FC07E000FC0FE0007C0FE0007C0FFFFFFC0FFFFFFC0FE000000FE00
-0000FE0000007E0000007E0000007F0000003F0001C01F0001C00F80038007C0070003F0
-1E0000FFFC00003FE0001A1B7E9A1F> I<0007F8003FFC007E3E01FC7F03F87F03F07F07
-F07F07F03E07F00007F00007F00007F00007F00007F00007F000FFFFC0FFFFC0FFFFC007
-F00007F00007F00007F00007F00007F00007F00007F00007F00007F00007F00007F00007
-F00007F00007F00007F00007F00007F00007F00007F00007F0007FFF807FFF807FFF8018
-2A7EA915> I
-104 D<07000F801FC03FE03FE03FE01FC00F8007000000000000000000000000000000FF
-E0FFE0FFE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00F
-E00FE00FE00FE00FE00FE0FFFEFFFEFFFE0F2B7EAA12> I 108 D 110 D<003FE00001FFFC0003F07E000FC01F801F80
-0FC03F0007E03F0007E07E0003F07E0003F07E0003F0FE0003F8FE0003F8FE0003F8FE00
-03F8FE0003F8FE0003F8FE0003F8FE0003F87E0003F07E0003F03F0007E03F0007E01F80
-0FC00FC01F8007F07F0001FFFC00003FE0001D1B7E9A22> I I 114 D<03FE300FFFF03E03F078
-00F07000F0F00070F00070F80070FE0000FFE0007FFF007FFFC03FFFE01FFFF007FFF800
-FFF80007FC0000FCE0007CE0003CF0003CF00038F80038FC0070FF01E0E7FFC0C1FF0016
-1B7E9A1B> I<00E00000E00000E00000E00001E00001E00001E00003E00003E00007E000
-0FE0001FFFE0FFFFE0FFFFE00FE0000FE0000FE0000FE0000FE0000FE0000FE0000FE000
-0FE0000FE0000FE0000FE0000FE0000FE0700FE0700FE0700FE0700FE0700FE0700FE070
-07F0E003F0C001FF80007F0014267FA51A> I I E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fm cmr12 14.4 20
-/Fm 20 118 df<78FCFCFEFE7A02020202040404080810204007127B8510> 44
-D<00200000E00001E0000FE000FFE000F1E00001E00001E00001E00001E00001E00001E0
-0001E00001E00001E00001E00001E00001E00001E00001E00001E00001E00001E00001E0
-0001E00001E00001E00001E00001E00001E00001E00001E00001E00001E00001E00001E0
-0001E00003F000FFFFC0FFFFC012287BA71D> 49 D<01FC0007FF000C0FC01803E02001
-F06001F04000F84000F8F800FCFC00FCFC007CFC007CFC007C7800FC0000FC0000F80000
-F80001F00001F00003E00003C0000780000700000E00001C0000380000300000600000C0
-000180000300040200040400080800081000082000183FFFF87FFFF0FFFFF0FFFFF01628
-7DA71D> I<000FC0003FF000F01801C01803803C07007C0F007C0E00381E00003C00003C
-00003C0000780000780000780000F83F00F8C1C0F900E0FA0070FA0038FC003CFC001EFC
-001EF8001EF8001FF8001FF8001FF8001F78001F78001F78001F78001F3C001E3C001E1C
-003C1E003C0E007807007003C1E001FFC0007E0018297EA71D> 54
-D<007E0001FF800781C00F00E01E00703C00383C003878003C78003CF8001EF8001EF800
-1EF8001EF8001FF8001FF8001FF8001F78001F78003F78003F3C003F1C005F0E005F0700
-9F03831F00FC1F00001E00001E00001E00003E00003C00003C0000381C00783E00703E00
-E03C01C01803801C0F000FFE0003F80018297EA71D> 57 D<0000FF00100007FFE03000
-1FC07830003E000C7000F80006F001F00003F003E00001F007C00000F00F800000700F80
-0000701F000000303F000000303E000000303E000000107E000000107E000000107C0000
-0000FC00000000FC00000000FC00000000FC00000000FC00000000FC00000000FC000000
-00FC00000000FC0000FFFF7C0000FFFF7E000003F07E000001F03E000001F03E000001F0
-3F000001F01F000001F00F800001F00F800001F007C00001F003E00001F001F00002F000
-F80002F0003E000C70001FC038300007FFE0100000FF8000282B7DA92E> 71
-D<01FFFE01FFFE0007E00003E00003E00003E00003E00003E00003E00003E00003E00003
-E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003
-E00003E00003E00003E00003E00003E00003E00003E03003E07803E0FC03E0FC03E0FC03
-C0F807C0400780200F00300E000C3C0003F000172A7DA81E> 74
-D<0001FF0000000F01E000003C0078000078003C0000E0000E0001E0000F0003C0000780
-07800003C00F800003E01F000001F01F000001F03E000000F83E000000F87E000000FC7E
-000000FC7C0000007C7C0000007CFC0000007EFC0000007EFC0000007EFC0000007EFC00
-00007EFC0000007EFC0000007EFC0000007EFC0000007E7C0000007C7E000000FC7E0000
-00FC7E000000FC3E000000F83F000001F81F000001F01F000001F00F800003E007800003
-C007C00007C003E0000F8000F0001E000078003C00003C007800000F01E0000001FF0000
-272B7DA92E> 79 D<03FC00000C070000100380003C01C0003E01E0003E00F0001C00F0
-000800F0000000F0000000F0000000F000007FF00003E0F0000F80F0001E00F0003C00F0
-007C00F0007800F040F800F040F800F040F800F040F801F0407C01F0403C0278801E0C7F
-8007F01E001A1A7E991D> 97 D<0F000000FF000000FF0000001F0000000F0000000F00
-00000F0000000F0000000F0000000F0000000F0000000F0000000F0000000F0000000F00
-00000F0000000F07E0000F1838000F600E000F8007000F8007800F0003C00F0003C00F00
-01E00F0001E00F0001F00F0001F00F0001F00F0001F00F0001F00F0001F00F0001F00F00
-01E00F0001E00F0003E00F0003C00F0003800F8007800E800F000E401C000C303800080F
-C0001C2A7EA921> I<007F0001C0E00700100E00781E00F83C00F83C00707C0020780000
-F80000F80000F80000F80000F80000F80000F80000F800007800007C00003C00083C0008
-1E00100E002007006001C180007E00151A7E991A> I<00FC000387800701C00E01E01C00
-E03C00F03C00F0780078780078F80078F80078FFFFF8F80000F80000F80000F80000F800
-007800007800003C00083C00081E00100E002007004001C180007E00151A7E991A> 101
-D<00000F0001FC3080070743800E03C3801E03C1003C01E0003C01E0007C01F0007C01F0
-007C01F0007C01F0007C01F0003C01E0003C01E0001E03C0000E0380001707000011FC00
-0030000000300000003000000030000000180000001FFF80000FFFF00007FFF80018007C
-0030001E0070000E0060000700E0000700E0000700E0000700E000070070000E0070000E
-0038001C001C0038000781E00000FF000019287E9A1D> 103 D<1E003F003F003F003F00
-1E000000000000000000000000000000000000000F00FF00FF001F000F000F000F000F00
-0F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F00FFF0FFF0
-0C297EA811> 105 D<007E0003C3C00700E00E00701C00383C003C3C003C78001E78001E
-F8001FF8001FF8001FF8001FF8001FF8001FF8001FF8001F78001E78001E3C003C3C003C
-1C00380E00700700E003C3C0007E00181A7E991D> 111 D<003F010001E0830003804300
-0F0027001E0017001E001F003C000F007C000F007C000F0078000F00F8000F00F8000F00
-F8000F00F8000F00F8000F00F8000F00F8000F007C000F007C000F003C000F003E001F00
-1E001F000F002F0007804F0001C18F00007E0F0000000F0000000F0000000F0000000F00
-00000F0000000F0000000F0000000F0000000F0000000F000000FFF00000FFF01C267E99
-1F> 113 D<0F0F80FF11C0FF23E01F43E00F83E00F81C00F80000F00000F00000F00000F
-00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F
-00000F8000FFFC00FFFC00131A7E9917> I<07F0801C0D80300380600180E00180E00080
-E00080F00080F800007E00007FE0003FFC001FFE0007FF00003F800007808003C08003C0
-8001C0C001C0C001C0E00180E00380F00300CC0E0083F800121A7E9917> I<0080000080
-000080000080000180000180000180000380000380000780000F80001FFF80FFFF800780
-000780000780000780000780000780000780000780000780000780000780000780000780
-0007804007804007804007804007804007804007804003C08001C08000E100003E001225
-7FA417> I<0F000F00FF00FF00FF00FF001F001F000F000F000F000F000F000F000F000F
-000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F
-000F000F000F000F000F000F000F001F000F001F0007002F0003804F8001C08FF0007F0F
-F01C1A7E9921> I E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fn cmr17 20.74 18
-/Fn 18 119 df<000001FF00008000001FFFE0018000007F007801800001F8000E038000
-03E000070780000FC000018780001F000000CF80003E0000006F80007C0000003F8000F8
-0000003F8001F00000001F8003F00000000F8007E00000000F8007C000000007800FC000
-000007800FC000000007801F8000000003801F8000000003803F8000000003803F000000
-0001803F0000000001807F0000000001807F0000000001807E0000000000007E00000000
-0000FE000000000000FE000000000000FE000000000000FE000000000000FE0000000000
-00FE000000000000FE000000000000FE000000000000FE000000000000FE000000000000
-FE0000000000007E0000000000007E0000000000007F0000000000007F0000000001803F
-0000000001803F0000000001803F8000000001801F8000000001801F8000000003000FC0
-00000003000FC0000000030007E0000000060007E0000000060003F0000000060001F000
-00000C0000F80000001800007C0000001800003E0000003000001F0000006000000FC000
-01C0000003E0000380000001F8000E000000007F007C000000001FFFF00000000001FF00
-0000313D7CBB39> 67 D 76 D<000003FF00000000001E01E000000000F0003C000000
-03C0000F000000078000078000000F000003C000003E000001F000007C000000F80000F8
-0000007C0001F00000003E0001F00000003E0003E00000001F0007E00000001F8007C000
-00000F800FC00000000FC00F8000000007C01F8000000007E01F8000000007E03F000000
-0003F03F0000000003F03F0000000003F07F0000000003F87E0000000001F87E00000000
-01F87E0000000001F8FE0000000001FCFE0000000001FCFE0000000001FCFE0000000001
-FCFE0000000001FCFE0000000001FCFE0000000001FCFE0000000001FCFE0000000001FC
-FE0000000001FCFE0000000001FC7E0000000001F87F0000000003F87F0000000003F87F
-0000000003F87F0000000003F83F0000000003F03F8000000007F01F8000000007E01F80
-00000007E01FC00000000FE00FC00000000FC007C00000000F8007E00000001F8003E000
-00001F0001F00000003E0001F80000007E0000F80000007C00007C000000F800003E0000
-01F000000F000003C000000780000780000003E0001F00000000F8007C000000001E01E0
-0000000003FF000000363D7CBB3E> 79 D<003F80000001C0F0000003003C000004001E
-00000C000F000018000780001C0007C0003E0003C0003F0003E0003F0003E0003F0003E0
-001E0003E000000003E000000003E000000003E00000003FE000000FF3E000007E03E000
-01F803E00003E003E0000FC003E0001F8003E0003F0003E0003E0003E0007E0003E0007E
-0003E060FC0003E060FC0003E060FC0003E060FC0007E060FC0007E0607C000BE0607E00
-0BE0603E0011F0C01F0060F0C007C1807F8000FE003E0023257CA427> 97
-D<03E0000000FFE0000000FFE000000007E000000003E000000003E000000003E0000000
-03E000000003E000000003E000000003E000000003E000000003E000000003E000000003
-E000000003E000000003E000000003E000000003E000000003E000000003E000000003E0
-00000003E000000003E03FC00003E0E0780003E3001C0003E6000F0003E800078003F800
-03C003F00001E003E00001F003E00000F003E00000F803E00000F803E00000FC03E00000
-7C03E000007C03E000007E03E000007E03E000007E03E000007E03E000007E03E000007E
-03E000007E03E000007E03E000007E03E000007C03E000007C03E00000FC03E00000F803
-E00000F803E00001F003E00001E003F00003E003D80003C003C80007800384000E000383
-001C000381C0F00003003F8000273C7EBB2C> I<0007F800003C0E0000F0018001E000C0
-03C00060078000300F0000701F0000F81F0001F83E0001F83E0001F87E0000F07C000000
-7C000000FC000000FC000000FC000000FC000000FC000000FC000000FC000000FC000000
-FC0000007C0000007C0000007E0000003E0000003E00000C1F00000C1F0000180F800018
-0780003003C0006001E000C000F00180003C0E000007F8001E257DA423> I<0007F80000
-3C1E0000F0078001C003C003C001E0078000F00F0000F81F0000781E00007C3E00007C3E
-00007C7E00003E7C00003E7C00003EFC00003EFC00003EFFFFFFFEFC000000FC000000FC
-000000FC000000FC000000FC0000007C0000007C0000007E0000003E0000003E0000061F
-0000060F00000C0F80000C0780001803C0003000E00060007000C0001E07000003FC001F
-257EA423> 101 D<0000FC0000078300000E0380001C07C0003C0FC000780FC000F80FC0
-00F8078000F0000001F0000001F0000001F0000001F0000001F0000001F0000001F00000
-01F0000001F0000001F0000001F0000001F0000001F0000001F00000FFFFFC00FFFFFC00
-01F0000001F0000001F0000001F0000001F0000001F0000001F0000001F0000001F00000
-01F0000001F0000001F0000001F0000001F0000001F0000001F0000001F0000001F00000
-01F0000001F0000001F0000001F0000001F0000001F0000001F0000001F0000001F00000
-01F0000001F0000001F0000001F0000001F0000003F800007FFFE0007FFFE0001A3C7FBB
-18> I<07000F801FC01FC01FC00F80070000000000000000000000000000000000000000
-0000000000000007C0FFC0FFC00FC007C007C007C007C007C007C007C007C007C007C007
-C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007
-C007C00FE0FFFEFFFE0F397DB815> 105 D<0003800007C0000FE0000FE0000FE00007C0
-000380000000000000000000000000000000000000000000000000000000000000000000
-0000000000000007E000FFE000FFE0000FE00003E00003E00003E00003E00003E00003E0
-0003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E0
-0003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E0
-0003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E0
-7803C0FC07C0FC0780FC0780FC0F00780E00381C000FE000134A82B818> I<07C0FFC0FF
-C00FC007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007
-C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007
-C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007
-C00FE0FFFEFFFE0F3C7DBB15> 108 D<03E01FE0003FC000FFE0607C00C0F800FFE0801E
-01003C0007E3000F06001E0003E4000F88001F0003E4000F88001F0003E8000790000F00
-03E80007D0000F8003F00007E0000F8003F00007E0000F8003E00007C0000F8003E00007
-C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F80
-03E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007
-C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F80
-03E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007
-C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F80
-07F0000FE0001FC0FFFF81FFFF03FFFEFFFF81FFFF03FFFE3F257EA443> I<03E01FE000
-FFE0607C00FFE0801E0007E3000F0003E4000F8003E4000F8003E800078003E80007C003
-F00007C003F00007C003E00007C003E00007C003E00007C003E00007C003E00007C003E0
-0007C003E00007C003E00007C003E00007C003E00007C003E00007C003E00007C003E000
-07C003E00007C003E00007C003E00007C003E00007C003E00007C003E00007C003E00007
-C003E00007C003E00007C003E00007C003E00007C007F0000FE0FFFF81FFFFFFFF81FFFF
-28257EA42C> I<0007FC0000001C070000007001C00001E000F00003C00078000780003C
-000F00001E001F00001F001E00000F003E00000F803E00000F807C000007C07C000007C0
-7C000007C0FC000007E0FC000007E0FC000007E0FC000007E0FC000007E0FC000007E0FC
-000007E0FC000007E0FC000007E07C000007C07C000007C07E00000FC03E00000F803E00
-000F801E00000F001F00001F000F00001E000780003C0003C000780001E000F000007001
-C000001C0700000007FC000023257EA427> I<03E03E00FFE0C300FFE1078007E20FC003
-E40FC003E80FC003E8078003E8030003F0000003F0000003F0000003E0000003E0000003
-E0000003E0000003E0000003E0000003E0000003E0000003E0000003E0000003E0000003
-E0000003E0000003E0000003E0000003E0000003E0000003E0000003E0000003E0000003
-E0000003E0000003E0000007F00000FFFFC000FFFFC0001A257EA41E> 114
-D<00FF02000700C6000C002E0010001E0030001E0060000E0060000E00E0000600E00006
-00E0000600F0000600F8000600FC0000007F0000003FF000003FFF80000FFFE00007FFF0
-0001FFFC00003FFE000001FE0000003F00C0001F00C0000F80C0000780E0000380E00003
-80E0000380E0000380F0000300F0000300F8000700F8000600E4000C00E2001800C18070
-00807F800019257DA41F> I<003000000030000000300000003000000030000000300000
-0070000000700000007000000070000000F0000000F0000001F0000001F0000003F00000
-07F000001FFFFE00FFFFFE0001F0000001F0000001F0000001F0000001F0000001F00000
-01F0000001F0000001F0000001F0000001F0000001F0000001F0000001F0000001F00000
-01F0000001F0000001F0000001F0000001F0018001F0018001F0018001F0018001F00180
-01F0018001F0018001F0018001F0018000F0010000F8030000F8030000780200003C0400
-000E08000003F00019357FB41E> I 118
-D E
-%EndDVIPSBitmapFont
-end
-%%EndProlog
-%%BeginSetup
-%%Feature: *Resolution 300dpi
-TeXDict begin
-%%PaperSize: a4
-
-userdict/PStoPSxform PStoPSmatrix matrix currentmatrix
- matrix invertmatrix matrix concatmatrix
- matrix invertmatrix put
-%%EndSetup
-%%Page: (0,1) 1
-userdict/PStoPSsaved save put
-PStoPSmatrix setmatrix
-595.000000 0.271378 translate
-90 rotate
-0.706651 dup scale
-userdict/PStoPSmatrix matrix currentmatrix put
-userdict/PStoPSclip{0 0 moveto
- 595.000000 0 rlineto 0 842.000000 rlineto -595.000000 0 rlineto
- closepath}put initclip
-/showpage{}def/copypage{}def/erasepage{}def
-PStoPSxform concat
-1 0 bop Fn 281 370 a(Cleaner) p 570 370 a(seman) n(tics) p
-927 370 a(for) p 1047 370 a(Ob) t(jectiv) n(e) p 1404
-370 a(Lab) r(el) p Fm 717 518 a(Jacques) p 934 518 a(Garrigue) 719
-634 y(Octob) r(er) p 945 634 a(26,) p 1040 634 a(1999) p
-Fl 11 836 a(Credits) p Fk 11 929 a(This) p 122 929 a(prop) q(osal) p
-319 929 a(con) o(tains) p 510 929 a(ideas) p 632 929
-a(from) p 747 929 a(Damien) p 928 929 a(Doligez) p 1101
-929 a(and) p 1196 929 a(Pierre) p 1340 929 a(W) l(eis.) p
-Fl 11 1073 a(Lab) r(els) p 221 1073 a(and) p 351 1073
-a(optionals) p Fk 11 1165 a(Lab) q(els) p 165 1165 a(and) p
-259 1165 a(optional) p 449 1165 a(argumen) o(ts) p 687
-1165 a(had) p 781 1165 a(t) o(w) o(o) p 873 1165 a(problems) p
-1082 1165 a(in) p 1139 1165 a(Ob) s(jectiv) o(e) p 1360
-1165 a(Lab) q(el.) p Fj 83 1280 a(\017) p Fk 133 1280
-a(They) p 259 1280 a(w) o(ere) p 372 1280 a(not) p 459
-1280 a(fully) p 570 1280 a(coheren) o(t) p 767 1280 a(with) p
-878 1280 a(the) p 963 1280 a(original) p 1139 1280 a(call-b) o(y-v) m
-(alue) p 1423 1280 a(seman) o(tics) p 1644 1280 a(of) p
-1700 1280 a(the) p 1784 1280 a(lan-) 133 1340 y(guage.) p
-303 1340 a(In) p 368 1340 a(some) p 495 1340 a(\(subtle\)) p
-681 1340 a(cases,) p 823 1340 a(a) p 868 1340 a(side-e\013ect) p
-1099 1340 a(migh) o(t) p 1243 1340 a(get) p 1329 1340
-a(dela) o(y) o(ed) p 1508 1340 a(more) p 1635 1340 a(than) p
-1753 1340 a(in) p 1814 1340 a(an) 133 1400 y(un) o(t) o(yp) q(ed) p
-322 1400 a(seman) o(tics.) p Fj 83 1502 a(\017) p Fk
-133 1502 a(F) l(or) p 220 1502 a(optional) p 410 1502
-a(argumen) o(ts,) p 660 1502 a(no) p 728 1502 a(un) o(t) o(yp) q(ed) p
-918 1502 a(seman) o(tics) p 1139 1502 a(existed.) 84
-1616 y(This) p 195 1616 a(new) p 295 1616 a(prop) q(osal) p
-492 1616 a(corrects) p 674 1616 a(these) p 799 1616 a(t) o(w) o(o) p
-891 1616 a(\015a) o(ws.) p Fi 11 1746 a(Syn) n(tax) p
-Fk 11 1838 a(W) l(e) p 95 1838 a(k) o(eep) p 206 1838
-a(Ob) s(jectiv) o(e) p 426 1838 a(Lab) q(el's) p 594
-1838 a(syn) o(tax,) p 764 1838 a(except) p 917 1838 a(for) p
-991 1838 a(default) p 1155 1838 a(v) m(alues) p 1301
-1838 a(in) p 1357 1838 a(optional) p 1547 1838 a(argumen) o(ts.) p
-Fh 329 1944 a(typ) n(expr) p Fk 528 1944 a(::=) p Fg
-634 1944 a(:) p 656 1944 a(:) p 678 1944 a(:) p Fj 579
-2004 a(j) p Fh 634 2004 a(typ) n(expr) p Fj 806 2004
-a(!) p Fh 870 2004 a(typ) n(expr) p Fj 579 2064 a(j) p
-Fk 634 2064 a([?]) p Fi(lab) r(el) p Fk 801 2064 a(:) p
-Fh(typ) n(expr) p Fj 987 2064 a(!) p Fh 1050 2064 a(typ) n(expr) 391
-2124 y(expr) p Fk 528 2124 a(::=) p Fg 634 2124 a(:) p
-656 2124 a(:) p 678 2124 a(:) p Fj 579 2185 a(j) p Fh
-634 2185 a(expr) p 746 2185 a(lab) n(ele) n(d-expr) p
-Ff 991 2163 a(+) p Fj 579 2245 a(j) p Fe 634 2245 a(fun) p
-Fj 728 2245 a(f) p Fh(lab) n(ele) n(d-simple-p) n(attern) p
-Fj 1209 2245 a(g) p Ff 1234 2227 a(+) p Fk 1280 2245
-a([) p Fe(when) p Fh 1412 2245 a(expr) p Fk 1507 2245
-a(]) p Fj 1535 2245 a(!) p Fh 1599 2245 a(expr) p Fj
-579 2305 a(j) p Fe 634 2305 a(function) p Fh 856 2305
-a(lab) n(ele) n(d-p) n(attern) p Fk 1177 2305 a([) p
-Fe(when) p Fh 1309 2305 a(expr) p Fk 1404 2305 a(]) p
-Fj 1432 2305 a(!) p Fh 1496 2305 a(expr) p Fj 785 2365
-a(f) p Fe(|) p Fh 851 2365 a(lab) n(ele) n(d-p) n(attern) p
-Fk 1172 2365 a([) p Fe(when) p Fg 1305 2365 a(expr) p
-Fk 1403 2365 a(]) p Fj 1430 2365 a(!) p Fh 1494 2365
-a(expr) p Fj 1589 2365 a(g) p Fd 1614 2347 a(\003) p
-Fh 242 2425 a(lab) n(ele) n(d-expr) p Fk 528 2425 a(::=) p
-634 2425 a([?]) p Fh(expr) p Fj 579 2486 a(j) p Fk 634
-2486 a([?]) p Fi(lab) r(el) p Fk 801 2486 a(:) p Fh(expr) 182
-2546 y(lab) n(ele) n(d-p) n(attern) p Fk 528 2546 a(::=) p
-Fh 634 2546 a(p) n(attern) p Fj 579 2606 a(j) p Fi 634
-2606 a(lab) r(el) p Fk 751 2606 a(:) p Fh(p) n(attern) p
-Fj 579 2666 a(j) p Fk 634 2666 a(?[) p Fe(\() p Fh(expr) p
-Fe(\)) p Fk(]) p Fi(lab) r(el) p Fk 943 2666 a(:) p Fh
-956 2666 a(p) n(attern) p Fk 926 2937 a(1) p eop
-PStoPSsaved restore
-userdict/PStoPSsaved save put
-PStoPSmatrix setmatrix
-595.000000 421.271378 translate
-90 rotate
-0.706651 dup scale
-userdict/PStoPSmatrix matrix currentmatrix put
-userdict/PStoPSclip{0 0 moveto
- 595.000000 0 rlineto 0 842.000000 rlineto -595.000000 0 rlineto
- closepath}put initclip
-PStoPSxform concat
-2 1 bop Fi 11 168 a(Dynamic) p 247 168 a(seman) n(tics) p
-Fj 11 261 a(;) p Fk 52 261 a(is) p 101 261 a(a) p 141
-261 a(notation) p 337 261 a(for) p 411 261 a(the) p 495
-261 a(empt) o(y) p 644 261 a(lab) q(el.) 86 366 y(\() p
-Fe(fun) p Fi 198 366 a(l) p Fc 214 373 a(i) p Fk 227
-366 a(:) p Fg(x) p Fj 282 366 a(!) p Fg 346 366 a(e) p
-Fk(\)) p Fi 404 366 a(l) p Fc 420 373 a(1) p Fk 442 366
-a(:) p Fg 455 366 a(e) p Ff 478 373 a(1) p Fg 506 366
-a(:) p 528 366 a(:) p 550 366 a(:) p Fi 571 366 a(l) p
-Fc 587 373 a(n) p Fk 612 366 a(:) p Fg 625 366 a(e) p
-Fb 648 373 a(n) p Fj 515 427 a(!) p Fk 579 427 a(\() p
-Fg(e) p Fk([) p Fg(e) p Fb 658 434 a(i) p Fg 671 427
-a(=x) p Fk(]) p Fi 752 427 a(l) p Fc 768 434 a(1) p Fk
-790 427 a(:) p Fg(e) p Ff 827 434 a(1) p Fg 855 427 a(:) p
-877 427 a(:) p 899 427 a(:) p Fi 920 427 a(l) p Fc 936
-434 a(i) p Fd(\000) p Fc(1) p Fk 997 427 a(:) p Fg 1010
-427 a(e) p Fb 1033 434 a(i) p Fd(\000) p Ff(1) p Fi 1108
-427 a(l) p Fc 1124 434 a(i) p Ff(+) p Fc(1) p Fk 1185
-427 a(:) p Fg(e) p Fb 1222 434 a(i) p Ff(+1) p Fg 1289
-427 a(:) p 1311 427 a(:) p 1333 427 a(:) p Fi 1354 427
-a(l) p Fc 1370 434 a(n) p Fk 1395 427 a(:) p Fg 1408
-427 a(e) p Fb 1431 434 a(n) p Fk 86 487 a(\() p Fe(fun) p
-Fk 198 487 a(?) p Fi(l) p Fc 237 494 a(i) p Fk 250 487
-a(:) p Fg(x) p Fj 305 487 a(!) p Fg 369 487 a(e) p Fk(\)) p
-Fi 427 487 a(l) p Fc 443 494 a(1) p Fk 465 487 a(:) p
-Fg 478 487 a(e) p Ff 501 494 a(1) p Fg 529 487 a(:) p
-551 487 a(:) p 573 487 a(:) p Fi 594 487 a(l) p Fc 610
-494 a(n) p Fk 635 487 a(:) p Fg 648 487 a(e) p Fb 671
-494 a(n) p Fj 515 547 a(!) p Fg 579 547 a(e) p Fk([) p
-Fe(Some) p Fk 717 547 a(\() p Fg(e) p Fb 759 554 a(i) p
-Fk 773 547 a(\)) p Fg(=x) p Fk(]) p Fi 874 547 a(l) p
-Fc 890 554 a(1) p Fk 912 547 a(:) p Fg 925 547 a(e) p
-Ff 948 554 a(1) p Fg 976 547 a(:) p 998 547 a(:) p 1020
-547 a(:) p Fi 1042 547 a(l) p Fc 1058 554 a(i) p Fd(\000) p
-Fc(1) p Fk 1118 547 a(:) p Fg(e) p Fb 1155 554 a(i) p
-Fd(\000) p Ff(1) p Fi 1230 547 a(l) p Fc 1246 554 a(i) p
-Ff(+) p Fc(1) p Fk 1307 547 a(:) p Fg 1320 547 a(e) p
-Fb 1343 554 a(i) p Ff(+1) p Fg 1410 547 a(:) p 1432 547
-a(:) p 1454 547 a(:) p Fi 1476 547 a(l) p Fc 1492 554
-a(n) p Fk 1516 547 a(:) p Fg(e) p Fb 1553 554 a(n) p
-Fk 86 607 a(\() p Fe(fun) p Fk 198 607 a(?) p Fi(l) p
-Fk(:) p Fg 250 607 a(x) p Fj 292 607 a(!) p Fg 356 607
-a(e) p Fk(\)) p Fi 413 607 a(l) p Fc 429 614 a(1) p Fk
-451 607 a(:) p Fg(e) p Ff 488 614 a(1) p Fg 516 607 a(:) p
-538 607 a(:) p 560 607 a(:) p Fi 581 607 a(l) p Fc 597
-614 a(n) p Fk 621 607 a(:) p Fg(e) p Fb 658 614 a(n) p
-Fk 1154 607 a(when) p Fi 1281 607 a(l) p Fc 1297 614
-a(i) p Fk 1324 607 a(=) p Fj 1376 607 a(;) p Fk 1417
-607 a(and) p Fg 1512 607 a(l) p Fj 1541 607 a(62) p 1588
-607 a(f) p Fi(l) p Fc 1629 614 a(1) p Fg 1660 607 a(:) p
-1682 607 a(:) p 1704 607 a(:) p Fi 1725 607 a(l) p Fc
-1741 614 a(n) p Fj 1765 607 a(g) 515 667 y(!) p Fg 579
-667 a(e) p Fk([) p Fe(None) p Fg 717 667 a(=x) p Fk(]) p
-Fi 799 667 a(l) p Fc 815 674 a(1) p Fk 837 667 a(:) p
-Fg(e) p Ff 874 674 a(1) p Fg 901 667 a(:) p 923 667 a(:) p
-945 667 a(:) p Fi 967 667 a(l) p Fc 983 674 a(n) p Fk
-1007 667 a(:) p Fg(e) p Fb 1044 674 a(n) p Fk 86 728
-a(\(\() p Fe(fun) p Fi 217 728 a(l) p Fk(:) p Fg 246
-728 a(x) p Fj 288 728 a(!) p Fg 352 728 a(e) p Fk(\)) p
-Fi 409 728 a(l) p Fc 425 735 a(1) p Fk 447 728 a(:) p
-Fg(e) p Ff 484 735 a(1) p Fg 511 728 a(:) p 533 728 a(:) p
-555 728 a(:) p Fi 577 728 a(l) p Fc 593 735 a(m) p Fk
-629 728 a(:) p Fg 642 728 a(e) p Fb 665 735 a(m) p Fk
-698 728 a(\)) p Fi 733 728 a(l) p Fc 749 735 a(m) p Ff(+) p
-Fc(1) p Fk 833 728 a(:) p Fg 846 728 a(e) p Fb 869 735
-a(m) p Ff(+1) p Fg 955 728 a(:) p 977 728 a(:) p 999
-728 a(:) p Fi 1021 728 a(l) p Fc 1037 735 a(n) p Fk 1061
-728 a(:) p Fg(e) p Fb 1098 735 a(n) p Fk 1373 728 a(when) p
-Fi 1501 728 a(l) p Fj 1530 728 a(62) p 1577 728 a(f) p
-Fi(l) p Fc 1618 735 a(1) p Fg 1648 728 a(:) p 1670 728
-a(:) p 1692 728 a(:) p Fi 1714 728 a(l) p Fc 1730 735
-a(m) p Fj 1765 728 a(g) 515 788 y(!) p Fk 579 788 a(\() p
-Fe(fun) p Fi 691 788 a(l) p Fk(:) p Fg 720 788 a(x) p
-Fj 761 788 a(!) p Fg 825 788 a(e) p Fk(\)) p Fi 883 788
-a(l) p Fc 899 795 a(1) p Fk 921 788 a(:) p Fg 934 788
-a(e) p Ff 957 795 a(1) p Fg 985 788 a(:) p 1007 788 a(:) p
-1029 788 a(:) p Fi 1051 788 a(l) p Fc 1067 795 a(n) p
-Fk 1091 788 a(:) p Fg 1104 788 a(e) p Fb 1127 795 a(n) p
-Fk 86 848 a(\(\() p Fe(fun) p Fk 217 848 a(?) p Fi(l) p
-Fk(:) p Fg 269 848 a(x) p Fj 311 848 a(!) p Fg 375 848
-a(e) p Fk(\)) p Fi 432 848 a(l) p Fc 448 855 a(1) p Fk
-470 848 a(:) p Fg(e) p Ff 507 855 a(1) p Fg 535 848 a(:) p
-557 848 a(:) p 579 848 a(:) p Fi 600 848 a(l) p Fc 616
-855 a(m) p Fk 652 848 a(:) p Fg 665 848 a(e) p Fb 688
-855 a(m) p Fk 721 848 a(\)) p Fi 756 848 a(l) p Fc 772
-855 a(m) p Ff(+) p Fc(1) p Fk 856 848 a(:) p Fg 869 848
-a(e) p Fb 892 855 a(m) p Ff(+1) p Fg 978 848 a(:) p 1000
-848 a(:) p 1022 848 a(:) p Fi 1044 848 a(l) p Fc 1060
-855 a(n) p Fk 1084 848 a(:) p Fg(e) p Fb 1121 855 a(n) p
-Fk 1261 848 a(when) p Fj 1388 848 a(f) p Fi(l) p Fg(;) p
-Fj 1451 848 a(;g) p 1530 848 a(6) m(\\) p 1577 848 a(f) p
-Fi(l) p Fc 1618 855 a(1) p Fg 1648 848 a(:) p 1670 848
-a(:) p 1692 848 a(:) p Fi 1714 848 a(l) p Fc 1730 855
-a(m) p Fj 1765 848 a(g) 515 908 y(!) p Fk 579 908 a(\() p
-Fe(fun) p Fk 691 908 a(?) p Fi(l) p Fk(:) p Fg 743 908
-a(x) p Fj 785 908 a(!) p Fg 848 908 a(e) p Fk(\)) p Fi
-906 908 a(l) p Fc 922 915 a(1) p Fk 944 908 a(:) p Fg(e) p
-Ff 981 915 a(1) p Fg 1008 908 a(:) p 1030 908 a(:) p
-1052 908 a(:) p Fi 1074 908 a(l) p Fc 1090 915 a(n) p
-Fk 1114 908 a(:) p Fg 1127 908 a(e) p Fb 1150 915 a(n) p
-Fi 11 1035 a(T) n(yping) p Fk 11 1127 a(Seman) o(tics) p
-240 1127 a(are) p 321 1127 a(k) o(ept) p 430 1127 a(throughout) p
-685 1127 a(compilation) p 950 1127 a(b) o(y) p 1018 1127
-a(disallo) o(wing) p 1269 1127 a(lab) q(el) p 1387 1127
-a(comm) o(utation) p 1684 1127 a(for) p 1759 1127 a(func-) 11
-1187 y(tion) p 116 1187 a(t) o(yp) q(es.) p 278 1187
-a(Ho) o(w) o(ev) o(er,) p 494 1187 a(the) p 583 1187
-a(original) p 764 1187 a(comfort) p 949 1187 a(of) p
-1009 1187 a(out-of-order) p 1283 1187 a(application) p
-1540 1187 a(is) p 1594 1187 a(reco) o(v) o(ered) p 1814
-1187 a(b) o(y) 11 1247 y(allo) o(wing) p 207 1247 a(argumen) o(t) p
-431 1247 a(reordering) p 670 1247 a(in) p 732 1247 a(application,) p
-1005 1247 a(when) p 1138 1247 a(the) p 1227 1247 a(function's) p
-1457 1247 a(t) o(yp) q(e) p 1572 1247 a(is) p Fh 1626
-1247 a(wel) r(l) p 1731 1247 a(known) p Fk 11 1308 a(\() p
-Fh(c.f.) p Fk 118 1308 a(p) q(olymorphic) p 400 1308
-a(metho) q(ds\).) p Fl 11 1452 a(V) p 56 1452 a(arian) n(ts) p
-Fk 11 1544 a(V) l(arian) o(t) p 187 1544 a(t) o(yping,) p
-355 1544 a(as) p 417 1544 a(it) p 468 1544 a(is) p 519
-1544 a(presen) o(ted) p 739 1544 a(in) p 798 1544 a(the) p
-884 1544 a(user's) p 1022 1544 a(man) o(ual,) p 1210
-1544 a(is) p 1261 1544 a(not) p 1350 1544 a(principal:) p
-1576 1544 a(in) p 1635 1544 a(some) p 1760 1544 a(cases) 11
-1605 y(t) o(ypabilit) o(y) p 239 1605 a(of) p 301 1605
-a(an) p 375 1605 a(expression) p 616 1605 a(ma) o(y) p
-728 1605 a(dep) q(end) p 904 1605 a(on) p 978 1605 a(the) p
-1069 1605 a(order) p 1202 1605 a(in) p 1265 1605 a(whic) o(h) p
-1411 1605 a(the) p 1502 1605 a(t) o(yping) p 1660 1605
-a(algorithm) 11 1665 y(pro) q(ceeds.) p Fe 133 1779 a(#) p
-184 1779 a(let) p 286 1779 a(f1) p 363 1779 a(\(x) p
-440 1779 a(:) p 491 1779 a([<) p 568 1779 a(a) p 620
-1779 a(b\(int\)]\)) p 850 1779 a(=) p 902 1779 a(\(\)) 184
-1839 y(let) p 286 1839 a(f2) p 363 1839 a(\(x) p 440
-1839 a(:) p 491 1839 a([<) p 568 1839 a(a]\)) p 671 1839
-a(=) p 722 1839 a(\(\)) 184 1899 y(let) p 286 1899 a(f3) p
-363 1899 a(\(x) p 440 1899 a(:) p 491 1899 a([<) p 568
-1899 a(a) p 620 1899 a(b\(bool\)]\)) p 876 1899 a(=) p
-927 1899 a(\(\);;) 133 1960 y(val) p 235 1960 a(f1) p
-312 1960 a(:) p 363 1960 a([<) p 440 1960 a(a) p 491
-1960 a(b\(int\)]) p 696 1960 a(->) p 773 1960 a(unit) p
-902 1960 a(=) p 953 1960 a() 133 2020 y(val) p 235
-2020 a(f2) p 312 2020 a(:) p 363 2020 a([<) p 440 2020
-a(a]) p 517 2020 a(->) p 594 2020 a(unit) p 722 2020
-a(=) p 773 2020 a() 133 2080 y(val) p 235 2080 a(f3) p
-312 2080 a(:) p 363 2080 a([<) p 440 2080 a(a) p 491
-2080 a(b\(bool\)]) p 722 2080 a(->) p 799 2080 a(unit) p
-927 2080 a(=) p 978 2080 a() 133 2140 y(#) p 184
-2140 a(fun) p 286 2140 a(x) p 338 2140 a(->) p 414 2140
-a(f1) p 491 2140 a(x;) p 568 2140 a(f2) p 645 2140 a(x;) p
-722 2140 a(f3) p 799 2140 a(x;;) 133 2200 y(-) p 184
-2200 a(:) p 235 2200 a([<) p 312 2200 a(a]) p 389 2200
-a(->) p 466 2200 a(unit) p 594 2200 a(=) p 645 2200 a() 133
-2260 y(#) p 184 2260 a(fun) p 286 2260 a(x) p 338 2260
-a(->) p 414 2260 a(f1) p 491 2260 a(x;) p 568 2260 a(f3) p
-645 2260 a(x;;) 133 2321 y(Character) o(s) p 414 2321
-a(18-19:) 133 2381 y(This) p 261 2381 a(expressio) o(n) p
-543 2381 a(has) p 645 2381 a(type) p 773 2381 a([<) p
-850 2381 a(a) p 902 2381 a(b\(int\)]) p 1107 2381 a(but) p
-1209 2381 a(is) p 1286 2381 a(here) p 1414 2381 a(used) p
-1542 2381 a(with) p 1670 2381 a(type) 184 2441 y([<) p
-261 2441 a(a) p 312 2441 a(b\(bool\)]) p Fk 84 2555 a(Here) p
-204 2555 a(the) p 292 2555 a(constrain) o(t) p 526 2555
-a(in) o(tro) q(duced) p 775 2555 a(b) o(y) p Fe 848 2555
-a(f2) p Fk 920 2555 a(hides) p 1049 2555 a(the) p 1138
-2555 a(constructor) p Fe 1401 2555 a(b) p Fk(,) p 1462
-2555 a(and) p 1562 2555 a(a) o(v) o(oids) p 1714 2555
-a(a) p 1760 2555 a(clash) 11 2615 y(b) q(et) o(w) o(een) p
-Fe 199 2615 a(int) p Fk 292 2615 a(and) p Fe 387 2615
-a(bool) p Fk(.) 84 2676 y(An) p 163 2676 a(easy) p 270
-2676 a(w) o(a) o(y) p 369 2676 a(to) p 428 2676 a(solv) o(e) p
-547 2676 a(this) p 642 2676 a(w) o(ould) p 784 2676 a(b) q(e) p
-850 2676 a(to) p 909 2676 a(restrict) p 1077 2676 a(hiding) p
-1226 2676 a(absen) o(t) p 1379 2676 a(lab) q(els) p 1515
-2676 a(to) p 1575 2676 a(generic) p 1739 2676 a(t) o(yp) q(es.) 11
-2736 y(This) p 124 2736 a(w) o(a) o(y) p 224 2736 a(the) p
-310 2736 a(second) p 469 2736 a(case) p 574 2736 a(w) o(ould) p
-718 2736 a(still) p 814 2736 a(fail,) p 913 2736 a(since) p
-Fe 1034 2736 a(x) p Fk 1077 2736 a(has) p 1166 2736 a(a) p
-1208 2736 a(monorphic) p 1451 2736 a(t) o(yp) q(e.) p
-1584 2736 a(This) p 1697 2736 a(solution) 11 2796 y(w) o(ould) p
-153 2796 a(b) q(e) p 219 2796 a(correct) p 382 2796 a(and) p
-477 2796 a(principal.) 926 2937 y(2) p eop
-PStoPSsaved restore
-%%Page: (2,3) 2
-userdict/PStoPSsaved save put
-PStoPSmatrix setmatrix
-595.000000 0.271378 translate
-90 rotate
-0.706651 dup scale
-userdict/PStoPSmatrix matrix currentmatrix put
-userdict/PStoPSclip{0 0 moveto
- 595.000000 0 rlineto 0 842.000000 rlineto -595.000000 0 rlineto
- closepath}put initclip
-/showpage{}def/copypage{}def/erasepage{}def
-PStoPSxform concat
-3 2 bop Fk 84 168 a(Ho) o(w) o(ev) o(er,) p 293 168 a(one) p
-382 168 a(can) p 472 168 a(easily) p 606 168 a(see) p
-684 168 a(that) p 789 168 a(this) p 884 168 a(solution) p
-1068 168 a(is) p 1117 168 a(coun) o(ter-in) o(tuitiv) o(e.) p
-1504 168 a(F) l(or) p 1591 168 a(the) p 1675 168 a(user,) p
-Fe 1791 168 a(b) p Fk 1833 168 a(is) 11 229 y(already) p
-183 229 a(an) p 250 229 a(imp) q(ossible) p 488 229 a(constructor,) p
-759 229 a(and) p 854 229 a(ha) o(ving) p 1011 229 a(a) p
-1052 229 a(clash) p 1174 229 a(on) p 1242 229 a(it) p
-1291 229 a(is) p 1340 229 a(hard) p 1453 229 a(to) p
-1513 229 a(understand.) 84 289 y(Another) p 277 289 a(solution) p
-463 289 a(is) p 514 289 a(to) p 575 289 a(go) p 642 289
-a(the) p 728 289 a(opp) q(osite) p 924 289 a(w) o(a) o(y) l(.) p
-1044 289 a(T) l(o) p 1117 289 a(accept) p 1271 289 a(more) p
-1395 289 a(programs.) p 1634 289 a(This) p 1747 289 a(is) p
-1798 289 a(the) 11 349 y(w) o(a) o(y) p 109 349 a(w) o(e) p
-181 349 a(explore) p 351 349 a(here,) p 470 349 a(with) p
-581 349 a(an) p 649 349 a(unc) o(hanged) p 891 349 a(syn) o(tax.) p
-Fi 11 479 a(T) n(yping) p Fk 11 571 a(The) p 114 571
-a(idea) p 220 571 a(is) p 273 571 a(to) p 336 571 a(dela) o(y) p
-466 571 a(uni\014cation) p 711 571 a(on) p 782 571 a(constructor) p
-1043 571 a(un) o(til) p 1161 571 a(they) p 1274 571 a(are) p
-1359 571 a(explicitely) p 1595 571 a(kno) o(wn) p 1753
-571 a(to) p 1816 571 a(b) q(e) 11 631 y(presen) o(t.) p
-199 631 a(W) l(e) p 280 631 a(k) o(eep) p 390 631 a(the) p
-472 631 a(\() p Fg(T) t(;) p 546 631 a(U;) p 601 631
-a(L) p Fk(\)) p 666 631 a(represen) o(tation) p 983 631
-a(of) p 1036 631 a(v) m(arian) o(t) p 1200 631 a(t) o(yp) q(es,) p
-1341 631 a(but) p Fg 1428 631 a(T) p Fk 1478 631 a(is) p
-1525 631 a(no) p 1591 631 a(longer) p 1735 631 a(a) p
-1774 631 a(map) 11 692 y(from) p 126 692 a(constructors) p
-403 692 a(to) p 462 692 a(t) o(yp) q(es,) p 605 692 a(but) p
-694 692 a(from) p 809 692 a(constructors) p 1086 692
-a(to) p 1146 692 a(sets) p 1241 692 a(of) p 1297 692
-a(t) o(yp) q(es.) 84 752 y(When) p 230 752 a(w) o(e) p
-307 752 a(unify) p 436 752 a(t) o(w) o(o) p 532 752 a(v) m(arian) o(t) p
-702 752 a(t) o(yp) q(es,) p 850 752 a(the) p 938 752
-a(\014rst) p 1043 752 a(step) p 1150 752 a(is) p 1204
-752 a(just) p 1305 752 a(to) p 1369 752 a(tak) o(e) p
-1479 752 a(the) p 1567 752 a(union) p 1707 752 a(of) p
-1767 752 a(b) q(oth) 11 812 y(t) o(yping) p 162 812 a(en) o(vironmen) o
-(ts,) p 476 812 a(dropping) p 682 812 a(unnecessary) p
-952 812 a(t) o(yp) q(es.) 204 932 y(\() p Fg(T) p Ff
-252 939 a(1) p Fg 272 932 a(;) p 294 932 a(U) p Ff 327
-939 a(1) p Fg 346 932 a(;) p 368 932 a(L) p Ff 401 939
-a(1) p Fk 421 932 a(\)) p Fj 451 932 a(^) p Fk 495 932
-a(\() p Fg(T) p Ff 543 939 a(2) p Fg 563 932 a(;) p 585
-932 a(U) p Ff 618 939 a(2) p Fg 637 932 a(;) p 659 932
-a(L) p Ff 692 939 a(2) p Fk 712 932 a(\)) p 745 932 a(=) p
-797 932 a(\(\() p Fg(T) p Ff 864 939 a(1) p Fj 883 932
-a(j) p Fb 897 939 a(U) p Fa 921 944 a(1) p Fd 938 939
-a(\\) p Fb(U) p Fa 986 944 a(2) p Fk 1005 932 a(\)) p
-Fj 1035 932 a([) p Fk 1079 932 a(\() p Fg(T) p Ff 1127
-939 a(2) p Fj 1146 932 a(j) p Fb 1160 939 a(U) p Fa 1184
-944 a(1) p Fd 1201 939 a(\\) p Fb(U) p Fa 1249 944 a(2) p
-Fk 1268 932 a(\)) p Fg(;) p 1309 932 a(U) p Ff 1342 939
-a(1) p Fj 1373 932 a(\\) p Fg 1417 932 a(U) p Ff 1450
-939 a(2) p Fg 1470 932 a(;) p 1492 932 a(L) p Ff 1525
-939 a(1) p Fj 1556 932 a([) p Fg 1600 932 a(L) p Ff 1633
-939 a(2) p Fk 1653 932 a(\)) 84 1042 y(Here) p 203 1042
-a(the) p 291 1042 a(union) p 431 1042 a(of) p 490 1042
-a(t) o(w) o(o) p 587 1042 a(t) o(yping) p 742 1042 a(en) o(vironmen) o
-(ts) p 1046 1042 a(is) p 1099 1042 a(the) p 1187 1042
-a(p) q(oin) o(t) o(wise) p 1407 1042 a(union) p 1547
-1042 a(of) p 1606 1042 a(their) p 1727 1042 a(sets) p
-1826 1042 a(of) 11 1102 y(t) o(yp) q(es) p 140 1102 a(for) p
-214 1102 a(eac) o(h) p 324 1102 a(constructor.) 84 1162
-y(This) p 195 1162 a(\014rst) p 296 1162 a(step) p 399
-1162 a(nev) o(er) p 529 1162 a(fails.) 84 1222 y(In) p
-145 1222 a(a) p 186 1222 a(second) p 343 1222 a(step,) p
-460 1222 a(structural) p 685 1222 a(constrain) o(ts) p
-934 1222 a(are) p 1015 1222 a(enforced) p 1209 1222 a(on) p
-1277 1222 a(the) p 1361 1222 a(resulting) p 1562 1222
-a(t) o(yp) q(e) p 1672 1222 a(\() p Fg(T) t(;) p 1746
-1222 a(U;) p 1801 1222 a(L) p Fk(\).) 11 1282 y(First,) p
-Fg 144 1282 a(L) p Fk 195 1282 a(should) p 351 1282 a(b) q(e) p
-418 1282 a(included) p 614 1282 a(in) p Fg 672 1282 a(U) p
-Fk 710 1282 a(.) p 749 1282 a(Then,) p 892 1282 a(for) p
-967 1282 a(all) p 1036 1282 a(constructors) p 1314 1282
-a(app) q(earing) p 1542 1282 a(in) p Fg 1600 1282 a(L) p
-Fk(,) p 1664 1282 a(the) p 1749 1282 a(set) p 1826 1282
-a(of) 11 1343 y(t) o(yp) q(es) p 136 1343 a(asso) q(ciated) p
-365 1343 a(with) p 472 1343 a(eac) o(h) p 578 1343 a(constructor) p
-833 1343 a(is) p 878 1343 a(collapsed) p 1084 1343 a(b) o(y) p
-1148 1343 a(uni\014cation.) p 1407 1343 a(This) p 1515
-1343 a(can) p 1600 1343 a(b) q(e) p 1663 1343 a(expressed) 11
-1403 y(b) o(y) p 78 1403 a(rewriting) p 287 1403 a(rules,) p
-417 1403 a(where) p Fg 558 1403 a(e) p Fk 597 1403 a(is) p
-646 1403 a(a) p 687 1403 a(m) o(ulti-equation) p 1015
-1403 a(and) p Fg 1109 1403 a(\036) p Fk 1155 1403 a(a) p
-1195 1403 a(set) p 1271 1403 a(of) p 1327 1403 a(m) o(ultiequations) 249
-1509 y(if) p Fg 294 1509 a(L) p Fj 341 1509 a(6\032) p
-Fg 393 1509 a(U) p Fk 448 1509 a(then) p 559 1509 a(\() p
-Fg(T) t(;) p 633 1509 a(U;) p 688 1509 a(L) p Fk(\)) p
-753 1509 a(=) p Fg 805 1509 a(e) p Fj 839 1509 a(^) p
-Fg 883 1509 a(\036) p Fj 926 1509 a(\000) p 956 1509
-a(!) p 1020 1509 a(?) p Fk 249 1629 a(if) p Fg 294 1629
-a(l) p Fj 323 1629 a(2) p Fg 370 1629 a(L) p Fk 420 1629
-a(and) p Fg 515 1629 a(T) p Fk 551 1629 a(\() p Fg(l) p
-Fk 586 1629 a(\)) p 617 1629 a(=) p Fj 669 1629 a(f) p
-Fg(\034) p Ff 715 1636 a(1) p Fg 735 1629 a(;) p 757
-1629 a(:) p 779 1629 a(:) p 801 1629 a(:) p 822 1629
-a(;) p 844 1629 a(\034) p Fb 865 1636 a(n) p Fj 889 1629
-a(g) p Fk 930 1629 a(then) 298 1689 y(\() p Fg(T) t(;) p
-372 1689 a(U;) p 427 1689 a(L) p Fk(\)) p 492 1689 a(=) p
-Fg 544 1689 a(e) p Fj 577 1689 a(^) p Fg 622 1689 a(\036) p
-Fj 664 1689 a(\000) p 695 1689 a(!) p Fk 759 1689 a(\() p
-Fg(T) p Fj 814 1689 a(f) p Fg(l) p Fj 867 1689 a(7!) p
-Fg 931 1689 a(\034) p Ff 952 1696 a(1) p Fj 972 1689
-a(g) p Fg(;) p 1019 1689 a(U;) p 1074 1689 a(L) p Fk(\)) p
-1139 1689 a(=) p Fg 1191 1689 a(e) p Fj 1225 1689 a(^) p
-Fg 1269 1689 a(\034) p Ff 1290 1696 a(1) p Fk 1324 1689
-a(=) p Fg 1376 1689 a(:) p 1398 1689 a(:) p 1420 1689
-a(:) p Fk 1447 1689 a(=) p Fg 1498 1689 a(\034) p Fb
-1519 1696 a(n) p Fj 1554 1689 a(^) p Fg 1598 1689 a(\036) p
-Fk 84 1796 a(Optionally) p 331 1796 a(one) p 425 1796
-a(can) p 519 1796 a(add) p 619 1796 a(rules) p 740 1796
-a(that) p 850 1796 a(remo) o(v) o(e) p 1022 1796 a(a) p
-1067 1796 a(constructor) p Fg 1329 1796 a(l) p Fk 1366
-1796 a(from) p Fg 1486 1796 a(U) p Fk 1545 1796 a(if) p
-1594 1796 a(the) p 1683 1796 a(equation) 11 1856 y(obtained) p
-211 1856 a(from) p Fg 326 1856 a(T) p Fk 362 1856 a(\() p
-Fg(l) p Fk 397 1856 a(\)) p 431 1856 a(has) p 518 1856
-a(no) p 586 1856 a(solution.) p 790 1856 a(Suc) o(h) p
-908 1856 a(rules) p 1024 1856 a(w) o(ould) p 1167 1856
-a(b) q(e) p 1233 1856 a(sound) p 1374 1856 a(and) p 1469
-1856 a(complete.) p Fi 11 1986 a(Syn) n(tax) p 198 1986
-a(of) p 262 1986 a(t) n(yp) r(es) p Fk 11 2078 a(Thanks) p
-188 2078 a(to) p 250 2078 a(the) p 336 2078 a(go) q(o) q(d) p
-458 2078 a(prop) q(erties) p 689 2078 a(of) p 747 2078
-a(these) p 874 2078 a(constrain) o(ts,) p 1139 2078 a(the) p
-1226 2078 a(surface) p 1392 2078 a(syn) o(tax) p 1551
-2078 a(of) p 1608 2078 a(t) o(yp) q(es) p 1740 2078 a(w) o(ould) 11
-2138 y(only) p 118 2138 a(ha) o(v) o(e) p 230 2138 a(to) p
-290 2138 a(b) q(e) p 356 2138 a(sligh) o(tly) p 527 2138
-a(extended.) p Fh 590 2244 a(tag-typ) n(e) p Fk 798 2244
-a(::=) p Fh 904 2244 a(ident) p Fj 849 2304 a(j) p Fh
-904 2304 a(ident) p Fe 1031 2304 a(\() p Fh(typ) n(expr-list) p
-Fe(\)) p Fh 523 2365 a(typ) n(expr-list) p Fk 798 2365
-a(::=) p Fh 904 2365 a(typ) n(expr) p Fj 849 2425 a(j) p
-Fh 904 2425 a(typ) n(expr) p Fe 1078 2425 a(&) p Fh 1120
-2425 a(typ) n(expr-list) p Fk 84 2531 a(Notice) p 234
-2531 a(that) p 336 2531 a(a) p 373 2531 a(0-ary) p 496
-2531 a(constructor) p 751 2531 a(and) p 842 2531 a(an) p
-907 2531 a(1-ary) p 1030 2531 a(construtor) p 1262 2531
-a(are) p 1340 2531 a(con) o(tradictory) l(,) p 1648 2531
-a(and) p 1740 2531 a(w) o(ould) 11 2592 y(result) p 146
-2592 a(in) p 203 2592 a(the) p 287 2592 a(absence) p
-466 2592 a(of) p 522 2592 a(this) p 617 2592 a(constructor.) 926
-2937 y(3) p eop
-PStoPSsaved restore
-userdict/PStoPSsaved save put
-PStoPSmatrix setmatrix
-595.000000 421.271378 translate
-90 rotate
-0.706651 dup scale
-userdict/PStoPSmatrix matrix currentmatrix put
-userdict/PStoPSclip{0 0 moveto
- 595.000000 0 rlineto 0 842.000000 rlineto -595.000000 0 rlineto
- closepath}put initclip
-PStoPSxform concat
-4 3 bop Fi 11 168 a(Discussion) p Fk 11 261 a(Suc) o(h) p
-133 261 a(a) p 179 261 a(c) o(hange) p 345 261 a(has) p
-436 261 a(the) p 525 261 a(ma) s(jor) p 672 261 a(adv) m(an) o(tage) p
-907 261 a(of) p 967 261 a(b) q(oth) p 1087 261 a(reco) o(v) o(ering) p
-1324 261 a(principalit) o(y) p 1589 261 a(and) p 1688
-261 a(a) o(v) o(oiding) 11 321 y(unin) o(tuitiv) o(e) p
-266 321 a(error) p 392 321 a(messages.) p 640 321 a(Constrain) o(ts) p
-909 321 a(created) p 1087 321 a(in) p 1152 321 a(suc) o(h) p
-1269 321 a(a) p 1317 321 a(w) o(a) o(y) p 1423 321 a(are) p
-1512 321 a(v) o(ery) p 1626 321 a(ligh) o(t:) p 1772
-321 a(they) 11 381 y(alw) o(a) o(ys) p 165 381 a(app) q(ear) p
-325 381 a(inside) p 463 381 a(a) p 502 381 a(v) m(arian) o(t) p
-666 381 a(t) o(yp) q(e,) p 788 381 a(and) p 882 381 a(if) p
-926 381 a(the) p 1008 381 a(v) m(arian) o(t) p 1172 381
-a(t) o(yp) q(e) p 1281 381 a(do) q(es) p 1390 381 a(not) p
-1475 381 a(app) q(ear) p 1635 381 a(in) p 1691 381 a(the) p
-1774 381 a(\014nal) 11 441 y(t) o(yp) q(e) p 120 441
-a(sc) o(heme,) p 301 441 a(then) p 412 441 a(the) p 496
-441 a(constrain) o(t) p 725 441 a(can) p 815 441 a(b) q(e) p
-881 441 a(discarded) p 1098 441 a(safely) l(.) 84 501
-y(On) p 165 501 a(the) p 249 501 a(other) p 376 501 a(hand,) p
-512 501 a(there) p 637 501 a(are) p 718 501 a(t) o(w) o(o) p
-810 501 a(dra) o(wbac) o(ks.) p Fj 83 616 a(\017) p Fk
-133 616 a(Some) p 259 616 a(errors) p 393 616 a(will) p
-482 616 a(b) q(e) p 544 616 a(dela) o(y) o(ed) p 715
-616 a(longer) p 858 616 a(than) p 968 616 a(no) o(w,) p
-1080 616 a(un) o(til) p 1191 616 a(a) p 1228 616 a(construtor) p
-1460 616 a(is) p 1505 616 a(actually) p 1687 616 a(included) 133
-676 y(in) p Fg 189 676 a(L) p Fk(.) p 258 676 a(It) p
-311 676 a(is) p 360 676 a(not) p 446 676 a(clear) p 563
-676 a(ho) o(w) p 665 676 a(damageable) p 930 676 a(it) p
-979 676 a(is.) p Fj 83 777 a(\017) p Fk 133 777 a(While) p
-272 777 a(t) o(yp) q(e) p 378 777 a(inference) p 579
-777 a(is) p 625 777 a(simple) p 774 777 a(and) p 865
-777 a(costless) p 1036 777 a(for) p 1108 777 a(this) p
-1200 777 a(extension,) p 1426 777 a(simpli\014cation) p
-1724 777 a(of) p 1776 777 a(con-) 133 838 y(strain) o(ts) p
-310 838 a(|marking) p 551 838 a(constructors) p 830 838
-a(with) p 943 838 a(unsolv) m(able) p 1182 838 a(constrain) o(ts) p
-1432 838 a(as) p 1494 838 a(absen) o(t,) p 1663 838 a(and) p
-1760 838 a(elim-) 133 898 y(inating) p 300 898 a(redundan) o(t) p
-536 898 a(t) o(yp) q(es) p 667 898 a(in) p 726 898 a(constrain) o(ts|) p
-1025 898 a(is) p 1076 898 a(a) p 1119 898 a(bit) p 1197
-898 a(more) p 1320 898 a(exp) q(ensiv) o(e.) p 1565 898
-a(Also,) p 1691 898 a(allo) o(wing) 133 958 y(suc) o(h) p
-244 958 a(constrained) p 506 958 a(t) o(yp) q(es) p 637
-958 a(inside) p 777 958 a(signatures) p 1010 958 a(w) o(ould) p
-1154 958 a(mean) p 1286 958 a(ha) o(ving) p 1444 958
-a(to) p 1506 958 a(solv) o(e) p 1627 958 a(a) p 1669
-958 a(matc) o(hing) 133 1018 y(problem,) p 333 1018 a(whic) o(h) p
-469 1018 a(is) p 514 1018 a(exp) q(onen) o(tial) p 772
-1018 a(in) p 825 1018 a(the) p 906 1018 a(n) o(um) o(b) q(er) p
-1080 1018 a(of) p 1132 1018 a(connected) p 1356 1018
-a(constrain) o(ts) p 1600 1018 a(inside) p 1735 1018
-a(a) p 1772 1018 a(t) o(yp) q(e) 133 1078 y(sc) o(heme.) 84
-1193 y(Reasonably) p 340 1193 a(e\016cien) o(t) p 516
-1193 a(algorithms) p 754 1193 a(exist) p 866 1193 a(to) p
-922 1193 a(solv) o(e) p 1038 1193 a(these) p 1159 1193
-a(problems,) p 1379 1193 a(so) p 1435 1193 a(the) p 1515
-1193 a(di\016cult) o(y) p 1715 1193 a(is) p 1760 1193
-a(more) 11 1253 y(in) p 67 1253 a(the) p 151 1253 a(increased) p
-363 1253 a(complexit) o(y) p 611 1253 a(of) p 667 1253
-a(the) p 751 1253 a(t) o(yp) q(e-c) o(hec) o(k) o(er) p
-1031 1253 a(than) p 1145 1253 a(in) p 1202 1253 a(run-time) p
-1402 1253 a(cost.) p Fl 11 1397 a(Other) p 205 1397 a(features) p
-Fk 11 1490 a(Ob) s(jectiv) o(e) p 238 1490 a(Lab) q(el) p
-380 1490 a(con) o(tains) p 579 1490 a(t) o(w) o(o) p
-678 1490 a(other) p 812 1490 a(features:) p 1029 1490
-a(p) q(olymorphic) p 1318 1490 a(metho) q(ds) p 1521
-1490 a(and) p 1623 1490 a(t) o(yp) q(e-driv) o(en) 11
-1550 y(access) p 153 1550 a(of) p 208 1550 a(records.) p
-394 1550 a(Both) p 514 1550 a(of) p 568 1550 a(them) p
-692 1550 a(use) p 775 1550 a(the) p 857 1550 a(same) p
-978 1550 a(metho) q(d) p 1154 1550 a(of) p 1209 1550
-a(enforcing) p 1417 1550 a(principalit) o(y) p 1676 1550
-a(of) p 1730 1550 a(t) o(yping) 11 1610 y(through) p
-191 1610 a(tracing) p 351 1610 a(user) p 450 1610 a(pro) o(vided) p
-647 1610 a(t) o(yp) q(e) p 752 1610 a(information.) p
-1034 1610 a(With) p 1155 1610 a(this) p 1246 1610 a(tracing,) p
-1422 1610 a(their) p 1534 1610 a(implem) o(en) n(tation) 11
-1670 y(is) p 60 1670 a(v) o(ery) p 167 1670 a(easy) l(,) p
-283 1670 a(but) p 373 1670 a(without) p 554 1670 a(it) p
-603 1670 a(they) p 713 1670 a(lo) q(ose) p 834 1670 a(principalit) o(y)
-l(.) 84 1730 y(While) p 229 1730 a(these) p 357 1730
-a(features) p 543 1730 a(pro) o(vide) p 720 1730 a(some) p
-845 1730 a(comfort) p 1029 1730 a(in) p 1089 1730 a(writing) p
-1260 1730 a(user) p 1366 1730 a(programs,) p 1598 1730
-a(they) p 1711 1730 a(are) p 1795 1730 a(not) 11 1791
-y(strictly) p 182 1791 a(necessary) p 403 1791 a(for) p
-482 1791 a(the) p 571 1791 a(v) m(arious) p 742 1791
-a(libraries) p 934 1791 a(coming) p 1107 1791 a(with) p
-1223 1791 a(O'Labl) p 1391 1791 a(\(LablTk,) p 1602 1791
-a(LablGL) p 1787 1791 a(and) 11 1851 y(LablGTK\).) 926
-2937 y(4) p eop
-PStoPSsaved restore
-%%Trailer
-end
-userdict /end-hook known{end-hook}if
-%%EOF
diff -Nru ocaml-3.12.1/testlabl/objvariant.diffs ocaml-4.01.0/testlabl/objvariant.diffs
--- ocaml-3.12.1/testlabl/objvariant.diffs	2006-01-16 02:25:50.000000000 +0000
+++ ocaml-4.01.0/testlabl/objvariant.diffs	1970-01-01 00:00:00.000000000 +0000
@@ -1,354 +0,0 @@
-? objvariants-3.09.1.diffs
-? objvariants.diffs
-Index: btype.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/btype.ml,v
-retrieving revision 1.37.4.1
-diff -u -r1.37.4.1 btype.ml
---- btype.ml	5 Dec 2005 13:18:42 -0000	1.37.4.1
-+++ btype.ml	16 Jan 2006 02:23:14 -0000
-@@ -177,7 +177,8 @@
-     Tvariant row -> iter_row f row
-   | Tvar | Tunivar | Tsubst _ | Tconstr _ ->
-       Misc.may (fun (_,l) -> List.iter f l) row.row_name;
--      List.iter f row.row_bound
-+      List.iter f row.row_bound;
-+      List.iter (fun (s,k,t) -> f t) row.row_object
-   | _ -> assert false
- 
- let iter_type_expr f ty =
-@@ -224,7 +225,9 @@
-     | Some (path, tl) -> Some (path, List.map f tl) in
-   { row_fields = fields; row_more = more;
-     row_bound = !bound; row_fixed = row.row_fixed && fixed;
--    row_closed = row.row_closed; row_name = name; }
-+    row_closed = row.row_closed; row_name = name;
-+    row_object = List.map (fun (s,k,t) -> (s,k,f t)) row.row_object;
-+  }
- 
- let rec copy_kind = function
-     Fvar{contents = Some k} -> copy_kind k
-Index: ctype.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/ctype.ml,v
-retrieving revision 1.197.2.6
-diff -u -r1.197.2.6 ctype.ml
---- ctype.ml	15 Dec 2005 02:28:38 -0000	1.197.2.6
-+++ ctype.ml	16 Jan 2006 02:23:15 -0000
-@@ -1421,7 +1421,7 @@
-   newgenty
-     (Tvariant
-        {row_fields = fields; row_closed = closed; row_more = newvar();
--        row_bound = []; row_fixed = false; row_name = None })
-+        row_bound = []; row_fixed = false; row_name = None; row_object=[]})
- 
- (**** Unification ****)
- 
-@@ -1724,8 +1724,11 @@
-     else None
-   in
-   let bound = row1.row_bound @ row2.row_bound in
-+  let opairs, _, miss2 = associate_fields row1.row_object row2.row_object in
-+  let row_object = row1.row_object @ miss2 in
-   let row0 = {row_fields = []; row_more = more; row_bound = bound;
--              row_closed = closed; row_fixed = fixed; row_name = name} in
-+              row_closed = closed; row_fixed = fixed; row_name = name;
-+              row_object = row_object } in
-   let set_more row rest =
-     let rest =
-       if closed then
-@@ -1758,6 +1761,18 @@
-           raise (Unify ((mkvariant [l,f1] true,
-                          mkvariant [l,f2] true) :: trace)))
-       pairs;
-+    List.iter (fun (s,_,ty1,_,ty2) -> unify env ty1 ty2) opairs;
-+    if row_object <> [] then begin
-+      List.iter
-+        (fun (l,f) ->
-+          match row_field_repr f with
-+            Rpresent (Some ty) ->
-+              let fi = build_fields generic_level row_object (newgenvar()) in
-+              unify env (newgenty (Tobject (fi, ref None))) ty
-+          | Rpresent None -> raise (Unify [])
-+          | _ -> ())
-+        (row_repr row1).row_fields
-+    end;
-   with exn ->
-     log_type rm1; rm1.desc <- md1; log_type rm2; rm2.desc <- md2; raise exn
-   end
-@@ -2789,7 +2804,8 @@
-       let row =
-         { row_fields = List.map fst fields; row_more = newvar();
-           row_bound = !bound; row_closed = posi; row_fixed = false;
--          row_name = if c > Unchanged then None else row.row_name }
-+          row_name = if c > Unchanged then None else row.row_name;
-+          row_object = [] }
-       in
-       (newty (Tvariant row), Changed)
-   | Tobject (t1, _) ->
-Index: oprint.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/oprint.ml,v
-retrieving revision 1.22
-diff -u -r1.22 oprint.ml
---- oprint.ml	23 Mar 2005 03:08:37 -0000	1.22
-+++ oprint.ml	16 Jan 2006 02:23:15 -0000
-@@ -185,7 +185,7 @@
-       fprintf ppf "@[<2>< %a >@]" (print_fields rest) fields
-   | Otyp_stuff s -> fprintf ppf "%s" s
-   | Otyp_var (ng, s) -> fprintf ppf "'%s%s" (if ng then "_" else "") s
--  | Otyp_variant (non_gen, row_fields, closed, tags) ->
-+  | Otyp_variant (non_gen, row_fields, closed, tags, obj) ->
-       let print_present ppf =
-         function
-           None | Some [] -> ()
-@@ -198,12 +198,17 @@
-               ppf fields
-         | Ovar_name (id, tyl) ->
-             fprintf ppf "@[%a%a@]" print_typargs tyl print_ident id
-+      and print_object ppf obj =
-+        if obj <> [] then
-+          fprintf ppf "@ as @[<2>< %a >@]" (print_fields (Some false)) obj
-       in
--      fprintf ppf "%s[%s@[@[%a@]%a ]@]" (if non_gen then "_" else "")
-+      fprintf ppf "%s[%s@[@[%a@]%a%a ]@]"
-+        (if non_gen then "_" else "")
-         (if closed then if tags = None then " " else "< "
-          else if tags = None then "> " else "? ")
-         print_fields row_fields
-         print_present tags
-+        print_object obj
-   | Otyp_alias _ | Otyp_poly _ | Otyp_arrow _ | Otyp_tuple _ as ty ->
-       fprintf ppf "@[<1>(%a)@]" print_out_type ty
-   | Otyp_abstract | Otyp_sum _ | Otyp_record _ | Otyp_manifest (_, _) -> ()
-Index: outcometree.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/outcometree.mli,v
-retrieving revision 1.14
-diff -u -r1.14 outcometree.mli
---- outcometree.mli	23 Mar 2005 03:08:37 -0000	1.14
-+++ outcometree.mli	16 Jan 2006 02:23:15 -0000
-@@ -59,6 +59,7 @@
-   | Otyp_var of bool * string
-   | Otyp_variant of
-       bool * out_variant * bool * (string list) option
-+      * (string * out_type) list
-   | Otyp_poly of string list * out_type
- and out_variant =
-   | Ovar_fields of (string * bool * out_type list) list
-Index: printtyp.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/printtyp.ml,v
-retrieving revision 1.139.2.2
-diff -u -r1.139.2.2 printtyp.ml
---- printtyp.ml	7 Dec 2005 23:37:27 -0000	1.139.2.2
-+++ printtyp.ml	16 Jan 2006 02:23:15 -0000
-@@ -244,7 +244,10 @@
-             visited_objects := px :: !visited_objects;
-           match row.row_name with
-           | Some(p, tyl) when namable_row row ->
--              List.iter (mark_loops_rec visited) tyl
-+              List.iter (mark_loops_rec visited) tyl;
-+              if not (static_row row) then
-+                List.iter (fun (s,k,t) -> mark_loops_rec visited t)
-+                  row.row_object
-           | _ ->
-               iter_row (mark_loops_rec visited) {row with row_bound = []}
-          end
-@@ -343,25 +346,27 @@
-                | _ -> false)
-             fields in
-         let all_present = List.length present = List.length fields in
-+        let static = row.row_closed && all_present in
-+        let obj =
-+          if static then [] else
-+          List.map (fun (s,k,t) -> (s, tree_of_typexp sch t)) row.row_object
-+        in
-+        let tags = if all_present then None else Some (List.map fst present) in
-         begin match row.row_name with
-         | Some(p, tyl) when namable_row row ->
-             let id = tree_of_path p in
-             let args = tree_of_typlist sch tyl in
--            if row.row_closed && all_present then
-+            if static then
-               Otyp_constr (id, args)
-             else
-               let non_gen = is_non_gen sch px in
--              let tags =
--                if all_present then None else Some (List.map fst present) in
-               Otyp_variant (non_gen, Ovar_name(tree_of_path p, args),
--                            row.row_closed, tags)
-+                            row.row_closed, tags, obj)
-         | _ ->
--            let non_gen =
--              not (row.row_closed && all_present) && is_non_gen sch px in
-+            let non_gen = not static && is_non_gen sch px in
-             let fields = List.map (tree_of_row_field sch) fields in
--            let tags =
--              if all_present then None else Some (List.map fst present) in
--            Otyp_variant (non_gen, Ovar_fields fields, row.row_closed, tags)
-+            Otyp_variant (non_gen, Ovar_fields fields, row.row_closed,
-+                          tags, obj)
-         end
-     | Tobject (fi, nm) ->
-         tree_of_typobject sch fi nm
-Index: typecore.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typecore.ml,v
-retrieving revision 1.176.2.2
-diff -u -r1.176.2.2 typecore.ml
---- typecore.ml	11 Dec 2005 09:56:33 -0000	1.176.2.2
-+++ typecore.ml	16 Jan 2006 02:23:15 -0000
-@@ -170,7 +170,8 @@
-       (* Force check of well-formedness *)
-       unify_pat pat.pat_env pat
-         (newty(Tvariant{row_fields=[]; row_more=newvar(); row_closed=false;
--                        row_bound=[]; row_fixed=false; row_name=None}));
-+                        row_bound=[]; row_fixed=false; row_name=None;
-+                        row_object=[]}));
-   | _ -> ()
- 
- let rec iter_pattern f p =
-@@ -251,7 +252,7 @@
-       let ty = may_map (build_as_type env) p' in
-       newty (Tvariant{row_fields=[l, Rpresent ty]; row_more=newvar();
-                       row_bound=[]; row_name=None;
--                      row_fixed=false; row_closed=false})
-+                      row_fixed=false; row_closed=false; row_object=[]})
-   | Tpat_record lpl ->
-       let lbl = fst(List.hd lpl) in
-       if lbl.lbl_private = Private then p.pat_type else
-@@ -318,7 +319,8 @@
-       ([],[]) fields in
-   let row =
-     { row_fields = List.rev fields; row_more = newvar(); row_bound = !bound;
--      row_closed = false; row_fixed = false; row_name = Some (path, tyl) }
-+      row_closed = false; row_fixed = false; row_name = Some (path, tyl);
-+      row_object = [] }
-   in
-   let ty = newty (Tvariant row) in
-   let gloc = {loc with Location.loc_ghost=true} in
-@@ -428,7 +430,8 @@
-                   row_closed = false;
-                   row_more = newvar ();
-                   row_fixed = false;
--                  row_name = None } in
-+                  row_name = None;
-+                  row_object = [] } in
-       rp {
-         pat_desc = Tpat_variant(l, arg, row);
-         pat_loc = sp.ppat_loc;
-@@ -976,7 +979,8 @@
-                                   row_bound = [];
-                                   row_closed = false;
-                                   row_fixed = false;
--                                  row_name = None});
-+                                  row_name = None;
-+                                  row_object = []});
-         exp_env = env }
-   | Pexp_record(lid_sexp_list, opt_sexp) ->
-       let ty = newvar() in
-@@ -1261,8 +1265,30 @@
-                   assert false
-               end
-           | _ ->
--              (Texp_send(obj, Tmeth_name met),
--               filter_method env met Public obj.exp_type)
-+              let obj, met_ty =
-+                match expand_head env obj.exp_type with
-+                  {desc = Tvariant _} ->
-+                    let exp_ty = newvar () in
-+                    let met_ty = filter_method env met Public exp_ty in
-+                    let row =
-+                      {row_fields=[]; row_more=newvar();
-+                       row_bound=[]; row_closed=false;
-+                       row_fixed=false; row_name=None;
-+                       row_object=[met, Fpresent, met_ty]} in
-+                    unify_exp env obj (newty (Tvariant row));
-+                    let prim = Primitive.parse_declaration 1 ["%field1"] in
-+                    let ty = newty(Tarrow("", obj.exp_type, exp_ty, Cok)) in
-+                    let vd = {val_type = ty; val_kind = Val_prim prim} in
-+                    let esnd =
-+                      {exp_desc=Texp_ident(Path.Pident(Ident.create"snd"), vd);
-+                       exp_loc = Location.none; exp_type = ty; exp_env = env}
-+                    in
-+                    ({obj with exp_type = exp_ty;
-+                      exp_desc = Texp_apply(esnd,[Some obj, Required])},
-+                     met_ty)
-+                | _ -> (obj, filter_method env met Public obj.exp_type)
-+              in
-+              (Texp_send(obj, Tmeth_name met), met_ty)
-         in
-         if !Clflags.principal then begin
-           end_def ();
-Index: types.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/types.ml,v
-retrieving revision 1.25
-diff -u -r1.25 types.ml
---- types.ml	9 Dec 2004 12:40:53 -0000	1.25
-+++ types.ml	16 Jan 2006 02:23:15 -0000
-@@ -44,7 +44,9 @@
-       row_bound: type_expr list;
-       row_closed: bool;
-       row_fixed: bool;
--      row_name: (Path.t * type_expr list) option }
-+      row_name: (Path.t * type_expr list) option;
-+      row_object: (string * field_kind * type_expr) list;
-+    }
- 
- and row_field =
-     Rpresent of type_expr option
-Index: types.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/types.mli,v
-retrieving revision 1.25
-diff -u -r1.25 types.mli
---- types.mli	9 Dec 2004 12:40:53 -0000	1.25
-+++ types.mli	16 Jan 2006 02:23:15 -0000
-@@ -43,7 +43,9 @@
-       row_bound: type_expr list;
-       row_closed: bool;
-       row_fixed: bool;
--      row_name: (Path.t * type_expr list) option }
-+      row_name: (Path.t * type_expr list) option;
-+      row_object: (string * field_kind * type_expr) list;
-+    }
- 
- and row_field =
-     Rpresent of type_expr option
-Index: typetexp.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typetexp.ml,v
-retrieving revision 1.54
-diff -u -r1.54 typetexp.ml
---- typetexp.ml	22 Jul 2005 06:42:36 -0000	1.54
-+++ typetexp.ml	16 Jan 2006 02:23:15 -0000
-@@ -215,7 +215,8 @@
-           in
-           let row = { row_closed = true; row_fields = fields;
-                       row_bound = !bound; row_name = Some (path, args);
--                      row_fixed = false; row_more = newvar () } in
-+                      row_fixed = false; row_more = newvar ();
-+                      row_object = [] } in
-           let static = Btype.static_row row in
-           let row =
-             if static then row else
-@@ -262,7 +263,7 @@
-       let mkfield l f =
-         newty (Tvariant {row_fields=[l,f]; row_more=newvar();
-                          row_bound=[]; row_closed=true;
--                         row_fixed=false; row_name=None}) in
-+                         row_fixed=false; row_name=None; row_object=[]}) in
-       let add_typed_field loc l f fields =
-         try
-           let f' = List.assoc l fields in
-@@ -345,7 +346,7 @@
-       let row =
-         { row_fields = List.rev fields; row_more = newvar ();
-           row_bound = !bound; row_closed = closed;
--          row_fixed = false; row_name = !name } in
-+          row_fixed = false; row_name = !name; row_object = [] } in
-       let static = Btype.static_row row in
-       let row =
-         if static then row else
diff -Nru ocaml-3.12.1/testlabl/objvariant.ml ocaml-4.01.0/testlabl/objvariant.ml
--- ocaml-3.12.1/testlabl/objvariant.ml	2004-03-30 14:05:53.000000000 +0000
+++ ocaml-4.01.0/testlabl/objvariant.ml	1970-01-01 00:00:00.000000000 +0000
@@ -1,42 +0,0 @@
-(* use with [cvs update -r objvariants typing] *)
-
-let f (x : [> ]) = x#m 3;;
-let o = object method m x = x+2 end;;
-f (`A o);;
-let l = [`A o; `B(object method m x = x -2 method y = 3 end)];;
-List.map f l;;
-let g = function `A x -> x#m 3 | `B x -> x#y;;
-List.map g l;;
-fun x -> ignore (x=f); List.map x l;;
-fun (x : [< `A of _ | `B of _] -> int) -> ignore (x=f); List.map x l;;
-
-
-class cvar name =
-  object
-    method name = name
-    method print ppf = Format.pp_print_string ppf name
-  end
-
-type var = [`Var of cvar]
-
-class cint n =
-  object
-    method n = n
-    method print ppf = Format.pp_print_int ppf n
-  end
-
-class ['a] cadd (e1 : 'a) (e2 : 'a) =
-  object
-    constraint 'a = [> ]
-    method e1 = e1
-    method e2 = e2
-    method print ppf = Format.fprintf ppf "(%t, %t)" e1#print e2#print
-  end
-
-type 'a expr = [var | `Int of cint | `Add of 'a cadd]
-
-type expr1 = expr1 expr
-
-let print = Format.printf "%t@."
-
-let e1 : expr1 = `Add (new cadd (`Var (new cvar "x")) (`Int (new cint 2)))
diff -Nru ocaml-3.12.1/testlabl/printers.ml ocaml-4.01.0/testlabl/printers.ml
--- ocaml-3.12.1/testlabl/printers.ml	2003-04-03 02:16:20.000000000 +0000
+++ ocaml-4.01.0/testlabl/printers.ml	1970-01-01 00:00:00.000000000 +0000
@@ -1,11 +0,0 @@
-(* $Id: printers.ml 5492 2003-04-03 02:16:20Z garrigue $ *)
-
-open Types
-
-let ignore_abbrevs ppf ab =
-  let s = match ab with
-    Mnil -> "Mnil"
-  | Mlink _ -> "Mlink _"
-  | Mcons _ -> "Mcons _"
-  in
-  Format.pp_print_string ppf s
diff -Nru ocaml-3.12.1/testlabl/sigsubst.ml ocaml-4.01.0/testlabl/sigsubst.ml
--- ocaml-3.12.1/testlabl/sigsubst.ml	2010-08-19 02:06:00.000000000 +0000
+++ ocaml-4.01.0/testlabl/sigsubst.ml	1970-01-01 00:00:00.000000000 +0000
@@ -1,38 +0,0 @@
-module type Printable = sig
-  type t
-  val print : Format.formatter -> t -> unit
-end
-module type Comparable = sig
-  type t
-  val compare : t -> t -> int
-end
-module type PrintableComparable = sig
-  include Printable
-  include Comparable with type t = t
-end
-module type PrintableComparable = sig
-  type t
-  include Printable with type t := t
-  include Comparable with type t := t
-end
-module type PrintableComparable = sig
-  include Printable
-  include Comparable with type t := t
-end
-module type ComparableInt = Comparable with type t := int
-
-module type S = sig type t val f : t -> t end
-module type S' = S with type t := int
-
-module type S = sig type 'a t val map : ('a -> 'b) -> 'a t -> 'b t end
-module type S1 = S with type 'a t := 'a list
-module type S2 = sig
-  type 'a dict = (string * 'a) list
-  include S with type 'a t := 'a dict
-end
-
-
-module type S =
-  sig module T : sig type exp type arg end val f : T.exp -> T.arg end
-module M = struct type exp = string type arg = int end
-module type S' = S with module T := M
diff -Nru ocaml-3.12.1/testlabl/tests.ml ocaml-4.01.0/testlabl/tests.ml
--- ocaml-3.12.1/testlabl/tests.ml	2000-01-07 16:47:25.000000000 +0000
+++ ocaml-4.01.0/testlabl/tests.ml	1970-01-01 00:00:00.000000000 +0000
@@ -1,22 +0,0 @@
-(* $Id: tests.ml 2745 2000-01-07 16:47:25Z doligez $ *)
-
-let f1 = function `a x -> x=1 | `b -> true
-let f2 = function `a x -> x | `b -> true
-let f3 = function `b -> true
-let f x = f1 x && f2 x
-
-let sub s ?:pos{=0} ?:len{=String.length s - pos} () =
-  String.sub s pos len
-
-let cCAMLtoTKpack_options w = function
-        `After v1 -> "-after"
-        | `Anchor v1 -> "-anchor"
-        | `Before v1 -> "-before"
-        | `Expand v1 -> "-expand"
-        | `Fill v1 -> "-fill"
-        | `In v1 -> "-in"
-        | `Ipadx v1 -> "-ipadx"
-        | `Ipady v1 -> "-ipady"
-        | `Padx v1 -> "-padx"
-        | `Pady v1 -> "-pady"
-        | `Side v1 -> "-side"
diff -Nru ocaml-3.12.1/testlabl/valvirt.diffs ocaml-4.01.0/testlabl/valvirt.diffs
--- ocaml-3.12.1/testlabl/valvirt.diffs	2010-05-21 12:00:49.000000000 +0000
+++ ocaml-4.01.0/testlabl/valvirt.diffs	1970-01-01 00:00:00.000000000 +0000
@@ -1,2349 +0,0 @@
-Index: utils/warnings.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/utils/warnings.ml,v
-retrieving revision 1.23
-diff -u -r1.23 warnings.ml
---- utils/warnings.ml	15 Sep 2005 03:09:26 -0000	1.23
-+++ utils/warnings.ml	5 Apr 2006 02:25:59 -0000
-@@ -26,7 +26,7 @@
-   | Statement_type                   (* S *)
-   | Unused_match                     (* U *)
-   | Unused_pat
--  | Hide_instance_variable of string (* V *)
-+  | Instance_variable_override of string (* V *)
-   | Illegal_backslash                (* X *)
-   | Implicit_public_methods of string list
-   | Unerasable_optional_argument
-@@ -54,7 +54,7 @@
-   | Statement_type ->           's'
-   | Unused_match
-   | Unused_pat ->               'u'
--  | Hide_instance_variable _ -> 'v'
-+  | Instance_variable_override _ -> 'v'
-   | Illegal_backslash
-   | Implicit_public_methods _
-   | Unerasable_optional_argument
-@@ -126,9 +126,9 @@
-       String.concat " "
-         ("the following methods are overridden \
-           by the inherited class:\n " :: slist)
--  | Hide_instance_variable lab ->
--      "this definition of an instance variable " ^ lab ^
--      " hides a previously\ndefined instance variable of the same name."
-+  | Instance_variable_override lab ->
-+      "the instance variable " ^ lab ^ " is overridden.\n" ^
-+      "The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)"
-   | Partial_application ->
-       "this function application is partial,\n\
-        maybe some arguments are missing."
-Index: utils/warnings.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/utils/warnings.mli,v
-retrieving revision 1.16
-diff -u -r1.16 warnings.mli
---- utils/warnings.mli	15 Sep 2005 03:09:26 -0000	1.16
-+++ utils/warnings.mli	5 Apr 2006 02:25:59 -0000
-@@ -26,7 +26,7 @@
-   | Statement_type                   (* S *)
-   | Unused_match                     (* U *)
-   | Unused_pat
--  | Hide_instance_variable of string (* V *)
-+  | Instance_variable_override of string (* V *)
-   | Illegal_backslash                (* X *)
-   | Implicit_public_methods of string list
-   | Unerasable_optional_argument
-Index: parsing/parser.mly
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/parsing/parser.mly,v
-retrieving revision 1.123
-diff -u -r1.123 parser.mly
---- parsing/parser.mly	23 Mar 2005 03:08:37 -0000	1.123
-+++ parsing/parser.mly	5 Apr 2006 02:25:59 -0000
-@@ -623,6 +623,8 @@
-       { [] }
-   | class_fields INHERIT class_expr parent_binder
-       { Pcf_inher ($3, $4) :: $1 }
-+  | class_fields VAL virtual_value
-+      { Pcf_valvirt $3 :: $1 }
-   | class_fields VAL value
-       { Pcf_val $3 :: $1 }
-   | class_fields virtual_method
-@@ -638,14 +640,20 @@
-     AS LIDENT
-           { Some $2 }
-   | /* empty */
--          {None}
-+          { None }
-+;
-+virtual_value:
-+    MUTABLE VIRTUAL label COLON core_type
-+      { $3, Mutable, $5, symbol_rloc () }
-+  | VIRTUAL mutable_flag label COLON core_type
-+      { $3, $2, $5, symbol_rloc () }
- ;
- value:
--        mutable_flag label EQUAL seq_expr
--          { $2, $1, $4, symbol_rloc () }
--      | mutable_flag label type_constraint EQUAL seq_expr
--          { $2, $1, (let (t, t') = $3 in ghexp(Pexp_constraint($5, t, t'))),
--            symbol_rloc () }
-+    mutable_flag label EQUAL seq_expr
-+      { $2, $1, $4, symbol_rloc () }
-+  | mutable_flag label type_constraint EQUAL seq_expr
-+      { $2, $1, (let (t, t') = $3 in ghexp(Pexp_constraint($5, t, t'))),
-+        symbol_rloc () }
- ;
- virtual_method:
-     METHOD PRIVATE VIRTUAL label COLON poly_type
-@@ -711,8 +719,12 @@
-   | class_sig_fields CONSTRAINT constrain       { Pctf_cstr  $3 :: $1 }
- ;
- value_type:
--    mutable_flag label COLON core_type
--      { $2, $1, Some $4, symbol_rloc () }
-+    VIRTUAL mutable_flag label COLON core_type
-+      { $3, $2, Virtual, $5, symbol_rloc () }
-+  | MUTABLE virtual_flag label COLON core_type
-+      { $3, Mutable, $2, $5, symbol_rloc () }
-+  | label COLON core_type
-+      { $1, Immutable, Concrete, $3, symbol_rloc () }
- ;
- method_type:
-     METHOD private_flag label COLON poly_type
-Index: parsing/parsetree.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/parsing/parsetree.mli,v
-retrieving revision 1.42
-diff -u -r1.42 parsetree.mli
---- parsing/parsetree.mli	23 Mar 2005 03:08:37 -0000	1.42
-+++ parsing/parsetree.mli	5 Apr 2006 02:25:59 -0000
-@@ -152,7 +152,7 @@
- 
- and class_type_field =
-     Pctf_inher of class_type
--  | Pctf_val   of (string * mutable_flag * core_type option * Location.t)
-+  | Pctf_val of (string * mutable_flag * virtual_flag * core_type * Location.t)
-   | Pctf_virt  of (string * private_flag * core_type * Location.t)
-   | Pctf_meth  of (string * private_flag * core_type * Location.t)
-   | Pctf_cstr  of (core_type * core_type * Location.t)
-@@ -179,6 +179,7 @@
- 
- and class_field =
-     Pcf_inher of class_expr * string option
-+  | Pcf_valvirt of (string * mutable_flag * core_type * Location.t)
-   | Pcf_val   of (string * mutable_flag * expression * Location.t)
-   | Pcf_virt  of (string * private_flag * core_type * Location.t)
-   | Pcf_meth  of (string * private_flag * expression * Location.t)
-Index: parsing/printast.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/parsing/printast.ml,v
-retrieving revision 1.29
-diff -u -r1.29 printast.ml
---- parsing/printast.ml	4 Jan 2006 16:55:50 -0000	1.29
-+++ parsing/printast.ml	5 Apr 2006 02:25:59 -0000
-@@ -353,10 +353,11 @@
-   | Pctf_inher (ct) ->
-       line i ppf "Pctf_inher\n";
-       class_type i ppf ct;
--  | Pctf_val (s, mf, cto, loc) ->
-+  | Pctf_val (s, mf, vf, ct, loc) ->
-       line i ppf
--        "Pctf_val \"%s\" %a %a\n" s fmt_mutable_flag mf fmt_location loc;
--      option i core_type ppf cto;
-+        "Pctf_val \"%s\" %a %a %a\n" s
-+        fmt_mutable_flag mf fmt_virtual_flag vf fmt_location loc;
-+      core_type (i+1) ppf ct;
-   | Pctf_virt (s, pf, ct, loc) ->
-       line i ppf
-         "Pctf_virt \"%s\" %a %a\n" s fmt_private_flag pf fmt_location loc;
-@@ -428,6 +429,10 @@
-       line i ppf "Pcf_inher\n";
-       class_expr (i+1) ppf ce;
-       option (i+1) string ppf so;
-+  | Pcf_valvirt (s, mf, ct, loc) ->
-+      line i ppf
-+        "Pcf_valvirt \"%s\" %a %a\n" s fmt_mutable_flag mf fmt_location loc;
-+      core_type (i+1) ppf ct;
-   | Pcf_val (s, mf, e, loc) ->
-       line i ppf
-         "Pcf_val \"%s\" %a %a\n" s fmt_mutable_flag mf fmt_location loc;
-Index: typing/btype.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/btype.ml,v
-retrieving revision 1.38
-diff -u -r1.38 btype.ml
---- typing/btype.ml	4 Jan 2006 16:55:50 -0000	1.38
-+++ typing/btype.ml	5 Apr 2006 02:25:59 -0000
-@@ -330,7 +330,7 @@
- 
- let unmark_class_signature sign =
-   unmark_type sign.cty_self;
--  Vars.iter (fun l (m, t) -> unmark_type t) sign.cty_vars
-+  Vars.iter (fun l (m, v, t) -> unmark_type t) sign.cty_vars
- 
- let rec unmark_class_type =
-   function
-Index: typing/ctype.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/ctype.ml,v
-retrieving revision 1.200
-diff -u -r1.200 ctype.ml
---- typing/ctype.ml	6 Jan 2006 02:16:24 -0000	1.200
-+++ typing/ctype.ml	5 Apr 2006 02:25:59 -0000
-@@ -857,7 +857,7 @@
-         Tcty_signature
-           {cty_self = copy sign.cty_self;
-            cty_vars =
--             Vars.map (function (mut, ty) -> (mut, copy ty)) sign.cty_vars;
-+             Vars.map (function (m, v, ty) -> (m, v, copy ty)) sign.cty_vars;
-            cty_concr = sign.cty_concr;
-            cty_inher =
-              List.map (fun (p,tl) -> (p, List.map copy tl)) sign.cty_inher}
-@@ -2354,10 +2354,11 @@
-   | CM_Val_type_mismatch of string * (type_expr * type_expr) list
-   | CM_Meth_type_mismatch of string * (type_expr * type_expr) list
-   | CM_Non_mutable_value of string
-+  | CM_Non_concrete_value of string
-   | CM_Missing_value of string
-   | CM_Missing_method of string
-   | CM_Hide_public of string
--  | CM_Hide_virtual of string
-+  | CM_Hide_virtual of string * string
-   | CM_Public_method of string
-   | CM_Private_method of string
-   | CM_Virtual_method of string
-@@ -2390,8 +2391,8 @@
-            end)
-         pairs;
-       Vars.iter
--        (fun lab (mut, ty) ->
--           let (mut', ty') = Vars.find lab sign1.cty_vars in
-+        (fun lab (mut, v, ty) ->
-+           let (mut', v', ty') = Vars.find lab sign1.cty_vars in
-            try moregen true type_pairs env ty' ty with Unify trace ->
-              raise (Failure [CM_Val_type_mismatch
-                                 (lab, expand_trace env trace)]))
-@@ -2437,7 +2438,7 @@
-              end
-            in
-            if Concr.mem lab sign1.cty_concr then err
--           else CM_Hide_virtual lab::err)
-+           else CM_Hide_virtual ("method", lab) :: err)
-         miss1 []
-     in
-     let missing_method = List.map (fun (m, _, _) -> m) miss2 in
-@@ -2455,11 +2456,13 @@
-     in
-     let error =
-       Vars.fold
--        (fun lab (mut, ty) err ->
-+        (fun lab (mut, vr, ty) err ->
-           try
--            let (mut', ty') = Vars.find lab sign1.cty_vars in
-+            let (mut', vr', ty') = Vars.find lab sign1.cty_vars in
-             if mut = Mutable && mut' <> Mutable then
-               CM_Non_mutable_value lab::err
-+            else if vr = Concrete && vr' <> Concrete then
-+              CM_Non_concrete_value lab::err
-             else
-               err
-           with Not_found ->
-@@ -2467,6 +2470,14 @@
-         sign2.cty_vars error
-     in
-     let error =
-+      Vars.fold
-+        (fun lab (_,vr,_) err ->
-+          if vr = Virtual && not (Vars.mem lab sign2.cty_vars) then
-+            CM_Hide_virtual ("instance variable", lab) :: err
-+          else err)
-+        sign1.cty_vars error
-+    in
-+    let error =
-       List.fold_right
-         (fun e l ->
-            if List.mem e missing_method then l else CM_Virtual_method e::l)
-@@ -2516,8 +2527,8 @@
-              end)
-           pairs;
-         Vars.iter
--          (fun lab (mut, ty) ->
--             let (mut', ty') = Vars.find lab sign1.cty_vars in
-+          (fun lab (_, _, ty) ->
-+             let (_, _, ty') = Vars.find lab sign1.cty_vars in
-              try eqtype true type_pairs subst env ty ty' with Unify trace ->
-                raise (Failure [CM_Val_type_mismatch
-                                   (lab, expand_trace env trace)]))
-@@ -2554,7 +2565,7 @@
-           end
-         in
-         if Concr.mem lab sign1.cty_concr then err
--        else CM_Hide_virtual lab::err)
-+        else CM_Hide_virtual ("method", lab) :: err)
-       miss1 []
-   in
-   let missing_method = List.map (fun (m, _, _) -> m) miss2 in
-@@ -2578,11 +2589,13 @@
-   in
-   let error =
-     Vars.fold
--      (fun lab (mut, ty) err ->
-+      (fun lab (mut, vr, ty) err ->
-          try
--           let (mut', ty') = Vars.find lab sign1.cty_vars in
-+           let (mut', vr', ty') = Vars.find lab sign1.cty_vars in
-            if mut = Mutable && mut' <> Mutable then
-              CM_Non_mutable_value lab::err
-+           else if vr = Concrete && vr' <> Concrete then
-+             CM_Non_concrete_value lab::err
-            else
-              err
-          with Not_found ->
-@@ -2590,6 +2603,14 @@
-       sign2.cty_vars error
-   in
-   let error =
-+    Vars.fold
-+      (fun lab (_,vr,_) err ->
-+        if vr = Virtual && not (Vars.mem lab sign2.cty_vars) then
-+          CM_Hide_virtual ("instance variable", lab) :: err
-+        else err)
-+      sign1.cty_vars error
-+  in
-+  let error =
-     List.fold_right
-       (fun e l ->
-         if List.mem e missing_method then l else CM_Virtual_method e::l)
-@@ -3279,7 +3300,7 @@
- let nondep_class_signature env id sign =
-   { cty_self = nondep_type_rec env id sign.cty_self;
-     cty_vars =
--      Vars.map (function (m, t) -> (m, nondep_type_rec env id t))
-+      Vars.map (function (m, v, t) -> (m, v, nondep_type_rec env id t))
-         sign.cty_vars;
-     cty_concr = sign.cty_concr;
-     cty_inher =
-Index: typing/ctype.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/ctype.mli,v
-retrieving revision 1.53
-diff -u -r1.53 ctype.mli
---- typing/ctype.mli	9 Dec 2004 12:40:53 -0000	1.53
-+++ typing/ctype.mli	5 Apr 2006 02:25:59 -0000
-@@ -170,10 +170,11 @@
-   | CM_Val_type_mismatch of string * (type_expr * type_expr) list
-   | CM_Meth_type_mismatch of string * (type_expr * type_expr) list
-   | CM_Non_mutable_value of string
-+  | CM_Non_concrete_value of string
-   | CM_Missing_value of string
-   | CM_Missing_method of string
-   | CM_Hide_public of string
--  | CM_Hide_virtual of string
-+  | CM_Hide_virtual of string * string
-   | CM_Public_method of string
-   | CM_Private_method of string
-   | CM_Virtual_method of string
-Index: typing/includeclass.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/includeclass.ml,v
-retrieving revision 1.7
-diff -u -r1.7 includeclass.ml
---- typing/includeclass.ml	6 Mar 2000 22:11:57 -0000	1.7
-+++ typing/includeclass.ml	5 Apr 2006 02:25:59 -0000
-@@ -78,14 +78,17 @@
-   | CM_Non_mutable_value lab ->
-       fprintf ppf
-        "@[The non-mutable instance variable %s cannot become mutable@]" lab
-+  | CM_Non_concrete_value lab ->
-+      fprintf ppf
-+       "@[The virtual instance variable %s cannot become concrete@]" lab
-   | CM_Missing_value lab ->
-       fprintf ppf "@[The first class type has no instance variable %s@]" lab
-   | CM_Missing_method lab ->
-       fprintf ppf "@[The first class type has no method %s@]" lab
-   | CM_Hide_public lab ->
-      fprintf ppf "@[The public method %s cannot be hidden@]" lab
--  | CM_Hide_virtual lab ->
--      fprintf ppf "@[The virtual method %s cannot be hidden@]" lab
-+  | CM_Hide_virtual (k, lab) ->
-+      fprintf ppf "@[The virtual %s %s cannot be hidden@]" k lab
-   | CM_Public_method lab ->
-       fprintf ppf "@[The public method %s cannot become private" lab
-   | CM_Virtual_method lab ->
-Index: typing/oprint.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/oprint.ml,v
-retrieving revision 1.22
-diff -u -r1.22 oprint.ml
---- typing/oprint.ml	23 Mar 2005 03:08:37 -0000	1.22
-+++ typing/oprint.ml	5 Apr 2006 02:25:59 -0000
-@@ -291,8 +291,10 @@
-       fprintf ppf "@[<2>method %s%s%s :@ %a@]"
-         (if priv then "private " else "") (if virt then "virtual " else "")
-         name !out_type ty
--  | Ocsg_value (name, mut, ty) ->
--      fprintf ppf "@[<2>val %s%s :@ %a@]" (if mut then "mutable " else "")
-+  | Ocsg_value (name, mut, vr, ty) ->
-+      fprintf ppf "@[<2>val %s%s%s :@ %a@]"
-+        (if mut then "mutable " else "")
-+        (if vr then "virtual " else "")
-         name !out_type ty
- 
- let out_class_type = ref print_out_class_type
-Index: typing/outcometree.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/outcometree.mli,v
-retrieving revision 1.14
-diff -u -r1.14 outcometree.mli
---- typing/outcometree.mli	23 Mar 2005 03:08:37 -0000	1.14
-+++ typing/outcometree.mli	5 Apr 2006 02:25:59 -0000
-@@ -71,7 +71,7 @@
- and out_class_sig_item =
-   | Ocsg_constraint of out_type * out_type
-   | Ocsg_method of string * bool * bool * out_type
--  | Ocsg_value of string * bool * out_type
-+  | Ocsg_value of string * bool * bool * out_type
- 
- type out_module_type =
-   | Omty_abstract
-Index: typing/printtyp.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/printtyp.ml,v
-retrieving revision 1.140
-diff -u -r1.140 printtyp.ml
---- typing/printtyp.ml	4 Jan 2006 16:55:50 -0000	1.140
-+++ typing/printtyp.ml	5 Apr 2006 02:26:00 -0000
-@@ -650,7 +650,7 @@
-         Ctype.flatten_fields (Ctype.object_fields sign.cty_self)
-       in
-       List.iter (fun met -> mark_loops (method_type met)) fields;
--      Vars.iter (fun _ (_, ty) -> mark_loops ty) sign.cty_vars
-+      Vars.iter (fun _ (_, _, ty) -> mark_loops ty) sign.cty_vars
-   | Tcty_fun (_, ty, cty) ->
-       mark_loops ty;
-       prepare_class_type params cty
-@@ -682,13 +682,15 @@
-           csil (tree_of_constraints params)
-       in
-       let all_vars =
--        Vars.fold (fun l (m, t) all -> (l, m, t) :: all) sign.cty_vars [] in
-+        Vars.fold (fun l (m, v, t) all -> (l, m, v, t) :: all) sign.cty_vars []
-+      in
-       (* Consequence of PR#3607: order of Map.fold has changed! *)
-       let all_vars = List.rev all_vars in
-       let csil =
-         List.fold_left
--          (fun csil (l, m, t) ->
--             Ocsg_value (l, m = Mutable, tree_of_typexp sch t) :: csil)
-+          (fun csil (l, m, v, t) ->
-+            Ocsg_value (l, m = Mutable, v = Virtual, tree_of_typexp sch t)
-+            :: csil)
-           csil all_vars
-       in
-       let csil =
-@@ -763,7 +765,9 @@
-     List.exists
-       (fun (lab, _, ty) ->
-          not (lab = dummy_method || Concr.mem lab sign.cty_concr))
--      fields in
-+      fields
-+    || Vars.fold (fun _ (_,vr,_) b -> vr = Virtual || b) sign.cty_vars false
-+  in
- 
-   Osig_class_type
-     (virt, Ident.name id,
-Index: typing/subst.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/subst.ml,v
-retrieving revision 1.49
-diff -u -r1.49 subst.ml
---- typing/subst.ml	4 Jan 2006 16:55:50 -0000	1.49
-+++ typing/subst.ml	5 Apr 2006 02:26:00 -0000
-@@ -178,7 +178,8 @@
- 
- let class_signature s sign =
-   { cty_self = typexp s sign.cty_self;
--    cty_vars = Vars.map (function (m, t) -> (m, typexp s t)) sign.cty_vars;
-+    cty_vars =
-+      Vars.map (function (m, v, t) -> (m, v, typexp s t)) sign.cty_vars;
-     cty_concr = sign.cty_concr;
-     cty_inher =
-       List.map (fun (p, tl) -> (type_path s p, List.map (typexp s) tl))
-Index: typing/typeclass.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typeclass.ml,v
-retrieving revision 1.85
-diff -u -r1.85 typeclass.ml
---- typing/typeclass.ml	22 Jul 2005 06:42:36 -0000	1.85
-+++ typing/typeclass.ml	5 Apr 2006 02:26:00 -0000
-@@ -24,7 +24,7 @@
- 
- type error =
-     Unconsistent_constraint of (type_expr * type_expr) list
--  | Method_type_mismatch of string * (type_expr * type_expr) list
-+  | Field_type_mismatch of string * string * (type_expr * type_expr) list
-   | Structure_expected of class_type
-   | Cannot_apply of class_type
-   | Apply_wrong_label of label
-@@ -36,7 +36,7 @@
-   | Unbound_class_type_2 of Longident.t
-   | Abbrev_type_clash of type_expr * type_expr * type_expr
-   | Constructor_type_mismatch of string * (type_expr * type_expr) list
--  | Virtual_class of bool * string list
-+  | Virtual_class of bool * string list * string list
-   | Parameter_arity_mismatch of Longident.t * int * int
-   | Parameter_mismatch of (type_expr * type_expr) list
-   | Bad_parameters of Ident.t * type_expr * type_expr
-@@ -49,6 +49,7 @@
-   | Non_collapsable_conjunction of
-       Ident.t * Types.class_declaration * (type_expr * type_expr) list
-   | Final_self_clash of (type_expr * type_expr) list
-+  | Mutability_mismatch of string * mutable_flag
- 
- exception Error of Location.t * error
- 
-@@ -90,7 +91,7 @@
-       generalize_class_type cty
-   | Tcty_signature {cty_self = sty; cty_vars = vars; cty_inher = inher} ->
-       Ctype.generalize sty;
--      Vars.iter (fun _ (_, ty) -> Ctype.generalize ty) vars;
-+      Vars.iter (fun _ (_, _, ty) -> Ctype.generalize ty) vars;
-       List.iter (fun (_,tl) -> List.iter Ctype.generalize tl) inher
-   | Tcty_fun (_, ty, cty) ->
-       Ctype.generalize ty;
-@@ -152,7 +153,7 @@
-   | Tcty_signature sign ->
-       Ctype.closed_schema sign.cty_self
-         &&
--      Vars.fold (fun _ (_, ty) cc -> Ctype.closed_schema ty && cc)
-+      Vars.fold (fun _ (_, _, ty) cc -> Ctype.closed_schema ty && cc)
-         sign.cty_vars
-         true
-   | Tcty_fun (_, ty, cty) ->
-@@ -172,7 +173,7 @@
-       limited_generalize rv cty
-   | Tcty_signature sign ->
-       Ctype.limited_generalize rv sign.cty_self;
--      Vars.iter (fun _ (_, ty) -> Ctype.limited_generalize rv ty)
-+      Vars.iter (fun _ (_, _, ty) -> Ctype.limited_generalize rv ty)
-         sign.cty_vars;
-       List.iter (fun (_, tl) -> List.iter (Ctype.limited_generalize rv) tl)
-         sign.cty_inher
-@@ -201,11 +202,25 @@
-    Env.add_value id {val_type = ty; val_kind = Val_unbound} par_env)
- 
- (* Enter an instance variable in the environment *)
--let enter_val cl_num vars lab mut ty val_env met_env par_env =
--  let (id, val_env, met_env, par_env) as result =
--    enter_met_env lab (Val_ivar (mut, cl_num)) ty val_env met_env par_env
-+let enter_val cl_num vars inh lab mut virt ty val_env met_env par_env loc =
-+  let (id, virt) =
-+    try
-+      let (id, mut', virt', ty') = Vars.find lab !vars in
-+      if mut' <> mut then raise (Error(loc, Mutability_mismatch(lab, mut)));
-+      Ctype.unify val_env (Ctype.instance ty) (Ctype.instance ty');
-+      (if not inh then Some id else None),
-+      (if virt' = Concrete then virt' else virt)
-+    with
-+      Ctype.Unify tr ->
-+        raise (Error(loc, Field_type_mismatch("instance variable", lab, tr)))
-+    | Not_found -> None, virt
-+  in
-+  let (id, _, _, _) as result =
-+    match id with Some id -> (id, val_env, met_env, par_env)
-+    | None ->
-+        enter_met_env lab (Val_ivar (mut, cl_num)) ty val_env met_env par_env
-   in
--  vars := Vars.add lab (id, mut, ty) !vars;
-+  vars := Vars.add lab (id, mut, virt, ty) !vars;
-   result
- 
- let inheritance self_type env concr_meths warn_meths loc parent =
-@@ -218,7 +233,7 @@
-       with Ctype.Unify trace ->
-         match trace with
-           _::_::_::({desc = Tfield(n, _, _, _)}, _)::rem ->
--            raise(Error(loc, Method_type_mismatch (n, rem)))
-+            raise(Error(loc, Field_type_mismatch ("method", n, rem)))
-         | _ ->
-             assert false
-       end;
-@@ -243,7 +258,7 @@
-   in
-   let ty = transl_simple_type val_env false sty in
-   try Ctype.unify val_env ty ty' with Ctype.Unify trace ->
--    raise(Error(loc, Method_type_mismatch (lab, trace)))
-+    raise(Error(loc, Field_type_mismatch ("method", lab, trace)))
- 
- let delayed_meth_specs = ref []
- 
-@@ -253,7 +268,7 @@
-   in
-   let unif ty =
-     try Ctype.unify val_env ty ty' with Ctype.Unify trace ->
--      raise(Error(loc, Method_type_mismatch (lab, trace)))
-+      raise(Error(loc, Field_type_mismatch ("method", lab, trace)))
-   in
-   match sty.ptyp_desc, priv with
-     Ptyp_poly ([],sty), Public ->
-@@ -279,6 +294,15 @@
- 
- (*******************************)
- 
-+let add_val env loc lab (mut, virt, ty) val_sig = 
-+  let virt =
-+    try
-+      let (mut', virt', ty') = Vars.find lab val_sig in
-+      if virt' = Concrete then virt' else virt
-+    with Not_found -> virt
-+  in
-+  Vars.add lab (mut, virt, ty) val_sig
-+
- let rec class_type_field env self_type meths (val_sig, concr_meths, inher) =
-   function
-     Pctf_inher sparent ->
-@@ -293,25 +317,12 @@
-           parent
-       in
-       let val_sig =
--        Vars.fold
--          (fun lab (mut, ty) val_sig -> Vars.add lab (mut, ty) val_sig)
--          cl_sig.cty_vars val_sig
--      in
-+        Vars.fold (add_val env sparent.pcty_loc) cl_sig.cty_vars val_sig in
-       (val_sig, concr_meths, inher)
- 
--  | Pctf_val (lab, mut, sty_opt, loc) ->
--      let (mut, ty) =
--        match sty_opt with
--          None     ->
--            let (mut', ty) =
--              try Vars.find lab val_sig with Not_found ->
--                raise(Error(loc, Unbound_val lab))
--            in
--            (if mut = Mutable then mut' else Immutable), ty
--        | Some sty ->
--            mut, transl_simple_type env false sty
--      in
--      (Vars.add lab (mut, ty) val_sig, concr_meths, inher)
-+  | Pctf_val (lab, mut, virt, sty, loc) ->
-+      let ty = transl_simple_type env false sty in
-+      (add_val env loc lab (mut, virt, ty) val_sig, concr_meths, inher)
- 
-   | Pctf_virt (lab, priv, sty, loc) ->
-       declare_method env meths self_type lab priv sty loc;
-@@ -397,7 +408,7 @@
- 
- let rec class_field cl_num self_type meths vars
-     (val_env, met_env, par_env, fields, concr_meths, warn_meths,
--     inh_vals, inher) =
-+     warn_vals, inher) =
-   function
-     Pcf_inher (sparent, super) ->
-       let parent = class_expr cl_num val_env par_env sparent in
-@@ -411,18 +422,23 @@
-           parent.cl_type
-       in
-       (* Variables *)
--      let (val_env, met_env, par_env, inh_vars, inh_vals) =
-+      let (val_env, met_env, par_env, inh_vars, warn_vals) =
-         Vars.fold
--          (fun lab (mut, ty) (val_env, met_env, par_env, inh_vars, inh_vals) ->
-+          (fun lab info (val_env, met_env, par_env, inh_vars, warn_vals) ->
-+             let mut, vr, ty = info in
-              let (id, val_env, met_env, par_env) =
--               enter_val cl_num vars lab mut ty val_env met_env par_env
-+               enter_val cl_num vars true lab mut vr ty val_env met_env par_env
-+                 sparent.pcl_loc
-              in
--             if StringSet.mem lab inh_vals then
--               Location.prerr_warning sparent.pcl_loc
--                 (Warnings.Hide_instance_variable lab);
--             (val_env, met_env, par_env, (lab, id) :: inh_vars,
--              StringSet.add lab inh_vals))
--          cl_sig.cty_vars (val_env, met_env, par_env, [], inh_vals)
-+             let warn_vals =
-+               if vr = Virtual then warn_vals else
-+               if StringSet.mem lab warn_vals then
-+                 (Location.prerr_warning sparent.pcl_loc
-+                   (Warnings.Instance_variable_override lab); warn_vals)
-+               else StringSet.add lab warn_vals
-+             in
-+             (val_env, met_env, par_env, (lab, id) :: inh_vars, warn_vals))
-+          cl_sig.cty_vars (val_env, met_env, par_env, [], warn_vals)
-       in
-       (* Inherited concrete methods *)
-       let inh_meths = 
-@@ -443,11 +459,26 @@
-       in
-       (val_env, met_env, par_env,
-        lazy(Cf_inher (parent, inh_vars, inh_meths))::fields,
--       concr_meths, warn_meths, inh_vals, inher)
-+       concr_meths, warn_meths, warn_vals, inher)
-+
-+  | Pcf_valvirt (lab, mut, styp, loc) ->
-+      if !Clflags.principal then Ctype.begin_def ();
-+      let ty = Typetexp.transl_simple_type val_env false styp in
-+      if !Clflags.principal then begin
-+        Ctype.end_def ();
-+        Ctype.generalize_structure ty
-+      end;
-+      let (id, val_env, met_env', par_env) =
-+        enter_val cl_num vars false lab mut Virtual ty
-+          val_env met_env par_env loc
-+      in
-+      (val_env, met_env', par_env,
-+       lazy(Cf_val (lab, id, None, met_env' == met_env)) :: fields,
-+       concr_meths, warn_meths, StringSet.remove lab warn_vals, inher)
- 
-   | Pcf_val (lab, mut, sexp, loc) ->
--      if StringSet.mem lab inh_vals then
--        Location.prerr_warning loc (Warnings.Hide_instance_variable lab);
-+      if StringSet.mem lab warn_vals then
-+        Location.prerr_warning loc (Warnings.Instance_variable_override lab);
-       if !Clflags.principal then Ctype.begin_def ();
-       let exp =
-         try type_exp val_env sexp with Ctype.Unify [(ty, _)] ->
-@@ -457,17 +488,19 @@
-         Ctype.end_def ();
-         Ctype.generalize_structure exp.exp_type
-       end;
--      let (id, val_env, met_env, par_env) =
--        enter_val cl_num vars lab mut exp.exp_type val_env met_env par_env
--      in
--      (val_env, met_env, par_env, lazy(Cf_val (lab, id, exp)) :: fields,
--       concr_meths, warn_meths, inh_vals, inher)
-+      let (id, val_env, met_env', par_env) =
-+        enter_val cl_num vars false lab mut Concrete exp.exp_type
-+          val_env met_env par_env loc
-+      in
-+      (val_env, met_env', par_env,
-+       lazy(Cf_val (lab, id, Some exp, met_env' == met_env)) :: fields,
-+       concr_meths, warn_meths, StringSet.add lab warn_vals, inher)
- 
-   | Pcf_virt (lab, priv, sty, loc) ->
-       virtual_method val_env meths self_type lab priv sty loc;
-       let warn_meths = Concr.remove lab warn_meths in
-       (val_env, met_env, par_env, fields, concr_meths, warn_meths,
--       inh_vals, inher)
-+       warn_vals, inher)
- 
-   | Pcf_meth (lab, priv, expr, loc)  ->
-       let (_, ty) =
-@@ -493,7 +526,7 @@
-           end
-       | _ -> assert false
-       with Ctype.Unify trace ->
--        raise(Error(loc, Method_type_mismatch (lab, trace)))
-+        raise(Error(loc, Field_type_mismatch ("method", lab, trace)))
-       end;
-       let meth_expr = make_method cl_num expr in
-       (* backup variables for Pexp_override *)
-@@ -510,12 +543,12 @@
-           Cf_meth (lab, texp)
-         end in
-       (val_env, met_env, par_env, field::fields,
--       Concr.add lab concr_meths, Concr.add lab warn_meths, inh_vals, inher)
-+       Concr.add lab concr_meths, Concr.add lab warn_meths, warn_vals, inher)
- 
-   | Pcf_cstr (sty, sty', loc) ->
-       type_constraint val_env sty sty' loc;
-       (val_env, met_env, par_env, fields, concr_meths, warn_meths,
--       inh_vals, inher)
-+       warn_vals, inher)
- 
-   | Pcf_let (rec_flag, sdefs, loc) ->
-       let (defs, val_env) =
-@@ -545,7 +578,7 @@
-           ([], met_env, par_env)
-       in
-       (val_env, met_env, par_env, lazy(Cf_let(rec_flag, defs, vals))::fields,
--       concr_meths, warn_meths, inh_vals, inher)
-+       concr_meths, warn_meths, warn_vals, inher)
- 
-   | Pcf_init expr ->
-       let expr = make_method cl_num expr in
-@@ -562,7 +595,7 @@
-           Cf_init texp
-         end in
-       (val_env, met_env, par_env, field::fields,
--       concr_meths, warn_meths, inh_vals, inher)
-+       concr_meths, warn_meths, warn_vals, inher)
- 
- and class_structure cl_num final val_env met_env loc (spat, str) =
-   (* Environment for substructures *)
-@@ -616,7 +649,7 @@
-   Ctype.unify val_env self_type (Ctype.newvar ());
-   let sign =
-     {cty_self = public_self;
--     cty_vars = Vars.map (function (id, mut, ty) -> (mut, ty)) !vars;
-+     cty_vars = Vars.map (fun (id, mut, vr, ty) -> (mut, vr, ty)) !vars;
-      cty_concr = concr_meths;
-      cty_inher = inher} in
-   let methods = get_methods self_type in
-@@ -628,7 +661,11 @@
-        be modified after this point *)
-     Ctype.close_object self_type;
-     let mets = virtual_methods {sign with cty_self = self_type} in
--    if mets <> [] then raise(Error(loc, Virtual_class(true, mets)));
-+    let vals =
-+      Vars.fold
-+        (fun name (mut, vr, ty) l -> if vr = Virtual then name :: l else l)
-+        sign.cty_vars [] in
-+    if mets <> [] then raise(Error(loc, Virtual_class(true, mets, vals)));
-     let self_methods =
-       List.fold_right
-         (fun (lab,kind,ty) rem ->
-@@ -1135,9 +1172,14 @@
-   in
- 
-   if cl.pci_virt = Concrete then begin
--    match virtual_methods (Ctype.signature_of_class_type typ) with
--      []   -> ()
--    | mets -> raise(Error(cl.pci_loc, Virtual_class(define_class, mets)))
-+    let sign = Ctype.signature_of_class_type typ in
-+    let mets = virtual_methods sign in
-+    let vals =
-+      Vars.fold
-+        (fun name (mut, vr, ty) l -> if vr = Virtual then name :: l else l)
-+        sign.cty_vars [] in
-+    if mets <> []  || vals <> [] then
-+      raise(Error(cl.pci_loc, Virtual_class(true, mets, vals)));
-   end;
- 
-   (* Misc. *)
-@@ -1400,10 +1442,10 @@
-       Printtyp.report_unification_error ppf trace
-         (fun ppf -> fprintf ppf "Type")
-         (fun ppf -> fprintf ppf "is not compatible with type")
--  | Method_type_mismatch (m, trace) ->
-+  | Field_type_mismatch (k, m, trace) ->
-       Printtyp.report_unification_error ppf trace
-         (function ppf ->
--           fprintf ppf "The method %s@ has type" m)
-+           fprintf ppf "The %s %s@ has type" k m)
-         (function ppf ->
-            fprintf ppf "but is expected to have type")
-   | Structure_expected clty ->
-@@ -1451,15 +1493,20 @@
-            fprintf ppf "The expression \"new %s\" has type" c)
-         (function ppf ->
-            fprintf ppf "but is used with type")
--  | Virtual_class (cl, mets) ->
-+  | Virtual_class (cl, mets, vals) ->
-       let print_mets ppf mets =
-         List.iter (function met -> fprintf ppf "@ %s" met) mets in
-       let cl_mark = if cl then "" else " type" in
-+      let missings =
-+        match mets, vals with
-+          [], _ -> "variables"
-+        | _, [] -> "methods"
-+        | _ -> "methods and variables"
-+      in
-       fprintf ppf
--        "@[This class%s should be virtual@ \
--           @[<2>The following methods are undefined :%a@]
--         @]"
--        cl_mark print_mets mets
-+        "@[This class%s should be virtual.@ \
-+           @[<2>The following %s are undefined :%a@]@]"
-+          cl_mark missings print_mets (mets @ vals)
-   | Parameter_arity_mismatch(lid, expected, provided) ->
-       fprintf ppf
-         "@[The class constructor %a@ expects %i type argument(s),@ \
-@@ -1532,3 +1579,10 @@
-            fprintf ppf "This object is expected to have type")
-         (function ppf ->
-            fprintf ppf "but has actually type")
-+  | Mutability_mismatch (lab, mut) ->
-+      let mut1, mut2 =
-+        if mut = Immutable then "mutable", "immutable"
-+        else "immutable", "mutable" in
-+      fprintf ppf
-+        "@[The instance variable is %s,@ it cannot be redefined as %s@]"
-+        mut1 mut2
-Index: typing/typeclass.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typeclass.mli,v
-retrieving revision 1.18
-diff -u -r1.18 typeclass.mli
---- typing/typeclass.mli	1 Dec 2003 00:32:11 -0000	1.18
-+++ typing/typeclass.mli	5 Apr 2006 02:26:00 -0000
-@@ -49,7 +49,7 @@
- 
- type error =
-     Unconsistent_constraint of (type_expr * type_expr) list
--  | Method_type_mismatch of string * (type_expr * type_expr) list
-+  | Field_type_mismatch of string * string * (type_expr * type_expr) list
-   | Structure_expected of class_type
-   | Cannot_apply of class_type
-   | Apply_wrong_label of label
-@@ -61,7 +61,7 @@
-   | Unbound_class_type_2 of Longident.t
-   | Abbrev_type_clash of type_expr * type_expr * type_expr
-   | Constructor_type_mismatch of string * (type_expr * type_expr) list
--  | Virtual_class of bool * string list
-+  | Virtual_class of bool * string list * string list
-   | Parameter_arity_mismatch of Longident.t * int * int
-   | Parameter_mismatch of (type_expr * type_expr) list
-   | Bad_parameters of Ident.t * type_expr * type_expr
-@@ -74,6 +74,7 @@
-   | Non_collapsable_conjunction of
-       Ident.t * Types.class_declaration * (type_expr * type_expr) list
-   | Final_self_clash of (type_expr * type_expr) list
-+  | Mutability_mismatch of string * mutable_flag
- 
- exception Error of Location.t * error
- 
-Index: typing/typecore.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typecore.ml,v
-retrieving revision 1.178
-diff -u -r1.178 typecore.ml
---- typing/typecore.ml	6 Jan 2006 02:25:37 -0000	1.178
-+++ typing/typecore.ml	5 Apr 2006 02:26:00 -0000
-@@ -611,11 +611,11 @@
-       List.for_all
-         (function
-             Cf_meth _ -> true
--          | Cf_val (_,_,e) -> incr count; is_nonexpansive e
-+          | Cf_val (_,_,e,_) -> incr count; is_nonexpansive_opt e
-           | Cf_init e -> is_nonexpansive e
-           | Cf_inher _ | Cf_let _ -> false)
-         fields &&
--      Vars.fold (fun _ (mut,_) b -> decr count; b && mut = Immutable)
-+      Vars.fold (fun _ (mut,_,_) b -> decr count; b && mut = Immutable)
-         vars true &&
-       !count = 0
-   | _ -> false
-@@ -1356,7 +1356,7 @@
-         (path_self, _) ->
-           let type_override (lab, snewval) =
-             begin try
--              let (id, _, ty) = Vars.find lab !vars in
-+              let (id, _, _, ty) = Vars.find lab !vars in
-               (Path.Pident id, type_expect env snewval (instance ty))
-             with
-               Not_found ->
-Index: typing/typecore.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typecore.mli,v
-retrieving revision 1.37
-diff -u -r1.37 typecore.mli
---- typing/typecore.mli	4 Mar 2005 14:51:31 -0000	1.37
-+++ typing/typecore.mli	5 Apr 2006 02:26:00 -0000
-@@ -38,7 +38,8 @@
-         string -> type_expr -> Env.t -> Env.t -> Env.t -> Parsetree.pattern ->
-         Typedtree.pattern *
-         (Ident.t * type_expr) Meths.t ref *
--        (Ident.t * Asttypes.mutable_flag * type_expr) Vars.t ref *
-+        (Ident.t * Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr)
-+            Vars.t ref *
-         Env.t * Env.t * Env.t
- val type_expect:
-         ?in_function:(Location.t * type_expr) ->
-Index: typing/typedtree.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typedtree.ml,v
-retrieving revision 1.36
-diff -u -r1.36 typedtree.ml
---- typing/typedtree.ml	25 Nov 2003 09:20:43 -0000	1.36
-+++ typing/typedtree.ml	5 Apr 2006 02:26:00 -0000
-@@ -106,7 +106,7 @@
- 
- and class_field =
-     Cf_inher of class_expr * (string * Ident.t) list * (string * Ident.t) list
--  | Cf_val of string * Ident.t * expression
-+  | Cf_val of string * Ident.t * expression option * bool
-   | Cf_meth of string * expression
-   | Cf_let of rec_flag * (pattern * expression) list *
-               (Ident.t * expression) list
-@@ -140,7 +140,8 @@
-   | Tstr_recmodule of (Ident.t * module_expr) list
-   | Tstr_modtype of Ident.t * module_type
-   | Tstr_open of Path.t
--  | Tstr_class of (Ident.t * int * string list * class_expr) list
-+  | Tstr_class of
-+      (Ident.t * int * string list * class_expr * virtual_flag) list
-   | Tstr_cltype of (Ident.t * cltype_declaration) list
-   | Tstr_include of module_expr * Ident.t list
- 
-Index: typing/typedtree.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typedtree.mli,v
-retrieving revision 1.34
-diff -u -r1.34 typedtree.mli
---- typing/typedtree.mli	25 Nov 2003 09:20:43 -0000	1.34
-+++ typing/typedtree.mli	5 Apr 2006 02:26:00 -0000
-@@ -107,7 +107,8 @@
- and class_field =
-     Cf_inher of class_expr * (string * Ident.t) list * (string * Ident.t) list
-     (* Inherited instance variables and concrete methods *)
--  | Cf_val of string * Ident.t * expression
-+  | Cf_val of string * Ident.t * expression option * bool
-+        (* None = virtual, true = override *)
-   | Cf_meth of string * expression
-   | Cf_let of rec_flag * (pattern * expression) list *
-               (Ident.t * expression) list
-@@ -141,7 +142,8 @@
-   | Tstr_recmodule of (Ident.t * module_expr) list
-   | Tstr_modtype of Ident.t * module_type
-   | Tstr_open of Path.t
--  | Tstr_class of (Ident.t * int * string list * class_expr) list
-+  | Tstr_class of
-+      (Ident.t * int * string list * class_expr * virtual_flag) list
-   | Tstr_cltype of (Ident.t * cltype_declaration) list
-   | Tstr_include of module_expr * Ident.t list
- 
-Index: typing/typemod.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typemod.ml,v
-retrieving revision 1.73
-diff -u -r1.73 typemod.ml
---- typing/typemod.ml	8 Aug 2005 09:41:51 -0000	1.73
-+++ typing/typemod.ml	5 Apr 2006 02:26:00 -0000
-@@ -17,6 +17,7 @@
- open Misc
- open Longident
- open Path
-+open Asttypes
- open Parsetree
- open Types
- open Typedtree
-@@ -667,8 +668,9 @@
-         let (classes, new_env) = Typeclass.class_declarations env cl in
-         let (str_rem, sig_rem, final_env) = type_struct new_env srem in
-         (Tstr_class
--           (List.map (fun (i, _,_,_,_,_,_,_, s, m, c) ->
--              (i, s, m, c)) classes) ::
-+           (List.map (fun (i, d, _,_,_,_,_,_, s, m, c) ->
-+              let vf = if d.cty_new = None then Virtual else Concrete in
-+              (i, s, m, c, vf)) classes) ::
-          Tstr_cltype
-            (List.map (fun (_,_, i, d, _,_,_,_,_,_,_) -> (i, d)) classes) ::
-          Tstr_type
-Index: typing/types.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/types.ml,v
-retrieving revision 1.25
-diff -u -r1.25 types.ml
---- typing/types.ml	9 Dec 2004 12:40:53 -0000	1.25
-+++ typing/types.ml	5 Apr 2006 02:26:00 -0000
-@@ -90,7 +90,8 @@
-   | Val_prim of Primitive.description   (* Primitive *)
-   | Val_ivar of mutable_flag * string   (* Instance variable (mutable ?) *)
-   | Val_self of (Ident.t * type_expr) Meths.t ref *
--                (Ident.t * Asttypes.mutable_flag * type_expr) Vars.t ref *
-+                (Ident.t * Asttypes.mutable_flag *
-+                 Asttypes.virtual_flag * type_expr) Vars.t ref *
-                 string * type_expr
-                                         (* Self *)
-   | Val_anc of (string * Ident.t) list * string
-@@ -156,7 +157,8 @@
- 
- and class_signature =
-   { cty_self: type_expr;
--    cty_vars: (Asttypes.mutable_flag * type_expr) Vars.t;
-+    cty_vars:
-+      (Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr) Vars.t;
-     cty_concr: Concr.t;
-     cty_inher: (Path.t * type_expr list) list }
- 
-Index: typing/types.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/types.mli,v
-retrieving revision 1.25
-diff -u -r1.25 types.mli
---- typing/types.mli	9 Dec 2004 12:40:53 -0000	1.25
-+++ typing/types.mli	5 Apr 2006 02:26:00 -0000
-@@ -91,7 +91,8 @@
-   | Val_prim of Primitive.description   (* Primitive *)
-   | Val_ivar of mutable_flag * string   (* Instance variable (mutable ?) *)
-   | Val_self of (Ident.t * type_expr) Meths.t ref *
--                (Ident.t * Asttypes.mutable_flag * type_expr) Vars.t ref *
-+                (Ident.t * Asttypes.mutable_flag *
-+                 Asttypes.virtual_flag * type_expr) Vars.t ref *
-                 string * type_expr
-                                         (* Self *)
-   | Val_anc of (string * Ident.t) list * string
-@@ -158,7 +159,8 @@
- 
- and class_signature =
-   { cty_self: type_expr;
--    cty_vars: (Asttypes.mutable_flag * type_expr) Vars.t;
-+    cty_vars:
-+      (Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr) Vars.t;
-     cty_concr: Concr.t;
-     cty_inher: (Path.t * type_expr list) list }
- 
-Index: typing/unused_var.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/unused_var.ml,v
-retrieving revision 1.5
-diff -u -r1.5 unused_var.ml
---- typing/unused_var.ml	4 Jan 2006 16:55:50 -0000	1.5
-+++ typing/unused_var.ml	5 Apr 2006 02:26:00 -0000
-@@ -245,7 +245,7 @@
-   match cf with
-   | Pcf_inher (ce, _) -> class_expr ppf tbl ce;
-   | Pcf_val (_, _, e, _) -> expression ppf tbl e;
--  | Pcf_virt _ -> ()
-+  | Pcf_virt _ | Pcf_valvirt _ -> ()
-   | Pcf_meth (_, _, e, _) -> expression ppf tbl e;
-   | Pcf_cstr _ -> ()
-   | Pcf_let (recflag, pel, _) -> let_pel ppf tbl recflag pel None;
-Index: bytecomp/translclass.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/translclass.ml,v
-retrieving revision 1.38
-diff -u -r1.38 translclass.ml
---- bytecomp/translclass.ml	13 Aug 2005 20:59:37 -0000	1.38
-+++ bytecomp/translclass.ml	5 Apr 2006 02:26:00 -0000
-@@ -133,10 +133,10 @@
-                        (fun _ -> lambda_unit) cl
-                    in
-                    (inh_init, lsequence obj_init' obj_init, true)
--               | Cf_val (_, id, exp) ->
-+               | Cf_val (_, id, Some exp, _) ->
-                    (inh_init, lsequence (set_inst_var obj id exp) obj_init,
-                     has_init)
--               | Cf_meth _ ->
-+               | Cf_meth _ | Cf_val _ ->
-                    (inh_init, obj_init, has_init)
-                | Cf_init _ ->
-                    (inh_init, obj_init, true)
-@@ -213,27 +213,17 @@
-   if len < 2 && nvals = 0 then Meths.fold (bind_method tbl) meths cl_init else
-   if len = 0 && nvals < 2 then transl_vals tbl true vals cl_init else
-   let ids = Ident.create "ids" in
--  let i = ref len in
--  let getter, names, cl_init =
--    match vals with [] -> "get_method_labels", [], cl_init
--    | (_,id0)::vals' ->
--        incr i;
--        let i = ref (List.length vals) in
--        "new_methods_variables",
--        [transl_meth_list (List.map fst vals)],
--        Llet(Strict, id0, lfield ids 0,
--	     List.fold_right
--	       (fun (name,id) rem ->
--	         decr i;
--                 Llet(Alias, id, Lprim(Poffsetint !i, [Lvar id0]), rem))
--	       vals' cl_init)
-+  let i = ref (len + nvals) in
-+  let getter, names =
-+    if nvals = 0 then "get_method_labels", [] else
-+    "new_methods_variables", [transl_meth_list (List.map fst vals)]
-   in
-   Llet(StrictOpt, ids,
-        Lapply (oo_prim getter,
-                [Lvar tbl; transl_meth_list (List.map fst methl)] @ names),
-        List.fold_right
-          (fun (lab,id) lam -> decr i; Llet(StrictOpt, id, lfield ids !i, lam))
--         methl cl_init)
-+         (methl @ vals) cl_init)
- 
- let output_methods tbl methods lam =
-   match methods with
-@@ -283,8 +273,9 @@
-                     (vals, meths_super cla str.cl_meths meths)
-                     inh_init cl_init msubst top cl in
-                 (inh_init, cl_init, [], values)
--            | Cf_val (name, id, exp) ->
--                (inh_init, cl_init, methods, (name, id)::values)
-+            | Cf_val (name, id, exp, over) ->
-+                let values = if over then values else (name, id) :: values in
-+                (inh_init, cl_init, methods, values)
-             | Cf_meth (name, exp) ->
-                 let met_code = msubst true (transl_exp exp) in
-                 let met_code =
-@@ -342,27 +333,24 @@
- 	  assert (Path.same path path');
- 	  let lpath = transl_path path in
-           let inh = Ident.create "inh"
--          and inh_vals = Ident.create "vals"
--          and inh_meths = Ident.create "meths"
-+          and ofs = List.length vals + 1
-           and valids, methids = super in
-           let cl_init =
-             List.fold_left
-               (fun init (nm, id, _) ->
--                Llet(StrictOpt, id, lfield inh_meths (index nm concr_meths),
-+                Llet(StrictOpt, id, lfield inh (index nm concr_meths + ofs),
-                      init))
-               cl_init methids in
-           let cl_init =
-             List.fold_left
-               (fun init (nm, id) ->
--                Llet(StrictOpt, id, lfield inh_vals (index nm vals), init))
-+                Llet(StrictOpt, id, lfield inh (index nm vals + 1), init))
-               cl_init valids in
-           (inh_init,
-            Llet (Strict, inh, 
- 		 Lapply(oo_prim "inherits", narrow_args @
- 			[lpath; Lconst(Const_pointer(if top then 1 else 0))]),
--                 Llet(StrictOpt, obj_init, lfield inh 0,
--                 Llet(Alias, inh_vals, lfield inh 1,
--                 Llet(Alias, inh_meths, lfield inh 2, cl_init)))))
-+                 Llet(StrictOpt, obj_init, lfield inh 0, cl_init)))
-       | _ ->
- 	  let core cl_init =
-             build_class_init cla true super inh_init cl_init msubst top cl
-@@ -397,12 +385,16 @@
-    XXX Il devrait etre peu couteux d'ecrire des classes :
-      class c x y = d e f
- *)
--let rec transl_class_rebind obj_init cl =
-+let rec transl_class_rebind obj_init cl vf =
-   match cl.cl_desc with
-     Tclass_ident path ->
-+      if vf = Concrete then begin
-+        try if (Env.find_class path cl.cl_env).cty_new = None then raise Exit
-+        with Not_found -> raise Exit
-+      end;
-       (path, obj_init)
-   | Tclass_fun (pat, _, cl, partial) ->
--      let path, obj_init = transl_class_rebind obj_init cl in
-+      let path, obj_init = transl_class_rebind obj_init cl vf in
-       let build params rem =
-         let param = name_pattern "param" [pat, ()] in
-         Lfunction (Curried, param::params,
-@@ -414,14 +406,14 @@
-          Lfunction (Curried, params, rem) -> build params rem
-        | rem                              -> build [] rem)
-   | Tclass_apply (cl, oexprs) ->
--      let path, obj_init = transl_class_rebind obj_init cl in
-+      let path, obj_init = transl_class_rebind obj_init cl vf in
-       (path, transl_apply obj_init oexprs)
-   | Tclass_let (rec_flag, defs, vals, cl) ->
--      let path, obj_init = transl_class_rebind obj_init cl in
-+      let path, obj_init = transl_class_rebind obj_init cl vf in
-       (path, Translcore.transl_let rec_flag defs obj_init)
-   | Tclass_structure _ -> raise Exit
-   | Tclass_constraint (cl', _, _, _) ->
--      let path, obj_init = transl_class_rebind obj_init cl' in
-+      let path, obj_init = transl_class_rebind obj_init cl' vf in
-       let rec check_constraint = function
-           Tcty_constr(path', _, _) when Path.same path path' -> ()
-         | Tcty_fun (_, _, cty) -> check_constraint cty
-@@ -430,21 +422,21 @@
-       check_constraint cl.cl_type;
-       (path, obj_init)
- 
--let rec transl_class_rebind_0 self obj_init cl =
-+let rec transl_class_rebind_0 self obj_init cl vf =
-   match cl.cl_desc with
-     Tclass_let (rec_flag, defs, vals, cl) ->
--      let path, obj_init = transl_class_rebind_0 self obj_init cl in
-+      let path, obj_init = transl_class_rebind_0 self obj_init cl vf in
-       (path, Translcore.transl_let rec_flag defs obj_init)
-   | _ ->
--      let path, obj_init = transl_class_rebind obj_init cl in
-+      let path, obj_init = transl_class_rebind obj_init cl vf in
-       (path, lfunction [self] obj_init)
- 
--let transl_class_rebind ids cl =
-+let transl_class_rebind ids cl vf =
-   try
-     let obj_init = Ident.create "obj_init"
-     and self = Ident.create "self" in
-     let obj_init0 = lapply (Lvar obj_init) [Lvar self] in
--    let path, obj_init' = transl_class_rebind_0 self obj_init0 cl in
-+    let path, obj_init' = transl_class_rebind_0 self obj_init0 cl vf in
-     if not (Translcore.check_recursive_lambda ids obj_init') then
-       raise(Error(cl.cl_loc, Illegal_class_expr));
-     let id = (obj_init' = lfunction [self] obj_init0) in
-@@ -592,9 +584,9 @@
- *)
- 
- 
--let transl_class ids cl_id arity pub_meths cl =
-+let transl_class ids cl_id arity pub_meths cl vflag =
-   (* First check if it is not only a rebind *)
--  let rebind = transl_class_rebind ids cl in
-+  let rebind = transl_class_rebind ids cl vflag in
-   if rebind <> lambda_unit then rebind else
- 
-   (* Prepare for heavy environment handling *)
-@@ -696,9 +688,7 @@
-   (* Simplest case: an object defined at toplevel (ids=[]) *)
-   if top && ids = [] then llets (ltable cla (ldirect obj_init)) else
- 
--  let concrete =
--    ids = [] ||
--    Typeclass.virtual_methods (Ctype.signature_of_class_type cl.cl_type) = []
-+  let concrete = (vflag = Concrete)
-   and lclass lam =
-     let cl_init = llets (Lfunction(Curried, [cla], cl_init)) in
-     Llet(Strict, class_init, cl_init, lam (free_variables cl_init))
-@@ -800,11 +790,11 @@
- 
- (* Wrapper for class compilation *)
- 
--let transl_class ids cl_id arity pub_meths cl =
--  oo_wrap cl.cl_env false (transl_class ids cl_id arity pub_meths) cl
-+let transl_class ids cl_id arity pub_meths cl vf =
-+  oo_wrap cl.cl_env false (transl_class ids cl_id arity pub_meths cl) vf
- 
- let () =
--  transl_object := (fun id meths cl -> transl_class [] id 0 meths cl)
-+  transl_object := (fun id meths cl -> transl_class [] id 0 meths cl Concrete)
- 
- (* Error report *)
- 
-Index: bytecomp/translclass.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/translclass.mli,v
-retrieving revision 1.11
-diff -u -r1.11 translclass.mli
---- bytecomp/translclass.mli	12 Aug 2004 12:55:11 -0000	1.11
-+++ bytecomp/translclass.mli	5 Apr 2006 02:26:00 -0000
-@@ -16,7 +16,8 @@
- open Lambda
- 
- val transl_class :
--  Ident.t list -> Ident.t -> int -> string list -> class_expr -> lambda;;
-+  Ident.t list -> Ident.t ->
-+  int -> string list -> class_expr -> Asttypes.virtual_flag -> lambda;;
- 
- type error = Illegal_class_expr | Tags of string * string
- 
-Index: bytecomp/translmod.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/translmod.ml,v
-retrieving revision 1.51
-diff -u -r1.51 translmod.ml
---- bytecomp/translmod.ml	12 Aug 2004 12:55:11 -0000	1.51
-+++ bytecomp/translmod.ml	5 Apr 2006 02:26:00 -0000
-@@ -317,10 +317,10 @@
-   | Tstr_open path :: rem ->
-       transl_structure fields cc rootpath rem
-   | Tstr_class cl_list :: rem ->
--      let ids = List.map (fun (i, _, _, _) -> i) cl_list in
-+      let ids = List.map (fun (i, _, _, _, _) -> i) cl_list in
-       Lletrec(List.map
--                (fun (id, arity, meths, cl) ->
--                  (id, transl_class ids id arity meths cl))
-+                (fun (id, arity, meths, cl, vf) ->
-+                  (id, transl_class ids id arity meths cl vf))
-                 cl_list,
-               transl_structure (List.rev ids @ fields) cc rootpath rem)
-   | Tstr_cltype cl_list :: rem ->
-@@ -414,11 +414,11 @@
-   | Tstr_open path :: rem ->
-       transl_store subst rem
-   | Tstr_class cl_list :: rem ->
--      let ids = List.map (fun (i, _, _, _) -> i) cl_list in
-+      let ids = List.map (fun (i, _, _, _, _) -> i) cl_list in
-       let lam =
-         Lletrec(List.map
--                  (fun (id, arity, meths, cl) ->
--                     (id, transl_class ids id arity meths cl))
-+                  (fun (id, arity, meths, cl, vf) ->
-+                     (id, transl_class ids id arity meths cl vf))
-                   cl_list,
-                 store_idents ids) in
-       Lsequence(subst_lambda subst lam,
-@@ -485,7 +485,7 @@
-   | Tstr_modtype(id, decl) :: rem -> defined_idents rem
-   | Tstr_open path :: rem -> defined_idents rem
-   | Tstr_class cl_list :: rem ->
--      List.map (fun (i, _, _, _) -> i) cl_list @ defined_idents rem
-+      List.map (fun (i, _, _, _, _) -> i) cl_list @ defined_idents rem
-   | Tstr_cltype cl_list :: rem -> defined_idents rem
-   | Tstr_include(modl, ids) :: rem -> ids @ defined_idents rem
- 
-@@ -603,14 +603,14 @@
-   | Tstr_class cl_list ->
-       (* we need to use unique names for the classes because there might
-          be a value named identically *)
--      let ids = List.map (fun (i, _, _, _) -> i) cl_list in
-+      let ids = List.map (fun (i, _, _, _, _) -> i) cl_list in
-       List.iter set_toplevel_unique_name ids;
-       Lletrec(List.map
--                (fun (id, arity, meths, cl) ->
--                   (id, transl_class ids id arity meths cl))
-+                (fun (id, arity, meths, cl, vf) ->
-+                   (id, transl_class ids id arity meths cl vf))
-                 cl_list,
-               make_sequence
--                (fun (id, _, _, _) -> toploop_setvalue_id id)
-+                (fun (id, _, _, _, _) -> toploop_setvalue_id id)
-                 cl_list)
-   | Tstr_cltype cl_list ->
-       lambda_unit
-Index: driver/main_args.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/driver/main_args.ml,v
-retrieving revision 1.48
-diff -u -r1.48 main_args.ml
---- driver/main_args.ml	4 Jan 2006 16:55:49 -0000	1.48
-+++ driver/main_args.ml	5 Apr 2006 02:26:00 -0000
-@@ -136,11 +136,11 @@
-       \032    E/e enable/disable fragile match\n\
-       \032    F/f enable/disable partially applied function\n\
-       \032    L/l enable/disable labels omitted in application\n\
--      \032    M/m enable/disable overridden method\n\
-+      \032    M/m enable/disable overridden methods\n\
-       \032    P/p enable/disable partial match\n\
-       \032    S/s enable/disable non-unit statement\n\
-       \032    U/u enable/disable unused match case\n\
--      \032    V/v enable/disable hidden instance variable\n\
-+      \032    V/v enable/disable overridden instance variables\n\
-       \032    Y/y enable/disable suspicious unused variables\n\
-       \032    Z/z enable/disable all other unused variables\n\
-       \032    X/x enable/disable all other warnings\n\
-Index: driver/optmain.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/driver/optmain.ml,v
-retrieving revision 1.87
-diff -u -r1.87 optmain.ml
---- driver/optmain.ml	4 Jan 2006 16:55:49 -0000	1.87
-+++ driver/optmain.ml	5 Apr 2006 02:26:00 -0000
-@@ -173,7 +173,7 @@
-          \032    P/p enable/disable partial match\n\
-          \032    S/s enable/disable non-unit statement\n\
-          \032    U/u enable/disable unused match case\n\
--         \032    V/v enable/disable hidden instance variables\n\
-+         \032    V/v enable/disable overridden instance variables\n\
-          \032    Y/y enable/disable suspicious unused variables\n\
-          \032    Z/z enable/disable all other unused variables\n\
-          \032    X/x enable/disable all other warnings\n\
-Index: stdlib/camlinternalOO.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/stdlib/camlinternalOO.ml,v
-retrieving revision 1.14
-diff -u -r1.14 camlinternalOO.ml
---- stdlib/camlinternalOO.ml	25 Oct 2005 18:34:07 -0000	1.14
-+++ stdlib/camlinternalOO.ml	5 Apr 2006 02:26:00 -0000
-@@ -206,7 +206,11 @@
-      (table.methods_by_name, table.methods_by_label, table.hidden_meths,
-       table.vars, virt_meth_labs, vars)
-      :: table.previous_states;
--  table.vars <- Vars.empty;
-+  table.vars <-
-+    Vars.fold
-+      (fun lab info tvars ->
-+        if List.mem lab vars then Vars.add lab info tvars else tvars)
-+      table.vars Vars.empty;
-   let by_name = ref Meths.empty in
-   let by_label = ref Labs.empty in
-   List.iter2
-@@ -255,9 +259,11 @@
-   index
- 
- let new_variable table name =
--  let index = new_slot table in
--  table.vars <- Vars.add name index table.vars;
--  index
-+  try Vars.find name table.vars
-+  with Not_found ->
-+    let index = new_slot table in
-+    table.vars <- Vars.add name index table.vars;
-+    index
- 
- let to_array arr =
-   if arr = Obj.magic 0 then [||] else arr
-@@ -265,16 +271,17 @@
- let new_methods_variables table meths vals =
-   let meths = to_array meths in
-   let nmeths = Array.length meths and nvals = Array.length vals in
--  let index = new_variable table vals.(0) in
--  let res = Array.create (nmeths + 1) index in
--  for i = 1 to nvals - 1 do ignore (new_variable table vals.(i)) done;
-+  let res = Array.create (nmeths + nvals) 0 in
-   for i = 0 to nmeths - 1 do
--    res.(i+1) <- get_method_label table meths.(i)
-+    res.(i) <- get_method_label table meths.(i)
-+  done;
-+  for i = 0 to nvals - 1 do
-+    res.(i+nmeths) <- new_variable table vals.(i)
-   done;
-   res
- 
- let get_variable table name =
--  Vars.find name table.vars
-+  try Vars.find name table.vars with Not_found -> assert false
- 
- let get_variables table names =
-   Array.map (get_variable table) names
-@@ -315,9 +322,12 @@
-   let init =
-     if top then super cla env else Obj.repr (super cla) in
-   widen cla;
--  (init, Array.map (get_variable cla) (to_array vals),
--   Array.map (fun nm -> get_method cla (get_method_label cla nm))
--     (to_array concr_meths))
-+  Array.concat
-+    [[| repr init |];
-+     magic (Array.map (get_variable cla) (to_array vals) : int array);
-+     Array.map
-+       (fun nm -> repr (get_method cla (get_method_label cla nm) : closure))
-+       (to_array concr_meths) ]
- 
- let make_class pub_meths class_init =
-   let table = create_table pub_meths in
-Index: stdlib/camlinternalOO.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/stdlib/camlinternalOO.mli,v
-retrieving revision 1.9
-diff -u -r1.9 camlinternalOO.mli
---- stdlib/camlinternalOO.mli	25 Oct 2005 18:34:07 -0000	1.9
-+++ stdlib/camlinternalOO.mli	5 Apr 2006 02:26:00 -0000
-@@ -46,8 +46,7 @@
- val init_class : table -> unit
- val inherits :
-     table -> string array -> string array -> string array ->
--    (t * (table -> obj -> Obj.t) * t * obj) -> bool ->
--    (Obj.t * int array * closure array)
-+    (t * (table -> obj -> Obj.t) * t * obj) -> bool -> Obj.t array
- val make_class :
-     string array -> (table -> Obj.t -> t) ->
-     (t * (table -> Obj.t -> t) * (Obj.t -> t) * Obj.t)
-@@ -79,6 +78,7 @@
- 
- (** {6 Builtins to reduce code size} *)
- 
-+(*
- val get_const : t -> closure
- val get_var : int -> closure
- val get_env : int -> int -> closure
-@@ -103,6 +103,7 @@
- val send_var : tag -> int -> int -> closure
- val send_env : tag -> int -> int -> int -> closure
- val send_meth : tag -> label -> int -> closure
-+*)
- 
- type impl =
-     GetConst
-Index: stdlib/sys.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/stdlib/sys.ml,v
-retrieving revision 1.142
-diff -u -r1.142 sys.ml
---- stdlib/sys.ml	22 Mar 2006 12:39:39 -0000	1.142
-+++ stdlib/sys.ml	5 Apr 2006 02:26:00 -0000
-@@ -78,4 +78,4 @@
- 
- (* OCaml version string, must be in the format described in sys.mli. *)
- 
--let ocaml_version = "3.10+dev4 (2006-03-22)";;
-+let ocaml_version = "3.10+dev5 (2006-04-05)";;
-Index: tools/depend.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/tools/depend.ml,v
-retrieving revision 1.9
-diff -u -r1.9 depend.ml
---- tools/depend.ml	23 Mar 2005 03:08:37 -0000	1.9
-+++ tools/depend.ml	5 Apr 2006 02:26:00 -0000
-@@ -87,7 +87,7 @@
- 
- and add_class_type_field bv = function
-     Pctf_inher cty -> add_class_type bv cty
--  | Pctf_val(_, _, oty, _) -> add_opt add_type bv oty
-+  | Pctf_val(_, _, _, ty, _) -> add_type bv ty
-   | Pctf_virt(_, _, ty, _) -> add_type bv ty
-   | Pctf_meth(_, _, ty, _) -> add_type bv ty
-   | Pctf_cstr(ty1, ty2, _) -> add_type bv ty1; add_type bv ty2
-@@ -280,6 +280,7 @@
- and add_class_field bv = function
-     Pcf_inher(ce, _) -> add_class_expr bv ce
-   | Pcf_val(_, _, e, _) -> add_expr bv e
-+  | Pcf_valvirt(_, _, ty, _)
-   | Pcf_virt(_, _, ty, _) -> add_type bv ty
-   | Pcf_meth(_, _, e, _) -> add_expr bv e
-   | Pcf_cstr(ty1, ty2, _) -> add_type bv ty1; add_type bv ty2
-Index: tools/ocamlprof.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/tools/ocamlprof.ml,v
-retrieving revision 1.38
-diff -u -r1.38 ocamlprof.ml
---- tools/ocamlprof.ml	24 Mar 2005 17:20:54 -0000	1.38
-+++ tools/ocamlprof.ml	5 Apr 2006 02:26:00 -0000
-@@ -328,7 +328,7 @@
-       rewrite_patexp_list iflag spat_sexp_list
-   | Pcf_init sexp ->
-       rewrite_exp iflag sexp
--  | Pcf_virt _ | Pcf_cstr _  -> ()
-+  | Pcf_valvirt _ | Pcf_virt _ | Pcf_cstr _  -> ()
- 
- and rewrite_class_expr iflag cexpr =
-   match cexpr.pcl_desc with
-Index: otherlibs/labltk/browser/searchpos.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/otherlibs/labltk/browser/searchpos.ml,v
-retrieving revision 1.48
-diff -u -r1.48 searchpos.ml
---- otherlibs/labltk/browser/searchpos.ml	23 Mar 2005 03:08:37 -0000	1.48
-+++ otherlibs/labltk/browser/searchpos.ml	5 Apr 2006 02:26:01 -0000
-@@ -141,9 +141,8 @@
-         List.iter cfl ~f:
-           begin function
-               Pctf_inher cty -> search_pos_class_type cty ~pos ~env
--            | Pctf_val (_, _, Some ty, loc) ->
-+            | Pctf_val (_, _, _, ty, loc) ->
-                 if in_loc loc ~pos then search_pos_type ty ~pos ~env
--            | Pctf_val _ -> ()
-             | Pctf_virt (_, _, ty, loc) ->
-                 if in_loc loc ~pos then search_pos_type ty ~pos ~env
-             | Pctf_meth (_, _, ty, loc) ->
-@@ -675,7 +674,7 @@
-   | Tstr_modtype _ -> ()
-   | Tstr_open _ -> ()
-   | Tstr_class l ->
--      List.iter l ~f:(fun (id, _, _, cl) -> search_pos_class_expr cl ~pos)
-+      List.iter l ~f:(fun (id, _, _, cl, _) -> search_pos_class_expr cl ~pos)
-   | Tstr_cltype _ -> ()
-   | Tstr_include (m, _) -> search_pos_module_expr m ~pos
-   end
-@@ -685,7 +684,8 @@
-     begin function
-         Cf_inher (cl, _, _) ->
-           search_pos_class_expr cl ~pos
--      | Cf_val (_, _, exp) -> search_pos_expr exp ~pos
-+      | Cf_val (_, _, Some exp, _) -> search_pos_expr exp ~pos
-+      | Cf_val _ -> ()
-       | Cf_meth (_, exp) -> search_pos_expr exp ~pos
-       | Cf_let (_, pel, iel) ->
-           List.iter pel ~f:
-Index: ocamldoc/Makefile
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/ocamldoc/Makefile,v
-retrieving revision 1.61
-diff -u -r1.61 Makefile
---- ocamldoc/Makefile	4 Jan 2006 16:55:49 -0000	1.61
-+++ ocamldoc/Makefile	5 Apr 2006 02:26:01 -0000
-@@ -31,7 +31,7 @@
- MKDIR=mkdir -p
- CP=cp -f
- OCAMLDOC=ocamldoc
--OCAMLDOC_RUN=sh ./runocamldoc $(SUPPORTS_SHARED_LIBRARIES)
-+OCAMLDOC_RUN=./ocamldoc.opt #sh ./runocamldoc $(SUPPORTS_SHARED_LIBRARIES)
- OCAMLDOC_OPT=$(OCAMLDOC).opt
- OCAMLDOC_LIBCMA=odoc_info.cma
- OCAMLDOC_LIBCMI=odoc_info.cmi
-@@ -188,12 +188,12 @@
- 	../otherlibs/num/num.mli
- 
- all: exe lib
--	$(MAKE) manpages
- 
- exe: $(OCAMLDOC)
- lib: $(OCAMLDOC_LIBCMA) $(OCAMLDOC_LIBCMI) $(ODOC_TEST)
- 
- opt.opt: exeopt libopt
-+	$(MAKE) manpages
- exeopt: $(OCAMLDOC_OPT)
- libopt: $(OCAMLDOC_LIBCMXA) $(OCAMLDOC_LIBCMI)
- debug:
-Index: ocamldoc/odoc_ast.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/ocamldoc/odoc_ast.ml,v
-retrieving revision 1.27
-diff -u -r1.27 odoc_ast.ml
---- ocamldoc/odoc_ast.ml	4 Jan 2006 16:55:49 -0000	1.27
-+++ ocamldoc/odoc_ast.ml	5 Apr 2006 02:26:01 -0000
-@@ -88,7 +88,7 @@
-             ident_type_decl_list
-       | Typedtree.Tstr_class info_list ->
-           List.iter
--            (fun ((id,_,_,_) as ci) ->
-+            (fun ((id,_,_,_,_) as ci) ->
-               Hashtbl.add table (C (Name.from_ident id))
-                 (Typedtree.Tstr_class [ci]))
-             info_list
-@@ -146,7 +146,7 @@
- 
-     let search_class_exp table name =
-       match Hashtbl.find table (C name) with
--      | (Typedtree.Tstr_class [(_,_,_,ce)]) ->
-+      | (Typedtree.Tstr_class [(_,_,_,ce,_)]) ->
-           (
-            try
-              let type_decl = search_type_declaration table name in
-@@ -184,7 +184,7 @@
-       let rec iter = function
-         | [] ->
-             raise Not_found
--        | Typedtree.Cf_val (_, ident, exp) :: q
-+        | Typedtree.Cf_val (_, ident, Some exp, _) :: q
-           when Name.from_ident ident = name ->
-             exp.Typedtree.exp_type
-         | _ :: q ->
-@@ -523,7 +523,8 @@
-               p_clexp.Parsetree.pcl_loc.Location.loc_end.Lexing.pos_cnum
-               q
- 
--        | (Parsetree.Pcf_val (label, mutable_flag, expression, loc)) :: q ->
-+        | (Parsetree.Pcf_val (label, mutable_flag, _, loc) |
-+           Parsetree.Pcf_valvirt (label, mutable_flag, _, loc)) :: q ->
-             let complete_name = Name.concat current_class_name label in
-             let (info_opt, ele_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
-             let type_exp =
-Index: ocamldoc/odoc_sig.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/ocamldoc/odoc_sig.ml,v
-retrieving revision 1.37
-diff -u -r1.37 odoc_sig.ml
---- ocamldoc/odoc_sig.ml	4 Jan 2006 16:55:50 -0000	1.37
-+++ ocamldoc/odoc_sig.ml	5 Apr 2006 02:26:01 -0000
-@@ -107,7 +107,7 @@
-       | _ -> assert false
- 
-     let search_attribute_type name class_sig =
--      let (_, type_expr) = Types.Vars.find name class_sig.Types.cty_vars in
-+      let (_, _, type_expr) = Types.Vars.find name class_sig.Types.cty_vars in
-       type_expr
- 
-     let search_method_type name class_sig =
-@@ -269,7 +269,7 @@
-           [] -> pos_limit
-         | ele2 :: _ ->
-             match ele2 with
--              Parsetree.Pctf_val (_, _, _, loc)
-+              Parsetree.Pctf_val (_, _, _, _, loc)
-             | Parsetree.Pctf_virt (_, _, _, loc)
-             | Parsetree.Pctf_meth (_, _, _, loc)
-             | Parsetree.Pctf_cstr (_, _, loc) -> loc.Location.loc_start.Lexing.pos_cnum
-@@ -330,7 +330,7 @@
-             in
-             ([], ele_comments)
- 
--        | Parsetree.Pctf_val (name, mutable_flag, _, loc) :: q ->
-+        | Parsetree.Pctf_val (name, mutable_flag, _, _, loc) :: q ->
-             (* of (string * mutable_flag * core_type option * Location.t)*)
-             let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
-             let complete_name = Name.concat current_class_name name in
-Index: camlp4/camlp4/ast2pt.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/camlp4/camlp4/ast2pt.ml,v
-retrieving revision 1.36
-diff -u -r1.36 ast2pt.ml
---- camlp4/camlp4/ast2pt.ml	29 Jun 2005 04:11:26 -0000	1.36
-+++ camlp4/camlp4/ast2pt.ml	5 Apr 2006 02:26:01 -0000
-@@ -244,6 +244,7 @@
- ;
- value mkmutable m = if m then Mutable else Immutable;
- value mkprivate m = if m then Private else Public;
-+value mkvirtual m = if m then Virtual else Concrete;
- value mktrecord (loc, n, m, t) =
-   (n, mkmutable m, ctyp (mkpolytype t), mkloc loc);
- value mkvariant (loc, c, tl) = (c, List.map ctyp tl, mkloc loc);
-@@ -862,8 +863,8 @@
-   | CgInh loc ct -> [Pctf_inher (class_type ct) :: l]
-   | CgMth loc s pf t ->
-       [Pctf_meth (s, mkprivate pf, ctyp (mkpolytype t), mkloc loc) :: l]
--  | CgVal loc s b t ->
--      [Pctf_val (s, mkmutable b, Some (ctyp t), mkloc loc) :: l]
-+  | CgVal loc s b v t ->
-+      [Pctf_val (s, mkmutable b, mkvirtual v, ctyp t, mkloc loc) :: l]
-   | CgVir loc s b t ->
-       [Pctf_virt (s, mkprivate b, ctyp (mkpolytype t), mkloc loc) :: l] ]
- and class_expr =
-@@ -907,7 +908,9 @@
-       [Pcf_meth (s, mkprivate b, e, mkloc loc) :: l]
-   | CrVal loc s b e -> [Pcf_val (s, mkmutable b, expr e, mkloc loc) :: l]
-   | CrVir loc s b t ->
--      [Pcf_virt (s, mkprivate b, ctyp (mkpolytype t), mkloc loc) :: l] ]
-+      [Pcf_virt (s, mkprivate b, ctyp (mkpolytype t), mkloc loc) :: l]
-+  | CrVvr loc s b t ->
-+      [Pcf_valvirt (s, mkmutable b, ctyp t, mkloc loc) :: l] ]
- ;
- 
- value interf ast = List.fold_right sig_item ast [];
-Index: camlp4/camlp4/mLast.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/camlp4/camlp4/mLast.mli,v
-retrieving revision 1.18
-diff -u -r1.18 mLast.mli
---- camlp4/camlp4/mLast.mli	29 Jun 2005 04:11:26 -0000	1.18
-+++ camlp4/camlp4/mLast.mli	5 Apr 2006 02:26:01 -0000
-@@ -180,7 +180,7 @@
-   | CgDcl of loc and list class_sig_item
-   | CgInh of loc and class_type
-   | CgMth of loc and string and bool and ctyp
--  | CgVal of loc and string and bool and ctyp
-+  | CgVal of loc and string and bool and bool and ctyp
-   | CgVir of loc and string and bool and ctyp ]
- and class_expr =
-   [ CeApp of loc and class_expr and expr
-@@ -196,7 +196,8 @@
-   | CrIni of loc and expr
-   | CrMth of loc and string and bool and expr and option ctyp
-   | CrVal of loc and string and bool and expr
--  | CrVir of loc and string and bool and ctyp ]
-+  | CrVir of loc and string and bool and ctyp
-+  | CrVvr of loc and string and bool and ctyp ]
- ;
- 
- external loc_of_ctyp : ctyp -> loc = "%field0";
-Index: camlp4/camlp4/reloc.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/camlp4/camlp4/reloc.ml,v
-retrieving revision 1.18
-diff -u -r1.18 reloc.ml
---- camlp4/camlp4/reloc.ml	29 Jun 2005 04:11:26 -0000	1.18
-+++ camlp4/camlp4/reloc.ml	5 Apr 2006 02:26:01 -0000
-@@ -350,7 +350,7 @@
-     | CgDcl loc x1 -> let nloc = floc loc in CgDcl nloc (List.map (class_sig_item floc sh) x1)
-     | CgInh loc x1 -> let nloc = floc loc in CgInh nloc (class_type floc sh x1)
-     | CgMth loc x1 x2 x3 -> let nloc = floc loc in CgMth nloc x1 x2 (ctyp floc sh x3)
--    | CgVal loc x1 x2 x3 -> let nloc = floc loc in CgVal nloc x1 x2 (ctyp floc sh x3)
-+    | CgVal loc x1 x2 x3 x4 -> let nloc = floc loc in CgVal nloc x1 x2 x3 (ctyp floc sh x4)
-     | CgVir loc x1 x2 x3 -> let nloc = floc loc in CgVir nloc x1 x2 (ctyp floc sh x3) ]
- and class_expr floc sh =
-   self where rec self =
-@@ -377,5 +377,6 @@
-     | CrMth loc x1 x2 x3 x4 ->
-         let nloc = floc loc in CrMth nloc x1 x2 (expr floc sh x3) (option_map (ctyp floc sh) x4)
-     | CrVal loc x1 x2 x3 -> let nloc = floc loc in CrVal nloc x1 x2 (expr floc sh x3)
--    | CrVir loc x1 x2 x3 -> let nloc = floc loc in CrVir nloc x1 x2 (ctyp floc sh x3) ]
-+    | CrVir loc x1 x2 x3 -> let nloc = floc loc in CrVir nloc x1 x2 (ctyp floc sh x3)
-+    | CrVvr loc x1 x2 x3 -> let nloc = floc loc in CrVvr nloc x1 x2 (ctyp floc sh x3) ]
- ;
-Index: camlp4/etc/pa_o.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/camlp4/etc/pa_o.ml,v
-retrieving revision 1.66
-diff -u -r1.66 pa_o.ml
---- camlp4/etc/pa_o.ml	29 Jun 2005 04:11:26 -0000	1.66
-+++ camlp4/etc/pa_o.ml	5 Apr 2006 02:26:01 -0000
-@@ -1037,8 +1037,14 @@
-   class_str_item:
-     [ [ "inherit"; ce = class_expr; pb = OPT [ "as"; i = LIDENT -> i ] ->
-           <:class_str_item< inherit $ce$ $opt:pb$ >>
--      | "val"; mf = OPT "mutable"; lab = label; e = cvalue_binding ->
--          <:class_str_item< value $opt:o2b mf$ $lab$ = $e$ >>
-+      | "val"; "mutable"; lab = label; e = cvalue_binding ->
-+          <:class_str_item< value mutable $lab$ = $e$ >>
-+      | "val"; lab = label; e = cvalue_binding ->
-+          <:class_str_item< value $lab$ = $e$ >>
-+      | "val"; "mutable"; "virtual"; lab = label; ":"; t = ctyp ->
-+          <:class_str_item< value virtual mutable $lab$ : $t$ >>
-+      | "val"; "virtual"; mf = OPT "mutable"; lab = label; ":"; t = ctyp ->
-+          <:class_str_item< value virtual $opt:o2b mf$ $lab$ : $t$ >>
-       | "method"; "private"; "virtual"; l = label; ":"; t = poly_type ->
-           <:class_str_item< method virtual private $l$ : $t$ >>
-       | "method"; "virtual"; "private"; l = label; ":"; t = poly_type ->
-@@ -1087,8 +1093,9 @@
-   ;
-   class_sig_item:
-     [ [ "inherit"; cs = class_signature -> <:class_sig_item< inherit $cs$ >>
--      | "val"; mf = OPT "mutable"; l = label; ":"; t = ctyp ->
--          <:class_sig_item< value $opt:o2b mf$ $l$ : $t$ >>
-+      | "val"; mf = OPT "mutable"; vf = OPT "virtual";
-+        l = label; ":"; t = ctyp ->
-+          <:class_sig_item< value $opt:o2b mf$ $opt:o2b vf$ $l$ : $t$ >>
-       | "method"; "private"; "virtual"; l = label; ":"; t = poly_type ->
-           <:class_sig_item< method virtual private $l$ : $t$ >>
-       | "method"; "virtual"; "private"; l = label; ":"; t = poly_type ->
-Index: camlp4/etc/pr_o.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/camlp4/etc/pr_o.ml,v
-retrieving revision 1.51
-diff -u -r1.51 pr_o.ml
---- camlp4/etc/pr_o.ml	5 Jan 2006 10:44:29 -0000	1.51
-+++ camlp4/etc/pr_o.ml	5 Apr 2006 02:26:01 -0000
-@@ -1768,10 +1768,11 @@
-                   [: `S LR "method"; private_flag pf; `label lab;
-                      `S LR ":" :];
-                `ctyp t "" k :]
--      | MLast.CgVal _ lab mf t ->
-+      | MLast.CgVal _ lab mf vf t ->
-           fun curr next dg k ->
-             [: `HVbox
--                  [: `S LR "val"; mutable_flag mf; `label lab; `S LR ":" :];
-+                  [: `S LR "val"; mutable_flag mf; virtual_flag vf;
-+                     `label lab; `S LR ":" :];
-                `ctyp t "" k :]
-       | MLast.CgVir _ lab pf t ->
-           fun curr next dg k ->
-Index: camlp4/meta/pa_r.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/camlp4/meta/pa_r.ml,v
-retrieving revision 1.64
-diff -u -r1.64 pa_r.ml
---- camlp4/meta/pa_r.ml	29 Jun 2005 04:11:26 -0000	1.64
-+++ camlp4/meta/pa_r.ml	5 Apr 2006 02:26:01 -0000
-@@ -658,7 +658,9 @@
-       | "inherit"; ce = class_expr; pb = OPT as_lident ->
-           <:class_str_item< inherit $ce$ $opt:pb$ >>
-       | "value"; mf = OPT "mutable"; lab = label; e = cvalue_binding ->
--          <:class_str_item< value $opt:o2b mf$ $lab$ = $e$ >>
-+          <:class_str_item< value $opt:o2b mf$ $lab$ = $e$ >> 
-+      | "value"; "virtual"; mf = OPT "mutable"; l = label; ":"; t = ctyp ->
-+          <:class_str_item< value virtual $opt:o2b mf$ $l$ : $t$ >>
-       | "method"; "virtual"; pf = OPT "private"; l = label; ":"; t = ctyp ->
-           <:class_str_item< method virtual $opt:o2b pf$ $l$ : $t$ >>
-       | "method"; pf = OPT "private"; l = label; topt = OPT polyt;
-@@ -701,8 +703,9 @@
-     [ [ "declare"; st = LIST0 [ s = class_sig_item; ";" -> s ]; "end" ->
-           <:class_sig_item< declare $list:st$ end >>
-       | "inherit"; cs = class_type -> <:class_sig_item< inherit $cs$ >>
--      | "value"; mf = OPT "mutable"; l = label; ":"; t = ctyp ->
--          <:class_sig_item< value $opt:o2b mf$ $l$ : $t$ >>
-+      | "value"; mf = OPT "mutable"; vf = OPT "virtual";
-+        l = label; ":"; t = ctyp ->
-+          <:class_sig_item< value $opt:o2b mf$ $opt:o2b vf$ $l$ : $t$ >>
-       | "method"; "virtual"; pf = OPT "private"; l = label; ":"; t = ctyp ->
-           <:class_sig_item< method virtual $opt:o2b pf$ $l$ : $t$ >>
-       | "method"; pf = OPT "private"; l = label; ":"; t = ctyp ->
-Index: camlp4/meta/q_MLast.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/camlp4/meta/q_MLast.ml,v
-retrieving revision 1.60
-diff -u -r1.60 q_MLast.ml
---- camlp4/meta/q_MLast.ml	29 Jun 2005 04:11:26 -0000	1.60
-+++ camlp4/meta/q_MLast.ml	5 Apr 2006 02:26:01 -0000
-@@ -947,6 +947,8 @@
-           Qast.Node "CrDcl" [Qast.Loc; st]
-       | "inherit"; ce = class_expr; pb = SOPT as_lident ->
-           Qast.Node "CrInh" [Qast.Loc; ce; pb]
-+      | "value"; "virtual"; mf = SOPT "mutable"; l = label; ":"; t = ctyp ->
-+          Qast.Node "CrVvr" [Qast.Loc; l; o2b mf; t]
-       | "value"; mf = SOPT "mutable"; lab = label; e = cvalue_binding ->
-           Qast.Node "CrVal" [Qast.Loc; lab; o2b mf; e]
-       | "method"; "virtual"; pf = SOPT "private"; l = label; ":"; t = ctyp ->
-@@ -992,8 +994,9 @@
-     [ [ "declare"; st = SLIST0 [ s = class_sig_item; ";" -> s ]; "end" ->
-           Qast.Node "CgDcl" [Qast.Loc; st]
-       | "inherit"; cs = class_type -> Qast.Node "CgInh" [Qast.Loc; cs]
--      | "value"; mf = SOPT "mutable"; l = label; ":"; t = ctyp ->
--          Qast.Node "CgVal" [Qast.Loc; l; o2b mf; t]
-+      | "value"; mf = SOPT "mutable"; vf = SOPT "virtual";
-+        l = label; ":"; t = ctyp ->
-+          Qast.Node "CgVal" [Qast.Loc; l; o2b mf; o2b vf; t]
-       | "method"; "virtual"; pf = SOPT "private"; l = label; ":"; t = ctyp ->
-           Qast.Node "CgVir" [Qast.Loc; l; o2b pf; t]
-       | "method"; pf = SOPT "private"; l = label; ":"; t = ctyp ->
-Index: camlp4/ocaml_src/camlp4/ast2pt.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/camlp4/ast2pt.ml,v
-retrieving revision 1.36
-diff -u -r1.36 ast2pt.ml
---- camlp4/ocaml_src/camlp4/ast2pt.ml	29 Jun 2005 04:11:26 -0000	1.36
-+++ camlp4/ocaml_src/camlp4/ast2pt.ml	5 Apr 2006 02:26:01 -0000
-@@ -227,6 +227,7 @@
- ;;
- let mkmutable m = if m then Mutable else Immutable;;
- let mkprivate m = if m then Private else Public;;
-+let mkvirtual m = if m then Virtual else Concrete;;
- let mktrecord (loc, n, m, t) =
-   n, mkmutable m, ctyp (mkpolytype t), mkloc loc
- ;;
-@@ -878,8 +879,8 @@
-   | CgInh (loc, ct) -> Pctf_inher (class_type ct) :: l
-   | CgMth (loc, s, pf, t) ->
-       Pctf_meth (s, mkprivate pf, ctyp (mkpolytype t), mkloc loc) :: l
--  | CgVal (loc, s, b, t) ->
--      Pctf_val (s, mkmutable b, Some (ctyp t), mkloc loc) :: l
-+  | CgVal (loc, s, b, v, t) ->
-+      Pctf_val (s, mkmutable b, mkvirtual v, ctyp t, mkloc loc) :: l
-   | CgVir (loc, s, b, t) ->
-       Pctf_virt (s, mkprivate b, ctyp (mkpolytype t), mkloc loc) :: l
- and class_expr =
-@@ -923,6 +924,8 @@
-   | CrVal (loc, s, b, e) -> Pcf_val (s, mkmutable b, expr e, mkloc loc) :: l
-   | CrVir (loc, s, b, t) ->
-       Pcf_virt (s, mkprivate b, ctyp (mkpolytype t), mkloc loc) :: l
-+  | CrVvr (loc, s, b, t) ->
-+      Pcf_valvirt (s, mkmutable b, ctyp t, mkloc loc) :: l
- ;;
- 
- let interf ast = List.fold_right sig_item ast [];;
-Index: camlp4/ocaml_src/camlp4/mLast.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/camlp4/mLast.mli,v
-retrieving revision 1.20
-diff -u -r1.20 mLast.mli
---- camlp4/ocaml_src/camlp4/mLast.mli	29 Jun 2005 04:11:26 -0000	1.20
-+++ camlp4/ocaml_src/camlp4/mLast.mli	5 Apr 2006 02:26:01 -0000
-@@ -180,7 +180,7 @@
-   | CgDcl of loc * class_sig_item list
-   | CgInh of loc * class_type
-   | CgMth of loc * string * bool * ctyp
--  | CgVal of loc * string * bool * ctyp
-+  | CgVal of loc * string * bool * bool * ctyp
-   | CgVir of loc * string * bool * ctyp
- and class_expr =
-     CeApp of loc * class_expr * expr
-@@ -197,6 +197,7 @@
-   | CrMth of loc * string * bool * expr * ctyp option
-   | CrVal of loc * string * bool * expr
-   | CrVir of loc * string * bool * ctyp
-+  | CrVvr of loc * string * bool * ctyp
- ;;
- 
- external loc_of_ctyp : ctyp -> loc = "%field0";;
-Index: camlp4/ocaml_src/camlp4/reloc.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/camlp4/reloc.ml,v
-retrieving revision 1.20
-diff -u -r1.20 reloc.ml
---- camlp4/ocaml_src/camlp4/reloc.ml	29 Jun 2005 04:11:26 -0000	1.20
-+++ camlp4/ocaml_src/camlp4/reloc.ml	5 Apr 2006 02:26:01 -0000
-@@ -430,8 +430,8 @@
-         let nloc = floc loc in CgInh (nloc, class_type floc sh x1)
-     | CgMth (loc, x1, x2, x3) ->
-         let nloc = floc loc in CgMth (nloc, x1, x2, ctyp floc sh x3)
--    | CgVal (loc, x1, x2, x3) ->
--        let nloc = floc loc in CgVal (nloc, x1, x2, ctyp floc sh x3)
-+    | CgVal (loc, x1, x2, x3, x4) ->
-+        let nloc = floc loc in CgVal (nloc, x1, x2, x3, ctyp floc sh x4)
-     | CgVir (loc, x1, x2, x3) ->
-         let nloc = floc loc in CgVir (nloc, x1, x2, ctyp floc sh x3)
-   in
-@@ -478,6 +478,8 @@
-         let nloc = floc loc in CrVal (nloc, x1, x2, expr floc sh x3)
-     | CrVir (loc, x1, x2, x3) ->
-         let nloc = floc loc in CrVir (nloc, x1, x2, ctyp floc sh x3)
-+    | CrVvr (loc, x1, x2, x3) ->
-+        let nloc = floc loc in CrVvr (nloc, x1, x2, ctyp floc sh x3)
-   in
-   self
- ;;
-Index: camlp4/ocaml_src/meta/pa_r.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/meta/pa_r.ml,v
-retrieving revision 1.59
-diff -u -r1.59 pa_r.ml
---- camlp4/ocaml_src/meta/pa_r.ml	29 Jun 2005 04:11:26 -0000	1.59
-+++ camlp4/ocaml_src/meta/pa_r.ml	5 Apr 2006 02:26:01 -0000
-@@ -2161,6 +2161,15 @@
-         (fun (t : 'ctyp) _ (l : 'label) (pf : string option) _ _
-            (_loc : Lexing.position * Lexing.position) ->
-            (MLast.CrVir (_loc, l, o2b pf, t) : 'class_str_item));
-+      [Gramext.Stoken ("", "value"); Gramext.Stoken ("", "virtual");
-+       Gramext.Sopt (Gramext.Stoken ("", "mutable"));
-+       Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e));
-+       Gramext.Stoken ("", ":");
-+       Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
-+      Gramext.action
-+        (fun (t : 'ctyp) _ (l : 'label) (mf : string option) _ _
-+           (_loc : Lexing.position * Lexing.position) ->
-+           (MLast.CrVvr (_loc, l, o2b mf, t) : 'class_str_item));
-       [Gramext.Stoken ("", "value");
-        Gramext.Sopt (Gramext.Stoken ("", "mutable"));
-        Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e));
-@@ -2338,13 +2347,15 @@
-            (MLast.CgVir (_loc, l, o2b pf, t) : 'class_sig_item));
-       [Gramext.Stoken ("", "value");
-        Gramext.Sopt (Gramext.Stoken ("", "mutable"));
-+       Gramext.Sopt (Gramext.Stoken ("", "virtual"));
-        Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e));
-        Gramext.Stoken ("", ":");
-        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
-       Gramext.action
--        (fun (t : 'ctyp) _ (l : 'label) (mf : string option) _
-+        (fun (t : 'ctyp) _ (l : 'label) (vf : string option)
-+           (mf : string option) _
-            (_loc : Lexing.position * Lexing.position) ->
--           (MLast.CgVal (_loc, l, o2b mf, t) : 'class_sig_item));
-+           (MLast.CgVal (_loc, l, o2b mf, o2b vf, t) : 'class_sig_item));
-       [Gramext.Stoken ("", "inherit");
-        Gramext.Snterm
-          (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e))],
-Index: camlp4/ocaml_src/meta/q_MLast.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/meta/q_MLast.ml,v
-retrieving revision 1.65
-diff -u -r1.65 q_MLast.ml
---- camlp4/ocaml_src/meta/q_MLast.ml	12 Jan 2006 08:54:21 -0000	1.65
-+++ camlp4/ocaml_src/meta/q_MLast.ml	5 Apr 2006 02:26:01 -0000
-@@ -3152,9 +3152,9 @@
-                  Gramext.action
-                    (fun (x : string)
-                       (_loc : Lexing.position * Lexing.position) ->
--                      (Qast.Str x : 'e__17))])],
-+                      (Qast.Str x : 'e__18))])],
-           Gramext.action
--            (fun (a : 'e__17 option)
-+            (fun (a : 'e__18 option)
-                (_loc : Lexing.position * Lexing.position) ->
-                (Qast.Option a : 'a_opt));
-           [Gramext.Snterm
-@@ -3191,9 +3191,9 @@
-                  Gramext.action
-                    (fun (x : string)
-                       (_loc : Lexing.position * Lexing.position) ->
--                      (Qast.Str x : 'e__16))])],
-+                      (Qast.Str x : 'e__17))])],
-           Gramext.action
--            (fun (a : 'e__16 option)
-+            (fun (a : 'e__17 option)
-                (_loc : Lexing.position * Lexing.position) ->
-                (Qast.Option a : 'a_opt));
-           [Gramext.Snterm
-@@ -3216,9 +3216,9 @@
-                  Gramext.action
-                    (fun (x : string)
-                       (_loc : Lexing.position * Lexing.position) ->
--                      (Qast.Str x : 'e__15))])],
-+                      (Qast.Str x : 'e__16))])],
-           Gramext.action
--            (fun (a : 'e__15 option)
-+            (fun (a : 'e__16 option)
-                (_loc : Lexing.position * Lexing.position) ->
-                (Qast.Option a : 'a_opt));
-           [Gramext.Snterm
-@@ -3235,6 +3235,31 @@
-            (_loc : Lexing.position * Lexing.position) ->
-            (Qast.Node ("CrVal", [Qast.Loc; lab; o2b mf; e]) :
-             'class_str_item));
-+      [Gramext.Stoken ("", "value"); Gramext.Stoken ("", "virtual");
-+       Gramext.srules
-+         [[Gramext.Sopt
-+             (Gramext.srules
-+                [[Gramext.Stoken ("", "mutable")],
-+                 Gramext.action
-+                   (fun (x : string)
-+                      (_loc : Lexing.position * Lexing.position) ->
-+                      (Qast.Str x : 'e__15))])],
-+          Gramext.action
-+            (fun (a : 'e__15 option)
-+               (_loc : Lexing.position * Lexing.position) ->
-+               (Qast.Option a : 'a_opt));
-+          [Gramext.Snterm
-+             (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
-+          Gramext.action
-+            (fun (a : 'a_opt) (_loc : Lexing.position * Lexing.position) ->
-+               (a : 'a_opt))];
-+       Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e));
-+       Gramext.Stoken ("", ":");
-+       Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
-+      Gramext.action
-+        (fun (t : 'ctyp) _ (l : 'label) (mf : 'a_opt) _ _
-+           (_loc : Lexing.position * Lexing.position) ->
-+           (Qast.Node ("CrVvr", [Qast.Loc; l; o2b mf; t]) : 'class_str_item));
-       [Gramext.Stoken ("", "inherit");
-        Gramext.Snterm
-          (Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e));
-@@ -3366,9 +3391,9 @@
-                  Gramext.action
-                    (fun _ (csf : 'class_sig_item)
-                       (_loc : Lexing.position * Lexing.position) ->
--                      (csf : 'e__18))])],
-+                      (csf : 'e__19))])],
-           Gramext.action
--            (fun (a : 'e__18 list)
-+            (fun (a : 'e__19 list)
-                (_loc : Lexing.position * Lexing.position) ->
-                (Qast.List a : 'a_list));
-           [Gramext.Snterm
-@@ -3446,9 +3471,9 @@
-                  Gramext.action
-                    (fun (x : string)
-                       (_loc : Lexing.position * Lexing.position) ->
--                      (Qast.Str x : 'e__22))])],
-+                      (Qast.Str x : 'e__24))])],
-           Gramext.action
--            (fun (a : 'e__22 option)
-+            (fun (a : 'e__24 option)
-                (_loc : Lexing.position * Lexing.position) ->
-                (Qast.Option a : 'a_opt));
-           [Gramext.Snterm
-@@ -3471,9 +3496,9 @@
-                  Gramext.action
-                    (fun (x : string)
-                       (_loc : Lexing.position * Lexing.position) ->
--                      (Qast.Str x : 'e__21))])],
-+                      (Qast.Str x : 'e__23))])],
-           Gramext.action
--            (fun (a : 'e__21 option)
-+            (fun (a : 'e__23 option)
-                (_loc : Lexing.position * Lexing.position) ->
-                (Qast.Option a : 'a_opt));
-           [Gramext.Snterm
-@@ -3496,9 +3521,26 @@
-                  Gramext.action
-                    (fun (x : string)
-                       (_loc : Lexing.position * Lexing.position) ->
--                      (Qast.Str x : 'e__20))])],
-+                      (Qast.Str x : 'e__21))])],
-           Gramext.action
--            (fun (a : 'e__20 option)
-+            (fun (a : 'e__21 option)
-+               (_loc : Lexing.position * Lexing.position) ->
-+               (Qast.Option a : 'a_opt));
-+          [Gramext.Snterm
-+             (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
-+          Gramext.action
-+            (fun (a : 'a_opt) (_loc : Lexing.position * Lexing.position) ->
-+               (a : 'a_opt))];
-+       Gramext.srules
-+         [[Gramext.Sopt
-+             (Gramext.srules
-+                [[Gramext.Stoken ("", "virtual")],
-+                 Gramext.action
-+                   (fun (x : string)
-+                      (_loc : Lexing.position * Lexing.position) ->
-+                      (Qast.Str x : 'e__22))])],
-+          Gramext.action
-+            (fun (a : 'e__22 option)
-                (_loc : Lexing.position * Lexing.position) ->
-                (Qast.Option a : 'a_opt));
-           [Gramext.Snterm
-@@ -3510,9 +3552,10 @@
-        Gramext.Stoken ("", ":");
-        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
-       Gramext.action
--        (fun (t : 'ctyp) _ (l : 'label) (mf : 'a_opt) _
-+        (fun (t : 'ctyp) _ (l : 'label) (vf : 'a_opt) (mf : 'a_opt) _
-            (_loc : Lexing.position * Lexing.position) ->
--           (Qast.Node ("CgVal", [Qast.Loc; l; o2b mf; t]) : 'class_sig_item));
-+           (Qast.Node ("CgVal", [Qast.Loc; l; o2b mf; o2b vf; t]) :
-+            'class_sig_item));
-       [Gramext.Stoken ("", "inherit");
-        Gramext.Snterm
-          (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e))],
-@@ -3531,9 +3574,9 @@
-                  Gramext.action
-                    (fun _ (s : 'class_sig_item)
-                       (_loc : Lexing.position * Lexing.position) ->
--                      (s : 'e__19))])],
-+                      (s : 'e__20))])],
-           Gramext.action
--            (fun (a : 'e__19 list)
-+            (fun (a : 'e__20 list)
-                (_loc : Lexing.position * Lexing.position) ->
-                (Qast.List a : 'a_list));
-           [Gramext.Snterm
-@@ -3556,9 +3599,9 @@
-                  Gramext.action
-                    (fun (x : string)
-                       (_loc : Lexing.position * Lexing.position) ->
--                      (Qast.Str x : 'e__23))])],
-+                      (Qast.Str x : 'e__25))])],
-           Gramext.action
--            (fun (a : 'e__23 option)
-+            (fun (a : 'e__25 option)
-                (_loc : Lexing.position * Lexing.position) ->
-                (Qast.Option a : 'a_opt));
-           [Gramext.Snterm
-@@ -3593,9 +3636,9 @@
-                  Gramext.action
-                    (fun (x : string)
-                       (_loc : Lexing.position * Lexing.position) ->
--                      (Qast.Str x : 'e__24))])],
-+                      (Qast.Str x : 'e__26))])],
-           Gramext.action
--            (fun (a : 'e__24 option)
-+            (fun (a : 'e__26 option)
-                (_loc : Lexing.position * Lexing.position) ->
-                (Qast.Option a : 'a_opt));
-           [Gramext.Snterm
-@@ -3713,9 +3756,9 @@
-                  Gramext.action
-                    (fun (x : string)
-                       (_loc : Lexing.position * Lexing.position) ->
--                      (Qast.Str x : 'e__25))])],
-+                      (Qast.Str x : 'e__27))])],
-           Gramext.action
--            (fun (a : 'e__25 option)
-+            (fun (a : 'e__27 option)
-                (_loc : Lexing.position * Lexing.position) ->
-                (Qast.Option a : 'a_opt));
-           [Gramext.Snterm
-@@ -3922,9 +3965,9 @@
-                  Gramext.action
-                    (fun (x : string)
-                       (_loc : Lexing.position * Lexing.position) ->
--                      (Qast.Str x : 'e__26))])],
-+                      (Qast.Str x : 'e__28))])],
-           Gramext.action
--            (fun (a : 'e__26 option)
-+            (fun (a : 'e__28 option)
-                (_loc : Lexing.position * Lexing.position) ->
-                (Qast.Option a : 'a_opt));
-           [Gramext.Snterm
-@@ -4390,9 +4433,9 @@
-                  Gramext.action
-                    (fun _ (e : 'expr)
-                       (_loc : Lexing.position * Lexing.position) ->
--                      (e : 'e__29))])],
-+                      (e : 'e__31))])],
-           Gramext.action
--            (fun (a : 'e__29 list)
-+            (fun (a : 'e__31 list)
-                (_loc : Lexing.position * Lexing.position) ->
-                (Qast.List a : 'a_list));
-           [Gramext.Snterm
-@@ -4425,9 +4468,9 @@
-                  Gramext.action
-                    (fun _ (e : 'expr)
-                       (_loc : Lexing.position * Lexing.position) ->
--                      (e : 'e__28))])],
-+                      (e : 'e__30))])],
-           Gramext.action
--            (fun (a : 'e__28 list)
-+            (fun (a : 'e__30 list)
-                (_loc : Lexing.position * Lexing.position) ->
-                (Qast.List a : 'a_list));
-           [Gramext.Snterm
-@@ -4454,9 +4497,9 @@
-                  Gramext.action
-                    (fun _ (e : 'expr)
-                       (_loc : Lexing.position * Lexing.position) ->
--                      (e : 'e__27))])],
-+                      (e : 'e__29))])],
-           Gramext.action
--            (fun (a : 'e__27 list)
-+            (fun (a : 'e__29 list)
-                (_loc : Lexing.position * Lexing.position) ->
-                (Qast.List a : 'a_list));
-           [Gramext.Snterm
-@@ -4547,9 +4590,9 @@
-                  Gramext.action
-                    (fun _ (cf : 'class_str_item)
-                       (_loc : Lexing.position * Lexing.position) ->
--                      (cf : 'e__30))])],
-+                      (cf : 'e__32))])],
-           Gramext.action
--            (fun (a : 'e__30 list)
-+            (fun (a : 'e__32 list)
-                (_loc : Lexing.position * Lexing.position) ->
-                (Qast.List a : 'a_list));
-           [Gramext.Snterm
-@@ -4592,9 +4635,9 @@
-                  Gramext.action
-                    (fun _ (csf : 'class_sig_item)
-                       (_loc : Lexing.position * Lexing.position) ->
--                      (csf : 'e__32))])],
-+                      (csf : 'e__34))])],
-           Gramext.action
--            (fun (a : 'e__32 list)
-+            (fun (a : 'e__34 list)
-                (_loc : Lexing.position * Lexing.position) ->
-                (Qast.List a : 'a_list));
-           [Gramext.Snterm
-@@ -4623,9 +4666,9 @@
-                  Gramext.action
-                    (fun _ (csf : 'class_sig_item)
-                       (_loc : Lexing.position * Lexing.position) ->
--                      (csf : 'e__31))])],
-+                      (csf : 'e__33))])],
-           Gramext.action
--            (fun (a : 'e__31 list)
-+            (fun (a : 'e__33 list)
-                (_loc : Lexing.position * Lexing.position) ->
-                (Qast.List a : 'a_list));
-           [Gramext.Snterm
-Index: camlp4/top/rprint.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/camlp4/top/rprint.ml,v
-retrieving revision 1.18
-diff -u -r1.18 rprint.ml
---- camlp4/top/rprint.ml	29 Jun 2005 04:11:26 -0000	1.18
-+++ camlp4/top/rprint.ml	5 Apr 2006 02:26:01 -0000
-@@ -288,8 +288,9 @@
-       fprintf ppf "@[<2>method %s%s%s :@ %a;@]"
-         (if priv then "private " else "") (if virt then "virtual " else "")
-         name Toploop.print_out_type.val ty
--  | Ocsg_value name mut ty ->
--      fprintf ppf "@[<2>value %s%s :@ %a;@]" (if mut then "mutable " else "")
-+  | Ocsg_value name mut virt ty ->
-+      fprintf ppf "@[<2>value %s%s%s :@ %a;@]"
-+        (if mut then "mutable " else "") (if virt then "virtual " else "")
-         name Toploop.print_out_type.val ty ]
- ;
- 
diff -Nru ocaml-3.12.1/testlabl/varunion.ml ocaml-4.01.0/testlabl/varunion.ml
--- ocaml-3.12.1/testlabl/varunion.ml	2007-10-18 02:51:39.000000000 +0000
+++ ocaml-4.01.0/testlabl/varunion.ml	1970-01-01 00:00:00.000000000 +0000
@@ -1,435 +0,0 @@
-(* cvs update -r varunion parsing typing bytecomp toplevel *)
-
-type t = private [> ];;
-type u = private [> ] ~ [t];;
-type v = [t | u];;
-let f x = (x : t :> v);;
-
-(* bad *)
-module Mix(X: sig type t = private [> ] end)
-    (Y: sig type t = private [> ] end) =
-  struct type t = [X.t | Y.t] end;;
-
-(* bad *)
-module Mix(X: sig type t = private [> `A of int ] end)
-    (Y: sig type t = private [> `A of bool] ~ [X.t] end) =
-  struct type t = [X.t | Y.t] end;;
-
-(* ok *)
-module Mix(X: sig type t = private [> `A of int ] end)
-    (Y: sig type t = private [> `A of int] ~ [X.t] end) =
-  struct type t = [X.t | Y.t] end;;
-
-(* bad *)
-module Mix(X: sig type t = private [> `A of int ] end)
-    (Y: sig type t = private [> `B of bool] ~ [X.t] end) =
-  struct type t = [X.t | Y.t] end;;
-
-type 'a t = private [> `L of 'a] ~ [`L];;
-
-(* ok *)
-module Mix(X: sig type t = private [> `A of int ] ~ [`B] end)
-    (Y: sig type t = private [> `B of bool] ~ [X.t] end) =
-  struct type t = [X.t | Y.t] let is_t = function #t -> true | _ -> false end;;
-
-module Mix(X: sig type t = private [> `A of int ] ~ [`B] end)
-    (Y: sig type t = private [> `B of bool] ~ [X.t] end) =
-  struct
-    type t = [X.t | Y.t]
-    let which = function #X.t -> `X | #Y.t -> `Y
-  end;;
-
-module Mix(I: sig type t = private [> ] ~ [`A;`B] end)
-    (X: sig type t = private [> I.t | `A of int ] ~ [`B] end)
-    (Y: sig type t = private [> I.t | `B of bool] ~ [X.t] end) =
-  struct
-    type t = [X.t | Y.t]
-    let which = function #X.t -> `X | #Y.t -> `Y
-  end;;
-
-(* ok *)
-module M =
-  Mix(struct type t = [`C of char] end)
-    (struct type t = [`A of int | `C of char] end)
-    (struct type t = [`B of bool | `C of char] end);;
-
-(* bad *)
-module M =
-  Mix(struct type t = [`B of bool] end)
-    (struct type t = [`A of int | `B of bool] end)
-    (struct type t = [`B of bool | `C of char] end);;
-
-(* ok *)
-module M1 = struct type t = [`A of int | `C of char] end
-module M2 = struct type t = [`B of bool | `C of char] end
-module I = struct type t = [`C of char] end
-module M = Mix(I)(M1)(M2) ;;
-
-let c = (`C 'c' : M.t) ;;
-
-module M(X : sig type t = private [> `A] end) = 
-  struct let f (#X.t as x) = x end;;
-
-(* code generation *)
-type t = private [> `A ] ~ [`B];;
-match `B with #t -> 1 | `B -> 2;;
-
-module M : sig type t = private [> `A of int | `B] ~ [`C] end =
-  struct type t = [`A of int | `B | `D of bool] end;;
-let f = function (`C | #M.t) -> 1+1 ;;
-let f = function (`A _ | `B #M.t) -> 1+1 ;;
-
-(* expression *)
-module Mix(X:sig type t = private [> ] val show: t -> string end)
-    (Y:sig type t = private [> ] ~ [X.t] val show: t -> string end) =
-  struct
-    type t = [X.t | Y.t]
-    let show : t -> string = function
-        #X.t as x -> X.show x
-      | #Y.t as y -> Y.show y
-  end;;
-
-module EStr = struct
-  type t = [`Str of string]
-  let show (`Str s) = s
-end
-module EInt = struct
-  type t = [`Int of int]
-  let show (`Int i) = string_of_int i
-end
-module M = Mix(EStr)(EInt);;
-
-module type T = sig type t = private [> ] val show: t -> string end
-module Mix(X:T)(Y:T with type t = private [> ] ~ [X.t]) :
-    T with type t = [X.t | Y.t] =
-  struct
-    type t = [X.t | Y.t]
-    let show = function
-        #X.t as x -> X.show x
-      | #Y.t as y -> Y.show y
-  end;;
-module M = Mix(EStr)(EInt);;
-
-(* deep *)
-module M : sig type t = private [> `A] end = struct type t = [`A] end
-module M' : sig type t = private [> ] end = struct type t = [M.t | `A] end;;
-
-(* bad *)
-type t = private [> ]
-type u = private [> `A of int] ~ [t] ;;
-
-(* ok *)
-type t = private [> `A of int]
-type u = private [> `A of int] ~ [t] ;;
-
-module F(X: sig
-  type t = private [> ] ~ [`A;`B;`C;`D]
-  type u = private [> `A|`B|`C] ~ [t; `D]
-end) : sig type v = private [< X.t | X.u | `D] end = struct
-  open X
-  let f = function #u -> 1 | #t -> 2 | `D -> 3
-  let g = function #u|#t|`D -> 2 
-  type v = [t|u|`D]
-end
-
-(* ok *)
-module M = struct type t = private [> `A] end;;
-module M' : sig type t = private [> ] ~ [`A] end = M;;
-
-(* ok *)
-module type T = sig type t = private [> ] ~ [`A] end;;
-module type T' = T with type t = private [> `A];;
-
-(* ok *)
-type t = private [> ] ~ [`A]
-let f = function `A x -> x | #t -> 0
-type t' = private [< `A of int | t];;
-
-(* should be ok *)
-module F(X:sig end) :
-    sig type t = private [> ] type u = private [> ] ~ [t] end =
-  struct type t = [ `A] type u = [`B] end
-module M = F(String)
-let f = function #M.t -> 1 | #M.u -> 2
-let f = function #M.t -> 1 | _ -> 2
-type t = [M.t | M.u]
-let f = function #t -> 1 | _ -> 2;;
-module G(X : sig type t = private [> ] type u = private [> ] ~ [t] end) =
-  struct let f = function #X.t -> 1 | _ -> 2 end;;
-module M1 = G(struct module N = F(String) type t = N.t type u = N.u end) ;;
-module M1 = G(struct type t = M.t type u = M.u end) ;;
-(* bad *)
-let f = function #F(String).t -> 1 | _ -> 2;;
-type t = [F(String).t | M.u]
-let f = function #t -> 1 | _ -> 2;;
-module N : sig type t = private [> ] end =
-  struct type t = [F(String).t | M.u] end;;
-
-(* compatibility improvement *)
-type a = [`A of int | `B]
-type b = [`A of bool | `B]
-type c = private [> ] ~ [a;b]
-let f = function #c -> 1 | `A x -> truncate x
-type d = private [> ] ~ [a]
-let g = function #d -> 1 | `A x -> truncate x;;
-
-
-(* Expression Problem: functorial form *)
-
-type num = [ `Num of int ]
-
-module type Exp = sig
-  type t = private [> num]
-  val eval : t -> t
-  val show : t -> string
-end
-
-module Num(X : Exp) = struct
-  type t = num
-  let eval (`Num _ as x) : X.t = x
-  let show (`Num n) = string_of_int n
-end
-
-type 'a add = [ `Add of 'a * 'a ]
-
-module Add(X : Exp with type t = private [> num | 'a add] as 'a) = struct
-  type t = X.t add
-  let show (`Add(e1, e2) : t) = "("^ X.show e1 ^"+"^ X.show e2 ^")"
-  let eval (`Add(e1, e2) : t) =
-    let e1 = X.eval e1 and e2 = X.eval e2 in
-    match e1, e2 with
-      `Num n1, `Num n2 -> `Num (n1+n2)
-    | `Num 0, e | e, `Num 0 -> e
-    | e12 -> `Add e12
-end 
-
-type 'a mul = [`Mul of 'a * 'a]
-
-module Mul(X : Exp with type t = private [> num | 'a mul] as 'a) = struct
-  type t = X.t mul
-  let show (`Mul(e1, e2) : t) = "("^ X.show e1 ^"*"^ X.show e2 ^")"
-  let eval (`Mul(e1, e2) : t) =
-    let e1 = X.eval e1 and e2 = X.eval e2 in
-    match e1, e2 with
-      `Num n1, `Num n2 -> `Num (n1*n2)
-    | `Num 0, e | e, `Num 0 -> `Num 0
-    | `Num 1, e | e, `Num 1 -> e
-    | e12 -> `Mul e12
-end
-
-module Ext(X : sig type t = private [> ] end)(Y : sig type t end) = struct
-  module type S =
-    sig
-      type t = private [> ] ~ [ X.t ]
-      val eval : t -> Y.t
-      val show : t -> string
-    end
-end
-
-module Dummy = struct type t = [`Dummy] end
-
-module Mix(E : Exp)(E1 : Ext(Dummy)(E).S)(E2 : Ext(E1)(E).S) =
-  struct
-    type t = [E1.t | E2.t]
-    let eval = function
-        #E1.t as x -> E1.eval x
-      | #E2.t as x -> E2.eval x
-    let show = function
-        #E1.t as x -> E1.show x
-      | #E2.t as x -> E2.show x
-  end
-
-module rec EAdd : (Exp with type t = [num | EAdd.t add]) =
-    Mix(EAdd)(Num(EAdd))(Add(EAdd))
-
-(* A bit heavy: one must pass E to everybody *)
-module rec E : Exp with type t = [num | E.t add | E.t mul] =
-    Mix(E)(Mix(E)(Num(E))(Add(E)))(Mul(E))
-
-let e = E.eval (`Add(`Mul(`Num 2,`Num 3),`Num 1))
-
-(* Alternatives *)
-(* Direct approach, no need of Mix *)
-module rec E : (Exp with type t = [num | E.t add | E.t mul]) =
-  struct
-    module E1 = Num(E)
-    module E2 = Add(E)
-    module E3 = Mul(E)
-    type t = E.t
-    let show = function
-      | #num as x -> E1.show x
-      | #add as x -> E2.show x
-      | #mul as x -> E3.show x
-    let eval = function
-      | #num as x -> E1.eval x
-      | #add as x -> E2.eval x
-      | #mul as x -> E3.eval x
-  end
-
-(* Do functor applications in Mix *)
-module type T = sig type t = private [> ] end
-module type Tnum = sig type t = private [> num] end
-
-module Ext(E : Tnum) = struct
-  module type S = functor (Y : Exp with type t = E.t) ->
-    sig
-      type t = private [> num]
-      val eval : t -> Y.t
-      val show : t -> string
-    end
-end
-
-module Ext'(E : Tnum)(X : T) = struct
-  module type S = functor (Y : Exp with type t = E.t) ->
-    sig
-      type t = private [> ] ~ [ X.t ]
-      val eval : t -> Y.t
-      val show : t -> string
-    end
-end
-
-module Mix(E : Exp)(F1 : Ext(E).S)(F2 : Ext'(E)(F1(E)).S) =
-  struct
-    module E1 = F1(E)
-    module E2 = F2(E)
-    type t = [E1.t | E2.t]
-    let eval = function
-        #E1.t as x -> E1.eval x
-      | #E2.t as x -> E2.eval x
-    let show = function
-        #E1.t as x -> E1.show x
-      | #E2.t as x -> E2.show x
-  end
-
-module Join(E : Exp)(F1 : Ext(E).S)(F2 : Ext'(E)(F1(E)).S)
-    (E' : Exp with type t = E.t) =
-  Mix(E)(F1)(F2)
-
-module rec EAdd : (Exp with type t = [num | EAdd.t add]) =
-  Mix(EAdd)(Num)(Add)
-
-module rec EMul : (Exp with type t = [num | EMul.t mul]) =
-  Mix(EMul)(Num)(Mul)
-
-module rec E : (Exp with type t = [num | E.t add | E.t mul]) =
-  Mix(E)(Join(E)(Num)(Add))(Mul)
-
-(* Linear extension by the end: not so nice *)
-module LExt(X : T) = struct
-  module type S =
-    sig
-      type t
-      val eval : t -> X.t
-      val show : t -> string
-    end
-end
-module LNum(E: Exp)(X : LExt(E).S with type t = private [> ] ~ [num]) =
-  struct
-    type t = [num | X.t]
-    let show = function
-        `Num n -> string_of_int n
-      | #X.t as x -> X.show x
-    let eval = function
-        #num as x -> x
-      | #X.t as x -> X.eval x
-  end
-module LAdd(E : Exp with type t = private [> num | 'a add] as 'a)
-    (X : LExt(E).S with type t = private [> ] ~ [add]) =
-  struct
-    type t = [E.t add | X.t]
-    let show = function
-        `Add(e1,e2) -> "("^ E.show e1 ^"+"^ E.show e2 ^")"
-      | #X.t as x -> X.show x
-    let eval = function
-        `Add(e1,e2) ->
-          let e1 = E.eval e1 and e2 = E.eval e2 in
-          begin match e1, e2 with
-            `Num n1, `Num n2 -> `Num (n1+n2)
-          | `Num 0, e | e, `Num 0 -> e
-          | e12 -> `Add e12
-          end
-      | #X.t as x -> X.eval x
-  end
-module LEnd = struct
-  type t = [`Dummy]
-  let show `Dummy = ""
-  let eval `Dummy = `Dummy
-end
-module rec L : Exp with type t = [num | L.t add | `Dummy] =
-    LAdd(L)(LNum(L)(LEnd))
-
-(* Back to first form, but add map *)
-
-module Num(X : Exp) = struct
-  type t = num
-  let map f x = x
-  let eval1 (`Num _ as x) : X.t = x
-  let show (`Num n) = string_of_int n
-end
-
-module Add(X : Exp with type t = private [> num | 'a add] as 'a) = struct
-  type t = X.t add
-  let show (`Add(e1, e2) : t) = "("^ X.show e1 ^"+"^ X.show e2 ^")"
-  let map f (`Add(e1, e2) : t) = `Add(f e1, f e2)
-  let eval1 (`Add(e1, e2) as e : t) =
-    match e1, e2 with
-      `Num n1, `Num n2 -> `Num (n1+n2)
-    | `Num 0, e | e, `Num 0 -> e
-    | _ -> e
-end 
-
-module Mul(X : Exp with type t = private [> num | 'a mul] as 'a) = struct
-  type t = X.t mul
-  let show (`Mul(e1, e2) : t) = "("^ X.show e1 ^"*"^ X.show e2 ^")"
-  let map f (`Mul(e1, e2) : t) = `Mul(f e1, f e2)
-  let eval1 (`Mul(e1, e2) as e : t) =
-    match e1, e2 with
-      `Num n1, `Num n2 -> `Num (n1*n2)
-    | `Num 0, e | e, `Num 0 -> `Num 0
-    | `Num 1, e | e, `Num 1 -> e
-    | _ -> e
-end
-
-module Ext(X : sig type t = private [> ] end)(Y : sig type t end) = struct
-  module type S =
-    sig
-      type t = private [> ] ~ [ X.t ]
-      val map  : (Y.t -> Y.t) -> t -> t
-      val eval1 : t -> Y.t
-      val show : t -> string
-    end
-end
-
-module Mix(E : Exp)(E1 : Ext(Dummy)(E).S)(E2 : Ext(E1)(E).S) =
-  struct
-    type t = [E1.t | E2.t]
-    let map f = function
-        #E1.t as x -> (E1.map f x : E1.t :> t)
-      | #E2.t as x -> (E2.map f x : E2.t :> t)
-    let eval1 = function
-        #E1.t as x -> E1.eval1 x
-      | #E2.t as x -> E2.eval1 x
-    let show = function
-        #E1.t as x -> E1.show x
-      | #E2.t as x -> E2.show x
-  end
-
-module type ET = sig
-  type t
-  val map  : (t -> t) -> t -> t
-  val eval1 : t -> t
-  val show : t -> string
-end
-
-module Fin(E : ET) = struct
-  include E
-  let rec eval e = eval1 (map eval e)
-end
-
-module rec EAdd : (Exp with type t = [num | EAdd.t add]) =
-    Fin(Mix(EAdd)(Num(EAdd))(Add(EAdd)))
-
-module rec E : Exp with type t = [num | E.t add | E.t mul] =
-    Fin(Mix(E)(Mix(E)(Num(E))(Add(E)))(Mul(E)))
-
-let e = E.eval (`Add(`Mul(`Num 2,`Num 3),`Num 1))
diff -Nru ocaml-3.12.1/testsuite/.ignore ocaml-4.01.0/testsuite/.ignore
--- ocaml-3.12.1/testsuite/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/.ignore	2012-07-17 15:31:12.000000000 +0000
@@ -0,0 +1 @@
+_log
diff -Nru ocaml-3.12.1/testsuite/.svnignore ocaml-4.01.0/testsuite/.svnignore
--- ocaml-3.12.1/testsuite/.svnignore	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/.svnignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,9 +0,0 @@
-# svn propset -R svn:ignore -F .svnignore .
-# find . -name .svnignore -print | while read f; do svn propset svn:ignore -F $f `dirname $f`; done
-_log
-*.so
-*.a
-*.result
-*.byte
-*.native
-program
diff -Nru ocaml-3.12.1/testsuite/Makefile ocaml-4.01.0/testsuite/Makefile
--- ocaml-3.12.1/testsuite/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/Makefile	2013-05-29 16:45:07.000000000 +0000
@@ -1,65 +1,103 @@
-# $Id: Makefile 10713 2010-10-08 11:53:19Z doligez $
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
 
 BASEDIR=${PWD}
-NO_PRINT=`($(MAKE) empty --no-print-directory > /dev/null 2>&1) && echo '--no-print-directory' || echo ''`
+NO_PRINT=`$(MAKE) empty --no-print-directory >/dev/null 2>&1 && echo '--no-print-directory'`
 
+FIND=find
+include ../config/Makefile
+
+.PHONY: default
 default:
 	@echo "Available targets:"
-	@echo "  all           launches all tests"
-	@echo "  list FILE=f   launches the tests referenced in file f (one path per line)"
-	@echo "  one DIR=p     launches the tests located in path p"
-	@echo "  lib           builds library modules"
-	@echo "  clean         deletes generated files"
-	@echo "  report        prints the report for the last execution, if any"
+	@echo "  all             launch all tests"
+	@echo "  list FILE=f     launch the tests referenced in file f (one path per line)"
+	@echo "  one DIR=p       launch the tests located in path p"
+	@echo "  promote DIR=p   promote the reference files for the tests located in path p"
+	@echo "  lib             build library modules"
+	@echo "  clean           delete generated files"
+	@echo "  report          print the report for the last execution, if any"
 
+.PHONY: all
 all: lib
 	@for dir in tests/*; do \
 	  $(MAKE) $(NO_PRINT) exec-one DIR=$$dir; \
 	done 2>&1 | tee _log
 	@$(MAKE) report
 
+.PHONY: list
 list: lib
-	@if [ -z $(FILE) ]; then echo "No value set for variable 'FILE'."; exit 1; fi
-	@if [ ! -f $(FILE) ]; then echo "File '$(FILE)' does not exist."; exit 1; fi
+	@if [ -z "$(FILE)" ]; \
+	  then echo "No value set for variable 'FILE'."; \
+	  exit 1; \
+	fi
 	@while read LINE; do \
 	  $(MAKE) $(NO_PRINT) exec-one DIR=$$LINE; \
-	done < $(FILE) 2>&1 | tee _log
+	done <$(FILE) 2>&1 | tee _log
 	@$(MAKE) report
 
+.PHONY: one
 one: lib
-	@if [ -z $(DIR) ]; then echo "No value set for variable 'DIR'."; exit 1; fi
-	@if [ ! -d $(DIR) ]; then echo "Directory '$(DIR)' does not exist."; exit 1; fi
+	@if [ -z "$(DIR)" ]; then \
+	  echo "No value set for variable 'DIR'."; \
+	  exit 1; \
+	fi
+	@if [ ! -d $(DIR) ]; then \
+	  echo "Directory '$(DIR)' does not exist."; \
+	  exit 1; \
+	fi
 	@$(MAKE) $(NO_PRINT) exec-one DIR=$(DIR)
 
+.PHONY: exec-one
 exec-one:
-	@echo "Running tests from '$$DIR' ..."
-	@(cd $(DIR) && $(MAKE) TERM=dumb BASEDIR=$(BASEDIR) && cd ../..)
-
-lib: FORCE
-	@(cd lib && $(MAKE) -s BASEDIR=$(BASEDIR) && cd ..)
-
-clean: FORCE
-	@(cd lib && $(MAKE) BASEDIR=$(BASEDIR) clean && cd ..)
-	@for file in tests/*; do \
-	  if [ -d $$file ]; then \
-	    (cd $$file && $(MAKE) BASEDIR=$(BASEDIR) clean && cd ../..); \
-	  fi \
-	done
-	@for file in interactive/*; do \
-	  if [ -d $$file ]; then \
-	    (cd $$file && $(MAKE) BASEDIR=$(BASEDIR) clean && cd ../..); \
-	  fi \
+	@if [ ! -f $(DIR)/Makefile ]; then \
+	  for dir in $(DIR)/*; do \
+	    if [ -d $$dir ]; then \
+	      $(MAKE) exec-one DIR=$$dir; \
+	    fi; \
+	  done; \
+	else \
+	  echo "Running tests from '$$DIR' ..."; \
+	  cd $(DIR) && \
+	  $(MAKE) TERM=dumb BASEDIR=$(BASEDIR) || echo '=> unexpected error'; \
+	fi
+
+.PHONY: promote
+promote:
+	@if [ -z "$(DIR)" ]; then \
+	  echo "No value set for variable 'DIR'."; \
+	  exit 1; \
+	fi
+	@if [ ! -d $(DIR) ]; then \
+	  echo "Directory '$(DIR)' does not exist."; \
+	  exit 1; \
+	fi
+	@cd $(DIR) && $(MAKE) TERM=dumb BASEDIR=$(BASEDIR) promote
+
+.PHONY: lib
+lib:
+	@cd lib && $(MAKE) -s BASEDIR=$(BASEDIR)
+
+.PHONY: clean
+clean:
+	@cd lib && $(MAKE) BASEDIR=$(BASEDIR) clean
+	@for file in `$(FIND) interactive tests -name Makefile`; do \
+	  (cd `dirname $$file` && $(MAKE) BASEDIR=$(BASEDIR) clean); \
 	done
 
-report: FORCE
+.PHONY: report
+report:
 	@if [ ! -f _log ]; then echo "No '_log' file."; exit 1; fi
-	@echo ''
-	@echo 'Summary:'
-	@echo '  ' `grep 'passed$$' _log | wc -l` 'test(s) passed'
-	@echo '  ' `grep 'failed$$' _log | wc -l` 'test(s) failed'
-	@echo '  ' `grep '^Error' _log | wc -l` 'compilation error(s)'
-	@echo '  ' `grep '^Warning' _log | wc -l` 'compilation warning(s)'
-
-empty: FORCE
+	@awk -f makefiles/summarize.awk <_log
 
-FORCE:
+.PHONY: empty
+empty:
diff -Nru ocaml-3.12.1/testsuite/external/.ignore ocaml-4.01.0/testsuite/external/.ignore
--- ocaml-3.12.1/testsuite/external/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/.ignore	2013-09-11 13:44:47.000000000 +0000
@@ -0,0 +1,146 @@
+*.tar.gz
+*.tar.bz2
+*.tgz
+*.tbz
+*.zip
+
+log-*
+log_*
+
+advi
+advi-1.10.2
+altergo
+alt-ergo-0.95
+binprot
+bin_prot-109.30.00
+bitstring
+ocaml-bitstring-2.0.3
+boomerang
+boomerang-0.2
+calendar
+calendar-2.03.2
+camlimages
+camlimages-4.0.1
+camlpdf
+camlpdf-0.5
+camlp5
+camlp5-6.10
+camlzip
+camlzip-1.04
+camomile
+camomile-0.8.4
+comparelib
+comparelib-109.15.00
+compcert
+compcert-1.13
+configfile
+config-file-1.1
+coq
+coq-8.4pl1
+core
+core-109.37.00
+coreextended
+core_extended-109.36.00
+corekernel
+core_kernel-109.37.00
+cryptokit
+cryptokit-1.6
+customprintf
+custom_printf-109.27.00
+dbm
+camldbm-1.0
+expect
+ocaml-expect-0.0.3
+extlib
+extlib-1.5.2
+fieldslib
+fieldslib-109.15.00
+fileutils
+ocaml-fileutils-0.4.4
+findlib
+findlib-1.3.3
+framac
+frama-c-Oxygen-20120901
+geneweb
+gw-6.05-src
+herelib
+herelib-109.35.00
+hevea
+hevea-2.09
+kaputt
+kaputt-1.2
+lablgtk
+lablgtk-2.16.0
+lablgtkextras
+lablgtkextras-1.3
+lwt
+lwt-2.4.0
+menhir
+menhir-20120123
+mldonkey
+mldonkey-3.1.2
+mysql
+ocaml-mysql-1.0.4
+oasis
+oasis-0.3.0
+obrowser
+obrowser-1.1.1
+ocamlgraph
+ocamlgraph-1.8.2
+ocamlify
+ocamlify-0.0.1
+ocamlmod
+ocamlmod-0.0.3
+ocamlnet
+ocamlnet-3.5.1
+ocamlscript
+ocamlscript-2.0.3
+ocamlssl
+ocaml-ssl-0.4.6
+ocamltext
+ocaml-text-0.5
+ocgi
+ocgi-0.5
+ocsigen
+ocsigen-bundle-2.2.2
+odn
+ocaml-data-notation-0.0.10
+omake
+omake-0.9.8.6
+ounit
+ounit-1.1.2
+paounit
+pa_ounit-109.36.00
+pcre
+pcre-ocaml-6.2.5
+pipebang
+pipebang-109.28.00
+react
+react-0.9.3
+res
+res-3.2.0
+rss
+ocamlrss-2.2.2
+sexplib
+sexplib-109.15.00
+sks
+sks-1.1.3
+sqlite
+sqlite3-ocaml-2.0.1
+textutils
+textutils-109.36.00
+typeconv
+type_conv-109.28.00
+unison
+unison-2.45.4
+variantslib
+variantslib-109.15.00
+vsyml
+vsyml-2010-04-06
+xmllight
+xml-light-2.2
+xmlm
+xmlm-1.1.0
+zen
+zen_2.3.2
+._ZEN_2.3.2
diff -Nru ocaml-3.12.1/testsuite/external/Makefile ocaml-4.01.0/testsuite/external/Makefile
--- ocaml-3.12.1/testsuite/external/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/Makefile	2013-09-11 13:44:47.000000000 +0000
@@ -0,0 +1,1676 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#           Damien Doligez, projet Gallium, INRIA Rocquencourt          #
+#                                                                       #
+#   Copyright 2012 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+# To use this test set, you need OCaml installed in a directory where
+# you have write rights.
+
+# Warning: use of this Makefile will install lots of software
+# in the same place where OCaml is installed.
+
+# It is recommended that you install OCaml in some isolated
+# directory D (for example /usr/local/ocaml/test), add D/bin
+# at the front of your PATH, then use this Makefile to test
+# your OCaml installation.
+
+WGET = wget --no-check-certificate --progress=dot:mega
+
+PREFIX = "`ocamlc -where | sed -e 's|/[^/]*/[^/]*$$||'`"
+VERSION = `ocamlc -vnum`
+
+.PHONY: default
+default:
+	@printf "\n\n########## Starting make at " >>log-${VERSION}
+	@date >>log-${VERSION}
+	${MAKE} platform >>log-${VERSION} 2>&1
+	@printf '\n'
+	mv log-${VERSION} log_${VERSION}_`date -u '+%Y-%m-%d:%H:%M:%S'`
+
+# Platform-dependent subsets: add your own here.
+
+.PHONY: all-cygwin
+all-cygwin: findlib ounit res pcre react ocamltext ocamlssl camlzip cryptokit \
+            sqlite ocgi xmllight configfile xmlm omake \
+            camomile zen vsyml extlib fileutils ocamlify ocamlmod \
+            calendar dbm ocamlscript camlp5 geneweb coq
+
+all-macos: findlib lablgtk ocamlgraph ounit res pcre core react ocamltext \
+           ocamlssl lwt camlzip cryptokit sqlite menhir obrowser hevea \
+           unison ocgi xmllight configfile xmlm lablgtkextras sks omake \
+           altergo boomerang camomile zen vsyml ocamlnet extlib fileutils \
+           odn ocamlify expect ocamlmod oasis calendar camlimages advi \
+           dbm ocsigen ocamlscript camlp5 geneweb coq framac
+
+platform:
+	case `uname -s` in \
+	  CYGWIN*) ${MAKE} all-cygwin;; \
+	  Darwin) ${MAKE} all-macos;; \
+	  *) ${MAKE} all;; \
+	esac
+
+# http://projects.camlcity.org/projects/findlib.html
+FINDLIB=findlib-1.3.3
+${FINDLIB}.tar.gz:
+	${WGET} http://download.camlcity.org/download/$@
+findlib: ${FINDLIB}.tar.gz
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${FINDLIB}
+	tar zxf ${FINDLIB}.tar.gz
+	./Patcher.sh ${FINDLIB}
+	( cd ${FINDLIB} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ./configure && \
+	  ${MAKE} all && \
+	  ${MAKE} opt && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${FINDLIB} findlib
+distclean::
+	rm -f ${FINDLIB}.tar.gz
+all: findlib
+
+# http://lablgtk.forge.ocamlcore.org/
+LABLGTK=lablgtk-2.16.0
+${LABLGTK}.tar.gz:
+	${WGET} https://forge.ocamlcore.org/frs/download.php/561/$@
+lablgtk: ${LABLGTK}.tar.gz findlib # TODO: add lablgl
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${LABLGTK}
+	tar zxf ${LABLGTK}.tar.gz
+	./Patcher.sh ${LABLGTK}
+	( cd ${LABLGTK} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ./configure -prefix ${PREFIX} && \
+	  ${MAKE} world && \
+	  ocamlfind remove lablgtk2 && \
+	  ${MAKE} install && \
+	  rm -f ${PREFIX}/lib/ocaml/lablgtk2 && \
+	  ln -f -s ${PREFIX}/lib/ocaml/site-lib/lablgtk2 \
+	           ${PREFIX}/lib/ocaml/lablgtk2 )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${LABLGTK} lablgtk
+distclean::
+	rm -f ${LABLGTK}.tar.gz
+all: lablgtk
+
+# http://ocamlgraph.lri.fr/
+OCAMLGRAPH=ocamlgraph-1.8.2
+${OCAMLGRAPH}.tar.gz:
+	${WGET} http://ocamlgraph.lri.fr/download/$@
+ocamlgraph: ${OCAMLGRAPH}.tar.gz findlib lablgtk
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${OCAMLGRAPH}
+	tar zxf ${OCAMLGRAPH}.tar.gz
+	./Patcher.sh ${OCAMLGRAPH}
+	( cd ${OCAMLGRAPH} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ./configure -prefix ${PREFIX} && \
+	  ${MAKE} && \
+	  rm -rf ${PREFIX}/lib/ocaml/ocamlgraph && \
+	  ocamlfind remove ocamlgraph && \
+	  ${MAKE} install install-findlib && \
+	  ln -s ${PREFIX}/lib/ocaml/site-lib/ocamlgraph \
+	        ${PREFIX}/lib/ocaml/ocamlgraph )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${OCAMLGRAPH} ocamlgraph
+distclean::
+	rm -f ${OCAMLGRAPH}.tar.gz
+all: ocamlgraph
+
+# http://ounit.forge.ocamlcore.org/
+OUNIT=ounit-1.1.2
+${OUNIT}.tar.gz:
+	${WGET} http://forge.ocamlcore.org/frs/download.php/886/$@
+ounit: ${OUNIT}.tar.gz findlib
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${OUNIT}
+	tar zxf ${OUNIT}.tar.gz
+	./Patcher.sh ${OUNIT}
+	( cd ${OUNIT} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ${MAKE} && \
+	  ocamlfind remove oUnit && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${OUNIT} ounit
+distclean::
+	rm -f ${OUNIT}.tar.gz
+all: ounit
+
+# https://bitbucket.org/mmottl/res
+RES=res-3.2.0
+${RES}.tar.gz:
+	${WGET} https://bitbucket.org/mmottl/res/downloads/$@
+res: ${RES}.tar.gz findlib
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${RES}
+	tar zxf ${RES}.tar.gz
+	./Patcher.sh ${RES}
+	( cd ${RES} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ${MAKE} && \
+	  ocamlfind remove res && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${RES} res
+distclean::
+	rm -f ${RES}.tar.gz
+all: res
+
+# https://bitbucket.org/mmottl/pcre-ocaml
+PCRE=pcre-ocaml-6.2.5
+${PCRE}.tar.gz:
+	${WGET} https://bitbucket.org/mmottl/pcre-ocaml/downloads/$@
+pcre: ${PCRE}.tar.gz findlib
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${PCRE}
+	tar zxf ${PCRE}.tar.gz
+	./Patcher.sh ${PCRE}
+	( cd ${PCRE} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ${MAKE} && \
+	  ocamlfind remove pcre && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${PCRE} pcre
+distclean::
+	rm -f ${PCRE}.tar.gz
+all: pcre
+
+###########################################################################
+
+## Jane Street Core
+
+# https://ocaml.janestreet.com/ocaml-core/109.28.00/individual/
+TYPECONV=type_conv-109.28.00
+${TYPECONV}.tar.gz:
+	${WGET} https://ocaml.janestreet.com/ocaml-core/109.28.00/individual/$@
+typeconv: ${TYPECONV}.tar.gz findlib
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${TYPECONV}
+	tar zxf ${TYPECONV}.tar.gz
+	./Patcher.sh ${TYPECONV}
+	( cd ${TYPECONV} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ocaml setup.ml -configure && \
+	  ocaml setup.ml -build && \
+	  ocamlfind remove type_conv && \
+	  ocaml setup.ml -install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${TYPECONV} typeconv
+distclean::
+	rm -f ${TYPECONV}.tar.gz
+all: typeconv
+
+# https://ocaml.janestreet.com/ocaml-core/109.15.00/individual/
+VARIANTSLIB=variantslib-109.15.00
+${VARIANTSLIB}.tar.gz:
+	${WGET} https://ocaml.janestreet.com/ocaml-core/109.15.00/individual/$@
+variantslib: ${VARIANTSLIB}.tar.gz findlib typeconv
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${VARIANTSLIB}
+	tar zxf ${VARIANTSLIB}.tar.gz
+	./Patcher.sh ${VARIANTSLIB}
+	( cd ${VARIANTSLIB} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ocaml setup.ml -configure && \
+	  ocaml setup.ml -build && \
+	  ocamlfind remove variantslib && \
+	  ocaml setup.ml -install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${VARIANTSLIB} variantslib
+distclean::
+	rm -f ${VARIANTSLIB}.tar.gz
+all: variantslib
+
+# https://ocaml.janestreet.com/ocaml-core/109.28.00/individual/
+PIPEBANG=pipebang-109.28.00
+${PIPEBANG}.tar.gz:
+	${WGET} https://ocaml.janestreet.com/ocaml-core/109.28.00/individual/$@
+pipebang: ${PIPEBANG}.tar.gz findlib typeconv
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${PIPEBANG}
+	tar zxf ${PIPEBANG}.tar.gz
+	./Patcher.sh ${PIPEBANG}
+	( cd ${PIPEBANG} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ocaml setup.ml -configure && \
+	  ocaml setup.ml -build && \
+	  ocamlfind remove pa_pipebang && \
+	  ocaml setup.ml -install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${PIPEBANG} pipebang
+distclean::
+	rm -f ${PIPEBANG}.tar.gz
+all: pipebang
+
+# https://ocaml.janestreet.com/ocaml-core/109.36.00/individual/
+PAOUNIT=pa_ounit-109.36.00
+${PAOUNIT}.tar.gz:
+	${WGET} https://ocaml.janestreet.com/ocaml-core/109.36.00/individual/$@
+paounit: ${PAOUNIT}.tar.gz findlib typeconv
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${PAOUNIT}
+	tar zxf ${PAOUNIT}.tar.gz
+	./Patcher.sh ${PAOUNIT}
+	( cd ${PAOUNIT} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ocaml setup.ml -configure && \
+	  ocaml setup.ml -build && \
+	  ocamlfind remove pa_ounit && \
+	  ocaml setup.ml -install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${PAOUNIT} paounit
+distclean::
+	rm -f ${PAOUNIT}.tar.gz
+all: paounit
+
+# https://ocaml.janestreet.com/ocaml-core/109.15.00/individual/
+COMPARELIB=comparelib-109.15.00
+${COMPARELIB}.tar.gz:
+	${WGET} https://ocaml.janestreet.com/ocaml-core/109.15.00/individual/$@
+comparelib: ${COMPARELIB}.tar.gz findlib typeconv
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${COMPARELIB}
+	tar zxf ${COMPARELIB}.tar.gz
+	./Patcher.sh ${COMPARELIB}
+	( cd ${COMPARELIB} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ocaml setup.ml -configure && \
+	  ocaml setup.ml -build && \
+	  ocamlfind remove comparelib && \
+	  ocaml setup.ml -install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${COMPARELIB} comparelib
+distclean::
+	rm -f ${COMPARELIB}.tar.gz
+all: comparelib
+
+# https://ocaml.janestreet.com/ocaml-core/109.30.00/individual/
+BINPROT=bin_prot-109.30.00
+${BINPROT}.tar.gz:
+	${WGET} https://ocaml.janestreet.com/ocaml-core/109.30.00/individual/$@
+binprot: ${BINPROT}.tar.gz findlib typeconv ounit
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${BINPROT}
+	tar zxf ${BINPROT}.tar.gz
+	./Patcher.sh ${BINPROT}
+	( cd ${BINPROT} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ocaml setup.ml -configure && \
+	  ocaml setup.ml -build && \
+	  ocamlfind remove bin_prot && \
+	  ocaml setup.ml -install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${BINPROT} binprot
+distclean::
+	rm -f ${BINPROT}.tar.gz
+all: binprot
+
+# https://ocaml.janestreet.com/ocaml-core/109.15.00/individual/
+FIELDSLIB=fieldslib-109.15.00
+${FIELDSLIB}.tar.gz:
+	${WGET} https://ocaml.janestreet.com/ocaml-core/109.15.00/individual/$@
+fieldslib: ${FIELDSLIB}.tar.gz findlib typeconv
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${FIELDSLIB}
+	tar zxf ${FIELDSLIB}.tar.gz
+	./Patcher.sh ${FIELDSLIB}
+	( cd ${FIELDSLIB} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ocaml setup.ml -configure && \
+	  ocaml setup.ml -build && \
+	  ocamlfind remove fieldslib && \
+	  ocaml setup.ml -install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${FIELDSLIB} fieldslib
+distclean::
+	rm -f ${FIELDSLIB}.tar.gz
+all: fieldslib
+
+# https://ocaml.janestreet.com/ocaml-core/109.15.00/individual/
+SEXPLIB=sexplib-109.15.00
+${SEXPLIB}.tar.gz:
+	${WGET} https://ocaml.janestreet.com/ocaml-core/109.15.00/individual/$@
+sexplib: ${SEXPLIB}.tar.gz findlib typeconv
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${SEXPLIB}
+	tar zxf ${SEXPLIB}.tar.gz
+	./Patcher.sh ${SEXPLIB}
+	( cd ${SEXPLIB} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ocaml setup.ml -configure && \
+	  ocaml setup.ml -build && \
+	  ocamlfind remove sexplib && \
+	  ocaml setup.ml -install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${SEXPLIB} sexplib
+distclean::
+	rm -f ${SEXPLIB}.tar.gz
+all: sexplib
+
+# https://ocaml.janestreet.com/ocaml-core/109.35.00/individual/
+HERELIB=herelib-109.35.00
+${HERELIB}.tar.gz:
+	${WGET} https://ocaml.janestreet.com/ocaml-core/109.35.00/individual/$@
+herelib: ${HERELIB}.tar.gz
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${HERELIB}
+	tar zxf ${HERELIB}.tar.gz
+	./Patcher.sh ${HERELIB}
+	( cd ${HERELIB} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure --prefix ${PREFIX} && \
+	  ${MAKE} && \
+	  ocamlfind remove herelib && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${HERELIB} herelib
+distclean::
+	rm -f ${HERELIB}.tar.gz
+all: herelib
+
+# https://ocaml.janestreet.com/ocaml-core/109.37.00/individual/
+COREKERNEL=core_kernel-109.37.00
+${COREKERNEL}.tar.gz:
+	${WGET} https://ocaml.janestreet.com/ocaml-core/109.37.00/individual/$@
+corekernel: ${COREKERNEL}.tar.gz findlib variantslib sexplib fieldslib \
+      binprot comparelib paounit pipebang res ounit herelib
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${COREKERNEL}
+	tar zxf ${COREKERNEL}.tar.gz
+	./Patcher.sh ${COREKERNEL}
+	( cd ${COREKERNEL} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ocaml setup.ml -configure && \
+	  ocaml setup.ml -build && \
+	  ocamlfind remove core_kernel && \
+	  ocaml setup.ml -install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${COREKERNEL} corekernel
+distclean::
+	rm -f ${COREKERNEL}.tar.gz
+all: core
+
+# https://ocaml.janestreet.com/ocaml-core/109.37.00/individual/
+CORE=core-109.37.00
+${CORE}.tar.gz:
+	${WGET} https://ocaml.janestreet.com/ocaml-core/109.37.00/individual/$@
+core: ${CORE}.tar.gz findlib variantslib sexplib fieldslib binprot comparelib \
+      paounit pipebang res ounit corekernel
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${CORE}
+	tar zxf ${CORE}.tar.gz
+	./Patcher.sh ${CORE}
+	( cd ${CORE} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ocaml setup.ml -configure && \
+	  ocaml setup.ml -build && \
+	  ocamlfind remove core && \
+	  ocaml setup.ml -install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${CORE} core
+distclean::
+	rm -f ${CORE}.tar.gz
+all: core
+
+# https://ocaml.janestreet.com/ocaml-core/109.27.00/individual/
+CUSTOMPRINTF=custom_printf-109.27.00
+${CUSTOMPRINTF}.tar.gz:
+	${WGET} https://ocaml.janestreet.com/ocaml-core/109.27.00/individual/$@
+customprintf: ${CUSTOMPRINTF}.tar.gz
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${CUSTOMPRINTF}
+	tar zxf ${CUSTOMPRINTF}.tar.gz
+	./Patcher.sh ${CUSTOMPRINTF}
+	( cd ${CUSTOMPRINTF} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure --prefix ${PREFIX} && \
+	  ${MAKE} && \
+	  ocamlfind remove customprintf && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${CUSTOMPRINTF} customprintf
+distclean::
+	rm -f ${CUSTOMPRINTF}.tar.gz
+all: customprintf
+
+# https://ocaml.janestreet.com/ocaml-core/109.36.00/individual/
+TEXTUTILS=textutils-109.36.00
+${TEXTUTILS}.tar.gz:
+	${WGET} https://ocaml.janestreet.com/ocaml-core/109.36.00/individual/$@
+textutils: ${TEXTUTILS}.tar.gz
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${TEXTUTILS}
+	tar zxf ${TEXTUTILS}.tar.gz
+	./Patcher.sh ${TEXTUTILS}
+	( cd ${TEXTUTILS} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure --prefix ${PREFIX} && \
+	  ${MAKE} && \
+	  ocamlfind remove textutils && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${TEXTUTILS} textutils
+distclean::
+	rm -f ${TEXTUTILS}.tar.gz
+all: textutils
+
+# https://ocaml.janestreet.com/ocaml-core/109.36.00/individual/
+COREEXTENDED=core_extended-109.36.00
+${COREEXTENDED}.tar.gz:
+	${WGET} https://ocaml.janestreet.com/ocaml-core/109.36.00/individual/$@
+coreextended: ${COREEXTENDED}.tar.gz findlib sexplib fieldslib binprot paounit \
+              pipebang core pcre res comparelib ounit
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${COREEXTENDED}
+	tar zxf ${COREEXTENDED}.tar.gz
+	./Patcher.sh ${COREEXTENDED}
+	( cd ${COREEXTENDED} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ocaml setup.ml -configure && \
+	  ocaml setup.ml -build && \
+	  ocaml setup.ml -install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${COREEXTENDED} coreextended
+distclean::
+	rm -f ${COREEXTENDED}.tar.gz
+all: coreextended
+
+###########################################################################
+
+# http://erratique.ch/software/react
+REACT=react-0.9.3
+${REACT}.tbz:
+	${WGET} http://erratique.ch/software/react/releases/$@
+react: ${REACT}.tbz findlib
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${REACT}
+	tar jxf ${REACT}.tbz
+	./Patcher.sh ${REACT} oasis-common.patch
+	( cd ${REACT} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ocaml setup.ml -configure && \
+	  ocaml setup.ml -build && \
+	  ./test.native && \
+	  ocamlfind remove react && \
+	  ocaml setup.ml -install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${REACT} react
+distclean::
+	rm -f ${REACT}.tbz
+all: react
+
+# http://forge.ocamlcore.org/projects/ocaml-text/
+OCAMLTEXT=ocaml-text-0.5
+${OCAMLTEXT}.tar.gz:
+	${WGET} http://forge.ocamlcore.org/frs/download.php/641/$@
+ocamltext: ${OCAMLTEXT}.tar.gz findlib
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${OCAMLTEXT}
+	tar zxf ${OCAMLTEXT}.tar.gz
+	./Patcher.sh ${OCAMLTEXT} oasis-common.patch
+	( cd ${OCAMLTEXT} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ${MAKE} build && \
+	  ${MAKE} test && \
+	  ocamlfind remove text && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${OCAMLTEXT} ocamltext
+distclean::
+	rm -f ${OCAMLTEXT}.tar.gz
+all: ocamltext
+
+# http://sourceforge.net/projects/savonet/files/ocaml-ssl/
+OCAMLSSL=ocaml-ssl-0.4.6
+${OCAMLSSL}.tar.gz:
+	${WGET} http://voxel.dl.sourceforge.net/project/savonet/ocaml-ssl/0.4.6/$@
+ocamlssl: ${OCAMLSSL}.tar.gz findlib
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${OCAMLSSL}
+	tar zxf ${OCAMLSSL}.tar.gz
+	./Patcher.sh ${OCAMLSSL}
+	( cd ${OCAMLSSL} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ./configure && \
+	  ${MAKE} && \
+	  ocamlfind remove ssl && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${OCAMLSSL} ocamlssl
+distclean::
+	rm -f ${OCAMLSSL}.tar.gz
+all: ocamlssl
+
+# http://ocsigen.org/lwt/install
+LWT=lwt-2.4.0
+${LWT}.tar.gz:
+	${WGET} http://ocsigen.org/download/$@
+lwt: ${LWT}.tar.gz findlib react ocamltext ocamlssl lablgtk
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${LWT}
+	tar zxf ${LWT}.tar.gz
+	./Patcher.sh ${LWT}
+	( cd ${LWT} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  export C_INCLUDE_PATH=/usr/include:/opt/local/include && \
+	  export LIBRARY_PATH=/usr/lib:/opt/local/lib && \
+	  ./configure --enable-ssl --enable-react && \
+	  ${MAKE} && \
+	  ocamlfind remove lwt && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${LWT} lwt
+distclean::
+	rm -f ${LWT}.tar.gz
+all: lwt
+
+# http://forge.ocamlcore.org/projects/camlzip/
+CAMLZIP=camlzip-1.04
+${CAMLZIP}.tar.gz:
+	${WGET} http://forge.ocamlcore.org/frs/download.php/328/$@
+camlzip: ${CAMLZIP}.tar.gz findlib
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${CAMLZIP}
+	tar zxf ${CAMLZIP}.tar.gz
+	./Patcher.sh ${CAMLZIP}
+	( cd ${CAMLZIP} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ${MAKE} all && \
+	  ${MAKE} allopt && \
+	  ${MAKE} install && \
+	  ${MAKE} installopt && \
+	  ocamlfind remove camlzip && \
+	  ocamlfind install camlzip META )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${CAMLZIP} camlzip
+distclean::
+	rm -f ${CAMLZIP}.tar.gz
+all: camlzip
+
+# http://forge.ocamlcore.org/projects/cryptokit/
+CRYPTOKIT=cryptokit-1.6
+${CRYPTOKIT}.tar.gz:
+	${WGET} http://forge.ocamlcore.org/frs/download.php/891/$@
+cryptokit: ${CRYPTOKIT}.tar.gz findlib
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${CRYPTOKIT}
+	tar zxf ${CRYPTOKIT}.tar.gz
+	./Patcher.sh ${CRYPTOKIT}
+	( cd ${CRYPTOKIT} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ${MAKE} build && \
+	  ${MAKE} test && \
+	  ocamlfind remove cryptokit && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${CRYPTOKIT} cryptokit
+distclean::
+	rm -f ${CRYPTOKIT}.tar.gz
+all: cryptokit
+
+# https://bitbucket.org/mmottl
+SQLITE=sqlite3-ocaml-2.0.1
+${SQLITE}.tar.gz:
+	${WGET} https://bitbucket.org/mmottl/sqlite3-ocaml/downloads/$@
+sqlite: ${SQLITE}.tar.gz findlib
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${SQLITE}
+	tar zxf ${SQLITE}.tar.gz
+	./Patcher.sh ${SQLITE} oasis-common.patch
+	( cd ${SQLITE} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ocaml setup.ml -configure && \
+	  ocaml setup.ml -build && \
+	  ocamlfind remove sqlite3 && \
+	  ocaml setup.ml -install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${SQLITE} sqlite
+distclean::
+	rm -f ${SQLITE}.tar.gz
+all: sqlite
+
+# http://gallium.inria.fr/~fpottier/menhir/
+MENHIR=menhir-20120123
+${MENHIR}.tar.gz:
+	${WGET} http://gallium.inria.fr/~fpottier/menhir/$@
+menhir: ${MENHIR}.tar.gz
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${MENHIR}
+	tar zxf ${MENHIR}.tar.gz
+	./Patcher.sh ${MENHIR}
+	( cd ${MENHIR} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ${MAKE} PREFIX=${PREFIX} && \
+	  ocamlfind remove MenhirLib && \
+	  ${MAKE} PREFIX=${PREFIX} install)
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${MENHIR} menhir
+distclean::
+	rm -f ${MENHIR}.tar.gz
+all: menhir
+
+# http://ocsigen.org/obrowser/install
+OBROWSER=obrowser-1.1.1
+${OBROWSER}.tar.gz:
+	${WGET} http://ocsigen.org/download/$@
+obrowser: ${OBROWSER}.tar.gz lwt menhir
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${OBROWSER}
+	tar zxf ${OBROWSER}.tar.gz
+	./Patcher.sh ${OBROWSER}
+	( cd ${OBROWSER} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ${MAKE} && \
+	  ocamlfind remove obrowser && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${OBROWSER} obrowser
+distclean::
+	rm -f ${OBROWSER}.tar.gz
+all: obrowser
+
+# http://hevea.inria.fr/old/
+HEVEA=hevea-2.09
+${HEVEA}.tar.gz:
+	${WGET} http://hevea.inria.fr/old/$@
+hevea: ${HEVEA}.tar.gz
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${HEVEA}
+	tar zxf ${HEVEA}.tar.gz
+	./Patcher.sh ${HEVEA}
+	( cd ${HEVEA} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ${MAKE} PREFIX=${PREFIX} && \
+	  ${MAKE} PREFIX=${PREFIX} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${HEVEA} hevea
+distclean::
+	rm -f ${HEVEA}.tar.gz
+all: hevea
+
+# http://www.seas.upenn.edu/~bcpierce/unison/download/releases/
+UNISON=unison-2.45.4
+${UNISON}.tar.gz:
+	${WGET} http://www.seas.upenn.edu/~bcpierce/unison/download/releases/unison-2.45.4/$@
+unison: ${UNISON}.tar.gz lablgtk
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${UNISON}
+	tar zxf ${UNISON}.tar.gz
+	./Patcher.sh ${UNISON}
+	( cd ${UNISON} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ${MAKE} UISTYLE=gtk2 && \
+	  touch ${PREFIX}/bin/unison && \
+	  ${MAKE} UISTYLE=gtk2 INSTALLDIR=${PREFIX}/bin/ install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${UNISON} unison
+distclean::
+	rm -f ${UNISON}.tar.gz
+all: unison
+
+# http://raevnos.pennmush.org/code/ocaml-mysql/
+MYSQL=ocaml-mysql-1.0.4
+${MYSQL}.tar.gz:
+	${WGET} http://raevnos.pennmush.org/code/ocaml-mysql/$@
+mysql: ${MYSQL}.tar.gz findlib
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${MYSQL}
+	tar zxf ${MYSQL}.tar.gz
+	./Patcher.sh ${MYSQL}
+	( cd ${MYSQL} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  export CPPFLAGS=-I/opt/local/include/mysql5 && \
+	  export LDFLAGS=-L/opt/local/lib/mysql5/mysql && \
+	  ./configure -prefix ${PREFIX} && \
+	  ${MAKE} && \
+	  ${MAKE} opt && \
+	  ocamlfind remove mysql && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${MYSQL} mysql
+distclean::
+	rm -f ${MYSQL}.tar.gz
+all: mysql
+
+# http://gallium.inria.fr/~guesdon/Tools/ocgi/
+OCGI=ocgi-0.5
+${OCGI}.tar.gz:
+	${WGET} http://pauillac.inria.fr/~guesdon/Tools/Tars/$@
+ocgi: ${OCGI}.tar.gz
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${OCGI}
+	tar zxf ${OCGI}.tar.gz
+	./Patcher.sh ${OCGI}
+	( cd ${OCGI} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ./configure && \
+	  ${MAKE} && \
+	  ${MAKE} opt && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${OCGI} ocgi
+distclean::
+	rm -f ${OCGI}.tar.gz
+all: ocgi
+
+# http://tech.motion-twin.com/xmllight
+XMLLIGHT=xml-light-2.2
+${XMLLIGHT}.zip:
+	${WGET} http://tech.motion-twin.com/zip/$@
+xmllight: ${XMLLIGHT}.zip
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf xml-light ${XMLLIGHT}
+	unzip ${XMLLIGHT}.zip && mv xml-light ${XMLLIGHT}
+	./Patcher.sh ${XMLLIGHT}
+	( cd ${XMLLIGHT} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ${MAKE} xml_parser.ml && \
+	  ${MAKE} all opt && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${XMLLIGHT} xml-light xmllight
+distclean::
+	rm -f ${XMLLIGHT}.zip
+all: xmllight
+
+# http://config-file.forge.ocamlcore.org/
+CONFIGFILE=config-file-1.1
+${CONFIGFILE}.tar.gz:
+	${WGET} https://forge.ocamlcore.org/frs/download.php/845/$@
+configfile: ${CONFIGFILE}.tar.gz
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${CONFIGFILE}
+	tar zxf ${CONFIGFILE}.tar.gz
+	./Patcher.sh ${CONFIGFILE}
+	( cd ${CONFIGFILE} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure --prefix=${PREFIX} && \
+	  ${MAKE} all && \
+	  ocamlfind remove config-file && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${CONFIGFILE} configfile
+distclean::
+	rm -f ${CONFIGFILE}.tar.gz
+all: configfile
+
+# http://erratique.ch/software/xmlm
+XMLM=xmlm-1.1.0
+${XMLM}.tbz:
+	${WGET} http://erratique.ch/software/xmlm/releases/$@
+xmlm: ${XMLM}.tbz findlib
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${XMLM}
+	tar jxf ${XMLM}.tbz
+	./Patcher.sh ${XMLM} oasis-common.patch
+	( cd ${XMLM} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ocaml setup.ml -configure --prefix ${PREFIX} && \
+	  ocaml setup.ml -build && \
+	  ocamlfind remove xmlm && \
+	  ocaml setup.ml -install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${XMLM} xmlm
+distclean::
+	rm -f ${XMLM}.tbz
+all: xmlm
+
+# http://forge.ocamlcore.org/projects/gtk-extras/
+LABLGTKEXTRAS=lablgtkextras-1.3
+${LABLGTKEXTRAS}.tar.gz:
+	${WGET} http://forge.ocamlcore.org/frs/download.php/1072/$@
+lablgtkextras: ${LABLGTKEXTRAS}.tar.gz lablgtk configfile xmlm
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${LABLGTKEXTRAS}
+	tar zxf ${LABLGTKEXTRAS}.tar.gz
+	./Patcher.sh ${LABLGTKEXTRAS}
+	( cd ${LABLGTKEXTRAS} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure --prefix ${PREFIX} && \
+	  ${MAKE} all && \
+	  ocamlfind remove lablgtk2-extras && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${LABLGTKEXTRAS} lablgtkextras
+distclean::
+	rm -f ${LABLGTKEXTRAS}.tar.gz
+all: lablgtkextras
+
+# https://bitbucket.org/skskeyserver/sks-keyserver/downloads
+SKS=sks-1.1.3
+${SKS}.tgz:
+	${WGET} https://bitbucket.org/skskeyserver/sks-keyserver/downloads/$@
+sks: ${SKS}.tgz
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${SKS}
+	tar zxf ${SKS}.tgz
+	./Patcher.sh ${SKS}
+	( cd ${SKS} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ${MAKE} dep PREFIX=${PREFIX} && \
+	  ${MAKE} all PREFIX=${PREFIX} && \
+	  ${MAKE} all.bc PREFIX=${PREFIX} && \
+	  ${MAKE} install PREFIX=${PREFIX} )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${SKS} sks
+distclean::
+	rm -f ${SKS}.tgz
+all: sks
+
+# http://omake.metaprl.org/download.html
+OMAKE=omake-0.9.8.6
+${OMAKE}-0.rc1.tar.gz:
+	${WGET} http://omake.metaprl.org/downloads/$@
+omake: ${OMAKE}-0.rc1.tar.gz
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${OMAKE}
+	tar zxf ${OMAKE}-0.rc1.tar.gz
+	./Patcher.sh ${OMAKE}
+	( cd ${OMAKE} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  export PREFIX=${PREFIX} && \
+	  ${MAKE} all && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${OMAKE} omake
+distclean::
+	rm -f ${OMAKE}-0.rc1.tar.gz
+all: omake
+
+# http://alt-ergo.lri.fr/
+ALTERGO=alt-ergo-0.95
+${ALTERGO}.tar.gz:
+	${WGET} http://alt-ergo.lri.fr/http/$(ALTERGO)/$@
+altergo: ${ALTERGO}.tar.gz ocamlgraph
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${ALTERGO}
+	tar zxf ${ALTERGO}.tar.gz
+	./Patcher.sh ${ALTERGO}
+	( cd ${ALTERGO} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ./configure -prefix ${PREFIX} && \
+	  ${MAKE} && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${ALTERGO} altergo
+distclean::
+	rm -f ${ALTERGO}.tar.gz
+all: altergo
+
+# http://www.seas.upenn.edu/~harmony/
+BOOMERANG=boomerang-0.2
+${BOOMERANG}-source.tar.gz:
+	${WGET} http://www.seas.upenn.edu/~harmony/download/$@
+boomerang: ${BOOMERANG}-source.tar.gz omake
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${BOOMERANG}
+	tar zxf ${BOOMERANG}-source.tar.gz && mv boomerang-20090902 ${BOOMERANG}
+	./Patcher.sh ${BOOMERANG}
+	( cd ${BOOMERANG} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  omake )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${BOOMERANG} boomerang
+distclean::
+	rm -f ${BOOMERANG}-source.tar.gz
+all: boomerang
+
+# https://github.com/yoriyuki/Camomile/wiki
+CAMOMILE=camomile-0.8.4
+${CAMOMILE}.tar.bz2:
+	${WGET} https://github.com/downloads/yoriyuki/Camomile/$@
+camomile: ${CAMOMILE}.tar.bz2
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${CAMOMILE}
+	tar xf ${CAMOMILE}.tar.bz2
+	./Patcher.sh ${CAMOMILE}
+	( cd ${CAMOMILE} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ./configure -prefix ${PREFIX} && \
+	  ${MAKE} && \
+	  ocamlfind remove camomile && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${CAMOMILE} camomile
+distclean::
+	rm -f ${CAMOMILE}.tar.bz2
+all: camomile
+
+# http://sanskrit.inria.fr/ZEN/
+ZEN=zen_2.3.2
+${ZEN}.tar.gz:
+	${WGET} http://sanskrit.inria.fr/ZEN/$@
+zen: ${ZEN}.tar.gz
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${ZEN}
+	tar zxf ${ZEN}.tar.gz && mv ZEN_* ${ZEN}
+	./Patcher.sh ${ZEN}
+	( cd ${ZEN} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ${MAKE} depend && \
+	  ${MAKE} all && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${ZEN} zen
+distclean::
+	rm -f ${ZEN}.tar.gz
+all: zen
+
+# http://users-tima.imag.fr/vds/ouchet/index_fichiers/vsyml.html
+VSYML=vsyml-2010-04-06
+${VSYML}.tar.gz:
+	${WGET} http://users-tima.imag.fr/vds/ouchet/vsyml/$@
+vsyml: ${VSYML}.tar.gz
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${VSYML}
+	tar zxf ${VSYML}.tar.gz
+	./Patcher.sh ${VSYML}
+	( cd ${VSYML} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ${MAKE} )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${VSYML} vsyml
+distclean::
+	rm -f ${VSYML}.tar.gz
+all: vsyml
+
+# http://projects.camlcity.org/projects/ocamlnet.html
+OCAMLNET=ocamlnet-3.5.1
+${OCAMLNET}.tar.gz:
+	${WGET} http://download.camlcity.org/download/$@
+ocamlnet: ${OCAMLNET}.tar.gz findlib pcre lablgtk ocamlssl camlzip cryptokit
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${OCAMLNET}
+	tar zxf ${OCAMLNET}.tar.gz
+	./Patcher.sh ${OCAMLNET}
+	( cd ${OCAMLNET} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ./configure && \
+	  ${MAKE} all && \
+	  ${MAKE} opt && \
+	  ocamlfind remove netsys && \
+	  ocamlfind remove netshm && \
+	  ocamlfind remove netstring && \
+	  ocamlfind remove equeue && \
+	  ocamlfind remove shell && \
+	  ocamlfind remove rpc-generator && \
+	  ocamlfind remove rpc-auth-local && \
+	  ocamlfind remove rpc && \
+	  ocamlfind remove pop && \
+	  ocamlfind remove smtp && \
+	  ocamlfind remove netclient && \
+	  ocamlfind remove netcgi2 && \
+	  ocamlfind remove netplex && \
+	  ocamlfind remove netcgi2-plex && \
+	  ocamlfind remove netcamlbox && \
+	  ocamlfind remove netmulticore && \
+	  ocamlfind remove netgssapi && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${OCAMLNET} ocamlnet
+distclean::
+	rm -f ${OCAMLNET}.tar.gz
+all: ocamlnet
+
+# http://zoggy.github.io/ocamlrss/
+RSS=ocamlrss-2.2.2
+${RSS}.tar.gz:
+	${WGET} http://zoggy.github.io/ocamlrss/$@
+rss: ${RSS}.tar.gz xmlm ocamlnet
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${RSS}
+	tar zxf ${RSS}.tar.gz
+	./Patcher.sh ${RSS}
+	( cd ${RSS} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ${MAKE} all && \
+	  ocamlfind remove ocaml-rss && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${RSS} rss
+distclean::
+	rm -f ${RSS}.tar.gz
+all: rss
+
+# http://code.google.com/p/ocaml-extlib/
+EXTLIB=extlib-1.5.2
+${EXTLIB}.tar.gz:
+	${WGET} http://ocaml-extlib.googlecode.com/files/$@
+extlib: ${EXTLIB}.tar.gz
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${EXTLIB}
+	tar zxf ${EXTLIB}.tar.gz
+	./Patcher.sh ${EXTLIB}
+	( cd ${EXTLIB} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ocamlfind remove extlib && \
+	  ocaml install.ml -b -n -doc )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${EXTLIB} extlib
+distclean::
+	rm -f ${EXTLIB}.tar.gz
+all: extlib
+
+# http://forge.ocamlcore.org/projects/ocaml-fileutils
+FILEUTILS=ocaml-fileutils-0.4.4
+${FILEUTILS}.tar.gz:
+	${WGET} http://forge.ocamlcore.org/frs/download.php/892/$@
+fileutils: ${FILEUTILS}.tar.gz findlib ounit
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${FILEUTILS}
+	tar xf ${FILEUTILS}.tar.gz
+	./Patcher.sh ${FILEUTILS}
+	( cd ${FILEUTILS} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure --prefix ${PREFIX} && \
+	  ${MAKE} && \
+	  ocamlfind remove fileutils && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${FILEUTILS} fileutils
+distclean::
+	rm -f ${FILEUTILS}.tar.gz
+all: fileutils
+
+# http://forge.ocamlcore.org/projects/odn
+ODN=ocaml-data-notation-0.0.10
+${ODN}.tar.gz:
+	${WGET} http://forge.ocamlcore.org/frs/download.php/1029/$@
+odn: ${ODN}.tar.gz findlib core ounit fileutils
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${ODN}
+	tar zxf ${ODN}.tar.gz
+	./Patcher.sh ${ODN} oasis-common.patch
+	( cd ${ODN} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ocaml setup.ml -configure && \
+	  ocaml setup.ml -build && \
+	  ocamlfind remove odn && \
+	  ocaml setup.ml -install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${ODN} odn
+distclean::
+	rm -f ${ODN}.tar.gz
+all: odn
+
+# http://forge.ocamlcore.org/projects/ocamlify
+OCAMLIFY=ocamlify-0.0.1
+${OCAMLIFY}.tar.gz:
+	${WGET} http://forge.ocamlcore.org/frs/download.php/379/$@
+ocamlify: ${OCAMLIFY}.tar.gz findlib
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${OCAMLIFY}
+	tar zxf ${OCAMLIFY}.tar.gz
+	./Patcher.sh ${OCAMLIFY} oasis-common.patch
+	( cd ${OCAMLIFY} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure --prefix ${PREFIX} && \
+	  ocaml setup.ml -build && \
+	  ocaml setup.ml -install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${OCAMLIFY} ocamlify
+distclean::
+	rm -f ${OCAMLIFY}.tar.gz
+all: ocamlify
+
+# http://forge.ocamlcore.org/projects/ocaml-expect
+EXPECT=ocaml-expect-0.0.3
+${EXPECT}.tar.gz:
+	${WGET} http://forge.ocamlcore.org/frs/download.php/894/$@
+expect: ${EXPECT}.tar.gz findlib extlib pcre ounit
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${EXPECT}
+	tar zxf ${EXPECT}.tar.gz
+	./Patcher.sh ${EXPECT} oasis-common.patch
+	( cd ${EXPECT} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ocaml setup.ml -configure && \
+	  ocaml setup.ml -build && \
+	  ocamlfind remove expect && \
+	  ocaml setup.ml -install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${EXPECT} expect
+distclean::
+	rm -f ${EXPECT}.tar.gz
+all: expect
+
+# http://forge.ocamlcore.org/projects/ocamlmod/
+OCAMLMOD=ocamlmod-0.0.3
+${OCAMLMOD}.tar.gz:
+	${WGET} http://forge.ocamlcore.org/frs/download.php/856/$@
+ocamlmod: ${OCAMLMOD}.tar.gz findlib fileutils pcre
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${OCAMLMOD}
+	tar zxf ${OCAMLMOD}.tar.gz
+	./Patcher.sh ${OCAMLMOD}
+	( cd ${OCAMLMOD} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure --prefix ${PREFIX} && \
+	  ${MAKE} && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${OCAMLMOD} ocamlmod
+distclean::
+	rm -f ${OCAMLMOD}.tar.gz
+all: ocamlmod
+
+# http://forge.ocamlcore.org/projects/oasis
+OASIS=oasis-0.3.0
+${OASIS}.tar.gz:
+	${WGET} http://forge.ocamlcore.org/frs/download.php/918/$@
+oasis: ${OASIS}.tar.gz findlib fileutils pcre extlib odn ocamlgraph ocamlify \
+       ounit expect ocamlmod
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${OASIS}
+	tar zxf ${OASIS}.tar.gz
+	./Patcher.sh ${OASIS} oasis-common.patch
+	( cd ${OASIS} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure --prefix ${PREFIX} && \
+	  ocaml setup.ml -build && \
+	  ocamlfind remove oasis && \
+	  ocamlfind remove userconf && \
+	  ocamlfind remove plugin-loader && \
+	  ocaml setup.ml -install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${OASIS} oasis
+distclean::
+	rm -f ${OASIS}.tar.gz
+all: oasis
+
+# http://calendar.forge.ocamlcore.org/
+CALENDAR=calendar-2.03.2
+${CALENDAR}.tar.gz:
+	${WGET} https://forge.ocamlcore.org/frs/download.php/915/$@
+calendar: ${CALENDAR}.tar.gz
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${CALENDAR}
+	tar zxf ${CALENDAR}.tar.gz
+	./Patcher.sh ${CALENDAR}
+	( cd ${CALENDAR} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure --prefix ${PREFIX} && \
+	  ${MAKE} && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${CALENDAR} calendar
+distclean::
+	rm -f ${CALENDAR}.tar.gz
+all: calendar
+
+# http://gallium.inria.fr/camlimages/
+CAMLIMAGES=camlimages-4.0.1
+${CAMLIMAGES}.tar.gz:
+	${WGET} https://bitbucket.org/camlspotter/camlimages/get/v4.0.1.tar.gz
+	mv v4.0.1.tar.gz $@
+camlimages: ${CAMLIMAGES}.tar.gz findlib omake lablgtk
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${CAMLIMAGES}
+	tar xf ${CAMLIMAGES}.tar.gz
+	mv camlspotter-camlimages-c803efa9d5d3 ${CAMLIMAGES}
+	mv ${CAMLIMAGES}/doc/old/* ${CAMLIMAGES}/doc/
+	./Patcher.sh ${CAMLIMAGES}
+	( cd ${CAMLIMAGES} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  omake && \
+	  ocamlfind remove camlimages && \
+	  omake install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${CAMLIMAGES} camlimages
+distclean::
+	rm -f ${CAMLIMAGES}.tar.gz
+all: camlimages
+
+# http://advi.inria.fr/
+ADVI=advi-1.10.2
+${ADVI}.tar.gz:
+	${WGET} http://advi.inria.fr/$@
+advi: ${ADVI}.tar.gz findlib camlimages
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${ADVI}
+	tar zxf ${ADVI}.tar.gz
+	./Patcher.sh ${ADVI}
+	( cd ${ADVI} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure --prefix ${PREFIX} && \
+	  ${MAKE} && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${ADVI} advi
+distclean::
+	rm -f ${ADVI}.tar.gz
+all: advi
+
+# http://forge.ocamlcore.org/projects/camldbm
+DBM=camldbm-1.0
+${DBM}.tgz:
+	${WGET} http://forge.ocamlcore.org/frs/download.php/728/$@
+dbm: ${DBM}.tgz
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${DBM}
+	tar zxf ${DBM}.tgz
+	./Patcher.sh ${DBM}
+	( cd ${DBM} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure --prefix ${PREFIX} && \
+	  ${MAKE} && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${DBM} dbm
+distclean::
+	rm -f ${DBM}.tgz
+all: dbm
+
+# http://ocsigen.org/
+OCSIGEN=ocsigen-bundle-2.2.2
+${OCSIGEN}.tar.gz:
+	${WGET} http://ocsigen.org/download/$@
+ocsigen: ${OCSIGEN}.tar.gz findlib lwt obrowser pcre ocamlnet ocamlssl \
+         sqlite camlzip cryptokit calendar dbm
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${OCSIGEN}
+	tar zxf ${OCSIGEN}.tar.gz
+	./Patcher.sh ${OCSIGEN}
+	( cd ${OCSIGEN} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  export OCSIGEN_USER=${USER}; export OCSIGEN_GROUP=everyone && \
+	  ./configure --prefix=${PREFIX} && \
+	  ${MAKE} && \
+	  rm -rf ${PREFIX}/lib/ocaml/ocsigenserver/extensions && \
+	  ocamlfind remove -destdir ${PREFIX}/lib/ocaml deriving-ocsigen && \
+	  ocamlfind remove -destdir ${PREFIX}/lib/ocaml js_of_ocaml && \
+	  ocamlfind remove -destdir ${PREFIX}/lib/ocaml ocsigenserver && \
+	  ocamlfind remove -destdir ${PREFIX}/lib/ocaml tyxml && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${OCSIGEN} ocsigen
+distclean::
+	rm -f ${OCSIGEN}.tar.gz
+all: ocsigen
+
+# http://mldonkey.sourceforge.net/
+MLDONKEY=mldonkey-3.1.2
+${MLDONKEY}.tar.bz2:
+	${WGET} http://freefr.dl.sourceforge.net/project/mldonkey/mldonkey/3.1.2/$@
+mldonkey: ${MLDONKEY}.tar.bz2 lablgtk
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${MLDONKEY}
+	tar zxf ${MLDONKEY}.tar.bz2
+	./Patcher.sh ${MLDONKEY}
+	( cd ${MLDONKEY} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure && \
+	  ${MAKE} )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${MLDONKEY} mldonkey
+distclean::
+	rm -f ${MLDONKEY}.tar.bz2
+all: mldonkey
+
+# http://mjambon.com/releases/ocamlscript
+OCAMLSCRIPT=ocamlscript-2.0.3
+${OCAMLSCRIPT}.tar.gz:
+	${WGET} http://mjambon.com/releases/ocamlscript/$@
+ocamlscript: ${OCAMLSCRIPT}.tar.gz findlib
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${OCAMLSCRIPT}
+	tar xf ${OCAMLSCRIPT}.tar.gz
+	./Patcher.sh ${OCAMLSCRIPT}
+	( cd ${OCAMLSCRIPT} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ${MAKE} && \
+	  ocamlfind remove ocamlscript && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${OCAMLSCRIPT} ocamlscript
+distclean::
+	rm -f ${OCAMLSCRIPT}.tar.bz2
+all: ocamlscript
+
+# https://forge.ocamlcore.org/projects/kaputt/
+KAPUTT=kaputt-1.2
+${KAPUTT}.tar.gz:
+	${WGET} https://forge.ocamlcore.org/frs/download.php/987/$@
+kaputt: ${KAPUTT}.tar.gz findlib
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${KAPUTT}
+	tar zxf ${KAPUTT}.tar.gz
+	./Patcher.sh ${KAPUTT}
+	( cd ${KAPUTT} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure -ocaml-prefix ${PREFIX} && \
+	  ${MAKE} all && \
+	  ocamlfind remove kaputt && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${KAPUTT} kaputt
+distclean::
+	rm -f ${KAPUTT}.tar.gz
+all: kaputt
+
+#http://www.coherentpdf.com/ocaml-libraries.html
+CAMLPDF=camlpdf-0.5
+${CAMLPDF}.tar.bz2:
+	${WGET} http://www.coherentpdf.com/$@
+camlpdf: ${CAMLPDF}.tar.bz2
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${CAMLPDF}
+	tar zxf ${CAMLPDF}.tar.bz2
+	./Patcher.sh ${CAMLPDF}
+	( cd ${CAMLPDF} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ${MAKE} all && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${CAMLPDF} camlpdf
+distclean::
+	rm -f ${CAMLPDF}.tar.gz
+all: camlpdf
+
+# http://pauillac.inria.fr/~ddr/camlp5/
+CAMLP5=camlp5-6.10
+${CAMLP5}.tgz:
+	${WGET} http://pauillac.inria.fr/~ddr/camlp5/distrib/src/$@
+camlp5: ${CAMLP5}.tgz
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${CAMLP5}
+	tar zxf ${CAMLP5}.tgz
+	./Patcher.sh ${CAMLP5}
+	( cd ${CAMLP5} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ./configure --transitional && \
+	  ${MAKE} world.opt && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${CAMLP5} camlp5
+distclean::
+	rm -f ${CAMLP5}.tgz
+all: camlp5
+
+# http://opensource.geneanet.org/projects/geneweb
+GENEWEB=gw-6.05-src
+${GENEWEB}.tgz:
+	${WGET} http://opensource.geneanet.org/attachments/download/190/$@
+geneweb: ${GENEWEB}.tgz camlp5
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${GENEWEB}
+	tar zxf ${GENEWEB}.tgz
+	./Patcher.sh ${GENEWEB}
+	( cd ${GENEWEB} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure && \
+	  ${MAKE} )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${GENEWEB} geneweb
+distclean::
+	rm -f ${GENEWEB}.tgz
+all: geneweb
+
+# http://coq.inria.fr/download
+COQ=coq-8.4pl1
+${COQ}.tar.gz:
+	${WGET} http://coq.inria.fr/distrib/V8.4pl1/files/$@
+coq: ${COQ}.tar.gz camlp5
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${COQ}
+	tar zxf ${COQ}.tar.gz
+	./Patcher.sh ${COQ}
+	( cd ${COQ} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ./configure -prefix ${PREFIX} -with-doc no && \
+	  ${MAKE} world && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${COQ} coq
+distclean::
+	rm -f ${COQ}.tar.gz
+all: coq
+
+# http://code.google.com/p/bitstring/
+
+BITSTRING=ocaml-bitstring-2.0.3
+${BITSTRING}.tar.gz:
+	${WGET} http://bitstring.googlecode.com/files/$@
+bitstring: ${BITSTRING}.tar.gz findlib # cil FIXME ?
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${BITSTRING}
+	tar zxf ${BITSTRING}.tar.gz
+	./Patcher.sh ${BITSTRING}
+	( cd ${BITSTRING} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure --prefix ${PREFIX} && \
+	  ${MAKE} && \
+	  ${MAKE} check && \
+	  ${MAKE} examples && \
+	  ocamlfind remove bitstring && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${BITSTRING} bitstring
+distclean::
+	rm -f ${BITSTRING}.tar.gz
+all: bitstring
+
+# http://compcert.inria.fr
+COMPCERT=compcert-1.13
+${COMPCERT}.tgz:
+	${WGET} http://compcert.inria.fr/release/$@
+compcert: ${COMPCERT}.tgz coq bitstring
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${COMPCERT}
+	tar zxf ${COMPCERT}.tgz
+	./Patcher.sh ${COMPCERT}
+	( cd ${COMPCERT} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure -prefix ${PREFIX} ppc-linux && \
+	  ${MAKE} all && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${COMPCERT} compcert
+distclean::
+	rm -f ${COMPCERT}.tgz
+all: compcert
+
+# http://frama-c.com/
+FRAMAC=frama-c-Oxygen-20120901
+${FRAMAC}.tar.gz:
+	${WGET} http://frama-c.com/download/$@
+framac: ${FRAMAC}.tar.gz lablgtk ocamlgraph altergo coq
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${FRAMAC}
+	tar zxf ${FRAMAC}.tar.gz
+	./Patcher.sh ${FRAMAC}
+	( cd ${FRAMAC} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ./configure --enable-verbosemake --prefix ${PREFIX} && \
+	  ${MAKE} && \
+	  ${MAKE} oracles && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${FRAMAC} framac
+distclean::
+	rm -f ${FRAMAC}.tar.gz
+all: framac
+
+##################################################################
+### Template for new entries
+##################################################################
+
+FOO=
+${FOO}.tar.gz:
+	${WGET} http://foo.bar.com/.../$@
+foo: ${FOO}.tar.gz
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${FOO}
+	tar zxf ${FOO}.tar.gz
+	./Patcher.sh ${FOO}
+	( cd ${FOO} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure --prefix ${PREFIX} && \
+	  ${MAKE} && \
+	  ocamlfind remove foo && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+xxclean::
+	rm -rf ${FOO} foo
+xxdistclean::
+	rm -f ${FOO}.tar.gz
+xxall: foo
+
+##################################################################
+
+.PHONY: clean
+
+.PHONY: distclean
+distclean::
+	${MAKE} clean
+
+.PHONY: all
+all:
+	echo >/dev/tty
diff -Nru ocaml-3.12.1/testsuite/external/Patcher.sh ocaml-4.01.0/testsuite/external/Patcher.sh
--- ocaml-3.12.1/testsuite/external/Patcher.sh	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/Patcher.sh	2012-08-02 08:17:59.000000000 +0000
@@ -0,0 +1,31 @@
+#!/bin/sh
+
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#           Damien Doligez, projet Gallium, INRIA Rocquencourt          #
+#                                                                       #
+#   Copyright 2012 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+# usage:
+# Patcher.sh  []
+
+if [ -f "$1.patch" ]; then
+  echo "patch -d $1 -p1 < $1.patch"
+  patch -d $1 -p1 < "$1.patch"
+fi
+
+if [ -f "$1-$VERSION.patch" ]; then
+  echo "patch -d $1 -p1 < $1-$VERSION.patch"
+  patch -d $1 -p1 < "$1-$VERSION.patch"
+fi
+
+if [ -f "$2" ]; then
+  echo "patch -d $1 -l -p0 < $2"
+  patch -d $1 -l -p0 < "$2" || exit 0
+fi
diff -Nru ocaml-3.12.1/testsuite/external/TODO.txt ocaml-4.01.0/testsuite/external/TODO.txt
--- ocaml-3.12.1/testsuite/external/TODO.txt	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/TODO.txt	2012-08-09 19:58:22.000000000 +0000
@@ -0,0 +1,26 @@
+TODO:
+Understand why ocamlnet does not detect lablgtk, ocamlssl, camlzip, cryptokit
+
+TODO: cryptogps
+http://www.ocaml-programming.de/packages
+and make ocamlnet depend on it
+
+# TODO: lablgl
+# http://wwwfun.kurims.kyoto-u.ac.jp/soft/lsl/lablgl.html
+
+Haxe: missing a source archive of released version...
+# # http://code.google.com/p/haxe/source/browse/#svn%2Ftrunk
+# HAXE=haxe-2.10dev
+# haxe:
+# 	printf "%s " "$@" >/dev/tty
+# 	test -d ${PREFIX}
+# 	rm -rf ${HAXE}
+# 	tar zxf ${HAXE}.tar.gz
+# 	./Patcher.sh ${HAXE}
+# 	( cd ${HAXE} && \
+# 	  export PATH=${PREFIX}/bin:$$PATH && \
+# 	  make )
+# 	echo ${VERSION} >$@
+# clean::
+# 	rm -rf ${HAXE} haxe
+# all: haxe
diff -Nru ocaml-3.12.1/testsuite/external/boomerang-0.2.patch ocaml-4.01.0/testsuite/external/boomerang-0.2.patch
--- ocaml-3.12.1/testsuite/external/boomerang-0.2.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/boomerang-0.2.patch	2012-08-02 08:17:59.000000000 +0000
@@ -0,0 +1,11 @@
+--- boomerang-0.2/OMakefile.orig	2010-06-07 15:01:55.000000000 +0200
++++ boomerang-0.2/OMakefile	2010-06-07 15:02:08.000000000 +0200
+@@ -126,7 +126,7 @@
+ ##############################################################################
+ # Include sub-directories
+ 
+-SUBDIRS = common src lenses examples doc
++SUBDIRS = common src lenses examples #doc
+ 
+ .SUBDIRS: $(SUBDIRS)
+ 
diff -Nru ocaml-3.12.1/testsuite/external/camlimages-4.0.1.patch ocaml-4.01.0/testsuite/external/camlimages-4.0.1.patch
--- ocaml-3.12.1/testsuite/external/camlimages-4.0.1.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/camlimages-4.0.1.patch	2013-02-26 12:45:32.000000000 +0000
@@ -0,0 +1,11 @@
+--- camlimages-4.0.1.orig/OMakefile	2011-06-22 20:04:32.000000000 +0200
++++ camlimages-4.0.1/OMakefile	2013-02-19 15:35:38.000000000 +0100
+@@ -138,7 +138,7 @@
+     SUPPORTED_FORMATS+=jpeg
+     export
+ 
+-  HAVE_TIFF = $(Check_header_library tiff, tiff.h, TIFFOpen)
++  HAVE_TIFF = false # $(Check_header_library tiff, tiff.h, TIFFOpen)
+   SUPPORT_TIFF = $(and $(HAVE_Z) $(HAVE_JPEG) $(HAVE_TIFF))
+   LDFLAGS_tiff=
+   if $(SUPPORT_TIFF)
diff -Nru ocaml-3.12.1/testsuite/external/camlp5-6.06.patch ocaml-4.01.0/testsuite/external/camlp5-6.06.patch
--- ocaml-3.12.1/testsuite/external/camlp5-6.06.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/camlp5-6.06.patch	2013-03-09 00:32:46.000000000 +0000
@@ -0,0 +1,2243 @@
+diff -r -u -N camlp5-6.06.orig/ocaml_src/lib/versdep/4.00.1.ml camlp5-6.06/ocaml_src/lib/versdep/4.00.1.ml
+--- camlp5-6.06.orig/ocaml_src/lib/versdep/4.00.1.ml	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_src/lib/versdep/4.00.1.ml	2012-07-31 16:52:22.000000000 +0200
+@@ -0,0 +1,465 @@
++(* camlp5r pa_macro.cmo *)
++(* File generated by program: edit only if it does not compile. *)
++(* Copyright (c) INRIA 2007-2012 *)
++
++open Parsetree;;
++open Longident;;
++open Asttypes;;
++
++type ('a, 'b) choice =
++    Left of 'a
++  | Right of 'b
++;;
++
++let sys_ocaml_version = Sys.ocaml_version;;
++
++let ocaml_location (fname, lnum, bolp, lnuml, bolpl, bp, ep) =
++  let loc_at n lnum bolp =
++    {Lexing.pos_fname = if lnum = -1 then "" else fname;
++     Lexing.pos_lnum = lnum; Lexing.pos_bol = bolp; Lexing.pos_cnum = n}
++  in
++  {Location.loc_start = loc_at bp lnum bolp;
++   Location.loc_end = loc_at ep lnuml bolpl;
++   Location.loc_ghost = bp = 0 && ep = 0}
++;;
++
++let loc_none =
++  let loc =
++    {Lexing.pos_fname = "_none_"; Lexing.pos_lnum = 1; Lexing.pos_bol = 0;
++     Lexing.pos_cnum = -1}
++  in
++  {Location.loc_start = loc; Location.loc_end = loc;
++   Location.loc_ghost = true}
++;;
++
++let mkloc loc txt = {Location.txt = txt; Location.loc = loc};;
++let mknoloc txt = mkloc loc_none txt;;
++
++let ocaml_id_or_li_of_string_list loc sl =
++  let mkli s =
++    let rec loop f =
++      function
++        i :: il -> loop (fun s -> Ldot (f i, s)) il
++      | [] -> f s
++    in
++    loop (fun s -> Lident s)
++  in
++  match List.rev sl with
++    [] -> None
++  | s :: sl -> Some (mkli s (List.rev sl))
++;;
++
++let list_map_check f l =
++  let rec loop rev_l =
++    function
++      x :: l ->
++        begin match f x with
++          Some s -> loop (s :: rev_l) l
++        | None -> None
++        end
++    | [] -> Some (List.rev rev_l)
++  in
++  loop [] l
++;;
++
++let ocaml_value_description t p =
++  {pval_type = t; pval_prim = p; pval_loc = t.ptyp_loc}
++;;
++
++let ocaml_class_type_field loc ctfd = {pctf_desc = ctfd; pctf_loc = loc};;
++
++let ocaml_class_field loc cfd = {pcf_desc = cfd; pcf_loc = loc};;
++
++let ocaml_type_declaration params cl tk pf tm loc variance =
++  match list_map_check (fun s_opt -> s_opt) params with
++    Some params ->
++      let params = List.map (fun os -> Some (mknoloc os)) params in
++      Right
++        {ptype_params = params; ptype_cstrs = cl; ptype_kind = tk;
++         ptype_private = pf; ptype_manifest = tm; ptype_loc = loc;
++         ptype_variance = variance}
++  | None -> Left "no '_' type param in this ocaml version"
++;;
++
++let ocaml_class_type = Some (fun d loc -> {pcty_desc = d; pcty_loc = loc});;
++
++let ocaml_class_expr = Some (fun d loc -> {pcl_desc = d; pcl_loc = loc});;
++
++let ocaml_class_structure p cil = {pcstr_pat = p; pcstr_fields = cil};;
++
++let ocaml_pmty_ident loc li = Pmty_ident (mkloc loc li);;
++
++let ocaml_pmty_functor sloc s mt1 mt2 =
++  Pmty_functor (mkloc sloc s, mt1, mt2)
++;;
++
++let ocaml_pmty_typeof = Some (fun me -> Pmty_typeof me);;
++
++let ocaml_pmty_with mt lcl =
++  let lcl = List.map (fun (s, c) -> mknoloc s, c) lcl in Pmty_with (mt, lcl)
++;;
++
++let ocaml_ptype_abstract = Ptype_abstract;;
++
++let ocaml_ptype_record ltl priv =
++  Ptype_record
++    (List.map (fun (s, mf, ct, loc) -> mkloc loc s, mf, ct, loc) ltl)
++;;
++
++let ocaml_ptype_variant ctl priv =
++  try
++    let ctl =
++      List.map
++        (fun (c, tl, rto, loc) ->
++           if rto <> None then raise Exit else mknoloc c, tl, None, loc)
++        ctl
++    in
++    Some (Ptype_variant ctl)
++  with Exit -> None
++;;
++
++let ocaml_ptyp_arrow lab t1 t2 = Ptyp_arrow (lab, t1, t2);;
++
++let ocaml_ptyp_class li tl ll = Ptyp_class (mknoloc li, tl, ll);;
++
++let ocaml_ptyp_constr li tl = Ptyp_constr (mknoloc li, tl);;
++
++let ocaml_ptyp_package = Some (fun pt -> Ptyp_package pt);;
++
++let ocaml_ptyp_poly = Some (fun cl t -> Ptyp_poly (cl, t));;
++
++let ocaml_ptyp_variant catl clos sl_opt =
++  let catl =
++    List.map
++      (function
++         Left (c, a, tl) -> Rtag (c, a, tl)
++       | Right t -> Rinherit t)
++      catl
++  in
++  Some (Ptyp_variant (catl, clos, sl_opt))
++;;
++
++let ocaml_package_type li ltl =
++  mknoloc li, List.map (fun (li, t) -> mkloc t.ptyp_loc li, t) ltl
++;;
++
++let ocaml_const_int32 = Some (fun s -> Const_int32 (Int32.of_string s));;
++
++let ocaml_const_int64 = Some (fun s -> Const_int64 (Int64.of_string s));;
++
++let ocaml_const_nativeint =
++  Some (fun s -> Const_nativeint (Nativeint.of_string s))
++;;
++
++let ocaml_pexp_apply f lel = Pexp_apply (f, lel);;
++
++let ocaml_pexp_assertfalse fname loc = Pexp_assertfalse;;
++
++let ocaml_pexp_assert fname loc e = Pexp_assert e;;
++
++let ocaml_pexp_construct li po chk_arity =
++  Pexp_construct (mknoloc li, po, chk_arity)
++;;
++
++let ocaml_pexp_field e li = Pexp_field (e, mknoloc li);;
++
++let ocaml_pexp_for i e1 e2 df e = Pexp_for (mknoloc i, e1, e2, df, e);;
++
++let ocaml_pexp_function lab eo pel = Pexp_function (lab, eo, pel);;
++
++let ocaml_pexp_lazy = Some (fun e -> Pexp_lazy e);;
++
++let ocaml_pexp_ident li = Pexp_ident (mknoloc li);;
++
++let ocaml_pexp_letmodule =
++  Some (fun i me e -> Pexp_letmodule (mknoloc i, me, e))
++;;
++
++let ocaml_pexp_new loc li = Pexp_new (mkloc loc li);;
++
++let ocaml_pexp_newtype = Some (fun s e -> Pexp_newtype (s, e));;
++
++let ocaml_pexp_object = Some (fun cs -> Pexp_object cs);;
++
++let ocaml_pexp_open = Some (fun li e -> Pexp_open (mknoloc li, e));;
++
++let ocaml_pexp_override sel =
++  let sel = List.map (fun (s, e) -> mknoloc s, e) sel in Pexp_override sel
++;;
++
++let ocaml_pexp_pack : ('a -> 'b -> 'c, 'd) choice option =
++  Some (Right ((fun me -> Pexp_pack me), (fun pt -> Ptyp_package pt)))
++;;
++
++let ocaml_pexp_poly = Some (fun e t -> Pexp_poly (e, t));;
++
++let ocaml_pexp_record lel eo =
++  let lel = List.map (fun (li, loc, e) -> mkloc loc li, e) lel in
++  Pexp_record (lel, eo)
++;;
++
++let ocaml_pexp_setinstvar s e = Pexp_setinstvar (mknoloc s, e);;
++
++let ocaml_pexp_variant =
++  let pexp_variant_pat =
++    function
++      Pexp_variant (lab, eo) -> Some (lab, eo)
++    | _ -> None
++  in
++  let pexp_variant (lab, eo) = Pexp_variant (lab, eo) in
++  Some (pexp_variant_pat, pexp_variant)
++;;
++
++let ocaml_ppat_alias p i iloc = Ppat_alias (p, mkloc iloc i);;
++
++let ocaml_ppat_array = Some (fun pl -> Ppat_array pl);;
++
++let ocaml_ppat_construct li li_loc po chk_arity =
++  Ppat_construct (mkloc li_loc li, po, chk_arity)
++;;
++
++let ocaml_ppat_construct_args =
++  function
++    Ppat_construct (li, po, chk_arity) -> Some (li.txt, li.loc, po, chk_arity)
++  | _ -> None
++;;
++
++let ocaml_ppat_lazy = Some (fun p -> Ppat_lazy p);;
++
++let ocaml_ppat_record lpl is_closed =
++  let lpl = List.map (fun (li, loc, p) -> mkloc loc li, p) lpl in
++  Ppat_record (lpl, (if is_closed then Closed else Open))
++;;
++
++let ocaml_ppat_type = Some (fun loc li -> Ppat_type (mkloc loc li));;
++
++let ocaml_ppat_unpack =
++  Some ((fun loc s -> Ppat_unpack (mkloc loc s)), (fun pt -> Ptyp_package pt))
++;;
++
++let ocaml_ppat_var loc s = Ppat_var (mkloc loc s);;
++
++let ocaml_ppat_variant =
++  let ppat_variant_pat =
++    function
++      Ppat_variant (lab, po) -> Some (lab, po)
++    | _ -> None
++  in
++  let ppat_variant (lab, po) = Ppat_variant (lab, po) in
++  Some (ppat_variant_pat, ppat_variant)
++;;
++
++let ocaml_psig_class_type = Some (fun ctl -> Psig_class_type ctl);;
++
++let ocaml_psig_exception s ed = Psig_exception (mknoloc s, ed);;
++
++let ocaml_psig_module s mt = Psig_module (mknoloc s, mt);;
++
++let ocaml_psig_modtype s mtd = Psig_modtype (mknoloc s, mtd);;
++
++let ocaml_psig_open li = Psig_open (mknoloc li);;
++
++let ocaml_psig_recmodule =
++  let f ntl =
++    let ntl = List.map (fun (s, mt) -> mknoloc s, mt) ntl in
++    Psig_recmodule ntl
++  in
++  Some f
++;;
++
++let ocaml_psig_type stl =
++  let stl = List.map (fun (s, t) -> mknoloc s, t) stl in Psig_type stl
++;;
++
++let ocaml_psig_value s vd = Psig_value (mknoloc s, vd);;
++
++let ocaml_pstr_class_type = Some (fun ctl -> Pstr_class_type ctl);;
++
++let ocaml_pstr_exception s ed = Pstr_exception (mknoloc s, ed);;
++
++let ocaml_pstr_exn_rebind =
++  Some (fun s li -> Pstr_exn_rebind (mknoloc s, mknoloc li))
++;;
++
++let ocaml_pstr_include = Some (fun me -> Pstr_include me);;
++
++let ocaml_pstr_modtype s mt = Pstr_modtype (mknoloc s, mt);;
++
++let ocaml_pstr_module s me = Pstr_module (mknoloc s, me);;
++
++let ocaml_pstr_open li = Pstr_open (mknoloc li);;
++
++let ocaml_pstr_primitive s vd = Pstr_primitive (mknoloc s, vd);;
++
++let ocaml_pstr_recmodule =
++  let f nel =
++    Pstr_recmodule (List.map (fun (s, mt, me) -> mknoloc s, mt, me) nel)
++  in
++  Some f
++;;
++
++let ocaml_pstr_type stl =
++  let stl = List.map (fun (s, t) -> mknoloc s, t) stl in Pstr_type stl
++;;
++
++let ocaml_class_infos =
++  Some
++    (fun virt (sl, sloc) name expr loc variance ->
++       let params = List.map (fun s -> mkloc loc s) sl, sloc in
++       {pci_virt = virt; pci_params = params; pci_name = mkloc loc name;
++        pci_expr = expr; pci_loc = loc; pci_variance = variance})
++;;
++
++let ocaml_pmod_ident li = Pmod_ident (mknoloc li);;
++
++let ocaml_pmod_functor s mt me = Pmod_functor (mknoloc s, mt, me);;
++
++let ocaml_pmod_unpack : ('a -> 'b -> 'c, 'd) choice option =
++  Some (Right ((fun e -> Pmod_unpack e), (fun pt -> Ptyp_package pt)))
++;;
++
++let ocaml_pcf_cstr = Some (fun (t1, t2, loc) -> Pcf_constr (t1, t2));;
++
++let ocaml_pcf_inher ce pb = Pcf_inher (Fresh, ce, pb);;
++
++let ocaml_pcf_init = Some (fun e -> Pcf_init e);;
++
++let ocaml_pcf_meth (s, pf, ovf, e, loc) =
++  let pf = if pf then Private else Public in
++  let ovf = if ovf then Override else Fresh in
++  Pcf_meth (mkloc loc s, pf, ovf, e)
++;;
++
++let ocaml_pcf_val (s, mf, ovf, e, loc) =
++  let mf = if mf then Mutable else Immutable in
++  let ovf = if ovf then Override else Fresh in
++  Pcf_val (mkloc loc s, mf, ovf, e)
++;;
++
++let ocaml_pcf_valvirt =
++  let ocaml_pcf (s, mf, t, loc) =
++    let mf = if mf then Mutable else Immutable in
++    Pcf_valvirt (mkloc loc s, mf, t)
++  in
++  Some ocaml_pcf
++;;
++
++let ocaml_pcf_virt (s, pf, t, loc) = Pcf_virt (mkloc loc s, pf, t);;
++
++let ocaml_pcl_apply = Some (fun ce lel -> Pcl_apply (ce, lel));;
++
++let ocaml_pcl_constr = Some (fun li ctl -> Pcl_constr (mknoloc li, ctl));;
++
++let ocaml_pcl_constraint = Some (fun ce ct -> Pcl_constraint (ce, ct));;
++
++let ocaml_pcl_fun = Some (fun lab ceo p ce -> Pcl_fun (lab, ceo, p, ce));;
++
++let ocaml_pcl_let = Some (fun rf pel ce -> Pcl_let (rf, pel, ce));;
++
++let ocaml_pcl_structure = Some (fun cs -> Pcl_structure cs);;
++
++let ocaml_pctf_cstr = Some (fun (t1, t2, loc) -> Pctf_cstr (t1, t2));;
++
++let ocaml_pctf_meth (s, pf, t, loc) = Pctf_meth (s, pf, t);;
++
++let ocaml_pctf_val (s, mf, t, loc) = Pctf_val (s, mf, Concrete, t);;
++
++let ocaml_pctf_virt (s, pf, t, loc) = Pctf_virt (s, pf, t);;
++
++let ocaml_pcty_constr = Some (fun li ltl -> Pcty_constr (mknoloc li, ltl));;
++
++let ocaml_pcty_fun = Some (fun lab t ct -> Pcty_fun (lab, t, ct));;
++
++let ocaml_pcty_signature =
++  let f (t, ctfl) =
++    let cs = {pcsig_self = t; pcsig_fields = ctfl; pcsig_loc = t.ptyp_loc} in
++    Pcty_signature cs
++  in
++  Some f
++;;
++
++let ocaml_pdir_bool = Some (fun b -> Pdir_bool b);;
++
++let ocaml_pwith_modsubst =
++  Some (fun loc me -> Pwith_modsubst (mkloc loc me))
++;;
++
++let ocaml_pwith_module loc me = Pwith_module (mkloc loc me);;
++
++let ocaml_pwith_typesubst = Some (fun td -> Pwith_typesubst td);;
++
++let module_prefix_can_be_in_first_record_label_only = true;;
++
++let split_or_patterns_with_bindings = false;;
++
++let has_records_with_with = true;;
++
++(* *)
++
++let jocaml_pstr_def : (_ -> _) option = None;;
++
++let jocaml_pexp_def : (_ -> _ -> _) option = None;;
++
++let jocaml_pexp_par : (_ -> _ -> _) option = None;;
++
++let jocaml_pexp_reply : (_ -> _ -> _ -> _) option = None;;
++
++let jocaml_pexp_spawn : (_ -> _) option = None;;
++
++let arg_rest =
++  function
++    Arg.Rest r -> Some r
++  | _ -> None
++;;
++
++let arg_set_string =
++  function
++    Arg.Set_string r -> Some r
++  | _ -> None
++;;
++
++let arg_set_int =
++  function
++    Arg.Set_int r -> Some r
++  | _ -> None
++;;
++
++let arg_set_float =
++  function
++    Arg.Set_float r -> Some r
++  | _ -> None
++;;
++
++let arg_symbol =
++  function
++    Arg.Symbol (s, f) -> Some (s, f)
++  | _ -> None
++;;
++
++let arg_tuple =
++  function
++    Arg.Tuple t -> Some t
++  | _ -> None
++;;
++
++let arg_bool =
++  function
++    Arg.Bool f -> Some f
++  | _ -> None
++;;
++
++let char_escaped = Char.escaped;;
++
++let hashtbl_mem = Hashtbl.mem;;
++
++let list_rev_append = List.rev_append;;
++
++let list_rev_map = List.rev_map;;
++
++let list_sort = List.sort;;
++
++let pervasives_set_binary_mode_out = Pervasives.set_binary_mode_out;;
++
++let printf_ksprintf = Printf.ksprintf;;
++
++let string_contains = String.contains;;
+diff -r -u -N camlp5-6.06.orig/ocaml_stuff/4.00.1/parsing/.cvsignore camlp5-6.06/ocaml_stuff/4.00.1/parsing/.cvsignore
+--- camlp5-6.06.orig/ocaml_stuff/4.00.1/parsing/.cvsignore	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.1/parsing/.cvsignore	2012-07-31 16:52:22.000000000 +0200
+@@ -0,0 +1 @@
++*.cm[oi]
+diff -r -u -N camlp5-6.06.orig/ocaml_stuff/4.00.1/parsing/.depend camlp5-6.06/ocaml_stuff/4.00.1/parsing/.depend
+--- camlp5-6.06.orig/ocaml_stuff/4.00.1/parsing/.depend	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.1/parsing/.depend	2012-07-31 16:52:22.000000000 +0200
+@@ -0,0 +1,4 @@
++asttypes.cmi : location.cmi
++location.cmi : ../utils/warnings.cmi
++longident.cmi :
++parsetree.cmi : longident.cmi location.cmi asttypes.cmi
+diff -r -u -N camlp5-6.06.orig/ocaml_stuff/4.00.1/parsing/Makefile camlp5-6.06/ocaml_stuff/4.00.1/parsing/Makefile
+--- camlp5-6.06.orig/ocaml_stuff/4.00.1/parsing/Makefile	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.1/parsing/Makefile	2012-07-31 16:52:22.000000000 +0200
+@@ -0,0 +1,19 @@
++# Id
++
++FILES=asttypes.cmi location.cmi longident.cmi parsetree.cmi
++INCL=-I ../utils
++
++all: $(FILES)
++
++clean:
++	rm -f *.cmi
++
++depend:
++	ocamldep $(INCL) *.ml* | sed -e 's/  *$$//' > .depend
++
++.SUFFIXES: .mli .cmi
++
++.mli.cmi:
++	$(OCAMLN)c $(INCL) -c $<
++
++include .depend
+diff -r -u -N camlp5-6.06.orig/ocaml_stuff/4.00.1/parsing/asttypes.mli camlp5-6.06/ocaml_stuff/4.00.1/parsing/asttypes.mli
+--- camlp5-6.06.orig/ocaml_stuff/4.00.1/parsing/asttypes.mli	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.1/parsing/asttypes.mli	2012-07-31 16:52:22.000000000 +0200
+@@ -0,0 +1,45 @@
++(***********************************************************************)
++(*                                                                     *)
++(*                                OCaml                                *)
++(*                                                                     *)
++(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
++(*                                                                     *)
++(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
++(*  en Automatique.  All rights reserved.  This file is distributed    *)
++(*  under the terms of the Q Public License version 1.0.               *)
++(*                                                                     *)
++(***********************************************************************)
++
++(* Id *)
++
++(* Auxiliary a.s.t. types used by parsetree and typedtree. *)
++
++type constant =
++    Const_int of int
++  | Const_char of char
++  | Const_string of string
++  | Const_float of string
++  | Const_int32 of int32
++  | Const_int64 of int64
++  | Const_nativeint of nativeint
++
++type rec_flag = Nonrecursive | Recursive | Default
++
++type direction_flag = Upto | Downto
++
++type private_flag = Private | Public
++
++type mutable_flag = Immutable | Mutable
++
++type virtual_flag = Virtual | Concrete
++
++type override_flag = Override | Fresh
++
++type closed_flag = Closed | Open
++
++type label = string
++
++type 'a loc = 'a Location.loc = {
++  txt : 'a;
++  loc : Location.t;
++}
+diff -r -u -N camlp5-6.06.orig/ocaml_stuff/4.00.1/parsing/location.mli camlp5-6.06/ocaml_stuff/4.00.1/parsing/location.mli
+--- camlp5-6.06.orig/ocaml_stuff/4.00.1/parsing/location.mli	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.1/parsing/location.mli	2012-07-31 16:52:22.000000000 +0200
+@@ -0,0 +1,80 @@
++(***********************************************************************)
++(*                                                                     *)
++(*                                OCaml                                *)
++(*                                                                     *)
++(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
++(*                                                                     *)
++(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
++(*  en Automatique.  All rights reserved.  This file is distributed    *)
++(*  under the terms of the Q Public License version 1.0.               *)
++(*                                                                     *)
++(***********************************************************************)
++
++(* Id *)
++
++(* Source code locations (ranges of positions), used in parsetree. *)
++
++open Format
++
++type t = {
++  loc_start: Lexing.position;
++  loc_end: Lexing.position;
++  loc_ghost: bool;
++}
++
++(* Note on the use of Lexing.position in this module.
++   If [pos_fname = ""], then use [!input_name] instead.
++   If [pos_lnum = -1], then [pos_bol = 0]. Use [pos_cnum] and
++     re-parse the file to get the line and character numbers.
++   Else all fields are correct.
++*)
++
++val none : t
++(** An arbitrary value of type [t]; describes an empty ghost range. *)
++val in_file : string -> t;;
++(** Return an empty ghost range located in a given file. *)
++val init : Lexing.lexbuf -> string -> unit
++(** Set the file name and line number of the [lexbuf] to be the start
++    of the named file. *)
++val curr : Lexing.lexbuf -> t
++(** Get the location of the current token from the [lexbuf]. *)
++
++val symbol_rloc: unit -> t
++val symbol_gloc: unit -> t
++
++(** [rhs_loc n] returns the location of the symbol at position [n], starting
++  at 1, in the current parser rule. *)
++val rhs_loc: int -> t
++
++val input_name: string ref
++val input_lexbuf: Lexing.lexbuf option ref
++
++val get_pos_info: Lexing.position -> string * int * int (* file, line, char *)
++val print_loc: formatter -> t -> unit
++val print_error: formatter -> t -> unit
++val print_error_cur_file: formatter -> unit
++val print_warning: t -> formatter -> Warnings.t -> unit
++val prerr_warning: t -> Warnings.t -> unit
++val echo_eof: unit -> unit
++val reset: unit -> unit
++
++val highlight_locations: formatter -> t -> t -> bool
++
++type 'a loc = {
++  txt : 'a;
++  loc : t;
++}
++
++val mknoloc : 'a -> 'a loc
++val mkloc : 'a -> t -> 'a loc
++
++val print: formatter -> t -> unit
++val print_filename: formatter -> string -> unit
++
++val show_filename: string -> string
++    (** In -absname mode, return the absolute path for this filename.
++        Otherwise, returns the filename unchanged. *)
++
++
++val absname: bool ref
++
+diff -r -u -N camlp5-6.06.orig/ocaml_stuff/4.00.1/parsing/longident.mli camlp5-6.06/ocaml_stuff/4.00.1/parsing/longident.mli
+--- camlp5-6.06.orig/ocaml_stuff/4.00.1/parsing/longident.mli	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.1/parsing/longident.mli	2012-07-31 16:52:22.000000000 +0200
+@@ -0,0 +1,24 @@
++(***********************************************************************)
++(*                                                                     *)
++(*                                OCaml                                *)
++(*                                                                     *)
++(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
++(*                                                                     *)
++(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
++(*  en Automatique.  All rights reserved.  This file is distributed    *)
++(*  under the terms of the Q Public License version 1.0.               *)
++(*                                                                     *)
++(***********************************************************************)
++
++(* Id *)
++
++(* Long identifiers, used in parsetree. *)
++
++type t =
++    Lident of string
++  | Ldot of t * string
++  | Lapply of t * t
++
++val flatten: t -> string list
++val last: t -> string
++val parse: string -> t
+diff -r -u -N camlp5-6.06.orig/ocaml_stuff/4.00.1/parsing/parsetree.mli camlp5-6.06/ocaml_stuff/4.00.1/parsing/parsetree.mli
+--- camlp5-6.06.orig/ocaml_stuff/4.00.1/parsing/parsetree.mli	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.1/parsing/parsetree.mli	2012-07-31 16:52:22.000000000 +0200
+@@ -0,0 +1,307 @@
++(***********************************************************************)
++(*                                                                     *)
++(*                                OCaml                                *)
++(*                                                                     *)
++(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
++(*                                                                     *)
++(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
++(*  en Automatique.  All rights reserved.  This file is distributed    *)
++(*  under the terms of the Q Public License version 1.0.               *)
++(*                                                                     *)
++(***********************************************************************)
++
++(* Id *)
++
++(* Abstract syntax tree produced by parsing *)
++
++open Asttypes
++
++(* Type expressions for the core language *)
++
++type core_type =
++  { ptyp_desc: core_type_desc;
++    ptyp_loc: Location.t }
++
++and core_type_desc =
++    Ptyp_any
++  | Ptyp_var of string
++  | Ptyp_arrow of label * core_type * core_type
++  | Ptyp_tuple of core_type list
++  | Ptyp_constr of Longident.t loc * core_type list
++  | Ptyp_object of core_field_type list
++  | Ptyp_class of Longident.t loc * core_type list * label list
++  | Ptyp_alias of core_type * string
++  | Ptyp_variant of row_field list * bool * label list option
++  | Ptyp_poly of string list * core_type
++  | Ptyp_package of package_type
++
++
++and package_type = Longident.t loc * (Longident.t loc * core_type) list
++
++and core_field_type =
++  { pfield_desc: core_field_desc;
++    pfield_loc: Location.t }
++
++and core_field_desc =
++    Pfield of string * core_type
++  | Pfield_var
++
++and row_field =
++    Rtag of label * bool * core_type list
++  | Rinherit of core_type
++
++(* Type expressions for the class language *)
++
++type 'a class_infos =
++  { pci_virt: virtual_flag;
++    pci_params: string loc list * Location.t;
++    pci_name: string loc;
++    pci_expr: 'a;
++    pci_variance: (bool * bool) list;
++    pci_loc: Location.t }
++
++(* Value expressions for the core language *)
++
++type pattern =
++  { ppat_desc: pattern_desc;
++    ppat_loc: Location.t }
++
++and pattern_desc =
++    Ppat_any
++  | Ppat_var of string loc
++  | Ppat_alias of pattern * string loc
++  | Ppat_constant of constant
++  | Ppat_tuple of pattern list
++  | Ppat_construct of Longident.t loc * pattern option * bool
++  | Ppat_variant of label * pattern option
++  | Ppat_record of (Longident.t loc * pattern) list * closed_flag
++  | Ppat_array of pattern list
++  | Ppat_or of pattern * pattern
++  | Ppat_constraint of pattern * core_type
++  | Ppat_type of Longident.t loc
++  | Ppat_lazy of pattern
++  | Ppat_unpack of string loc
++
++type expression =
++  { pexp_desc: expression_desc;
++    pexp_loc: Location.t }
++
++and expression_desc =
++    Pexp_ident of Longident.t loc
++  | Pexp_constant of constant
++  | Pexp_let of rec_flag * (pattern * expression) list * expression
++  | Pexp_function of label * expression option * (pattern * expression) list
++  | Pexp_apply of expression * (label * expression) list
++  | Pexp_match of expression * (pattern * expression) list
++  | Pexp_try of expression * (pattern * expression) list
++  | Pexp_tuple of expression list
++  | Pexp_construct of Longident.t loc * expression option * bool
++  | Pexp_variant of label * expression option
++  | Pexp_record of (Longident.t loc * expression) list * expression option
++  | Pexp_field of expression * Longident.t loc
++  | Pexp_setfield of expression * Longident.t loc * expression
++  | Pexp_array of expression list
++  | Pexp_ifthenelse of expression * expression * expression option
++  | Pexp_sequence of expression * expression
++  | Pexp_while of expression * expression
++  | Pexp_for of string loc *  expression * expression * direction_flag * expression
++  | Pexp_constraint of expression * core_type option * core_type option
++  | Pexp_when of expression * expression
++  | Pexp_send of expression * string
++  | Pexp_new of Longident.t loc
++  | Pexp_setinstvar of string loc * expression
++  | Pexp_override of (string loc * expression) list
++  | Pexp_letmodule of string loc * module_expr * expression
++  | Pexp_assert of expression
++  | Pexp_assertfalse
++  | Pexp_lazy of expression
++  | Pexp_poly of expression * core_type option
++  | Pexp_object of class_structure
++  | Pexp_newtype of string * expression
++  | Pexp_pack of module_expr
++  | Pexp_open of Longident.t loc * expression
++
++(* Value descriptions *)
++
++and value_description =
++  { pval_type: core_type;
++    pval_prim: string list;
++    pval_loc : Location.t
++    }
++
++(* Type declarations *)
++
++and type_declaration =
++  { ptype_params: string loc option list;
++    ptype_cstrs: (core_type * core_type * Location.t) list;
++    ptype_kind: type_kind;
++    ptype_private: private_flag;
++    ptype_manifest: core_type option;
++    ptype_variance: (bool * bool) list;
++    ptype_loc: Location.t }
++
++and type_kind =
++    Ptype_abstract
++  | Ptype_variant of
++      (string loc * core_type list * core_type option * Location.t) list
++  | Ptype_record of
++      (string loc * mutable_flag * core_type * Location.t) list
++
++and exception_declaration = core_type list
++
++(* Type expressions for the class language *)
++
++and class_type =
++  { pcty_desc: class_type_desc;
++    pcty_loc: Location.t }
++
++and class_type_desc =
++    Pcty_constr of Longident.t loc * core_type list
++  | Pcty_signature of class_signature
++  | Pcty_fun of label * core_type * class_type
++
++and class_signature = {
++    pcsig_self : core_type;
++    pcsig_fields : class_type_field list;
++    pcsig_loc : Location.t;
++  }
++
++and class_type_field = {
++    pctf_desc : class_type_field_desc;
++    pctf_loc : Location.t;
++  }
++
++and class_type_field_desc =
++    Pctf_inher of class_type
++  | Pctf_val of (string * mutable_flag * virtual_flag * core_type)
++  | Pctf_virt  of (string * private_flag * core_type)
++  | Pctf_meth  of (string * private_flag * core_type)
++  | Pctf_cstr  of (core_type * core_type)
++
++and class_description = class_type class_infos
++
++and class_type_declaration = class_type class_infos
++
++(* Value expressions for the class language *)
++
++and class_expr =
++  { pcl_desc: class_expr_desc;
++    pcl_loc: Location.t }
++
++and class_expr_desc =
++    Pcl_constr of Longident.t loc * core_type list
++  | Pcl_structure of class_structure
++  | Pcl_fun of label * expression option * pattern * class_expr
++  | Pcl_apply of class_expr * (label * expression) list
++  | Pcl_let of rec_flag * (pattern * expression) list * class_expr
++  | Pcl_constraint of class_expr * class_type
++
++and class_structure = {
++    pcstr_pat : pattern;
++    pcstr_fields :  class_field list;
++  }
++
++and class_field = {
++    pcf_desc : class_field_desc;
++    pcf_loc : Location.t;
++  }
++
++and class_field_desc =
++    Pcf_inher of override_flag * class_expr * string option
++  | Pcf_valvirt of (string loc * mutable_flag * core_type)
++  | Pcf_val of (string loc * mutable_flag * override_flag * expression)
++  | Pcf_virt  of (string loc * private_flag * core_type)
++  | Pcf_meth of (string loc * private_flag *override_flag * expression)
++  | Pcf_constr  of (core_type * core_type)
++  | Pcf_init  of expression
++
++and class_declaration = class_expr class_infos
++
++(* Type expressions for the module language *)
++
++and module_type =
++  { pmty_desc: module_type_desc;
++    pmty_loc: Location.t }
++
++and module_type_desc =
++    Pmty_ident of Longident.t loc
++  | Pmty_signature of signature
++  | Pmty_functor of string loc * module_type * module_type
++  | Pmty_with of module_type * (Longident.t loc * with_constraint) list
++  | Pmty_typeof of module_expr
++
++and signature = signature_item list
++
++and signature_item =
++  { psig_desc: signature_item_desc;
++    psig_loc: Location.t }
++
++and signature_item_desc =
++    Psig_value of string loc * value_description
++  | Psig_type of (string loc * type_declaration) list
++  | Psig_exception of string loc * exception_declaration
++  | Psig_module of string loc * module_type
++  | Psig_recmodule of (string loc * module_type) list
++  | Psig_modtype of string loc * modtype_declaration
++  | Psig_open of Longident.t loc
++  | Psig_include of module_type
++  | Psig_class of class_description list
++  | Psig_class_type of class_type_declaration list
++
++and modtype_declaration =
++    Pmodtype_abstract
++  | Pmodtype_manifest of module_type
++
++and with_constraint =
++    Pwith_type of type_declaration
++  | Pwith_module of Longident.t loc
++  | Pwith_typesubst of type_declaration
++  | Pwith_modsubst of Longident.t loc
++
++(* Value expressions for the module language *)
++
++and module_expr =
++  { pmod_desc: module_expr_desc;
++    pmod_loc: Location.t }
++
++and module_expr_desc =
++    Pmod_ident of Longident.t loc
++  | Pmod_structure of structure
++  | Pmod_functor of string loc * module_type * module_expr
++  | Pmod_apply of module_expr * module_expr
++  | Pmod_constraint of module_expr * module_type
++  | Pmod_unpack of expression
++
++and structure = structure_item list
++
++and structure_item =
++  { pstr_desc: structure_item_desc;
++    pstr_loc: Location.t }
++
++and structure_item_desc =
++    Pstr_eval of expression
++  | Pstr_value of rec_flag * (pattern * expression) list
++  | Pstr_primitive of string loc * value_description
++  | Pstr_type of (string loc * type_declaration) list
++  | Pstr_exception of string loc * exception_declaration
++  | Pstr_exn_rebind of string loc * Longident.t loc
++  | Pstr_module of string loc * module_expr
++  | Pstr_recmodule of (string loc * module_type * module_expr) list
++  | Pstr_modtype of string loc * module_type
++  | Pstr_open of Longident.t loc
++  | Pstr_class of class_declaration list
++  | Pstr_class_type of class_type_declaration list
++  | Pstr_include of module_expr
++
++(* Toplevel phrases *)
++
++type toplevel_phrase =
++    Ptop_def of structure
++  | Ptop_dir of string * directive_argument
++
++and directive_argument =
++    Pdir_none
++  | Pdir_string of string
++  | Pdir_int of int
++  | Pdir_ident of Longident.t
++  | Pdir_bool of bool
+diff -r -u -N camlp5-6.06.orig/ocaml_stuff/4.00.1/utils/.cvsignore camlp5-6.06/ocaml_stuff/4.00.1/utils/.cvsignore
+--- camlp5-6.06.orig/ocaml_stuff/4.00.1/utils/.cvsignore	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.1/utils/.cvsignore	2012-07-31 16:52:22.000000000 +0200
+@@ -0,0 +1 @@
++*.cm[oix]
+diff -r -u -N camlp5-6.06.orig/ocaml_stuff/4.00.1/utils/.depend camlp5-6.06/ocaml_stuff/4.00.1/utils/.depend
+--- camlp5-6.06.orig/ocaml_stuff/4.00.1/utils/.depend	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.1/utils/.depend	2012-07-31 16:52:22.000000000 +0200
+@@ -0,0 +1,4 @@
++pconfig.cmo : pconfig.cmi
++pconfig.cmx : pconfig.cmi
++pconfig.cmi :
++warnings.cmi :
+diff -r -u -N camlp5-6.06.orig/ocaml_stuff/4.00.1/utils/Makefile camlp5-6.06/ocaml_stuff/4.00.1/utils/Makefile
+--- camlp5-6.06.orig/ocaml_stuff/4.00.1/utils/Makefile	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.1/utils/Makefile	2012-07-31 16:52:22.000000000 +0200
+@@ -0,0 +1,27 @@
++# Id
++
++FILES=warnings.cmi pconfig.cmo
++INCL=
++
++all: $(FILES)
++
++opt: pconfig.cmx
++
++clean:
++	rm -f *.cm[oix] *.o
++
++depend:
++	ocamldep $(INCL) *.ml* | sed -e 's/  *$$//' > .depend
++
++.SUFFIXES: .mli .cmi .ml .cmo .cmx
++
++.mli.cmi:
++	$(OCAMLN)c $(INCL) -c $<
++
++.ml.cmo:
++	$(OCAMLN)c $(INCL) -c $<
++
++.ml.cmx:
++	$(OCAMLN)opt $(INCL) -c $<
++
++include .depend
+diff -r -u -N camlp5-6.06.orig/ocaml_stuff/4.00.1/utils/pconfig.ml camlp5-6.06/ocaml_stuff/4.00.1/utils/pconfig.ml
+--- camlp5-6.06.orig/ocaml_stuff/4.00.1/utils/pconfig.ml	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.1/utils/pconfig.ml	2012-07-31 16:53:40.000000000 +0200
+@@ -0,0 +1,4 @@
++let ocaml_version = "4.00.1"
++let ocaml_name = "ocaml"
++let ast_impl_magic_number = "Caml1999M015"
++let ast_intf_magic_number = "Caml1999N014"
+diff -r -u -N camlp5-6.06.orig/ocaml_stuff/4.00.1/utils/pconfig.mli camlp5-6.06/ocaml_stuff/4.00.1/utils/pconfig.mli
+--- camlp5-6.06.orig/ocaml_stuff/4.00.1/utils/pconfig.mli	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.1/utils/pconfig.mli	2012-07-31 16:52:22.000000000 +0200
+@@ -0,0 +1,4 @@
++val ocaml_version : string
++val ocaml_name : string
++val ast_impl_magic_number : string
++val ast_intf_magic_number : string
+diff -r -u -N camlp5-6.06.orig/ocaml_stuff/4.00.1/utils/warnings.mli camlp5-6.06/ocaml_stuff/4.00.1/utils/warnings.mli
+--- camlp5-6.06.orig/ocaml_stuff/4.00.1/utils/warnings.mli	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.1/utils/warnings.mli	2012-07-31 16:52:22.000000000 +0200
+@@ -0,0 +1,75 @@
++(***********************************************************************)
++(*                                                                     *)
++(*                                OCaml                                *)
++(*                                                                     *)
++(*            Pierre Weis && Damien Doligez, INRIA Rocquencourt        *)
++(*                                                                     *)
++(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
++(*  en Automatique.  All rights reserved.  This file is distributed    *)
++(*  under the terms of the Q Public License version 1.0.               *)
++(*                                                                     *)
++(***********************************************************************)
++
++(* Id *)
++
++open Format
++
++type t =
++  | Comment_start                           (*  1 *)
++  | Comment_not_end                         (*  2 *)
++  | Deprecated                              (*  3 *)
++  | Fragile_match of string                 (*  4 *)
++  | Partial_application                     (*  5 *)
++  | Labels_omitted                          (*  6 *)
++  | Method_override of string list          (*  7 *)
++  | Partial_match of string                 (*  8 *)
++  | Non_closed_record_pattern of string     (*  9 *)
++  | Statement_type                          (* 10 *)
++  | Unused_match                            (* 11 *)
++  | Unused_pat                              (* 12 *)
++  | Instance_variable_override of string list (* 13 *)
++  | Illegal_backslash                       (* 14 *)
++  | Implicit_public_methods of string list  (* 15 *)
++  | Unerasable_optional_argument            (* 16 *)
++  | Undeclared_virtual_method of string     (* 17 *)
++  | Not_principal of string                 (* 18 *)
++  | Without_principality of string          (* 19 *)
++  | Unused_argument                         (* 20 *)
++  | Nonreturning_statement                  (* 21 *)
++  | Camlp4 of string                        (* 22 *)
++  | Useless_record_with                     (* 23 *)
++  | Bad_module_name of string               (* 24 *)
++  | All_clauses_guarded                     (* 25 *)
++  | Unused_var of string                    (* 26 *)
++  | Unused_var_strict of string             (* 27 *)
++  | Wildcard_arg_to_constant_constr         (* 28 *)
++  | Eol_in_string                           (* 29 *)
++  | Duplicate_definitions of string * string * string * string (*30 *)
++  | Multiple_definition of string * string * string (* 31 *)
++  | Unused_value_declaration of string      (* 32 *)
++  | Unused_open of string                   (* 33 *)
++  | Unused_type_declaration of string       (* 34 *)
++  | Unused_for_index of string              (* 35 *)
++  | Unused_ancestor of string               (* 36 *)
++  | Unused_constructor of string * bool * bool  (* 37 *)
++  | Unused_exception of string * bool       (* 38 *)
++  | Unused_rec_flag                         (* 39 *)
++;;
++
++val parse_options : bool -> string -> unit;;
++
++val is_active : t -> bool;;
++val is_error : t -> bool;;
++
++val defaults_w : string;;
++val defaults_warn_error : string;;
++
++val print : formatter -> t -> int;;
++  (* returns the number of newlines in the printed string *)
++
++
++exception Errors of int;;
++
++val check_fatal : unit -> unit;;
++
++val help_warnings: unit -> unit
+--- camlp5-6.06/ocaml_stuff/4.01.0/utils/warnings.mli.orig	2013-02-18 15:14:16.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.01.0/utils/warnings.mli	2013-02-18 15:14:31.000000000 +0100
+@@ -54,6 +54,10 @@
+   | Unused_constructor of string * bool * bool  (* 37 *)
+   | Unused_exception of string * bool       (* 38 *)
+   | Unused_rec_flag                         (* 39 *)
++  | Name_out_of_scope of string list * bool (* 40 *)
++  | Ambiguous_name of string list * bool    (* 41 *)
++  | Disambiguated_name of string            (* 42 *)
++  | Nonoptional_label of string             (* 43 *)
+ ;;
+ 
+ val parse_options : bool -> string -> unit;;
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/.cvsignore camlp5-6.06/ocaml_stuff/4.00.2/parsing/.cvsignore
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/.cvsignore	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/parsing/.cvsignore	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1 @@
++*.cm[oi]
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/.depend camlp5-6.06/ocaml_stuff/4.00.2/parsing/.depend
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/.depend	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/parsing/.depend	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,4 @@
++asttypes.cmi : location.cmi
++location.cmi : ../utils/warnings.cmi
++longident.cmi :
++parsetree.cmi : longident.cmi location.cmi asttypes.cmi
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/Makefile camlp5-6.06/ocaml_stuff/4.00.2/parsing/Makefile
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/Makefile	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/parsing/Makefile	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,19 @@
++# Id
++
++FILES=asttypes.cmi location.cmi longident.cmi parsetree.cmi
++INCL=-I ../utils
++
++all: $(FILES)
++
++clean:
++	rm -f *.cmi
++
++depend:
++	ocamldep $(INCL) *.ml* | sed -e 's/  *$$//' > .depend
++
++.SUFFIXES: .mli .cmi
++
++.mli.cmi:
++	$(OCAMLN)c $(INCL) -c $<
++
++include .depend
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/asttypes.mli camlp5-6.06/ocaml_stuff/4.00.2/parsing/asttypes.mli
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/asttypes.mli	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/parsing/asttypes.mli	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,45 @@
++(***********************************************************************)
++(*                                                                     *)
++(*                                OCaml                                *)
++(*                                                                     *)
++(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
++(*                                                                     *)
++(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
++(*  en Automatique.  All rights reserved.  This file is distributed    *)
++(*  under the terms of the Q Public License version 1.0.               *)
++(*                                                                     *)
++(***********************************************************************)
++
++(* Id *)
++
++(* Auxiliary a.s.t. types used by parsetree and typedtree. *)
++
++type constant =
++    Const_int of int
++  | Const_char of char
++  | Const_string of string
++  | Const_float of string
++  | Const_int32 of int32
++  | Const_int64 of int64
++  | Const_nativeint of nativeint
++
++type rec_flag = Nonrecursive | Recursive | Default
++
++type direction_flag = Upto | Downto
++
++type private_flag = Private | Public
++
++type mutable_flag = Immutable | Mutable
++
++type virtual_flag = Virtual | Concrete
++
++type override_flag = Override | Fresh
++
++type closed_flag = Closed | Open
++
++type label = string
++
++type 'a loc = 'a Location.loc = {
++  txt : 'a;
++  loc : Location.t;
++}
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/location.mli camlp5-6.06/ocaml_stuff/4.00.2/parsing/location.mli
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/location.mli	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/parsing/location.mli	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,80 @@
++(***********************************************************************)
++(*                                                                     *)
++(*                                OCaml                                *)
++(*                                                                     *)
++(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
++(*                                                                     *)
++(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
++(*  en Automatique.  All rights reserved.  This file is distributed    *)
++(*  under the terms of the Q Public License version 1.0.               *)
++(*                                                                     *)
++(***********************************************************************)
++
++(* Id *)
++
++(* Source code locations (ranges of positions), used in parsetree. *)
++
++open Format
++
++type t = {
++  loc_start: Lexing.position;
++  loc_end: Lexing.position;
++  loc_ghost: bool;
++}
++
++(* Note on the use of Lexing.position in this module.
++   If [pos_fname = ""], then use [!input_name] instead.
++   If [pos_lnum = -1], then [pos_bol = 0]. Use [pos_cnum] and
++     re-parse the file to get the line and character numbers.
++   Else all fields are correct.
++*)
++
++val none : t
++(** An arbitrary value of type [t]; describes an empty ghost range. *)
++val in_file : string -> t;;
++(** Return an empty ghost range located in a given file. *)
++val init : Lexing.lexbuf -> string -> unit
++(** Set the file name and line number of the [lexbuf] to be the start
++    of the named file. *)
++val curr : Lexing.lexbuf -> t
++(** Get the location of the current token from the [lexbuf]. *)
++
++val symbol_rloc: unit -> t
++val symbol_gloc: unit -> t
++
++(** [rhs_loc n] returns the location of the symbol at position [n], starting
++  at 1, in the current parser rule. *)
++val rhs_loc: int -> t
++
++val input_name: string ref
++val input_lexbuf: Lexing.lexbuf option ref
++
++val get_pos_info: Lexing.position -> string * int * int (* file, line, char *)
++val print_loc: formatter -> t -> unit
++val print_error: formatter -> t -> unit
++val print_error_cur_file: formatter -> unit
++val print_warning: t -> formatter -> Warnings.t -> unit
++val prerr_warning: t -> Warnings.t -> unit
++val echo_eof: unit -> unit
++val reset: unit -> unit
++
++val highlight_locations: formatter -> t -> t -> bool
++
++type 'a loc = {
++  txt : 'a;
++  loc : t;
++}
++
++val mknoloc : 'a -> 'a loc
++val mkloc : 'a -> t -> 'a loc
++
++val print: formatter -> t -> unit
++val print_filename: formatter -> string -> unit
++
++val show_filename: string -> string
++    (** In -absname mode, return the absolute path for this filename.
++        Otherwise, returns the filename unchanged. *)
++
++
++val absname: bool ref
++
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/longident.mli camlp5-6.06/ocaml_stuff/4.00.2/parsing/longident.mli
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/longident.mli	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/parsing/longident.mli	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,24 @@
++(***********************************************************************)
++(*                                                                     *)
++(*                                OCaml                                *)
++(*                                                                     *)
++(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
++(*                                                                     *)
++(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
++(*  en Automatique.  All rights reserved.  This file is distributed    *)
++(*  under the terms of the Q Public License version 1.0.               *)
++(*                                                                     *)
++(***********************************************************************)
++
++(* Id *)
++
++(* Long identifiers, used in parsetree. *)
++
++type t =
++    Lident of string
++  | Ldot of t * string
++  | Lapply of t * t
++
++val flatten: t -> string list
++val last: t -> string
++val parse: string -> t
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/parsetree.mli camlp5-6.06/ocaml_stuff/4.00.2/parsing/parsetree.mli
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/parsetree.mli	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/parsing/parsetree.mli	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,307 @@
++(***********************************************************************)
++(*                                                                     *)
++(*                                OCaml                                *)
++(*                                                                     *)
++(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
++(*                                                                     *)
++(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
++(*  en Automatique.  All rights reserved.  This file is distributed    *)
++(*  under the terms of the Q Public License version 1.0.               *)
++(*                                                                     *)
++(***********************************************************************)
++
++(* Id *)
++
++(* Abstract syntax tree produced by parsing *)
++
++open Asttypes
++
++(* Type expressions for the core language *)
++
++type core_type =
++  { ptyp_desc: core_type_desc;
++    ptyp_loc: Location.t }
++
++and core_type_desc =
++    Ptyp_any
++  | Ptyp_var of string
++  | Ptyp_arrow of label * core_type * core_type
++  | Ptyp_tuple of core_type list
++  | Ptyp_constr of Longident.t loc * core_type list
++  | Ptyp_object of core_field_type list
++  | Ptyp_class of Longident.t loc * core_type list * label list
++  | Ptyp_alias of core_type * string
++  | Ptyp_variant of row_field list * bool * label list option
++  | Ptyp_poly of string list * core_type
++  | Ptyp_package of package_type
++
++
++and package_type = Longident.t loc * (Longident.t loc * core_type) list
++
++and core_field_type =
++  { pfield_desc: core_field_desc;
++    pfield_loc: Location.t }
++
++and core_field_desc =
++    Pfield of string * core_type
++  | Pfield_var
++
++and row_field =
++    Rtag of label * bool * core_type list
++  | Rinherit of core_type
++
++(* Type expressions for the class language *)
++
++type 'a class_infos =
++  { pci_virt: virtual_flag;
++    pci_params: string loc list * Location.t;
++    pci_name: string loc;
++    pci_expr: 'a;
++    pci_variance: (bool * bool) list;
++    pci_loc: Location.t }
++
++(* Value expressions for the core language *)
++
++type pattern =
++  { ppat_desc: pattern_desc;
++    ppat_loc: Location.t }
++
++and pattern_desc =
++    Ppat_any
++  | Ppat_var of string loc
++  | Ppat_alias of pattern * string loc
++  | Ppat_constant of constant
++  | Ppat_tuple of pattern list
++  | Ppat_construct of Longident.t loc * pattern option * bool
++  | Ppat_variant of label * pattern option
++  | Ppat_record of (Longident.t loc * pattern) list * closed_flag
++  | Ppat_array of pattern list
++  | Ppat_or of pattern * pattern
++  | Ppat_constraint of pattern * core_type
++  | Ppat_type of Longident.t loc
++  | Ppat_lazy of pattern
++  | Ppat_unpack of string loc
++
++type expression =
++  { pexp_desc: expression_desc;
++    pexp_loc: Location.t }
++
++and expression_desc =
++    Pexp_ident of Longident.t loc
++  | Pexp_constant of constant
++  | Pexp_let of rec_flag * (pattern * expression) list * expression
++  | Pexp_function of label * expression option * (pattern * expression) list
++  | Pexp_apply of expression * (label * expression) list
++  | Pexp_match of expression * (pattern * expression) list
++  | Pexp_try of expression * (pattern * expression) list
++  | Pexp_tuple of expression list
++  | Pexp_construct of Longident.t loc * expression option * bool
++  | Pexp_variant of label * expression option
++  | Pexp_record of (Longident.t loc * expression) list * expression option
++  | Pexp_field of expression * Longident.t loc
++  | Pexp_setfield of expression * Longident.t loc * expression
++  | Pexp_array of expression list
++  | Pexp_ifthenelse of expression * expression * expression option
++  | Pexp_sequence of expression * expression
++  | Pexp_while of expression * expression
++  | Pexp_for of string loc *  expression * expression * direction_flag * expression
++  | Pexp_constraint of expression * core_type option * core_type option
++  | Pexp_when of expression * expression
++  | Pexp_send of expression * string
++  | Pexp_new of Longident.t loc
++  | Pexp_setinstvar of string loc * expression
++  | Pexp_override of (string loc * expression) list
++  | Pexp_letmodule of string loc * module_expr * expression
++  | Pexp_assert of expression
++  | Pexp_assertfalse
++  | Pexp_lazy of expression
++  | Pexp_poly of expression * core_type option
++  | Pexp_object of class_structure
++  | Pexp_newtype of string * expression
++  | Pexp_pack of module_expr
++  | Pexp_open of Longident.t loc * expression
++
++(* Value descriptions *)
++
++and value_description =
++  { pval_type: core_type;
++    pval_prim: string list;
++    pval_loc : Location.t
++    }
++
++(* Type declarations *)
++
++and type_declaration =
++  { ptype_params: string loc option list;
++    ptype_cstrs: (core_type * core_type * Location.t) list;
++    ptype_kind: type_kind;
++    ptype_private: private_flag;
++    ptype_manifest: core_type option;
++    ptype_variance: (bool * bool) list;
++    ptype_loc: Location.t }
++
++and type_kind =
++    Ptype_abstract
++  | Ptype_variant of
++      (string loc * core_type list * core_type option * Location.t) list
++  | Ptype_record of
++      (string loc * mutable_flag * core_type * Location.t) list
++
++and exception_declaration = core_type list
++
++(* Type expressions for the class language *)
++
++and class_type =
++  { pcty_desc: class_type_desc;
++    pcty_loc: Location.t }
++
++and class_type_desc =
++    Pcty_constr of Longident.t loc * core_type list
++  | Pcty_signature of class_signature
++  | Pcty_fun of label * core_type * class_type
++
++and class_signature = {
++    pcsig_self : core_type;
++    pcsig_fields : class_type_field list;
++    pcsig_loc : Location.t;
++  }
++
++and class_type_field = {
++    pctf_desc : class_type_field_desc;
++    pctf_loc : Location.t;
++  }
++
++and class_type_field_desc =
++    Pctf_inher of class_type
++  | Pctf_val of (string * mutable_flag * virtual_flag * core_type)
++  | Pctf_virt  of (string * private_flag * core_type)
++  | Pctf_meth  of (string * private_flag * core_type)
++  | Pctf_cstr  of (core_type * core_type)
++
++and class_description = class_type class_infos
++
++and class_type_declaration = class_type class_infos
++
++(* Value expressions for the class language *)
++
++and class_expr =
++  { pcl_desc: class_expr_desc;
++    pcl_loc: Location.t }
++
++and class_expr_desc =
++    Pcl_constr of Longident.t loc * core_type list
++  | Pcl_structure of class_structure
++  | Pcl_fun of label * expression option * pattern * class_expr
++  | Pcl_apply of class_expr * (label * expression) list
++  | Pcl_let of rec_flag * (pattern * expression) list * class_expr
++  | Pcl_constraint of class_expr * class_type
++
++and class_structure = {
++    pcstr_pat : pattern;
++    pcstr_fields :  class_field list;
++  }
++
++and class_field = {
++    pcf_desc : class_field_desc;
++    pcf_loc : Location.t;
++  }
++
++and class_field_desc =
++    Pcf_inher of override_flag * class_expr * string option
++  | Pcf_valvirt of (string loc * mutable_flag * core_type)
++  | Pcf_val of (string loc * mutable_flag * override_flag * expression)
++  | Pcf_virt  of (string loc * private_flag * core_type)
++  | Pcf_meth of (string loc * private_flag *override_flag * expression)
++  | Pcf_constr  of (core_type * core_type)
++  | Pcf_init  of expression
++
++and class_declaration = class_expr class_infos
++
++(* Type expressions for the module language *)
++
++and module_type =
++  { pmty_desc: module_type_desc;
++    pmty_loc: Location.t }
++
++and module_type_desc =
++    Pmty_ident of Longident.t loc
++  | Pmty_signature of signature
++  | Pmty_functor of string loc * module_type * module_type
++  | Pmty_with of module_type * (Longident.t loc * with_constraint) list
++  | Pmty_typeof of module_expr
++
++and signature = signature_item list
++
++and signature_item =
++  { psig_desc: signature_item_desc;
++    psig_loc: Location.t }
++
++and signature_item_desc =
++    Psig_value of string loc * value_description
++  | Psig_type of (string loc * type_declaration) list
++  | Psig_exception of string loc * exception_declaration
++  | Psig_module of string loc * module_type
++  | Psig_recmodule of (string loc * module_type) list
++  | Psig_modtype of string loc * modtype_declaration
++  | Psig_open of Longident.t loc
++  | Psig_include of module_type
++  | Psig_class of class_description list
++  | Psig_class_type of class_type_declaration list
++
++and modtype_declaration =
++    Pmodtype_abstract
++  | Pmodtype_manifest of module_type
++
++and with_constraint =
++    Pwith_type of type_declaration
++  | Pwith_module of Longident.t loc
++  | Pwith_typesubst of type_declaration
++  | Pwith_modsubst of Longident.t loc
++
++(* Value expressions for the module language *)
++
++and module_expr =
++  { pmod_desc: module_expr_desc;
++    pmod_loc: Location.t }
++
++and module_expr_desc =
++    Pmod_ident of Longident.t loc
++  | Pmod_structure of structure
++  | Pmod_functor of string loc * module_type * module_expr
++  | Pmod_apply of module_expr * module_expr
++  | Pmod_constraint of module_expr * module_type
++  | Pmod_unpack of expression
++
++and structure = structure_item list
++
++and structure_item =
++  { pstr_desc: structure_item_desc;
++    pstr_loc: Location.t }
++
++and structure_item_desc =
++    Pstr_eval of expression
++  | Pstr_value of rec_flag * (pattern * expression) list
++  | Pstr_primitive of string loc * value_description
++  | Pstr_type of (string loc * type_declaration) list
++  | Pstr_exception of string loc * exception_declaration
++  | Pstr_exn_rebind of string loc * Longident.t loc
++  | Pstr_module of string loc * module_expr
++  | Pstr_recmodule of (string loc * module_type * module_expr) list
++  | Pstr_modtype of string loc * module_type
++  | Pstr_open of Longident.t loc
++  | Pstr_class of class_declaration list
++  | Pstr_class_type of class_type_declaration list
++  | Pstr_include of module_expr
++
++(* Toplevel phrases *)
++
++type toplevel_phrase =
++    Ptop_def of structure
++  | Ptop_dir of string * directive_argument
++
++and directive_argument =
++    Pdir_none
++  | Pdir_string of string
++  | Pdir_int of int
++  | Pdir_ident of Longident.t
++  | Pdir_bool of bool
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/.cvsignore camlp5-6.06/ocaml_stuff/4.00.2/utils/.cvsignore
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/.cvsignore	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/utils/.cvsignore	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1 @@
++*.cm[oix]
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/.depend camlp5-6.06/ocaml_stuff/4.00.2/utils/.depend
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/.depend	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/utils/.depend	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,2 @@
++pconfig.cmo: pconfig.cmi
++pconfig.cmx: pconfig.cmi
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/Makefile camlp5-6.06/ocaml_stuff/4.00.2/utils/Makefile
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/Makefile	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/utils/Makefile	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,27 @@
++# Id
++
++FILES=warnings.cmi pconfig.cmo
++INCL=
++
++all: $(FILES)
++
++opt: pconfig.cmx
++
++clean:
++	rm -f *.cm[oix] *.o
++
++depend:
++	ocamldep $(INCL) *.ml* | sed -e 's/  *$$//' > .depend
++
++.SUFFIXES: .mli .cmi .ml .cmo .cmx
++
++.mli.cmi:
++	$(OCAMLN)c $(INCL) -c $<
++
++.ml.cmo:
++	$(OCAMLN)c $(INCL) -c $<
++
++.ml.cmx:
++	$(OCAMLN)opt $(INCL) -c $<
++
++include .depend
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/pconfig.ml camlp5-6.06/ocaml_stuff/4.00.2/utils/pconfig.ml
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/pconfig.ml	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/utils/pconfig.ml	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,4 @@
++let ocaml_version = "4.00.2"
++let ocaml_name = "ocaml"
++let ast_impl_magic_number = "Caml1999M015"
++let ast_intf_magic_number = "Caml1999N014"
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/pconfig.mli camlp5-6.06/ocaml_stuff/4.00.2/utils/pconfig.mli
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/pconfig.mli	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/utils/pconfig.mli	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,4 @@
++val ocaml_version : string
++val ocaml_name : string
++val ast_impl_magic_number : string
++val ast_intf_magic_number : string
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/warnings.mli camlp5-6.06/ocaml_stuff/4.00.2/utils/warnings.mli
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/warnings.mli	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/utils/warnings.mli	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,75 @@
++(***********************************************************************)
++(*                                                                     *)
++(*                                OCaml                                *)
++(*                                                                     *)
++(*            Pierre Weis && Damien Doligez, INRIA Rocquencourt        *)
++(*                                                                     *)
++(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
++(*  en Automatique.  All rights reserved.  This file is distributed    *)
++(*  under the terms of the Q Public License version 1.0.               *)
++(*                                                                     *)
++(***********************************************************************)
++
++(* Id *)
++
++open Format
++
++type t =
++  | Comment_start                           (*  1 *)
++  | Comment_not_end                         (*  2 *)
++  | Deprecated                              (*  3 *)
++  | Fragile_match of string                 (*  4 *)
++  | Partial_application                     (*  5 *)
++  | Labels_omitted                          (*  6 *)
++  | Method_override of string list          (*  7 *)
++  | Partial_match of string                 (*  8 *)
++  | Non_closed_record_pattern of string     (*  9 *)
++  | Statement_type                          (* 10 *)
++  | Unused_match                            (* 11 *)
++  | Unused_pat                              (* 12 *)
++  | Instance_variable_override of string list (* 13 *)
++  | Illegal_backslash                       (* 14 *)
++  | Implicit_public_methods of string list  (* 15 *)
++  | Unerasable_optional_argument            (* 16 *)
++  | Undeclared_virtual_method of string     (* 17 *)
++  | Not_principal of string                 (* 18 *)
++  | Without_principality of string          (* 19 *)
++  | Unused_argument                         (* 20 *)
++  | Nonreturning_statement                  (* 21 *)
++  | Camlp4 of string                        (* 22 *)
++  | Useless_record_with                     (* 23 *)
++  | Bad_module_name of string               (* 24 *)
++  | All_clauses_guarded                     (* 25 *)
++  | Unused_var of string                    (* 26 *)
++  | Unused_var_strict of string             (* 27 *)
++  | Wildcard_arg_to_constant_constr         (* 28 *)
++  | Eol_in_string                           (* 29 *)
++  | Duplicate_definitions of string * string * string * string (*30 *)
++  | Multiple_definition of string * string * string (* 31 *)
++  | Unused_value_declaration of string      (* 32 *)
++  | Unused_open of string                   (* 33 *)
++  | Unused_type_declaration of string       (* 34 *)
++  | Unused_for_index of string              (* 35 *)
++  | Unused_ancestor of string               (* 36 *)
++  | Unused_constructor of string * bool * bool  (* 37 *)
++  | Unused_exception of string * bool       (* 38 *)
++  | Unused_rec_flag                         (* 39 *)
++;;
++
++val parse_options : bool -> string -> unit;;
++
++val is_active : t -> bool;;
++val is_error : t -> bool;;
++
++val defaults_w : string;;
++val defaults_warn_error : string;;
++
++val print : formatter -> t -> int;;
++  (* returns the number of newlines in the printed string *)
++
++
++exception Errors of int;;
++
++val check_fatal : unit -> unit;;
++
++val help_warnings: unit -> unit
+diff -r -u -N camlp5-6.06.orig/ocaml_src/lib/versdep/4.00.2.ml camlp5-6.06/ocaml_src/lib/versdep/4.00.2.ml
+--- camlp5-6.06.orig/ocaml_src/lib/versdep/4.00.2.ml	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_src/lib/versdep/4.00.2.ml	2012-07-31 16:52:22.000000000 +0200
+@@ -0,0 +1,465 @@
++(* camlp5r pa_macro.cmo *)
++(* File generated by program: edit only if it does not compile. *)
++(* Copyright (c) INRIA 2007-2012 *)
++
++open Parsetree;;
++open Longident;;
++open Asttypes;;
++
++type ('a, 'b) choice =
++    Left of 'a
++  | Right of 'b
++;;
++
++let sys_ocaml_version = Sys.ocaml_version;;
++
++let ocaml_location (fname, lnum, bolp, lnuml, bolpl, bp, ep) =
++  let loc_at n lnum bolp =
++    {Lexing.pos_fname = if lnum = -1 then "" else fname;
++     Lexing.pos_lnum = lnum; Lexing.pos_bol = bolp; Lexing.pos_cnum = n}
++  in
++  {Location.loc_start = loc_at bp lnum bolp;
++   Location.loc_end = loc_at ep lnuml bolpl;
++   Location.loc_ghost = bp = 0 && ep = 0}
++;;
++
++let loc_none =
++  let loc =
++    {Lexing.pos_fname = "_none_"; Lexing.pos_lnum = 1; Lexing.pos_bol = 0;
++     Lexing.pos_cnum = -1}
++  in
++  {Location.loc_start = loc; Location.loc_end = loc;
++   Location.loc_ghost = true}
++;;
++
++let mkloc loc txt = {Location.txt = txt; Location.loc = loc};;
++let mknoloc txt = mkloc loc_none txt;;
++
++let ocaml_id_or_li_of_string_list loc sl =
++  let mkli s =
++    let rec loop f =
++      function
++        i :: il -> loop (fun s -> Ldot (f i, s)) il
++      | [] -> f s
++    in
++    loop (fun s -> Lident s)
++  in
++  match List.rev sl with
++    [] -> None
++  | s :: sl -> Some (mkli s (List.rev sl))
++;;
++
++let list_map_check f l =
++  let rec loop rev_l =
++    function
++      x :: l ->
++        begin match f x with
++          Some s -> loop (s :: rev_l) l
++        | None -> None
++        end
++    | [] -> Some (List.rev rev_l)
++  in
++  loop [] l
++;;
++
++let ocaml_value_description t p =
++  {pval_type = t; pval_prim = p; pval_loc = t.ptyp_loc}
++;;
++
++let ocaml_class_type_field loc ctfd = {pctf_desc = ctfd; pctf_loc = loc};;
++
++let ocaml_class_field loc cfd = {pcf_desc = cfd; pcf_loc = loc};;
++
++let ocaml_type_declaration params cl tk pf tm loc variance =
++  match list_map_check (fun s_opt -> s_opt) params with
++    Some params ->
++      let params = List.map (fun os -> Some (mknoloc os)) params in
++      Right
++        {ptype_params = params; ptype_cstrs = cl; ptype_kind = tk;
++         ptype_private = pf; ptype_manifest = tm; ptype_loc = loc;
++         ptype_variance = variance}
++  | None -> Left "no '_' type param in this ocaml version"
++;;
++
++let ocaml_class_type = Some (fun d loc -> {pcty_desc = d; pcty_loc = loc});;
++
++let ocaml_class_expr = Some (fun d loc -> {pcl_desc = d; pcl_loc = loc});;
++
++let ocaml_class_structure p cil = {pcstr_pat = p; pcstr_fields = cil};;
++
++let ocaml_pmty_ident loc li = Pmty_ident (mkloc loc li);;
++
++let ocaml_pmty_functor sloc s mt1 mt2 =
++  Pmty_functor (mkloc sloc s, mt1, mt2)
++;;
++
++let ocaml_pmty_typeof = Some (fun me -> Pmty_typeof me);;
++
++let ocaml_pmty_with mt lcl =
++  let lcl = List.map (fun (s, c) -> mknoloc s, c) lcl in Pmty_with (mt, lcl)
++;;
++
++let ocaml_ptype_abstract = Ptype_abstract;;
++
++let ocaml_ptype_record ltl priv =
++  Ptype_record
++    (List.map (fun (s, mf, ct, loc) -> mkloc loc s, mf, ct, loc) ltl)
++;;
++
++let ocaml_ptype_variant ctl priv =
++  try
++    let ctl =
++      List.map
++        (fun (c, tl, rto, loc) ->
++           if rto <> None then raise Exit else mknoloc c, tl, None, loc)
++        ctl
++    in
++    Some (Ptype_variant ctl)
++  with Exit -> None
++;;
++
++let ocaml_ptyp_arrow lab t1 t2 = Ptyp_arrow (lab, t1, t2);;
++
++let ocaml_ptyp_class li tl ll = Ptyp_class (mknoloc li, tl, ll);;
++
++let ocaml_ptyp_constr li tl = Ptyp_constr (mknoloc li, tl);;
++
++let ocaml_ptyp_package = Some (fun pt -> Ptyp_package pt);;
++
++let ocaml_ptyp_poly = Some (fun cl t -> Ptyp_poly (cl, t));;
++
++let ocaml_ptyp_variant catl clos sl_opt =
++  let catl =
++    List.map
++      (function
++         Left (c, a, tl) -> Rtag (c, a, tl)
++       | Right t -> Rinherit t)
++      catl
++  in
++  Some (Ptyp_variant (catl, clos, sl_opt))
++;;
++
++let ocaml_package_type li ltl =
++  mknoloc li, List.map (fun (li, t) -> mkloc t.ptyp_loc li, t) ltl
++;;
++
++let ocaml_const_int32 = Some (fun s -> Const_int32 (Int32.of_string s));;
++
++let ocaml_const_int64 = Some (fun s -> Const_int64 (Int64.of_string s));;
++
++let ocaml_const_nativeint =
++  Some (fun s -> Const_nativeint (Nativeint.of_string s))
++;;
++
++let ocaml_pexp_apply f lel = Pexp_apply (f, lel);;
++
++let ocaml_pexp_assertfalse fname loc = Pexp_assertfalse;;
++
++let ocaml_pexp_assert fname loc e = Pexp_assert e;;
++
++let ocaml_pexp_construct li po chk_arity =
++  Pexp_construct (mknoloc li, po, chk_arity)
++;;
++
++let ocaml_pexp_field e li = Pexp_field (e, mknoloc li);;
++
++let ocaml_pexp_for i e1 e2 df e = Pexp_for (mknoloc i, e1, e2, df, e);;
++
++let ocaml_pexp_function lab eo pel = Pexp_function (lab, eo, pel);;
++
++let ocaml_pexp_lazy = Some (fun e -> Pexp_lazy e);;
++
++let ocaml_pexp_ident li = Pexp_ident (mknoloc li);;
++
++let ocaml_pexp_letmodule =
++  Some (fun i me e -> Pexp_letmodule (mknoloc i, me, e))
++;;
++
++let ocaml_pexp_new loc li = Pexp_new (mkloc loc li);;
++
++let ocaml_pexp_newtype = Some (fun s e -> Pexp_newtype (s, e));;
++
++let ocaml_pexp_object = Some (fun cs -> Pexp_object cs);;
++
++let ocaml_pexp_open = Some (fun li e -> Pexp_open (mknoloc li, e));;
++
++let ocaml_pexp_override sel =
++  let sel = List.map (fun (s, e) -> mknoloc s, e) sel in Pexp_override sel
++;;
++
++let ocaml_pexp_pack : ('a -> 'b -> 'c, 'd) choice option =
++  Some (Right ((fun me -> Pexp_pack me), (fun pt -> Ptyp_package pt)))
++;;
++
++let ocaml_pexp_poly = Some (fun e t -> Pexp_poly (e, t));;
++
++let ocaml_pexp_record lel eo =
++  let lel = List.map (fun (li, loc, e) -> mkloc loc li, e) lel in
++  Pexp_record (lel, eo)
++;;
++
++let ocaml_pexp_setinstvar s e = Pexp_setinstvar (mknoloc s, e);;
++
++let ocaml_pexp_variant =
++  let pexp_variant_pat =
++    function
++      Pexp_variant (lab, eo) -> Some (lab, eo)
++    | _ -> None
++  in
++  let pexp_variant (lab, eo) = Pexp_variant (lab, eo) in
++  Some (pexp_variant_pat, pexp_variant)
++;;
++
++let ocaml_ppat_alias p i iloc = Ppat_alias (p, mkloc iloc i);;
++
++let ocaml_ppat_array = Some (fun pl -> Ppat_array pl);;
++
++let ocaml_ppat_construct li li_loc po chk_arity =
++  Ppat_construct (mkloc li_loc li, po, chk_arity)
++;;
++
++let ocaml_ppat_construct_args =
++  function
++    Ppat_construct (li, po, chk_arity) -> Some (li.txt, li.loc, po, chk_arity)
++  | _ -> None
++;;
++
++let ocaml_ppat_lazy = Some (fun p -> Ppat_lazy p);;
++
++let ocaml_ppat_record lpl is_closed =
++  let lpl = List.map (fun (li, loc, p) -> mkloc loc li, p) lpl in
++  Ppat_record (lpl, (if is_closed then Closed else Open))
++;;
++
++let ocaml_ppat_type = Some (fun loc li -> Ppat_type (mkloc loc li));;
++
++let ocaml_ppat_unpack =
++  Some ((fun loc s -> Ppat_unpack (mkloc loc s)), (fun pt -> Ptyp_package pt))
++;;
++
++let ocaml_ppat_var loc s = Ppat_var (mkloc loc s);;
++
++let ocaml_ppat_variant =
++  let ppat_variant_pat =
++    function
++      Ppat_variant (lab, po) -> Some (lab, po)
++    | _ -> None
++  in
++  let ppat_variant (lab, po) = Ppat_variant (lab, po) in
++  Some (ppat_variant_pat, ppat_variant)
++;;
++
++let ocaml_psig_class_type = Some (fun ctl -> Psig_class_type ctl);;
++
++let ocaml_psig_exception s ed = Psig_exception (mknoloc s, ed);;
++
++let ocaml_psig_module s mt = Psig_module (mknoloc s, mt);;
++
++let ocaml_psig_modtype s mtd = Psig_modtype (mknoloc s, mtd);;
++
++let ocaml_psig_open li = Psig_open (mknoloc li);;
++
++let ocaml_psig_recmodule =
++  let f ntl =
++    let ntl = List.map (fun (s, mt) -> mknoloc s, mt) ntl in
++    Psig_recmodule ntl
++  in
++  Some f
++;;
++
++let ocaml_psig_type stl =
++  let stl = List.map (fun (s, t) -> mknoloc s, t) stl in Psig_type stl
++;;
++
++let ocaml_psig_value s vd = Psig_value (mknoloc s, vd);;
++
++let ocaml_pstr_class_type = Some (fun ctl -> Pstr_class_type ctl);;
++
++let ocaml_pstr_exception s ed = Pstr_exception (mknoloc s, ed);;
++
++let ocaml_pstr_exn_rebind =
++  Some (fun s li -> Pstr_exn_rebind (mknoloc s, mknoloc li))
++;;
++
++let ocaml_pstr_include = Some (fun me -> Pstr_include me);;
++
++let ocaml_pstr_modtype s mt = Pstr_modtype (mknoloc s, mt);;
++
++let ocaml_pstr_module s me = Pstr_module (mknoloc s, me);;
++
++let ocaml_pstr_open li = Pstr_open (mknoloc li);;
++
++let ocaml_pstr_primitive s vd = Pstr_primitive (mknoloc s, vd);;
++
++let ocaml_pstr_recmodule =
++  let f nel =
++    Pstr_recmodule (List.map (fun (s, mt, me) -> mknoloc s, mt, me) nel)
++  in
++  Some f
++;;
++
++let ocaml_pstr_type stl =
++  let stl = List.map (fun (s, t) -> mknoloc s, t) stl in Pstr_type stl
++;;
++
++let ocaml_class_infos =
++  Some
++    (fun virt (sl, sloc) name expr loc variance ->
++       let params = List.map (fun s -> mkloc loc s) sl, sloc in
++       {pci_virt = virt; pci_params = params; pci_name = mkloc loc name;
++        pci_expr = expr; pci_loc = loc; pci_variance = variance})
++;;
++
++let ocaml_pmod_ident li = Pmod_ident (mknoloc li);;
++
++let ocaml_pmod_functor s mt me = Pmod_functor (mknoloc s, mt, me);;
++
++let ocaml_pmod_unpack : ('a -> 'b -> 'c, 'd) choice option =
++  Some (Right ((fun e -> Pmod_unpack e), (fun pt -> Ptyp_package pt)))
++;;
++
++let ocaml_pcf_cstr = Some (fun (t1, t2, loc) -> Pcf_constr (t1, t2));;
++
++let ocaml_pcf_inher ce pb = Pcf_inher (Fresh, ce, pb);;
++
++let ocaml_pcf_init = Some (fun e -> Pcf_init e);;
++
++let ocaml_pcf_meth (s, pf, ovf, e, loc) =
++  let pf = if pf then Private else Public in
++  let ovf = if ovf then Override else Fresh in
++  Pcf_meth (mkloc loc s, pf, ovf, e)
++;;
++
++let ocaml_pcf_val (s, mf, ovf, e, loc) =
++  let mf = if mf then Mutable else Immutable in
++  let ovf = if ovf then Override else Fresh in
++  Pcf_val (mkloc loc s, mf, ovf, e)
++;;
++
++let ocaml_pcf_valvirt =
++  let ocaml_pcf (s, mf, t, loc) =
++    let mf = if mf then Mutable else Immutable in
++    Pcf_valvirt (mkloc loc s, mf, t)
++  in
++  Some ocaml_pcf
++;;
++
++let ocaml_pcf_virt (s, pf, t, loc) = Pcf_virt (mkloc loc s, pf, t);;
++
++let ocaml_pcl_apply = Some (fun ce lel -> Pcl_apply (ce, lel));;
++
++let ocaml_pcl_constr = Some (fun li ctl -> Pcl_constr (mknoloc li, ctl));;
++
++let ocaml_pcl_constraint = Some (fun ce ct -> Pcl_constraint (ce, ct));;
++
++let ocaml_pcl_fun = Some (fun lab ceo p ce -> Pcl_fun (lab, ceo, p, ce));;
++
++let ocaml_pcl_let = Some (fun rf pel ce -> Pcl_let (rf, pel, ce));;
++
++let ocaml_pcl_structure = Some (fun cs -> Pcl_structure cs);;
++
++let ocaml_pctf_cstr = Some (fun (t1, t2, loc) -> Pctf_cstr (t1, t2));;
++
++let ocaml_pctf_meth (s, pf, t, loc) = Pctf_meth (s, pf, t);;
++
++let ocaml_pctf_val (s, mf, t, loc) = Pctf_val (s, mf, Concrete, t);;
++
++let ocaml_pctf_virt (s, pf, t, loc) = Pctf_virt (s, pf, t);;
++
++let ocaml_pcty_constr = Some (fun li ltl -> Pcty_constr (mknoloc li, ltl));;
++
++let ocaml_pcty_fun = Some (fun lab t ct -> Pcty_fun (lab, t, ct));;
++
++let ocaml_pcty_signature =
++  let f (t, ctfl) =
++    let cs = {pcsig_self = t; pcsig_fields = ctfl; pcsig_loc = t.ptyp_loc} in
++    Pcty_signature cs
++  in
++  Some f
++;;
++
++let ocaml_pdir_bool = Some (fun b -> Pdir_bool b);;
++
++let ocaml_pwith_modsubst =
++  Some (fun loc me -> Pwith_modsubst (mkloc loc me))
++;;
++
++let ocaml_pwith_module loc me = Pwith_module (mkloc loc me);;
++
++let ocaml_pwith_typesubst = Some (fun td -> Pwith_typesubst td);;
++
++let module_prefix_can_be_in_first_record_label_only = true;;
++
++let split_or_patterns_with_bindings = false;;
++
++let has_records_with_with = true;;
++
++(* *)
++
++let jocaml_pstr_def : (_ -> _) option = None;;
++
++let jocaml_pexp_def : (_ -> _ -> _) option = None;;
++
++let jocaml_pexp_par : (_ -> _ -> _) option = None;;
++
++let jocaml_pexp_reply : (_ -> _ -> _ -> _) option = None;;
++
++let jocaml_pexp_spawn : (_ -> _) option = None;;
++
++let arg_rest =
++  function
++    Arg.Rest r -> Some r
++  | _ -> None
++;;
++
++let arg_set_string =
++  function
++    Arg.Set_string r -> Some r
++  | _ -> None
++;;
++
++let arg_set_int =
++  function
++    Arg.Set_int r -> Some r
++  | _ -> None
++;;
++
++let arg_set_float =
++  function
++    Arg.Set_float r -> Some r
++  | _ -> None
++;;
++
++let arg_symbol =
++  function
++    Arg.Symbol (s, f) -> Some (s, f)
++  | _ -> None
++;;
++
++let arg_tuple =
++  function
++    Arg.Tuple t -> Some t
++  | _ -> None
++;;
++
++let arg_bool =
++  function
++    Arg.Bool f -> Some f
++  | _ -> None
++;;
++
++let char_escaped = Char.escaped;;
++
++let hashtbl_mem = Hashtbl.mem;;
++
++let list_rev_append = List.rev_append;;
++
++let list_rev_map = List.rev_map;;
++
++let list_sort = List.sort;;
++
++let pervasives_set_binary_mode_out = Pervasives.set_binary_mode_out;;
++
++let printf_ksprintf = Printf.ksprintf;;
++
++let string_contains = String.contains;;
diff -Nru ocaml-3.12.1/testsuite/external/camlp5-6.08.patch ocaml-4.01.0/testsuite/external/camlp5-6.08.patch
--- ocaml-3.12.1/testsuite/external/camlp5-6.08.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/camlp5-6.08.patch	2013-03-18 14:09:24.000000000 +0000
@@ -0,0 +1,1127 @@
+--- camlp5-6.06/ocaml_stuff/4.01.0/utils/warnings.mli.orig	2013-02-18 15:14:16.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.01.0/utils/warnings.mli	2013-02-18 15:14:31.000000000 +0100
+@@ -54,6 +54,10 @@
+   | Unused_constructor of string * bool * bool  (* 37 *)
+   | Unused_exception of string * bool       (* 38 *)
+   | Unused_rec_flag                         (* 39 *)
++  | Name_out_of_scope of string list * bool (* 40 *)
++  | Ambiguous_name of string list * string list * bool    (* 41 *)
++  | Disambiguated_name of string            (* 42 *)
++  | Nonoptional_label of string             (* 43 *)
+ ;;
+ 
+ val parse_options : bool -> string -> unit;;
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/.cvsignore camlp5-6.06/ocaml_stuff/4.00.2/parsing/.cvsignore
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/.cvsignore	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/parsing/.cvsignore	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1 @@
++*.cm[oi]
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/.depend camlp5-6.06/ocaml_stuff/4.00.2/parsing/.depend
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/.depend	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/parsing/.depend	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,4 @@
++asttypes.cmi : location.cmi
++location.cmi : ../utils/warnings.cmi
++longident.cmi :
++parsetree.cmi : longident.cmi location.cmi asttypes.cmi
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/Makefile camlp5-6.06/ocaml_stuff/4.00.2/parsing/Makefile
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/Makefile	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/parsing/Makefile	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,19 @@
++# Id
++
++FILES=asttypes.cmi location.cmi longident.cmi parsetree.cmi
++INCL=-I ../utils
++
++all: $(FILES)
++
++clean:
++	rm -f *.cmi
++
++depend:
++	ocamldep $(INCL) *.ml* | sed -e 's/  *$$//' > .depend
++
++.SUFFIXES: .mli .cmi
++
++.mli.cmi:
++	$(OCAMLN)c $(INCL) -c $<
++
++include .depend
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/asttypes.mli camlp5-6.06/ocaml_stuff/4.00.2/parsing/asttypes.mli
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/asttypes.mli	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/parsing/asttypes.mli	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,45 @@
++(***********************************************************************)
++(*                                                                     *)
++(*                                OCaml                                *)
++(*                                                                     *)
++(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
++(*                                                                     *)
++(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
++(*  en Automatique.  All rights reserved.  This file is distributed    *)
++(*  under the terms of the Q Public License version 1.0.               *)
++(*                                                                     *)
++(***********************************************************************)
++
++(* Id *)
++
++(* Auxiliary a.s.t. types used by parsetree and typedtree. *)
++
++type constant =
++    Const_int of int
++  | Const_char of char
++  | Const_string of string
++  | Const_float of string
++  | Const_int32 of int32
++  | Const_int64 of int64
++  | Const_nativeint of nativeint
++
++type rec_flag = Nonrecursive | Recursive | Default
++
++type direction_flag = Upto | Downto
++
++type private_flag = Private | Public
++
++type mutable_flag = Immutable | Mutable
++
++type virtual_flag = Virtual | Concrete
++
++type override_flag = Override | Fresh
++
++type closed_flag = Closed | Open
++
++type label = string
++
++type 'a loc = 'a Location.loc = {
++  txt : 'a;
++  loc : Location.t;
++}
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/location.mli camlp5-6.06/ocaml_stuff/4.00.2/parsing/location.mli
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/location.mli	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/parsing/location.mli	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,80 @@
++(***********************************************************************)
++(*                                                                     *)
++(*                                OCaml                                *)
++(*                                                                     *)
++(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
++(*                                                                     *)
++(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
++(*  en Automatique.  All rights reserved.  This file is distributed    *)
++(*  under the terms of the Q Public License version 1.0.               *)
++(*                                                                     *)
++(***********************************************************************)
++
++(* Id *)
++
++(* Source code locations (ranges of positions), used in parsetree. *)
++
++open Format
++
++type t = {
++  loc_start: Lexing.position;
++  loc_end: Lexing.position;
++  loc_ghost: bool;
++}
++
++(* Note on the use of Lexing.position in this module.
++   If [pos_fname = ""], then use [!input_name] instead.
++   If [pos_lnum = -1], then [pos_bol = 0]. Use [pos_cnum] and
++     re-parse the file to get the line and character numbers.
++   Else all fields are correct.
++*)
++
++val none : t
++(** An arbitrary value of type [t]; describes an empty ghost range. *)
++val in_file : string -> t;;
++(** Return an empty ghost range located in a given file. *)
++val init : Lexing.lexbuf -> string -> unit
++(** Set the file name and line number of the [lexbuf] to be the start
++    of the named file. *)
++val curr : Lexing.lexbuf -> t
++(** Get the location of the current token from the [lexbuf]. *)
++
++val symbol_rloc: unit -> t
++val symbol_gloc: unit -> t
++
++(** [rhs_loc n] returns the location of the symbol at position [n], starting
++  at 1, in the current parser rule. *)
++val rhs_loc: int -> t
++
++val input_name: string ref
++val input_lexbuf: Lexing.lexbuf option ref
++
++val get_pos_info: Lexing.position -> string * int * int (* file, line, char *)
++val print_loc: formatter -> t -> unit
++val print_error: formatter -> t -> unit
++val print_error_cur_file: formatter -> unit
++val print_warning: t -> formatter -> Warnings.t -> unit
++val prerr_warning: t -> Warnings.t -> unit
++val echo_eof: unit -> unit
++val reset: unit -> unit
++
++val highlight_locations: formatter -> t -> t -> bool
++
++type 'a loc = {
++  txt : 'a;
++  loc : t;
++}
++
++val mknoloc : 'a -> 'a loc
++val mkloc : 'a -> t -> 'a loc
++
++val print: formatter -> t -> unit
++val print_filename: formatter -> string -> unit
++
++val show_filename: string -> string
++    (** In -absname mode, return the absolute path for this filename.
++        Otherwise, returns the filename unchanged. *)
++
++
++val absname: bool ref
++
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/longident.mli camlp5-6.06/ocaml_stuff/4.00.2/parsing/longident.mli
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/longident.mli	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/parsing/longident.mli	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,24 @@
++(***********************************************************************)
++(*                                                                     *)
++(*                                OCaml                                *)
++(*                                                                     *)
++(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
++(*                                                                     *)
++(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
++(*  en Automatique.  All rights reserved.  This file is distributed    *)
++(*  under the terms of the Q Public License version 1.0.               *)
++(*                                                                     *)
++(***********************************************************************)
++
++(* Id *)
++
++(* Long identifiers, used in parsetree. *)
++
++type t =
++    Lident of string
++  | Ldot of t * string
++  | Lapply of t * t
++
++val flatten: t -> string list
++val last: t -> string
++val parse: string -> t
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/parsetree.mli camlp5-6.06/ocaml_stuff/4.00.2/parsing/parsetree.mli
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/parsing/parsetree.mli	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/parsing/parsetree.mli	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,307 @@
++(***********************************************************************)
++(*                                                                     *)
++(*                                OCaml                                *)
++(*                                                                     *)
++(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
++(*                                                                     *)
++(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
++(*  en Automatique.  All rights reserved.  This file is distributed    *)
++(*  under the terms of the Q Public License version 1.0.               *)
++(*                                                                     *)
++(***********************************************************************)
++
++(* Id *)
++
++(* Abstract syntax tree produced by parsing *)
++
++open Asttypes
++
++(* Type expressions for the core language *)
++
++type core_type =
++  { ptyp_desc: core_type_desc;
++    ptyp_loc: Location.t }
++
++and core_type_desc =
++    Ptyp_any
++  | Ptyp_var of string
++  | Ptyp_arrow of label * core_type * core_type
++  | Ptyp_tuple of core_type list
++  | Ptyp_constr of Longident.t loc * core_type list
++  | Ptyp_object of core_field_type list
++  | Ptyp_class of Longident.t loc * core_type list * label list
++  | Ptyp_alias of core_type * string
++  | Ptyp_variant of row_field list * bool * label list option
++  | Ptyp_poly of string list * core_type
++  | Ptyp_package of package_type
++
++
++and package_type = Longident.t loc * (Longident.t loc * core_type) list
++
++and core_field_type =
++  { pfield_desc: core_field_desc;
++    pfield_loc: Location.t }
++
++and core_field_desc =
++    Pfield of string * core_type
++  | Pfield_var
++
++and row_field =
++    Rtag of label * bool * core_type list
++  | Rinherit of core_type
++
++(* Type expressions for the class language *)
++
++type 'a class_infos =
++  { pci_virt: virtual_flag;
++    pci_params: string loc list * Location.t;
++    pci_name: string loc;
++    pci_expr: 'a;
++    pci_variance: (bool * bool) list;
++    pci_loc: Location.t }
++
++(* Value expressions for the core language *)
++
++type pattern =
++  { ppat_desc: pattern_desc;
++    ppat_loc: Location.t }
++
++and pattern_desc =
++    Ppat_any
++  | Ppat_var of string loc
++  | Ppat_alias of pattern * string loc
++  | Ppat_constant of constant
++  | Ppat_tuple of pattern list
++  | Ppat_construct of Longident.t loc * pattern option * bool
++  | Ppat_variant of label * pattern option
++  | Ppat_record of (Longident.t loc * pattern) list * closed_flag
++  | Ppat_array of pattern list
++  | Ppat_or of pattern * pattern
++  | Ppat_constraint of pattern * core_type
++  | Ppat_type of Longident.t loc
++  | Ppat_lazy of pattern
++  | Ppat_unpack of string loc
++
++type expression =
++  { pexp_desc: expression_desc;
++    pexp_loc: Location.t }
++
++and expression_desc =
++    Pexp_ident of Longident.t loc
++  | Pexp_constant of constant
++  | Pexp_let of rec_flag * (pattern * expression) list * expression
++  | Pexp_function of label * expression option * (pattern * expression) list
++  | Pexp_apply of expression * (label * expression) list
++  | Pexp_match of expression * (pattern * expression) list
++  | Pexp_try of expression * (pattern * expression) list
++  | Pexp_tuple of expression list
++  | Pexp_construct of Longident.t loc * expression option * bool
++  | Pexp_variant of label * expression option
++  | Pexp_record of (Longident.t loc * expression) list * expression option
++  | Pexp_field of expression * Longident.t loc
++  | Pexp_setfield of expression * Longident.t loc * expression
++  | Pexp_array of expression list
++  | Pexp_ifthenelse of expression * expression * expression option
++  | Pexp_sequence of expression * expression
++  | Pexp_while of expression * expression
++  | Pexp_for of string loc *  expression * expression * direction_flag * expression
++  | Pexp_constraint of expression * core_type option * core_type option
++  | Pexp_when of expression * expression
++  | Pexp_send of expression * string
++  | Pexp_new of Longident.t loc
++  | Pexp_setinstvar of string loc * expression
++  | Pexp_override of (string loc * expression) list
++  | Pexp_letmodule of string loc * module_expr * expression
++  | Pexp_assert of expression
++  | Pexp_assertfalse
++  | Pexp_lazy of expression
++  | Pexp_poly of expression * core_type option
++  | Pexp_object of class_structure
++  | Pexp_newtype of string * expression
++  | Pexp_pack of module_expr
++  | Pexp_open of Longident.t loc * expression
++
++(* Value descriptions *)
++
++and value_description =
++  { pval_type: core_type;
++    pval_prim: string list;
++    pval_loc : Location.t
++    }
++
++(* Type declarations *)
++
++and type_declaration =
++  { ptype_params: string loc option list;
++    ptype_cstrs: (core_type * core_type * Location.t) list;
++    ptype_kind: type_kind;
++    ptype_private: private_flag;
++    ptype_manifest: core_type option;
++    ptype_variance: (bool * bool) list;
++    ptype_loc: Location.t }
++
++and type_kind =
++    Ptype_abstract
++  | Ptype_variant of
++      (string loc * core_type list * core_type option * Location.t) list
++  | Ptype_record of
++      (string loc * mutable_flag * core_type * Location.t) list
++
++and exception_declaration = core_type list
++
++(* Type expressions for the class language *)
++
++and class_type =
++  { pcty_desc: class_type_desc;
++    pcty_loc: Location.t }
++
++and class_type_desc =
++    Pcty_constr of Longident.t loc * core_type list
++  | Pcty_signature of class_signature
++  | Pcty_fun of label * core_type * class_type
++
++and class_signature = {
++    pcsig_self : core_type;
++    pcsig_fields : class_type_field list;
++    pcsig_loc : Location.t;
++  }
++
++and class_type_field = {
++    pctf_desc : class_type_field_desc;
++    pctf_loc : Location.t;
++  }
++
++and class_type_field_desc =
++    Pctf_inher of class_type
++  | Pctf_val of (string * mutable_flag * virtual_flag * core_type)
++  | Pctf_virt  of (string * private_flag * core_type)
++  | Pctf_meth  of (string * private_flag * core_type)
++  | Pctf_cstr  of (core_type * core_type)
++
++and class_description = class_type class_infos
++
++and class_type_declaration = class_type class_infos
++
++(* Value expressions for the class language *)
++
++and class_expr =
++  { pcl_desc: class_expr_desc;
++    pcl_loc: Location.t }
++
++and class_expr_desc =
++    Pcl_constr of Longident.t loc * core_type list
++  | Pcl_structure of class_structure
++  | Pcl_fun of label * expression option * pattern * class_expr
++  | Pcl_apply of class_expr * (label * expression) list
++  | Pcl_let of rec_flag * (pattern * expression) list * class_expr
++  | Pcl_constraint of class_expr * class_type
++
++and class_structure = {
++    pcstr_pat : pattern;
++    pcstr_fields :  class_field list;
++  }
++
++and class_field = {
++    pcf_desc : class_field_desc;
++    pcf_loc : Location.t;
++  }
++
++and class_field_desc =
++    Pcf_inher of override_flag * class_expr * string option
++  | Pcf_valvirt of (string loc * mutable_flag * core_type)
++  | Pcf_val of (string loc * mutable_flag * override_flag * expression)
++  | Pcf_virt  of (string loc * private_flag * core_type)
++  | Pcf_meth of (string loc * private_flag *override_flag * expression)
++  | Pcf_constr  of (core_type * core_type)
++  | Pcf_init  of expression
++
++and class_declaration = class_expr class_infos
++
++(* Type expressions for the module language *)
++
++and module_type =
++  { pmty_desc: module_type_desc;
++    pmty_loc: Location.t }
++
++and module_type_desc =
++    Pmty_ident of Longident.t loc
++  | Pmty_signature of signature
++  | Pmty_functor of string loc * module_type * module_type
++  | Pmty_with of module_type * (Longident.t loc * with_constraint) list
++  | Pmty_typeof of module_expr
++
++and signature = signature_item list
++
++and signature_item =
++  { psig_desc: signature_item_desc;
++    psig_loc: Location.t }
++
++and signature_item_desc =
++    Psig_value of string loc * value_description
++  | Psig_type of (string loc * type_declaration) list
++  | Psig_exception of string loc * exception_declaration
++  | Psig_module of string loc * module_type
++  | Psig_recmodule of (string loc * module_type) list
++  | Psig_modtype of string loc * modtype_declaration
++  | Psig_open of Longident.t loc
++  | Psig_include of module_type
++  | Psig_class of class_description list
++  | Psig_class_type of class_type_declaration list
++
++and modtype_declaration =
++    Pmodtype_abstract
++  | Pmodtype_manifest of module_type
++
++and with_constraint =
++    Pwith_type of type_declaration
++  | Pwith_module of Longident.t loc
++  | Pwith_typesubst of type_declaration
++  | Pwith_modsubst of Longident.t loc
++
++(* Value expressions for the module language *)
++
++and module_expr =
++  { pmod_desc: module_expr_desc;
++    pmod_loc: Location.t }
++
++and module_expr_desc =
++    Pmod_ident of Longident.t loc
++  | Pmod_structure of structure
++  | Pmod_functor of string loc * module_type * module_expr
++  | Pmod_apply of module_expr * module_expr
++  | Pmod_constraint of module_expr * module_type
++  | Pmod_unpack of expression
++
++and structure = structure_item list
++
++and structure_item =
++  { pstr_desc: structure_item_desc;
++    pstr_loc: Location.t }
++
++and structure_item_desc =
++    Pstr_eval of expression
++  | Pstr_value of rec_flag * (pattern * expression) list
++  | Pstr_primitive of string loc * value_description
++  | Pstr_type of (string loc * type_declaration) list
++  | Pstr_exception of string loc * exception_declaration
++  | Pstr_exn_rebind of string loc * Longident.t loc
++  | Pstr_module of string loc * module_expr
++  | Pstr_recmodule of (string loc * module_type * module_expr) list
++  | Pstr_modtype of string loc * module_type
++  | Pstr_open of Longident.t loc
++  | Pstr_class of class_declaration list
++  | Pstr_class_type of class_type_declaration list
++  | Pstr_include of module_expr
++
++(* Toplevel phrases *)
++
++type toplevel_phrase =
++    Ptop_def of structure
++  | Ptop_dir of string * directive_argument
++
++and directive_argument =
++    Pdir_none
++  | Pdir_string of string
++  | Pdir_int of int
++  | Pdir_ident of Longident.t
++  | Pdir_bool of bool
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/.cvsignore camlp5-6.06/ocaml_stuff/4.00.2/utils/.cvsignore
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/.cvsignore	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/utils/.cvsignore	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1 @@
++*.cm[oix]
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/.depend camlp5-6.06/ocaml_stuff/4.00.2/utils/.depend
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/.depend	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/utils/.depend	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,2 @@
++pconfig.cmo: pconfig.cmi
++pconfig.cmx: pconfig.cmi
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/Makefile camlp5-6.06/ocaml_stuff/4.00.2/utils/Makefile
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/Makefile	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/utils/Makefile	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,27 @@
++# Id
++
++FILES=warnings.cmi pconfig.cmo
++INCL=
++
++all: $(FILES)
++
++opt: pconfig.cmx
++
++clean:
++	rm -f *.cm[oix] *.o
++
++depend:
++	ocamldep $(INCL) *.ml* | sed -e 's/  *$$//' > .depend
++
++.SUFFIXES: .mli .cmi .ml .cmo .cmx
++
++.mli.cmi:
++	$(OCAMLN)c $(INCL) -c $<
++
++.ml.cmo:
++	$(OCAMLN)c $(INCL) -c $<
++
++.ml.cmx:
++	$(OCAMLN)opt $(INCL) -c $<
++
++include .depend
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/pconfig.ml camlp5-6.06/ocaml_stuff/4.00.2/utils/pconfig.ml
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/pconfig.ml	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/utils/pconfig.ml	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,4 @@
++let ocaml_version = "4.00.2"
++let ocaml_name = "ocaml"
++let ast_impl_magic_number = "Caml1999M015"
++let ast_intf_magic_number = "Caml1999N014"
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/pconfig.mli camlp5-6.06/ocaml_stuff/4.00.2/utils/pconfig.mli
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/pconfig.mli	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/utils/pconfig.mli	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,4 @@
++val ocaml_version : string
++val ocaml_name : string
++val ast_impl_magic_number : string
++val ast_intf_magic_number : string
+diff -N -r -u camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/warnings.mli camlp5-6.06/ocaml_stuff/4.00.2/utils/warnings.mli
+--- camlp5-6.06.orig/ocaml_stuff/4.00.2/utils/warnings.mli	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_stuff/4.00.2/utils/warnings.mli	2013-03-06 14:44:56.000000000 +0100
+@@ -0,0 +1,75 @@
++(***********************************************************************)
++(*                                                                     *)
++(*                                OCaml                                *)
++(*                                                                     *)
++(*            Pierre Weis && Damien Doligez, INRIA Rocquencourt        *)
++(*                                                                     *)
++(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
++(*  en Automatique.  All rights reserved.  This file is distributed    *)
++(*  under the terms of the Q Public License version 1.0.               *)
++(*                                                                     *)
++(***********************************************************************)
++
++(* Id *)
++
++open Format
++
++type t =
++  | Comment_start                           (*  1 *)
++  | Comment_not_end                         (*  2 *)
++  | Deprecated                              (*  3 *)
++  | Fragile_match of string                 (*  4 *)
++  | Partial_application                     (*  5 *)
++  | Labels_omitted                          (*  6 *)
++  | Method_override of string list          (*  7 *)
++  | Partial_match of string                 (*  8 *)
++  | Non_closed_record_pattern of string     (*  9 *)
++  | Statement_type                          (* 10 *)
++  | Unused_match                            (* 11 *)
++  | Unused_pat                              (* 12 *)
++  | Instance_variable_override of string list (* 13 *)
++  | Illegal_backslash                       (* 14 *)
++  | Implicit_public_methods of string list  (* 15 *)
++  | Unerasable_optional_argument            (* 16 *)
++  | Undeclared_virtual_method of string     (* 17 *)
++  | Not_principal of string                 (* 18 *)
++  | Without_principality of string          (* 19 *)
++  | Unused_argument                         (* 20 *)
++  | Nonreturning_statement                  (* 21 *)
++  | Camlp4 of string                        (* 22 *)
++  | Useless_record_with                     (* 23 *)
++  | Bad_module_name of string               (* 24 *)
++  | All_clauses_guarded                     (* 25 *)
++  | Unused_var of string                    (* 26 *)
++  | Unused_var_strict of string             (* 27 *)
++  | Wildcard_arg_to_constant_constr         (* 28 *)
++  | Eol_in_string                           (* 29 *)
++  | Duplicate_definitions of string * string * string * string (*30 *)
++  | Multiple_definition of string * string * string (* 31 *)
++  | Unused_value_declaration of string      (* 32 *)
++  | Unused_open of string                   (* 33 *)
++  | Unused_type_declaration of string       (* 34 *)
++  | Unused_for_index of string              (* 35 *)
++  | Unused_ancestor of string               (* 36 *)
++  | Unused_constructor of string * bool * bool  (* 37 *)
++  | Unused_exception of string * bool       (* 38 *)
++  | Unused_rec_flag                         (* 39 *)
++;;
++
++val parse_options : bool -> string -> unit;;
++
++val is_active : t -> bool;;
++val is_error : t -> bool;;
++
++val defaults_w : string;;
++val defaults_warn_error : string;;
++
++val print : formatter -> t -> int;;
++  (* returns the number of newlines in the printed string *)
++
++
++exception Errors of int;;
++
++val check_fatal : unit -> unit;;
++
++val help_warnings: unit -> unit
+diff -r -u -N camlp5-6.06.orig/ocaml_src/lib/versdep/4.00.2.ml camlp5-6.06/ocaml_src/lib/versdep/4.00.2.ml
+--- camlp5-6.06.orig/ocaml_src/lib/versdep/4.00.2.ml	1970-01-01 01:00:00.000000000 +0100
++++ camlp5-6.06/ocaml_src/lib/versdep/4.00.2.ml	2012-07-31 16:52:22.000000000 +0200
+@@ -0,0 +1,465 @@
++(* camlp5r pa_macro.cmo *)
++(* File generated by program: edit only if it does not compile. *)
++(* Copyright (c) INRIA 2007-2012 *)
++
++open Parsetree;;
++open Longident;;
++open Asttypes;;
++
++type ('a, 'b) choice =
++    Left of 'a
++  | Right of 'b
++;;
++
++let sys_ocaml_version = Sys.ocaml_version;;
++
++let ocaml_location (fname, lnum, bolp, lnuml, bolpl, bp, ep) =
++  let loc_at n lnum bolp =
++    {Lexing.pos_fname = if lnum = -1 then "" else fname;
++     Lexing.pos_lnum = lnum; Lexing.pos_bol = bolp; Lexing.pos_cnum = n}
++  in
++  {Location.loc_start = loc_at bp lnum bolp;
++   Location.loc_end = loc_at ep lnuml bolpl;
++   Location.loc_ghost = bp = 0 && ep = 0}
++;;
++
++let loc_none =
++  let loc =
++    {Lexing.pos_fname = "_none_"; Lexing.pos_lnum = 1; Lexing.pos_bol = 0;
++     Lexing.pos_cnum = -1}
++  in
++  {Location.loc_start = loc; Location.loc_end = loc;
++   Location.loc_ghost = true}
++;;
++
++let mkloc loc txt = {Location.txt = txt; Location.loc = loc};;
++let mknoloc txt = mkloc loc_none txt;;
++
++let ocaml_id_or_li_of_string_list loc sl =
++  let mkli s =
++    let rec loop f =
++      function
++        i :: il -> loop (fun s -> Ldot (f i, s)) il
++      | [] -> f s
++    in
++    loop (fun s -> Lident s)
++  in
++  match List.rev sl with
++    [] -> None
++  | s :: sl -> Some (mkli s (List.rev sl))
++;;
++
++let list_map_check f l =
++  let rec loop rev_l =
++    function
++      x :: l ->
++        begin match f x with
++          Some s -> loop (s :: rev_l) l
++        | None -> None
++        end
++    | [] -> Some (List.rev rev_l)
++  in
++  loop [] l
++;;
++
++let ocaml_value_description t p =
++  {pval_type = t; pval_prim = p; pval_loc = t.ptyp_loc}
++;;
++
++let ocaml_class_type_field loc ctfd = {pctf_desc = ctfd; pctf_loc = loc};;
++
++let ocaml_class_field loc cfd = {pcf_desc = cfd; pcf_loc = loc};;
++
++let ocaml_type_declaration params cl tk pf tm loc variance =
++  match list_map_check (fun s_opt -> s_opt) params with
++    Some params ->
++      let params = List.map (fun os -> Some (mknoloc os)) params in
++      Right
++        {ptype_params = params; ptype_cstrs = cl; ptype_kind = tk;
++         ptype_private = pf; ptype_manifest = tm; ptype_loc = loc;
++         ptype_variance = variance}
++  | None -> Left "no '_' type param in this ocaml version"
++;;
++
++let ocaml_class_type = Some (fun d loc -> {pcty_desc = d; pcty_loc = loc});;
++
++let ocaml_class_expr = Some (fun d loc -> {pcl_desc = d; pcl_loc = loc});;
++
++let ocaml_class_structure p cil = {pcstr_pat = p; pcstr_fields = cil};;
++
++let ocaml_pmty_ident loc li = Pmty_ident (mkloc loc li);;
++
++let ocaml_pmty_functor sloc s mt1 mt2 =
++  Pmty_functor (mkloc sloc s, mt1, mt2)
++;;
++
++let ocaml_pmty_typeof = Some (fun me -> Pmty_typeof me);;
++
++let ocaml_pmty_with mt lcl =
++  let lcl = List.map (fun (s, c) -> mknoloc s, c) lcl in Pmty_with (mt, lcl)
++;;
++
++let ocaml_ptype_abstract = Ptype_abstract;;
++
++let ocaml_ptype_record ltl priv =
++  Ptype_record
++    (List.map (fun (s, mf, ct, loc) -> mkloc loc s, mf, ct, loc) ltl)
++;;
++
++let ocaml_ptype_variant ctl priv =
++  try
++    let ctl =
++      List.map
++        (fun (c, tl, rto, loc) ->
++           if rto <> None then raise Exit else mknoloc c, tl, None, loc)
++        ctl
++    in
++    Some (Ptype_variant ctl)
++  with Exit -> None
++;;
++
++let ocaml_ptyp_arrow lab t1 t2 = Ptyp_arrow (lab, t1, t2);;
++
++let ocaml_ptyp_class li tl ll = Ptyp_class (mknoloc li, tl, ll);;
++
++let ocaml_ptyp_constr li tl = Ptyp_constr (mknoloc li, tl);;
++
++let ocaml_ptyp_package = Some (fun pt -> Ptyp_package pt);;
++
++let ocaml_ptyp_poly = Some (fun cl t -> Ptyp_poly (cl, t));;
++
++let ocaml_ptyp_variant catl clos sl_opt =
++  let catl =
++    List.map
++      (function
++         Left (c, a, tl) -> Rtag (c, a, tl)
++       | Right t -> Rinherit t)
++      catl
++  in
++  Some (Ptyp_variant (catl, clos, sl_opt))
++;;
++
++let ocaml_package_type li ltl =
++  mknoloc li, List.map (fun (li, t) -> mkloc t.ptyp_loc li, t) ltl
++;;
++
++let ocaml_const_int32 = Some (fun s -> Const_int32 (Int32.of_string s));;
++
++let ocaml_const_int64 = Some (fun s -> Const_int64 (Int64.of_string s));;
++
++let ocaml_const_nativeint =
++  Some (fun s -> Const_nativeint (Nativeint.of_string s))
++;;
++
++let ocaml_pexp_apply f lel = Pexp_apply (f, lel);;
++
++let ocaml_pexp_assertfalse fname loc = Pexp_assertfalse;;
++
++let ocaml_pexp_assert fname loc e = Pexp_assert e;;
++
++let ocaml_pexp_construct li po chk_arity =
++  Pexp_construct (mknoloc li, po, chk_arity)
++;;
++
++let ocaml_pexp_field e li = Pexp_field (e, mknoloc li);;
++
++let ocaml_pexp_for i e1 e2 df e = Pexp_for (mknoloc i, e1, e2, df, e);;
++
++let ocaml_pexp_function lab eo pel = Pexp_function (lab, eo, pel);;
++
++let ocaml_pexp_lazy = Some (fun e -> Pexp_lazy e);;
++
++let ocaml_pexp_ident li = Pexp_ident (mknoloc li);;
++
++let ocaml_pexp_letmodule =
++  Some (fun i me e -> Pexp_letmodule (mknoloc i, me, e))
++;;
++
++let ocaml_pexp_new loc li = Pexp_new (mkloc loc li);;
++
++let ocaml_pexp_newtype = Some (fun s e -> Pexp_newtype (s, e));;
++
++let ocaml_pexp_object = Some (fun cs -> Pexp_object cs);;
++
++let ocaml_pexp_open = Some (fun li e -> Pexp_open (mknoloc li, e));;
++
++let ocaml_pexp_override sel =
++  let sel = List.map (fun (s, e) -> mknoloc s, e) sel in Pexp_override sel
++;;
++
++let ocaml_pexp_pack : ('a -> 'b -> 'c, 'd) choice option =
++  Some (Right ((fun me -> Pexp_pack me), (fun pt -> Ptyp_package pt)))
++;;
++
++let ocaml_pexp_poly = Some (fun e t -> Pexp_poly (e, t));;
++
++let ocaml_pexp_record lel eo =
++  let lel = List.map (fun (li, loc, e) -> mkloc loc li, e) lel in
++  Pexp_record (lel, eo)
++;;
++
++let ocaml_pexp_setinstvar s e = Pexp_setinstvar (mknoloc s, e);;
++
++let ocaml_pexp_variant =
++  let pexp_variant_pat =
++    function
++      Pexp_variant (lab, eo) -> Some (lab, eo)
++    | _ -> None
++  in
++  let pexp_variant (lab, eo) = Pexp_variant (lab, eo) in
++  Some (pexp_variant_pat, pexp_variant)
++;;
++
++let ocaml_ppat_alias p i iloc = Ppat_alias (p, mkloc iloc i);;
++
++let ocaml_ppat_array = Some (fun pl -> Ppat_array pl);;
++
++let ocaml_ppat_construct li li_loc po chk_arity =
++  Ppat_construct (mkloc li_loc li, po, chk_arity)
++;;
++
++let ocaml_ppat_construct_args =
++  function
++    Ppat_construct (li, po, chk_arity) -> Some (li.txt, li.loc, po, chk_arity)
++  | _ -> None
++;;
++
++let ocaml_ppat_lazy = Some (fun p -> Ppat_lazy p);;
++
++let ocaml_ppat_record lpl is_closed =
++  let lpl = List.map (fun (li, loc, p) -> mkloc loc li, p) lpl in
++  Ppat_record (lpl, (if is_closed then Closed else Open))
++;;
++
++let ocaml_ppat_type = Some (fun loc li -> Ppat_type (mkloc loc li));;
++
++let ocaml_ppat_unpack =
++  Some ((fun loc s -> Ppat_unpack (mkloc loc s)), (fun pt -> Ptyp_package pt))
++;;
++
++let ocaml_ppat_var loc s = Ppat_var (mkloc loc s);;
++
++let ocaml_ppat_variant =
++  let ppat_variant_pat =
++    function
++      Ppat_variant (lab, po) -> Some (lab, po)
++    | _ -> None
++  in
++  let ppat_variant (lab, po) = Ppat_variant (lab, po) in
++  Some (ppat_variant_pat, ppat_variant)
++;;
++
++let ocaml_psig_class_type = Some (fun ctl -> Psig_class_type ctl);;
++
++let ocaml_psig_exception s ed = Psig_exception (mknoloc s, ed);;
++
++let ocaml_psig_module s mt = Psig_module (mknoloc s, mt);;
++
++let ocaml_psig_modtype s mtd = Psig_modtype (mknoloc s, mtd);;
++
++let ocaml_psig_open li = Psig_open (mknoloc li);;
++
++let ocaml_psig_recmodule =
++  let f ntl =
++    let ntl = List.map (fun (s, mt) -> mknoloc s, mt) ntl in
++    Psig_recmodule ntl
++  in
++  Some f
++;;
++
++let ocaml_psig_type stl =
++  let stl = List.map (fun (s, t) -> mknoloc s, t) stl in Psig_type stl
++;;
++
++let ocaml_psig_value s vd = Psig_value (mknoloc s, vd);;
++
++let ocaml_pstr_class_type = Some (fun ctl -> Pstr_class_type ctl);;
++
++let ocaml_pstr_exception s ed = Pstr_exception (mknoloc s, ed);;
++
++let ocaml_pstr_exn_rebind =
++  Some (fun s li -> Pstr_exn_rebind (mknoloc s, mknoloc li))
++;;
++
++let ocaml_pstr_include = Some (fun me -> Pstr_include me);;
++
++let ocaml_pstr_modtype s mt = Pstr_modtype (mknoloc s, mt);;
++
++let ocaml_pstr_module s me = Pstr_module (mknoloc s, me);;
++
++let ocaml_pstr_open li = Pstr_open (mknoloc li);;
++
++let ocaml_pstr_primitive s vd = Pstr_primitive (mknoloc s, vd);;
++
++let ocaml_pstr_recmodule =
++  let f nel =
++    Pstr_recmodule (List.map (fun (s, mt, me) -> mknoloc s, mt, me) nel)
++  in
++  Some f
++;;
++
++let ocaml_pstr_type stl =
++  let stl = List.map (fun (s, t) -> mknoloc s, t) stl in Pstr_type stl
++;;
++
++let ocaml_class_infos =
++  Some
++    (fun virt (sl, sloc) name expr loc variance ->
++       let params = List.map (fun s -> mkloc loc s) sl, sloc in
++       {pci_virt = virt; pci_params = params; pci_name = mkloc loc name;
++        pci_expr = expr; pci_loc = loc; pci_variance = variance})
++;;
++
++let ocaml_pmod_ident li = Pmod_ident (mknoloc li);;
++
++let ocaml_pmod_functor s mt me = Pmod_functor (mknoloc s, mt, me);;
++
++let ocaml_pmod_unpack : ('a -> 'b -> 'c, 'd) choice option =
++  Some (Right ((fun e -> Pmod_unpack e), (fun pt -> Ptyp_package pt)))
++;;
++
++let ocaml_pcf_cstr = Some (fun (t1, t2, loc) -> Pcf_constr (t1, t2));;
++
++let ocaml_pcf_inher ce pb = Pcf_inher (Fresh, ce, pb);;
++
++let ocaml_pcf_init = Some (fun e -> Pcf_init e);;
++
++let ocaml_pcf_meth (s, pf, ovf, e, loc) =
++  let pf = if pf then Private else Public in
++  let ovf = if ovf then Override else Fresh in
++  Pcf_meth (mkloc loc s, pf, ovf, e)
++;;
++
++let ocaml_pcf_val (s, mf, ovf, e, loc) =
++  let mf = if mf then Mutable else Immutable in
++  let ovf = if ovf then Override else Fresh in
++  Pcf_val (mkloc loc s, mf, ovf, e)
++;;
++
++let ocaml_pcf_valvirt =
++  let ocaml_pcf (s, mf, t, loc) =
++    let mf = if mf then Mutable else Immutable in
++    Pcf_valvirt (mkloc loc s, mf, t)
++  in
++  Some ocaml_pcf
++;;
++
++let ocaml_pcf_virt (s, pf, t, loc) = Pcf_virt (mkloc loc s, pf, t);;
++
++let ocaml_pcl_apply = Some (fun ce lel -> Pcl_apply (ce, lel));;
++
++let ocaml_pcl_constr = Some (fun li ctl -> Pcl_constr (mknoloc li, ctl));;
++
++let ocaml_pcl_constraint = Some (fun ce ct -> Pcl_constraint (ce, ct));;
++
++let ocaml_pcl_fun = Some (fun lab ceo p ce -> Pcl_fun (lab, ceo, p, ce));;
++
++let ocaml_pcl_let = Some (fun rf pel ce -> Pcl_let (rf, pel, ce));;
++
++let ocaml_pcl_structure = Some (fun cs -> Pcl_structure cs);;
++
++let ocaml_pctf_cstr = Some (fun (t1, t2, loc) -> Pctf_cstr (t1, t2));;
++
++let ocaml_pctf_meth (s, pf, t, loc) = Pctf_meth (s, pf, t);;
++
++let ocaml_pctf_val (s, mf, t, loc) = Pctf_val (s, mf, Concrete, t);;
++
++let ocaml_pctf_virt (s, pf, t, loc) = Pctf_virt (s, pf, t);;
++
++let ocaml_pcty_constr = Some (fun li ltl -> Pcty_constr (mknoloc li, ltl));;
++
++let ocaml_pcty_fun = Some (fun lab t ct -> Pcty_fun (lab, t, ct));;
++
++let ocaml_pcty_signature =
++  let f (t, ctfl) =
++    let cs = {pcsig_self = t; pcsig_fields = ctfl; pcsig_loc = t.ptyp_loc} in
++    Pcty_signature cs
++  in
++  Some f
++;;
++
++let ocaml_pdir_bool = Some (fun b -> Pdir_bool b);;
++
++let ocaml_pwith_modsubst =
++  Some (fun loc me -> Pwith_modsubst (mkloc loc me))
++;;
++
++let ocaml_pwith_module loc me = Pwith_module (mkloc loc me);;
++
++let ocaml_pwith_typesubst = Some (fun td -> Pwith_typesubst td);;
++
++let module_prefix_can_be_in_first_record_label_only = true;;
++
++let split_or_patterns_with_bindings = false;;
++
++let has_records_with_with = true;;
++
++(* *)
++
++let jocaml_pstr_def : (_ -> _) option = None;;
++
++let jocaml_pexp_def : (_ -> _ -> _) option = None;;
++
++let jocaml_pexp_par : (_ -> _ -> _) option = None;;
++
++let jocaml_pexp_reply : (_ -> _ -> _ -> _) option = None;;
++
++let jocaml_pexp_spawn : (_ -> _) option = None;;
++
++let arg_rest =
++  function
++    Arg.Rest r -> Some r
++  | _ -> None
++;;
++
++let arg_set_string =
++  function
++    Arg.Set_string r -> Some r
++  | _ -> None
++;;
++
++let arg_set_int =
++  function
++    Arg.Set_int r -> Some r
++  | _ -> None
++;;
++
++let arg_set_float =
++  function
++    Arg.Set_float r -> Some r
++  | _ -> None
++;;
++
++let arg_symbol =
++  function
++    Arg.Symbol (s, f) -> Some (s, f)
++  | _ -> None
++;;
++
++let arg_tuple =
++  function
++    Arg.Tuple t -> Some t
++  | _ -> None
++;;
++
++let arg_bool =
++  function
++    Arg.Bool f -> Some f
++  | _ -> None
++;;
++
++let char_escaped = Char.escaped;;
++
++let hashtbl_mem = Hashtbl.mem;;
++
++let list_rev_append = List.rev_append;;
++
++let list_rev_map = List.rev_map;;
++
++let list_sort = List.sort;;
++
++let pervasives_set_binary_mode_out = Pervasives.set_binary_mode_out;;
++
++let printf_ksprintf = Printf.ksprintf;;
++
++let string_contains = String.contains;;
diff -Nru ocaml-3.12.1/testsuite/external/camlp5-6.10.patch ocaml-4.01.0/testsuite/external/camlp5-6.10.patch
--- ocaml-3.12.1/testsuite/external/camlp5-6.10.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/camlp5-6.10.patch	2013-08-13 14:58:09.000000000 +0000
@@ -0,0 +1,10 @@
+--- camlp5-6.10.orig/ocaml_stuff/4.01.0/utils/warnings.mli	2013-06-19 04:17:42.000000000 +0200
++++ camlp5-6.10/ocaml_stuff/4.01.0/utils/warnings.mli	2013-08-13 16:14:47.000000000 +0200
+@@ -58,6 +58,7 @@
+   | Nonoptional_label of string             (* 43 *)
+   | Open_shadow_identifier of string * string (* 44 *)
+   | Open_shadow_label_constructor of string * string (* 45 *)
++  | Bad_env_variable of string * string
+ ;;
+ 
+ val parse_options : bool -> string -> unit;;
diff -Nru ocaml-3.12.1/testsuite/external/camlpdf-0.5.patch ocaml-4.01.0/testsuite/external/camlpdf-0.5.patch
--- ocaml-3.12.1/testsuite/external/camlpdf-0.5.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/camlpdf-0.5.patch	2013-06-03 14:06:57.000000000 +0000
@@ -0,0 +1,25 @@
+--- camlpdf-0.5.orig/makefile	2010-03-08 17:30:19.000000000 +0100
++++ camlpdf-0.5/makefile	2013-05-30 17:07:12.000000000 +0200
+@@ -42,7 +42,7 @@
+ 
+ CLIBS = z
+ 
+-CFLAGS = -m32
++#CFLAGS = -m32
+ 
+ #Uncomment for debug build
+ #OCAMLNCFLAGS = -g
+@@ -56,6 +56,13 @@
+ #Remove native-code-library if you don't have native compilers
+ all : byte-code-library native-code-library
+ 
++LIBDIR="`ocamlc -where`"/camlpdf
++.PHONY: install
++install :
++	mkdir -p ${LIBDIR}
++	cp *.mli *.cm[ia] *.cmxa *.a *.so ${LIBDIR}/
++	cp introduction_to_camlpdf.pdf ${LIBDIR}/
++
+ # Predefined generic makefile
+ -include OCamlMakefile
+ 
diff -Nru ocaml-3.12.1/testsuite/external/camlzip-1.04.patch ocaml-4.01.0/testsuite/external/camlzip-1.04.patch
--- ocaml-3.12.1/testsuite/external/camlzip-1.04.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/camlzip-1.04.patch	2012-08-02 08:17:59.000000000 +0000
@@ -0,0 +1,45 @@
+--- camlzip-1.04/Makefile	2009-10-20 15:59:55.000000000 +0200
++++ camlzip-1.04/Makefile.new	2009-10-20 16:00:31.000000000 +0200
+@@ -4,10 +4,10 @@
+ ZLIB_LIB=-lz
+ 
+ # The directory containing the Zlib library (libz.a or libz.so)
+-ZLIB_LIBDIR=/usr/local/lib
++ZLIB_LIBDIR=/opt/local/lib
+ 
+ # The directory containing the Zlib header file (zlib.h)
+-ZLIB_INCLUDE=/usr/local/include
++ZLIB_INCLUDE=/opt/local/include
+ 
+ # Where to install the library.  By default: sub-directory 'zip' of
+ # OCaml's standard library directory.
+--- /dev/null	2009-10-20 16:35:40.000000000 +0200
++++ camlzip-1.04/META	2009-10-20 16:37:31.000000000 +0200
+@@ -0,0 +1,6 @@
++name = "camlzip"
++version = "1.04"
++description = "compression library"
++archive(byte) = "zip.cma"
++archive(native) = "zip.cmxa"
++directory = "+zip"
+--- camlzip-1.04/Makefile.orig	2011-07-04 18:09:00.000000000 +0200
++++ camlzip-1.04/Makefile	2011-07-04 18:10:09.000000000 +0200
+@@ -56,7 +56,8 @@
+ 
+ install:
+ 	mkdir -p $(INSTALLDIR)
+-	cp zip.cma zip.cmi gzip.cmi zip.mli gzip.mli libcamlzip.a $(INSTALLDIR)
++	cp zip.cma zip.cmi gzip.cmi zlib.cmi zip.mli gzip.mli zlib.mli \
++	   libcamlzip.a $(INSTALLDIR)
+ 	if test -f dllcamlzip.so; then \
+ 	  cp dllcamlzip.so $(INSTALLDIR); \
+           ldconf=`$(OCAMLC) -where`/ld.conf; \
+@@ -66,7 +67,7 @@
+         fi
+ 
+ installopt:
+-	cp zip.cmxa zip.a zip.cmx gzip.cmx $(INSTALLDIR)
++	cp zip.cmxa zip.a zip.cmx gzip.cmx zlib.cmx $(INSTALLDIR)
+ 
+ depend:
+ 	gcc -MM -I$(ZLIB_INCLUDE) *.c > .depend
diff -Nru ocaml-3.12.1/testsuite/external/coq-8.3pl4.patch ocaml-4.01.0/testsuite/external/coq-8.3pl4.patch
--- ocaml-3.12.1/testsuite/external/coq-8.3pl4.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/coq-8.3pl4.patch	2012-08-02 08:17:59.000000000 +0000
@@ -0,0 +1,59 @@
+--- coq-8.3pl4.orig/configure	2011-12-19 22:57:30.000000000 +0100
++++ coq-8.3pl4/configure	2012-03-16 11:44:55.000000000 +0100
+@@ -444,7 +444,7 @@
+ 
+ if [ "$coq_debug_flag" = "-g" ]; then
+     case $CAMLTAG in
+-        OCAML31*)
++        OCAML31*|OCAML4*)
+             # Compilation debug flag
+             coq_debug_flag_opt="-g"
+             ;;
+@@ -494,7 +494,7 @@
+     camlp4oexec=`echo $camlp4oexec | sed -e 's/4/5/'`
+ else
+     case $CAMLTAG in
+-        OCAML31*)
++        OCAML31*|OCAML4*)
+             if [ -x "${CAMLLIB}/camlp5" ]; then
+                 CAMLP4LIB=+camlp5
+             elif [ -x "${CAMLLIB}/site-lib/camlp5" ]; then
+@@ -538,7 +538,7 @@
+       CAMLOPTVERSION=`"$nativecamlc" -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' `
+       if [ "`uname -s`" = "Darwin" -a "$ARCH" = "i386" ]; then
+ 	  case $CAMLOPTVERSION in
+-	      3.09.3|3.1?*) ;;
++	      3.09.3|3.1?*|4.*) ;;
+ 	      *) echo "Native compilation on MacOS X Pentium requires Objective-Caml >= 3.09.3,"
+ 		 best_compiler=byte
+ 		 echo "only the bytecode version of Coq will be available."
+--- coq-8.3pl4/scripts/coqmktop.ml.orig	2012-05-26 21:32:12.000000000 +0200
++++ coq-8.3pl4/scripts/coqmktop.ml	2012-05-26 21:36:35.000000000 +0200
+@@ -63,6 +63,7 @@
+       (src_dirs ())
+       (["-I"; "\"" ^ camlp4lib ^ "\""] @
+ 	 ["-I"; "\"" ^ coqlib ^ "\""] @
++         ["-I"; "+compiler-libs"] @
+ 	 (if !coqide then ["-thread"; "-I"; "+lablgtk2"] else []))
+ 
+ (* Transform bytecode object file names in native object file names *)
+@@ -274,7 +275,7 @@
+         ocamloptexec^" -linkall"
+     end else
+       (* bytecode (we shunt ocamlmktop script which fails on win32) *)
+-      let ocamlmktoplib = " toplevellib.cma" in
++      let ocamlmktoplib = " ocamlcommon.cma ocamlbytecomp.cma ocamltoplevel.cma" in
+       let ocamlcexec = Filename.concat camlbin "ocamlc" in
+       let ocamlccustom = Printf.sprintf "%s %s -linkall "
+         ocamlcexec Coq_config.coqrunbyteflags in
+--- coq-8.3pl4/configure.orig	2012-07-18 11:31:08.353180800 +0200
++++ coq-8.3pl4/configure	2012-07-18 11:31:10.346046400 +0200
+@@ -272,7 +272,7 @@
+     no) 
+     # First we test if we are running a Cygwin system
+     if [ `uname -s | cut -c -6` = "CYGWIN" ] ; then
+-	ARCH="win32"
++	ARCH=`uname -s`
+     else
+ 	# If not, we determine the architecture
+ 	if test -x /bin/arch ; then
diff -Nru ocaml-3.12.1/testsuite/external/core-109.37.00.patch ocaml-4.01.0/testsuite/external/core-109.37.00.patch
--- ocaml-3.12.1/testsuite/external/core-109.37.00.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/core-109.37.00.patch	2013-08-13 14:58:09.000000000 +0000
@@ -0,0 +1,20 @@
+--- core-109.37.00.orig/lib/core_unix.ml	2013-08-06 21:52:16.000000000 +0200
++++ core-109.37.00/lib/core_unix.ml	2013-08-13 15:25:11.000000000 +0200
+@@ -890,6 +890,7 @@
+ | O_SYNC
+ | O_RSYNC
+ | O_SHARE_DELETE
++| O_CLOEXEC
+ with sexp
+ 
+ type file_perm = int with of_sexp
+--- core-109.37.00.orig/lib/core_unix.mli	2013-08-06 21:52:16.000000000 +0200
++++ core-109.37.00/lib/core_unix.mli	2013-08-13 15:25:32.000000000 +0200
+@@ -305,6 +305,7 @@
+     | O_SYNC          (** Writes complete as `Synchronised I/O file integrity completion' *)
+     | O_RSYNC         (** Reads complete as writes (depending on O_SYNC/O_DSYNC) *)
+     | O_SHARE_DELETE  (** Windows only: allow the file to be deleted while still open *)
++    | O_CLOEXEC
+ with sexp
+ 
+ (** The type of file access rights. *)
diff -Nru ocaml-3.12.1/testsuite/external/core-suite-108.00.01.patch ocaml-4.01.0/testsuite/external/core-suite-108.00.01.patch
--- ocaml-3.12.1/testsuite/external/core-suite-108.00.01.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/core-suite-108.00.01.patch	2012-08-02 08:17:59.000000000 +0000
@@ -0,0 +1,213 @@
+--- core-suite-108.00.01.orig/sexplib-108.00.01/top/install_printers.ml	2012-05-14 20:53:09.000000000 +0200
++++ core-suite-108.00.01/sexplib-108.00.01/top/install_printers.ml	2012-07-12 17:33:45.000000000 +0200
+@@ -3,8 +3,11 @@
+ let eval_string
+       ?(print_outcome = false) ?(err_formatter = Format.err_formatter) str =
+   let lexbuf = Lexing.from_string str in
++assert false
++(*
+   let phrase = !Toploop.parse_toplevel_phrase lexbuf in
+   Toploop.execute_phrase print_outcome err_formatter phrase
++*)
+ 
+ let rec install_printers = function
+   | [] -> true
+--- core-suite-108.00.01.orig/core-108.00.01/lib/core_unix.mli	2012-05-25 23:10:12.000000000 +0200
++++ core-suite-108.00.01/core-108.00.01/lib/core_unix.mli	2012-07-12 17:39:29.000000000 +0200
+@@ -296,6 +296,7 @@
+     | O_DSYNC      (** Writes complete as `Synchronised I/O data integrity completion' *)
+     | O_SYNC       (** Writes complete as `Synchronised I/O file integrity completion' *)
+     | O_RSYNC      (** Reads complete as writes (depending on O_SYNC/O_DSYNC) *)
++    | O_SHARE_DELETE
+ with sexp
+ 
+ (** The type of file access rights. *)
+--- core-suite-108.00.01.orig/core-108.00.01/lib/core_unix.ml	2012-05-25 23:10:12.000000000 +0200
++++ core-suite-108.00.01/core-108.00.01/lib/core_unix.ml	2012-07-12 17:44:04.000000000 +0200
+@@ -804,6 +804,7 @@
+ | O_DSYNC
+ | O_SYNC
+ | O_RSYNC
++| O_SHARE_DELETE
+ with sexp
+ 
+ type file_perm = int with of_sexp
+--- core-suite-108.00.01.orig/core-108.00.01/top/install_printers.ml	2012-05-17 16:50:03.000000000 +0200
++++ core-suite-108.00.01/core-108.00.01/top/install_printers.ml	2012-07-12 17:48:36.000000000 +0200
+@@ -5,8 +5,11 @@
+ let eval_string
+       ?(print_outcome = false) ?(err_formatter = Format.err_formatter) str =
+   let lexbuf = Lexing.from_string str in
++assert false
++(*
+   let phrase = !Toploop.parse_toplevel_phrase lexbuf in
+   Toploop.execute_phrase print_outcome err_formatter phrase
++*)
+ 
+ let rec install_printers = function
+   | [] -> true
+--- core-suite-108.00.01.orig/async-108.00.01/myocamlbuild.ml	2012-05-26 00:48:10.000000000 +0200
++++ core-suite-108.00.01/async-108.00.01/myocamlbuild.ml	2012-07-12 17:59:01.000000000 +0200
+@@ -630,7 +630,7 @@
+       List.concat (List.map f flags)
+     in
+     flag ["compile"; "c"] (S cflags);
+-    flag ["compile"; "ocaml"] (S [A "-w"; A "@Aemr-28"; A "-strict-sequence" ])
++    flag ["compile"; "ocaml"] (S [A "-w"; A "Aemr-28"; A "-strict-sequence" ])
+ ;;
+ 
+ let dispatch = function
+--- core-suite-108.00.01.orig/async_core-108.00.01/myocamlbuild.ml	2012-05-26 00:48:09.000000000 +0200
++++ core-suite-108.00.01/async_core-108.00.01/myocamlbuild.ml	2012-07-12 17:58:57.000000000 +0200
+@@ -630,7 +630,7 @@
+       List.concat (List.map f flags)
+     in
+     flag ["compile"; "c"] (S cflags);
+-    flag ["compile"; "ocaml"] (S [A "-w"; A "@Aemr-28"; A "-strict-sequence" ])
++    flag ["compile"; "ocaml"] (S [A "-w"; A "Aemr-28"; A "-strict-sequence" ])
+ ;;
+ 
+ let dispatch = function
+--- core-suite-108.00.01.orig/async_extra-108.00.01/myocamlbuild.ml	2012-05-26 00:48:09.000000000 +0200
++++ core-suite-108.00.01/async_extra-108.00.01/myocamlbuild.ml	2012-07-12 17:58:53.000000000 +0200
+@@ -630,7 +630,7 @@
+       List.concat (List.map f flags)
+     in
+     flag ["compile"; "c"] (S cflags);
+-    flag ["compile"; "ocaml"] (S [A "-w"; A "@Aemr-28"; A "-strict-sequence" ])
++    flag ["compile"; "ocaml"] (S [A "-w"; A "Aemr-28"; A "-strict-sequence" ])
+ ;;
+ 
+ let dispatch = function
+--- core-suite-108.00.01.orig/async_unix-108.00.01/myocamlbuild.ml	2012-05-26 00:48:09.000000000 +0200
++++ core-suite-108.00.01/async_unix-108.00.01/myocamlbuild.ml	2012-07-12 17:58:48.000000000 +0200
+@@ -630,7 +630,7 @@
+       List.concat (List.map f flags)
+     in
+     flag ["compile"; "c"] (S cflags);
+-    flag ["compile"; "ocaml"] (S [A "-w"; A "@Aemr-28"; A "-strict-sequence" ])
++    flag ["compile"; "ocaml"] (S [A "-w"; A "Aemr-28"; A "-strict-sequence" ])
+ ;;
+ 
+ let dispatch = function
+--- core-suite-108.00.01.orig/bin_prot-108.00.01/myocamlbuild.ml	2012-05-26 00:48:07.000000000 +0200
++++ core-suite-108.00.01/bin_prot-108.00.01/myocamlbuild.ml	2012-07-12 17:15:41.000000000 +0200
+@@ -636,7 +636,7 @@
+       List.concat (List.map f flags)
+     in
+     flag ["compile"; "c"] (S cflags);
+-    flag ["compile"; "ocaml"] (S [A "-w"; A "@Aemr-28"; A "-strict-sequence" ])
++    flag ["compile"; "ocaml"] (S [A "-w"; A "Aemr-28"; A "-strict-sequence" ])
+ ;;
+ 
+ (* We probably will want to set this up in the `configure` script at some
+--- core-suite-108.00.01.orig/comparelib-108.00.01/myocamlbuild.ml	2012-05-26 00:48:06.000000000 +0200
++++ core-suite-108.00.01/comparelib-108.00.01/myocamlbuild.ml	2012-07-12 17:58:40.000000000 +0200
+@@ -631,7 +631,7 @@
+       List.concat (List.map f flags)
+     in
+     flag ["compile"; "c"] (S cflags);
+-    flag ["compile"; "ocaml"] (S [A "-w"; A "@Aemr-28"; A "-strict-sequence" ])
++    flag ["compile"; "ocaml"] (S [A "-w"; A "Aemr-28"; A "-strict-sequence" ])
+ ;;
+ 
+ let dispatch = function
+--- core-suite-108.00.01.orig/core-108.00.01/myocamlbuild.ml	2012-05-26 00:48:08.000000000 +0200
++++ core-suite-108.00.01/core-108.00.01/myocamlbuild.ml	2012-07-12 17:35:18.000000000 +0200
+@@ -643,7 +643,7 @@
+       List.concat (List.map f flags)
+     in
+     flag ["compile"; "c"] (S cflags);
+-    flag ["compile"; "ocaml"] (S [A "-w"; A "@Aemr-28"; A "-strict-sequence" ])
++    flag ["compile"; "ocaml"] (S [A "-w"; A "Aemr-28"; A "-strict-sequence" ])
+ ;;
+ 
+ let dispatch = function
+--- core-suite-108.00.01.orig/core_extended-108.00.01/myocamlbuild.ml	2012-05-26 00:48:09.000000000 +0200
++++ core-suite-108.00.01/core_extended-108.00.01/myocamlbuild.ml	2012-07-12 17:51:57.000000000 +0200
+@@ -645,7 +645,7 @@
+       List.concat (List.map f flags)
+     in
+     flag ["compile"; "c"] (S cflags);
+-    flag ["compile"; "ocaml"] (S [A "-w"; A "@Aemr-28"; A "-strict-sequence" ])
++    flag ["compile"; "ocaml"] (S [A "-w"; A "Aemr-28"; A "-strict-sequence" ])
+ ;;
+ 
+ let dispatch = function
+--- core-suite-108.00.01.orig/fieldslib-108.00.01/myocamlbuild.ml	2012-05-26 00:48:06.000000000 +0200
++++ core-suite-108.00.01/fieldslib-108.00.01/myocamlbuild.ml	2012-07-12 17:07:50.000000000 +0200
+@@ -631,7 +631,7 @@
+       List.concat (List.map f flags)
+     in
+     flag ["compile"; "c"] (S cflags);
+-    flag ["compile"; "ocaml"] (S [A "-w"; A "@Aemr-28"; A "-strict-sequence" ])
++    flag ["compile"; "ocaml"] (S [A "-w"; A "Aemr-28"; A "-strict-sequence" ])
+ ;;
+ 
+ let dispatch = function
+--- core-suite-108.00.01.orig/pa_ounit-108.00.01/myocamlbuild.ml	2012-05-26 00:48:06.000000000 +0200
++++ core-suite-108.00.01/pa_ounit-108.00.01/myocamlbuild.ml	2012-07-12 17:13:58.000000000 +0200
+@@ -630,7 +630,7 @@
+       List.concat (List.map f flags)
+     in
+     flag ["compile"; "c"] (S cflags);
+-    flag ["compile"; "ocaml"] (S [A "-w"; A "@Aemr-28"; A "-strict-sequence" ])
++    flag ["compile"; "ocaml"] (S [A "-w"; A "Aemr-28"; A "-strict-sequence" ])
+ ;;
+ 
+ let dispatch = function
+--- core-suite-108.00.01.orig/pipebang-108.00.01/myocamlbuild.ml	2012-05-26 00:48:06.000000000 +0200
++++ core-suite-108.00.01/pipebang-108.00.01/myocamlbuild.ml	2012-07-12 17:58:22.000000000 +0200
+@@ -630,7 +630,7 @@
+       List.concat (List.map f flags)
+     in
+     flag ["compile"; "c"] (S cflags);
+-    flag ["compile"; "ocaml"] (S [A "-w"; A "@Aemr-28"; A "-strict-sequence" ])
++    flag ["compile"; "ocaml"] (S [A "-w"; A "Aemr-28"; A "-strict-sequence" ])
+ ;;
+ 
+ let dispatch = function
+--- core-suite-108.00.01.orig/sexplib-108.00.01/myocamlbuild.ml	2012-05-26 00:48:07.000000000 +0200
++++ core-suite-108.00.01/sexplib-108.00.01/myocamlbuild.ml	2012-07-12 17:24:42.000000000 +0200
+@@ -635,7 +635,7 @@
+       List.concat (List.map f flags)
+     in
+     flag ["compile"; "c"] (S cflags);
+-    flag ["compile"; "ocaml"] (S [A "-w"; A "@Aemr-28"; A "-strict-sequence" ])
++    flag ["compile"; "ocaml"] (S [A "-w"; A "Aemr-28"; A "-strict-sequence"])
+ ;;
+ 
+ Ocamlbuild_plugin.dispatch
+--- core-suite-108.00.01.orig/type_conv-108.00.01/myocamlbuild.ml	2012-05-26 00:48:05.000000000 +0200
++++ core-suite-108.00.01/type_conv-108.00.01/myocamlbuild.ml	2012-07-12 17:05:31.000000000 +0200
+@@ -630,7 +630,7 @@
+       List.concat (List.map f flags)
+     in
+     flag ["compile"; "c"] (S cflags);
+-    flag ["compile"; "ocaml"] (S [A "-w"; A "@Aemr-28"; A "-strict-sequence" ])
++    flag ["compile"; "ocaml"] (S [A "-w"; A "Aemr-28"; A "-strict-sequence" ])
+ ;;
+ 
+ let dispatch = function
+--- core-suite-108.00.01.orig/typehashlib-108.00.01/myocamlbuild.ml	2012-05-26 00:48:06.000000000 +0200
++++ core-suite-108.00.01/typehashlib-108.00.01/myocamlbuild.ml	2012-07-12 17:58:06.000000000 +0200
+@@ -631,7 +631,7 @@
+       List.concat (List.map f flags)
+     in
+     flag ["compile"; "c"] (S cflags);
+-    flag ["compile"; "ocaml"] (S [A "-w"; A "@Aemr-28"; A "-strict-sequence" ])
++    flag ["compile"; "ocaml"] (S [A "-w"; A "Aemr-28"; A "-strict-sequence" ])
+ ;;
+ 
+ let dispatch = function
+--- core-suite-108.00.01.orig/variantslib-108.00.01/myocamlbuild.ml	2012-05-26 00:48:06.000000000 +0200
++++ core-suite-108.00.01/variantslib-108.00.01/myocamlbuild.ml	2012-07-12 17:11:51.000000000 +0200
+@@ -631,7 +631,7 @@
+       List.concat (List.map f flags)
+     in
+     flag ["compile"; "c"] (S cflags);
+-    flag ["compile"; "ocaml"] (S [A "-w"; A "@Aemr-28"; A "-strict-sequence" ])
++    flag ["compile"; "ocaml"] (S [A "-w"; A "Aemr-28"; A "-strict-sequence" ])
+ ;;
+ 
+ let dispatch = function
diff -Nru ocaml-3.12.1/testsuite/external/extlib-1.5.2.patch ocaml-4.01.0/testsuite/external/extlib-1.5.2.patch
--- ocaml-3.12.1/testsuite/external/extlib-1.5.2.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/extlib-1.5.2.patch	2012-08-02 08:17:59.000000000 +0000
@@ -0,0 +1,10 @@
+--- extlib-1.5.2.orig/extHashtbl.ml	2011-08-06 16:56:39.000000000 +0200
++++ extlib-1.5.2/extHashtbl.ml	2012-01-12 19:48:28.000000000 +0100
+@@ -32,6 +32,7 @@
+ 	}
+ 
+ 	include Hashtbl
++        let create n = Hashtbl.create (* no seed *) n
+ 
+ 	external h_conv : ('a, 'b) t -> ('a, 'b) h_t = "%identity"
+ 	external h_make : ('a, 'b) h_t -> ('a, 'b) t = "%identity"
diff -Nru ocaml-3.12.1/testsuite/external/frama-c-Nitrogen-20111001.patch ocaml-4.01.0/testsuite/external/frama-c-Nitrogen-20111001.patch
--- ocaml-3.12.1/testsuite/external/frama-c-Nitrogen-20111001.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/frama-c-Nitrogen-20111001.patch	2012-08-02 08:17:59.000000000 +0000
@@ -0,0 +1,126 @@
+diff -r -u frama-c-Nitrogen-20111001.orig/src/type/datatype.mli frama-c-Nitrogen-20111001/src/type/datatype.mli
+--- frama-c-Nitrogen-20111001.orig/src/type/datatype.mli	2011-10-10 10:38:09.000000000 +0200
++++ frama-c-Nitrogen-20111001/src/type/datatype.mli	2012-01-05 18:35:45.000000000 +0100
+@@ -249,10 +249,27 @@
+ 
+ end
+ 
++module type Hashtbl_S = sig
++    type key
++    type 'a t
++    val create : int -> 'a t
++    val clear : 'a t -> unit
++    val copy : 'a t -> 'a t
++    val add : 'a t -> key -> 'a -> unit
++    val remove : 'a t -> key -> unit
++    val find : 'a t -> key -> 'a
++    val find_all : 'a t -> key -> 'a list
++    val replace : 'a t -> key -> 'a -> unit
++    val mem : 'a t -> key -> bool
++    val iter : (key -> 'a -> unit) -> 'a t -> unit
++    val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
++    val length : 'a t -> int
++end
++
+ (** A standard OCaml hashtbl signature extended with datatype operations. *)
+ module type Hashtbl = sig
+ 
+-  include Hashtbl.S
++  include Hashtbl_S
+ 
+   val memo: 'a t -> key -> (key -> 'a) -> 'a
+   (** [memo tbl k f] returns the binding of [k] in [tbl]. If there is
+@@ -468,7 +485,7 @@
+ module Map(M: Map_common_interface.S)(Key: S with type t = M.key)(Info: Functor_info) :
+   Map with type 'a t = 'a M.t and type key = M.key and module Key = Key
+ 
+-module Hashtbl(H: Hashtbl.S)(Key: S with type t = H.key)(Info : Functor_info):
++module Hashtbl(H: Hashtbl_S)(Key: S with type t = H.key)(Info : Functor_info):
+   Hashtbl with type 'a t = 'a H.t and type key = H.key and module Key = Key
+ 
+ module type Sub_caml_weak_hashtbl = sig
+diff -r -u frama-c-Nitrogen-20111001.orig/src/wp/LogicId.mli frama-c-Nitrogen-20111001/src/wp/LogicId.mli
+--- frama-c-Nitrogen-20111001.orig/src/wp/LogicId.mli	2011-10-10 10:38:21.000000000 +0200
++++ frama-c-Nitrogen-20111001/src/wp/LogicId.mli	2012-01-05 18:38:36.000000000 +0100
+@@ -40,7 +40,7 @@
+ 
+ module Iset : Set.S with type elt = t
+ module Imap : Map.S with type key = t
+-module Ihmap : Hashtbl.S with type key = t
++module Ihmap : Datatype.Hashtbl_S with type key = t
+ 
+ (** {3 Name Spaces} *)
+ 
+diff -r -u frama-c-Nitrogen-20111001.orig/src/wp/fol_formula.ml frama-c-Nitrogen-20111001/src/wp/fol_formula.ml
+--- frama-c-Nitrogen-20111001.orig/src/wp/fol_formula.ml	2011-10-10 10:38:21.000000000 +0200
++++ frama-c-Nitrogen-20111001/src/wp/fol_formula.ml	2012-01-05 18:31:40.000000000 +0100
+@@ -389,7 +389,7 @@
+ module type Identifiable =
+ sig
+   type t
+-  module H : Hashtbl.S
++  module H : Datatype.Hashtbl_S
+   val index : t -> H.key
+   val prefix : string
+   val basename : t -> string
+diff -r -u frama-c-Nitrogen-20111001.orig/src/wp/formula.mli frama-c-Nitrogen-20111001/src/wp/formula.mli
+--- frama-c-Nitrogen-20111001.orig/src/wp/formula.mli	2011-10-10 10:38:21.000000000 +0200
++++ frama-c-Nitrogen-20111001/src/wp/formula.mli	2012-01-05 18:38:28.000000000 +0100
+@@ -147,7 +147,7 @@
+   module type Identifiable =
+   sig
+     type t
+-    module H : Hashtbl.S
++    module H : Datatype.Hashtbl_S
+     val index : t -> H.key
+     val prefix : string
+     val basename : t -> string
+--- frama-c-Nitrogen-20111001.orig/src/type/datatype.ml	2011-10-10 10:38:09.000000000 +0200
++++ frama-c-Nitrogen-20111001/src/type/datatype.ml	2012-01-05 18:46:38.000000000 +0100
+@@ -306,8 +306,26 @@
+   module Make(Data: S) : S with type t = Data.t t
+ end
+ 
++module type Hashtbl_S =
++  sig
++    type key
++    type 'a t
++    val create : int -> 'a t
++    val clear : 'a t -> unit
++    val copy : 'a t -> 'a t
++    val add : 'a t -> key -> 'a -> unit
++    val remove : 'a t -> key -> unit
++    val find : 'a t -> key -> 'a
++    val find_all : 'a t -> key -> 'a list
++    val replace : 'a t -> key -> 'a -> unit
++    val mem : 'a t -> key -> bool
++    val iter : (key -> 'a -> unit) -> 'a t -> unit
++    val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
++    val length : 'a t -> int
++  end
++
+ module type Hashtbl = sig
+-  include Hashtbl.S
++  include Hashtbl_S
+   val memo: 'a t -> key -> (key -> 'a) -> 'a
+   module Key: S with type t = key
+   module Make(Data: S) : S with type t = Data.t t
+@@ -970,7 +988,7 @@
+ module Initial_caml_hashtbl = Hashtbl
+ 
+ (* ocaml functors are generative *)
+-module Hashtbl(H: Hashtbl.S)(Key: S with type t = H.key)(Info : Functor_info) =
++module Hashtbl(H: Hashtbl_S)(Key: S with type t = H.key)(Info : Functor_info) =
+ struct
+ 
+   let () = check Key.equal "equal" Key.name Info.module_name
+--- frama-c-Nitrogen-20111001/configure.orig	2012-03-12 16:14:45.000000000 +0100
++++ frama-c-Nitrogen-20111001/configure	2012-03-12 16:15:06.000000000 +0100
+@@ -2675,6 +2675,7 @@
+          ;;
+   3.10*) echo "${ECHO_T}good!";;
+   3.1*) echo "${ECHO_T}good!"; OCAML_ANNOT_OPTION="-annot";;
++  4.0*) echo "${ECHO_T}good!"; OCAML_ANNOT_OPTION="-annot";;
+   *) echo "${ECHO_T}Incompatible version!"; exit 2;;
+ esac
+ 
diff -Nru ocaml-3.12.1/testsuite/external/frama-c-Oxygen-20120901.patch ocaml-4.01.0/testsuite/external/frama-c-Oxygen-20120901.patch
--- ocaml-3.12.1/testsuite/external/frama-c-Oxygen-20120901.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/frama-c-Oxygen-20120901.patch	2013-02-26 12:45:32.000000000 +0000
@@ -0,0 +1,185 @@
+--- frama-c-Oxygen-20120901.orig/src/type/datatype.ml	2012-09-19 13:55:23.000000000 +0200
++++ frama-c-Oxygen-20120901/src/type/datatype.ml	2013-02-19 16:36:36.000000000 +0100
+@@ -285,8 +285,37 @@
+ 
+ end
+ 
++module type Set_S = sig
++    type elt
++    type t
++    val empty: t
++    val is_empty: t -> bool
++    val mem: elt -> t -> bool
++    val add: elt -> t -> t
++    val singleton: elt -> t
++    val remove: elt -> t -> t
++    val union: t -> t -> t
++    val inter: t -> t -> t
++    val diff: t -> t -> t
++    val compare: t -> t -> int
++    val equal: t -> t -> bool
++    val subset: t -> t -> bool
++    val iter: (elt -> unit) -> t -> unit
++    val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a
++    val for_all: (elt -> bool) -> t -> bool
++    val exists: (elt -> bool) -> t -> bool
++    val filter: (elt -> bool) -> t -> t
++    val partition: (elt -> bool) -> t -> t * t
++    val cardinal: t -> int
++    val elements: t -> elt list
++    val min_elt: t -> elt
++    val max_elt: t -> elt
++    val choose: t -> elt
++    val split: elt -> t -> t * bool * t
++end
++
+ module type Set = sig
+-  include Set.S
++  include Set_S
+   val ty: t Type.t
+   val name: string
+   val descr: t Descr.t
+@@ -1093,7 +1122,7 @@
+ module Initial_caml_set = Set
+ 
+ (* ocaml functors are generative *)
+-module Set(S: Set.S)(E: S with type t = S.elt)(Info: Functor_info) = struct
++module Set(S: Set_S)(E: S with type t = S.elt)(Info: Functor_info) = struct
+ 
+   let () = check E.equal "equal" E.name Info.module_name
+   let () = check E.compare "compare" E.name Info.module_name
+--- frama-c-Oxygen-20120901.orig/src/type/datatype.mli	2012-09-19 13:55:23.000000000 +0200
++++ frama-c-Oxygen-20120901/src/type/datatype.mli	2013-02-19 16:36:29.000000000 +0100
+@@ -230,9 +230,38 @@
+     defining by applying the functor. *)
+ end
+ 
++module type Set_S = sig
++    type elt
++    type t
++    val empty: t
++    val is_empty: t -> bool
++    val mem: elt -> t -> bool
++    val add: elt -> t -> t
++    val singleton: elt -> t
++    val remove: elt -> t -> t
++    val union: t -> t -> t
++    val inter: t -> t -> t
++    val diff: t -> t -> t
++    val compare: t -> t -> int
++    val equal: t -> t -> bool
++    val subset: t -> t -> bool
++    val iter: (elt -> unit) -> t -> unit
++    val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a
++    val for_all: (elt -> bool) -> t -> bool
++    val exists: (elt -> bool) -> t -> bool
++    val filter: (elt -> bool) -> t -> t
++    val partition: (elt -> bool) -> t -> t * t
++    val cardinal: t -> int
++    val elements: t -> elt list
++    val min_elt: t -> elt
++    val max_elt: t -> elt
++    val choose: t -> elt
++    val split: elt -> t -> t * bool * t
++end
++
+ (** A standard OCaml set signature extended with datatype operations. *)
+ module type Set = sig
+-  include Set.S
++  include Set_S
+   val ty: t Type.t
+   val name: string
+   val descr: t Descr.t
+@@ -602,7 +631,7 @@
+   'e Type.t ->
+   ('a -> 'b -> 'c -> 'd -> 'e) Type.t
+ 
+-module Set(S: Set.S)(E: S with type t = S.elt)(Info : Functor_info):
++module Set(S: Set_S)(E: S with type t = S.elt)(Info : Functor_info):
+   Set with type t = S.t and type elt = E.t
+ 
+ module Map
+--- frama-c-Oxygen-20120901.orig/src/wp/qed/src/idxset.ml	2012-09-19 13:55:28.000000000 +0200
++++ frama-c-Oxygen-20120901/src/wp/qed/src/idxset.ml	2013-02-19 16:45:08.000000000 +0100
+@@ -20,9 +20,38 @@
+ (*                                                                        *)
+ (**************************************************************************)
+ 
++module type Set_S = sig
++    type elt
++    type t
++    val empty: t
++    val is_empty: t -> bool
++    val mem: elt -> t -> bool
++    val add: elt -> t -> t
++    val singleton: elt -> t
++    val remove: elt -> t -> t
++    val union: t -> t -> t
++    val inter: t -> t -> t
++    val diff: t -> t -> t
++    val compare: t -> t -> int
++    val equal: t -> t -> bool
++    val subset: t -> t -> bool
++    val iter: (elt -> unit) -> t -> unit
++    val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a
++    val for_all: (elt -> bool) -> t -> bool
++    val exists: (elt -> bool) -> t -> bool
++    val filter: (elt -> bool) -> t -> t
++    val partition: (elt -> bool) -> t -> t * t
++    val cardinal: t -> int
++    val elements: t -> elt list
++    val min_elt: t -> elt
++    val max_elt: t -> elt
++    val choose: t -> elt
++    val split: elt -> t -> t * bool * t
++end
++
+ module type S =
+ sig
+-  include Set.S
++  include Set_S
+   val map : (elt -> elt) -> t -> t
+   val intersect : t -> t -> bool
+ end
+--- frama-c-Oxygen-20120901.orig/src/wp/qed/src/idxset.mli	2012-09-19 13:55:28.000000000 +0200
++++ frama-c-Oxygen-20120901/src/wp/qed/src/idxset.mli	2013-02-19 16:45:19.000000000 +0100
+@@ -22,9 +22,38 @@
+ 
+ (** Set of indexed elements implemented as Patricia sets. *)
+ 
++module type Set_S = sig
++    type elt
++    type t
++    val empty: t
++    val is_empty: t -> bool
++    val mem: elt -> t -> bool
++    val add: elt -> t -> t
++    val singleton: elt -> t
++    val remove: elt -> t -> t
++    val union: t -> t -> t
++    val inter: t -> t -> t
++    val diff: t -> t -> t
++    val compare: t -> t -> int
++    val equal: t -> t -> bool
++    val subset: t -> t -> bool
++    val iter: (elt -> unit) -> t -> unit
++    val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a
++    val for_all: (elt -> bool) -> t -> bool
++    val exists: (elt -> bool) -> t -> bool
++    val filter: (elt -> bool) -> t -> t
++    val partition: (elt -> bool) -> t -> t * t
++    val cardinal: t -> int
++    val elements: t -> elt list
++    val min_elt: t -> elt
++    val max_elt: t -> elt
++    val choose: t -> elt
++    val split: elt -> t -> t * bool * t
++end
++
+ module type S =
+ sig
+-  include Set.S
++  include Set_S
+   val map : (elt -> elt) -> t -> t
+   val intersect : t -> t -> bool
+ end
diff -Nru ocaml-3.12.1/testsuite/external/hevea-1.10.patch ocaml-4.01.0/testsuite/external/hevea-1.10.patch
--- ocaml-3.12.1/testsuite/external/hevea-1.10.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/hevea-1.10.patch	2012-08-02 08:17:59.000000000 +0000
@@ -0,0 +1,22 @@
+diff -r -u hevea-1.10 2/hevea.ml hevea-1.10/hevea.ml
+--- hevea-1.10 2/hevea.ml	2007-02-09 15:44:28.000000000 +0100
++++ hevea-1.10/hevea.ml	2009-08-27 17:51:55.000000000 +0200
+@@ -237,6 +237,7 @@
+ *)
+   end ;
+   let _ = finalize false in
++  begin try Sys.remove Parse_opts.name_out with _ -> () end;
+   prerr_endline "Adios" ;
+   exit 2
+ ;;
+--- hevea-1.10/Makefile.orig	2009-10-28 12:18:16.000000000 +0100
++++ hevea-1.10/Makefile	2009-10-28 12:18:00.000000000 +0100
+@@ -48,7 +48,7 @@
+ all-make: $(TARGET)-make
+ 
+ install: config.sh
+-	./install.sh $(TARGET)
++	LIBDIR=${LIBDIR} LATEXLIBDIR=${LATEXLIBDIR} ./install.sh $(TARGET)
+ 
+ byte: ocb-byte
+ opt: ocb-opt
diff -Nru ocaml-3.12.1/testsuite/external/kaputt-1.2.patch ocaml-4.01.0/testsuite/external/kaputt-1.2.patch
--- ocaml-3.12.1/testsuite/external/kaputt-1.2.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/kaputt-1.2.patch	2013-02-26 12:45:32.000000000 +0000
@@ -0,0 +1,37 @@
+--- kaputt-1.2/src/syntax/kaputt_pp.ml.orig	2012-12-19 16:46:36.000000000 +0100
++++ kaputt-1.2/src/syntax/kaputt_pp.ml	2012-12-19 16:46:59.000000000 +0100
+@@ -54,6 +54,8 @@
+       let temp_name, temp_chan = Filename.open_temp_file "kaputt" ".ml" in
+       let source_chan = open_in args.(len - 3) in
+       let test_chan = open_in test_file in
++      let directive = Printf.sprintf "# 1 %S\n" args.(len - 3) in
++      output_string temp_chan directive;
+       copy source_chan temp_chan;
+       let directive = Printf.sprintf "# 1 %S\n" test_file in
+       output_string temp_chan directive;
+--- kaputt-1.2/src/syntax/kaputt_pp.ml.orig	2013-01-08 17:05:01.000000000 +0100
++++ kaputt-1.2/src/syntax/kaputt_pp.ml	2013-01-08 17:05:46.000000000 +0100
+@@ -28,8 +28,7 @@
+     Buffer.add_string buff (quote args.(i));
+     Buffer.add_char buff ' ';
+   done;
+-  let code = Sys.command (Buffer.contents buff) in
+-  ignore (exit code)
++  Sys.command (Buffer.contents buff)
+ 
+ let copy from_chan to_chan =
+   try
+@@ -64,9 +63,11 @@
+       close_in_noerr test_chan;
+       close_out_noerr temp_chan;
+       args.(len - 3) <- temp_name;
+-      call args
++      let code = call args in
++      (try Sys.remove temp_name with _ -> ());
++      ignore (exit code)
+     end else begin
+-      call args
++      ignore (exit (call args))
+     end
+   else begin
+     Printf.eprintf "Error: invalid command-line\n";
diff -Nru ocaml-3.12.1/testsuite/external/lablgtk-2.14.2.patch ocaml-4.01.0/testsuite/external/lablgtk-2.14.2.patch
--- ocaml-3.12.1/testsuite/external/lablgtk-2.14.2.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/lablgtk-2.14.2.patch	2012-08-02 08:17:59.000000000 +0000
@@ -0,0 +1,11 @@
+--- lablgtk-2.14.2/src/Makefile.orig	2012-07-31 17:37:12.000000000 +0200
++++ lablgtk-2.14.2/src/Makefile	2012-07-31 17:37:17.000000000 +0200
+@@ -191,7 +191,7 @@
+ .ml4.cmo:
+ 	$(CAMLC) -c -pp "$(CAMLP4O) -impl" -impl $<
+ .cmxa.cmxs:
+-	$(CAMLOPT) -verbose -o $@ -shared -linkall -I . \
++	$(CAMLOPT) -o $@ -shared -linkall -I . \
+         -ccopt '$(filter -L%, $(DYNLINKLIBS))' $<
+ 
+ #.ml4.ml:
diff -Nru ocaml-3.12.1/testsuite/external/lablgtk-2.16.0.patch ocaml-4.01.0/testsuite/external/lablgtk-2.16.0.patch
--- ocaml-3.12.1/testsuite/external/lablgtk-2.16.0.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/lablgtk-2.16.0.patch	2013-02-26 12:45:32.000000000 +0000
@@ -0,0 +1,22 @@
+--- lablgtk-2.16.0.orig/src/gMenu.ml	2012-08-23 12:37:48.000000000 +0200
++++ lablgtk-2.16.0/src/gMenu.ml	2013-02-18 20:12:27.000000000 +0100
+@@ -87,7 +87,7 @@
+ 
+ class menu_item_skel = [menu_item] pre_menu_item_skel
+ 
+-let pack_item self ~packing ~show =
++let pack_item self ?packing ?show =
+   may packing ~f:(fun f -> (f (self :> menu_item) : unit));
+   if show <> Some false then self#misc#show ();
+   self
+--- lablgtk-2.16.0.orig/src/gFile.ml	2012-08-23 12:37:48.000000000 +0200
++++ lablgtk-2.16.0/src/gFile.ml	2013-02-18 20:13:37.000000000 +0100
+@@ -179,7 +179,7 @@
+ 	 FileChooser.P.file_system_backend backend
+ 	 [ Gobject.param FileChooser.P.action action ]) in
+   let o = new chooser_widget w in
+-  GObj.pack_return o ?packing ?show
++  GObj.pack_return o ~packing ~show
+ 
+ class chooser_button_signals obj = object
+   inherit GContainer.container_signals_impl obj
diff -Nru ocaml-3.12.1/testsuite/external/lablgtkextras-1.1.patch ocaml-4.01.0/testsuite/external/lablgtkextras-1.1.patch
--- ocaml-3.12.1/testsuite/external/lablgtkextras-1.1.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/lablgtkextras-1.1.patch	2012-08-02 08:17:59.000000000 +0000
@@ -0,0 +1,22 @@
+--- lablgtkextras-1.1.orig/checkocaml.ml	2012-04-13 16:51:37.000000000 +0200
++++ lablgtkextras-1.1/checkocaml.ml	2012-05-25 16:23:36.000000000 +0200
+@@ -885,7 +885,7 @@
+ let _ = !print "\n### checking required tools and libraries ###\n"
+ 
+ let () = check_ocamlfind_package conf "config-file";;
+-let () = check_ocamlfind_package conf "lablgtk2.sourceview2";;
++let () = check_ocamlfind_package conf "lablgtk2";;
+ let () = check_ocamlfind_package conf ~min_version: [1;1] "xmlm";;
+ 
+ let _ = !print "\n###\n"
+--- lablgtkextras-1.1.orig/src/Makefile	2012-04-13 16:51:37.000000000 +0200
++++ lablgtkextras-1.1/src/Makefile	2012-05-25 16:27:58.000000000 +0200
+@@ -26,7 +26,7 @@
+ 
+ include ../master.Makefile
+ 
+-PACKAGES=config-file,lablgtk2.sourceview2,xmlm
++PACKAGES=config-file,lablgtk2,xmlm
+ OF_FLAGS= -package $(PACKAGES)
+ 
+ COMPFLAGS=-annot -g -warn-error A
diff -Nru ocaml-3.12.1/testsuite/external/lablgtkextras-1.3.patch ocaml-4.01.0/testsuite/external/lablgtkextras-1.3.patch
--- ocaml-3.12.1/testsuite/external/lablgtkextras-1.3.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/lablgtkextras-1.3.patch	2013-06-03 14:06:57.000000000 +0000
@@ -0,0 +1,11 @@
+--- lablgtkextras-1.3/src/Makefile.orig	2013-05-29 14:21:34.000000000 +0200
++++ lablgtkextras-1.3/src/Makefile	2013-05-29 14:21:52.000000000 +0200
+@@ -29,7 +29,7 @@
+ PACKAGES=config-file,lablgtk2.sourceview2,xmlm
+ OF_FLAGS= -package $(PACKAGES)
+ 
+-COMPFLAGS=-annot -g -warn-error A
++COMPFLAGS=-annot -g -warn-error a
+ 
+ GELIB_CMOFILES= \
+ 	gtke_version.cmo \
diff -Nru ocaml-3.12.1/testsuite/external/lwt-2.4.0.patch ocaml-4.01.0/testsuite/external/lwt-2.4.0.patch
--- ocaml-3.12.1/testsuite/external/lwt-2.4.0.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/lwt-2.4.0.patch	2013-08-13 14:58:09.000000000 +0000
@@ -0,0 +1,24 @@
+--- lwt-2.4.0.orig/src/unix/lwt_unix.ml	2012-07-19 13:35:56.000000000 +0200
++++ lwt-2.4.0/src/unix/lwt_unix.ml	2013-08-13 15:46:12.000000000 +0200
+@@ -596,6 +596,9 @@
+ #if ocaml_version >= (3, 13)
+   | O_SHARE_DELETE
+ #endif
++#if ocaml_version >= (4, 01)
++  | O_CLOEXEC
++#endif
+ 
+ #if windows
+ 
+--- lwt-2.4.0.orig/src/unix/lwt_unix.mli	2012-07-19 13:35:56.000000000 +0200
++++ lwt-2.4.0/src/unix/lwt_unix.mli	2013-08-13 15:46:18.000000000 +0200
+@@ -315,6 +315,9 @@
+ #if ocaml_version >= (3, 13)
+   | O_SHARE_DELETE
+ #endif
++#if ocaml_version >= (4, 01)
++  | O_CLOEXEC
++#endif
+ 
+ val openfile : string -> open_flag list -> file_perm -> file_descr Lwt.t
+   (** Wrapper for [Unix.openfile]. *)
diff -Nru ocaml-3.12.1/testsuite/external/menhir-20120123.patch ocaml-4.01.0/testsuite/external/menhir-20120123.patch
--- ocaml-3.12.1/testsuite/external/menhir-20120123.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/menhir-20120123.patch	2012-10-15 18:01:26.000000000 +0000
@@ -0,0 +1,11 @@
+--- menhir-20120123/Makefile.arch.orig	2012-09-28 19:03:09.673811200 +0200
++++ menhir-20120123/Makefile.arch	2012-09-28 19:07:38.680344000 +0200
+@@ -1,7 +1,7 @@
+ # If ocaml reports that Sys.os_type is Unix, we assume Unix, otherwise
+ # we assume Windows.
+ 
+-ifeq "$(shell rm -f ./o.ml && echo print_endline Sys.os_type > ./o.ml && ocaml ./o.ml && rm -f ./o.ml)" "Unix"
++ifneq "$(shell rm -f ./o.ml && echo print_endline Sys.os_type > ./o.ml && ocaml ./o.ml && rm -f ./o.ml)" "Win32"
+ MENHIREXE    := menhir
+ OBJ          := o
+ else
diff -Nru ocaml-3.12.1/testsuite/external/mldonkey-3.1.2.patch ocaml-4.01.0/testsuite/external/mldonkey-3.1.2.patch
--- ocaml-3.12.1/testsuite/external/mldonkey-3.1.2.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/mldonkey-3.1.2.patch	2012-08-02 08:17:59.000000000 +0000
@@ -0,0 +1,31 @@
+--- mldonkey-3.1.2.orig/config/configure	2011-08-08 07:11:57.000000000 +0200
++++ mldonkey-3.1.2/config/configure	2012-03-13 12:52:40.000000000 +0100
+@@ -4870,7 +4870,7 @@
+ else
+   OCAMLVERSION=`$OCAMLC -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' `
+   case "$OCAMLVERSION" in
+-    "$REQUIRED_OCAML"*|3.12.*|3.11.*|3.10.1*|3.10.2*) ;;
++    "$REQUIRED_OCAML"*|4.*|3.1[23].*|3.11.*|3.10.1*|3.10.2*) ;;
+     *)
+         echo "Need build"
+         BUILD_OCAML=yes
+@@ -5402,7 +5402,7 @@
+ 
+ # force usage of supported Ocaml versions
+ case "$OCAMLVERSION" in
+-    3.10.1*|3.10.2*|3.1*) ;;
++    3.10.1*|3.10.2*|3.1*|4.*) ;;
+     *)
+       if  test "$REQUIRED_OCAML" != "SVN" ; then
+         echo "********  Version $REQUIRED_OCAML of Objective-Caml is required  *********" 1>&2;
+--- mldonkey-3.1.2.orig/Makefile	2012-05-16 11:56:34.000000000 +0200
++++ mldonkey-3.1.2/Makefile	2012-05-25 19:24:15.000000000 +0200
+@@ -5447,7 +5449,7 @@
+ 	$(OCAMLC) $(DEVFLAGS) $(INCLUDES) -c $<
+ 
+ .mlcpp.ml:
+-	@$(CPP) -x c -P $< $(FIX_BROKEN_CPP) -o $@
++	@$(CPP) -x c -P $< $(FIX_BROKEN_CPP) > $@
+ 
+ %.ml: %.mlp $(BITSTRING)/pa_bitstring.cmo
+ 	$(CAMLP4OF) build/bitstring.cma $(BITSTRING)/bitstring_persistent.cmo $(BITSTRING)/pa_bitstring.cmo -impl $< -o $@
diff -Nru ocaml-3.12.1/testsuite/external/oasis-common.patch ocaml-4.01.0/testsuite/external/oasis-common.patch
--- ocaml-3.12.1/testsuite/external/oasis-common.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/oasis-common.patch	2012-08-02 08:17:59.000000000 +0000
@@ -0,0 +1,55 @@
+--- setup.ml	2011-03-22 17:00:48.000000000 +0100
++++ setup.ml	2011-12-22 21:41:25.000000000 +0100
+@@ -2662,10 +2662,14 @@
+         (ocamlc_config_map ())
+         0
+     in
+-    let nm_config =
++    let chop_version_suffix s =
++      try String.sub s 0 (String.index s '+')
++      with _ -> s
++    in
++    let nm_config, value_config =
+       match nm with 
+-        | "ocaml_version" -> "version"
+-        | _ -> nm
++        | "ocaml_version" -> "version", chop_version_suffix
++        | _ -> nm, (fun x -> x)
+     in
+       var_redefine
+         nm 
+@@ -2677,7 +2681,7 @@
+               let value = 
+                 SMap.find nm_config map
+               in
+-                value
++                value_config value
+             with Not_found ->
+               failwithf2
+                 (f_ "Cannot find field '%s' in '%s -config' output")
+@@ -3057,7 +3061,7 @@
+             begin
+               let acc = 
+                 try 
+-                  Scanf.bscanf scbuf "%S %S@\n" 
++                  Scanf.bscanf scbuf "%S %S\n" 
+                     (fun e d ->  
+                        let t = 
+                          e, d
+--- setup.ml.orig	2012-03-17 11:50:20.000000000 +0100
++++ setup.ml	2012-07-31 17:45:43.000000000 +0200
+@@ -2284,7 +2284,13 @@
+     let cmdline =
+       String.concat " " (cmd :: args)
+     in
+-      info (f_ "Running command '%s'") cmdline;
++    let printable_cmdline =
++      match List.rev args with
++      | _ :: (">" | "2>") :: rest ->
++         String.concat " " (cmd :: List.rev ("[file]" :: ">" :: rest))
++      | _ -> cmdline
++    in
++      info (f_ "Running command '%s'") printable_cmdline;
+       match f_exit_code, Sys.command cmdline with
+         | None, 0 -> ()
+         | None, i ->
diff -Nru ocaml-3.12.1/testsuite/external/obrowser-1.1.1.patch ocaml-4.01.0/testsuite/external/obrowser-1.1.1.patch
--- ocaml-3.12.1/testsuite/external/obrowser-1.1.1.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/obrowser-1.1.1.patch	2013-08-13 14:58:09.000000000 +0000
@@ -0,0 +1,1161 @@
+--- obrowser-1.1.1/Makefile.orig	2011-07-05 16:15:30.000000000 +0200
++++ obrowser-1.1.1/Makefile	2011-07-05 16:16:42.000000000 +0200
+@@ -16,9 +16,9 @@
+ EXAMPLES = $(patsubst examples/%,%, $(wildcard examples/*))
+ EXAMPLES_TARGETS = $(patsubst examples/%,%.example, $(wildcard examples/*))
+ OCAMLFIND = ocamlfind
+-.PHONY: tuto dist plugin lwt
++.PHONY: tuto dist plugin lwt AXO
+ 
+-all: .check_version rt/caml/stdlib.cma vm.js tuto $(EXAMPLES_TARGETS) examples.html AXO lwt
++all: .check_version rt/caml/stdlib.cma vm.js tuto AXO $(EXAMPLES_TARGETS) examples.html lwt
+ 
+ .check_version:
+ 	@[ "$(shell ocamlc -vnum)" = "3.12.0" ] || \
+--- obrowser-1.1.1.orig/Makefile	2011-04-20 18:26:44.000000000 +0200
++++ obrowser-1.1.1/Makefile	2012-03-12 16:55:44.000000000 +0100
+@@ -21,10 +21,11 @@
+ all: .check_version rt/caml/stdlib.cma vm.js tuto $(EXAMPLES_TARGETS) examples.html AXO lwt
+ 
+ .check_version:
+-	@[ "$(shell ocamlc -vnum)" = "3.12.0" ] || \
+-	  [ "$(shell ocamlc -vnum)" = "3.12.1" ] || \
+-	  ( echo "You need ocaml version 3.12.0 or 3.12.1"; \
+-            exit 1 )
++	@case `ocaml -vnum` in \
++	  3.1[2-9].*);; \
++	  4.*);; \
++	  *) echo "You need ocaml version 3.12.0 or later"; exit 1;; \
++	 esac
+ 	touch $@
+ 
+ %.example: 
+--- obrowser-1.1.1.orig/rt/caml/pervasives.mli	2011-04-20 18:26:44.000000000 +0200
++++ obrowser-1.1.1/rt/caml/pervasives.mli	2012-01-12 01:07:49.000000000 +0100
+@@ -1,6 +1,6 @@
+ (***********************************************************************)
+ (*                                                                     *)
+-(*                           Objective Caml                            *)
++(*                                OCaml                                *)
+ (*                                                                     *)
+ (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+ (*                                                                     *)
+@@ -52,24 +52,24 @@
+    Equality between cyclic data structures may not terminate. *)
+ 
+ external ( <> ) : 'a -> 'a -> bool = "%notequal"
+-(** Negation of {!Pervasives.(=)}. *)
++(** Negation of {!Pervasives.( = )}. *)
+ 
+ external ( < ) : 'a -> 'a -> bool = "%lessthan"
+-(** See {!Pervasives.(>=)}. *)
++(** See {!Pervasives.( >= )}. *)
+ 
+ external ( > ) : 'a -> 'a -> bool = "%greaterthan"
+-(** See {!Pervasives.(>=)}. *)
++(** See {!Pervasives.( >= )}. *)
+ 
+ external ( <= ) : 'a -> 'a -> bool = "%lessequal"
+-(** See {!Pervasives.(>=)}. *)
++(** See {!Pervasives.( >= )}. *)
+ 
+ external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
+ (** Structural ordering functions. These functions coincide with
+    the usual orderings over integers, characters, strings
+    and floating-point numbers, and extend them to a
+    total ordering over all types.
+-   The ordering is compatible with [(=)]. As in the case
+-   of [(=)], mutable structures are compared by contents.
++   The ordering is compatible with [( = )]. As in the case
++   of [( = )], mutable structures are compared by contents.
+    Comparison between functional values raises [Invalid_argument].
+    Comparison between cyclic structures may not terminate. *)
+ 
+@@ -108,12 +108,12 @@
+    mutable fields and objects with mutable instance variables,
+    [e1 == e2] is true if and only if physical modification of [e1]
+    also affects [e2].
+-   On non-mutable types, the behavior of [(==)] is
++   On non-mutable types, the behavior of [( == )] is
+    implementation-dependent; however, it is guaranteed that
+    [e1 == e2] implies [compare e1 e2 = 0]. *)
+ 
+ external ( != ) : 'a -> 'a -> bool = "%noteq"
+-(** Negation of {!Pervasives.(==)}. *)
++(** Negation of {!Pervasives.( == )}. *)
+ 
+ 
+ (** {6 Boolean operations} *)
+@@ -229,7 +229,7 @@
+ 
+ (** {6 Floating-point arithmetic}
+ 
+-   Caml's floating-point numbers follow the
++   OCaml's floating-point numbers follow the
+    IEEE 754 standard, using double precision (64 bits) numbers.
+    Floating-point operations never raise an exception on overflow,
+    underflow, division by zero, etc.  Instead, special IEEE numbers
+@@ -310,10 +310,18 @@
+     Result is in radians and is between [-pi/2] and [pi/2]. *)
+ 
+ external atan2 : float -> float -> float = "caml_atan2_float" "atan2" "float"
+-(** [atan x y] returns the arc tangent of [y /. x].  The signs of [x]
++(** [atan2 y x] returns the arc tangent of [y /. x].  The signs of [x]
+     and [y] are used to determine the quadrant of the result.
+     Result is in radians and is between [-pi] and [pi]. *)
+ 
++external hypot : float -> float -> float
++               = "caml_hypot_float" "caml_hypot" "float"
++(** [hypot x y] returns [sqrt(x *. x + y *. y)], that is, the length
++  of the hypotenuse of a right-angled triangle with sides of length
++  [x] and [y], or, equivalently, the distance of the point [(x,y)]
++  to origin.
++  @since 3.13.0  *)
++
+ external cosh : float -> float = "caml_cosh_float" "cosh" "float"
+ (** Hyperbolic cosine.  Argument is in radians. *)
+ 
+@@ -337,6 +345,14 @@
+ external abs_float : float -> float = "%absfloat"
+ (** [abs_float f] returns the absolute value of [f]. *)
+ 
++external copysign : float -> float -> float
++                  = "caml_copysign_float" "caml_copysign" "float"
++(** [copysign x y] returns a float whose absolute value is that of [x]
++  and whose sign is that of [y].  If [x] is [nan], returns [nan].
++  If [y] is [nan], returns either [x] or [-. x], but it is not
++  specified which.
++  @since 3.13.0  *)
++
+ external mod_float : float -> float -> float = "caml_fmod_float" "fmod" "float"
+ (** [mod_float a b] returns the remainder of [a] with respect to
+    [b].  The returned value is [a -. n *. b], where [n]
+@@ -505,7 +521,7 @@
+ (** The standard output for the process. *)
+ 
+ val stderr : out_channel
+-(** The standard error ouput for the process. *)
++(** The standard error output for the process. *)
+ 
+ 
+ (** {7 Output functions on standard output} *)
+@@ -642,7 +658,7 @@
+    The given integer is taken modulo 2{^32}.
+    The only reliable way to read it back is through the
+    {!Pervasives.input_binary_int} function. The format is compatible across
+-   all machines for a given version of Objective Caml. *)
++   all machines for a given version of OCaml. *)
+ 
+ val output_value : out_channel -> 'a -> unit
+ (** Write the representation of a structured value of any type
+@@ -855,12 +871,16 @@
+ (** Format strings have a general and highly polymorphic type
+     [('a, 'b, 'c, 'd, 'e, 'f) format6]. Type [format6] is built in.
+     The two simplified types, [format] and [format4] below are
+-    included for backward compatibility with earlier releases of Objective
+-    Caml.
++    included for backward compatibility with earlier releases of OCaml.
+     ['a] is the type of the parameters of the format,
+-    ['c] is the result type for the "printf"-style function,
+-    and ['b] is the type of the first argument given to
+-    [%a] and [%t] printing functions. *)
++    ['b] is the type of the first argument given to
++         [%a] and [%t] printing functions,
++    ['c] is the type of the argument transmitted to the first argument of
++         "kprintf"-style functions,
++    ['d] is the result type for the "scanf"-style functions,
++    ['e] is the type of the receiver function for the "scanf"-style functions,
++    ['f] is the result type for the "printf"-style function.
++ *)
+ type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
+ 
+ type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
+@@ -888,7 +908,7 @@
+ (** Terminate the process, returning the given status code
+    to the operating system: usually 0 to indicate no errors,
+    and a small positive integer to indicate failure.
+-   All open output channels are flushed with flush_all.
++   All open output channels are flushed with [flush_all].
+    An implicit [exit 0] is performed each time a program
+    terminates normally.  An implicit [exit 2] is performed if the program
+    terminates early because of an uncaught exception. *)
+--- obrowser-1.1.1.orig/rt/caml/pervasives.ml	2011-04-20 18:26:44.000000000 +0200
++++ obrowser-1.1.1/rt/caml/pervasives.ml	2012-01-12 17:04:04.000000000 +0100
+@@ -91,6 +91,8 @@
+ external asin : float -> float = "caml_asin_float" "asin" "float"
+ external atan : float -> float = "caml_atan_float" "atan" "float"
+ external atan2 : float -> float -> float = "caml_atan2_float" "atan2" "float"
++external hypot : float -> float -> float
++               = "caml_hypot_float" "caml_hypot" "float"
+ external cos : float -> float = "caml_cos_float" "cos" "float"
+ external cosh : float -> float = "caml_cosh_float" "cosh" "float"
+ external log : float -> float = "caml_log_float" "log" "float"
+@@ -104,6 +106,8 @@
+ external ceil : float -> float = "caml_ceil_float" "ceil" "float"
+ external floor : float -> float = "caml_floor_float" "floor" "float"
+ external abs_float : float -> float = "%absfloat"
++external copysign : float -> float -> float
++                  = "caml_copysign_float" "caml_copysign" "float"
+ external mod_float : float -> float -> float = "caml_fmod_float" "fmod" "float"
+ external frexp : float -> float * int = "caml_frexp_float"
+ external ldexp : float -> int -> float = "caml_ldexp_float"
+--- obrowser-1.1.1.orig/rt/caml/list.ml	2011-04-20 18:26:44.000000000 +0200
++++ obrowser-1.1.1/rt/caml/list.ml	2012-01-12 17:30:31.000000000 +0100
+@@ -1,6 +1,6 @@
+ (***********************************************************************)
+ (*                                                                     *)
+-(*                           Objective Caml                            *)
++(*                                OCaml                                *)
+ (*                                                                     *)
+ (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+ (*                                                                     *)
+@@ -56,6 +56,12 @@
+     [] -> []
+   | a::l -> let r = f a in r :: map f l
+ 
++let rec mapi i f = function
++    [] -> []
++  | a::l -> let r = f i a in r :: mapi (i + 1) f l
++
++let mapi f l = mapi 0 f l
++
+ let rev_map f l =
+   let rec rmap_f accu = function
+     | [] -> accu
+@@ -68,6 +74,12 @@
+     [] -> ()
+   | a::l -> f a; iter f l
+ 
++let rec iteri i f = function
++    [] -> ()
++  | a::l -> f i a; iteri (i + 1) f l
++
++let iteri f l = iteri 0 f l
++
+ let rec fold_left f accu l =
+   match l with
+     [] -> accu
+--- obrowser-1.1.1.orig/rt/caml/list.mli	2011-04-20 18:26:44.000000000 +0200
++++ obrowser-1.1.1/rt/caml/list.mli	2012-01-12 17:30:31.000000000 +0100
+@@ -1,6 +1,6 @@
+ (***********************************************************************)
+ (*                                                                     *)
+-(*                           Objective Caml                            *)
++(*                                OCaml                                *)
+ (*                                                                     *)
+ (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+ (*                                                                     *)
+@@ -75,11 +75,25 @@
+    [a1; ...; an]. It is equivalent to
+    [begin f a1; f a2; ...; f an; () end]. *)
+ 
++val iteri : (int -> 'a -> unit) -> 'a list -> unit
++(** Same as {!List.iter}, but the function is applied to the index of
++   the element as first argument (counting from 0), and the element
++   itself as second argument.
++   @since 3.13.0
++*)
++
+ val map : ('a -> 'b) -> 'a list -> 'b list
+ (** [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an],
+    and builds the list [[f a1; ...; f an]]
+    with the results returned by [f].  Not tail-recursive. *)
+ 
++val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
++(** Same as {!List.map}, but the function is applied to the index of
++   the element as first argument (counting from 0), and the element
++   itself as second argument.  Not tail-recursive.
++   @since 3.13.0
++*)
++
+ val rev_map : ('a -> 'b) -> 'a list -> 'b list
+ (** [List.rev_map f l] gives the same result as
+    {!List.rev}[ (]{!List.map}[ f l)], but is tail-recursive and
+--- obrowser-1.1.1-old/rt/caml/pervasives.mli	2013-06-20 13:50:19.000000000 +0200
++++ obrowser-1.1.1/rt/caml/pervasives.mli	2013-06-20 13:50:59.000000000 +0200
+@@ -11,8 +11,6 @@
+ (*                                                                     *)
+ (***********************************************************************)
+ 
+-(* $Id: pervasives.mli 10548 2010-06-09 10:26:19Z weis $ *)
+-
+ (** The initially opened module.
+ 
+    This module provides the basic operations over the built-in types
+@@ -122,7 +120,7 @@
+ (** The boolean negation. *)
+ 
+ external ( && ) : bool -> bool -> bool = "%sequand"
+-(** The boolean ``and''. Evaluation is sequential, left-to-right:
++(** The boolean 'and'. Evaluation is sequential, left-to-right:
+    in [e1 && e2], [e1] is evaluated first, and if it returns [false],
+    [e2] is not evaluated at all. *)
+ 
+@@ -130,7 +128,7 @@
+ (** @deprecated {!Pervasives.( && )} should be used instead. *)
+ 
+ external ( || ) : bool -> bool -> bool = "%sequor"
+-(** The boolean ``or''. Evaluation is sequential, left-to-right:
++(** The boolean 'or'. Evaluation is sequential, left-to-right:
+    in [e1 || e2], [e1] is evaluated first, and if it returns [true],
+    [e2] is not evaluated at all. *)
+ 
+@@ -138,6 +136,20 @@
+ (** @deprecated {!Pervasives.( || )} should be used instead.*)
+ 
+ 
++(** {6 Composition operators} *)
++
++external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
++(** Reverse-application operator: [x |> f |> g] is exactly equivalent
++ to [g (f (x))].
++   @since 4.01
++*)
++
++external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
++(** Application operator: [g @@ f @@ x] is exactly equivalent to
++ [g (f (x))].
++   @since 4.01
++*)
++
+ (** {6 Integer arithmetic} *)
+ 
+ (** Integers are 31 bits wide (or 63 bits on 64-bit processors).
+@@ -234,7 +246,7 @@
+    Floating-point operations never raise an exception on overflow,
+    underflow, division by zero, etc.  Instead, special IEEE numbers
+    are returned as appropriate, such as [infinity] for [1.0 /. 0.0],
+-   [neg_infinity] for [-1.0 /. 0.0], and [nan] (``not a number'')
++   [neg_infinity] for [-1.0 /. 0.0], and [nan] ('not a number')
+    for [0.0 /. 0.0].  These special numbers then propagate through
+    floating-point computations as expected: for instance,
+    [1.0 /. infinity] is [0.0], and any arithmetic operation with [nan]
+@@ -320,7 +332,7 @@
+   of the hypotenuse of a right-angled triangle with sides of length
+   [x] and [y], or, equivalently, the distance of the point [(x,y)]
+   to origin.
+-  @since 3.13.0  *)
++  @since 4.00.0  *)
+ 
+ external cosh : float -> float = "caml_cosh_float" "cosh" "float"
+ (** Hyperbolic cosine.  Argument is in radians. *)
+@@ -351,7 +363,7 @@
+   and whose sign is that of [y].  If [x] is [nan], returns [nan].
+   If [y] is [nan], returns either [x] or [-. x], but it is not
+   specified which.
+-  @since 3.13.0  *)
++  @since 4.00.0  *)
+ 
+ external mod_float : float -> float -> float = "caml_fmod_float" "fmod" "float"
+ (** [mod_float a b] returns the remainder of [a] with respect to
+@@ -395,7 +407,7 @@
+ val nan : float
+ (** A special floating-point value denoting the result of an
+    undefined operation such as [0.0 /. 0.0].  Stands for
+-   ``not a number''.  Any floating-point operation with [nan] as
++   'not a number'.  Any floating-point operation with [nan] as
+    argument returns [nan] as result.  As for floating-point comparisons,
+    [=], [<], [<=], [>] and [>=] return [false] and [<>] returns [true]
+    if one or both of their arguments is [nan]. *)
+@@ -461,7 +473,9 @@
+ (** {6 String conversion functions} *)
+ 
+ val string_of_bool : bool -> string
+-(** Return the string representation of a boolean. *)
++(** Return the string representation of a boolean. As the returned values
++   may be shared, the user should not modify them directly.
++*)
+ 
+ val bool_of_string : string -> bool
+ (** Convert the given string to a boolean.
+@@ -506,7 +520,9 @@
+ (** List concatenation. *)
+ 
+ 
+-(** {6 Input/output} *)
++(** {6 Input/output}
++    Note: all input/output functions can raise [Sys_error] when the system
++    calls they invoke fail. *)
+ 
+ type in_channel
+ (** The type of input channel. *)
+@@ -864,23 +880,73 @@
+ 
+ (** {6 Operations on format strings} *)
+ 
+-(** Format strings are used to read and print data using formatted input
+-    functions in module {!Scanf} and formatted output in modules {!Printf} and
+-    {!Format}. *)
++(** Format strings are character strings with special lexical conventions
++  that defines the functionality of formatted input/output functions. Format
++  strings are used to read data with formatted input functions from module
++  {!Scanf} and to print data with formatted output functions from modules
++  {!Printf} and {!Format}.
++
++  Format strings are made of three kinds of entities:
++  - {e conversions specifications}, introduced by the special character ['%']
++    followed by one or more characters specifying what kind of argument to
++    read or print,
++  - {e formatting indications}, introduced by the special character ['@']
++    followed by one or more characters specifying how to read or print the
++    argument,
++  - {e plain characters} that are regular characters with usual lexical
++    conventions. Plain characters specify string literals to be read in the
++    input or printed in the output.
++
++  There is an additional lexical rule to escape the special characters ['%']
++  and ['@'] in format strings: if a special character follows a ['%']
++  character, it is treated as a plain character. In other words, ["%%"] is
++  considered as a plain ['%'] and ["%@"] as a plain ['@'].
++
++  For more information about conversion specifications and formatting
++  indications available, read the documentation of modules {!Scanf},
++  {!Printf} and {!Format}.
++*)
+ 
+ (** Format strings have a general and highly polymorphic type
+     [('a, 'b, 'c, 'd, 'e, 'f) format6]. Type [format6] is built in.
+     The two simplified types, [format] and [format4] below are
+-    included for backward compatibility with earlier releases of OCaml.
+-    ['a] is the type of the parameters of the format,
+-    ['b] is the type of the first argument given to
+-         [%a] and [%t] printing functions,
+-    ['c] is the type of the argument transmitted to the first argument of
+-         "kprintf"-style functions,
+-    ['d] is the result type for the "scanf"-style functions,
+-    ['e] is the type of the receiver function for the "scanf"-style functions,
+-    ['f] is the result type for the "printf"-style function.
+- *)
++    included for backward compatibility with earlier releases of
++    OCaml.
++
++    The meaning of format string type parameters is as follows:
++
++    - ['a] is the type of the parameters of the format for formatted output
++      functions ([printf]-style functions);
++      ['a] is the type of the values read by the format for formatted input
++      functions ([scanf]-style functions).
++
++    - ['b] is the type of input source for formatted input functions and the
++      type of output target for formatted output functions.
++      For [printf]-style functions from module [Printf], ['b] is typically
++      [out_channel];
++      for [printf]-style functions from module [Format], ['b] is typically
++      [Format.formatter];
++      for [scanf]-style functions from module [Scanf], ['b] is typically
++      [Scanf.Scanning.in_channel].
++
++      Type argument ['b] is also the type of the first argument given to
++      user's defined printing functions for [%a] and [%t] conversions,
++      and user's defined reading functions for [%r] conversion.
++
++    - ['c] is the type of the result of the [%a] and [%t] printing
++      functions, and also the type of the argument transmitted to the
++      first argument of [kprintf]-style functions or to the
++      [kscanf]-style functions.
++
++    - ['d] is the type of parameters for the [scanf]-style functions.
++
++    - ['e] is the type of the receiver function for the [scanf]-style functions.
++
++    - ['f] is the final result type of a formatted input/output function
++      invocation: for the [printf]-style functions, it is typically [unit];
++      for the [scanf]-style functions, it is typically the result type of the
++      receiver function.
++*)
+ type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
+ 
+ type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
+@@ -892,14 +958,22 @@
+   ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+   ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity"
+ (** [format_of_string s] returns a format string read from the string
+-    literal [s]. *)
++    literal [s].
++    Note: [format_of_string] can not convert a string argument that is not a
++    literal. If you need this functionality, use the more general
++    {!Scanf.format_from_string} function.
++*)
+ 
+ val ( ^^ ) :
+       ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+       ('f, 'b, 'c, 'e, 'g, 'h) format6 ->
+       ('a, 'b, 'c, 'd, 'g, 'h) format6
+-(** [f1 ^^ f2] catenates formats [f1] and [f2].  The result is a format
+-  that accepts arguments from [f1], then arguments from [f2]. *)
++(** [f1 ^^ f2] catenates format strings [f1] and [f2]. The result is a
++  format string that behaves as the concatenation of format strings [f1] and
++  [f2]: in case of formatted output, it accepts arguments from [f1], then
++  arguments from [f2]; in case of formatted input, it returns results from
++  [f1], then results from [f2].
++*)
+ 
+ 
+ (** {6 Program termination} *)
+@@ -918,13 +992,12 @@
+    termination time. The functions registered with [at_exit]
+    will be called when the program executes {!Pervasives.exit},
+    or terminates, either normally or because of an uncaught exception.
+-   The functions are called in ``last in, first out'' order:
++   The functions are called in 'last in, first out' order:
+    the function most recently added with [at_exit] is called first. *)
+ 
+ (**/**)
+ 
+-
+-(** {6 For system use only, not for the casual user} *)
++(* The following is for system use only. Do not call directly. *)
+ 
+ val valid_float_lexem : string -> string
+ 
+--- obrowser-1.1.1-old/rt/caml/pervasives.ml	2013-06-20 13:50:19.000000000 +0200
++++ obrowser-1.1.1/rt/caml/pervasives.ml	2013-06-20 13:51:53.000000000 +0200
+@@ -1,6 +1,6 @@
+ (***********************************************************************)
+ (*                                                                     *)
+-(*                           Objective Caml                            *)
++(*                                OCaml                                *)
+ (*                                                                     *)
+ (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+ (*                                                                     *)
+@@ -11,8 +11,6 @@
+ (*                                                                     *)
+ (***********************************************************************)
+ 
+-(* $Id: pervasives.ml 9412 2009-11-09 11:42:39Z weis $ *)
+-
+ (* type 'a option = None | Some of 'a *)
+ 
+ (* Exceptions *)
+@@ -24,66 +22,70 @@
+ 
+ exception Exit
+ 
++(* Composition operators *)
++
++external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
++external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
++
+ (* Comparisons *)
+ 
+-external (=) : 'a -> 'a -> bool = "%equal"
+-external (<>) : 'a -> 'a -> bool = "%notequal"
+-external (<) : 'a -> 'a -> bool = "%lessthan"
+-external (>) : 'a -> 'a -> bool = "%greaterthan"
+-external (<=) : 'a -> 'a -> bool = "%lessequal"
+-external (>=) : 'a -> 'a -> bool = "%greaterequal"
+-external compare: 'a -> 'a -> int = "%compare"
++external ( = ) : 'a -> 'a -> bool = "%equal"
++external ( <> ) : 'a -> 'a -> bool = "%notequal"
++external ( < ) : 'a -> 'a -> bool = "%lessthan"
++external ( > ) : 'a -> 'a -> bool = "%greaterthan"
++external ( <= ) : 'a -> 'a -> bool = "%lessequal"
++external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
++external compare : 'a -> 'a -> int = "%compare"
+ 
+ let min x y = if x <= y then x else y
+ let max x y = if x >= y then x else y
+ 
+-external (==) : 'a -> 'a -> bool = "%eq"
+-external (!=) : 'a -> 'a -> bool = "%noteq"
++external ( == ) : 'a -> 'a -> bool = "%eq"
++external ( != ) : 'a -> 'a -> bool = "%noteq"
+ 
+ (* Boolean operations *)
+ 
+ external not : bool -> bool = "%boolnot"
+-external (&) : bool -> bool -> bool = "%sequand"
+-external (&&) : bool -> bool -> bool = "%sequand"
+-external (or) : bool -> bool -> bool = "%sequor"
+-external (||) : bool -> bool -> bool = "%sequor"
++external ( & ) : bool -> bool -> bool = "%sequand"
++external ( && ) : bool -> bool -> bool = "%sequand"
++external ( or ) : bool -> bool -> bool = "%sequor"
++external ( || ) : bool -> bool -> bool = "%sequor"
+ 
+ (* Integer operations *)
+ 
+-external (~-) : int -> int = "%negint"
+-external (~+) : int -> int = "%identity"
++external ( ~- ) : int -> int = "%negint"
++external ( ~+ ) : int -> int = "%identity"
+ external succ : int -> int = "%succint"
+ external pred : int -> int = "%predint"
+-external (+) : int -> int -> int = "%addint"
+-external (-) : int -> int -> int = "%subint"
+-external ( * ) : int -> int -> int = "%mulint"
+-external (/) : int -> int -> int = "%divint"
+-external (mod) : int -> int -> int = "%modint"
++external ( + ) : int -> int -> int = "%addint"
++external ( - ) : int -> int -> int = "%subint"
++external ( *  ) : int -> int -> int = "%mulint"
++external ( / ) : int -> int -> int = "%divint"
++external ( mod ) : int -> int -> int = "%modint"
+ 
+ let abs x = if x >= 0 then x else -x
+ 
+-external (land) : int -> int -> int = "%andint"
+-external (lor) : int -> int -> int = "%orint"
+-external (lxor) : int -> int -> int = "%xorint"
++external ( land ) : int -> int -> int = "%andint"
++external ( lor ) : int -> int -> int = "%orint"
++external ( lxor ) : int -> int -> int = "%xorint"
+ 
+ let lnot x = x lxor (-1)
+ 
+-external (lsl) : int -> int -> int = "%lslint"
+-external (lsr) : int -> int -> int = "%lsrint"
+-external (asr) : int -> int -> int = "%asrint"
++external ( lsl ) : int -> int -> int = "%lslint"
++external ( lsr ) : int -> int -> int = "%lsrint"
++external ( asr ) : int -> int -> int = "%asrint"
+ 
+-let min_int = 1 lsl (if 1 lsl 32 = 1 then 31 else 63) (* obrowser mod: no tag bit*)
++let min_int = 1 lsl (if 1 lsl 31 = 0 then 30 else 62)
+ let max_int = min_int - 1
+ 
+-
+ (* Floating-point operations *)
+ 
+-external (~-.) : float -> float = "%negfloat"
+-external (~+.) : float -> float = "%identity"
+-external (+.) : float -> float -> float = "%addfloat"
+-external (-.) : float -> float -> float = "%subfloat"
++external ( ~-. ) : float -> float = "%negfloat"
++external ( ~+. ) : float -> float = "%identity"
++external ( +. ) : float -> float -> float = "%addfloat"
++external ( -. ) : float -> float -> float = "%subfloat"
+ external ( *. ) : float -> float -> float = "%mulfloat"
+-external (/.) : float -> float -> float = "%divfloat"
++external ( /. ) : float -> float -> float = "%divfloat"
+ external ( ** ) : float -> float -> float = "caml_power_float" "pow" "float"
+ external exp : float -> float = "caml_exp_float" "exp" "float"
+ external expm1 : float -> float = "caml_expm1_float" "caml_expm1" "float"
+@@ -136,16 +138,16 @@
+   | FP_zero
+   | FP_infinite
+   | FP_nan
+-external classify_float: float -> fpclass = "caml_classify_float"
++external classify_float : float -> fpclass = "caml_classify_float"
+ 
+ (* String operations -- more in module String *)
+ 
+ external string_length : string -> int = "%string_length"
+-external string_create: int -> string = "caml_create_string"
++external string_create : int -> string = "caml_create_string"
+ external string_blit : string -> int -> string -> int -> int -> unit
+                      = "caml_blit_string" "noalloc"
+ 
+-let (^) s1 s2 =
++let ( ^ ) s1 s2 =
+   let l1 = string_length s1 and l2 = string_length s2 in
+   let s = string_create (l1 + l2) in
+   string_blit s1 0 s 0 l1;
+@@ -170,8 +172,8 @@
+ 
+ (* String conversion functions *)
+ 
+-external format_int: string -> int -> string = "caml_format_int"
+-external format_float: string -> float -> string = "caml_format_float"
++external format_int : string -> int -> string = "caml_format_int"
++external format_float : string -> float -> string = "caml_format_float"
+ 
+ let string_of_bool b =
+   if b then "true" else "false"
+@@ -187,7 +189,6 @@
+ 
+ module String = struct
+   external get : string -> int -> char = "%string_safe_get"
+-  external set : string -> int -> char -> unit = "%string_safe_set"
+ end
+ 
+ let valid_float_lexem s =
+@@ -195,7 +196,7 @@
+   let rec loop i =
+     if i >= l then s ^ "." else
+     match s.[i] with
+-    | '0' .. '9' | '-' -> loop (i+1)
++    | '0' .. '9' | '-' -> loop (i + 1)
+     | _ -> s
+   in
+   loop 0
+@@ -207,7 +208,7 @@
+ 
+ (* List operations -- more in module List *)
+ 
+-let rec (@) l1 l2 =
++let rec ( @ ) l1 l2 =
+   match l1 with
+     [] -> l2
+   | hd :: tl -> hd :: (tl @ l2)
+@@ -217,12 +218,13 @@
+ type in_channel
+ type out_channel
+ 
+-let open_descriptor_out _ = failwith "not implemented in obrowser"
+-let open_descriptor_in _ = failwith "not implemented in obrowser"
+-
+-let stdin = Obj.magic 0
+-let stdout = Obj.magic 0
+-let stderr = Obj.magic 0
++external open_descriptor_out : int -> out_channel
++                             = "caml_ml_open_descriptor_out"
++external open_descriptor_in : int -> in_channel = "caml_ml_open_descriptor_in"
++
++let stdin = open_descriptor_in 0
++let stdout = open_descriptor_out 1
++let stderr = open_descriptor_out 2
+ 
+ (* General output functions *)
+ 
+@@ -231,103 +233,184 @@
+   | Open_creat | Open_trunc | Open_excl
+   | Open_binary | Open_text | Open_nonblock
+ 
+-let open_desc _ _ _ = failwith "not implemented in obrowser"
+-let open_out_gen mode perm name = failwith "not implemented in obrowser"
+-let open_out name = failwith "not implemented in obrowser"
+-let open_out_bin name = failwith "not implemented in obrowser"
+-let flush _ =  failwith "not implemented in obrowser"
+-let out_channels_list _ = failwith "not implemented in obrowser"
+-let flush_all () = failwith "not implemented in obrowser"
+-let unsafe_output _ _ _ _ = failwith "not implemented in obrowser"
+-let output_char _ _ = failwith "not implemented in obrowser"
+-let output_string oc s = failwith "not implemented in obrowser"
+-let output oc s ofs len = failwith "not implemented in obrowser"
+-let output_byte _ _ = failwith "not implemented in obrowser"
+-let  output_binary_int _ _ = failwith "not implemented in obrowser"
+-let marshal_to_channel _ _ _ = failwith "not implemented in obrowser"
+-let output_value _ _ = failwith "not implemented in obrowser"
+-let seek_out _ _ = failwith "not implemented in obrowser"
+-let pos_out _ = failwith "not implemented in obrowser"
+-let out_channel_length _ = failwith "not implemented in obrowser"
+-let close_out_channel _ = failwith "not implemented in obrowser"
+-let close_out _ = failwith "not implemented in obrowser"
+-let close_out_noerr _ = failwith "not implemented in obrowser"
+-let set_binary_mode_out _ _  = failwith "not implemented in obrowser"
++external open_desc : string -> open_flag list -> int -> int = "caml_sys_open"
++
++let open_out_gen mode perm name =
++  open_descriptor_out(open_desc name mode perm)
++
++let open_out name =
++  open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_text] 0o666 name
++
++let open_out_bin name =
++  open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o666 name
++
++external flush : out_channel -> unit = "caml_ml_flush"
++
++external out_channels_list : unit -> out_channel list
++                           = "caml_ml_out_channels_list"
++
++let flush_all () =
++  let rec iter = function
++      [] -> ()
++    | a :: l -> (try flush a with _ -> ()); iter l
++  in iter (out_channels_list ())
++
++external unsafe_output : out_channel -> string -> int -> int -> unit
++                       = "caml_ml_output"
++
++external output_char : out_channel -> char -> unit = "caml_ml_output_char"
++
++let output_string oc s =
++  unsafe_output oc s 0 (string_length s)
++
++let output oc s ofs len =
++  if ofs < 0 || len < 0 || ofs > string_length s - len
++  then invalid_arg "output"
++  else unsafe_output oc s ofs len
++
++external output_byte : out_channel -> int -> unit = "caml_ml_output_char"
++external output_binary_int : out_channel -> int -> unit = "caml_ml_output_int"
++
++external marshal_to_channel : out_channel -> 'a -> unit list -> unit
++     = "caml_output_value"
++let output_value chan v = marshal_to_channel chan v []
++
++external seek_out : out_channel -> int -> unit = "caml_ml_seek_out"
++external pos_out : out_channel -> int = "caml_ml_pos_out"
++external out_channel_length : out_channel -> int = "caml_ml_channel_size"
++external close_out_channel : out_channel -> unit = "caml_ml_close_channel"
++let close_out oc = flush oc; close_out_channel oc
++let close_out_noerr oc =
++  (try flush oc with _ -> ());
++  (try close_out_channel oc with _ -> ())
++external set_binary_mode_out : out_channel -> bool -> unit
++                             = "caml_ml_set_binary_mode"
+ 
+ (* General input functions *)
+ 
+-let open_in_gen _ _ _ =  failwith "not implemented in obrowser"
+-let open_in _ =  failwith "not implemented in obrowser"
+-let open_in_bin _ =  failwith "not implemented in obrowser"
+-let input_char _ =  failwith "not implemented in obrowser"
+-let unsafe_input _ _ _ _ = failwith "not implemented in obrowser"
+-let input _ _ _ _ = failwith "not implemented in obrowser"
+-let rec unsafe_really_input _ _ _ _ = failwith "not implemented in obrowser"
+-let really_input _ _ _ _ = failwith "not implemented in obrowser"
+-let input_scan_line _ = failwith "not implemented in obrowser"
+-let input_line _ = failwith "not implemented in obrowser"
+-
+-let input_byte _ = failwith "not implemented in obrowser"
+-let input_binary_int _ = failwith "not implemented in obrowser"
+-let input_value _ = failwith "not implemented in obrowser"
+-let seek_in _ _ = failwith "not implemented in obrowser"
+-let pos_in _ = failwith "not implemented in obrowser"
+-let in_channel_length _ = failwith "not implemented in obrowser"
+-let close_in _ = failwith "not implemented in obrowser"
+-let close_in_noerr _ = failwith "not implemented in obrowser"
+-let set_binary_mode_in _ _ = failwith "not implemented in obrowser"
++let open_in_gen mode perm name =
++  open_descriptor_in(open_desc name mode perm)
+ 
+-(* Output functions on standard output *)
++let open_in name =
++  open_in_gen [Open_rdonly; Open_text] 0 name
++
++let open_in_bin name =
++  open_in_gen [Open_rdonly; Open_binary] 0 name
++
++external input_char : in_channel -> char = "caml_ml_input_char"
++
++external unsafe_input : in_channel -> string -> int -> int -> int
++                      = "caml_ml_input"
++
++let input ic s ofs len =
++  if ofs < 0 || len < 0 || ofs > string_length s - len
++  then invalid_arg "input"
++  else unsafe_input ic s ofs len
++
++let rec unsafe_really_input ic s ofs len =
++  if len <= 0 then () else begin
++    let r = unsafe_input ic s ofs len in
++    if r = 0
++    then raise End_of_file
++    else unsafe_really_input ic s (ofs + r) (len - r)
++  end
+ 
+-external basic_io_write : string -> unit = "caml_basic_io_write"
++let really_input ic s ofs len =
++  if ofs < 0 || len < 0 || ofs > string_length s - len
++  then invalid_arg "really_input"
++  else unsafe_really_input ic s ofs len
++
++external input_scan_line : in_channel -> int = "caml_ml_input_scan_line"
++
++let input_line chan =
++  let rec build_result buf pos = function
++    [] -> buf
++  | hd :: tl ->
++      let len = string_length hd in
++      string_blit hd 0 buf (pos - len) len;
++      build_result buf (pos - len) tl in
++  let rec scan accu len =
++    let n = input_scan_line chan in
++    if n = 0 then begin                   (* n = 0: we are at EOF *)
++      match accu with
++        [] -> raise End_of_file
++      | _  -> build_result (string_create len) len accu
++    end else if n > 0 then begin          (* n > 0: newline found in buffer *)
++      let res = string_create (n - 1) in
++      ignore (unsafe_input chan res 0 (n - 1));
++      ignore (input_char chan);           (* skip the newline *)
++      match accu with
++        [] -> res
++      |  _ -> let len = len + n - 1 in
++              build_result (string_create len) len (res :: accu)
++    end else begin                        (* n < 0: newline not found *)
++      let beg = string_create (-n) in
++      ignore(unsafe_input chan beg 0 (-n));
++      scan (beg :: accu) (len - n)
++    end
++  in scan [] 0
++
++external input_byte : in_channel -> int = "caml_ml_input_char"
++external input_binary_int : in_channel -> int = "caml_ml_input_int"
++external input_value : in_channel -> 'a = "caml_input_value"
++external seek_in : in_channel -> int -> unit = "caml_ml_seek_in"
++external pos_in : in_channel -> int = "caml_ml_pos_in"
++external in_channel_length : in_channel -> int = "caml_ml_channel_size"
++external close_in : in_channel -> unit = "caml_ml_close_channel"
++let close_in_noerr ic = (try close_in ic with _ -> ());;
++external set_binary_mode_in : in_channel -> bool -> unit
++                            = "caml_ml_set_binary_mode"
+ 
+-let print_char c = basic_io_write (let s = string_create 1 in s.[0] <- c ; s)
+-let print_string s = basic_io_write s
+-let print_int i = basic_io_write (string_of_int i)
+-let print_float f = basic_io_write (string_of_float f)
++(* Output functions on standard output *)
++
++let print_char c = output_char stdout c
++let print_string s = output_string stdout s
++let print_int i = output_string stdout (string_of_int i)
++let print_float f = output_string stdout (string_of_float f)
+ let print_endline s =
+-  print_string s; print_char '\n'
+-let print_newline () = print_char '\n'
++  output_string stdout s; output_char stdout '\n'; flush stdout
++let print_newline () = output_char stdout '\n'; flush stdout
+ 
+ (* Output functions on standard error *)
+ 
+-let prerr_char c = basic_io_write (let s = string_create 1 in s.[0] <- c ; s)
+-let prerr_string s = basic_io_write s
+-let prerr_int i = basic_io_write (string_of_int i)
+-let prerr_float f = basic_io_write (string_of_float f)
++let prerr_char c = output_char stderr c
++let prerr_string s = output_string stderr s
++let prerr_int i = output_string stderr (string_of_int i)
++let prerr_float f = output_string stderr (string_of_float f)
+ let prerr_endline s =
+-  prerr_string s; prerr_char '\n'
+-let prerr_newline () = prerr_char '\n'
++  output_string stderr s; output_char stderr '\n'; flush stderr
++let prerr_newline () = output_char stderr '\n'; flush stderr
+ 
+ (* Input functions on standard input *)
+ 
+-let read_line () = failwith "not implemented in obrowser"
+-let read_int () = failwith "not implemented in obrowser"
+-let read_float () = failwith "not implemented in obrowser"
++let read_line () = flush stdout; input_line stdin
++let read_int () = int_of_string(read_line())
++let read_float () = float_of_string(read_line())
+ 
+ (* Operations on large files *)
+ 
+ module LargeFile =
+   struct
+-    let seek_out _ _ = failwith "not implemented in obrowser"
+-    let pos_out _ = failwith "not implemented in obrowser"
+-    let out_channel_length _ = failwith "not implemented in obrowser"
+-    let seek_in _ _ = failwith "not implemented in obrowser"
+-    let pos_in _ = failwith "not implemented in obrowser"
+-    let in_channel_length _ = failwith "not implemented in obrowser"
++    external seek_out : out_channel -> int64 -> unit = "caml_ml_seek_out_64"
++    external pos_out : out_channel -> int64 = "caml_ml_pos_out_64"
++    external out_channel_length : out_channel -> int64
++                                = "caml_ml_channel_size_64"
++    external seek_in : in_channel -> int64 -> unit = "caml_ml_seek_in_64"
++    external pos_in : in_channel -> int64 = "caml_ml_pos_in_64"
++    external in_channel_length : in_channel -> int64 = "caml_ml_channel_size_64"
+   end
+ 
+ (* References *)
+ 
+-type 'a ref = { mutable contents: 'a }
+-external ref: 'a -> 'a ref = "%makemutable"
+-external (!): 'a ref -> 'a = "%field0"
+-external (:=): 'a ref -> 'a -> unit = "%setfield0"
+-external incr: int ref -> unit = "%incr"
+-external decr: int ref -> unit = "%decr"
++type 'a ref = { mutable contents : 'a }
++external ref : 'a -> 'a ref = "%makemutable"
++external ( ! ) : 'a ref -> 'a = "%field0"
++external ( := ) : 'a ref -> 'a -> unit = "%setfield0"
++external incr : int ref -> unit = "%incr"
++external decr : int ref -> unit = "%decr"
+ 
+ (* Formats *)
+-type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6 
++type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
+ 
+ type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
+ 
+@@ -345,7 +428,8 @@
+       ('f, 'b, 'c, 'e, 'g, 'h) format6 ->
+       ('a, 'b, 'c, 'd, 'g, 'h) format6) =
+   fun fmt1 fmt2 ->
+-    string_to_format (format_to_string fmt1 ^ format_to_string fmt2);;
++    string_to_format (format_to_string fmt1 ^ "%," ^ format_to_string fmt2)
++;;
+ 
+ let string_of_format fmt =
+   let s = format_to_string fmt in
+@@ -358,7 +442,7 @@
+ 
+ external sys_exit : int -> 'a = "caml_sys_exit"
+ 
+-let exit_function = ref (fun () -> ())
++let exit_function = ref flush_all
+ 
+ let at_exit f =
+   let g = !exit_function in
+--- obrowser-1.1.1.orig/rt/caml/printexc.ml	2011-04-20 18:26:44.000000000 +0200
++++ obrowser-1.1.1/rt/caml/printexc.ml	2013-08-13 15:54:35.000000000 +0200
+@@ -1,6 +1,6 @@
+ (***********************************************************************)
+ (*                                                                     *)
+-(*                           Objective Caml                            *)
++(*                                OCaml                                *)
+ (*                                                                     *)
+ (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+ (*                                                                     *)
+@@ -11,8 +11,6 @@
+ (*                                                                     *)
+ (***********************************************************************)
+ 
+-(* $Id: printexc.ml 10272 2010-04-19 12:25:46Z frisch $ *)
+-
+ open Printf;;
+ 
+ let printers = ref []
+@@ -56,9 +54,12 @@
+             sprintf locfmt file line char (char+5) "Pattern matching failed"
+         | Assert_failure(file, line, char) ->
+             sprintf locfmt file line char (char+6) "Assertion failed"
++        | Undefined_recursive_module(file, line, char) ->
++            sprintf locfmt file line char (char+6) "Undefined recursive module"
+         | _ ->
+             let x = Obj.repr x in
+-            let constructor = (Obj.magic(Obj.field (Obj.field x 0) 0) : string) in
++            let constructor =
++              (Obj.magic (Obj.field (Obj.field x 0) 0) : string) in
+             constructor ^ (fields x) in
+   conv !printers
+ 
+@@ -78,6 +79,11 @@
+     eprintf "Uncaught exception: %s\n" (to_string x);
+     exit 2
+ 
++type raw_backtrace
++
++external get_raw_backtrace:
++  unit -> raw_backtrace = "caml_get_exception_raw_backtrace"
++
+ type loc_info =
+   | Known_location of bool   (* is_raise *)
+                     * string (* filename *)
+@@ -86,8 +92,13 @@
+                     * int    (* end char *)
+   | Unknown_location of bool (*is_raise*)
+ 
+-external get_exception_backtrace:
+-  unit -> loc_info array option = "caml_get_exception_backtrace"
++(* to avoid warning *)
++let _ = [Known_location (false, "", 0, 0, 0); Unknown_location false]
++
++type backtrace = loc_info array
++
++external convert_raw_backtrace:
++  raw_backtrace -> backtrace option = "caml_convert_raw_backtrace"
+ 
+ let format_loc_info pos li =
+   let is_raise =
+@@ -108,8 +119,8 @@
+       sprintf "%s unknown location"
+               info
+ 
+-let print_backtrace outchan =
+-  match get_exception_backtrace() with
++let print_exception_backtrace outchan backtrace =
++  match backtrace with
+   | None ->
+       fprintf outchan
+         "(Program not linked with -g, cannot print stack backtrace)\n"
+@@ -119,8 +130,15 @@
+           fprintf outchan "%s\n" (format_loc_info i a.(i))
+       done
+ 
+-let get_backtrace () =
+-  match get_exception_backtrace() with
++let print_raw_backtrace outchan raw_backtrace =
++  print_exception_backtrace outchan (convert_raw_backtrace raw_backtrace)
++
++(* confusingly named: prints the global current backtrace *)
++let print_backtrace outchan =
++  print_raw_backtrace outchan (get_raw_backtrace ())
++
++let backtrace_to_string backtrace =
++  match backtrace with
+   | None ->
+      "(Program not linked with -g, cannot print stack backtrace)\n"
+   | Some a ->
+@@ -131,8 +149,22 @@
+       done;
+       Buffer.contents b
+ 
++let raw_backtrace_to_string raw_backtrace =
++  backtrace_to_string (convert_raw_backtrace raw_backtrace)
++
++(* confusingly named:
++   returns the *string* corresponding to the global current backtrace *)
++let get_backtrace () =
++  (* we could use the caml_get_exception_backtrace primitive here, but
++     we hope to deprecate it so it's better to just compose the
++     raw stuff *)
++  backtrace_to_string (convert_raw_backtrace (get_raw_backtrace ()))
++
+ external record_backtrace: bool -> unit = "caml_record_backtrace"
+ external backtrace_status: unit -> bool = "caml_backtrace_status"
+ 
+ let register_printer fn =
+   printers := fn :: !printers
++
++
++external get_callstack: int -> raw_backtrace = "caml_get_current_callstack"
+--- obrowser-1.1.1.orig/rt/caml/printexc.mli	2011-04-20 18:26:44.000000000 +0200
++++ obrowser-1.1.1/rt/caml/printexc.mli	2013-08-13 15:54:40.000000000 +0200
+@@ -1,6 +1,6 @@
+ (***********************************************************************)
+ (*                                                                     *)
+-(*                           Objective Caml                            *)
++(*                                OCaml                                *)
+ (*                                                                     *)
+ (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+ (*                                                                     *)
+@@ -11,9 +11,7 @@
+ (*                                                                     *)
+ (***********************************************************************)
+ 
+-(* $Id: printexc.mli 10457 2010-05-21 18:30:12Z doligez $ *)
+-
+-(** Facilities for printing exceptions. *)
++(** Facilities for printing exceptions and inspecting current call stack. *)
+ 
+ val to_string: exn -> string
+ (** [Printexc.to_string e] returns a string representation of
+@@ -77,5 +75,40 @@
+     in the reverse order of their registrations, until a printer returns
+     a [Some s] value (if no such printer exists, the runtime will use a
+     generic printer).
++
++    When using this mechanism, one should be aware that an exception backtrace
++    is attached to the thread that saw it raised, rather than to the exception
++    itself. Practically, it means that the code related to [fn] should not use
++    the backtrace if it has itself raised an exception before.
+     @since 3.11.2
+ *)
++
++(** {6 Raw backtraces} *)
++
++type raw_backtrace
++
++(** The abstract type [backtrace] stores exception backtraces in
++    a low-level format, instead of directly exposing them as string as
++    the [get_backtrace()] function does.
++
++    This allows to pay the performance overhead of representation
++    conversion and formatting only at printing time, which is useful
++    if you want to record more backtrace than you actually print.
++*)
++
++val get_raw_backtrace: unit -> raw_backtrace
++val print_raw_backtrace: out_channel -> raw_backtrace -> unit
++val raw_backtrace_to_string: raw_backtrace -> string
++
++
++(** {6 Current call stack} *)
++
++val get_callstack: int -> raw_backtrace
++
++(** [Printexc.get_callstack n] returns a description of the top of the
++    call stack on the current program point (for the current thread),
++    with at most [n] entries.  (Note: this function is not related to
++    exceptions at all, despite being part of the [Printexc] module.)
++
++    @since 4.01.0
++*)
diff -Nru ocaml-3.12.1/testsuite/external/ocaml-bitstring-2.0.3.patch ocaml-4.01.0/testsuite/external/ocaml-bitstring-2.0.3.patch
--- ocaml-3.12.1/testsuite/external/ocaml-bitstring-2.0.3.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/ocaml-bitstring-2.0.3.patch	2013-04-13 19:42:20.000000000 +0000
@@ -0,0 +1,11 @@
+--- ocaml-bitstring-2.0.3/Makefile.in.orig	2013-04-04 17:42:45.000000000 +0200
++++ ocaml-bitstring-2.0.3/Makefile.in	2013-04-04 17:43:06.000000000 +0200
+@@ -123,7 +123,7 @@
+ 
+ byteswap.h: byteswap.in.h
+ 	{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+-	  cat $(srcdir)/byteswap.in.h; \
++	  cat byteswap.in.h; \
+ 	} > $@-t
+ 	mv -f $@-t $@
+ 
diff -Nru ocaml-3.12.1/testsuite/external/ocaml-mysql-1.0.4.patch.disabled ocaml-4.01.0/testsuite/external/ocaml-mysql-1.0.4.patch.disabled
--- ocaml-3.12.1/testsuite/external/ocaml-mysql-1.0.4.patch.disabled	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/ocaml-mysql-1.0.4.patch.disabled	2012-10-15 18:01:26.000000000 +0000
@@ -0,0 +1,15 @@
+--- ocaml-mysql-1.0.4.orig/mysql_stubs.c	2006-02-24 00:12:36.000000000 +0100
++++ ocaml-mysql-1.0.4/mysql_stubs.c	2012-08-09 20:51:24.000000000 +0200
+@@ -19,9 +19,9 @@
+ 
+ /* MySQL API */
+ 
+-#include 
+-#include 
+-#include 
++#include 
++#include 
++#include 
+ /* type 'a option = None | Some of 'a */
+ 
+ #define NONE            Val_int(0)     
diff -Nru ocaml-3.12.1/testsuite/external/ocamlnet-3.5.1.patch ocaml-4.01.0/testsuite/external/ocamlnet-3.5.1.patch
--- ocaml-3.12.1/testsuite/external/ocamlnet-3.5.1.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/ocamlnet-3.5.1.patch	2013-06-20 14:20:59.000000000 +0000
@@ -0,0 +1,41 @@
+--- ocamlnet-3.5.1.orig/src/netsys/netsys_posix.ml	2011-10-12 14:09:05.000000000 +0200
++++ ocamlnet-3.5.1/src/netsys/netsys_posix.ml	2012-01-12 19:33:39.000000000 +0100
+@@ -412,9 +412,11 @@
+ type at_flag = AT_EACCESS | AT_SYMLINK_NOFOLLOW | AT_REMOVEDIR
+ 
+ (* The stubs assume these type definitions: *)
++(* In fact, they don't: they assume OCaml's stdlib definition
+ type open_flag1 = Unix.open_flag =
+     O_RDONLY | O_WRONLY | O_RDWR | O_NONBLOCK | O_APPEND | O_CREAT | O_TRUNC
+   | O_EXCL | O_NOCTTY | O_DSYNC | O_SYNC | O_RSYNC
++*)
+ 
+ type access_permission1 = Unix.access_permission =
+     R_OK | W_OK | X_OK | F_OK
+--- ocamlnet-3.5.1.orig/src/netstring/Makefile.def	2012-02-29 19:02:52.000000000 +0100
++++ ocamlnet-3.5.1/src/netstring/Makefile.def	2012-05-25 16:59:56.000000000 +0200
+@@ -13,7 +13,7 @@
+ PKGNAME  = netstring
+ 
+ REQUIRES = $(REGEXP_PROVIDER) bigarray
+-INCLUDES += $(INC_NETSYS)
++INCLUDES += $(INC_NETSYS) -I +compiler-libs
+ 
+ ISO_MAPPINGS   = mappings/iso*.unimap
+ JP_MAPPINGS    = mappings/jis*.*map
+--- ocamlnet-3.5.1.orig/src/pop/netpop.ml	2012-02-29 19:02:53.000000000 +0100
++++ ocamlnet-3.5.1/src/pop/netpop.ml	2013-06-20 14:06:11.000000000 +0200
+@@ -231,6 +231,7 @@
+ 	  status_response ic parse_line (Hashtbl.create 1)
+     with _ -> raise Protocol_error
+ 
++(*
+   method stat () =
+     self#check_state `Transaction;
+     send_command oc "STAT";
+@@ -242,4 +243,5 @@
+ 	(count, size, ext)
+       )
+     with _ -> raise Protocol_error;
++*)
+ end
diff -Nru ocaml-3.12.1/testsuite/external/ocsigen-bundle-2.2.2.patch ocaml-4.01.0/testsuite/external/ocsigen-bundle-2.2.2.patch
--- ocaml-3.12.1/testsuite/external/ocsigen-bundle-2.2.2.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/ocsigen-bundle-2.2.2.patch	2012-08-02 08:17:59.000000000 +0000
@@ -0,0 +1,47 @@
+diff -u -r ocsigen-bundle-2.2.2.orig/pkg/Makefile.lwt ocsigen-bundle-2.2.2/pkg/Makefile.lwt
+--- ocsigen-bundle-2.2.2.orig/pkg/Makefile.lwt	2011-12-20 16:13:24.000000000 +0100
++++ ocsigen-bundle-2.2.2/pkg/Makefile.lwt	2011-12-29 00:34:27.000000000 +0100
+@@ -70,7 +70,7 @@
+ 
+ ${METAS}/META.lwt: ${LWT_DIR}/src/core/META
+ 	echo "directory = \"${srcdir}/${LWT_DIR}/_build/src/core\"" > $@
+-	sed -e 's%^package "\([^\"]*\)" (%package "\1" (\n directory = "../\1"%g' \
++	sed -e 's%^package "\([^\"]*\)" (%package "\1" ( directory = "../\1"%g' \
+ 	    -e 's%../syntax%../../syntax%' \
+ 	  $< >> $@
+ 
+diff -u -r ocsigen-bundle-2.2.2.orig/pkg/Makefile.ocsimore ocsigen-bundle-2.2.2/pkg/Makefile.ocsimore
+--- ocsigen-bundle-2.2.2.orig/pkg/Makefile.ocsimore	2011-12-20 16:13:24.000000000 +0100
++++ ocsigen-bundle-2.2.2/pkg/Makefile.ocsimore	2011-12-29 00:34:51.000000000 +0100
+@@ -37,8 +37,8 @@
+ 
+ ${METAS}/META.ocsimore: ${OCSIMORE_DIR}/src/core/META
+ 	echo "directory = \"${srcdir}/${OCSIMORE_DIR}/_build/src/core\"" > $@
+-	sed -e 's%^package "\([^\"]*\(user\|wiki\|site\|forum\)\)" (%package "\1" (\n directory = "../\2"%g' \
+-	    -e 's%^package "site_client" (%package "site_client" (\n directory = "../site/client"%g' \
++	sed -e 's%^package "\([^\"]*\(user\|wiki\|site\|forum\)\)" (%package "\1" ( directory = "../\2"%g' \
++	    -e 's%^package "site_client" (%package "site_client" ( directory = "../site/client"%g' \
+ 	  $< >> $@
+ 
+ 
+diff -u -r ocsigen-bundle-2.2.2.orig/pkg/Makefile.tyxml ocsigen-bundle-2.2.2/pkg/Makefile.tyxml
+--- ocsigen-bundle-2.2.2.orig/pkg/Makefile.js_of_ocaml	2011-12-20 16:13:24.000000000 +0100
++++ ocsigen-bundle-2.2.2/pkg/Makefile.js_of_ocaml	2011-12-29 01:47:00.000000000 +0100
+@@ -47,5 +47,5 @@
+ 
+ ${METAS}/META.js_of_ocaml: ${JS_OF_OCAML_DIR}/lib/META
+ 	echo "directory = \"${srcdir}/${JS_OF_OCAML_DIR}/lib\"" > $@
+-	sed -e 's%package "syntax" (%package "syntax" (\n directory = "syntax"%g' \
++	sed -e 's%package "syntax" (%package "syntax" ( directory = "syntax"%g' \
+ 	  $< >> $@
+--- ocsigen-bundle-2.2.2/configure.orig	2012-05-25 18:33:10.000000000 +0200
++++ ocsigen-bundle-2.2.2/configure	2012-05-25 18:33:24.000000000 +0200
+@@ -11051,7 +11051,7 @@
+ 
+ 
+ 
+-build_projects="deriving-ocsigen lwt js_of_ocaml tyxml ocsigenserver eliom"
++build_projects="deriving-ocsigen js_of_ocaml tyxml ocsigenserver"
+ if  test $enable_ocsimore = yes ; then :
+    build_projects+=" ocsimore"
+ fi
diff -Nru ocaml-3.12.1/testsuite/external/omake-0.9.8.6.patch ocaml-4.01.0/testsuite/external/omake-0.9.8.6.patch
--- ocaml-3.12.1/testsuite/external/omake-0.9.8.6.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/omake-0.9.8.6.patch	2012-08-02 08:17:59.000000000 +0000
@@ -0,0 +1,11 @@
+--- omake-0.9.8.6.orig/lib/build/OCaml.om	2008-03-05 02:07:25.000000000 +0100
++++ omake-0.9.8.6/lib/build/OCaml.om	2011-05-02 22:53:23.000000000 +0200
+@@ -176,7 +176,7 @@
+ #
+ declare OCAMLDEPFLAGS
+ public.OCAMLPPFLAGS  =
+-public.OCAMLFLAGS    = -warn-error A
++public.OCAMLFLAGS    = -warn-error a
+ public.OCAMLCFLAGS   = -g
+ public.OCAMLOPTFLAGS =
+ public.OCAMLCPPFLAGS =
diff -Nru ocaml-3.12.1/testsuite/external/sks-1.1.3.patch ocaml-4.01.0/testsuite/external/sks-1.1.3.patch
--- ocaml-3.12.1/testsuite/external/sks-1.1.3.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/sks-1.1.3.patch	2013-06-03 14:06:57.000000000 +0000
@@ -0,0 +1,20 @@
+diff -N -r -u sks-1.1.3.orig/Makefile.local sks-1.1.3/Makefile.local
+--- sks-1.1.3.orig/Makefile.local	1970-01-01 01:00:00.000000000 +0100
++++ sks-1.1.3/Makefile.local	2010-05-17 14:49:16.000000000 +0200
+@@ -0,0 +1,5 @@
++LIBDB=-ldb
++MANDIR=${PREFIX}/share/man
++export PREFIX
++export LIBDB
++export MANDIR
+--- sks-1.1.3.orig/Makefile	2012-04-11 04:03:25.000000000 +0200
++++ sks-1.1.3/Makefile	2013-05-30 14:40:03.000000000 +0200
+@@ -47,7 +47,7 @@
+ 
+ CAMLP4=-pp $(CAMLP4O)
+ CAMLINCLUDE= -I lib -I bdb
+-COMMONCAMLFLAGS=$(CAMLINCLUDE) $(OCAMLLIB) -ccopt -Lbdb -dtypes -ccopt -pthread -ccopt -pg -warn-error A
++COMMONCAMLFLAGS=$(CAMLINCLUDE) $(OCAMLLIB) -ccopt -Lbdb -dtypes -ccopt -pthread -ccopt -pg -warn-error a
+ OCAMLDEP=ocamldep $(CAMLP4) 
+ CAMLLIBS=unix.cma str.cma bdb.cma nums.cma bigarray.cma cryptokit.cma
+ OCAMLFLAGS=$(COMMONCAMLFLAGS) -g $(CAMLLIBS)
diff -Nru ocaml-3.12.1/testsuite/external/vsyml-2010-04-06.patch ocaml-4.01.0/testsuite/external/vsyml-2010-04-06.patch
--- ocaml-3.12.1/testsuite/external/vsyml-2010-04-06.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/vsyml-2010-04-06.patch	2012-08-02 08:17:59.000000000 +0000
@@ -0,0 +1,20 @@
+--- vsyml-2010-04-06.orig/makefile	2010-04-06 19:28:25.000000000 +0200
++++ vsyml-2010-04-06/makefile	2010-08-23 15:16:22.000000000 +0200
+@@ -525,13 +525,13 @@
+ 
+ # dependencies for the symbolic simulator main file on cmo cma cmx and cmxa
+ $(VSYML_CMO_LST): $(VSYML_MAIN)
+-	echo -n "VSYML_CMO=" > $@
+-	for i in `grep -o -e '[a-zA-Z0-9_]*\.cmo' $<` ; do echo -n $$i " " >> $@ ; done
++	echo "VSYML_CMO=" | tr -d '\012' > $@
++	for i in `grep -o -e '[a-zA-Z0-9_]*\.cmo' $<` ; do echo $$i " " | tr -d '\012' >> $@ ; done
+ 	echo $(patsubst $(SRC_PATH)$(PATH_SEPARATOR)%.ml,%.cmo,$<) >> $@
+ 
+ $(VSYML_CMA_LST): $(VSYML_MAIN)
+-	echo -n "VSYML_CMA=" > $@
+-	for i in `grep -o -e '[a-zA-Z0-9_]*\.cma' $<` ; do echo -n $$i " " >> $@ ; done
++	echo "VSYML_CMA=" | tr -d '\012' > $@
++	for i in `grep -o -e '[a-zA-Z0-9_]*\.cma' $<` ; do echo $$i " " | tr -d '\012' >> $@ ; done
+ 
+ $(VSYML_BYTE_CMO_LST): $(VSYML_CMO_LST)
+ 	sed -e 's@\([a-zA-Z0-9_]*\)\.cmo@$(BYTE_PATH)$(PATH_SEPARATOR)\1.cmo@g' -e 's/VSYML_CMO/VSYML_BYTE_CMO/' $< > $@
diff -Nru ocaml-3.12.1/testsuite/external/xml-light-2.2.patch ocaml-4.01.0/testsuite/external/xml-light-2.2.patch
--- ocaml-3.12.1/testsuite/external/xml-light-2.2.patch	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/external/xml-light-2.2.patch	2012-08-02 08:17:59.000000000 +0000
@@ -0,0 +1,19 @@
+--- xml-light/Makefile	2003-10-12 11:16:12.000000000 +0200
++++ xml-light-2.2/Makefile	2010-01-23 20:57:57.000000000 +0100
+@@ -2,7 +2,7 @@
+ # http://tech.motion-twin.com
+ .SUFFIXES : .ml .mli .cmo .cmx .cmi .mll .mly
+ 
+-INSTALLDIR=`ocamlc -where`
++INSTALLDIR=`ocamlc -where`/xml-light
+ CFLAGS=
+ LFLAGS= -a
+ LIBS=
+@@ -12,6 +12,7 @@
+ opt: xml-light.cmxa test_opt.exe
+ 
+ install: all opt
++	mkdir -p "${INSTALLDIR}"
+ 	cp xml-light.cmxa xml-light.a xml-light.cma xml.mli xmlParser.mli dtd.mli xml.cmi xmlParser.cmi dtd.cmi xml.cmx dtd.cmx xmlParser.cmx $(INSTALLDIR)
+ 
+ doc:
diff -Nru ocaml-3.12.1/testsuite/interactive/lib-gc/Makefile ocaml-4.01.0/testsuite/interactive/lib-gc/Makefile
--- ocaml-3.12.1/testsuite/interactive/lib-gc/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/interactive/lib-gc/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,17 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+
 default:
 	@$(OCAMLC) -o program.byte alloc.ml
 	@./program.byte
@@ -7,4 +21,4 @@
 clean: defaultclean
 	@rm -fr program.*
 
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/interactive/lib-gc/alloc.ml ocaml-4.01.0/testsuite/interactive/lib-gc/alloc.ml
--- ocaml-3.12.1/testsuite/interactive/lib-gc/alloc.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/interactive/lib-gc/alloc.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*             Damien Doligez, projet Para, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: alloc.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (* Random allocation test *)
 
 (*
@@ -48,4 +46,3 @@
 Arg.parse argspecs (fun _ -> ()) "Usage: alloc [-c]";;
 
 main ();;
-
diff -Nru ocaml-3.12.1/testsuite/interactive/lib-gc/alloc.result ocaml-4.01.0/testsuite/interactive/lib-gc/alloc.result
--- ocaml-3.12.1/testsuite/interactive/lib-gc/alloc.result	2010-04-08 12:48:54.000000000 +0000
+++ ocaml-4.01.0/testsuite/interactive/lib-gc/alloc.result	1970-01-01 00:00:00.000000000 +0000
@@ -1,544 +0,0 @@
-
-minor_words: 6410964
-promoted_words: 6332175
-major_words: 6393661
-minor_collections: 196
-major_collections: 14
-heap_words: 3936256
-heap_chunks: 31
-top_heap_words: 3936256
-live_words: 2034808
-live_blocks: 31786
-free_words: 1901339
-free_blocks: 16531
-largest_free: 1357
-fragments: 109
-compactions: 0
-
-minor_words: 12805330
-promoted_words: 12664909
-major_words: 12739763
-minor_collections: 391
-major_collections: 21
-heap_words: 4571136
-heap_chunks: 36
-top_heap_words: 4571136
-live_words: 2126718
-live_blocks: 33282
-free_words: 2444325
-free_blocks: 19124
-largest_free: 1824
-fragments: 93
-compactions: 0
-
-minor_words: 19215544
-promoted_words: 18998176
-major_words: 19100845
-minor_collections: 586
-major_collections: 28
-heap_words: 4698112
-heap_chunks: 37
-top_heap_words: 4698112
-live_words: 2135891
-live_blocks: 33344
-free_words: 2562126
-free_blocks: 19238
-largest_free: 1405
-fragments: 95
-compactions: 0
-
-minor_words: 25638028
-promoted_words: 25361252
-major_words: 25472205
-minor_collections: 782
-major_collections: 35
-heap_words: 4698112
-heap_chunks: 37
-top_heap_words: 4698112
-live_words: 2137378
-live_blocks: 33350
-free_words: 2560637
-free_blocks: 19112
-largest_free: 1634
-fragments: 97
-compactions: 0
-
-minor_words: 32062298
-promoted_words: 31721945
-major_words: 31842628
-minor_collections: 978
-major_collections: 41
-heap_words: 4698112
-heap_chunks: 37
-top_heap_words: 4698112
-live_words: 2145462
-live_blocks: 33351
-free_words: 2552521
-free_blocks: 19013
-largest_free: 1999
-fragments: 129
-compactions: 0
-
-minor_words: 38449694
-promoted_words: 38049841
-major_words: 38176354
-minor_collections: 1173
-major_collections: 48
-heap_words: 4698112
-heap_chunks: 37
-top_heap_words: 4698112
-live_words: 2125014
-live_blocks: 33351
-free_words: 2572992
-free_blocks: 19080
-largest_free: 1525
-fragments: 106
-compactions: 0
-
-minor_words: 44846324
-promoted_words: 44379560
-major_words: 44521194
-minor_collections: 1368
-major_collections: 55
-heap_words: 4698112
-heap_chunks: 37
-top_heap_words: 4698112
-live_words: 2136556
-live_blocks: 33351
-free_words: 2561444
-free_blocks: 19191
-largest_free: 1760
-fragments: 112
-compactions: 0
-
-minor_words: 51240537
-promoted_words: 50707711
-major_words: 50862160
-minor_collections: 1563
-major_collections: 61
-heap_words: 4698112
-heap_chunks: 37
-top_heap_words: 4698112
-live_words: 2136623
-live_blocks: 33351
-free_words: 2561383
-free_blocks: 18967
-largest_free: 1526
-fragments: 106
-compactions: 0
-
-minor_words: 57628061
-promoted_words: 57038039
-major_words: 57197286
-minor_collections: 1758
-major_collections: 68
-heap_words: 4698112
-heap_chunks: 37
-top_heap_words: 4698112
-live_words: 2133895
-live_blocks: 33351
-free_words: 2564119
-free_blocks: 19273
-largest_free: 1793
-fragments: 98
-compactions: 0
-
-minor_words: 64028127
-promoted_words: 63367620
-major_words: 63545093
-minor_collections: 1953
-major_collections: 74
-heap_words: 4698112
-heap_chunks: 37
-top_heap_words: 4698112
-live_words: 2138085
-live_blocks: 33351
-free_words: 2559920
-free_blocks: 19111
-largest_free: 1800
-fragments: 107
-compactions: 0
-
-minor_words: 70438812
-promoted_words: 69698963
-major_words: 69904882
-minor_collections: 2148
-major_collections: 80
-heap_words: 4698112
-heap_chunks: 37
-top_heap_words: 4698112
-live_words: 2131008
-live_blocks: 33351
-free_words: 2566995
-free_blocks: 19079
-largest_free: 1451
-fragments: 109
-compactions: 0
-
-minor_words: 76852923
-promoted_words: 76032234
-major_words: 76270123
-minor_collections: 2343
-major_collections: 86
-heap_words: 4698112
-heap_chunks: 37
-top_heap_words: 4698112
-live_words: 2135699
-live_blocks: 33351
-free_words: 2562313
-free_blocks: 19201
-largest_free: 2056
-fragments: 100
-compactions: 0
-
-minor_words: 83248665
-promoted_words: 82362663
-major_words: 82613979
-minor_collections: 2538
-major_collections: 92
-heap_words: 4698112
-heap_chunks: 37
-top_heap_words: 4698112
-live_words: 2126387
-live_blocks: 33351
-free_words: 2571625
-free_blocks: 19099
-largest_free: 1498
-fragments: 100
-compactions: 0
-
-minor_words: 89636938
-promoted_words: 88694885
-major_words: 88952817
-minor_collections: 2733
-major_collections: 99
-heap_words: 4698112
-heap_chunks: 37
-top_heap_words: 4698112
-live_words: 2136754
-live_blocks: 33351
-free_words: 2561246
-free_blocks: 19220
-largest_free: 1697
-fragments: 112
-compactions: 0
-
-minor_words: 96030388
-promoted_words: 95026453
-major_words: 95296004
-minor_collections: 2928
-major_collections: 106
-heap_words: 4698112
-heap_chunks: 37
-top_heap_words: 4698112
-live_words: 2126039
-live_blocks: 33351
-free_words: 2571956
-free_blocks: 19250
-largest_free: 1593
-fragments: 117
-compactions: 0
-
-minor_words: 102436652
-promoted_words: 101356198
-major_words: 101649957
-minor_collections: 3123
-major_collections: 113
-heap_words: 4698112
-heap_chunks: 37
-top_heap_words: 4698112
-live_words: 2140261
-live_blocks: 33351
-free_words: 2557747
-free_blocks: 19192
-largest_free: 1731
-fragments: 104
-compactions: 0
-
-minor_words: 108832359
-promoted_words: 107686065
-major_words: 107994506
-minor_collections: 3318
-major_collections: 119
-heap_words: 4825088
-heap_chunks: 38
-top_heap_words: 4825088
-live_words: 2124817
-live_blocks: 33351
-free_words: 2700160
-free_blocks: 19149
-largest_free: 1617
-fragments: 111
-compactions: 0
-
-minor_words: 115220373
-promoted_words: 114018413
-major_words: 114333086
-minor_collections: 3513
-major_collections: 125
-heap_words: 4825088
-heap_chunks: 38
-top_heap_words: 4825088
-live_words: 2124190
-live_blocks: 33351
-free_words: 2700795
-free_blocks: 19303
-largest_free: 1567
-fragments: 103
-compactions: 0
-
-minor_words: 121628396
-promoted_words: 120347328
-major_words: 120688494
-minor_collections: 3708
-major_collections: 131
-heap_words: 4825088
-heap_chunks: 38
-top_heap_words: 4825088
-live_words: 2133563
-live_blocks: 33351
-free_words: 2691408
-free_blocks: 19134
-largest_free: 2129
-fragments: 117
-compactions: 0
-
-minor_words: 128038304
-promoted_words: 126675491
-major_words: 127045570
-minor_collections: 3903
-major_collections: 137
-heap_words: 4825088
-heap_chunks: 38
-top_heap_words: 4825088
-live_words: 2135379
-live_blocks: 33351
-free_words: 2689601
-free_blocks: 19345
-largest_free: 1699
-fragments: 108
-compactions: 0
-
-minor_words: 134429672
-promoted_words: 133007487
-major_words: 133387404
-minor_collections: 4098
-major_collections: 143
-heap_words: 4825088
-heap_chunks: 38
-top_heap_words: 4825088
-live_words: 2127333
-live_blocks: 33351
-free_words: 2697647
-free_blocks: 19276
-largest_free: 1758
-fragments: 108
-compactions: 0
-
-minor_words: 140831438
-promoted_words: 139333508
-major_words: 139733383
-minor_collections: 4293
-major_collections: 149
-heap_words: 4825088
-heap_chunks: 38
-top_heap_words: 4825088
-live_words: 2145113
-live_blocks: 33351
-free_words: 2679876
-free_blocks: 19365
-largest_free: 1650
-fragments: 99
-compactions: 0
-
-minor_words: 147229656
-promoted_words: 145661743
-major_words: 146077858
-minor_collections: 4488
-major_collections: 155
-heap_words: 4825088
-heap_chunks: 38
-top_heap_words: 4825088
-live_words: 2132556
-live_blocks: 33351
-free_words: 2692441
-free_blocks: 19150
-largest_free: 1431
-fragments: 91
-compactions: 0
-
-minor_words: 153646155
-promoted_words: 152024536
-major_words: 152442636
-minor_collections: 4684
-major_collections: 161
-heap_words: 4825088
-heap_chunks: 38
-top_heap_words: 4825088
-live_words: 2130394
-live_blocks: 33351
-free_words: 2694592
-free_blocks: 19164
-largest_free: 1288
-fragments: 102
-compactions: 0
-
-minor_words: 160038986
-promoted_words: 158352855
-major_words: 158781961
-minor_collections: 4879
-major_collections: 167
-heap_words: 4825088
-heap_chunks: 38
-top_heap_words: 4825088
-live_words: 2131838
-live_blocks: 33351
-free_words: 2693140
-free_blocks: 19355
-largest_free: 1741
-fragments: 110
-compactions: 0
-
-minor_words: 166458940
-promoted_words: 164714552
-major_words: 165149249
-minor_collections: 5075
-major_collections: 173
-heap_words: 4825088
-heap_chunks: 38
-top_heap_words: 4825088
-live_words: 2146731
-live_blocks: 33351
-free_words: 2678258
-free_blocks: 19338
-largest_free: 1951
-fragments: 99
-compactions: 0
-
-minor_words: 172869183
-promoted_words: 171044208
-major_words: 171507681
-minor_collections: 5270
-major_collections: 179
-heap_words: 4825088
-heap_chunks: 38
-top_heap_words: 4825088
-live_words: 2130620
-live_blocks: 33351
-free_words: 2694346
-free_blocks: 19355
-largest_free: 1716
-fragments: 122
-compactions: 0
-
-minor_words: 179276123
-promoted_words: 177371439
-major_words: 177859651
-minor_collections: 5465
-major_collections: 185
-heap_words: 4825088
-heap_chunks: 38
-top_heap_words: 4825088
-live_words: 2141174
-live_blocks: 33351
-free_words: 2683827
-free_blocks: 19340
-largest_free: 1707
-fragments: 87
-compactions: 0
-
-minor_words: 185681086
-promoted_words: 183702557
-major_words: 184213391
-minor_collections: 5660
-major_collections: 191
-heap_words: 4825088
-heap_chunks: 38
-top_heap_words: 4825088
-live_words: 2133699
-live_blocks: 33351
-free_words: 2691284
-free_blocks: 19303
-largest_free: 1557
-fragments: 105
-compactions: 0
-
-minor_words: 192087937
-promoted_words: 190033229
-major_words: 190568763
-minor_collections: 5855
-major_collections: 197
-heap_words: 4825088
-heap_chunks: 38
-top_heap_words: 4825088
-live_words: 2133162
-live_blocks: 33351
-free_words: 2691831
-free_blocks: 19299
-largest_free: 1561
-fragments: 95
-compactions: 0
-
-minor_words: 198496824
-promoted_words: 196364203
-major_words: 196926470
-minor_collections: 6050
-major_collections: 203
-heap_words: 4825088
-heap_chunks: 38
-top_heap_words: 4825088
-live_words: 2129841
-live_blocks: 33351
-free_words: 2695139
-free_blocks: 19163
-largest_free: 1653
-fragments: 108
-compactions: 0
-
-minor_words: 204889797
-promoted_words: 202693452
-major_words: 203267275
-minor_collections: 6245
-major_collections: 209
-heap_words: 4825088
-heap_chunks: 38
-top_heap_words: 4825088
-live_words: 2130715
-live_blocks: 33351
-free_words: 2694271
-free_blocks: 19257
-largest_free: 1491
-fragments: 102
-compactions: 0
-
-minor_words: 211268811
-promoted_words: 208990042
-major_words: 209593734
-minor_collections: 6439
-major_collections: 215
-heap_words: 4825088
-heap_chunks: 38
-top_heap_words: 4825088
-live_words: 2128683
-live_blocks: 33351
-free_words: 2696320
-free_blocks: 19306
-largest_free: 1789
-fragments: 85
-compactions: 0
-
-minor_words: 217673548
-promoted_words: 215319820
-major_words: 215946607
-minor_collections: 6634
-major_collections: 221
-heap_words: 4825088
-heap_chunks: 38
-top_heap_words: 4825088
-live_words: 2134523
-live_blocks: 33351
-free_words: 2690457
-free_blocks: 19391
-largest_free: 1845
-fragments: 108
-compactions: 0
diff -Nru ocaml-3.12.1/testsuite/interactive/lib-graph/Makefile ocaml-4.01.0/testsuite/interactive/lib-graph/Makefile
--- ocaml-3.12.1/testsuite/interactive/lib-graph/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/interactive/lib-graph/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,7 +1,20 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 #MODULES=
 MAIN_MODULE=graph_example
 #ADD_COMPFLAGS=
 LIBRARIES=graphics
 
-include ../../makefiles/Makefile.one
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/interactive/lib-graph/graph_example.ml ocaml-4.01.0/testsuite/interactive/lib-graph/graph_example.ml
--- ocaml-3.12.1/testsuite/interactive/lib-graph/graph_example.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/interactive/lib-graph/graph_example.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*             Damien Doligez, projet Para, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1999 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* To run this example:
    ********************
    1. Select all the text in this window.
diff -Nru ocaml-3.12.1/testsuite/interactive/lib-graph-2/Makefile ocaml-4.01.0/testsuite/interactive/lib-graph-2/Makefile
--- ocaml-3.12.1/testsuite/interactive/lib-graph-2/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/interactive/lib-graph-2/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,7 +1,20 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 #MODULES=
 MAIN_MODULE=graph_test
 #ADD_COMPFLAGS=
 LIBRARIES=graphics
 
-include ../../makefiles/Makefile.one
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/interactive/lib-graph-2/graph_test.ml ocaml-4.01.0/testsuite/interactive/lib-graph-2/graph_test.ml
--- ocaml-3.12.1/testsuite/interactive/lib-graph-2/graph_test.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/interactive/lib-graph-2/graph_test.ml	2012-07-17 15:31:12.000000000 +0000
@@ -1,13 +1,12 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Pierre Weis, projet Cristal, INRIA Rocquencourt          *)
 (*                                                                     *)
 (*  Copyright 2000 Institut National de Recherche en Informatique et   *)
 (*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the GNU Library General Public License, with    *)
-(*  the special exception on linking described in file ../../LICENSE.  *)
+(*  under the terms of the Q Public License version 1.0.               *)
 (*                                                                     *)
 (***********************************************************************)
 
@@ -28,7 +27,7 @@
 
 open_graph (Printf.sprintf " %ix%i" sz sz);;
 
-(* To be defined for older versions of O'Caml
+(* To be defined for older versions of OCaml
    Lineto, moveto and draw_rect.
 
 let rlineto x y =
@@ -151,7 +150,7 @@
 fill_rect x (y - 5) (8 * 20) 25;;
 set_color yellow;;
 go_legend ();;
-draw_string "Graphics (Caml)";;
+draw_string "Graphics (OCaml)";;
 
 (* Pie parts in different colors. *)
 let draw_green_string s = set_color green; draw_string s;;
diff -Nru ocaml-3.12.1/testsuite/interactive/lib-graph-3/Makefile ocaml-4.01.0/testsuite/interactive/lib-graph-3/Makefile
--- ocaml-3.12.1/testsuite/interactive/lib-graph-3/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/interactive/lib-graph-3/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,7 +1,20 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 #MODULES=
 MAIN_MODULE=sorts
 ADD_COMPFLAGS=-thread
 LIBRARIES=unix threads graphics
 
-include ../../makefiles/Makefile.one
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/interactive/lib-graph-3/sorts.ml ocaml-4.01.0/testsuite/interactive/lib-graph-3/sorts.ml
--- ocaml-3.12.1/testsuite/interactive/lib-graph-3/sorts.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/interactive/lib-graph-3/sorts.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Animation of sorting algorithms. *)
 
 open Graphics
diff -Nru ocaml-3.12.1/testsuite/interactive/lib-signals/Makefile ocaml-4.01.0/testsuite/interactive/lib-signals/Makefile
--- ocaml-3.12.1/testsuite/interactive/lib-signals/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/interactive/lib-signals/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,17 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+
 default:
 	@$(OCAMLC) -o program.byte signals.ml
 	@./program.byte
@@ -7,4 +21,4 @@
 clean: defaultclean
 	@rm -fr program.*
 
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/interactive/lib-signals/signals.ml ocaml-4.01.0/testsuite/interactive/lib-signals/signals.ml
--- ocaml-3.12.1/testsuite/interactive/lib-signals/signals.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/interactive/lib-signals/signals.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1995 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let rec tak (x, y, z) =
   if x > y then tak(tak (x-1, y, z), tak (y-1, z, x), tak (z-1, x, y))
            else z
diff -Nru ocaml-3.12.1/testsuite/lib/Makefile ocaml-4.01.0/testsuite/lib/Makefile
--- ocaml-3.12.1/testsuite/lib/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/lib/Makefile	2013-05-14 18:34:30.000000000 +0000
@@ -1,7 +1,28 @@
-# $Id: Makefile 10713 2010-10-08 11:53:19Z doligez $
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
 
-compile: testing.cmi testing.cmo testing.cmx
+.PHONY: compile
+compile: compile-targets
 
+.PHONY: promote
+promote: defaultpromote
+
+.PHONY: clean
 clean: defaultclean
 
 include ../makefiles/Makefile.common
+
+.PHONY: compile-targets
+compile-targets: testing.cmi testing.cmo
+	@if $(BYTECODE_ONLY); then : ; else \
+	  $(MAKE) testing.cmx; \
+	fi
diff -Nru ocaml-3.12.1/testsuite/lib/testing.ml ocaml-4.01.0/testsuite/lib/testing.ml
--- ocaml-3.12.1/testsuite/lib/testing.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/lib/testing.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*             Pierre Weis, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: testing.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (* Testing auxilliaries. *)
 
 open Scanf;;
@@ -30,7 +28,7 @@
 let test_num = ref (-1);;
 
 let print_test_number () =
-  print_int !test_num; print_string " "; flush stdout;;
+  print_string " "; print_int !test_num; flush stdout;;
 
 let next_test () =
   incr test_num;
@@ -93,4 +91,3 @@
 
 let scan_failure_test f x =
   test_raises_exc_p (function Scan_failure _ -> true | _ -> false) f x;;
-
diff -Nru ocaml-3.12.1/testsuite/lib/testing.mli ocaml-4.01.0/testsuite/lib/testing.mli
--- ocaml-3.12.1/testsuite/lib/testing.mli	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/lib/testing.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*             Pierre Weis, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: testing.mli 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (* Testing auxilliaries. *)
 
 val test : bool -> unit;;
diff -Nru ocaml-3.12.1/testsuite/makefiles/Makefile.common ocaml-4.01.0/testsuite/makefiles/Makefile.common
--- ocaml-3.12.1/testsuite/makefiles/Makefile.common	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/makefiles/Makefile.common	2013-07-23 15:30:26.000000000 +0000
@@ -1,24 +1,78 @@
-# $Id: Makefile.common 10713 2010-10-08 11:53:19Z doligez $
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
 
 TOPDIR=$(BASEDIR)/..
+WINTOPDIR=`cygpath -m "$(TOPDIR)"`
+
+# TOPDIR is the root directory of the OCaml sources, in Unix syntax.
+# WINTOPDIR is the same directory, in Windows syntax.
+
+OTOPDIR=$(TOPDIR)
+CTOPDIR=$(TOPDIR)
+CYGPATH=echo
+DIFF=diff -q
+CANKILL=true
+SORT=sort
+SET_LD_PATH=CAML_LD_LIBRARY_PATH="$(LD_PATH)"
+
+# The variables above may be overridden by .../config/Makefile
+# OTOPDIR is either TOPDIR or WINTOPDIR, whichever is appropriate for
+#   arguments given to the OCaml compiler.
+# CTOPDIR is either TOPDIR or WINTOPDIR, whichever is appropriate for
+#   arguments given to the C and Fortran compilers.
+# CYGPATH is the command that translates unix-style file names into
+#   whichever syntax is appropriate for arguments of OCaml programs.
+# DIFF is a "diff -q" command that ignores trailing CRs under Windows.
+# CANKILL is true if a script launched by Make can kill an OCaml process,
+#   and false for the mingw and MSVC ports.
+# SORT is the Unix "sort" command. Usually a simple command, but may be an
+#   absolute name if the Windows "sort" command is in the PATH.
+# SET_LD_PATH is a command prefix that sets the path for dynamic libraries
+#   (LD_LIBRARY_PATH for Unix, PATH for Windows) using the LD_PATH shell
+#   variable. Note that for Windows we add Unix-syntax directory names in
+#   PATH, and Cygwin will translate it to Windows syntax.
 
 include $(TOPDIR)/config/Makefile
 
-BOOTDIR=$(TOPDIR)/boot
-OCAMLRUN=$(BOOTDIR)/ocamlrun$(EXE)
-OCAML=$(OCAMLRUN) $(TOPDIR)/ocaml$(EXE)
-OCAMLC=$(OCAMLRUN) $(TOPDIR)/ocamlc$(EXE)
-OCAMLOPT=$(OCAMLRUN) $(TOPDIR)/ocamlopt$(EXE)
-OCAMLDOC=$(OCAMLRUN) $(TOPDIR)/ocamldoc/ocamldoc$(EXE)
-OCAMLLEX=$(OCAMLRUN) $(TOPDIR)/lex/ocamllex$(EXE)
-OCAMLMKLIB=$(OCAMLRUN) $(TOPDIR)/tools/ocamlmklib$(EXE)
+OCAMLRUN=$(TOPDIR)/boot/ocamlrun$(EXE)
+
+OCFLAGS=-nostdlib -I $(OTOPDIR)/stdlib $(COMPFLAGS)
+
+OCAML=$(OCAMLRUN) $(OTOPDIR)/ocaml $(OCFLAGS) \
+      -init $(OTOPDIR)/testsuite/lib/empty
+OCAMLC=$(OCAMLRUN) $(OTOPDIR)/ocamlc $(OCFLAGS)
+OCAMLOPT=$(OCAMLRUN) $(OTOPDIR)/ocamlopt $(OCFLAGS)
+OCAMLDOC=$(OCAMLRUN) $(OTOPDIR)/ocamldoc/ocamldoc
+OCAMLLEX=$(OCAMLRUN) $(OTOPDIR)/lex/ocamllex
+OCAMLMKLIB=$(OCAMLRUN) $(OTOPDIR)/tools/ocamlmklib \
+		       -ocamlc "$(OTOPDIR)/boot/ocamlrun$(EXE) \
+		                $(OTOPDIR)/ocamlc $(OCFLAGS)" \
+		       -ocamlopt "$(OTOPDIR)/boot/ocamlrun$(EXE) \
+		                  $(OTOPDIR)/ocamlopt $(OCFLAGS)"
 OCAMLYACC=$(TOPDIR)/yacc/ocamlyacc$(EXE)
 OCAMLBUILD=$(TOPDIR)/_build/ocamlbuild/ocamlbuild.native
-DUMPOBJ=$(OCAMLRUN) $(TOPDIR)/tool/dumpobj$(EXE)
-#COMPFLAGS=
+DUMPOBJ=$(OCAMLRUN) $(OTOPDIR)/tool/dumpobj
+BYTECODE_ONLY=[ "$(ARCH)" = "none" -o "$(ASM)" = "none" ]
+
 #FORTRAN_COMPILER=
 #FORTRAN_LIBRARY=
 
+UNIXLIBVAR=`case "$(OTHERLIBRARIES)" in *win32unix*) echo win32;; esac`
+
+defaultpromote:
+	@for file in *.reference; do \
+	  cp `basename $$file reference`result $$file; \
+	done
+
 defaultclean:
 	@rm -f *.cmo *.cmi *.cmx *.cma *.cmxa *.cmxs *.$(O) *.$(SO) *.$(A)
 	@for dsym in *.dSYM; do \
@@ -28,26 +82,26 @@
 	done
 
 .SUFFIXES:
-.SUFFIXES: .mli .ml .mly .mll .cmi .cmo .cmx .cmm .cmxa .s .S .o .so
+.SUFFIXES: .mli .ml .mly .mll .cmi .cmo .cmx .cmm .cmxa .s .S .o .so .c .f
 
 .mli.cmi:
-	@$(OCAMLC) -c $(COMPFLAGS) $(ADD_COMPFLAGS) $<
+	@$(OCAMLC) -c $(ADD_COMPFLAGS) $<
 
 .ml.cmi:
-	@$(OCAMLC) -c $(COMPFLAGS) $(ADD_COMPFLAGS) $<
+	@$(OCAMLC) -c $(ADD_COMPFLAGS) $<
 
 .ml.cmo:
-	@if [ -f $ /dev/null
@@ -57,10 +111,16 @@
 
 .cmm.o:
 	@$(OCAMLRUN) ./codegen $*.cmm > $*.s
-	@$(AS) $(ASFLAGS) -o $*.o $*.s
+	@$(ASM) -o $*.o $*.s
 
 .S.o:
 	@$(ASPP) $(ASPPFLAGS) -DSYS_$(SYSTEM) -o $*.o $*.S
 
 .s.o:
 	@$(ASPP) $(ASPPFLAGS) -DSYS_$(SYSTEM) -o $*.o $*.s
+
+.c.o:
+	@$(CC) -c -I$(CTOPDIR)/byterun $*.c -o $*.$(O)
+
+.f.o:
+	@$(FORTRAN_COMPILER) -c -I$(CTOPDIR)/byterun $*.f -o $*.$(O)
diff -Nru ocaml-3.12.1/testsuite/makefiles/Makefile.okbad ocaml-4.01.0/testsuite/makefiles/Makefile.okbad
--- ocaml-3.12.1/testsuite/makefiles/Makefile.okbad	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/makefiles/Makefile.okbad	2013-05-16 19:48:04.000000000 +0000
@@ -1,19 +1,42 @@
-# $Id: Makefile.okbad 10713 2010-10-08 11:53:19Z doligez $
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
 
+.PHONY: default
 default: compile
 
+.PHONY: compile
 compile:
 	@for file in *.ml; do \
 	  printf " ... testing '$$file'"; \
 	  if [ `echo $$file | grep bad` ]; then \
-	    $(OCAMLC) -c -w a $$file 2> /dev/null && (echo " => failed" && exit 1) || echo " => passed"; \
+	    $(OCAMLC) -c -w a $$file 2>/dev/null \
+            && echo " => failed" || echo " => passed"; \
 	  else \
-	    test -f `basename $$file ml`mli && $(OCAMLC) -c -w a `basename $$file ml`mli; \
-	    $(OCAMLC) -c -w a $$file 2> /dev/null || (echo " => failed" && exit 1); \
-	    test -f `basename $$file ml`reference && $(OCAMLC) `basename $$file ml`cmo && ./a.out > `basename $$file ml`result && (diff -q `basename $$file ml`reference `basename $$file ml`result || (echo " => failed" && exit 1)); \
-	    echo " => passed"; \
+	    F="`basename $$file .ml`"; \
+	    test -f $$F.mli && $(OCAMLC) -c -w a $$F.mli; \
+	    $(OCAMLC) -c -w a $$file 2>/dev/null \
+	    && if [ -f $$F.reference ]; then \
+	         rm -f program.byte; \
+	         $(OCAMLC) $$F.cmo -o program.byte \
+	         && $(OCAMLRUN) program.byte >$$F.result \
+	         && $(DIFF) $$F.reference $$F.result >/dev/null; \
+	       fi \
+	    && echo " => passed" || echo " => failed"; \
 	  fi; \
 	done
 
+.PHONY: promote
+promote: defaultpromote
+
+.PHONY: clean
 clean: defaultclean
-	@rm -f ./a.out *.cm* *.result
+	@rm -f program.byte *.cm* *.result
diff -Nru ocaml-3.12.1/testsuite/makefiles/Makefile.one ocaml-4.01.0/testsuite/makefiles/Makefile.one
--- ocaml-3.12.1/testsuite/makefiles/Makefile.one	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/makefiles/Makefile.one	2013-05-17 12:03:58.000000000 +0000
@@ -1,4 +1,14 @@
-# $Id: Makefile.one 10713 2010-10-08 11:53:19Z doligez $
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
 
 CMI_FILES=$(MODULES:=.cmi)
 CMO_FILES=$(MODULES:=.cmo)
@@ -9,32 +19,58 @@
 ML_YACC_FILES=$(YACC_MODULES:=.ml)
 MLI_YACC_FILES=$(YACC_MODULES:=.mli)
 ML_FILES=$(ML_LEX_FILES) $(ML_YACC_FILES)
-O_FILES=$(C_FILES:=.o)
+O_FILES=$(C_FILES:=.$(O))
 ADD_CMO_FILES=$(ADD_MODULES:=.cmo)
 ADD_CMX_FILES=$(ADD_MODULES:=.cmx)
 
 GENERATED_SOURCES=$(ML_LEX_FILES) $(ML_YACC_FILES) $(MLI_YACC_FILES)
 
-CUSTOM_FLAG=`if [ -z "$(C_FILES)" ]; then true; else echo '-custom'; fi`
+CUSTOM_FLAG=`if [ -n "$(C_FILES)" ]; then echo '-custom'; fi`
 ADD_CFLAGS+=$(CUSTOM_FLAG)
+MYRUNTIME=`if [ -z "$(C_FILES)" ]; then echo '$(OCAMLRUN)'; fi`
 
-default: compile run
+CC=$(NATIVECC) $(NATIVECCCOMPOPTS)
 
-compile: $(ML_FILES) $(CMO_FILES) $(CMX_FILES) $(MAIN_MODULE).cmo $(MAIN_MODULE).cmx
+.PHONY: default
+default:
+	@$(SET_LD_PATH) $(MAKE) compile run
+
+.PHONY: compile
+compile: $(ML_FILES) $(CMO_FILES) $(MAIN_MODULE).cmo
 	@for file in $(C_FILES); do \
-	  $(NATIVECC) $(NATIVECCCOMPOPTS) -c -I$(TOPDIR)/byterun $$file.c; \
+	  $(NATIVECC) $(NATIVECCCOMPOPTS) -c -I$(CTOPDIR)/byterun $$file.c; \
 	done;
-	@$(OCAMLC) $(ADD_COMPFLAGS) $(ADD_CFLAGS) -o program.byte $(O_FILES) $(CMA_FILES) $(CMO_FILES) $(ADD_CMO_FILES) $(MAIN_MODULE).cmo
-	@$(OCAMLOPT) $(ADD_COMPFLAGS) -o program.native $(O_FILES) $(CMXA_FILES) $(CMX_FILES) $(ADD_CMX_FILES) $(MAIN_MODULE).cmx
+	@rm -f program.byte program.byte.exe
+	@$(OCAMLC) $(ADD_COMPFLAGS) $(ADD_CFLAGS) -o program.byte$(EXE) \
+	           $(O_FILES) $(CMA_FILES) $(CMO_FILES) $(ADD_CMO_FILES) \
+	           $(MAIN_MODULE).cmo
+	@if $(BYTECODE_ONLY); then : ; else \
+	  rm -f program.native program.native.exe; \
+	  $(MAKE) $(CMX_FILES) $(MAIN_MODULE).cmx; \
+	  $(OCAMLOPT) $(ADD_COMPFLAGS) -o program.native$(EXE) $(O_FILES) \
+	              $(CMXA_FILES) $(CMX_FILES) $(ADD_CMX_FILES) \
+	              $(MAIN_MODULE).cmx; \
+	fi
 
+.PHONY: run
 run:
 	@printf " ... testing with ocamlc"
-	@./program.byte $(EXEC_ARGS) > $(MAIN_MODULE).result || (echo " => failed" && exit 1)
-	@diff -q $(MAIN_MODULE).reference $(MAIN_MODULE).result > /dev/null || (echo " => failed" && exit 1)
-	@printf " ocamlopt"
-	@./program.native $(EXEC_ARGS) > $(MAIN_MODULE).result || (echo " => failed" && exit 1)
-	@diff -q $(MAIN_MODULE).reference $(MAIN_MODULE).result > /dev/null || (echo " => failed" && exit 1)
-	@echo " => passed"
+	@$(MYRUNTIME) ./program.byte$(EXE) $(EXEC_ARGS) >$(MAIN_MODULE).result\
+	&& $(DIFF) $(MAIN_MODULE).reference $(MAIN_MODULE).result >/dev/null \
+	&& if $(BYTECODE_ONLY); then : ; else \
+	     printf " ocamlopt"; \
+	     ./program.native$(EXE) $(EXEC_ARGS) > $(MAIN_MODULE).result \
+	     && $(DIFF) $(MAIN_MODULE).reference $(MAIN_MODULE).result \
+	                >/dev/null; \
+	   fi \
+	&& echo " => passed" || echo " => failed"
+
+
+.PHONY: promote
+promote: defaultpromote
 
+.PHONY: clean
 clean: defaultclean
-	@rm -f *.result ./program.* $(GENERATED_SOURCES) $(O_FILES)
+	@rm -f *.result program.byte program.byte.exe \
+	       program.native program.native.exe \
+	       $(GENERATED_SOURCES) $(O_FILES) $(TEST_TEMP_FILES)
diff -Nru ocaml-3.12.1/testsuite/makefiles/Makefile.several ocaml-4.01.0/testsuite/makefiles/Makefile.several
--- ocaml-3.12.1/testsuite/makefiles/Makefile.several	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/makefiles/Makefile.several	2013-05-17 12:03:58.000000000 +0000
@@ -1,4 +1,14 @@
-# $Id: Makefile.several 10713 2010-10-08 11:53:19Z doligez $
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
 
 CC=$(NATIVECC) $(NATIVECCCOMPOPTS)
 FC=$(FORTAN_COMPILER)
@@ -8,15 +18,20 @@
 CMXA_FILES=$(LIBRARIES:=.cmxa)
 O_FILES=$(C_FILES:=.o)
 
-CUSTOM_FLAG=`if [ -z "$(C_FILES)" ]; then true; else echo '-custom'; fi`
+CUSTOM_FLAG=`if [ -n "$(C_FILES)" ]; then echo '-custom'; fi`
 ADD_CFLAGS+=$(CUSTOM_FLAG)
-FORTRAN_LIB=`if [ -z "$(F_FILES)" ]; then true; else echo '$(FORTRAN_LIBRARY)'; fi`
+MYRUNTIME=`if [ -z "$(C_FILES)" ]; then echo '$(OCAMLRUN)'; fi`
+FORTRAN_LIB=`if [ -n "$(F_FILES)" ]; then echo '$(FORTRAN_LIBRARY)'; fi`
 ADD_CFLAGS+=$(FORTRAN_LIB)
 ADD_OPTFLAGS+=$(FORTRAN_LIB)
 
+.PHONY: check
 check:
-	@if [ -n "$(FORTRAN_COMPILER)" -o -z "$(F_FILES)" ]; then $(MAKE) run-all; fi
+	@if [ -n "$(FORTRAN_COMPILER)" -o -z "$(F_FILES)" ]; then \
+	  $(SET_LD_PATH) $(MAKE) run-all; \
+	fi
 
+.PHONY: run-all
 run-all:
 	@for file in $(C_FILES); do \
 	  $(CC) -c -I$(PREFIX)/lib/ocaml/caml $$file.c; \
@@ -25,29 +40,67 @@
 	  $(FORTRAN_COMPILER) -c -I$(PREFIX)/lib/ocaml/caml $$file.f; \
 	done;
 	@for file in *.ml; do \
+	  if [ -f `basename $$file ml`precheck ]; then \
+	    CANKILL=$(CANKILL) sh `basename $$file ml`precheck || continue; \
+	  fi; \
 	  printf " ... testing '$$file':"; \
-	  $(MAKE) run-file DESC=ocamlc COMP='$(OCAMLC)' COMPFLAGS='$(ADD_COMPFLAGS) $(ADD_CFLAGS) $(O_FILES) -w a $(CMA_FILES) -I ../../lib $(CMO_FILES)' FILE=$$file PROGRAM_ARGS=$(PROGRAM_ARGS) && \
-	  $(MAKE) run-file DESC=ocamlopt COMP=$(PREFIX)/bin/ocamlopt COMPFLAGS='$(ADD_COMPFLAGS) $(ADD_OPTFLAGS) $(O_FILES) -w a $(CMXA_FILES) -I ../../lib $(CMX_FILES)' FILE=$$file PROGRAM_ARGS=$(PROGRAM_ARGS) && \
-	  if [ ! -z $(UNSAFE) ]; then \
-	    $(MAKE) run-file DESC=ocamlc-unsafe COMP=$(PREFIX)/bin/ocamlc COMPFLAGS='-w a -unsafe -I ../../li $(CMO_FILES)' FILE=$$file && \
-	    $(MAKE) run-file DESC=ocamlopt-unsafe COMP=$(PREFIX)/bin/ocamlopt COMPFLAGS='-w a -unsafe -I ../../lib $(CMX_FILES)' FILE=$$file; \
-	  fi && \
-	  echo " => passed"; \
-	done;
+	  $(MAKE) run-file DESC=ocamlc COMP='$(OCAMLC)' \
+	          RUNTIME='$(MYRUNTIME)' \
+	          COMPFLAGS='-w a $(ADD_COMPFLAGS) $(ADD_CFLAGS) $(O_FILES) \
+	                     $(CMA_FILES) -I $(OTOPDIR)/testsuite/lib \
+	                     $(CMO_FILES)' \
+	          FILE=$$file PROGRAM_ARGS=$(PROGRAM_ARGS) \
+	  && \
+	  if $(BYTECODE_ONLY); then : ; else \
+	    $(MAKE) run-file DESC=ocamlopt COMP='$(OCAMLOPT)' \
+	            RUNTIME= \
+	            COMPFLAGS='-w a $(ADD_COMPFLAGS) $(ADD_OPTFLAGS) \
+		               $(O_FILES) $(CMXA_FILES) \
+			       -I $(OTOPDIR)/testsuite/lib $(CMX_FILES)' \
+	            FILE=$$file PROGRAM_ARGS=$(PROGRAM_ARGS); \
+	  fi \
+	  && \
+	  if [ -n "$(UNSAFE)" ]; then \
+	    $(MAKE) run-file DESC=ocamlc-unsafe COMP='$(OCAMLC)' \
+	            RUNTIME='$(MYRUNTIME)' \
+	            COMPFLAGS='-w a -unsafe $(ADD_COMPFLAGS) $(ADD_CFLAGS) \
+	                       $(O_FILES) $(CMA_FILES) \
+	                       -I $(OTOPDIR)/testsuite/lib $(CMO_FILES)' \
+	            FILE=$$file \
+	    && \
+	    if $(BYTECODE_ONLY); then : ; else \
+	      $(MAKE) run-file DESC=ocamlopt-unsafe COMP='$(OCAMLOPT)' \
+	              RUNTIME= \
+	              COMPFLAGS='-w a -unsafe $(ADD_COMPFLAGS) $(ADD_OPTFLAGS)\
+		                 $(O_FILES) $(CMXA_FILES) \
+	                         -I $(OTOPDIR)/testsuite/lib $(CMX_FILES)' \
+	              FILE=$$file; \
+	       fi; \
+	     fi \
+	  && echo " => passed" || echo " => failed"; \
+	done
 
+.PHONY: run-file
 run-file:
 	@printf " $(DESC)"
-	@$(COMP) $(COMPFLAGS) $(FILE) -o program
-	@if [ -f `basename $(FILE) ml`runner ]; then \
-	  sh `basename $(FILE) ml`runner; \
+	@rm -f program program.exe
+	@$(COMP) $(COMPFLAGS) $(FILE) -o program$(EXE)
+	@F="`basename $(FILE) .ml`"; \
+	if [ -f $$F.runner ]; then \
+	  RUNTIME="$(RUNTIME)" sh $$F.runner; \
 	else \
-	  ./program $(PROGRAM_ARGS) > `basename $(FILE) ml`result; \
-	fi
-	@if [ -f `basename $(FILE) ml`checker ]; then \
-	  sh `basename $(FILE) ml`checker; \
+	  $(RUNTIME) ./program$(EXE) $(PROGRAM_ARGS) >$$F.result; \
+	fi \
+	&& \
+	if [ -f $$F.checker ]; then \
+	  DIFF="$(DIFF)" SORT="$(SORT)" sh $$F.checker; \
 	else \
-	  diff -q `basename $(FILE) ml`reference `basename $(FILE) ml`result > /dev/null || (echo " => failed" && exit 1); \
+	  $(DIFF) $$F.reference $$F.result >/dev/null; \
 	fi
 
+.PHONY: promote
+promote: defaultpromote
+
+.PHONY: clean
 clean: defaultclean
-	@rm -f *.result ./program
+	@rm -f *.result program program.exe
diff -Nru ocaml-3.12.1/testsuite/makefiles/Makefile.toplevel ocaml-4.01.0/testsuite/makefiles/Makefile.toplevel
--- ocaml-3.12.1/testsuite/makefiles/Makefile.toplevel	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/makefiles/Makefile.toplevel	2013-05-03 15:52:56.000000000 +0000
@@ -1,16 +1,31 @@
-# $Id: Makefile.toplevel 10713 2010-10-08 11:53:19Z doligez $
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
 
 default:
 	@for file in *.ml; do \
-	  $(OCAML) < $$file 2>&1 | grep -v '^        Objective Caml version' > $$file.result; \
+	  $(OCAML) $(TOPFLAGS) <$$file 2>&1 \
+	    | grep -v '^        OCaml version' > $$file.result; \
 	  if [ -f $$file.principal.reference ]; then \
-	    $(OCAML) -principal < $$file 2>&1 | grep -v '^        Objective Caml version' > $$file.principal.result; \
+	    $(OCAML) $(TOPFLAGS) -principal <$$file 2>&1 \
+	      | grep -v '^        OCaml version' > $$file.principal.result; \
 	  fi; \
 	done
 	@for file in *.reference; do \
 	  printf " ... testing '$$file':"; \
-	  diff -q $$file `basename $$file reference`result || (echo " => failed" && exit 1) && echo " => passed"; \
+	  $(DIFF) $$file `basename $$file reference`result >/dev/null \
+          && echo " => passed" || echo " => failed"; \
 	done
 
+promote: defaultpromote
+
 clean: defaultclean
 	@rm -f *.result
diff -Nru ocaml-3.12.1/testsuite/makefiles/summarize.awk ocaml-4.01.0/testsuite/makefiles/summarize.awk
--- ocaml-3.12.1/testsuite/makefiles/summarize.awk	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/makefiles/summarize.awk	2013-05-17 15:06:37.000000000 +0000
@@ -0,0 +1,117 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#         Damien Doligez, projet Gallium, INRIA Rocquencourt            #
+#                                                                       #
+#   Copyright 2013 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+function check() {
+    if (!in_test){
+        printf("error at line %d: found test result without test start\n", NR);
+        errored = 1;
+    }
+}
+
+function clear() {
+    curfile = "";
+    in_test = 0;
+}
+
+function record_pass() {
+    check();
+    ++ passed;
+    clear();
+}
+
+function record_skip() {
+    check();
+    ++ skipped;
+    clear();
+}
+
+function record_fail() {
+    check();
+    ++ failed;
+    fail[failidx++] = sprintf ("%s/%s", curdir, curfile);
+    clear();
+}
+
+function record_unexp() {
+    ++ unexped;
+    unexp[unexpidx++] = sprintf ("%s/%s", curdir, curfile);
+    clear();
+}
+
+/Running tests from '[^']*'/ {
+    if (in_test) record_unexp();
+    match($0, /Running tests from '[^']*'/);
+    curdir = substr($0, RSTART+20, RLENGTH - 21);
+    curfile = "";
+}
+
+/ ... testing.* ... testing/ {
+    printf("error at line %d: found two test results on the same line\n", NR);
+    errored = 1;
+}
+
+/^ ... testing '[^']*'/ {
+    if (in_test) record_unexp();
+    match($0, /... testing '[^']*'/);
+    curfile = substr($0, RSTART+13, RLENGTH-14);
+    in_test = 1;
+}
+
+/^ ... testing with / {
+    if (in_test) record_unexp();
+    in_test = 1;
+}
+
+/=> passed/ {
+    record_pass();
+}
+
+/=> skipped/ {
+    record_skip();
+}
+
+/=> failed/ {
+    record_fail();
+}
+
+/=> unexpected error/ {
+    record_unexp();
+}
+
+# Not displaying "skipped" for the moment, as most of the skipped tests
+# print nothing at all and are not counted.
+
+END {
+    if (errored){
+        printf ("\n#### Some fatal error occurred during testing.\n\n");
+        exit (3);
+    }else{
+        printf("\n");
+        printf("Summary:\n");
+        printf("  %3d test(s) passed\n", passed);
+        printf("  %3d test(s) failed\n", failed);
+        printf("  %3d unexpected error(s)\n", unexped);
+        if (failed != 0){
+            printf("\nList of failed tests:\n");
+            for (i=0; i < failed; i++) printf("    %s\n", fail[i]);
+        }
+        if (unexped != 0){
+            printf("\nList of unexpected errors:\n");
+            for (i=0; i < unexped; i++) printf("    %s\n", unexp[i]);
+        }
+        printf("\n");
+        if (failed || unexped){
+            printf("#### Some tests failed. Exiting with error status.\n\n");
+            exit 4;
+        }
+    }
+}
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/.ignore ocaml-4.01.0/testsuite/tests/asmcomp/.ignore
--- ocaml-3.12.1/testsuite/tests/asmcomp/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/.ignore	2011-07-20 15:37:36.000000000 +0000
@@ -0,0 +1,7 @@
+codegen
+parsecmm.ml
+parsecmm.mli
+lexcmm.ml
+*.s
+*.out
+*.out.dSYM
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/.svnignore ocaml-4.01.0/testsuite/tests/asmcomp/.svnignore
--- ocaml-3.12.1/testsuite/tests/asmcomp/.svnignore	2011-05-17 12:08:13.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/.svnignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,17 +0,0 @@
-#!/bin/sh
-
-svn propset svn:ignore -F - . < failed" && exit 1)
-	@echo " => passed"
+	@$(CC) -o $(NAME).out $(ARGS_$(NAME)) $(NAME).o $(ARCH).o \
+	&& echo " => passed" || echo " => failed"
 
 clean: defaultclean
 	@rm -f ./codegen *.out
 	@rm -f parsecmm.ml parsecmm.mli lexcmm.ml
 	@rm -f $(CASES:=.s)
 
+include $(BASEDIR)/makefiles/Makefile.common
+
 power.o: power-$(SYSTEM).o
 	@cp power-$(SYSTEM).o power.o
 
-
-include ../../makefiles/Makefile.common
+promote:
 
 arch: $(ARCH).o
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/alpha.S ocaml-4.01.0/testsuite/tests/asmcomp/alpha.S
--- ocaml-3.12.1/testsuite/tests/asmcomp/alpha.S	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/alpha.S	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -10,8 +10,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: alpha.S 10713 2010-10-08 11:53:19Z doligez $ */
-
         .globl  call_gen_code
         .ent    call_gen_code
 
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/amd64.S ocaml-4.01.0/testsuite/tests/asmcomp/amd64.S
--- ocaml-3.12.1/testsuite/tests/asmcomp/amd64.S	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/amd64.S	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -10,8 +10,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: amd64.S 10713 2010-10-08 11:53:19Z doligez $ */
-
 #ifdef SYS_macosx
 #define ALIGN 4
 #else
@@ -39,12 +37,12 @@
         pushq   %r13
         pushq   %r14
         pushq   %r15
-	movq	%rdi, %r10
-	movq	%rsi, %rax
-	movq	%rdx, %rbx
-	movq	%rcx, %rdi
-	movq	%r8, %rsi
-        call	*%r10
+        movq    %rdi, %r10
+        movq    %rsi, %rax
+        movq    %rdx, %rbx
+        movq    %rcx, %rdi
+        movq    %r8, %rsi
+        call    *%r10
         popq    %r15
         popq    %r14
         popq    %r13
@@ -59,17 +57,19 @@
         jmp     *%rax
 
 #ifdef SYS_macosx
-	.literal16
+        .literal16
+#elif defined(SYS_mingw64)
+        .section        .rodata.cst8
 #else
-	.section	.rodata.cst8,"aM",@progbits,8
+        .section        .rodata.cst8,"aM",@progbits,8
 #endif
         .globl  CAML_NEGF_MASK
         .align  ALIGN
 CAML_NEGF_MASK:
-	.quad	0x8000000000000000, 0
+        .quad   0x8000000000000000, 0
         .globl  CAML_ABSF_MASK
         .align  ALIGN
 CAML_ABSF_MASK:
-	.quad	0x7FFFFFFFFFFFFFFF, 0
+        .quad   0x7FFFFFFFFFFFFFFF, 0
 
         .comm   young_limit, 8
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/arith.cmm ocaml-4.01.0/testsuite/tests/asmcomp/arith.cmm
--- ocaml-3.12.1/testsuite/tests/asmcomp/arith.cmm	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/arith.cmm	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: arith.cmm 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (* Regression test for arithmetic instructions *)
 
 (function "testarith" ()
@@ -217,6 +215,3 @@
       (floataset d 38 (absf f))
 
 )))))))
-
-
-
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/arm.S ocaml-4.01.0/testsuite/tests/asmcomp/arm.S
--- ocaml-3.12.1/testsuite/tests/asmcomp/arm.S	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/arm.S	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -10,8 +10,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: arm.S 10713 2010-10-08 11:53:19Z doligez $ */
-
         .text
 
         .global call_gen_code
@@ -37,4 +35,3 @@
 caml_c_call:
     @ function to call is in r10
         mov     pc, r10
-
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/checkbound.cmm ocaml-4.01.0/testsuite/tests/asmcomp/checkbound.cmm
--- ocaml-3.12.1/testsuite/tests/asmcomp/checkbound.cmm	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/checkbound.cmm	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,12 +10,8 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: checkbound.cmm 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (function "checkbound2" (x: int y: int)
   (checkbound x y))
 
 (function "checkbound1" (x: int)
   (checkbound x 2))
-
-
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/fib.cmm ocaml-4.01.0/testsuite/tests/asmcomp/fib.cmm
--- ocaml-3.12.1/testsuite/tests/asmcomp/fib.cmm	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/fib.cmm	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: fib.cmm 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (function "fib" (n: int)
   (if (< n 2)
       1
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/hppa.S ocaml-4.01.0/testsuite/tests/asmcomp/hppa.S
--- ocaml-3.12.1/testsuite/tests/asmcomp/hppa.S	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/hppa.S	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 ;*********************************************************************
 ;*                                                                   *
-;*                          Objective Caml                           *
+;*                               OCaml                               *
 ;*                                                                   *
 ;*           Xavier Leroy, projet Cristal, INRIA Rocquencourt        *
 ;*                                                                   *
@@ -10,7 +10,6 @@
 ;*                                                                   *
 ;*********************************************************************
 
-; $Id: hppa.S 10713 2010-10-08 11:53:19Z doligez $
 ; Must be preprocessed by cpp
 
 #ifdef SYS_hpux
@@ -32,13 +31,13 @@
 #endif
 
 #ifdef SYS_hpux
-	.space $PRIVATE$
-	.subspa $DATA$,quad=1,align=8,access=31
-	.subspa $BSS$,quad=1,align=8,access=31,zero,sort=82
-	.space $TEXT$
-	.subspa $LIT$,quad=0,align=8,access=44
-	.subspa $CODE$,quad=0,align=8,access=44,code_only
-	.import $global$, data
+        .space $PRIVATE$
+        .subspa $DATA$,quad=1,align=8,access=31
+        .subspa $BSS$,quad=1,align=8,access=31,zero,sort=82
+        .space $TEXT$
+        .subspa $LIT$,quad=0,align=8,access=44
+        .subspa $CODE$,quad=0,align=8,access=44,code_only
+        .import $global$, data
         .import $$dyncall, millicode
 #endif
 
@@ -47,8 +46,8 @@
         EXPORT_CODE(G(call_gen_code))
 G(call_gen_code):
         STARTPROC
-	stw     %r2,-20(%r30)
-        ldo	256(%r30), %r30
+        stw     %r2,-20(%r30)
+        ldo     256(%r30), %r30
 ; Save the callee-save registers
         ldo     -32(%r30), %r1
         stws,ma %r3, -4(%r1)
@@ -67,26 +66,26 @@
         stws,ma %r16, -4(%r1)
         stws,ma %r17, -4(%r1)
         stws,ma %r18, -4(%r1)
-	fstds,ma %fr12, -8(%r1)
-	fstds,ma %fr13, -8(%r1)
-	fstds,ma %fr14, -8(%r1)
-	fstds,ma %fr15, -8(%r1)
-	fstds,ma %fr16, -8(%r1)
-	fstds,ma %fr17, -8(%r1)
-	fstds,ma %fr18, -8(%r1)
-	fstds,ma %fr19, -8(%r1)
-	fstds,ma %fr20, -8(%r1)
-	fstds,ma %fr21, -8(%r1)
-	fstds,ma %fr22, -8(%r1)
-	fstds,ma %fr23, -8(%r1)
-	fstds,ma %fr24, -8(%r1)
-	fstds,ma %fr25, -8(%r1)
-	fstds,ma %fr26, -8(%r1)
-	fstds,ma %fr27, -8(%r1)
-	fstds,ma %fr28, -8(%r1)
-	fstds,ma %fr29, -8(%r1)
-	fstds,ma %fr30, -8(%r1)
-	fstds,ma %fr31, -8(%r1)
+        fstds,ma %fr12, -8(%r1)
+        fstds,ma %fr13, -8(%r1)
+        fstds,ma %fr14, -8(%r1)
+        fstds,ma %fr15, -8(%r1)
+        fstds,ma %fr16, -8(%r1)
+        fstds,ma %fr17, -8(%r1)
+        fstds,ma %fr18, -8(%r1)
+        fstds,ma %fr19, -8(%r1)
+        fstds,ma %fr20, -8(%r1)
+        fstds,ma %fr21, -8(%r1)
+        fstds,ma %fr22, -8(%r1)
+        fstds,ma %fr23, -8(%r1)
+        fstds,ma %fr24, -8(%r1)
+        fstds,ma %fr25, -8(%r1)
+        fstds,ma %fr26, -8(%r1)
+        fstds,ma %fr27, -8(%r1)
+        fstds,ma %fr28, -8(%r1)
+        fstds,ma %fr29, -8(%r1)
+        fstds,ma %fr30, -8(%r1)
+        fstds,ma %fr31, -8(%r1)
 
 ; Shuffle the arguments and call
         copy    %r26, %r22
@@ -121,42 +120,42 @@
         ldws,ma -4(%r1), %r16
         ldws,ma -4(%r1), %r17
         ldws,ma -4(%r1), %r18
-	fldds,ma -8(%r1), %fr12
-	fldds,ma -8(%r1), %fr13
-	fldds,ma -8(%r1), %fr14
-	fldds,ma -8(%r1), %fr15
-	fldds,ma -8(%r1), %fr16
-	fldds,ma -8(%r1), %fr17
-	fldds,ma -8(%r1), %fr18
-	fldds,ma -8(%r1), %fr19
-	fldds,ma -8(%r1), %fr20
-	fldds,ma -8(%r1), %fr21
-	fldds,ma -8(%r1), %fr22
-	fldds,ma -8(%r1), %fr23
-	fldds,ma -8(%r1), %fr24
-	fldds,ma -8(%r1), %fr25
-	fldds,ma -8(%r1), %fr26
-	fldds,ma -8(%r1), %fr27
-	fldds,ma -8(%r1), %fr28
-	fldds,ma -8(%r1), %fr29
-	fldds,ma -8(%r1), %fr30
-	fldds,ma -8(%r1), %fr31
+        fldds,ma -8(%r1), %fr12
+        fldds,ma -8(%r1), %fr13
+        fldds,ma -8(%r1), %fr14
+        fldds,ma -8(%r1), %fr15
+        fldds,ma -8(%r1), %fr16
+        fldds,ma -8(%r1), %fr17
+        fldds,ma -8(%r1), %fr18
+        fldds,ma -8(%r1), %fr19
+        fldds,ma -8(%r1), %fr20
+        fldds,ma -8(%r1), %fr21
+        fldds,ma -8(%r1), %fr22
+        fldds,ma -8(%r1), %fr23
+        fldds,ma -8(%r1), %fr24
+        fldds,ma -8(%r1), %fr25
+        fldds,ma -8(%r1), %fr26
+        fldds,ma -8(%r1), %fr27
+        fldds,ma -8(%r1), %fr28
+        fldds,ma -8(%r1), %fr29
+        fldds,ma -8(%r1), %fr30
+        fldds,ma -8(%r1), %fr31
 
-        ldo	-256(%r30), %r30
-	ldw     -20(%r30), %r2
+        ldo     -256(%r30), %r30
+        ldw     -20(%r30), %r2
         bv      0(%r2)
         nop
         ENDPROC
 
-	.align	CODE_ALIGN
-	EXPORT_CODE(caml_c_call)
+        .align  CODE_ALIGN
+        EXPORT_CODE(caml_c_call)
 G(caml_c_call):
         STARTPROC
 #ifdef SYS_hpux
         bl $$dyncall, %r0
         nop
 #else
-        bv	0(%r22)
+        bv      0(%r22)
         nop
 #endif
         ENDPROC
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/i386.S ocaml-4.01.0/testsuite/tests/asmcomp/i386.S
--- ocaml-3.12.1/testsuite/tests/asmcomp/i386.S	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/i386.S	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -10,12 +10,11 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: i386.S 10713 2010-10-08 11:53:19Z doligez $ */
-
 /* Linux with ELF binaries does not prefix identifiers with _.
    Linux with a.out binaries, FreeBSD, and NextStep do. */
 
-#ifdef SYS_linux_elf
+#if defined(SYS_linux_elf) || defined(SYS_bsd_elf) \
+ || defined(SYS_solaris) || defined(SYS_beos) || defined(SYS_gnu)
 #define G(x) x
 #define FUNCTION_ALIGN 16
 #else
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/i386nt.asm ocaml-4.01.0/testsuite/tests/asmcomp/i386nt.asm
--- ocaml-3.12.1/testsuite/tests/asmcomp/i386nt.asm	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/i386nt.asm	2012-10-15 17:50:56.000000000 +0000
@@ -1,67 +1,65 @@
-;*********************************************************************
-;                                                                     
-;                           Objective Caml                            
-;                                                                     
-;            Xavier Leroy, projet Cristal, INRIA Rocquencourt         
-;                                                                     
-;  Copyright 1996 Institut National de Recherche en Informatique et   
-;  en Automatique.  All rights reserved.  This file is distributed    
-;  under the terms of the Q Public License version 1.0.               
-;                                                                     
-;*********************************************************************
+;*********************************************************************;
+;                                                                     ;
+;                                OCaml                                ;
+;                                                                     ;
+;            Xavier Leroy, projet Cristal, INRIA Rocquencourt         ;
+;                                                                     ;
+;  Copyright 1996 Institut National de Recherche en Informatique et   ;
+;  en Automatique.  All rights reserved.  This file is distributed    ;
+;  under the terms of the Q Public License version 1.0.               ;
+;                                                                     ;
+;*********************************************************************;
 
-; $Id: i386nt.asm 10713 2010-10-08 11:53:19Z doligez $
-
-	.386
-	.MODEL FLAT
+        .386
+        .MODEL FLAT
 
         .CODE
         PUBLIC  _call_gen_code
         ALIGN   4
 _call_gen_code:
-        push	ebp
-        mov	ebp, esp
-        push	ebx
-        push	esi
-        push	edi
-        mov	eax, [ebp+12]
-        mov	ebx, [ebp+16]
-        mov	ecx, [ebp+20]
-        mov	edx, [ebp+24]
-        call	DWORD PTR [ebp+8]
-        pop	edi
-        pop	esi
-        pop	ebx
-        pop	ebp
-        ret	
+        push    ebp
+        mov     ebp, esp
+        push    ebx
+        push    esi
+        push    edi
+        mov     eax, [ebp+12]
+        mov     ebx, [ebp+16]
+        mov     ecx, [ebp+20]
+        mov     edx, [ebp+24]
+        call    DWORD PTR [ebp+8]
+        pop     edi
+        pop     esi
+        pop     ebx
+        pop     ebp
+        ret
 
         PUBLIC  _caml_c_call
         ALIGN   4
 _caml_c_call:
-        ffree	st(0)
-        ffree	st(1)
-        ffree	st(2)
-        ffree	st(3)
-        jmp	eax
+        ffree   st(0)
+        ffree   st(1)
+        ffree   st(2)
+        ffree   st(3)
+        jmp     eax
 
         PUBLIC  _caml_call_gc
         PUBLIC  _caml_alloc
         PUBLIC  _caml_alloc1
         PUBLIC  _caml_alloc2
-        PUBLIC  _caml_alloc3       
+        PUBLIC  _caml_alloc3
 _caml_call_gc:
 _caml_alloc:
 _caml_alloc1:
 _caml_alloc2:
 _caml_alloc3:
-        int     3      
+        int     3
 
         .DATA
-        PUBLIC	_caml_exception_pointer
-_caml_exception_pointer	dword 0
-        PUBLIC	_young_ptr
-_young_ptr	dword 0
-        PUBLIC	_young_limit
-_young_limit	dword 0
+        PUBLIC  _caml_exception_pointer
+_caml_exception_pointer dword 0
+        PUBLIC  _young_ptr
+_young_ptr      dword 0
+        PUBLIC  _young_limit
+_young_limit    dword 0
 
         END
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/ia64.S ocaml-4.01.0/testsuite/tests/asmcomp/ia64.S
--- ocaml-3.12.1/testsuite/tests/asmcomp/ia64.S	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/ia64.S	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -10,8 +10,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: ia64.S 10713 2010-10-08 11:53:19Z doligez $ */
-
 #define ST8OFF(a,b,d) st8 [a] = b, d
 #define LD8OFF(a,b,d) ld8 a = [b], d
 #define STFDOFF(a,b,d) stfd [a] = b, d
@@ -26,7 +24,7 @@
         .proc   call_gen_code#
 
 call_gen_code:
-        /* Allocate 64 "out" registers (for the Caml code) and no locals */
+        /* Allocate 64 "out" registers (for the OCaml code) and no locals */
         alloc   r3 = ar.pfs, 0, 0, 64, 0
 
         /* Save PFS, return address and GP on stack */
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/integr.cmm ocaml-4.01.0/testsuite/tests/asmcomp/integr.cmm
--- ocaml-3.12.1/testsuite/tests/asmcomp/integr.cmm	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/integr.cmm	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: integr.cmm 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (function "square" (x: float)
    ( *f x x))
 
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/lexcmm.mli ocaml-4.01.0/testsuite/tests/asmcomp/lexcmm.mli
--- ocaml-3.12.1/testsuite/tests/asmcomp/lexcmm.mli	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/lexcmm.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: lexcmm.mli 10713 2010-10-08 11:53:19Z doligez $ *)
-
 val token: Lexing.lexbuf -> Parsecmm.token
 
 type error =
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/lexcmm.mll ocaml-4.01.0/testsuite/tests/asmcomp/lexcmm.mll
--- ocaml-3.12.1/testsuite/tests/asmcomp/lexcmm.mll	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/lexcmm.mll	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: lexcmm.mll 10713 2010-10-08 11:53:19Z doligez $ *)
-
 {
 open Parsecmm
 
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/m68k.S ocaml-4.01.0/testsuite/tests/asmcomp/m68k.S
--- ocaml-3.12.1/testsuite/tests/asmcomp/m68k.S	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/m68k.S	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 |***********************************************************************
 |*                                                                     *
-|*                           Objective Caml                            *
+|*                                OCaml                                *
 |*                                                                     *
 |*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *
 |*                                                                     *
@@ -10,8 +10,6 @@
 |*                                                                     *
 |***********************************************************************
 
-| $Id: m68k.S 10713 2010-10-08 11:53:19Z doligez $
-
 | call_gen_code is used with the following types:
 |       unit -> int
 |       int -> int
@@ -19,7 +17,7 @@
 |       int * int * address -> void
 |       int * int -> void
 |       unit -> unit
-| Hence arg1 -> d0, arg2 -> d1, arg3 -> a0, 
+| Hence arg1 -> d0, arg2 -> d1, arg3 -> a0,
 | and we need a special case for int -> double
 
         .text
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/main.c ocaml-4.01.0/testsuite/tests/asmcomp/main.c
--- ocaml-3.12.1/testsuite/tests/asmcomp/main.c	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/main.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -10,8 +10,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: main.c 10713 2010-10-08 11:53:19Z doligez $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/main.ml ocaml-4.01.0/testsuite/tests/asmcomp/main.ml
--- ocaml-3.12.1/testsuite/tests/asmcomp/main.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/main.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: main.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 open Clflags
 
 let compile_file filename =
@@ -21,7 +19,8 @@
   let lb = Lexing.from_channel ic in
   try
     while true do
-      Asmgen.compile_phrase Format.std_formatter (Parsecmm.phrase Lexcmm.token lb)
+      Asmgen.compile_phrase Format.std_formatter
+                            (Parsecmm.phrase Lexcmm.token lb)
     done
   with
       End_of_file ->
@@ -57,4 +56,3 @@
     ] compile_file usage
 
 let _ = (*Printexc.catch*) main (); exit 0
-
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/mainarith.c ocaml-4.01.0/testsuite/tests/asmcomp/mainarith.c
--- ocaml-3.12.1/testsuite/tests/asmcomp/mainarith.c	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/mainarith.c	2013-05-03 08:27:42.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -10,35 +10,36 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: mainarith.c 10713 2010-10-08 11:53:19Z doligez $ */
-
 #include 
 #include 
 #include 
 #include 
 #include 
 
+#include "../../../byterun/config.h"
+#define FMT ARCH_INTNAT_PRINTF_FORMAT
+
 void caml_ml_array_bound_error(void)
 {
   fprintf(stderr, "Fatal error: out-of-bound access in array or string\n");
   exit(2);
 }
 
-long R[200];
+intnat R[200];
 double D[40];
-long X, Y;
+intnat X, Y;
 double F, G;
 
 #define INTTEST(arg,res) \
-  { long result = (res); \
+  { intnat result = (res); \
     if (arg != result) \
-      printf("Failed test \"%s == %s\" for X=%ld and Y=%ld: result %ld, expected %ld\n", \
+      printf("Failed test \"%s == %s\" for X=%"FMT"d and Y=%"FMT"d: result %"FMT"d, expected %"FMT"d\n", \
              #arg, #res, X, Y, arg, result); \
   }
 #define INTFLOATTEST(arg,res) \
-  { long result = (res); \
+  { intnat result = (res); \
     if (arg != result) \
-      printf("Failed test \"%s == %s\" for F=%.15g and G=%.15g: result %ld, expected %ld\n", \
+      printf("Failed test \"%s == %s\" for F=%.15g and G=%.15g: result %"FMT"d, expected %"FMT"d\n", \
              #arg, #res, F, G, arg, result); \
   }
 #define FLOATTEST(arg,res) \
@@ -50,7 +51,7 @@
 #define FLOATINTTEST(arg,res) \
   { double result = (res); \
     if (arg < result || arg > result) \
-      printf("Failed test \"%s == %s\" for X=%ld and Y=%ld: result %.15g, expected %.15g\n", \
+      printf("Failed test \"%s == %s\" for X=%"FMT"d and Y=%"FMT"d: result %.15g, expected %.15g\n", \
              #arg, #res, X, Y, arg, result); \
   }
 
@@ -75,15 +76,15 @@
       INTTEST(R[10], (X + 1));
       INTTEST(R[11], (X + -1));
 
-      INTTEST(R[12], ((long) ((char *)R + 8)));
-      INTTEST(R[13], ((long) ((char *)R + Y)));
+      INTTEST(R[12], ((intnat) ((char *)R + 8)));
+      INTTEST(R[13], ((intnat) ((char *)R + Y)));
 
       INTTEST(R[14], (X - Y));
       INTTEST(R[15], (X - 1));
       INTTEST(R[16], (X - -1));
 
-      INTTEST(R[17], ((long) ((char *)R - 8)));
-      INTTEST(R[18], ((long) ((char *)R - Y)));
+      INTTEST(R[17], ((intnat) ((char *)R - 8)));
+      INTTEST(R[18], ((intnat) ((char *)R - Y)));
 
       INTTEST(R[19], (X * 2));
       INTTEST(R[20], (2 * X));
@@ -118,9 +119,9 @@
       INTTEST(R[43], (X << 1));
       INTTEST(R[44], (X << 8));
 
-      INTTEST(R[45], ((unsigned long) X >> Y));
-      INTTEST(R[46], ((unsigned long) X >> 1));
-      INTTEST(R[47], ((unsigned long) X >> 8));
+      INTTEST(R[45], ((uintnat) X >> Y));
+      INTTEST(R[46], ((uintnat) X >> 1));
+      INTTEST(R[47], ((uintnat) X >> 8));
 
       INTTEST(R[48], (X >> Y));
       INTTEST(R[49], (X >> 1));
@@ -190,7 +191,7 @@
       INTFLOATTEST(R[86], (F >= G));
 
       FLOATINTTEST(D[19], (double) X);
-      INTFLOATTEST(R[87], (long) F);
+      INTFLOATTEST(R[87], (intnat) F);
 
       INTTEST(R[88], (X >= 0) && (X < Y));
       INTTEST(R[89], (0 < Y));
@@ -225,7 +226,7 @@
       INTFLOATTEST(R[114], (F + 1.0 >= G));
 
       FLOATINTTEST(D[20], ((double) X) + 1.0);
-      INTFLOATTEST(R[115], (long)(F + 1.0));
+      INTFLOATTEST(R[115], (intnat)(F + 1.0));
 
       FLOATTEST(D[21], F + G);
       FLOATTEST(D[22], G + F);
@@ -304,4 +305,3 @@
   }
   return 0;
 }
-
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/mips.s ocaml-4.01.0/testsuite/tests/asmcomp/mips.s
--- ocaml-3.12.1/testsuite/tests/asmcomp/mips.s	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/mips.s	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -10,8 +10,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: mips.s 10713 2010-10-08 11:53:19Z doligez $ */
-
         .globl  call_gen_code
         .ent    call_gen_code
 call_gen_code:
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/parsecmm.mly ocaml-4.01.0/testsuite/tests/asmcomp/parsecmm.mly
--- ocaml-3.12.1/testsuite/tests/asmcomp/parsecmm.mly	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/parsecmm.mly	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -10,8 +10,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: parsecmm.mly 10713 2010-10-08 11:53:19Z doligez $ */
-
 /* A simple parser for C-- */
 
 %{
@@ -149,7 +147,8 @@
 fundecl:
     LPAREN FUNCTION STRING LPAREN params RPAREN sequence RPAREN
       { List.iter (fun (id, ty) -> unbind_ident id) $5;
-        {fun_name = $3; fun_args = $5; fun_body = $7; fun_fast = true} }
+        {fun_name = $3; fun_args = $5; fun_body = $7; fun_fast = true;
+         fun_dbg = Debuginfo.none} }
 ;
 params:
     oneparam params     { $1 :: $2 }
@@ -324,4 +323,3 @@
   | SKIP INTCONST               { Cskip $2 }
   | ALIGN INTCONST              { Calign $2 }
 ;
-
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/parsecmmaux.ml ocaml-4.01.0/testsuite/tests/asmcomp/parsecmmaux.ml
--- ocaml-3.12.1/testsuite/tests/asmcomp/parsecmmaux.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/parsecmmaux.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: parsecmmaux.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (* Auxiliary functions for parsing *)
 
 type error =
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/parsecmmaux.mli ocaml-4.01.0/testsuite/tests/asmcomp/parsecmmaux.mli
--- ocaml-3.12.1/testsuite/tests/asmcomp/parsecmmaux.mli	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/parsecmmaux.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: parsecmmaux.mli 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (* Auxiliary functions for parsing *)
 
 val bind_ident: string -> Ident.t
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/power-aix.S ocaml-4.01.0/testsuite/tests/asmcomp/power-aix.S
--- ocaml-3.12.1/testsuite/tests/asmcomp/power-aix.S	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/power-aix.S	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 #*********************************************************************
 #*                                                                   *
-#*                          Objective Caml                           *
+#*                               OCaml                               *
 #*                                                                   *
 #*           Xavier Leroy, projet Cristal, INRIA Rocquencourt        *
 #*                                                                   *
@@ -10,8 +10,6 @@
 #*                                                                   *
 #*********************************************************************
 
-# $Id: power-aix.S 10713 2010-10-08 11:53:19Z doligez $
-
         .csect  .text[PR]
 
         .globl  .call_gen_code
@@ -123,7 +121,7 @@
         .globl  .caml_c_call
 .caml_c_call:
 # Preserve RTOC and return address in callee-save registers
-# The C function will preserve them, and the Caml code does not
+# The C function will preserve them, and the OCaml code does not
 # expect them to be preserved
 # Return address is in 25, RTOC is in 26
         mflr    25
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/power-elf.S ocaml-4.01.0/testsuite/tests/asmcomp/power-elf.S
--- ocaml-3.12.1/testsuite/tests/asmcomp/power-elf.S	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/power-elf.S	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /*********************************************************************/
 /*                                                                   */
-/*                          Objective Caml                           */
+/*                               OCaml                               */
 /*                                                                   */
 /*           Xavier Leroy, projet Cristal, INRIA Rocquencourt        */
 /*                                                                   */
@@ -10,8 +10,6 @@
 /*                                                                   */
 /*********************************************************************/
 
-/* $Id: power-elf.S 10713 2010-10-08 11:53:19Z doligez $ */
-
 /* Save and restore all callee-save registers */
 /* GPR 14 at sp+16 ... GPR 31 at sp+84
    FPR 14 at sp+92 ... FPR 31 at sp+228 */
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/power-rhapsody.S ocaml-4.01.0/testsuite/tests/asmcomp/power-rhapsody.S
--- ocaml-3.12.1/testsuite/tests/asmcomp/power-rhapsody.S	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/power-rhapsody.S	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /*********************************************************************/
 /*                                                                   */
-/*                          Objective Caml                           */
+/*                               OCaml                               */
 /*                                                                   */
 /*           Xavier Leroy, projet Cristal, INRIA Rocquencourt        */
 /*                                                                   */
@@ -10,8 +10,6 @@
 /*                                                                   */
 /*********************************************************************/
 
-/* $Id: power-rhapsody.S 10713 2010-10-08 11:53:19Z doligez $ */
-
 /* Save and restore all callee-save registers */
 /* GPR 14 at sp+16 ... GPR 31 at sp+84
    FPR 14 at sp+92 ... FPR 31 at sp+228 */
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/quicksort.cmm ocaml-4.01.0/testsuite/tests/asmcomp/quicksort.cmm
--- ocaml-3.12.1/testsuite/tests/asmcomp/quicksort.cmm	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/quicksort.cmm	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: quicksort.cmm 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (function "quicksort" (lo: int hi: int a: addr)
   (if (< lo hi)
       (let (i lo
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/quicksort2.cmm ocaml-4.01.0/testsuite/tests/asmcomp/quicksort2.cmm
--- ocaml-3.12.1/testsuite/tests/asmcomp/quicksort2.cmm	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/quicksort2.cmm	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: quicksort2.cmm 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (function "cmp" (i: int j: int)
   (- i j))
 
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/soli.cmm ocaml-4.01.0/testsuite/tests/asmcomp/soli.cmm
--- ocaml-3.12.1/testsuite/tests/asmcomp/soli.cmm	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/soli.cmm	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: soli.cmm 10713 2010-10-08 11:53:19Z doligez $ *)
-
 ("d1": int 0 int 1
  "d2": int 1 int 0
  "d3": int 0 int -1
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/sparc.S ocaml-4.01.0/testsuite/tests/asmcomp/sparc.S
--- ocaml-3.12.1/testsuite/tests/asmcomp/sparc.S	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/sparc.S	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -10,9 +10,7 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: sparc.S 10713 2010-10-08 11:53:19Z doligez $ */
-
-#ifndef SYS_solaris
+#if defined(SYS_solaris) || defined(SYS_elf)
 #define Call_gen_code _call_gen_code
 #define Caml_c_call _caml_c_call
 #else
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/tagged-fib.cmm ocaml-4.01.0/testsuite/tests/asmcomp/tagged-fib.cmm
--- ocaml-3.12.1/testsuite/tests/asmcomp/tagged-fib.cmm	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/tagged-fib.cmm	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,10 +10,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: tagged-fib.cmm 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (function "fib" (n: int)
   (if (< n 5)
       3
     (-  (+ (app "fib" (- n 2) int) (app "fib" (- n 4) int)) 1)))
-
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/tagged-integr.cmm ocaml-4.01.0/testsuite/tests/asmcomp/tagged-integr.cmm
--- ocaml-3.12.1/testsuite/tests/asmcomp/tagged-integr.cmm	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/tagged-integr.cmm	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: tagged-integr.cmm 10713 2010-10-08 11:53:19Z doligez $ *)
-
 ("res_square": skip 8)
 ("h": skip 8)
 ("x": skip 8)
@@ -42,4 +40,3 @@
   (store float "low" 0.0)
   (store float "hi" 1.0)
   (load float (app "integr" "square" "low" "hi" n addr)))
-
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/tagged-quicksort.cmm ocaml-4.01.0/testsuite/tests/asmcomp/tagged-quicksort.cmm
--- ocaml-3.12.1/testsuite/tests/asmcomp/tagged-quicksort.cmm	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/tagged-quicksort.cmm	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: tagged-quicksort.cmm 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (function "quick" (lo: int hi: int a: addr)
   (if (< lo hi)
       (let (i lo
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/tagged-tak.cmm ocaml-4.01.0/testsuite/tests/asmcomp/tagged-tak.cmm
--- ocaml-3.12.1/testsuite/tests/asmcomp/tagged-tak.cmm	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/tagged-tak.cmm	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: tagged-tak.cmm 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (function "tak" (x:int y:int z:int)
   (if (> x y)
       (app "tak" (app "tak" (- x 2) y z int)
diff -Nru ocaml-3.12.1/testsuite/tests/asmcomp/tak.cmm ocaml-4.01.0/testsuite/tests/asmcomp/tak.cmm
--- ocaml-3.12.1/testsuite/tests/asmcomp/tak.cmm	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/asmcomp/tak.cmm	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: tak.cmm 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (function "tak" (x:int y:int z:int)
   (if (> x y)
       (app "tak" (app "tak" (- x 1) y z int)
diff -Nru ocaml-3.12.1/testsuite/tests/backtrace/Makefile ocaml-4.01.0/testsuite/tests/backtrace/Makefile
--- ocaml-3.12.1/testsuite/tests/backtrace/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/backtrace/Makefile	2013-06-19 15:18:05.000000000 +0000
@@ -1,16 +1,80 @@
-EXECNAME=./program
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
 
-run-all:
-	@for file in *.ml; do \
+BASEDIR=../..
+EXECNAME=program$(EXE)
+
+ABCDFILES=backtrace.ml
+OTHERFILES=backtrace2.ml raw_backtrace.ml
+
+default:
+	$(MAKE) byte
+	@if $(BYTECODE_ONLY); then : ; else $(MAKE) native; fi
+
+.PHONY: byte
+byte:
+	@for file in $(ABCDFILES); do \
+	  rm -f program program.exe; \
 	  $(OCAMLC) -g -o $(EXECNAME) $$file; \
 	  for arg in a b c d ''; do \
-	    printf " ... testing '$$file' (with argument '$$arg'):"; \
-	    OCAMLRUNPARAM=b=1 $(EXECNAME) $$arg > `basename $$file ml`$$arg.result 2>&1; \
-	    diff -q `basename $$file ml`$$arg.reference `basename $$file ml`$$arg.result > /dev/null && echo " => passed" || (echo " => failed" && exit 1); \
+	    printf " ... testing '$$file' with ocamlc and argument '$$arg':"; \
+	    F="`basename $$file .ml`"; \
+	    (OCAMLRUNPARAM=b=1 $(OCAMLRUN) $(EXECNAME) $$arg || true) \
+	         >$$F.$$arg.byte.result 2>&1; \
+	    $(DIFF) $$F.$$arg.reference $$F.$$arg.byte.result >/dev/null \
+	    && echo " => passed" || echo " => failed"; \
 	  done; \
 	done
+	@for file in $(OTHERFILES); do \
+	  rm -f program program.exe; \
+	  $(OCAMLC) -g -o $(EXECNAME) $$file; \
+	  printf " ... testing '$$file' with ocamlc:"; \
+	  F="`basename $$file .ml`"; \
+	  (OCAMLRUNPARAM=b=1 $(OCAMLRUN) $(EXECNAME) $$arg || true) \
+	       >$$F.byte.result 2>&1; \
+	  $(DIFF) $$F.reference $$F.byte.result >/dev/null \
+	  && echo " => passed" || echo " => failed"; \
+	done
+
+.PHONY: native
+native:
+	@for file in $(ABCDFILES); do \
+	  rm -f program program.exe; \
+	  $(OCAMLOPT) -g -o $(EXECNAME) $$file; \
+	  for arg in a b c d ''; do \
+	    printf " ... testing '$$file' with ocamlopt and argument '$$arg':"; \
+	    F="`basename $$file .ml`"; \
+	    (OCAMLRUNPARAM=b=1 ./$(EXECNAME) $$arg || true) \
+	         >$$F.$$arg.native.result 2>&1; \
+	    $(DIFF) $$F.$$arg.reference $$F.$$arg.native.result >/dev/null \
+	    && echo " => passed" || echo " => failed"; \
+	  done; \
+	done
+	@for file in $(OTHERFILES); do \
+	  rm -f program program.exe; \
+	  $(OCAMLOPT) -g -o $(EXECNAME) $$file; \
+	  printf " ... testing '$$file' with ocamlc:"; \
+	  F="`basename $$file .ml`"; \
+	  (OCAMLRUNPARAM=b=1 ./$(EXECNAME) $$arg || true) \
+	       >$$F.native.result 2>&1; \
+	  $(DIFF) $$F.reference $$F.native.result >/dev/null \
+	  && echo " => passed" || echo " => failed"; \
+	done
+
+.PHONY: promote
+promote: defaultpromote
 
+.PHONY: clean
 clean: defaultclean
-	@rm -f *.result $(EXECNAME)
+	@rm -f *.result program program.exe
 
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/backtrace/backtrace..reference ocaml-4.01.0/testsuite/tests/backtrace/backtrace..reference
--- ocaml-3.12.1/testsuite/tests/backtrace/backtrace..reference	2010-01-25 13:59:39.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/backtrace/backtrace..reference	2012-10-17 20:09:16.000000000 +0000
@@ -1,2 +1,2 @@
 Fatal error: exception Invalid_argument("index out of bounds")
-Raised by primitive operation at file "backtrace.ml", line 17, characters 12-24
+Raised by primitive operation at file "backtrace.ml", line 29, characters 12-24
diff -Nru ocaml-3.12.1/testsuite/tests/backtrace/backtrace.b.reference ocaml-4.01.0/testsuite/tests/backtrace/backtrace.b.reference
--- ocaml-3.12.1/testsuite/tests/backtrace/backtrace.b.reference	2010-01-25 13:59:39.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/backtrace/backtrace.b.reference	2012-10-17 20:09:16.000000000 +0000
@@ -1,11 +1,11 @@
 b
 Fatal error: exception Backtrace.Error("b")
-Raised at file "backtrace.ml", line 6, characters 21-32
-Called from file "backtrace.ml", line 6, characters 42-53
-Called from file "backtrace.ml", line 6, characters 42-53
-Called from file "backtrace.ml", line 6, characters 42-53
-Called from file "backtrace.ml", line 6, characters 42-53
-Called from file "backtrace.ml", line 6, characters 42-53
-Called from file "backtrace.ml", line 10, characters 4-11
-Re-raised at file "backtrace.ml", line 12, characters 68-71
-Called from file "backtrace.ml", line 17, characters 9-25
+Raised at file "backtrace.ml", line 18, characters 21-32
+Called from file "backtrace.ml", line 18, characters 42-53
+Called from file "backtrace.ml", line 18, characters 42-53
+Called from file "backtrace.ml", line 18, characters 42-53
+Called from file "backtrace.ml", line 18, characters 42-53
+Called from file "backtrace.ml", line 18, characters 42-53
+Called from file "backtrace.ml", line 22, characters 4-11
+Re-raised at file "backtrace.ml", line 24, characters 68-71
+Called from file "backtrace.ml", line 29, characters 9-25
diff -Nru ocaml-3.12.1/testsuite/tests/backtrace/backtrace.c.reference ocaml-4.01.0/testsuite/tests/backtrace/backtrace.c.reference
--- ocaml-3.12.1/testsuite/tests/backtrace/backtrace.c.reference	2010-01-25 13:59:39.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/backtrace/backtrace.c.reference	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,3 @@
 Fatal error: exception Backtrace.Error("c")
-Raised at file "backtrace.ml", line 13, characters 26-37
-Called from file "backtrace.ml", line 17, characters 9-25
+Raised at file "backtrace.ml", line 25, characters 26-37
+Called from file "backtrace.ml", line 29, characters 9-25
diff -Nru ocaml-3.12.1/testsuite/tests/backtrace/backtrace.d.reference ocaml-4.01.0/testsuite/tests/backtrace/backtrace.d.reference
--- ocaml-3.12.1/testsuite/tests/backtrace/backtrace.d.reference	2010-01-25 13:59:39.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/backtrace/backtrace.d.reference	2012-10-17 20:09:16.000000000 +0000
@@ -1,9 +1,9 @@
 Fatal error: exception Backtrace.Error("d")
-Raised at file "backtrace.ml", line 6, characters 21-32
-Called from file "backtrace.ml", line 6, characters 42-53
-Called from file "backtrace.ml", line 6, characters 42-53
-Called from file "backtrace.ml", line 6, characters 42-53
-Called from file "backtrace.ml", line 6, characters 42-53
-Called from file "backtrace.ml", line 6, characters 42-53
-Called from file "backtrace.ml", line 10, characters 4-11
-Called from file "backtrace.ml", line 17, characters 9-25
+Raised at file "backtrace.ml", line 18, characters 21-32
+Called from file "backtrace.ml", line 18, characters 42-53
+Called from file "backtrace.ml", line 18, characters 42-53
+Called from file "backtrace.ml", line 18, characters 42-53
+Called from file "backtrace.ml", line 18, characters 42-53
+Called from file "backtrace.ml", line 18, characters 42-53
+Called from file "backtrace.ml", line 22, characters 4-11
+Called from file "backtrace.ml", line 29, characters 9-25
diff -Nru ocaml-3.12.1/testsuite/tests/backtrace/backtrace.ml ocaml-4.01.0/testsuite/tests/backtrace/backtrace.ml
--- ocaml-3.12.1/testsuite/tests/backtrace/backtrace.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/backtrace/backtrace.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* A test for stack backtraces *)
 
 exception Error of string
diff -Nru ocaml-3.12.1/testsuite/tests/backtrace/backtrace2..reference ocaml-4.01.0/testsuite/tests/backtrace/backtrace2..reference
--- ocaml-3.12.1/testsuite/tests/backtrace/backtrace2..reference	2010-01-25 13:59:39.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/backtrace/backtrace2..reference	1970-01-01 00:00:00.000000000 +0000
@@ -1,27 +0,0 @@
-a
-No exception
-b
-Uncaught exception Backtrace2.Error("b")
-Raised at file "backtrace2.ml", line 6, characters 21-32
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 10, characters 4-11
-Re-raised at file "backtrace2.ml", line 12, characters 68-71
-Called from file "backtrace2.ml", line 17, characters 11-23
-Uncaught exception Backtrace2.Error("c")
-Raised at file "backtrace2.ml", line 13, characters 26-37
-Called from file "backtrace2.ml", line 17, characters 11-23
-Uncaught exception Backtrace2.Error("d")
-Raised at file "backtrace2.ml", line 6, characters 21-32
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 10, characters 4-11
-Called from file "backtrace2.ml", line 17, characters 11-23
-Uncaught exception Invalid_argument("index out of bounds")
-Raised by primitive operation at file "backtrace2.ml", line 17, characters 14-22
diff -Nru ocaml-3.12.1/testsuite/tests/backtrace/backtrace2.a.reference ocaml-4.01.0/testsuite/tests/backtrace/backtrace2.a.reference
--- ocaml-3.12.1/testsuite/tests/backtrace/backtrace2.a.reference	2010-01-25 13:59:39.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/backtrace/backtrace2.a.reference	1970-01-01 00:00:00.000000000 +0000
@@ -1,27 +0,0 @@
-a
-No exception
-b
-Uncaught exception Backtrace2.Error("b")
-Raised at file "backtrace2.ml", line 6, characters 21-32
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 10, characters 4-11
-Re-raised at file "backtrace2.ml", line 12, characters 68-71
-Called from file "backtrace2.ml", line 17, characters 11-23
-Uncaught exception Backtrace2.Error("c")
-Raised at file "backtrace2.ml", line 13, characters 26-37
-Called from file "backtrace2.ml", line 17, characters 11-23
-Uncaught exception Backtrace2.Error("d")
-Raised at file "backtrace2.ml", line 6, characters 21-32
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 10, characters 4-11
-Called from file "backtrace2.ml", line 17, characters 11-23
-Uncaught exception Invalid_argument("index out of bounds")
-Raised by primitive operation at file "backtrace2.ml", line 17, characters 14-22
diff -Nru ocaml-3.12.1/testsuite/tests/backtrace/backtrace2.b.reference ocaml-4.01.0/testsuite/tests/backtrace/backtrace2.b.reference
--- ocaml-3.12.1/testsuite/tests/backtrace/backtrace2.b.reference	2010-01-25 13:59:39.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/backtrace/backtrace2.b.reference	1970-01-01 00:00:00.000000000 +0000
@@ -1,27 +0,0 @@
-a
-No exception
-b
-Uncaught exception Backtrace2.Error("b")
-Raised at file "backtrace2.ml", line 6, characters 21-32
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 10, characters 4-11
-Re-raised at file "backtrace2.ml", line 12, characters 68-71
-Called from file "backtrace2.ml", line 17, characters 11-23
-Uncaught exception Backtrace2.Error("c")
-Raised at file "backtrace2.ml", line 13, characters 26-37
-Called from file "backtrace2.ml", line 17, characters 11-23
-Uncaught exception Backtrace2.Error("d")
-Raised at file "backtrace2.ml", line 6, characters 21-32
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 10, characters 4-11
-Called from file "backtrace2.ml", line 17, characters 11-23
-Uncaught exception Invalid_argument("index out of bounds")
-Raised by primitive operation at file "backtrace2.ml", line 17, characters 14-22
diff -Nru ocaml-3.12.1/testsuite/tests/backtrace/backtrace2.c.reference ocaml-4.01.0/testsuite/tests/backtrace/backtrace2.c.reference
--- ocaml-3.12.1/testsuite/tests/backtrace/backtrace2.c.reference	2010-01-25 13:59:39.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/backtrace/backtrace2.c.reference	1970-01-01 00:00:00.000000000 +0000
@@ -1,27 +0,0 @@
-a
-No exception
-b
-Uncaught exception Backtrace2.Error("b")
-Raised at file "backtrace2.ml", line 6, characters 21-32
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 10, characters 4-11
-Re-raised at file "backtrace2.ml", line 12, characters 68-71
-Called from file "backtrace2.ml", line 17, characters 11-23
-Uncaught exception Backtrace2.Error("c")
-Raised at file "backtrace2.ml", line 13, characters 26-37
-Called from file "backtrace2.ml", line 17, characters 11-23
-Uncaught exception Backtrace2.Error("d")
-Raised at file "backtrace2.ml", line 6, characters 21-32
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 10, characters 4-11
-Called from file "backtrace2.ml", line 17, characters 11-23
-Uncaught exception Invalid_argument("index out of bounds")
-Raised by primitive operation at file "backtrace2.ml", line 17, characters 14-22
diff -Nru ocaml-3.12.1/testsuite/tests/backtrace/backtrace2.d.reference ocaml-4.01.0/testsuite/tests/backtrace/backtrace2.d.reference
--- ocaml-3.12.1/testsuite/tests/backtrace/backtrace2.d.reference	2010-01-25 13:59:39.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/backtrace/backtrace2.d.reference	1970-01-01 00:00:00.000000000 +0000
@@ -1,27 +0,0 @@
-a
-No exception
-b
-Uncaught exception Backtrace2.Error("b")
-Raised at file "backtrace2.ml", line 6, characters 21-32
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 10, characters 4-11
-Re-raised at file "backtrace2.ml", line 12, characters 68-71
-Called from file "backtrace2.ml", line 17, characters 11-23
-Uncaught exception Backtrace2.Error("c")
-Raised at file "backtrace2.ml", line 13, characters 26-37
-Called from file "backtrace2.ml", line 17, characters 11-23
-Uncaught exception Backtrace2.Error("d")
-Raised at file "backtrace2.ml", line 6, characters 21-32
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 6, characters 42-53
-Called from file "backtrace2.ml", line 10, characters 4-11
-Called from file "backtrace2.ml", line 17, characters 11-23
-Uncaught exception Invalid_argument("index out of bounds")
-Raised by primitive operation at file "backtrace2.ml", line 17, characters 14-22
diff -Nru ocaml-3.12.1/testsuite/tests/backtrace/backtrace2.ml ocaml-4.01.0/testsuite/tests/backtrace/backtrace2.ml
--- ocaml-3.12.1/testsuite/tests/backtrace/backtrace2.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/backtrace/backtrace2.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2008 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* A test for stack backtraces *)
 
 exception Error of string
diff -Nru ocaml-3.12.1/testsuite/tests/backtrace/backtrace2.reference ocaml-4.01.0/testsuite/tests/backtrace/backtrace2.reference
--- ocaml-3.12.1/testsuite/tests/backtrace/backtrace2.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/backtrace/backtrace2.reference	2013-06-19 14:26:10.000000000 +0000
@@ -0,0 +1,27 @@
+a
+No exception
+b
+Uncaught exception Backtrace2.Error("b")
+Raised at file "backtrace2.ml", line 18, characters 21-32
+Called from file "backtrace2.ml", line 18, characters 42-53
+Called from file "backtrace2.ml", line 18, characters 42-53
+Called from file "backtrace2.ml", line 18, characters 42-53
+Called from file "backtrace2.ml", line 18, characters 42-53
+Called from file "backtrace2.ml", line 18, characters 42-53
+Called from file "backtrace2.ml", line 22, characters 4-11
+Re-raised at file "backtrace2.ml", line 24, characters 68-71
+Called from file "backtrace2.ml", line 29, characters 11-23
+Uncaught exception Backtrace2.Error("c")
+Raised at file "backtrace2.ml", line 25, characters 26-37
+Called from file "backtrace2.ml", line 29, characters 11-23
+Uncaught exception Backtrace2.Error("d")
+Raised at file "backtrace2.ml", line 18, characters 21-32
+Called from file "backtrace2.ml", line 18, characters 42-53
+Called from file "backtrace2.ml", line 18, characters 42-53
+Called from file "backtrace2.ml", line 18, characters 42-53
+Called from file "backtrace2.ml", line 18, characters 42-53
+Called from file "backtrace2.ml", line 18, characters 42-53
+Called from file "backtrace2.ml", line 22, characters 4-11
+Called from file "backtrace2.ml", line 29, characters 11-23
+Uncaught exception Invalid_argument("index out of bounds")
+Raised by primitive operation at file "backtrace2.ml", line 29, characters 14-22
diff -Nru ocaml-3.12.1/testsuite/tests/backtrace/raw_backtrace.ml ocaml-4.01.0/testsuite/tests/backtrace/raw_backtrace.ml
--- ocaml-3.12.1/testsuite/tests/backtrace/raw_backtrace.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/backtrace/raw_backtrace.ml	2013-07-23 14:48:47.000000000 +0000
@@ -0,0 +1,52 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2008 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* A test for stack backtraces *)
+
+exception Error of string
+
+let rec f msg n =
+  if n = 0 then raise(Error msg) else 1 + f msg (n-1)
+
+let g msg =
+  try
+    f msg 5
+  with Error "a" -> print_string "a"; print_newline(); 0
+     | Error "b" as exn -> print_string "b"; print_newline(); raise exn
+     | Error "c" -> raise (Error "c")
+
+let backtrace args =
+  try
+    ignore (g args.(0)); None
+  with exn ->
+    let exn = Printexc.to_string exn in
+    let trace = Printexc.get_raw_backtrace () in
+    Some (exn, trace)
+
+let run args =
+  match backtrace args with
+    | None -> print_string "No exception\n"
+    | Some (exn, trace) ->
+      begin
+        (* raise another exception to stash the global backtrace *)
+        try ignore (f "c" 5); assert false with Error _ -> ();
+      end;
+      Printf.printf "Uncaught exception %s\n" exn;
+      Printexc.print_raw_backtrace stdout trace
+
+let _ =
+  Printexc.record_backtrace true;
+  run [| "a" |];
+  run [| "b" |];
+  run [| "c" |];
+  run [| "d" |];
+  run [| |]
diff -Nru ocaml-3.12.1/testsuite/tests/backtrace/raw_backtrace.reference ocaml-4.01.0/testsuite/tests/backtrace/raw_backtrace.reference
--- ocaml-3.12.1/testsuite/tests/backtrace/raw_backtrace.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/backtrace/raw_backtrace.reference	2013-06-19 14:27:10.000000000 +0000
@@ -0,0 +1,27 @@
+a
+No exception
+b
+Uncaught exception Raw_backtrace.Error("b")
+Raised at file "raw_backtrace.ml", line 18, characters 21-32
+Called from file "raw_backtrace.ml", line 18, characters 42-53
+Called from file "raw_backtrace.ml", line 18, characters 42-53
+Called from file "raw_backtrace.ml", line 18, characters 42-53
+Called from file "raw_backtrace.ml", line 18, characters 42-53
+Called from file "raw_backtrace.ml", line 18, characters 42-53
+Called from file "raw_backtrace.ml", line 22, characters 4-11
+Re-raised at file "raw_backtrace.ml", line 24, characters 68-71
+Called from file "raw_backtrace.ml", line 29, characters 11-23
+Uncaught exception Raw_backtrace.Error("c")
+Raised at file "raw_backtrace.ml", line 25, characters 26-37
+Called from file "raw_backtrace.ml", line 29, characters 11-23
+Uncaught exception Raw_backtrace.Error("d")
+Raised at file "raw_backtrace.ml", line 18, characters 21-32
+Called from file "raw_backtrace.ml", line 18, characters 42-53
+Called from file "raw_backtrace.ml", line 18, characters 42-53
+Called from file "raw_backtrace.ml", line 18, characters 42-53
+Called from file "raw_backtrace.ml", line 18, characters 42-53
+Called from file "raw_backtrace.ml", line 18, characters 42-53
+Called from file "raw_backtrace.ml", line 22, characters 4-11
+Called from file "raw_backtrace.ml", line 29, characters 11-23
+Uncaught exception Invalid_argument("index out of bounds")
+Raised by primitive operation at file "raw_backtrace.ml", line 29, characters 14-22
diff -Nru ocaml-3.12.1/testsuite/tests/basic/Makefile ocaml-4.01.0/testsuite/tests/basic/Makefile
--- ocaml-3.12.1/testsuite/tests/basic/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,2 +1,15 @@
-include ../../makefiles/Makefile.several
-include ../../makefiles/Makefile.common
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/basic/arrays.ml ocaml-4.01.0/testsuite/tests/basic/arrays.ml
--- ocaml-3.12.1/testsuite/tests/basic/arrays.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic/arrays.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1995 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let bigarray n = [|
 n+0; n+1; n+2; n+3; n+4; n+5; n+6; n+7; n+8; n+9; n+10; n+11; n+12;
 n+13; n+14; n+15; n+16; n+17; n+18; n+19; n+20; n+21; n+22; n+23;
@@ -46,7 +58,9 @@
   if not (testcopy [|1.2;2.3;3.4;4.5|]) then
     print_string "Test2: failed on float array\n";
   if not (testcopy [|"un"; "deux"; "trois"|]) then
-    print_string "Test2: failed on string array\n"
+    print_string "Test2: failed on string array\n";
+  if not (testcopy (bigarray 42)) then
+    print_string "Test2: failed on big array\n"
 
 module AbstractFloat =
   (struct
@@ -79,8 +93,54 @@
           AbstractFloat.to_float u.(2) = 3.0) then
     print_string "Test3: failed on u\n"
 
+let test4 () =
+  let a = bigarray 0 in
+  let b = Array.sub a 50 10 in
+  if b <> [| 50;51;52;53;54;55;56;57;58;59 |] then
+    print_string "Test4: failed\n"
+
+let test5 () =
+  if Array.append [| 1;2;3 |] [| 4;5 |] <> [| 1;2;3;4;5 |] then
+    print_string "Test5: failed on int arrays\n";
+  if Array.append [| 1.0;2.0;3.0 |] [| 4.0;5.0 |] <> [| 1.0;2.0;3.0;4.0;5.0 |]
+  then
+    print_string "Test5: failed on float arrays\n"
+
+let test6 () =
+  let a = [| 0;1;2;3;4;5;6;7;8;9 |] in
+  let b = Array.concat [a;a;a;a;a;a;a;a;a;a] in
+  if not (Array.length b = 100 && b.(6) = 6 && b.(42) = 2 && b.(99) = 9) then
+    print_string "Test6: failed\n"
+
+let test7 () =
+  let a = Array.make 10 "a" in
+  let b = [| "b1"; "b2"; "b3" |] in
+  Array.blit b 0 a 5 3;
+  if a <> [|"a"; "a"; "a"; "a"; "a"; "b1"; "b2"; "b3"; "a"; "a"|]
+  || b <> [|"b1"; "b2"; "b3"|]
+  then print_string "Test7: failed(1)\n";
+  Array.blit a 5 a 6 4;
+  if a <> [|"a"; "a"; "a"; "a"; "a"; "b1"; "b1"; "b2"; "b3"; "a"|]
+  then print_string "Test7: failed(2)\n"
+
+let test8 () =
+  (try
+    ignore (Array.sub [||] 0 1); print_string "Test 8.1: failed\n"
+  with Invalid_argument _ -> ());
+  (try
+    ignore (Array.sub [|3;4|] 1 (-1)); print_string "Test 8.2: failed\n"
+  with Invalid_argument _ -> ());
+  (try
+    ignore (Array.sub [|3;4|] max_int 1); print_string "Test 8.3: failed\n"
+  with Invalid_argument _ -> ())
+
 let _ =
   test1();
   test2();
   test3();
+  test4();
+  test5();
+  test6();
+  test7();
+  test8();
   exit 0
diff -Nru ocaml-3.12.1/testsuite/tests/basic/bigints.ml ocaml-4.01.0/testsuite/tests/basic/bigints.ml
--- ocaml-3.12.1/testsuite/tests/basic/bigints.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic/bigints.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,12 +1,37 @@
-let _ =
-  print_int 1000000000; print_newline();
-  print_int 10000000000; print_newline();
-  print_int 100000000000; print_newline();
-  print_int 1000000000000; print_newline();
-  print_int 10000000000000; print_newline();
-  print_int 100000000000000; print_newline();
-  print_int 1000000000000000; print_newline();
-  print_int 10000000000000000; print_newline();
-  print_int 100000000000000000; print_newline();
-  print_int 1000000000000000000; print_newline()
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1997 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
 
+let _ =
+  match Sys.word_size with
+  | 32 ->
+     print_int (1 * 1000000000); print_newline();
+     print_string "10000000000"; print_newline();
+     print_string "100000000000"; print_newline();
+     print_string "1000000000000"; print_newline();
+     print_string "10000000000000"; print_newline();
+     print_string "100000000000000"; print_newline();
+     print_string "1000000000000000"; print_newline();
+     print_string "10000000000000000"; print_newline();
+     print_string "100000000000000000"; print_newline();
+     print_string "1000000000000000000"; print_newline();
+  | 64 ->
+     print_int (1 * 1000000000); print_newline();
+     print_int (10 * 1000000000); print_newline();
+     print_int (100 * 1000000000); print_newline();
+     print_int (1000 * 1000000000); print_newline();
+     print_int (10000 * 1000000000); print_newline();
+     print_int (100000 * 1000000000); print_newline();
+     print_int (1000000 * 1000000000); print_newline();
+     print_int (10000000 * 1000000000); print_newline();
+     print_int (100000000 * 1000000000); print_newline();
+     print_int (1000000000 * 1000000000); print_newline()
+  | _ -> assert false
diff -Nru ocaml-3.12.1/testsuite/tests/basic/boxedints.ml ocaml-4.01.0/testsuite/tests/basic/boxedints.ml
--- ocaml-3.12.1/testsuite/tests/basic/boxedints.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic/boxedints.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2000 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Test the types nativeint, int32, int64 *)
 
 open Printf
@@ -28,30 +40,30 @@
 module type TESTSIG = sig
   type t
   module Ops : sig
-    val neg: t -> t 
-    val add: t -> t -> t 
-    val sub: t -> t -> t 
-    val mul: t -> t -> t 
-    val div: t -> t -> t 
-    val rem: t -> t -> t 
-    val logand: t -> t -> t 
-    val logor: t -> t -> t 
-    val logxor: t -> t -> t 
-    val shift_left: t -> int -> t 
-    val shift_right: t -> int -> t 
-    val shift_right_logical: t -> int -> t 
-    val of_int: int -> t 
-    val to_int: t -> int 
-    val of_float: float -> t 
+    val neg: t -> t
+    val add: t -> t -> t
+    val sub: t -> t -> t
+    val mul: t -> t -> t
+    val div: t -> t -> t
+    val rem: t -> t -> t
+    val logand: t -> t -> t
+    val logor: t -> t -> t
+    val logxor: t -> t -> t
+    val shift_left: t -> int -> t
+    val shift_right: t -> int -> t
+    val shift_right_logical: t -> int -> t
+    val of_int: int -> t
+    val to_int: t -> int
+    val of_float: float -> t
     val to_float: t -> float
     val zero: t
     val one: t
     val minus_one: t
     val min_int: t
     val max_int: t
-    val format : string -> t -> string 
+    val format : string -> t -> string
     val to_string: t -> string
-    val of_string: string -> t 
+    val of_string: string -> t
   end
   val testcomp: t -> t -> bool*bool*bool*bool*bool*bool*int
   val skip_float_tests: bool
@@ -166,6 +178,7 @@
        9, 127531236, -365;
        10, 1234567, 12345678;
        11, 1234567, -12345678];
+    test 12 (div min_int (of_int (-1))) min_int;
 
     testing_function "mod";
     List.iter
@@ -181,6 +194,7 @@
        9, 127531236, -365;
        10, 1234567, 12345678;
        11, 1234567, -12345678];
+    test 12 (rem min_int (of_int (-1))) (of_int 0);
 
     testing_function "and";
     List.iter
@@ -345,7 +359,7 @@
     test 5 (add (of_int (-123)) (of_int 456)) (of_int 333);
     test 6 (add (of_int 123) (of_int (-456))) (of_int (-333));
     test 7 (add (of_int (-123)) (of_int (-456))) (of_int (-579));
-    test 8 (add (of_string "0x1234567812345678") 
+    test 8 (add (of_string "0x1234567812345678")
                 (of_string "0x9ABCDEF09ABCDEF"))
            (of_string "0x1be024671be02467");
     test 9 (add max_int max_int) (of_int (-2));
@@ -362,7 +376,7 @@
     test 5 (sub (of_int (-123)) (of_int 456)) (of_int (-579));
     test 6 (sub (of_int 123) (of_int (-456))) (of_int 579);
     test 7 (sub (of_int (-123)) (of_int (-456))) (of_int 333);
-    test 8 (sub (of_string "0x1234567812345678") 
+    test 8 (sub (of_string "0x1234567812345678")
                 (of_string "0x9ABCDEF09ABCDEF"))
            (of_string "0x888888908888889");
     test 9 (sub max_int min_int) minus_one;
@@ -400,6 +414,7 @@
        9, 127531236, -365;
        10, 1234567, 12345678;
        11, 1234567, -12345678];
+    test 12 (div min_int (of_int (-1))) min_int;
 
     testing_function "mod";
     List.iter
@@ -415,6 +430,7 @@
        9, 127531236, -365;
        10, 1234567, 12345678;
        11, 1234567, -12345678];
+    test 12 (rem min_int (of_int (-1))) (of_int 0);
 
     testing_function "and";
     List.iter
@@ -524,7 +540,7 @@
   begin match Sys.word_size with
     32 ->
       let module C =
-        Test32(struct type t = nativeint 
+        Test32(struct type t = nativeint
                       module Ops = Nativeint
                       let testcomp = testcomp_nativeint
                       let skip_float_tests = true end)
@@ -533,7 +549,7 @@
       let module C =
         Test64(struct type t = nativeint
                       module Ops = Nativeint
-                      let testcomp = testcomp_nativeint 
+                      let testcomp = testcomp_nativeint
                       let skip_float_tests = true end)
       in ()
   | _ ->
@@ -549,7 +565,7 @@
   test 3 (Nativeint.to_int32 (Nativeint.of_string "0x123456789ABCDEF0"))
          (Int32.of_string "0x9ABCDEF0")
   else
-  test 3 0 0; (* placeholder to have the same output on both 32-bit and 64-bit *)
+  test 3 0 0; (* placeholder to have the same output on 32-bit and 64-bit *)
   testing_function "int64 of/to int32";
   test 1 (Int64.of_int32 (Int32.of_string "-0x12345678"))
          (Int64.of_string "-0x12345678");
diff -Nru ocaml-3.12.1/testsuite/tests/basic/boxedints.reference ocaml-4.01.0/testsuite/tests/basic/boxedints.reference
--- ocaml-3.12.1/testsuite/tests/basic/boxedints.reference	2010-03-17 14:26:21.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic/boxedints.reference	2012-02-24 10:13:02.000000000 +0000
@@ -16,9 +16,9 @@
 mul
  1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13...
 div
- 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
 mod
- 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
 and
  1... 2... 3... 4... 5...
 or
@@ -55,9 +55,9 @@
 mul
  1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13...
 div
- 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
 mod
- 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
 and
  1... 2... 3... 4... 5...
 or
@@ -90,9 +90,9 @@
 mul
  1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13...
 div
- 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
 mod
- 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
 and
  1... 2... 3... 4... 5...
 or
diff -Nru ocaml-3.12.1/testsuite/tests/basic/equality.ml ocaml-4.01.0/testsuite/tests/basic/equality.ml
--- ocaml-3.12.1/testsuite/tests/basic/equality.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic/equality.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let test n check res =
   print_string "Test "; print_int n;
   if check res then print_string " passed.\n" else print_string " FAILED.\n";
@@ -102,4 +114,3 @@
   test 53 eqtrue (testcmpfloat 0.0 0.0);
   test 54 eqtrue (testcmpfloat 1.0 0.0);
   test 55 eqtrue (testcmpfloat 0.0 1.0)
-
diff -Nru ocaml-3.12.1/testsuite/tests/basic/float.ml ocaml-4.01.0/testsuite/tests/basic/float.ml
--- ocaml-3.12.1/testsuite/tests/basic/float.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic/float.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1 +1,13 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Damien Doligez, projet Moscova, INRIA Rocqencourt          *)
+(*                                                                     *)
+(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 Printf.printf "1./.0. = %f\n" (1.0 /. 0.0);;
diff -Nru ocaml-3.12.1/testsuite/tests/basic/includestruct.ml ocaml-4.01.0/testsuite/tests/basic/includestruct.ml
--- ocaml-3.12.1/testsuite/tests/basic/includestruct.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic/includestruct.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2001 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Test for "include " inside structures *)
 
 module A =
@@ -65,7 +77,7 @@
     include F(struct end)
     let test() = print_t A; print_newline(); print_t (B 42); print_newline()
   end
-    
+
 let _ =
   D.test();
   D.print_t D.A; print_newline(); D.print_t (D.B 42); print_newline()
@@ -89,4 +101,3 @@
 let _ =
   begin try raise (G.Exn "foo") with G.Exn s -> print_string s end;
   print_int ((new G.c)#m); print_newline()
-
diff -Nru ocaml-3.12.1/testsuite/tests/basic/maps.ml ocaml-4.01.0/testsuite/tests/basic/maps.ml
--- ocaml-3.12.1/testsuite/tests/basic/maps.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic/maps.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: maps.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 module IntMap = Map.Make(struct type t = int let compare x y = x-y end)
 
 let m1 = IntMap.add 4 "Y" (IntMap.singleton 3 "X1")
@@ -25,4 +23,3 @@
   print_endline "Inter";
   show (IntMap.merge (fun _ l r -> match l, r with Some x, Some y when x = y -> Some x | _ -> None) m1 m2);
   ()
-
diff -Nru ocaml-3.12.1/testsuite/tests/basic/patmatch.ml ocaml-4.01.0/testsuite/tests/basic/patmatch.ml
--- ocaml-3.12.1/testsuite/tests/basic/patmatch.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic/patmatch.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Tests for matchings on integers and characters *)
 
 (* Dense integer switch *)
@@ -91,7 +103,7 @@
   done;
   for i = 0 to 255 do
     let c = Char.chr i in
-    printf "k(%s) = %s\t" (escaped c) (k c)
+    printf "\tk(%s) = %s" (escaped c) (k c)
   done;
   printf "\n";
   printf "p([|\"hello\"|]) = %s\n" (p [|"hello"|]);
@@ -101,8 +113,19 @@
   printf "l([||]) = %d\n" (l [||]);
   printf "l([|1|]) = %d\n" (l [|1|]);
   printf "l([|2;3|]) = %d\n" (l [|2;3|]);
-  printf "l([|4;5;6|]) = %d\n" (l [|4;5;6|]);
-  exit 0
-
+  printf "l([|4;5;6|]) = %d\n" (l [|4;5;6|])
 
+(* PR #5992 *)
+(* Was segfaulting *)
 
+let f = function
+ | lazy (), _, {contents=None} -> 0
+ | _, lazy (), {contents=Some x} -> 1
+
+let s = ref None
+let set_true = lazy (s := Some 1)
+let set_false = lazy (s := None)
+
+let () =
+  let _r = try f (set_true, set_false, s) with Match_failure _ -> 2 in
+  printf "PR#5992=Ok\n"
diff -Nru ocaml-3.12.1/testsuite/tests/basic/patmatch.reference ocaml-4.01.0/testsuite/tests/basic/patmatch.reference
--- ocaml-3.12.1/testsuite/tests/basic/patmatch.reference	2010-05-04 15:09:32.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic/patmatch.reference	2013-04-25 13:32:17.000000000 +0000
@@ -57,7 +57,7 @@
 h(|) = ?
 h(}) = ?
 h(~) = ?
-k(\000) = othr	k(\001) = othr	k(\002) = othr	k(\003) = othr	k(\004) = othr	k(\005) = othr	k(\006) = othr	k(\007) = othr	k(\b) = othr	k(\t) = blk	k(\n) = blk	k(\011) = othr	k(\012) = othr	k(\r) = blk	k(\014) = othr	k(\015) = othr	k(\016) = othr	k(\017) = othr	k(\018) = othr	k(\019) = othr	k(\020) = othr	k(\021) = othr	k(\022) = othr	k(\023) = othr	k(\024) = othr	k(\025) = othr	k(\026) = othr	k(\027) = othr	k(\028) = othr	k(\029) = othr	k(\030) = othr	k(\031) = othr	k( ) = blk	k(!) = oper	k(\034) = othr	k(#) = oper	k($) = oper	k(%) = oper	k(&) = oper	k(\') = othr	k(\040) = othr	k(\041) = othr	k(*) = oper	k(+) = oper	k(\044) = othr	k(\045) = othr	k(\046) = othr	k(/) = oper	k(0) = dig	k(1) = dig	k(2) = dig	k(3) = dig	k(4) = dig	k(5) = dig	k(6) = dig	k(7) = dig	k(8) = dig	k(9) = dig	k(:) = oper	k(\059) = othr	k(<) = oper	k(=) = oper	k(>) = oper	k(?) = oper	k(@) = oper	k(A) = letr	k(B) = letr	k(C) = letr	k(D) = letr	k(E) = letr	k(F) = letr	k(G) = letr	k(H) = letr	k(I) = letr	k(J) = letr	k(K) = letr	k(L) = letr	k(M) = letr	k(N) = letr	k(O) = letr	k(P) = letr	k(Q) = letr	k(R) = letr	k(S) = letr	k(T) = letr	k(U) = letr	k(V) = letr	k(W) = letr	k(X) = letr	k(Y) = letr	k(Z) = letr	k(\091) = othr	k(\\) = oper	k(\093) = othr	k(^) = oper	k(\095) = othr	k(\096) = othr	k(a) = letr	k(b) = letr	k(c) = letr	k(d) = letr	k(e) = letr	k(f) = letr	k(g) = letr	k(h) = letr	k(i) = letr	k(j) = letr	k(k) = letr	k(l) = letr	k(m) = letr	k(n) = letr	k(o) = letr	k(p) = letr	k(q) = letr	k(r) = letr	k(s) = letr	k(t) = letr	k(u) = letr	k(v) = letr	k(w) = letr	k(x) = letr	k(y) = letr	k(z) = letr	k(\123) = othr	k(|) = oper	k(\125) = othr	k(~) = oper	k(\127) = othr	k(\128) = othr	k(\129) = othr	k(\130) = othr	k(\131) = othr	k(\132) = othr	k(\133) = othr	k(\134) = othr	k(\135) = othr	k(\136) = othr	k(\137) = othr	k(\138) = othr	k(\139) = othr	k(\140) = othr	k(\141) = othr	k(\142) = othr	k(\143) = othr	k(\144) = othr	k(\145) = othr	k(\146) = othr	k(\147) = othr	k(\148) = othr	k(\149) = othr	k(\150) = othr	k(\151) = othr	k(\152) = othr	k(\153) = othr	k(\154) = othr	k(\155) = othr	k(\156) = othr	k(\157) = othr	k(\158) = othr	k(\159) = othr	k(\160) = othr	k(\161) = othr	k(\162) = othr	k(\163) = othr	k(\164) = othr	k(\165) = othr	k(\166) = othr	k(\167) = othr	k(\168) = othr	k(\169) = othr	k(\170) = othr	k(\171) = othr	k(\172) = othr	k(\173) = othr	k(\174) = othr	k(\175) = othr	k(\176) = othr	k(\177) = othr	k(\178) = othr	k(\179) = othr	k(\180) = othr	k(\181) = othr	k(\182) = othr	k(\183) = othr	k(\184) = othr	k(\185) = othr	k(\186) = othr	k(\187) = othr	k(\188) = othr	k(\189) = othr	k(\190) = othr	k(\191) = othr	k(\192) = letr	k(\193) = letr	k(\194) = letr	k(\195) = letr	k(\196) = letr	k(\197) = letr	k(\198) = letr	k(\199) = letr	k(\200) = letr	k(\201) = letr	k(\202) = letr	k(\203) = letr	k(\204) = letr	k(\205) = letr	k(\206) = letr	k(\207) = letr	k(\208) = letr	k(\209) = letr	k(\210) = letr	k(\211) = letr	k(\212) = letr	k(\213) = letr	k(\214) = letr	k(\215) = letr	k(\216) = letr	k(\217) = letr	k(\218) = letr	k(\219) = letr	k(\220) = letr	k(\221) = letr	k(\222) = letr	k(\223) = letr	k(\224) = letr	k(\225) = letr	k(\226) = letr	k(\227) = letr	k(\228) = letr	k(\229) = letr	k(\230) = letr	k(\231) = letr	k(\232) = letr	k(\233) = letr	k(\234) = letr	k(\235) = letr	k(\236) = letr	k(\237) = letr	k(\238) = letr	k(\239) = letr	k(\240) = letr	k(\241) = letr	k(\242) = letr	k(\243) = letr	k(\244) = letr	k(\245) = letr	k(\246) = letr	k(\247) = letr	k(\248) = letr	k(\249) = letr	k(\250) = letr	k(\251) = letr	k(\252) = letr	k(\253) = letr	k(\254) = letr	k(\255) = letr	
+	k(\000) = othr	k(\001) = othr	k(\002) = othr	k(\003) = othr	k(\004) = othr	k(\005) = othr	k(\006) = othr	k(\007) = othr	k(\b) = othr	k(\t) = blk	k(\n) = blk	k(\011) = othr	k(\012) = othr	k(\r) = blk	k(\014) = othr	k(\015) = othr	k(\016) = othr	k(\017) = othr	k(\018) = othr	k(\019) = othr	k(\020) = othr	k(\021) = othr	k(\022) = othr	k(\023) = othr	k(\024) = othr	k(\025) = othr	k(\026) = othr	k(\027) = othr	k(\028) = othr	k(\029) = othr	k(\030) = othr	k(\031) = othr	k( ) = blk	k(!) = oper	k(\034) = othr	k(#) = oper	k($) = oper	k(%) = oper	k(&) = oper	k(\') = othr	k(\040) = othr	k(\041) = othr	k(*) = oper	k(+) = oper	k(\044) = othr	k(\045) = othr	k(\046) = othr	k(/) = oper	k(0) = dig	k(1) = dig	k(2) = dig	k(3) = dig	k(4) = dig	k(5) = dig	k(6) = dig	k(7) = dig	k(8) = dig	k(9) = dig	k(:) = oper	k(\059) = othr	k(<) = oper	k(=) = oper	k(>) = oper	k(?) = oper	k(@) = oper	k(A) = letr	k(B) = letr	k(C) = letr	k(D) = letr	k(E) = letr	k(F) = letr	k(G) = letr	k(H) = letr	k(I) = letr	k(J) = letr	k(K) = letr	k(L) = letr	k(M) = letr	k(N) = letr	k(O) = letr	k(P) = letr	k(Q) = letr	k(R) = letr	k(S) = letr	k(T) = letr	k(U) = letr	k(V) = letr	k(W) = letr	k(X) = letr	k(Y) = letr	k(Z) = letr	k(\091) = othr	k(\\) = oper	k(\093) = othr	k(^) = oper	k(\095) = othr	k(\096) = othr	k(a) = letr	k(b) = letr	k(c) = letr	k(d) = letr	k(e) = letr	k(f) = letr	k(g) = letr	k(h) = letr	k(i) = letr	k(j) = letr	k(k) = letr	k(l) = letr	k(m) = letr	k(n) = letr	k(o) = letr	k(p) = letr	k(q) = letr	k(r) = letr	k(s) = letr	k(t) = letr	k(u) = letr	k(v) = letr	k(w) = letr	k(x) = letr	k(y) = letr	k(z) = letr	k(\123) = othr	k(|) = oper	k(\125) = othr	k(~) = oper	k(\127) = othr	k(\128) = othr	k(\129) = othr	k(\130) = othr	k(\131) = othr	k(\132) = othr	k(\133) = othr	k(\134) = othr	k(\135) = othr	k(\136) = othr	k(\137) = othr	k(\138) = othr	k(\139) = othr	k(\140) = othr	k(\141) = othr	k(\142) = othr	k(\143) = othr	k(\144) = othr	k(\145) = othr	k(\146) = othr	k(\147) = othr	k(\148) = othr	k(\149) = othr	k(\150) = othr	k(\151) = othr	k(\152) = othr	k(\153) = othr	k(\154) = othr	k(\155) = othr	k(\156) = othr	k(\157) = othr	k(\158) = othr	k(\159) = othr	k(\160) = othr	k(\161) = othr	k(\162) = othr	k(\163) = othr	k(\164) = othr	k(\165) = othr	k(\166) = othr	k(\167) = othr	k(\168) = othr	k(\169) = othr	k(\170) = othr	k(\171) = othr	k(\172) = othr	k(\173) = othr	k(\174) = othr	k(\175) = othr	k(\176) = othr	k(\177) = othr	k(\178) = othr	k(\179) = othr	k(\180) = othr	k(\181) = othr	k(\182) = othr	k(\183) = othr	k(\184) = othr	k(\185) = othr	k(\186) = othr	k(\187) = othr	k(\188) = othr	k(\189) = othr	k(\190) = othr	k(\191) = othr	k(\192) = letr	k(\193) = letr	k(\194) = letr	k(\195) = letr	k(\196) = letr	k(\197) = letr	k(\198) = letr	k(\199) = letr	k(\200) = letr	k(\201) = letr	k(\202) = letr	k(\203) = letr	k(\204) = letr	k(\205) = letr	k(\206) = letr	k(\207) = letr	k(\208) = letr	k(\209) = letr	k(\210) = letr	k(\211) = letr	k(\212) = letr	k(\213) = letr	k(\214) = letr	k(\215) = letr	k(\216) = letr	k(\217) = letr	k(\218) = letr	k(\219) = letr	k(\220) = letr	k(\221) = letr	k(\222) = letr	k(\223) = letr	k(\224) = letr	k(\225) = letr	k(\226) = letr	k(\227) = letr	k(\228) = letr	k(\229) = letr	k(\230) = letr	k(\231) = letr	k(\232) = letr	k(\233) = letr	k(\234) = letr	k(\235) = letr	k(\236) = letr	k(\237) = letr	k(\238) = letr	k(\239) = letr	k(\240) = letr	k(\241) = letr	k(\242) = letr	k(\243) = letr	k(\244) = letr	k(\245) = letr	k(\246) = letr	k(\247) = letr	k(\248) = letr	k(\249) = letr	k(\250) = letr	k(\251) = letr	k(\252) = letr	k(\253) = letr	k(\254) = letr	k(\255) = letr
 p([|"hello"|]) = hello
 p([|1.0|]) = 1.000000
 q([|2|]) = 2
@@ -66,3 +66,4 @@
 l([|1|]) = 2
 l([|2;3|]) = 5
 l([|4;5;6|]) = 15
+PR#5992=Ok
diff -Nru ocaml-3.12.1/testsuite/tests/basic/recvalues.ml ocaml-4.01.0/testsuite/tests/basic/recvalues.ml
--- ocaml-3.12.1/testsuite/tests/basic/recvalues.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic/recvalues.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Recursive value definitions *)
 
 let _ =
@@ -8,7 +20,7 @@
   then print_string "Test 1: passed\n"
   else print_string "Test 1: FAILED\n";
   let one = 1 in
-  let rec y = (one, one+1) :: y in  
+  let rec y = (one, one+1) :: y in
   if match y with
        (1,2) :: y' -> y == y'
      | _ -> false
diff -Nru ocaml-3.12.1/testsuite/tests/basic/sets.ml ocaml-4.01.0/testsuite/tests/basic/sets.ml
--- ocaml-3.12.1/testsuite/tests/basic/sets.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic/sets.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: sets.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 module IntSet = Set.Make(struct type t = int let compare x y = x-y end)
 
 let even = List.fold_right IntSet.add [0; -2; 2; 4; 6; -10] IntSet.empty
diff -Nru ocaml-3.12.1/testsuite/tests/basic/tailcalls.ml ocaml-4.01.0/testsuite/tests/basic/tailcalls.ml
--- ocaml-3.12.1/testsuite/tests/basic/tailcalls.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic/tailcalls.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2000 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let rec tailcall4 a b c d =
   if a < 0
   then b
@@ -18,7 +30,7 @@
   fn a b c d e f g h
 
 let indtailcall16 fn a b c d e f g h i j k l m n o p =
-  fn a b c d e f g h i j k l m n o p 
+  fn a b c d e f g h i j k l m n o p
 
 let _ =
   print_int (tailcall4 10000000 0 0 0); print_newline();
diff -Nru ocaml-3.12.1/testsuite/tests/basic-float/Makefile ocaml-4.01.0/testsuite/tests/basic-float/Makefile
--- ocaml-3.12.1/testsuite/tests/basic-float/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-float/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,5 +1,18 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 MODULES=float_record
 MAIN_MODULE=tfloat_record
 
-include ../../makefiles/Makefile.one
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/basic-float/float_record.ml ocaml-4.01.0/testsuite/tests/basic-float/float_record.ml
--- ocaml-3.12.1/testsuite/tests/basic-float/float_record.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-float/float_record.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*             Pierre Weis, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 type t = float;;
 
 let make f = f;;
diff -Nru ocaml-3.12.1/testsuite/tests/basic-float/float_record.mli ocaml-4.01.0/testsuite/tests/basic-float/float_record.mli
--- ocaml-3.12.1/testsuite/tests/basic-float/float_record.mli	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-float/float_record.mli	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*             Pierre Weis, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 type t = private float;;
 
 val make : float -> t;;
diff -Nru ocaml-3.12.1/testsuite/tests/basic-float/tfloat_record.ml ocaml-4.01.0/testsuite/tests/basic-float/tfloat_record.ml
--- ocaml-3.12.1/testsuite/tests/basic-float/tfloat_record.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-float/tfloat_record.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,5 +1,16 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*             Pierre Weis, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let s = { Float_record.f = Float_record.make 1.0 };;
 
 print_float (Float_record.from s.Float_record.f);;
 print_newline ();;
-
diff -Nru ocaml-3.12.1/testsuite/tests/basic-io/Makefile ocaml-4.01.0/testsuite/tests/basic-io/Makefile
--- ocaml-3.12.1/testsuite/tests/basic-io/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-io/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,6 +1,19 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 #MODULES=
 MAIN_MODULE=wc
 EXEC_ARGS=wc.ml
 
-include ../../makefiles/Makefile.one
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/basic-io/wc.ml ocaml-4.01.0/testsuite/tests/basic-io/wc.ml
--- ocaml-3.12.1/testsuite/tests/basic-io/wc.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-io/wc.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1995 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Counts characters, lines and words in one or several files. *)
 
 let chars = ref 0
diff -Nru ocaml-3.12.1/testsuite/tests/basic-io/wc.reference ocaml-4.01.0/testsuite/tests/basic-io/wc.reference
--- ocaml-3.12.1/testsuite/tests/basic-io/wc.reference	2010-01-25 14:32:15.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-io/wc.reference	2012-10-17 20:09:16.000000000 +0000
@@ -1 +1 @@
-1198 characters, 178 words, 54 lines
+2013 characters, 233 words, 66 lines
diff -Nru ocaml-3.12.1/testsuite/tests/basic-io-2/Makefile ocaml-4.01.0/testsuite/tests/basic-io-2/Makefile
--- ocaml-3.12.1/testsuite/tests/basic-io-2/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-io-2/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,6 +1,19 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 #MODULES=
 MAIN_MODULE=io
 EXEC_ARGS=io.ml
 
-include ../../makefiles/Makefile.one
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/basic-io-2/io.ml ocaml-4.01.0/testsuite/tests/basic-io-2/io.ml
--- ocaml-3.12.1/testsuite/tests/basic-io-2/io.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-io-2/io.ml	2013-04-29 09:44:59.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Test a file copy function *)
 
 let test msg funct f1 f2 =
@@ -11,8 +23,8 @@
 (* File copy with constant-sized chunks *)
 
 let copy_file sz infile ofile =
-  let ic = open_in infile in
-  let oc = open_out ofile in
+  let ic = open_in_bin infile in
+  let oc = open_out_bin ofile in
   let buffer = String.create sz in
   let rec copy () =
     let n = input ic buffer 0 sz in
@@ -27,8 +39,8 @@
 (* File copy with random-sized chunks *)
 
 let copy_random sz infile ofile =
-  let ic = open_in infile in
-  let oc = open_out ofile in
+  let ic = open_in_bin infile in
+  let oc = open_out_bin ofile in
   let buffer = String.create sz in
   let rec copy () =
     let s = 1 + Random.int sz in
@@ -44,8 +56,8 @@
 (* File copy line per line *)
 
 let copy_line infile ofile =
-  let ic = open_in infile in
-  let oc = open_out ofile in
+  let ic = open_in_bin infile in
+  let oc = open_out_bin ofile in
   try
     while true do
       output_string oc (input_line ic); output_char oc '\n'
@@ -73,7 +85,7 @@
 (* Create long lines of text *)
 
 let make_lines ofile =
-  let oc = open_out ofile in
+  let oc = open_out_bin ofile in
   for i = 1 to 256 do
     output_string oc (String.make (i*64) '.'); output_char oc '\n'
   done;
@@ -93,7 +105,7 @@
   test "263-byte chunks" (copy_file 263) src testio;
   test "4011-byte chunks" (copy_file 4011) src testio;
   test "0...8192 byte chunks" (copy_random 8192) src testio;
-  test "line per line, short lines" copy_line "/etc/hosts" testio;
+  test "line per line, short lines" copy_line "test-file-short-lines" testio;
   make_lines lines;
   test "line per line, short and long lines" copy_line lines testio;
   test "backwards, 4096-byte chunks" (copy_seek 4096) src testio;
diff -Nru ocaml-3.12.1/testsuite/tests/basic-io-2/test-file-short-lines ocaml-4.01.0/testsuite/tests/basic-io-2/test-file-short-lines
--- ocaml-3.12.1/testsuite/tests/basic-io-2/test-file-short-lines	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-io-2/test-file-short-lines	2013-07-23 14:48:47.000000000 +0000
@@ -0,0 +1,10 @@
+##
+# Host Database
+#
+# localhost is used to configure the loopback interface
+# when the system is booting.  Do not change this entry.
+##
+127.0.0.1	localhost
+255.255.255.255	broadcasthost
+::1             localhost
+fe80::1%lo0	localhost
diff -Nru ocaml-3.12.1/testsuite/tests/basic-manyargs/Makefile ocaml-4.01.0/testsuite/tests/basic-manyargs/Makefile
--- ocaml-3.12.1/testsuite/tests/basic-manyargs/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-manyargs/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,6 +1,19 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 #MODULES=
 MAIN_MODULE=manyargs
 C_FILES=manyargsprim
 
-include ../../makefiles/Makefile.one
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/basic-manyargs/manyargs.ml ocaml-4.01.0/testsuite/tests/basic-manyargs/manyargs.ml
--- ocaml-3.12.1/testsuite/tests/basic-manyargs/manyargs.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-manyargs/manyargs.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1995 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let manyargs a b c d e f g h i j k l m n o =
   print_string "a = "; print_int a; print_newline();
   print_string "b = "; print_int b; print_newline();
@@ -35,7 +47,10 @@
   manyargs_tail2 0 1;
   manyargs_tail3 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
 
-external manyargs_ext: int -> int -> int -> int -> int -> int -> int -> int -> int -> int -> int -> int = "manyargs_argv" "manyargs"
+external manyargs_ext:
+  int -> int -> int -> int -> int -> int -> int -> int -> int -> int -> int ->
+    int
+  = "manyargs_argv" "manyargs"
 
 let _ =
   print_string "external:\n"; flush stdout;
diff -Nru ocaml-3.12.1/testsuite/tests/basic-manyargs/manyargsprim.c ocaml-4.01.0/testsuite/tests/basic-manyargs/manyargsprim.c
--- ocaml-3.12.1/testsuite/tests/basic-manyargs/manyargsprim.c	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-manyargs/manyargsprim.c	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+/***********************************************************************/
+/*                                                                     */
+/*                                OCaml                                */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 1995 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the Q Public License version 1.0.               */
+/*                                                                     */
+/***********************************************************************/
+
 #include "mlvalues.h"
 #include "stdio.h"
 
diff -Nru ocaml-3.12.1/testsuite/tests/basic-more/Makefile ocaml-4.01.0/testsuite/tests/basic-more/Makefile
--- ocaml-3.12.1/testsuite/tests/basic-more/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-more/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,4 +1,17 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 MODULES=testing
 
-include ../../makefiles/Makefile.several
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/basic-more/bounds.ml ocaml-4.01.0/testsuite/tests/basic-more/bounds.ml
--- ocaml-3.12.1/testsuite/tests/basic-more/bounds.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-more/bounds.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Test bound checks with ocamlopt *)
 
 let a = [| 0; 1; 2 |]
@@ -24,5 +36,3 @@
   print_string "Trail:";
   List.iter (fun n -> print_string " "; print_int n) !trail;
   print_newline()
-
-
diff -Nru ocaml-3.12.1/testsuite/tests/basic-more/morematch.ml ocaml-4.01.0/testsuite/tests/basic-more/morematch.ml
--- ocaml-3.12.1/testsuite/tests/basic-more/morematch.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-more/morematch.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Luc Maranget, projet Moscova, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2001 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (**************************************************************)
 (*  This suite tests the pattern-matching compiler            *)
 (*  it should just compile and run.                           *)
@@ -51,13 +63,13 @@
 test "deux" g 9 7 ; ()
 ;;
 
-  
+
 let g x = match x with
   1 -> 1
 | 2 -> 2
 | 3 -> 3
 | 4 | 5 -> 4
-| 6 -> 5   
+| 6 -> 5
 | 7 | 8 -> 6
 | 9 -> 7
 | _ -> 8;;
@@ -70,7 +82,7 @@
 | 2 -> 2
 | 3 -> 3
 | 4 | 5 -> 4
-| 6 -> 5   
+| 6 -> 5
 | 4|5|7 -> 100
 | 7 | 8 -> 6
 | 9 -> 7
@@ -251,7 +263,7 @@
 test "fin" f (E (C,A)) (D (A,0)) ; ()
 ;;
 
-type length = 
+type length =
     Char of int | Pixel of int | Percent of int | No of string | Default
 
 let length = function
@@ -550,7 +562,7 @@
 
 (* Les bugs de jerome *)
 type f =
-  | ABSENT 
+  | ABSENT
   | FILE
   | SYMLINK
   | DIRECTORY
@@ -584,27 +596,27 @@
 ;;
 
 
-test "jerome_constr" 
+test "jerome_constr"
    replicaContent2shortString (ABSENT, Unchanged) "        " ;
-test "jerome_constr" 
+test "jerome_constr"
    replicaContent2shortString (ABSENT, Deleted) "deleted " ;
-test "jerome_constr" 
+test "jerome_constr"
    replicaContent2shortString (FILE, Modified) "changed " ;
-test "jerome_constr" 
+test "jerome_constr"
    replicaContent2shortString (DIRECTORY, PropsChanged) "props   " ;
-test "jerome_constr" 
+test "jerome_constr"
    replicaContent2shortString (FILE, Deleted) "assert false" ;
-test "jerome_constr" 
+test "jerome_constr"
    replicaContent2shortString (SYMLINK, Deleted) "assert false" ;
-test "jerome_constr" 
+test "jerome_constr"
    replicaContent2shortString (SYMLINK, PropsChanged) "assert false" ;
-test "jerome_constr" 
+test "jerome_constr"
    replicaContent2shortString (DIRECTORY, Deleted) "assert false" ;
-test "jerome_constr" 
+test "jerome_constr"
    replicaContent2shortString (ABSENT, Created) "assert false" ;
-test "jerome_constr" 
+test "jerome_constr"
    replicaContent2shortString (ABSENT, Modified) "assert false" ;
-test "jerome_constr" 
+test "jerome_constr"
    replicaContent2shortString (ABSENT, PropsChanged) "assert false" ;
 ;;
 
@@ -631,27 +643,27 @@
 ;;
 
 
-test "jerome_variant" 
+test "jerome_variant"
    replicaContent2shortString (`ABSENT, `Unchanged) "        " ;
-test "jerome_variant" 
+test "jerome_variant"
    replicaContent2shortString (`ABSENT, `Deleted) "deleted " ;
-test "jerome_variant" 
+test "jerome_variant"
    replicaContent2shortString (`FILE, `Modified) "changed " ;
-test "jerome_variant" 
+test "jerome_variant"
    replicaContent2shortString (`DIRECTORY, `PropsChanged) "props   " ;
-test "jerome_variant" 
+test "jerome_variant"
    replicaContent2shortString (`FILE, `Deleted) "assert false" ;
-test "jerome_variant" 
+test "jerome_variant"
    replicaContent2shortString (`SYMLINK, `Deleted) "assert false" ;
-test "jerome_variant" 
+test "jerome_variant"
    replicaContent2shortString (`SYMLINK, `PropsChanged) "assert false" ;
-test "jerome_variant" 
+test "jerome_variant"
    replicaContent2shortString (`DIRECTORY, `Deleted) "assert false" ;
-test "jerome_variant" 
+test "jerome_variant"
    replicaContent2shortString (`ABSENT, `Created) "assert false" ;
-test "jerome_variant" 
+test "jerome_variant"
    replicaContent2shortString (`ABSENT, `Modified) "assert false" ;
-test "jerome_variant" 
+test "jerome_variant"
    replicaContent2shortString (`ABSENT, `PropsChanged) "assert false" ;
 ;;
 
@@ -972,10 +984,10 @@
 type  habert_a=
   | A of habert_c
   | B of habert_c
-  
-and habert_c= {lvar:int; lassoc: habert_c;lnb:int} 
-  
-  
+
+and habert_c= {lvar:int; lassoc: habert_c;lnb:int}
+
+
 let habert=function
   | (A {lnb=i}|B {lnb=i}) when i=0 -> 1
   | A {lassoc=({lnb=j});lnb=i} -> 2
@@ -1000,13 +1012,13 @@
   | `TVariant of string list
   | `TBlock of int
   | `TCopy of type_expr
-  ] 
+  ]
 
 and recurs_type_expr = [
   | `TTuple of type_expr list
   | `TConstr of type_expr list
   | `TVariant of string list
-  ] 
+  ]
 
 
 let rec maf te =
@@ -1129,7 +1141,7 @@
   | `False
   | `True
   ]
-  
+
 type vg = [
   | `A
   | `B
@@ -1142,7 +1154,7 @@
     x : bg;
   }
 
-let predg x = true 
+let predg x = true
 
 let rec gilles o = match o with
   | {v = (`U data | `V data); x = `False} when predg o -> 1
@@ -1168,3 +1180,22 @@
   test "lucexn1" lucexn  (Error "coucou") "coucou" ;
   test "lucexn2" lucexn (Found ("int: ",0)) "int: 0" ;
   ()
+
+(*
+  PR#5758: different representations of floats
+*)
+
+let pr5758 x str =
+  match (x, str) with
+  | (1. , "A") -> "Matched A"
+  | (1.0, "B") -> "Matched B"
+  | (1. , "C") -> "Matched C"
+  | result ->
+    match result with
+    | (1., "A") -> "Failed match A then later matched"
+    | _ -> "Failed twice"
+;;
+
+let () =
+  test "pr5758" (pr5758 1.) "A" "Matched A"
+;;
diff -Nru ocaml-3.12.1/testsuite/tests/basic-more/tbuffer.ml ocaml-4.01.0/testsuite/tests/basic-more/tbuffer.ml
--- ocaml-3.12.1/testsuite/tests/basic-more/tbuffer.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-more/tbuffer.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(*************************************************************************)
+(*                                                                       *)
+(*                                 OCaml                                 *)
+(*                                                                       *)
+(*            Pierre Weis, projet Estime, INRIA Rocquencourt             *)
+(*                                                                       *)
+(*   Copyright 2009 Institut National de Recherche en Informatique et    *)
+(*   en Automatique.  All rights reserved.  This file is distributed     *)
+(*   under the terms of the Q Public License version 1.0.                *)
+(*                                                                       *)
+(*************************************************************************)
+
 (* Dummy substitute function. *)
 
 open Testing;;
@@ -24,4 +36,3 @@
 Buffer.add_substitute b identity pat1;
 test (String.length (Buffer.contents b) = n1)
 ;;
-
diff -Nru ocaml-3.12.1/testsuite/tests/basic-more/tbuffer.reference ocaml-4.01.0/testsuite/tests/basic-more/tbuffer.reference
--- ocaml-3.12.1/testsuite/tests/basic-more/tbuffer.reference	2010-01-25 14:30:09.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-more/tbuffer.reference	2012-07-30 18:04:46.000000000 +0000
@@ -1,2 +1,2 @@
-0 1 
+ 0 1
 All tests succeeded.
diff -Nru ocaml-3.12.1/testsuite/tests/basic-more/testrandom.ml ocaml-4.01.0/testsuite/tests/basic-more/testrandom.ml
--- ocaml-3.12.1/testsuite/tests/basic-more/testrandom.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-more/testrandom.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,13 +1,24 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1995 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 open Random
 
-let _ = 
+let _ =
   for i = 0 to 20 do
-    print_float (float 1000.); print_char ' '
+    print_char ' '; print_int (int 1000);
   done;
   print_newline ();  print_newline ();
   for i = 0 to 20 do
-    print_int (int 1000); print_char ' '
+    print_char ' '; print_float (float 1000.);
   done
 
 let _ = exit 0
-
diff -Nru ocaml-3.12.1/testsuite/tests/basic-more/testrandom.reference ocaml-4.01.0/testsuite/tests/basic-more/testrandom.reference
--- ocaml-3.12.1/testsuite/tests/basic-more/testrandom.reference	2010-03-17 09:28:15.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-more/testrandom.reference	2012-07-30 18:04:46.000000000 +0000
@@ -1,4 +1,4 @@
-270.251355065 597.822945853 287.052171181 625.315015859 241.029649126 559.742196387 932.074421229 756.637587326 360.006556146 987.177314953 190.217751234 758.516786217 59.8488223602 328.350439075 172.627051105 944.543207513 629.424106752 868.196647048 174.382120878 78.1259713643 34.3270777955 
+ 344 685 182 641 439 500 104 20 921 370 217 885 949 678 615 412 401 606 428 869 289
 
-683 782 740 270 835 136 791 168 324 222 156 835 328 636 233 153 671 69 95 357 92 
+ 122.128067547 461.324792129 360.006556146 768.75882284 396.500946942 190.217751234 567.660068681 403.59226778 59.8488223602 363.816246826 764.705761642 172.627051105 481.861849093 399.173195422 629.424106752 391.547032203 676.701133948 174.382120878 994.425675487 585.00027757 34.3270777955
 All tests succeeded.
diff -Nru ocaml-3.12.1/testsuite/tests/basic-more/tformat.ml ocaml-4.01.0/testsuite/tests/basic-more/tformat.ml
--- ocaml-3.12.1/testsuite/tests/basic-more/tformat.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-more/tformat.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                            Objective Caml                             *)
+(*                                 OCaml                                 *)
 (*                                                                       *)
 (*            Pierre Weis, projet Estime, INRIA Rocquencourt             *)
 (*                                                                       *)
@@ -10,7 +10,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: tformat.ml 10713 2010-10-08 11:53:19Z doligez $
+(*
 
 A testbed file for the module Format.
 
diff -Nru ocaml-3.12.1/testsuite/tests/basic-more/tformat.reference ocaml-4.01.0/testsuite/tests/basic-more/tformat.reference
--- ocaml-3.12.1/testsuite/tests/basic-more/tformat.reference	2010-01-25 14:30:09.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-more/tformat.reference	2012-07-30 18:04:46.000000000 +0000
@@ -1,2 +1,2 @@
-0 
+ 0
 All tests succeeded.
diff -Nru ocaml-3.12.1/testsuite/tests/basic-more/tprintf.ml ocaml-4.01.0/testsuite/tests/basic-more/tprintf.ml
--- ocaml-3.12.1/testsuite/tests/basic-more/tprintf.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-more/tprintf.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*             Pierre Weis, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2006 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 open Testing;;
 
 open Printf;;
@@ -42,7 +54,7 @@
 let test2 () = true
 (*  sprintf "%1$d\n" 5 1 = "    1\n" &&
   sprintf "%01$d\n" 5 1 = "00001\n" *);;
-  
+
 test (test2 ());;
 
 (* Testing meta format string printing. *)
@@ -66,7 +78,7 @@
   sprintf "%(toto %s titi.\n%).\n"
     "Bonjour %s" "toto" = "Bonjour toto.\n" &&
   sprintf "%(toto %s titi.\n%)%s\n"
-    "Bonjour %s." "toto" " Ça va?" = "Bonjour toto. Ça va?\n"
+    "Bonjour %s." "toto" " Ca va?" = "Bonjour toto. Ca va?\n"
 ;;
 
 test (test5 ());;
diff -Nru ocaml-3.12.1/testsuite/tests/basic-more/tprintf.reference ocaml-4.01.0/testsuite/tests/basic-more/tprintf.reference
--- ocaml-3.12.1/testsuite/tests/basic-more/tprintf.reference	2010-01-25 14:30:09.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-more/tprintf.reference	2012-07-30 18:04:46.000000000 +0000
@@ -1,2 +1,2 @@
-0 1 2 3 4 5 
+ 0 1 2 3 4 5
 All tests succeeded.
diff -Nru ocaml-3.12.1/testsuite/tests/basic-multdef/Makefile ocaml-4.01.0/testsuite/tests/basic-multdef/Makefile
--- ocaml-3.12.1/testsuite/tests/basic-multdef/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-multdef/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,5 +1,18 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 MODULES=multdef
 MAIN_MODULE=usemultdef
 
-include ../../makefiles/Makefile.one
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/basic-multdef/multdef.ml ocaml-4.01.0/testsuite/tests/basic-multdef/multdef.ml
--- ocaml-3.12.1/testsuite/tests/basic-multdef/multdef.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-multdef/multdef.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,2 +1,14 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let f x = x + 1
 external g : string -> int = "caml_int_of_string"
diff -Nru ocaml-3.12.1/testsuite/tests/basic-multdef/multdef.mli ocaml-4.01.0/testsuite/tests/basic-multdef/multdef.mli
--- ocaml-3.12.1/testsuite/tests/basic-multdef/multdef.mli	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-multdef/multdef.mli	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 val f : int -> int
 val f : int -> int
 val g : string -> int
diff -Nru ocaml-3.12.1/testsuite/tests/basic-multdef/usemultdef.ml ocaml-4.01.0/testsuite/tests/basic-multdef/usemultdef.ml
--- ocaml-3.12.1/testsuite/tests/basic-multdef/usemultdef.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-multdef/usemultdef.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1 +1,13 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let _ = print_int(Multdef.f 1); print_newline(); exit 0
diff -Nru ocaml-3.12.1/testsuite/tests/basic-private/Makefile ocaml-4.01.0/testsuite/tests/basic-private/Makefile
--- ocaml-3.12.1/testsuite/tests/basic-private/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-private/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,5 +1,19 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+
 MODULES=length
 MAIN_MODULE=tlength
 
-include ../../makefiles/Makefile.one
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/basic-private/length.ml ocaml-4.01.0/testsuite/tests/basic-private/length.ml
--- ocaml-3.12.1/testsuite/tests/basic-private/length.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-private/length.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,4 +1,16 @@
-(* $Id: length.ml 10713 2010-10-08 11:53:19Z doligez $
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*             Pierre Weis, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(*
 
 A testbed file for private type abbreviation definitions.
 
diff -Nru ocaml-3.12.1/testsuite/tests/basic-private/length.mli ocaml-4.01.0/testsuite/tests/basic-private/length.mli
--- ocaml-3.12.1/testsuite/tests/basic-private/length.mli	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-private/length.mli	2012-10-17 20:09:16.000000000 +0000
@@ -1,4 +1,16 @@
-(* $Id: length.mli 10713 2010-10-08 11:53:19Z doligez $
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*             Pierre Weis, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(*
 
 A testbed file for private type abbreviation definitions.
 
diff -Nru ocaml-3.12.1/testsuite/tests/basic-private/tlength.ml ocaml-4.01.0/testsuite/tests/basic-private/tlength.ml
--- ocaml-3.12.1/testsuite/tests/basic-private/tlength.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/basic-private/tlength.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,4 +1,16 @@
-(* $Id: tlength.ml 10713 2010-10-08 11:53:19Z doligez $
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*             Pierre Weis, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(*
 
 A testbed file for private type abbreviation definitions.
 
diff -Nru ocaml-3.12.1/testsuite/tests/callback/Makefile ocaml-4.01.0/testsuite/tests/callback/Makefile
--- ocaml-3.12.1/testsuite/tests/callback/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/callback/Makefile	2013-05-17 12:03:58.000000000 +0000
@@ -1,27 +1,58 @@
-CC=$(NATIVECC) -I $(TOPDIR)/byterun
-
-default: run-byte run-opt
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+
+CC=$(NATIVECC) -I $(CTOPDIR)/byterun
+COMPFLAGS=-I $(OTOPDIR)/otherlibs/unix
+LD_PATH=$(TOPDIR)/otherlibs/unix
+
+.PHONY: default
+default:
+	@case " $(OTHERLIBRARIES) " in \
+	  *' unix '*) $(SET_LD_PATH) $(MAKE) run-byte run-opt;; \
+	esac
 
+.PHONY: common
 common:
 	@$(CC) -c callbackprim.c
 
+.PHONY: run-byte
 run-byte: common
 	@printf " ... testing 'bytecode':"
-	@$(OCAMLC) -c tcallback.ml
-	@$(OCAMLC) -o ./program -custom unix.cma callbackprim.$(O) tcallback.cmo
-	@./program > bytecode.result
-	@diff -q reference bytecode.result || (echo " => failed" && exit 1) 
-	@echo " => passed"
+	@$(OCAMLC) $(COMPFLAGS) -c tcallback.ml
+	@$(OCAMLC) $(COMPFLAGS) -o ./program -custom unix.cma \
+	           callbackprim.$(O) tcallback.cmo
+	@./program >bytecode.result
+	@$(DIFF) reference bytecode.result \
+	&& echo " => passed" || echo " => failed"
 
+.PHONY: run-opt
 run-opt: common
-	@printf " ... testing 'native':"
-	@$(OCAMLOPT) -c tcallback.ml
-	@$(OCAMLOPT) -o ./program unix.cmxa callbackprim.$(O) tcallback.cmx
-	@./program > native.result
-	@diff -q reference native.result || (echo " => failed" && exit 1) 
-	@echo " => passed"
+	@if $(BYTECODE_ONLY); then : ; else \
+	  printf " ... testing 'native':"; \
+	  $(OCAMLOPT) $(COMPFLAGS) -c tcallback.ml; \
+	  $(OCAMLOPT) $(COMPFLAGS) -o ./program unix.cmxa callbackprim.$(O) \
+	              tcallback.cmx; \
+	  ./program >native.result; \
+	  $(DIFF) reference native.result \
+	  && echo " => passed" || echo " => failed"; \
+	fi
+
+.PHONY: promote
+promote: defaultpromote
 
+.PHONY: clean
 clean: defaultclean
 	@rm -f *.result ./program
 
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/callback/callbackprim.c ocaml-4.01.0/testsuite/tests/callback/callbackprim.c
--- ocaml-3.12.1/testsuite/tests/callback/callbackprim.c	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/callback/callbackprim.c	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+/***********************************************************************/
+/*                                                                     */
+/*                                OCaml                                */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 1995 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the Q Public License version 1.0.               */
+/*                                                                     */
+/***********************************************************************/
+
 #include "mlvalues.h"
 #include "memory.h"
 #include "callback.h"
diff -Nru ocaml-3.12.1/testsuite/tests/callback/tcallback.ml ocaml-4.01.0/testsuite/tests/callback/tcallback.ml
--- ocaml-3.12.1/testsuite/tests/callback/tcallback.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/callback/tcallback.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,7 +1,21 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1995 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 external mycallback1 : ('a -> 'b) -> 'a -> 'b = "mycallback1"
 external mycallback2 : ('a -> 'b -> 'c) -> 'a -> 'b -> 'c = "mycallback2"
-external mycallback3 : ('a -> 'b -> 'c -> 'd) -> 'a -> 'b -> 'c -> 'd = "mycallback3"
-external mycallback4 : ('a -> 'b -> 'c -> 'd -> 'e) -> 'a -> 'b -> 'c -> 'd -> 'e = "mycallback4"
+external mycallback3 : ('a -> 'b -> 'c -> 'd) -> 'a -> 'b -> 'c -> 'd
+    = "mycallback3"
+external mycallback4 :
+    ('a -> 'b -> 'c -> 'd -> 'e) -> 'a -> 'b -> 'c -> 'd -> 'e = "mycallback4"
 
 let rec tak (x, y, z as _tuple) =
   if x > y then tak(tak (x-1, y, z), tak (y-1, z, x), tak (z-1, x, y))
@@ -65,4 +79,3 @@
   print_string(tripwire mycamlparam); print_newline();
   Sys.set_signal Sys.sigusr1 (Sys.Signal_handle sighandler);
   print_string(callbacksig ()); print_newline()
-
diff -Nru ocaml-3.12.1/testsuite/tests/embedded/.ignore ocaml-4.01.0/testsuite/tests/embedded/.ignore
--- ocaml-3.12.1/testsuite/tests/embedded/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/embedded/.ignore	2013-05-16 19:48:04.000000000 +0000
@@ -0,0 +1 @@
+caml
diff -Nru ocaml-3.12.1/testsuite/tests/embedded/.svnignore ocaml-4.01.0/testsuite/tests/embedded/.svnignore
--- ocaml-3.12.1/testsuite/tests/embedded/.svnignore	2011-05-17 12:08:13.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/embedded/.svnignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,10 +0,0 @@
-#!/bin/sh
-
-svn propset svn:ignore -F - . < program.result
-	@diff -q program.reference program.result > /dev/null || (echo " => failed" && exit 1)
-	@echo " => passed"
+	@./program >program.result
+	@$(DIFF) program.reference program.result >/dev/null \
+	&& echo " => passed" || echo " => failed"
+
+.PHONY: promote
+promote: defaultpromote
 
+.PHONY: clean
 clean: defaultclean
-	@rm -f *.result ./program
+	@rm -f *.result program
+	@rm -rf caml
 
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/embedded/cmcaml.ml ocaml-4.01.0/testsuite/tests/embedded/cmcaml.ml
--- ocaml-3.12.1/testsuite/tests/embedded/cmcaml.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/embedded/cmcaml.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,4 +1,16 @@
-(* Caml part of the code *)
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* OCaml part of the code *)
 
 let rec fib n =
   if n < 2 then 1 else fib(n-1) + fib(n-2)
diff -Nru ocaml-3.12.1/testsuite/tests/embedded/cmmain.c ocaml-4.01.0/testsuite/tests/embedded/cmmain.c
--- ocaml-3.12.1/testsuite/tests/embedded/cmmain.c	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/embedded/cmmain.c	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,16 @@
+/***********************************************************************/
+/*                                                                     */
+/*                                OCaml                                */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 1996 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the GNU Library General Public License, with    */
+/*  the special exception on linking described in file ../LICENSE.     */
+/*                                                                     */
+/***********************************************************************/
+
 /* Main program -- in C */
 
 #include 
@@ -9,7 +22,7 @@
 
 int main(int argc, char ** argv)
 {
-  printf("Initializing Caml code...\n");
+  printf("Initializing OCaml code...\n");
 #ifdef NO_BYTECODE_FILE
   caml_startup(argv);
 #else
diff -Nru ocaml-3.12.1/testsuite/tests/embedded/cmstub.c ocaml-4.01.0/testsuite/tests/embedded/cmstub.c
--- ocaml-3.12.1/testsuite/tests/embedded/cmstub.c	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/embedded/cmstub.c	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,16 @@
+/***********************************************************************/
+/*                                                                     */
+/*                                OCaml                                */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 1996 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the GNU Library General Public License, with    */
+/*  the special exception on linking described in file ../LICENSE.     */
+/*                                                                     */
+/***********************************************************************/
+
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/testsuite/tests/embedded/program.reference ocaml-4.01.0/testsuite/tests/embedded/program.reference
--- ocaml-3.12.1/testsuite/tests/embedded/program.reference	2010-04-08 12:47:08.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/embedded/program.reference	2012-02-10 16:15:24.000000000 +0000
@@ -1,4 +1,4 @@
-Initializing Caml code...
+Initializing OCaml code...
 Back in C code...
 Computing fib(20)...
 Result = 10946
diff -Nru ocaml-3.12.1/testsuite/tests/exotic-syntax/Makefile ocaml-4.01.0/testsuite/tests/exotic-syntax/Makefile
--- ocaml-3.12.1/testsuite/tests/exotic-syntax/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/exotic-syntax/Makefile	2013-02-19 10:23:37.000000000 +0000
@@ -0,0 +1,17 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#        Damien Doligez, projet Gallium, INRIA Rocquencourt             #
+#                                                                       #
+#   Copyright 2013 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+MAIN_MODULE=exotic
+
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/exotic-syntax/exotic.ml ocaml-4.01.0/testsuite/tests/exotic-syntax/exotic.ml
--- ocaml-3.12.1/testsuite/tests/exotic-syntax/exotic.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/exotic-syntax/exotic.ml	2013-06-11 07:32:49.000000000 +0000
@@ -0,0 +1,157 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Damien Doligez, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2013 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* Exotic OCaml syntax constructs found in the manual that are not *)
+(* used in the source of the OCaml distribution (even in the tests). *)
+
+(* Spaces between the parts of the ?label: token in a typexpr.
+   (used in bin-prot) *)
+type t1 = ? label : int -> int -> int;;
+
+(* Lazy in a pattern. (used in advi) *)
+function lazy y -> y;;
+
+(* Spaces between the parts of the ?label: token in a class-type. *)
+class c1 =
+  (fun ?label:x y -> object end : ? label : int -> int -> object end)
+;;
+
+(* type-class annotation in class-expr *)
+class c2 = (object end : object end);;
+
+(* virtual object field *)
+class virtual c3 = object val virtual x : int end;;
+class virtual c4 = object val mutable virtual x : int end;;
+
+(* abstract module type in a signature *)
+module type T = sig
+  module type U
+end;;
+
+(* associativity rules for patterns *)
+function Some Some x -> x | _ -> 0;;
+function Some `Tag x -> x | _ -> 0;;
+function `Tag Some x -> x | _ -> 0;;
+function `Tag `Tag x -> x | _ -> 0;;
+
+(* negative int32, int64, nativeint constants in patterns *)
+function -1l -> () | _ -> ();;
+function -1L -> () | _ -> ();;
+function -1n -> () | _ -> ();;
+
+(* surprising places where you can use an operator as a variable name *)
+function (+) -> (+);;
+function _ as (+) -> (+);;
+for (+) = 0 to 1 do () done;;
+
+(* access a class-type through an extended-module-path *)
+module F (X : sig end) = struct
+  class type t = object end
+end;;
+module M1 = struct end;;
+class type u = F(M1).t;;
+
+(* conjunctive constraints on tags (used by the compiler to print some
+   inferred types) *)
+type 'a t2 = [< `A of int & int & int ] as 'a;;
+
+(* same for a parameterless tag (triggers a very strange error message) *)
+(*type ('a, 'b) t3 = [< `A of & 'b ] as 'a;;*)
+
+(* negative float constant in a pattern *)
+function -1.0 -> 1 | _ -> 2;;
+
+(* combining language extensions (sec. 7.13 and 7.17) *)
+class c5 = object method f = 1 end;;
+object
+  inherit c5
+  method! f : type t . int = 2
+end;;
+
+(* private polymorphic method with local type *)
+object method private f : type t . int = 1 end;;
+
+
+(* More exotic: not even found in the manual (up to version 4.00),
+   but used in some programs found in the wild.
+*)
+
+(* local functor *)
+let module M (M1 : sig end) = struct end in ();;
+
+(* let-binding with a type coercion *)
+let x :> int = 1;;
+let x : int :> int = 1;;
+
+(* "begin end" as an alias for "()" *)
+begin end;;
+
+(* putting "virtual" before "mutable" or "private" *)
+class type virtual ct = object
+  val mutable virtual x : int
+  val virtual mutable y : int
+  method private virtual f : int
+  method virtual private g : int
+end;;
+class virtual c = object
+  val mutable virtual x : int
+  val virtual mutable y : int
+  method private virtual f : int
+  method virtual private g : int
+end;;
+
+(* Double-semicolon at the beginning of a module body [ocp-indent] *)
+module M2 = struct ;; end;;
+
+
+(**********************
+
+(* Most exotic: not found in the manual (up to 4.00) and not used
+   deliberately by anyone, but still implemented by the compiler. *)
+
+(* whitespace inside val!, method!, inherit! [found in ocamlspot] *)
+object
+  val x = 1
+  val ! x = 2
+  method m = 1
+  method ! m = 2
+  inherit ! object val x = 3 end
+end;;
+
+(* Using () as a constructor name [found in gettext] *)
+type t = ();;
+let x : t = ();;
+
+(* Using :: as a constructor name *)
+type t = :: of int * int;;
+
+(* Prefix syntax for :: in expressions *)
+(::) (1, 1);;
+
+(* Prefix syntax for :: in patterns *)
+function (::) (_, _) -> 1;;
+
+(* Unary plus in expressions (ints and float) *)
++1;;
++1l;;
++1L;;
++1n;;
++1.0;;
+
+(* Unary plus in patterns (ints and floats) *)
+function +1 -> ();;
+function +1l -> ();;
+function +1L -> ();;
+function +1n -> ();;
+function +1.0 -> ();;
+
+**********************)
diff -Nru ocaml-3.12.1/testsuite/tests/gc-roots/.svnignore ocaml-4.01.0/testsuite/tests/gc-roots/.svnignore
--- ocaml-3.12.1/testsuite/tests/gc-roots/.svnignore	2011-05-17 12:08:13.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/gc-roots/.svnignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,10 +0,0 @@
-#!/bin/sh
-
-svn propset svn:ignore -F - . < t
diff -Nru ocaml-3.12.1/testsuite/tests/gc-roots/globrootsprim.c ocaml-4.01.0/testsuite/tests/gc-roots/globrootsprim.c
--- ocaml-3.12.1/testsuite/tests/gc-roots/globrootsprim.c	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/gc-roots/globrootsprim.c	2013-02-25 03:01:31.000000000 +0000
@@ -1,3 +1,16 @@
+/***********************************************************************/
+/*                                                                     */
+/*                                OCaml                                */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 2001 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the GNU Library General Public License, with    */
+/*  the special exception on linking described in file ../LICENSE.     */
+/*                                                                     */
+/***********************************************************************/
+
 /* For testing global root registration */
 
 #include "mlvalues.h"
@@ -15,7 +28,7 @@
 
 value gb_classic_register(value v)
 {
-  struct block * b = stat_alloc(sizeof(struct block));
+  struct block * b = caml_stat_alloc(sizeof(struct block));
   b->v = v;
   caml_register_global_root(&(b->v));
   return (value) b;
@@ -35,7 +48,7 @@
 
 value gb_generational_register(value v)
 {
-  struct block * b = stat_alloc(sizeof(struct block));
+  struct block * b = caml_stat_alloc(sizeof(struct block));
   b->v = v;
   caml_register_generational_global_root(&(b->v));
   return (value) b;
@@ -52,5 +65,3 @@
   caml_remove_generational_global_root(&(Block_val(vblock)->v));
   return Val_unit;
 }
-
-
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/Makefile ocaml-4.01.0/testsuite/tests/letrec/Makefile
--- ocaml-3.12.1/testsuite/tests/letrec/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,16 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/backreferences.ml ocaml-4.01.0/testsuite/tests/letrec/backreferences.ml
--- ocaml-3.12.1/testsuite/tests/letrec/backreferences.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/backreferences.ml	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,30 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Gabriel Scherer, projet Gallium, INRIA Rocquencourt        *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* testing backreferences; some compilation scheme may handle
+   differently recursive references to a mutually-recursive RHS
+   depending on whether it is before or after in the bindings list *)
+type t = { x : t; y : t; z : t }
+
+let test =
+  let rec x = { x; y; z }
+      and y = { x; y; z }
+      and z = { x; y; z }
+  in
+  List.iter (fun (f, t_ref) ->
+    List.iter (fun t -> assert (f t == t_ref)) [x; y; z]
+  )
+    [
+      (fun t -> t.x), x;
+      (fun t -> t.y), y;
+      (fun t -> t.z), z;
+    ]
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/class_1.ml ocaml-4.01.0/testsuite/tests/letrec/class_1.ml
--- ocaml-3.12.1/testsuite/tests/letrec/class_1.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/class_1.ml	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,17 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Gabriel Scherer, projet Gallium, INRIA Rocquencourt        *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* class expression are compiled to recursive bindings *)
+class test =
+object
+  method x = 1
+end
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/class_2.ml ocaml-4.01.0/testsuite/tests/letrec/class_2.ml
--- ocaml-3.12.1/testsuite/tests/letrec/class_2.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/class_2.ml	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,20 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Gabriel Scherer, projet Gallium, INRIA Rocquencourt        *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* class expressions may also contain local recursive bindings *)
+class test =
+  let rec f = print_endline "f"; fun x -> g x
+      and g = print_endline "g"; fun x -> f x in
+object
+  method f : 'a 'b. 'a -> 'b = f
+  method g : 'a 'b. 'a -> 'b = g
+end
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/class_2.reference ocaml-4.01.0/testsuite/tests/letrec/class_2.reference
--- ocaml-3.12.1/testsuite/tests/letrec/class_2.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/class_2.reference	2012-01-13 17:46:21.000000000 +0000
@@ -0,0 +1,2 @@
+f
+g
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/evaluation_order_1.ml ocaml-4.01.0/testsuite/tests/letrec/evaluation_order_1.ml
--- ocaml-3.12.1/testsuite/tests/letrec/evaluation_order_1.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/evaluation_order_1.ml	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,32 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Gabriel Scherer, projet Gallium, INRIA Rocquencourt        *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* test evaluation order
+
+   'y' is translated into a constant, and is therefore considered
+   non-recursive. With the current letrec compilation method,
+   it should be evaluated before x and z.
+*)
+type tree = Tree of tree list
+
+let test =
+  let rec x = (print_endline "x"; Tree [y; z])
+  and y = (print_endline "y"; Tree [])
+  and z = (print_endline "z"; Tree [x])
+  in
+  match (x, y, z) with
+    | (Tree [y1; z1], Tree[], Tree[x1]) ->
+      assert (y1 == y);
+      assert (z1 == z);
+      assert (x1 == x)
+    | _ ->
+      assert false
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/evaluation_order_1.reference ocaml-4.01.0/testsuite/tests/letrec/evaluation_order_1.reference
--- ocaml-3.12.1/testsuite/tests/letrec/evaluation_order_1.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/evaluation_order_1.reference	2012-01-13 17:46:21.000000000 +0000
@@ -0,0 +1,3 @@
+y
+x
+z
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/evaluation_order_2.ml ocaml-4.01.0/testsuite/tests/letrec/evaluation_order_2.ml
--- ocaml-3.12.1/testsuite/tests/letrec/evaluation_order_2.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/evaluation_order_2.ml	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,30 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Gabriel Scherer, projet Gallium, INRIA Rocquencourt        *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* A variant of evaluation_order_1.ml where the side-effects
+   are inside the blocks. Note that this changes the evaluation
+   order, as y is considered recursive.
+*)
+type tree = Tree of tree list
+
+let test =
+  let rec x = (Tree [(print_endline "x"; y); z])
+  and y = Tree (print_endline "y"; [])
+  and z = Tree (print_endline "z"; [x])
+  in
+  match (x, y, z) with
+    | (Tree [y1; z1], Tree[], Tree[x1]) ->
+      assert (y1 == y);
+      assert (z1 == z);
+      assert (x1 == x)
+    | _ ->
+      assert false
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/evaluation_order_2.reference ocaml-4.01.0/testsuite/tests/letrec/evaluation_order_2.reference
--- ocaml-3.12.1/testsuite/tests/letrec/evaluation_order_2.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/evaluation_order_2.reference	2012-01-13 17:46:21.000000000 +0000
@@ -0,0 +1,3 @@
+x
+y
+z
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/evaluation_order_3.ml ocaml-4.01.0/testsuite/tests/letrec/evaluation_order_3.ml
--- ocaml-3.12.1/testsuite/tests/letrec/evaluation_order_3.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/evaluation_order_3.ml	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,23 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Gabriel Scherer, projet Gallium, INRIA Rocquencourt        *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+type t = { x : t; y : t }
+
+let p = print_endline
+
+let test =
+  let rec x = p "x"; { x = (p "x_x"; x); y = (p "x_y"; y) }
+      and y = p "y"; { x = (p "y_x"; x); y = (p "y_y"; y) }
+   in
+   assert (x.x == x); assert (x.y == y);
+   assert (y.x == x); assert (y.y == y);
+   ()
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/evaluation_order_3.reference ocaml-4.01.0/testsuite/tests/letrec/evaluation_order_3.reference
--- ocaml-3.12.1/testsuite/tests/letrec/evaluation_order_3.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/evaluation_order_3.reference	2012-01-13 17:46:21.000000000 +0000
@@ -0,0 +1,6 @@
+x
+x_y
+x_x
+y
+y_y
+y_x
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/float_block_1.ml ocaml-4.01.0/testsuite/tests/letrec/float_block_1.ml
--- ocaml-3.12.1/testsuite/tests/letrec/float_block_1.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/float_block_1.ml	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,22 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Gabriel Scherer, projet Gallium, INRIA Rocquencourt        *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* a bug in cmmgen.ml provokes a change in compilation order between
+   ocamlc and ocamlopt in certain letrec-bindings involving float
+   arrays *)
+let test =
+  let rec x = print_endline "x"; [| 1; 2; 3 |]
+      and y = print_endline "y"; [| 1.; 2.; 3. |]
+  in
+  assert (x = [| 1; 2; 3 |]);
+  assert (y = [| 1.; 2.; 3. |]);
+  ()
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/float_block_1.reference ocaml-4.01.0/testsuite/tests/letrec/float_block_1.reference
--- ocaml-3.12.1/testsuite/tests/letrec/float_block_1.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/float_block_1.reference	2012-01-13 17:46:21.000000000 +0000
@@ -0,0 +1,2 @@
+x
+y
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/float_block_2.ml ocaml-4.01.0/testsuite/tests/letrec/float_block_2.ml
--- ocaml-3.12.1/testsuite/tests/letrec/float_block_2.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/float_block_2.ml	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,19 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Gabriel Scherer, projet Gallium, INRIA Rocquencourt        *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* a bug in cmmgen.ml provokes a segfault in certain natively compiled
+   letrec-bindings involving float arrays *)
+let test =
+  let rec x = [| y; y |] and y = 1. in
+  assert (x = [| 1.; 1. |]);
+  assert (y = 1.);
+  ()
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/lists.ml ocaml-4.01.0/testsuite/tests/letrec/lists.ml
--- ocaml-3.12.1/testsuite/tests/letrec/lists.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/lists.ml	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,20 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Gabriel Scherer, projet Gallium, INRIA Rocquencourt        *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* a test with lists, because cyclic lists are fun *)
+let test =
+  let rec li = 0::1::2::3::4::5::6::7::8::9::li in
+  match li with
+    | 0::1::2::3::4::5::6::7::8::9::
+        0::1::2::3::4::5::6::7::8::9::li' ->
+      assert (li == li')
+    | _ -> assert false
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/mixing_value_closures_1.ml ocaml-4.01.0/testsuite/tests/letrec/mixing_value_closures_1.ml
--- ocaml-3.12.1/testsuite/tests/letrec/mixing_value_closures_1.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/mixing_value_closures_1.ml	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,20 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Gabriel Scherer, projet Gallium, INRIA Rocquencourt        *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* mixing values and closures may exercise interesting code paths *)
+type t = A of (int -> int)
+let test =
+  let rec x = A f
+  and f = function
+    | 0 -> 2
+    | n -> match x with A g -> g 0
+  in assert (f 1 = 2)
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/mixing_value_closures_2.ml ocaml-4.01.0/testsuite/tests/letrec/mixing_value_closures_2.ml
--- ocaml-3.12.1/testsuite/tests/letrec/mixing_value_closures_2.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/mixing_value_closures_2.ml	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,20 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Gabriel Scherer, projet Gallium, INRIA Rocquencourt        *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* a polymorphic variant of test3.ml; found a real bug once *)
+let test =
+  let rec x = `A f
+  and f = function
+    | 0 -> 2
+    | n -> match x with `A g -> g 0
+  in
+  assert (f 1 = 2)
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/mutual_functions.ml ocaml-4.01.0/testsuite/tests/letrec/mutual_functions.ml
--- ocaml-3.12.1/testsuite/tests/letrec/mutual_functions.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/mutual_functions.ml	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,23 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Gabriel Scherer, projet Gallium, INRIA Rocquencourt        *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* a simple test with mutually recursive functions *)
+let test =
+  let rec even = function
+    | 0 -> true
+    | n -> odd (n - 1)
+  and odd = function
+    | 0 -> false
+    | n -> even (n - 1)
+  in
+  List.iter (fun i -> assert (even i <> odd i && even i = (i mod 2 = 0)))
+    [0;1;2;3;4;5;6]
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/record_with.ml ocaml-4.01.0/testsuite/tests/letrec/record_with.ml
--- ocaml-3.12.1/testsuite/tests/letrec/record_with.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/record_with.ml	2013-05-22 12:56:54.000000000 +0000
@@ -0,0 +1,37 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Damien Doligez, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+
+(* A regression test for both PR#4141 and PR#5819: when a recursive
+   variable is defined by a { record with ... } expression.
+*)
+
+type t = {
+  self : t;
+  t0 : int;
+  t1 : int;
+  t2 : int;
+  t3 : int;
+  t4 : int;
+};;
+let rec t = {
+  self = t;
+  t0 = 42;
+  t1 = 42;
+  t2 = 42;
+  t3 = 42;
+  t4 = 42;
+};;
+
+let rec self = { t with self=self } in
+Printf.printf "%d\n" self.self.t0
+;;
diff -Nru ocaml-3.12.1/testsuite/tests/letrec/record_with.reference ocaml-4.01.0/testsuite/tests/letrec/record_with.reference
--- ocaml-3.12.1/testsuite/tests/letrec/record_with.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/letrec/record_with.reference	2013-05-22 12:56:54.000000000 +0000
@@ -0,0 +1 @@
+42
diff -Nru ocaml-3.12.1/testsuite/tests/lib-bigarray/Makefile ocaml-4.01.0/testsuite/tests/lib-bigarray/Makefile
--- ocaml-3.12.1/testsuite/tests/lib-bigarray/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-bigarray/Makefile	2013-05-17 12:03:58.000000000 +0000
@@ -1,4 +1,20 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 LIBRARIES=unix bigarray
+ADD_COMPFLAGS=-I $(OTOPDIR)/otherlibs/$(UNIXLIBVAR)unix \
+              -I $(OTOPDIR)/otherlibs/bigarray
+LD_PATH=$(TOPDIR)/otherlibs/$(UNIXLIBVAR)unix:$(TOPDIR)/otherlibs/bigarray
 
-include ../../makefiles/Makefile.several
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-bigarray/bigarrays.ml ocaml-4.01.0/testsuite/tests/lib-bigarray/bigarrays.ml
--- ocaml-3.12.1/testsuite/tests/lib-bigarray/bigarrays.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-bigarray/bigarrays.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 open Bigarray
 open Printf
 open Complex
@@ -139,14 +151,14 @@
   let from_list kind vals =
     let a = Array1.create kind c_layout (List.length vals) in
     let rec set i = function
-        [] -> () 
+        [] -> ()
       | hd :: tl -> a.{i} <- hd; set (i+1) tl in
     set 0 vals;
     a in
   let from_list_fortran kind vals =
     let a = Array1.create kind fortran_layout (List.length vals) in
     let rec set i = function
-        [] -> () 
+        [] -> ()
       | hd :: tl -> a.{i} <- hd; set (i+1) tl in
     set 1 vals;
     a in
@@ -157,7 +169,7 @@
   for i = 0 to 2 do test (i+1) a.{i} i done;
   test 4 true (try ignore a.{3}; false with Invalid_argument _ -> true);
   test 5 true (try ignore a.{-1}; false with Invalid_argument _ -> true);
-    
+
   let b = Array1.create float64 fortran_layout 3 in
   for i = 1 to 3 do b.{i} <- float i done;
   for i = 1 to 3 do test (5 + i) b.{i} (float i) done;
@@ -180,7 +192,7 @@
   let a = Array1.create int c_layout 3 in
   for i = 0 to 2 do Array1.unsafe_set a i i done;
   for i = 0 to 2 do test (i+1) (Array1.unsafe_get a i) i done;
-    
+
   let b = Array1.create float64 fortran_layout 3 in
   for i = 1 to 3 do Array1.unsafe_set b i (float i) done;
   for i = 1 to 3 do test (5 + i) (Array1.unsafe_get b i) (float i) done;
@@ -459,7 +471,7 @@
   test 3 true (try ignore a.{-1,0}; false with Invalid_argument _ -> true);
   test 4 true (try ignore a.{0,3}; false with Invalid_argument _ -> true);
   test 5 true (try ignore a.{0,-1}; false with Invalid_argument _ -> true);
-    
+
   let b = Array2.create float32 fortran_layout 3 3 in
   for i = 1 to 3 do for j = 1 to 3 do b.{i,j} <- float(i-j) done done;
   let ok = ref true in
@@ -480,7 +492,7 @@
     for j = 0 to 2 do if Array2.unsafe_get a i j <> i-j then ok := false done
   done;
   test 1 true !ok;
-    
+
   let b = Array2.create float32 fortran_layout 3 3 in
   for i = 1 to 3 do for j = 1 to 3 do Array2.unsafe_set b i j (float(i-j)) done done;
   let ok = ref true in
@@ -611,7 +623,7 @@
      if Int32.to_int a.{i,j,k} <> (i lsl 4) + (j lsl 2) + k then ok := false
   done done done;
   test 1 true !ok;
-    
+
   let b = Array3.create int64 fortran_layout 2 3 4 in
   for i = 1 to 2 do for j = 1 to 3 do for k = 1 to 4 do
      b.{i,j,k} <- Int64.of_int((i lsl 4) + (j lsl 2) + k)
@@ -764,7 +776,7 @@
   Sys.remove mapped_file;
 
   ()
-                  
+
 (********* End of test *********)
 
 let _ =
diff -Nru ocaml-3.12.1/testsuite/tests/lib-bigarray/fftba.ml ocaml-4.01.0/testsuite/tests/lib-bigarray/fftba.ml
--- ocaml-3.12.1/testsuite/tests/lib-bigarray/fftba.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-bigarray/fftba.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: fftba.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 open Bigarray
 
 let pi = 3.14159265358979323846
@@ -22,17 +20,17 @@
         (py : (float, float64_elt, c_layout) Array1.t) np =
   let i = ref 2 in
   let m = ref 1 in
-  
+
   while (!i < np) do
-    i := !i + !i; 
+    i := !i + !i;
     m := !m + 1
   done;
 
-  let n = !i in  
-  
+  let n = !i in
+
   if n <> np then begin
     for i = np+1 to n do
-      px.{i} <- 0.0; 
+      px.{i} <- 0.0;
       py.{i} <- 0.0
     done;
     print_string "Use "; print_int n;
@@ -41,7 +39,7 @@
 
   let n2 = ref(n+n) in
   for k = 1 to !m-1 do
-    n2 := !n2 / 2; 
+    n2 := !n2 / 2;
     let n4 = !n2 / 4 in
     let e  = tpi /. float !n2 in
 
@@ -54,7 +52,7 @@
       let ss3 = sin(a3) in
       let is = ref j in
       let id = ref(2 * !n2) in
-  
+
         while !is < n do
           let i0r = ref !is in
           while !i0r < n do
@@ -74,13 +72,13 @@
              let r1 = r1 +. s2 in
              let s2 = r2 -. s1 in
              let r2 = r2 +. s1 in
-             px.{i2} <- r1*.cc1 -. s2*.ss1; 
+             px.{i2} <- r1*.cc1 -. s2*.ss1;
              py.{i2} <- -.s2*.cc1 -. r1*.ss1;
              px.{i3} <- s3*.cc3 +. r2*.ss3;
              py.{i3} <- r2*.cc3 -. s3*.ss3;
              i0r := i0 + !id
           done;
-          is := 2 * !id - !n2 + j; 
+          is := 2 * !id - !n2 + j;
           id := 4 * !id
         done
     done
@@ -92,7 +90,7 @@
 
   let is = ref 1 in
   let id = ref 4 in
-  
+
   while !is < n do
     let i0r = ref !is in
     while !i0r <= n do
@@ -106,7 +104,7 @@
       py.{i1} <- r1 -. py.{i1};
       i0r := i0 + !id
     done;
-    is := 2 * !id - 1; 
+    is := 2 * !id - 1;
     id := 4 * !id
   done;
 
@@ -115,11 +113,11 @@
 (*************************)
 
   let j = ref 1 in
-  
+
   for i = 1 to n - 1 do
     if i < !j then begin
       let xt = px.{!j} in
-      px.{!j} <- px.{i}; 
+      px.{!j} <- px.{i};
       px.{i} <- xt;
       let xt = py.{!j} in
       py.{!j} <- py.{i};
@@ -127,7 +125,7 @@
     end;
     let k = ref(n / 2) in
     while !k < !j do
-      j := !j - !k; 
+      j := !j - !k;
       k := !k / 2
     done;
     j := !j + !k
@@ -173,12 +171,12 @@
   for i = 0 to np-1 do
       let a = abs_float(pxr.{i+1} -. float i) in
       if !zr < a then begin
-         zr := a; 
+         zr := a;
          kr := i
       end;
       let a = abs_float(pxi.{i+1}) in
       if !zi < a then begin
-         zi := a; 
+         zi := a;
          ki := i
       end
   done;
@@ -194,4 +192,3 @@
 
 let _ =
   let np = ref 16 in for i = 1 to 13 do test !np; np := !np*2 done
-
diff -Nru ocaml-3.12.1/testsuite/tests/lib-bigarray/pr5115.ml ocaml-4.01.0/testsuite/tests/lib-bigarray/pr5115.ml
--- ocaml-3.12.1/testsuite/tests/lib-bigarray/pr5115.ml	2010-11-11 17:08:07.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-bigarray/pr5115.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2010 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* PR#5115 - multiple evaluation of bigarray expr *)
 
 open Bigarray
@@ -10,4 +22,3 @@
   let y = Array1.of_array float64 fortran_layout [| 1. |] in
   (f y).{1};
   (f y).{1} <- 3.14
-
diff -Nru ocaml-3.12.1/testsuite/tests/lib-bigarray-2/Makefile ocaml-4.01.0/testsuite/tests/lib-bigarray-2/Makefile
--- ocaml-3.12.1/testsuite/tests/lib-bigarray-2/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-bigarray-2/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,6 +1,19 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 LIBRARIES=unix bigarray
 C_FILES=bigarrfstub
 F_FILES=bigarrf
 
-include ../../makefiles/Makefile.several
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-bigarray-2/bigarrf.f ocaml-4.01.0/testsuite/tests/lib-bigarray-2/bigarrf.f
--- ocaml-3.12.1/testsuite/tests/lib-bigarray-2/bigarrf.f	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-bigarray-2/bigarrf.f	2012-07-30 18:04:46.000000000 +0000
@@ -24,4 +24,3 @@
  300	   format(/1X, I3, 2X, 10F6.1/)
  200	continue
 	end
-
diff -Nru ocaml-3.12.1/testsuite/tests/lib-bigarray-2/bigarrfml.ml ocaml-4.01.0/testsuite/tests/lib-bigarray-2/bigarrfml.ml
--- ocaml-3.12.1/testsuite/tests/lib-bigarray-2/bigarrfml.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-bigarray-2/bigarrfml.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2000 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 open Bigarray
 open Printf
 
@@ -60,4 +72,3 @@
   test 2 a.{2,1} 201.0;
   test 3 a.{1,2} 102.0;
   test 4 a.{5,4} 504.0;
-
diff -Nru ocaml-3.12.1/testsuite/tests/lib-bigarray-2/bigarrfstub.c ocaml-4.01.0/testsuite/tests/lib-bigarray-2/bigarrfstub.c
--- ocaml-3.12.1/testsuite/tests/lib-bigarray-2/bigarrfstub.c	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-bigarray-2/bigarrfstub.c	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+/***********************************************************************/
+/*                                                                     */
+/*                                OCaml                                */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 2000 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the Q Public License version 1.0.               */
+/*                                                                     */
+/***********************************************************************/
+
 #include 
 #include 
 #include 
@@ -57,4 +69,3 @@
   printtab_(Data_bigarray_val(ba), &dimx, &dimy);
   return Val_unit;
 }
-
diff -Nru ocaml-3.12.1/testsuite/tests/lib-digest/.svnignore ocaml-4.01.0/testsuite/tests/lib-digest/.svnignore
--- ocaml-3.12.1/testsuite/tests/lib-digest/.svnignore	2011-05-17 12:08:13.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-digest/.svnignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,10 +0,0 @@
-#!/bin/sh
-
-svn propset svn:ignore -F - . < 1 && (Sys.argv.(1) = "-benchmark") then begin
     let s = String.make 50000 'a' in
     let num_iter = 1000 in
-    time "Caml implementation" num_iter
+    time "OCaml implementation" num_iter
       (fun () ->
         let ctx = init() in
         update ctx s 0 (String.length s);
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/.ignore ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/.ignore
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/.ignore	2013-05-16 19:48:04.000000000 +0000
@@ -0,0 +1,6 @@
+main
+static
+custom
+custom.exe
+marshal.data
+caml
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/.svnignore ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/.svnignore
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/.svnignore	2011-05-17 12:08:13.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/.svnignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,15 +0,0 @@
-#!/bin/sh
-
-svn propset svn:ignore -F - . < main.result
-	@diff -q main.reference main.result > /dev/null || (echo " => failed" && exit 1)
-	@echo " => passed"
+	@$(OCAMLRUN) ./main plug1.cma plug2.cma >main.result
+	@$(DIFF) main.reference main.result >/dev/null \
+	&& echo " => passed" || echo " => failed"
 
 	@printf " ... testing 'static'"
-	@export LD_LIBRARY_PATH=`pwd` && ./static > static.result
-	@diff -q static.reference static.result > /dev/null || (echo " => failed" && exit 1)
-	@echo " => passed"
+	@$(OCAMLRUN) ./static >static.result
+	@$(DIFF) static.reference static.result >/dev/null \
+	&& echo " => passed" || echo " => failed"
 
 	@printf " ... testing 'custom'"
-	@export LD_LIBRARY_PATH=`pwd` && ./custom > custom.result
-	@diff -q custom.reference custom.result > /dev/null || (echo " => failed" && exit 1)
-	@echo " => passed"
+	@./custom$(EXE) >custom.result
+	@$(DIFF) custom.reference custom.result >/dev/null \
+	&& echo " => passed" || echo " => failed"
+
+.PHONY: promote
+promote: defaultpromote
 
+.PHONY: clean
 clean: defaultclean
-	@rm -f ./main ./static ./custom *.result
+	@rm -f main static custom custom.exe *.result marshal.data
+	@rm -rf caml
 
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/custom.reference ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/custom.reference
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/custom.reference	2010-01-25 14:17:10.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/custom.reference	2012-03-13 14:50:41.000000000 +0000
@@ -1,5 +1,5 @@
-ABCDEF
 This is stub2, calling stub1:
 This is stub1!
 Ok!
 This is stub1!
+ABCDEF
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/main.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/main.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/main.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/main.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,17 +1,49 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+let f x = print_string "This is Main.f\n"; x
+
+let () = Registry.register f
+
+let _ =
   Dynlink.init ();
   Dynlink.allow_unsafe_modules true;
   for i = 1 to Array.length Sys.argv - 1 do
     let name = Sys.argv.(i) in
     Printf.printf "Loading %s\n" name; flush stdout;
-    try 
+    try
       if name.[0] = '-'
-      then Dynlink.loadfile_private 
-	(String.sub name 1 (String.length name - 1))
+      then Dynlink.loadfile_private
+        (String.sub name 1 (String.length name - 1))
       else Dynlink.loadfile name
     with
       | Dynlink.Error err ->
-	  Printf.printf "Dynlink error: %s\n" 
-	    (Dynlink.error_message err)
+          Printf.printf "Dynlink error: %s\n"
+            (Dynlink.error_message err)
       | exn ->
-	  Printf.printf "Error: %s\n" (Printexc.to_string exn)
-  done
+          Printf.printf "Error: %s\n" (Printexc.to_string exn)
+  done;
+  flush stdout;
+  try
+    let oc = open_out_bin "marshal.data" in
+    Marshal.to_channel oc (Registry.get_functions()) [Marshal.Closures];
+    close_out oc;
+    let ic = open_in_bin "marshal.data" in
+    let l = (Marshal.from_channel ic : (int -> int) list) in
+    close_in ic;
+    List.iter
+      (fun f ->
+        let res = f 0 in
+        Printf.printf "Result is: %d\n" res)
+      l
+  with Failure s ->
+    Printf.printf "Failure: %s\n" s
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/main.reference ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/main.reference
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/main.reference	2010-01-25 14:17:10.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/main.reference	2012-03-13 14:50:41.000000000 +0000
@@ -1,7 +1,13 @@
 Loading plug1.cma
+This is stub1!
 ABCDEF
 Loading plug2.cma
-This is stub1!
 This is stub2, calling stub1:
 This is stub1!
 Ok!
+This is Plug2.f
+Result is: 2
+This is Plug1.f
+Result is: 1
+This is Main.f
+Result is: 0
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/plug1.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/plug1.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/plug1.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/plug1.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,4 +1,19 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 external stub1: unit -> string = "stub1"
 
+let f x = print_string "This is Plug1.f\n"; x + 1
+
+let () = Registry.register f
 
 let () = print_endline (stub1 ())
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/plug2.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/plug2.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/plug2.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/plug2.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,4 +1,19 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 external stub2: unit -> unit = "stub2"
 
+let f x = print_string "This is Plug2.f\n"; x + 2
+
+let () = Registry.register f
 
 let () = stub2 ()
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/registry.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/registry.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/registry.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/registry.ml	2013-04-04 15:27:13.000000000 +0000
@@ -0,0 +1,19 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+let functions = ref ([]: (int -> int) list)
+
+let register f =
+  functions := f :: !functions
+
+let get_functions () =
+  !functions
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/static.reference ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/static.reference
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/static.reference	2010-01-25 14:17:10.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/static.reference	2012-03-13 14:50:41.000000000 +0000
@@ -1,5 +1,5 @@
-ABCDEF
 This is stub1!
+ABCDEF
 This is stub2, calling stub1:
 This is stub1!
 Ok!
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/stub1.c ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/stub1.c
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/stub1.c	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/stub1.c	2013-04-04 15:27:13.000000000 +0000
@@ -1,3 +1,15 @@
+/***********************************************************************/
+/*                                                                     */
+/*                                OCaml                                */
+/*                                                                     */
+/*                        Alain Frisch, LexiFi                         */
+/*                                                                     */
+/*  Copyright 2007 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the Q Public License version 1.0.               */
+/*                                                                     */
+/***********************************************************************/
+
 #include "caml/mlvalues.h"
 #include "caml/memory.h"
 #include "caml/alloc.h"
@@ -5,7 +17,7 @@
 
 value stub1() {
   CAMLlocal1(x);
-  printf("This is stub1!\n");
+  printf("This is stub1!\n"); fflush(stdout);
   x = caml_copy_string("ABCDEF");
   return x;
 }
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/stub2.c ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/stub2.c
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-bytecode/stub2.c	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-bytecode/stub2.c	2013-04-04 15:27:13.000000000 +0000
@@ -1,3 +1,15 @@
+/***********************************************************************/
+/*                                                                     */
+/*                                OCaml                                */
+/*                                                                     */
+/*                        Alain Frisch, LexiFi                         */
+/*                                                                     */
+/*  Copyright 2007 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the Q Public License version 1.0.               */
+/*                                                                     */
+/***********************************************************************/
+
 #include "caml/mlvalues.h"
 #include "caml/memory.h"
 #include "caml/alloc.h"
@@ -6,8 +18,8 @@
 extern value stub1();
 
 value stub2() {
-  printf("This is stub2, calling stub1:\n");
+  printf("This is stub2, calling stub1:\n"); fflush(stdout);
   stub1();
-  printf("Ok!\n");
+  printf("Ok!\n"); fflush(stdout);
   return Val_unit;
 }
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-csharp/Makefile ocaml-4.01.0/testsuite/tests/lib-dynlink-csharp/Makefile
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-csharp/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-csharp/Makefile	2013-05-17 15:06:37.000000000 +0000
@@ -1,58 +1,97 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 CSC=csc
 
-default: prepare bytecode bytecode-dll native native-dll
+COMPFLAGS=-I $(OTOPDIR)/otherlibs/bigarray
+LD_PATH=$(TOPDIR)/otherlibs/bigarray
+
+.PHONY: default
+default:
+	@if $(BYTECODE_ONLY); then : ; else \
+	  $(SET_LD_PATH) $(MAKE) all; \
+	fi
+
+.PHONY: all
+all: prepare bytecode bytecode-dll native native-dll
 
+.PHONY: prepare
 prepare:
 	@$(OCAMLC) -c plugin.ml
 	@$(OCAMLOPT) -o plugin.cmxs -shared plugin.ml
 
+.PHONY: bytecode
 bytecode:
 	@printf " ... testing 'bytecode':"
-	@if [ ! `which $(CSC) > /dev/null` ]; then \
-	  echo " => passed"; \
+	@if [ ! `which $(CSC) >/dev/null 2>&1` ]; then \
+	  echo " => skipped"; \
 	else \
 	  $(OCAMLC) -output-obj -o main.dll dynlink.cma main.ml entry.c; \
 	  $(CSC) /out:main.exe main.cs; \
 	  ./main.exe > bytecode.result; \
-	  diff -q bytecode.reference bytecode.result > /dev/null && echo " => passed" || echo " => failed"; \
+	  $(DIFF) bytecode.reference bytecode.result >/dev/null \
+	  && echo " => passed" || echo " => failed"; \
 	fi
 
+.PHONY: bytecode-dll
 bytecode-dll:
 	@printf " ... testing 'bytecode-dll':"
-	@if [ ! `which $(CSC) > /dev/null` ]; then \
-	  echo " => passed"; \
+	@if [ ! `which $(CSC) > /dev/null 2>&1` ]; then \
+	  echo " => skipped"; \
 	else \
 	  $(OCAMLC) -output-obj -o main_obj.$(O) dynlink.cma entry.c main.ml; \
-	  $(MKDLL) -maindll -o main.dll main_obj.$(O) entry.$(O) ../../byterun/libcamlrun.$(A)  $(BYTECCLIBS) -v; \
+	  $(MKDLL) -maindll -o main.dll main_obj.$(O) entry.$(O) \
+	           ../../byterun/libcamlrun.$(A)  $(BYTECCLIBS) -v; \
 	  $(CSC) /out:main.exe main.cs; \
-	  ./main.exe > bytecode.result; \
-	  diff -q bytecode.reference bytecode.result > /dev/null && echo " => passed" || echo " => failed"; \
+	  ./main.exe >bytecode.result; \
+	  $(DIFF) bytecode.reference bytecode.result >/dev/null \
+	  && echo " => passed" || echo " => failed"; \
 	fi
 
+.PHONY: native
 native:
 	@printf " ... testing 'native':"
-	@if [ ! `which $(CSC) > /dev/null` ]; then \
-	  echo " => passed"; \
+	@if [ ! `which $(CSC) > /dev/null 2>&1` ]; then \
+	  echo " => skipped"; \
 	else \
 	  $(OCAMLOPT) -output-obj -o main.dll dynlink.cmxa entry.c main.ml; \
 	  $(CSC) /out:main.exe main.cs; \
 	  ./main.exe > native.result; \
-	  diff -q native.reference native.result > /dev/null && echo " => passed" || echo " => failed"; \
+	  $(DIFF) native.reference native.result > /dev/null \
+	  && echo " => passed" || echo " => failed"; \
 	fi
 
+.PHONY: native-dll
 native-dll:
 	@printf " ... testing 'native-dll':"
-	@if [ ! `which $(CSC) > /dev/null` ]; then \
-	  echo " => passed"; \
+	@if [ ! `which $(CSC) > /dev/null 2>&1` ]; then \
+	  echo " => skipped"; \
 	else \
-	  $(OCAMLOPT) -output-obj -o main_obj.$(O) dynlink.cmxa entry.c main.ml; \
-	  $(MKDLL) -maindll -o main.dll main_obj.$(O) entry.$(O) ../../asmrun/libasmrun.lib -v; \
+	  $(OCAMLOPT) -output-obj -o main_obj.$(O) dynlink.cmxa entry.c \
+	              main.ml; \
+	  $(MKDLL) -maindll -o main.dll main_obj.$(O) entry.$(O) \
+	           ../../asmrun/libasmrun.lib -v; \
 	  $(CSC) /out:main.exe main.cs; \
 	  ./main.exe > native.result; \
-	  diff -q native.reference native.result > /dev/null && echo " => passed" || echo " => failed"; \
+	  $(DIFF) native.reference native.result >/dev/null \
+	  && echo " => passed" || echo " => failed"; \
 	fi
 
+.PHONY: promote
+promote: defaultpromote
+
+.PHONY: clean
 clean: defaultclean
-	@rm -f *.result *.exe *.dll
+	@rm -f *.result *.exe *.dll *.so *.obj *.o
 
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-csharp/bytecode.reference ocaml-4.01.0/testsuite/tests/lib-dynlink-csharp/bytecode.reference
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-csharp/bytecode.reference	2010-04-08 12:44:07.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-csharp/bytecode.reference	2012-02-10 16:15:24.000000000 +0000
@@ -1,4 +1,4 @@
-Now starting the Caml engine.
+Now starting the OCaml engine.
 Main is running.
 Loading ../../../otherlibs/bigarray/bigarray.cma
 I'm the plugin.
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-csharp/entry.c ocaml-4.01.0/testsuite/tests/lib-dynlink-csharp/entry.c
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-csharp/entry.c	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-csharp/entry.c	2013-05-17 15:06:37.000000000 +0000
@@ -1,3 +1,15 @@
+/***********************************************************************/
+/*                                                                     */
+/*                                OCaml                                */
+/*                                                                     */
+/*                        Alain Frisch, LexiFi                         */
+/*                                                                     */
+/*  Copyright 2007 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the Q Public License version 1.0.               */
+/*                                                                     */
+/***********************************************************************/
+
 #include 
 #include 
 #include 
@@ -5,7 +17,23 @@
 #include 
 #include 
 
-__declspec(dllexport) void __stdcall start_caml_engine() {
+#if !defined(OPENSTEP) && (defined(__WIN32__) && !defined(__CYGWIN__))
+#  if defined(_MSC_VER) || defined(__MINGW32__)
+#    define _DLLAPI __declspec(dllexport)
+#  else
+#    define _DLLAPI extern
+#  endif 
+#  if defined(__MINGW32__) || defined(UNDER_CE) 
+#    define _CALLPROC
+#  else
+#    define _CALLPROC __stdcall
+#  endif
+#elif defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__) >= 303
+#  define _DLLAPI __attribute__((visibility("default")))
+#  define _CALLPROC
+#endif /* WIN32 && !CYGWIN */
+
+_DLLAPI void _CALLPROC start_caml_engine() {
   char * argv[2];
   argv[0] = "--";
   argv[1] = NULL;
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-csharp/main.cs ocaml-4.01.0/testsuite/tests/lib-dynlink-csharp/main.cs
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-csharp/main.cs	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-csharp/main.cs	2012-07-17 15:31:12.000000000 +0000
@@ -5,7 +5,7 @@
   public static extern void start_caml_engine();
 
   public static void Main() {
-    System.Console.WriteLine("Now starting the Caml engine.");
+    System.Console.WriteLine("Now starting the OCaml engine.");
     start_caml_engine();
   }
 }
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-csharp/main.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-csharp/main.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-csharp/main.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-csharp/main.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let load s =
   Printf.printf "Loading %s\n%!" s;
   try
@@ -17,7 +29,6 @@
       "../../../otherlibs/bigarray/bigarray.cma",
       "plugin.cmo"
   in
-  load s1; 
+  load s1;
   load s2;
   print_endline "OK."
-
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-csharp/native.reference ocaml-4.01.0/testsuite/tests/lib-dynlink-csharp/native.reference
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-csharp/native.reference	2010-04-08 12:44:07.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-csharp/native.reference	2012-02-10 16:15:24.000000000 +0000
@@ -1,4 +1,4 @@
-Now starting the Caml engine.
+Now starting the OCaml engine.
 Main is running.
 Loading ../../../otherlibs/bigarray/bigarray.cmxs
 I'm the plugin.
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-csharp/plugin.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-csharp/plugin.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-csharp/plugin.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-csharp/plugin.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,4 +1,16 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let f x = x.{2}
-  
+
 let () =
   print_endline "I'm the plugin."
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/.ignore ocaml-4.01.0/testsuite/tests/lib-dynlink-native/.ignore
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/.ignore	2013-05-16 19:48:04.000000000 +0000
@@ -0,0 +1,7 @@
+mypack.pack.s
+mypack.pack.asm
+result
+main
+main.exe
+marshal.data
+caml
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/.svnignore ocaml-4.01.0/testsuite/tests/lib-dynlink-native/.svnignore
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/.svnignore	2011-05-17 12:08:13.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/.svnignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,15 +0,0 @@
-#!/bin/sh
-
-svn propset svn:ignore -F - . < result
-	@diff -q reference result > /dev/null || (echo " => failed" && exit 1)
-	@echo " => passed"
-
-main: api.cmx main.cmx
-	@$(OCAMLOPT) -thread -o main -linkall unix.cmxa threads.cmxa dynlink.cmxa api.cmx main.cmx $(PTHREAD_LINK)
-
-main_ext: api.cmx main.cmx factorial.$(O)
-	@$(OCAMLOPT) -o main_ext dynlink.cmxa api.cmx main.cmx factorial.$(O)
+	@./main$(EXE) plugin.so plugin2.so plugin_thread.so > result
+	@$(DIFF) reference result >/dev/null \
+	&& echo " => passed" || echo " => failed"
+
+main$(EXE): api.cmx main.cmx
+	@$(OCAMLOPT) -thread -o main$(EXE) -linkall unix.cmxa threads.cmxa \
+	             dynlink.cmxa api.cmx main.cmx $(PTHREAD_LINK)
+
+main_ext$(EXE): api.cmx main.cmx factorial.$(O)
+	@$(OCAMLOPT) -o main_ext$(EXE) dynlink.cmxa api.cmx main.cmx \
+	             factorial.$(O)
 
 sub/plugin3.cmx: sub/api.cmi sub/api.cmx sub/plugin3.ml
-	@(cd sub; mv api.cmx api.cmx.bak; $(OCAMLOPT) -c $(COMPFLAGS) plugin3.ml; mv api.cmx.bak api.cmx)
+	@cd sub; \
+	mv api.cmx api.cmx.bak; \
+	$(OCAMLOPT) -c plugin3.ml; \
+	mv api.cmx.bak api.cmx
 
 plugin2.cmx: api.cmx plugin.cmi plugin.cmx
-	@(mv plugin.cmx plugin.cmx.bak; $(OCAMLOPT) -c $(COMPFLAGS) plugin2.ml; mv plugin.cmx.bak plugin.cmx)
+	@mv plugin.cmx plugin.cmx.bak;
+	@$(OCAMLOPT) -c plugin2.ml
+	@mv plugin.cmx.bak plugin.cmx
 
 sub/api.so: sub/api.cmi sub/api.ml
-	@(cd sub; $(OCAMLOPT) -c $(COMPFLAGS) $(SHARED) api.ml)
+	@cd sub; $(OCAMLOPT) -c $(SHARED) api.ml
 
 sub/api.cmi: sub/api.mli
-	@(cd sub; $(OCAMLOPT) -c $(COMPFLAGS) api.mli)
+	@cd sub; $(OCAMLOPT) -c api.mli
 
 sub/api.cmx: sub/api.cmi sub/api.ml
-	@(cd sub; $(OCAMLOPT) -c $(COMPFLAGS) api.ml)
+	@cd sub; $(OCAMLOPT) -c api.ml
 
 plugin.cmx: api.cmx plugin.cmi
 sub/plugin.cmx: api.cmx
 plugin4.cmx: api.cmx
 main.cmx: api.cmx
 plugin_ext.cmx: api.cmx plugin_ext.ml
-	@$(OCAMLOPT) -c $(COMPFLAGS) plugin_ext.ml
+	@$(OCAMLOPT) -c plugin_ext.ml
 
 plugin_ext.so: factorial.$(O) plugin_ext.cmx
-	@$(OCAMLOPT) $(COMPFLAGS) -shared -o plugin_ext.so factorial.$(O) plugin_ext.cmx
+	@$(OCAMLOPT) -shared -o plugin_ext.so factorial.$(O) \
+	             plugin_ext.cmx
 
 plugin4_unix.so: plugin4.cmx
 	@$(OCAMLOPT) -shared -o plugin4_unix.so unix.cmxa plugin4.cmx
@@ -59,12 +98,24 @@
 mylib.cmxa: plugin.cmx plugin2.cmx
 	@$(OCAMLOPT) $(COMPFLAGS) -a -o mylib.cmxa plugin.cmx plugin2.cmx
 
-factorial.$(O): factorial.c
-	@$(OCAMLOPT) -c -ccopt "$(SHAREDCCCOMPOPTS)" factorial.c
+factorial.$(O): factorial.c caml
+	@$(OCAMLOPT) -c -ccopt "$(SHAREDCCCOMPOPTS)" -ccopt -I -ccopt . \
+	             factorial.c
+
+caml:
+	@mkdir -p caml || :
+	@cp $(TOPDIR)/byterun/*.h caml/
+
+.PHONY: promote
+promote:
+	@cp result reference
 
+.PHONY: clean
 clean: defaultclean
 	@rm -f result *.so *.o *.cm* main main_ext *.exe *.s *.asm *.obj
 	@rm -f *.a *.lib
 	@rm -f sub/*.so sub/*.o sub/*.cm* sub/*.s sub/*.asm sub/*.obj
+	@rm -f marshal.data
+	@rm -rf caml
 
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/a.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/a.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/a.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/a.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let x = ref 0
 let u = Random.int 1000
 
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/api.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/api.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/api.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/api.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,7 +1,19 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let mods = ref []
 
 let reg_mod name =
-  if List.mem name !mods then 
+  if List.mem name !mods then
     Printf.printf "Reloading module %s\n" name
   else (
     mods := name :: !mods;
@@ -14,5 +26,7 @@
 let add_cb f = cbs := f :: !cbs
 let runall () = List.iter (fun f -> f ()) !cbs
 
+(*
 let () =
   at_exit runall
+*)
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/b.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/b.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/b.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/b.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,5 +1,16 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let () =
   print_endline "B is running";
   incr A.x;
   Printf.printf "A.x = %i\n" !A.x
-
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/bug.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/bug.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/bug.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/bug.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,2 +1,14 @@
-let () = try raise (Invalid_argument "X") with Invalid_argument s -> 
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+let () = try raise (Invalid_argument "X") with Invalid_argument s ->
   raise (Invalid_argument (s ^ s))
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/c.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/c.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/c.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/c.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let () =
   print_endline "C is running";
   incr A.x;
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/factorial.c ocaml-4.01.0/testsuite/tests/lib-dynlink-native/factorial.c
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/factorial.c	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/factorial.c	2013-04-04 15:27:13.000000000 +0000
@@ -1,3 +1,15 @@
+/***********************************************************************/
+/*                                                                     */
+/*                                OCaml                                */
+/*                                                                     */
+/*                        Alain Frisch, LexiFi                         */
+/*                                                                     */
+/*  Copyright 2007 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the Q Public License version 1.0.               */
+/*                                                                     */
+/***********************************************************************/
+
 #include "caml/mlvalues.h"
 #include "caml/memory.h"
 #include "caml/alloc.h"
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/main.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/main.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/main.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/main.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,20 +1,44 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+let () =
+  Api.add_cb (fun () -> print_endline "Callback from main")
+
 let ()  =
   Dynlink.init ();
   Dynlink.allow_unsafe_modules true;
   for i = 1 to Array.length Sys.argv - 1 do
     let name = Sys.argv.(i) in
     Printf.printf "Loading %s\n" name; flush stdout;
-    try 
+    try
       if name.[0] = '-'
-      then Dynlink.loadfile_private 
-	(String.sub name 1 (String.length name - 1))
+      then Dynlink.loadfile_private
+        (String.sub name 1 (String.length name - 1))
       else Dynlink.loadfile name
     with
       | Dynlink.Error err ->
-	  Printf.printf "Dynlink error: %s\n" 
-	    (Dynlink.error_message err)
+          Printf.printf "Dynlink error: %s\n"
+            (Dynlink.error_message err)
       | exn ->
-	  Printf.printf "Error: %s\n" (Printexc.to_string exn)
-  done
-
-
+          Printf.printf "Error: %s\n" (Printexc.to_string exn)
+  done;
+  flush stdout;
+  try
+    let oc = open_out_bin "marshal.data" in
+    Marshal.to_channel oc !Api.cbs [Marshal.Closures];
+    close_out oc;
+    let ic = open_in_bin "marshal.data" in
+    let l = (Marshal.from_channel ic : (unit -> unit) list) in
+    close_in ic;
+    List.iter (fun f -> f()) l
+  with Failure s ->
+    Printf.printf "Failure: %s\n" s
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/pack_client.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/pack_client.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/pack_client.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/pack_client.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,2 +1,14 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let () =
   print_endline Mypack.Packed1.mykey
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/packed1.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/packed1.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/packed1.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/packed1.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,6 +1,17 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let () =
   Api.reg_mod "Packed1"
 
 let bla = Sys.argv.(0) ^ "XXX"
 let mykey = Sys.argv.(0)
-
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/packed1_client.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/packed1_client.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/packed1_client.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/packed1_client.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let () =
   Api.reg_mod "Packed1_client";
   print_endline Packed1.mykey
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/plugin.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/plugin.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/plugin.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/plugin.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let rec f x = ignore ([x]); f x
 
 let rec fact n = if n = 0 then 1 else n * fact (n - 1)
@@ -6,5 +18,6 @@
 
 let () =
   Api.reg_mod "Plugin";
-  print_endline "COUCOU"; 
+  Api.add_cb (fun () -> print_endline "Callback from plugin");
+  print_endline "COUCOU";
   ()
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/plugin.mli ocaml-4.01.0/testsuite/tests/lib-dynlink-native/plugin.mli
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/plugin.mli	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/plugin.mli	2013-04-04 15:27:13.000000000 +0000
@@ -1 +1,13 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 val facts: int list
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/plugin2.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/plugin2.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/plugin2.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/plugin2.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,8 +1,20 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (*external ex: int -> int = "caml_ex"*)
 
 let () =
   Api.reg_mod "Plugin2";
+  Api.add_cb (fun () -> print_endline "Callback from plugin2");
 (*  let i = ex 3 in*)
   List.iter (fun i -> Printf.printf "%i\n" i) Plugin.facts;
-  Printf.printf "XXX\n";
-  raise Exit
+  Printf.printf "XXX\n"
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/plugin4.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/plugin4.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/plugin4.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/plugin4.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,5 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let () =
   Printf.printf "time = %f\n" (Unix.time ());
   Api.reg_mod "Plugin"
-
-
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/plugin_ext.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/plugin_ext.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/plugin_ext.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/plugin_ext.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 external fact: int -> string = "factorial"
 
 let () =
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/plugin_high_arity.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/plugin_high_arity.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/plugin_high_arity.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/plugin_high_arity.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let f x x x x x x x x x x x x x = ()
 
 let g x = f x x x x x x x x
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/plugin_ref.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/plugin_ref.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/plugin_ref.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/plugin_ref.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,11 +1,22 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let x = ref 0
 
 let () =
   Api.reg_mod "Plugin_ref";
-  
-  Api.add_cb 
+
+  Api.add_cb
     (fun () ->
        Printf.printf "current value for ref = %i\n" !x;
        incr x
     )
-  
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/plugin_simple.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/plugin_simple.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/plugin_simple.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/plugin_simple.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let facts = [ (Random.int 4) ]
 
 let () = print_endline "COUCOU"; print_char '\n'
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/plugin_thread.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/plugin_thread.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/plugin_thread.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/plugin_thread.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,21 +1,27 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let () =
   Api.reg_mod "Plugin_thread";
   let _t =
-    Thread.create 
+    Thread.create
       (fun () ->
-	 for i = 1 to 5 do
-	   print_endline "Thread"; flush stdout;
-	   Thread.delay 1.;
-	 done
+         for i = 1 to 5 do
+           print_endline "Thread"; flush stdout;
+           Thread.delay 1.;
+         done
       ) ()
   in
   for i = 1 to 10 do
     print_endline "Thread"; flush stdout;
     Thread.delay 0.50;
   done
-
-
-
-
-
-
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/reference ocaml-4.01.0/testsuite/tests/lib-dynlink-native/reference
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/reference	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/reference	2012-07-17 15:31:12.000000000 +0000
@@ -1,3 +1,13 @@
+Loading plugin.so
+Registering module Plugin
+COUCOU
+Loading plugin2.so
+Registering module Plugin2
+1
+2
+6
+1
+XXX
 Loading plugin_thread.so
 Registering module Plugin_thread
 Thread
@@ -15,3 +25,6 @@
 Thread
 Thread
 Thread
+Callback from plugin2
+Callback from plugin
+Callback from main
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/sub/api.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/sub/api.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/sub/api.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/sub/api.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let f i =
   Printf.printf "Sub/api: f called with %i\n" i;
   i + 1
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/sub/api.mli ocaml-4.01.0/testsuite/tests/lib-dynlink-native/sub/api.mli
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/sub/api.mli	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/sub/api.mli	2013-04-04 15:27:13.000000000 +0000
@@ -1 +1,13 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 val f : int -> int
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/sub/plugin.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/sub/plugin.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/sub/plugin.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/sub/plugin.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,7 +1,18 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let rec fact n = if n = 0 then 1 else n * fact (n - 1)
 
 let facts = [ fact 1; fact 2; fact 3; fact 4; fact 5 ]
 
 let () =
   Api.reg_mod "Plugin'"
-
diff -Nru ocaml-3.12.1/testsuite/tests/lib-dynlink-native/sub/plugin3.ml ocaml-4.01.0/testsuite/tests/lib-dynlink-native/sub/plugin3.ml
--- ocaml-3.12.1/testsuite/tests/lib-dynlink-native/sub/plugin3.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-dynlink-native/sub/plugin3.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,3 +1,14 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let () =
   ignore (Api.f 10)
-
diff -Nru ocaml-3.12.1/testsuite/tests/lib-format/Makefile ocaml-4.01.0/testsuite/tests/lib-format/Makefile
--- ocaml-3.12.1/testsuite/tests/lib-format/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-format/Makefile	2013-05-30 11:26:53.000000000 +0000
@@ -0,0 +1,18 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+MAIN_MODULE=tformat
+ADD_COMPFLAGS=-I $(OTOPDIR)/testsuite/lib
+ADD_MODULES=testing
+
+include ../../makefiles/Makefile.one
+include ../../makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-format/tformat.ml ocaml-4.01.0/testsuite/tests/lib-format/tformat.ml
--- ocaml-3.12.1/testsuite/tests/lib-format/tformat.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-format/tformat.ml	2013-05-30 12:27:18.000000000 +0000
@@ -0,0 +1,493 @@
+(*************************************************************************)
+(*                                                                       *)
+(*                                OCaml                                  *)
+(*                                                                       *)
+(*         Pierre Weis, projet Pomdapi, INRIA Rocquencourt               *)
+(*                                                                       *)
+(*   Copyright 2011 Institut National de Recherche en Informatique et    *)
+(*   en Automatique.  All rights reserved.  This file is distributed     *)
+(*   under the terms of the Q Public License version 1.0.                *)
+(*                                                                       *)
+(*************************************************************************)
+
+(*
+
+A test file for the Format module.
+
+*)
+
+open Testing;;
+open Format;;
+
+let say s = Printf.printf s;;
+
+try
+
+  say "d/i positive\n%!";
+  test (sprintf "%d/%i" 42 43 = "42/43");
+  test (sprintf "%-4d/%-5i" 42 43 = "42  /43   ");
+  test (sprintf "%04d/%05i" 42 43 = "0042/00043");
+  test (sprintf "%+d/%+i" 42 43 = "+42/+43");
+  test (sprintf "% d/% i" 42 43 = " 42/ 43");
+  test (sprintf "%#d/%#i" 42 43 = "42/43");
+  test (sprintf "%4d/%5i" 42 43 = "  42/   43");
+  test (sprintf "%*d/%*i" 4 42 5 43 = "  42/   43");
+  test (sprintf "%-0+#4d/%-0 #5i" 42 43 = "+42 / 43  ");
+
+  say "\nd/i negative\n%!";
+  test (sprintf "%d/%i" (-42) (-43) = "-42/-43");
+  test (sprintf "%-4d/%-5i" (-42) (-43) = "-42 /-43  ");
+  test (sprintf "%04d/%05i" (-42) (-43) = "-042/-0043");
+  test (sprintf "%+d/%+i" (-42) (-43) = "-42/-43");
+  test (sprintf "% d/% i" (-42) (-43) = "-42/-43");
+  test (sprintf "%#d/%#i" (-42) (-43) = "-42/-43");
+  test (sprintf "%4d/%5i" (-42) (-43) = " -42/  -43");
+  test (sprintf "%*d/%*i" 4 (-42) 5 (-43) = " -42/  -43");
+  test (sprintf "%-0+ #4d/%-0+ #5i" (-42) (-43) = "-42 /-43  ");
+
+  say "\nu positive\n%!";
+  test (sprintf "%u" 42 = "42");
+  test (sprintf "%-4u" 42 = "42  ");
+  test (sprintf "%04u" 42 = "0042");
+  test (sprintf "%+u" 42 = "42");
+  test (sprintf "% u" 42 = "42");
+  test (sprintf "%#u" 42 = "42");
+  test (sprintf "%4u" 42 = "  42");
+  test (sprintf "%*u" 4 42 = "  42");
+  test (sprintf "%-0+ #6d" 42 = "+42   ");
+
+  say "\nu negative\n%!";
+  begin match Sys.word_size with
+  | 32 ->
+     test (sprintf "%u" (-1) = "2147483647");
+  | 64 ->
+     test (sprintf "%u" (-1) = "9223372036854775807");
+  | _ -> test false
+  end;
+
+  say "\nx positive\n%!";
+  test (sprintf "%x" 42 = "2a");
+  test (sprintf "%-4x" 42 = "2a  ");
+  test (sprintf "%04x" 42 = "002a");
+  test (sprintf "%+x" 42 = "2a");
+  test (sprintf "% x" 42 = "2a");
+  test (sprintf "%#x" 42 = "0x2a");
+  test (sprintf "%4x" 42 = "  2a");
+  test (sprintf "%*x" 5 42 = "   2a");
+  test (sprintf "%-0+ #*x" 5 42 = "0x2a ");
+
+  say "\nx negative\n%!";
+  begin match Sys.word_size with
+  | 32 ->
+     test (sprintf "%x" (-42) = "7fffffd6");
+  | 64 ->
+     test (sprintf "%x" (-42) = "7fffffffffffffd6");
+  | _ -> test false
+  end;
+
+  say "\nX positive\n%!";
+  test (sprintf "%X" 42 = "2A");
+  test (sprintf "%-4X" 42 = "2A  ");
+  test (sprintf "%04X" 42 = "002A");
+  test (sprintf "%+X" 42 = "2A");
+  test (sprintf "% X" 42 = "2A");
+  test (sprintf "%#X" 42 = "0X2A");
+  test (sprintf "%4X" 42 = "  2A");
+  test (sprintf "%*X" 5 42 = "   2A");
+  test (sprintf "%-0+ #*X" 5 42 = "0X2A ");
+
+  say "\nx negative\n%!";
+  begin match Sys.word_size with
+  | 32 ->
+     test (sprintf "%X" (-42) = "7FFFFFD6");
+  | 64 ->
+     test (sprintf "%X" (-42) = "7FFFFFFFFFFFFFD6");
+  | _ -> test false
+  end;
+
+  say "\no positive\n%!";
+  test (sprintf "%o" 42 = "52");
+  test (sprintf "%-4o" 42 = "52  ");
+  test (sprintf "%04o" 42 = "0052");
+  test (sprintf "%+o" 42 = "52");
+  test (sprintf "% o" 42 = "52");
+  test (sprintf "%#o" 42 = "052");
+  test (sprintf "%4o" 42 = "  52");
+  test (sprintf "%*o" 5 42 = "   52");
+  test (sprintf "%-0+ #*o" 5 42 = "052  ");
+
+  say "\no negative\n%!";
+  begin match Sys.word_size with
+  | 32 ->
+     test (sprintf "%o" (-42) = "17777777726");
+  | 64 ->
+     test (sprintf "%o" (-42) = "777777777777777777726");
+  | _ -> test false
+  end;
+
+  say "\ns\n%!";
+  test (sprintf "%s" "foo" = "foo");
+  test (sprintf "%-5s" "foo" = "foo  ");
+  test (sprintf "%05s" "foo" = "  foo");
+  test (sprintf "%+s" "foo" = "foo");
+  test (sprintf "% s" "foo" = "foo");
+  test (sprintf "%#s" "foo" = "foo");
+  test (sprintf "%5s" "foo" = "  foo");
+  test (sprintf "%1s" "foo" = "foo");
+  test (sprintf "%*s" 6 "foo" = "   foo");
+  test (sprintf "%*s" 2 "foo" = "foo");
+  test (sprintf "%-0+ #5s" "foo" = "foo  ");
+  test (sprintf "%s@@" "foo" = "foo@");
+  test (sprintf "%s@@inria.fr" "foo" = "foo@inria.fr");
+  test (sprintf "%s@@%s" "foo" "inria.fr" = "foo@inria.fr");
+
+  say "\nS\n%!";
+  test (sprintf "%S" "fo\"o" = "\"fo\\\"o\"");
+(*  test (sprintf "%-5S" "foo" = "\"foo\"  ");   padding not done *)
+(*  test (sprintf "%05S" "foo" = "  \"foo\"");   padding not done *)
+  test (sprintf "%+S" "foo" = "\"foo\"");
+  test (sprintf "% S" "foo" = "\"foo\"");
+  test (sprintf "%#S" "foo" = "\"foo\"");
+(*  test (sprintf "%5S" "foo" = "  \"foo\"");    padding not done *)
+  test (sprintf "%1S" "foo" = "\"foo\"");
+(*  test (sprintf "%*S" 6 "foo" = "   \"foo\"");  padding not done *)
+  test (sprintf "%*S" 2 "foo" = "\"foo\"");
+(*  test (sprintf "%-0+ #5S" "foo" = "\"foo\"  ");  padding not done *)
+  test (sprintf "%S@@" "foo" = "\"foo\"@");
+  test (sprintf "%S@@inria.fr" "foo" = "\"foo\"@inria.fr");
+  test (sprintf "%S@@%S" "foo" "inria.fr" = "\"foo\"@\"inria.fr\"");
+
+  say "\nc\n%!";
+  test (sprintf "%c" 'c' = "c");
+(*  test (sprintf "%-4c" 'c' = "c   ");    padding not done *)
+(*  test (sprintf "%04c" 'c' = "   c");    padding not done *)
+  test (sprintf "%+c" 'c' = "c");
+  test (sprintf "% c" 'c' = "c");
+  test (sprintf "%#c" 'c' = "c");
+(*  test (sprintf "%4c" 'c' = "   c");     padding not done *)
+(*  test (sprintf "%*c" 2 'c' = " c");     padding not done *)
+(*  test (sprintf "%-0+ #4c" 'c' = "c   ");  padding not done *)
+
+  say "\nC\n%!";
+  test (sprintf "%C" 'c' = "'c'");
+  test (sprintf "%C" '\'' = "'\\''");
+(*  test (sprintf "%-4C" 'c' = "c   ");    padding not done *)
+(*  test (sprintf "%04C" 'c' = "   c");    padding not done *)
+  test (sprintf "%+C" 'c' = "'c'");
+  test (sprintf "% C" 'c' = "'c'");
+  test (sprintf "%#C" 'c' = "'c'");
+(*  test (sprintf "%4C" 'c' = "   c");     padding not done *)
+(*  test (sprintf "%*C" 2 'c' = " c");     padding not done *)
+(*  test (sprintf "%-0+ #4C" 'c' = "c   ");  padding not done *)
+
+  say "\nf\n%!";
+  test (sprintf "%f" (-42.42) = "-42.420000");
+  test (sprintf "%-13f" (-42.42) = "-42.420000   ");
+  test (sprintf "%013f" (-42.42) = "-00042.420000");
+  test (sprintf "%+f" 42.42 = "+42.420000");
+  test (sprintf "% f" 42.42 = " 42.420000");
+  test (sprintf "%#f" 42.42 = "42.420000");
+  test (sprintf "%13f" 42.42 = "    42.420000");
+  test (sprintf "%*f" 12 42.42 = "   42.420000");
+  test (sprintf "%-0+ #12f" 42.42 = "+42.420000  ");
+  test (sprintf "%.3f" (-42.42) = "-42.420");
+  test (sprintf "%-13.3f" (-42.42) = "-42.420      ");
+  test (sprintf "%013.3f" (-42.42) = "-00000042.420");
+  test (sprintf "%+.3f" 42.42 = "+42.420");
+  test (sprintf "% .3f" 42.42 = " 42.420");
+  test (sprintf "%#.3f" 42.42 = "42.420");
+  test (sprintf "%13.3f" 42.42 = "       42.420");
+  test (sprintf "%*.*f" 12 3 42.42 = "      42.420");
+  test (sprintf "%-0+ #12.3f" 42.42 = "+42.420     ");
+
+  (* Under Windows (mingw and maybe also MSVC), the stdlib uses three
+     digits for the exponent instead of the two used by Linux and BSD.
+     Check that the two strings are equal, except that there may be an
+     extra zero, and if there is one, there may be a missing space or
+     zero. All in the first string relative to the second. *)
+  let ( =* ) s1 s2 =
+    let ss1 = s1 ^ "$" in
+    let ss2 = s2 ^ "$" in
+    let rec loop i1 i2 extra missing =
+      if i1 = String.length ss1 && i2 = String.length ss2 then begin
+        if extra then true else not missing
+      end else if i1 = String.length ss1 || i2 = String.length ss2 then
+        false
+      else begin
+        match ss1.[i1], ss2.[i2] with
+        | x, y when x = y -> loop (i1+1) (i2+1) extra missing
+        | '0', _ when not extra -> loop (i1+1) i2 true missing
+        | _, (' '|'0') when not missing -> loop i1 (i2+1) extra true
+        | _, _ -> false
+      end
+    in
+    loop 0 0 false false
+  in
+
+  say "\nF\n%!";
+  test (sprintf "%F" 42.42 = "42.42");
+  test (sprintf "%F" 42.42e42 =* "4.242e+43");
+  test (sprintf "%F" 42.00 = "42.");
+  test (sprintf "%F" 0.042 = "0.042");
+(* no padding, no precision
+  test (sprintf "%.3F" 42.42 = "42.420");
+  test (sprintf "%12.3F" 42.42e42 = "   4.242e+43");
+  test (sprintf "%.3F" 42.00 = "42.000");
+  test (sprintf "%.3F" 0.0042 = "0.004");
+*)
+
+  say "\ne\n%!";
+  test (sprintf "%e" (-42.42) =* "-4.242000e+01");
+  test (sprintf "%-15e" (-42.42) =* "-4.242000e+01  ");
+  test (sprintf "%015e" (-42.42) =* "-004.242000e+01");
+  test (sprintf "%+e" 42.42 =* "+4.242000e+01");
+  test (sprintf "% e" 42.42 =* " 4.242000e+01");
+  test (sprintf "%#e" 42.42 =* "4.242000e+01");
+  test (sprintf "%15e" 42.42 =* "   4.242000e+01");
+  test (sprintf "%*e" 14 42.42 =* "  4.242000e+01");
+  test (sprintf "%-0+ #14e" 42.42 =* "+4.242000e+01 ");
+  test (sprintf "%.3e" (-42.42) =* "-4.242e+01");
+  test (sprintf "%-15.3e" (-42.42) =* "-4.242e+01     ");
+  test (sprintf "%015.3e" (-42.42) =* "-000004.242e+01");
+  test (sprintf "%+.3e" 42.42 =* "+4.242e+01");
+  test (sprintf "% .3e" 42.42 =* " 4.242e+01");
+  test (sprintf "%#.3e" 42.42 =* "4.242e+01");
+  test (sprintf "%15.3e" 42.42 =* "      4.242e+01");
+  test (sprintf "%*.*e" 11 3 42.42 =* "  4.242e+01");
+  test (sprintf "%-0+ #14.3e" 42.42 =* "+4.242e+01    ");
+
+  say "\nE\n%!";
+  test (sprintf "%E" (-42.42) =* "-4.242000E+01");
+  test (sprintf "%-15E" (-42.42) =* "-4.242000E+01  ");
+  test (sprintf "%015E" (-42.42) =* "-004.242000E+01");
+  test (sprintf "%+E" 42.42 =* "+4.242000E+01");
+  test (sprintf "% E" 42.42 =* " 4.242000E+01");
+  test (sprintf "%#E" 42.42 =* "4.242000E+01");
+  test (sprintf "%15E" 42.42 =* "   4.242000E+01");
+  test (sprintf "%*E" 14 42.42 =* "  4.242000E+01");
+  test (sprintf "%-0+ #14E" 42.42 =* "+4.242000E+01 ");
+  test (sprintf "%.3E" (-42.42) =* "-4.242E+01");
+  test (sprintf "%-15.3E" (-42.42) =* "-4.242E+01     ");
+  test (sprintf "%015.3E" (-42.42) =* "-000004.242E+01");
+  test (sprintf "%+.3E" 42.42 =* "+4.242E+01");
+  test (sprintf "% .3E" 42.42 =* " 4.242E+01");
+  test (sprintf "%#.3E" 42.42 =* "4.242E+01");
+  test (sprintf "%15.3E" 42.42 =* "      4.242E+01");
+  test (sprintf "%*.*E" 11 3 42.42 =* "  4.242E+01");
+  test (sprintf "%-0+ #14.3E" 42.42 =* "+4.242E+01    ");
+
+(* %g gives strange results that correspond to neither %f nor %e
+  say "\ng\n%!";
+  test (sprintf "%g" (-42.42) = "-42.42000");
+  test (sprintf "%-15g" (-42.42) = "-42.42000      ");
+  test (sprintf "%015g" (-42.42) = "-00000042.42000");
+  test (sprintf "%+g" 42.42 = "+42.42000");
+  test (sprintf "% g" 42.42 = " 42.42000");
+  test (sprintf "%#g" 42.42 = "42.42000");
+  test (sprintf "%15g" 42.42 = "       42.42000");
+  test (sprintf "%*g" 14 42.42 = "      42.42000");
+  test (sprintf "%-0+ #14g" 42.42 = "+42.42000     ");
+  test (sprintf "%.3g" (-42.42) = "-42.420");
+*)
+
+(* Same for %G
+  say "\nG\n%!";
+*)
+
+  say "\nB\n%!";
+  test (sprintf "%B" true = "true");
+  test (sprintf "%B" false = "false");
+
+  say "\nld/li positive\n%!";
+  test (sprintf "%ld/%li" 42l 43l = "42/43");
+  test (sprintf "%-4ld/%-5li" 42l 43l = "42  /43   ");
+  test (sprintf "%04ld/%05li" 42l 43l = "0042/00043");
+  test (sprintf "%+ld/%+li" 42l 43l = "+42/+43");
+  test (sprintf "% ld/% li" 42l 43l = " 42/ 43");
+  test (sprintf "%#ld/%#li" 42l 43l = "42/43");
+  test (sprintf "%4ld/%5li" 42l 43l = "  42/   43");
+  test (sprintf "%*ld/%*li" 4 42l 5 43l = "  42/   43");
+  test (sprintf "%-0+#4ld/%-0 #5li" 42l 43l = "+42 / 43  ");
+
+  say "\nld/li negative\n%!";
+  test (sprintf "%ld/%li" (-42l) (-43l) = "-42/-43");
+  test (sprintf "%-4ld/%-5li" (-42l) (-43l) = "-42 /-43  ");
+  test (sprintf "%04ld/%05li" (-42l) (-43l) = "-042/-0043");
+  test (sprintf "%+ld/%+li" (-42l) (-43l) = "-42/-43");
+  test (sprintf "% ld/% li" (-42l) (-43l) = "-42/-43");
+  test (sprintf "%#ld/%#li" (-42l) (-43l) = "-42/-43");
+  test (sprintf "%4ld/%5li" (-42l) (-43l) = " -42/  -43");
+  test (sprintf "%*ld/%*li" 4 (-42l) 5 (-43l) = " -42/  -43");
+  test (sprintf "%-0+ #4ld/%-0+ #5li" (-42l) (-43l) = "-42 /-43  ");
+
+  say "\nlu positive\n%!";
+  test (sprintf "%lu" 42l = "42");
+  test (sprintf "%-4lu" 42l = "42  ");
+  test (sprintf "%04lu" 42l = "0042");
+  test (sprintf "%+lu" 42l = "42");
+  test (sprintf "% lu" 42l = "42");
+  test (sprintf "%#lu" 42l = "42");
+  test (sprintf "%4lu" 42l = "  42");
+  test (sprintf "%*lu" 4 42l = "  42");
+  test (sprintf "%-0+ #6ld" 42l = "+42   ");
+
+  say "\nlu negative\n%!";
+  test (sprintf "%lu" (-1l) = "4294967295");
+
+  say "\nlx positive\n%!";
+  test (sprintf "%lx" 42l = "2a");
+  test (sprintf "%-4lx" 42l = "2a  ");
+  test (sprintf "%04lx" 42l = "002a");
+  test (sprintf "%+lx" 42l = "2a");
+  test (sprintf "% lx" 42l = "2a");
+  test (sprintf "%#lx" 42l = "0x2a");
+  test (sprintf "%4lx" 42l = "  2a");
+  test (sprintf "%*lx" 5 42l = "   2a");
+  test (sprintf "%-0+ #*lx" 5 42l = "0x2a ");
+
+  say "\nlx negative\n%!";
+  test (sprintf "%lx" (-42l) = "ffffffd6");
+
+  say "\nlX positive\n%!";
+  test (sprintf "%lX" 42l = "2A");
+  test (sprintf "%-4lX" 42l = "2A  ");
+  test (sprintf "%04lX" 42l = "002A");
+  test (sprintf "%+lX" 42l = "2A");
+  test (sprintf "% lX" 42l = "2A");
+  test (sprintf "%#lX" 42l = "0X2A");
+  test (sprintf "%4lX" 42l = "  2A");
+  test (sprintf "%*lX" 5 42l = "   2A");
+  test (sprintf "%-0+ #*lX" 5 42l = "0X2A ");
+
+  say "\nlx negative\n%!";
+  test (sprintf "%lX" (-42l) = "FFFFFFD6");
+
+  say "\nlo positive\n%!";
+  test (sprintf "%lo" 42l = "52");
+  test (sprintf "%-4lo" 42l = "52  ");
+  test (sprintf "%04lo" 42l = "0052");
+  test (sprintf "%+lo" 42l = "52");
+  test (sprintf "% lo" 42l = "52");
+  test (sprintf "%#lo" 42l = "052");
+  test (sprintf "%4lo" 42l = "  52");
+  test (sprintf "%*lo" 5 42l = "   52");
+  test (sprintf "%-0+ #*lo" 5 42l = "052  ");
+
+  say "\nlo negative\n%!";
+  test (sprintf "%lo" (-42l) = "37777777726");
+
+  (* Nativeint not tested: looks like too much work, and anyway it should
+     work like Int32 or Int64. *)
+
+  say "\nLd/Li positive\n%!";
+  test (sprintf "%Ld/%Li" 42L 43L = "42/43");
+  test (sprintf "%-4Ld/%-5Li" 42L 43L = "42  /43   ");
+  test (sprintf "%04Ld/%05Li" 42L 43L = "0042/00043");
+  test (sprintf "%+Ld/%+Li" 42L 43L = "+42/+43");
+  test (sprintf "% Ld/% Li" 42L 43L = " 42/ 43");
+  test (sprintf "%#Ld/%#Li" 42L 43L = "42/43");
+  test (sprintf "%4Ld/%5Li" 42L 43L = "  42/   43");
+  test (sprintf "%*Ld/%*Li" 4 42L 5 43L = "  42/   43");
+  test (sprintf "%-0+#4Ld/%-0 #5Li" 42L 43L = "+42 / 43  ");
+
+  say "\nLd/Li negative\n%!";
+  test (sprintf "%Ld/%Li" (-42L) (-43L) = "-42/-43");
+  test (sprintf "%-4Ld/%-5Li" (-42L) (-43L) = "-42 /-43  ");
+  test (sprintf "%04Ld/%05Li" (-42L) (-43L) = "-042/-0043");
+  test (sprintf "%+Ld/%+Li" (-42L) (-43L) = "-42/-43");
+  test (sprintf "% Ld/% Li" (-42L) (-43L) = "-42/-43");
+  test (sprintf "%#Ld/%#Li" (-42L) (-43L) = "-42/-43");
+  test (sprintf "%4Ld/%5Li" (-42L) (-43L) = " -42/  -43");
+  test (sprintf "%*Ld/%*Li" 4 (-42L) 5 (-43L) = " -42/  -43");
+  test (sprintf "%-0+ #4Ld/%-0+ #5Li" (-42L) (-43L) = "-42 /-43  ");
+
+  say "\nLu positive\n%!";
+  test (sprintf "%Lu" 42L = "42");
+  test (sprintf "%-4Lu" 42L = "42  ");
+  test (sprintf "%04Lu" 42L = "0042");
+  test (sprintf "%+Lu" 42L = "42");
+  test (sprintf "% Lu" 42L = "42");
+  test (sprintf "%#Lu" 42L = "42");
+  test (sprintf "%4Lu" 42L = "  42");
+  test (sprintf "%*Lu" 4 42L = "  42");
+  test (sprintf "%-0+ #6Ld" 42L = "+42   ");
+
+  say "\nLu negative\n%!";
+  test (sprintf "%Lu" (-1L) = "18446744073709551615");
+
+  say "\nLx positive\n%!";
+  test (sprintf "%Lx" 42L = "2a");
+  test (sprintf "%-4Lx" 42L = "2a  ");
+  test (sprintf "%04Lx" 42L = "002a");
+  test (sprintf "%+Lx" 42L = "2a");
+  test (sprintf "% Lx" 42L = "2a");
+  test (sprintf "%#Lx" 42L = "0x2a");
+  test (sprintf "%4Lx" 42L = "  2a");
+  test (sprintf "%*Lx" 5 42L = "   2a");
+  test (sprintf "%-0+ #*Lx" 5 42L = "0x2a ");
+
+  say "\nLx negative\n%!";
+  test (sprintf "%Lx" (-42L) = "ffffffffffffffd6");
+
+  say "\nLX positive\n%!";
+  test (sprintf "%LX" 42L = "2A");
+  test (sprintf "%-4LX" 42L = "2A  ");
+  test (sprintf "%04LX" 42L = "002A");
+  test (sprintf "%+LX" 42L = "2A");
+  test (sprintf "% LX" 42L = "2A");
+  test (sprintf "%#LX" 42L = "0X2A");
+  test (sprintf "%4LX" 42L = "  2A");
+  test (sprintf "%*LX" 5 42L = "   2A");
+  test (sprintf "%-0+ #*LX" 5 42L = "0X2A ");
+
+  say "\nLx negative\n%!";
+  test (sprintf "%LX" (-42L) = "FFFFFFFFFFFFFFD6");
+
+  say "\nLo positive\n%!";
+  test (sprintf "%Lo" 42L = "52");
+  test (sprintf "%-4Lo" 42L = "52  ");
+  test (sprintf "%04Lo" 42L = "0052");
+  test (sprintf "%+Lo" 42L = "52");
+  test (sprintf "% Lo" 42L = "52");
+  test (sprintf "%#Lo" 42L = "052");
+  test (sprintf "%4Lo" 42L = "  52");
+  test (sprintf "%*Lo" 5 42L = "   52");
+  test (sprintf "%-0+ #*Lo" 5 42L = "052  ");
+
+  say "\nLo negative\n%!";
+  test (sprintf "%Lo" (-42L) = "1777777777777777777726");
+
+  say "\na\n%!";
+  let x = ref () in
+  let f () y = if y == x then "ok" else "wrong" in
+  test (sprintf "%a" f x = "ok");
+
+  say "\nt\n%!";
+  let f () = "ok" in
+  test (sprintf "%t" f = "ok");
+
+(* %{ fmt %} prints the signature of [fmt], i.e. a canonical representation
+   of the conversions present in [fmt].
+*)
+  say "\n{...%%}\n%!";
+  let f = format_of_string "%f/%s" in
+  test (sprintf "%{%f%s%}" f = "%f%s");
+
+  say "\n(...%%)\n%!";
+  let f = format_of_string "%d/foo/%s" in
+  test (sprintf "%(%d%s%)" f 42 "bar" = "42/foo/bar");
+
+  say "\n! %% @ , and constants\n%!";
+  test (sprintf "%!" = "");
+  test (sprintf "%%" = "%");
+  test (sprintf "%@" = "@");
+  test (sprintf "%," = "");
+  test (sprintf "@@" = "@");
+  test (sprintf "@@@@" = "@@");
+  test (sprintf "@@%%" = "@%");
+
+  say "\nend of tests\n%!";
+with e ->
+  say "unexpected exception: %s\n%!" (Printexc.to_string e);
+  test false;
+;;
diff -Nru ocaml-3.12.1/testsuite/tests/lib-format/tformat.reference ocaml-4.01.0/testsuite/tests/lib-format/tformat.reference
--- ocaml-3.12.1/testsuite/tests/lib-format/tformat.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-format/tformat.reference	2013-05-29 20:21:12.000000000 +0000
@@ -0,0 +1,91 @@
+d/i positive
+ 0 1 2 3 4 5 6 7 8
+d/i negative
+ 9 10 11 12 13 14 15 16 17
+u positive
+ 18 19 20 21 22 23 24 25 26
+u negative
+ 27
+x positive
+ 28 29 30 31 32 33 34 35 36
+x negative
+ 37
+X positive
+ 38 39 40 41 42 43 44 45 46
+x negative
+ 47
+o positive
+ 48 49 50 51 52 53 54 55 56
+o negative
+ 57
+s
+ 58 59 60 61 62 63 64 65 66 67 68 69 70 71
+S
+ 72 73 74 75 76 77 78 79 80
+c
+ 81 82 83 84
+C
+ 85 86 87 88 89
+f
+ 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
+F
+ 108 109 110 111
+e
+ 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
+E
+ 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
+B
+ 148 149
+ld/li positive
+ 150 151 152 153 154 155 156 157 158
+ld/li negative
+ 159 160 161 162 163 164 165 166 167
+lu positive
+ 168 169 170 171 172 173 174 175 176
+lu negative
+ 177
+lx positive
+ 178 179 180 181 182 183 184 185 186
+lx negative
+ 187
+lX positive
+ 188 189 190 191 192 193 194 195 196
+lx negative
+ 197
+lo positive
+ 198 199 200 201 202 203 204 205 206
+lo negative
+ 207
+Ld/Li positive
+ 208 209 210 211 212 213 214 215 216
+Ld/Li negative
+ 217 218 219 220 221 222 223 224 225
+Lu positive
+ 226 227 228 229 230 231 232 233 234
+Lu negative
+ 235
+Lx positive
+ 236 237 238 239 240 241 242 243 244
+Lx negative
+ 245
+LX positive
+ 246 247 248 249 250 251 252 253 254
+Lx negative
+ 255
+Lo positive
+ 256 257 258 259 260 261 262 263 264
+Lo negative
+ 265
+a
+ 266
+t
+ 267
+{...%}
+ 268
+(...%)
+ 269
+! % @ , and constants
+ 270 271 272 273 274 275 276
+end of tests
+
+All tests succeeded.
diff -Nru ocaml-3.12.1/testsuite/tests/lib-hashtbl/Makefile ocaml-4.01.0/testsuite/tests/lib-hashtbl/Makefile
--- ocaml-3.12.1/testsuite/tests/lib-hashtbl/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-hashtbl/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,15 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-hashtbl/hfun.ml ocaml-4.01.0/testsuite/tests/lib-hashtbl/hfun.ml
--- ocaml-3.12.1/testsuite/tests/lib-hashtbl/hfun.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-hashtbl/hfun.ml	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,53 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2011 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* Testing the hash function Hashtbl.hash *)
+(* What is tested:
+     - reproducibility on various platforms, esp. 32/64 bit issues
+     - equal values hash equally, esp NaNs. *)
+
+open Printf
+
+let _ =
+  printf "-- Strings:\n";
+  printf "\"\"\t\t%08x\n" (Hashtbl.hash "");
+  printf "\"Hello world\"\t%08x\n" (Hashtbl.hash "Hello world");
+
+  printf "-- Integers:\n";
+  printf "0\t\t%08x\n" (Hashtbl.hash 0);
+  printf "-1\t\t%08x\n" (Hashtbl.hash (-1));
+  printf "42\t\t%08x\n" (Hashtbl.hash 42);
+  printf "2^30-1\t\t%08x\n" (Hashtbl.hash 0x3FFF_FFFF);
+  printf "-2^30\t\t%08x\n" (Hashtbl.hash (-0x4000_0000));
+
+  printf "-- Floats:\n";
+  printf "+0.0\t\t%08x\n" (Hashtbl.hash 0.0);
+  printf "-0.0\t\t%08x\n" (Hashtbl.hash (-. 0.0));
+  printf "+infty\t\t%08x\n" (Hashtbl.hash infinity);
+  printf "-infty\t\t%08x\n" (Hashtbl.hash neg_infinity);
+  printf "NaN\t\t%08x\n" (Hashtbl.hash nan);
+  printf "NaN#2\t\t%08x\n" (Hashtbl.hash (Int64.float_of_bits 0xFF_F0_00_12_34_56_78_9AL));
+  printf "NaN#3\t\t%08x\n" (Hashtbl.hash (0.0 /. 0.0));
+
+  printf "-- Native integers:\n";
+  printf "0\t\t%08x\n" (Hashtbl.hash 0n);
+  printf "-1\t\t%08x\n" (Hashtbl.hash (-1n));
+  printf "42\t\t%08x\n" (Hashtbl.hash 42n);
+  printf "2^30-1\t\t%08x\n" (Hashtbl.hash 0x3FFF_FFFFn);
+  printf "-2^30\t\t%08x\n" (Hashtbl.hash (-0x4000_0000n));
+
+  printf "-- Lists:\n";
+  printf "[0..10]\t\t%08x\n" (Hashtbl.hash [0;1;2;3;4;5;6;7;8;9;10]);
+  printf "[0..12]\t\t%08x\n" (Hashtbl.hash [0;1;2;3;4;5;6;7;8;9;10;11;12]);
+  printf "[10..0]\t\t%08x\n" (Hashtbl.hash [10;9;8;7;6;5;4;3;2;1;0]);
+
+  ()
diff -Nru ocaml-3.12.1/testsuite/tests/lib-hashtbl/hfun.reference ocaml-4.01.0/testsuite/tests/lib-hashtbl/hfun.reference
--- ocaml-3.12.1/testsuite/tests/lib-hashtbl/hfun.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-hashtbl/hfun.reference	2012-07-30 18:04:46.000000000 +0000
@@ -0,0 +1,27 @@
+-- Strings:
+""		00000000
+"Hello world"	364b8272
+-- Integers:
+0		07be548a
+-1		3653e015
+42		1792870b
+2^30-1		23c392d0
+-2^30		0c66fde3
+-- Floats:
++0.0		0f478b8c
+-0.0		0f478b8c
++infty		23ea56fb
+-infty		059f7872
+NaN		3228858d
+NaN#2		3228858d
+NaN#3		3228858d
+-- Native integers:
+0		3f19274a
+-1		3653e015
+42		3e33aef8
+2^30-1		3711bf46
+-2^30		2e71f39c
+-- Lists:
+[0..10]		0ade0fc9
+[0..12]		0ade0fc9
+[10..0]		0cd6259d
diff -Nru ocaml-3.12.1/testsuite/tests/lib-hashtbl/htbl.ml ocaml-4.01.0/testsuite/tests/lib-hashtbl/htbl.ml
--- ocaml-3.12.1/testsuite/tests/lib-hashtbl/htbl.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-hashtbl/htbl.ml	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,204 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2011 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* Hashtable operations, using maps as a reference *)
+
+open Printf
+
+module Test(H: Hashtbl.S) (M: Map.S with type key = H.key) = struct
+
+  let incl_mh m h =
+    try
+      M.iter
+        (fun k d ->
+          let d' = H.find h k in if d <> d' then raise Exit)
+        m;
+      true
+    with Exit | Not_found -> false
+
+  let domain_hm h m =
+    try
+      H.iter
+        (fun k d -> if not (M.mem k m) then raise Exit)
+        h;
+      true
+    with Exit -> false
+
+  let incl_hm h m =
+    try
+      H.iter
+        (fun k d ->
+           let d' = M.find k m in if d <> d' then raise Exit)
+        h;
+      true
+    with Exit | Not_found -> false
+
+  let test data =
+    let n = Array.length data in
+    let h = H.create 51 and m = ref M.empty in
+    (* Insert all data with H.add *)
+    Array.iter
+      (fun (k, d) -> H.add h k d; m := M.add k d !m)
+      data;
+    printf "Insertion: %s\n"
+           (if incl_mh !m h && domain_hm h !m then "passed" else "FAILED");
+    (* Insert all data with H.replace *)
+    H.clear h; m := M.empty;
+    Array.iter
+      (fun (k, d) -> H.replace h k d; m := M.add k d !m)
+      data;
+    printf "Insertion: %s\n"
+           (if incl_mh !m h && incl_hm h !m then "passed" else "FAILED");
+    (* Remove some of the data *)
+    for i = 0 to n/3 - 1 do
+      let (k, _) = data.(i) in H.remove h k; m := M.remove k !m
+    done;
+    printf "Removal: %s\n"
+           (if incl_mh !m h && incl_hm h !m then "passed" else "FAILED")
+
+end
+
+module MS = Map.Make(struct type t = string
+                            let compare (x:t) (y:t) = Pervasives.compare x y
+                     end)
+module MI = Map.Make(struct type t = int
+                            let compare (x:t) (y:t) = Pervasives.compare x y
+                     end)
+
+module MSP = Map.Make(struct type t = string*string
+                            let compare (x:t) (y:t) = Pervasives.compare x y
+                     end)
+
+module MSL = Map.Make(struct type t = string list
+                            let compare (x:t) (y:t) = Pervasives.compare x y
+                     end)
+
+(* Generic hash wrapped as a functorial hash *)
+
+module HofM (M: Map.S) : Hashtbl.S with type key = M.key =
+  struct
+    type key = M.key
+    type 'a t = (key, 'a) Hashtbl.t
+    let create s = Hashtbl.create s
+    let clear = Hashtbl.clear
+    let reset = Hashtbl.reset
+    let copy = Hashtbl.copy
+    let add = Hashtbl.add
+    let remove = Hashtbl.remove
+    let find = Hashtbl.find
+    let find_all = Hashtbl.find_all
+    let replace = Hashtbl.replace
+    let mem = Hashtbl.mem
+    let iter = Hashtbl.iter
+    let fold = Hashtbl.fold
+    let length = Hashtbl.length
+    let stats = Hashtbl.stats
+  end
+
+module HS1 = HofM(MS)
+module HI1 = HofM(MI)
+module HSP = HofM(MSP)
+module HSL = HofM(MSL)
+
+(* Specific functorial hashes *)
+
+module HS2 = Hashtbl.Make(struct type t = string
+                                 let equal (x:t) (y:t) = x=y
+                                 let hash = Hashtbl.hash end)
+
+module HI2 = Hashtbl.Make(struct type t = int
+                                 let equal (x:t) (y:t) = x=y
+                                 let hash = Hashtbl.hash end)
+(* Instantiating the test *)
+
+module TS1 = Test(HS1)(MS)
+module TS2 = Test(HS2)(MS)
+module TI1 = Test(HI1)(MI)
+module TI2 = Test(HI2)(MI)
+module TSP = Test(HSP)(MSP)
+module TSL = Test(HSL)(MSL)
+
+(* Data set: strings from a file, associated with their line number *)
+
+let file_data filename =
+  let ic = open_in filename in
+  let lineno = ref 0 in
+  let data = ref [] in
+  begin try
+    while true do
+      let l = input_line ic in
+      incr lineno;
+      data := (l, !lineno) :: !data
+    done
+  with End_of_file -> ()
+  end;
+  close_in ic;
+  Array.of_list !data
+
+(* Data set: fixed strings *)
+
+let string_data = [|
+  "Si", 0; "non", 1; "e", 2; "vero", 3; "e", 4; "ben", 5; "trovato", 6;
+  "An", 10; "apple", 11; "a", 12; "day", 13; "keeps", 14; "the", 15;
+  "doctor", 16; "away", 17;
+  "Pierre", 20; "qui", 21; "roule", 22; "n'amasse", 23; "pas", 24; "mousse", 25;
+  "Asinus", 30; "asinum", 31; "fricat", 32
+|]
+
+(* Data set: random integers *)
+
+let random_integers num range =
+  let data = Array.make num (0,0) in
+  for i = 0 to num - 1 do
+    data.(i) <- (Random.int range, i)
+  done;
+  data
+
+(* Data set: pairs *)
+
+let pair_data data =
+  Array.map (fun (k, d) -> ((k, k), d)) data
+
+(* Data set: lists *)
+
+let list_data data =
+  let d = Array.make (Array.length data / 10) ([], 0) in
+  let j = ref 0 in
+  let rec mklist n =
+    if n <= 0 || !j >= Array.length data then [] else begin
+      let hd = fst data.(!j) in
+      incr j;
+      let tl = mklist (n-1) in
+      hd :: tl
+    end in
+  for i = 0 to Array.length d - 1 do
+    d.(i) <- (mklist (Random.int 16), i)
+  done;
+  d
+
+(* The test *)
+
+let _ =
+  printf "-- Random integers, large range\n%!";
+  TI1.test (random_integers 100_000 1_000_000);
+  printf "-- Random integers, narrow range\n%!";
+  TI2.test (random_integers 100_000 1_000);
+  let d =
+    try file_data "/usr/share/dict/words" with Sys_error _ -> string_data in
+  printf "-- Strings, generic interface\n%!";
+  TS1.test d;
+  printf "-- Strings, functorial interface\n%!";
+  TS2.test d;
+  printf "-- Pairs of strings\n%!";
+  TSP.test (pair_data d);
+  printf "-- Lists of strings\n%!";
+  TSL.test (list_data d)
diff -Nru ocaml-3.12.1/testsuite/tests/lib-hashtbl/htbl.reference ocaml-4.01.0/testsuite/tests/lib-hashtbl/htbl.reference
--- ocaml-3.12.1/testsuite/tests/lib-hashtbl/htbl.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-hashtbl/htbl.reference	2011-05-29 09:52:27.000000000 +0000
@@ -0,0 +1,24 @@
+-- Random integers, large range
+Insertion: passed
+Insertion: passed
+Removal: passed
+-- Random integers, narrow range
+Insertion: passed
+Insertion: passed
+Removal: passed
+-- Strings, generic interface
+Insertion: passed
+Insertion: passed
+Removal: passed
+-- Strings, functorial interface
+Insertion: passed
+Insertion: passed
+Removal: passed
+-- Pairs of strings
+Insertion: passed
+Insertion: passed
+Removal: passed
+-- Lists of strings
+Insertion: passed
+Insertion: passed
+Removal: passed
diff -Nru ocaml-3.12.1/testsuite/tests/lib-marshal/Makefile ocaml-4.01.0/testsuite/tests/lib-marshal/Makefile
--- ocaml-3.12.1/testsuite/tests/lib-marshal/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-marshal/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,6 +1,19 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 #MODULES=
 MAIN_MODULE=intext
 C_FILES=intextaux
 
-include ../../makefiles/Makefile.one
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-marshal/intext.ml ocaml-4.01.0/testsuite/tests/lib-marshal/intext.ml
--- ocaml-3.12.1/testsuite/tests/lib-marshal/intext.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-marshal/intext.ml	2013-05-22 12:56:54.000000000 +0000
@@ -1,5 +1,19 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Test for output_value / input_value *)
 
+let max_data_depth = 500000
+
 type t = A | B of int | C of float | D of string | E of char
        | F of t | G of t * t | H of int * t | I of t * float | J
 
@@ -425,6 +439,114 @@
     | _       -> false
   end
 
+(* Test for really deep data structures *)
+let test_deep () =
+  (* Right-leaning *)
+  let rec loop acc i =
+    if i < max_data_depth
+    then loop (i :: acc) (i+1)
+    else acc in
+  let x = loop [] 0 in
+  let s = Marshal.to_string x [] in
+  test 425 (Marshal.from_string s 0 = x);
+  (* Left-leaning *)
+  let rec loop acc i =
+    if i < max_data_depth
+    then loop (G(acc, B i)) (i+1)
+    else acc in
+  let x = loop A 0 in
+  let s = Marshal.to_string x [] in
+  test 426 (Marshal.from_string s 0 = x)
+
+(* Test for objects *)
+class foo = object (self : 'self)
+  val data1 = "foo"
+  val data2 = "bar"
+  val data3 = 42L
+  method test1 = data1 ^ data2
+  method test2 = false
+  method test3 = self#test1
+  method test4 = data3
+end
+
+class bar = object (self : 'self)
+  inherit foo as super
+  val! data2 = "test5"
+  val data4 = "test3"
+  val data5 = "test4"
+  method test1 =
+    data1
+  ^ data2
+  ^ data4
+  ^ data5
+  ^ Int64.to_string self#test4
+end
+
+class foobar = object (self : 'self)
+  inherit foo as super
+  inherit! bar
+end
+
+(* Test for objects *)
+let test_objects () =
+  let x = new foo in
+  let s = Marshal.to_string x [Marshal.Closures] in
+  let x = Marshal.from_string s 0 in
+  test 500 (x#test1 = "foobar");
+  test 501 (x#test2 = false);
+  test 502 (x#test3 = "foobar");
+  test 503 (x#test4 = 42L);
+  let x = new bar in
+  let s = Marshal.to_string x [Marshal.Closures] in
+  let x = Marshal.from_string s 0 in
+  test 504 (x#test1 = "footest5test3test442");
+  test 505 (x#test2 = false);
+  test 506 (x#test3 = "footest5test3test442");
+  test 507 (x#test4 = 42L);
+  let x0 = new foobar in
+  let s = Marshal.to_string x0 [Marshal.Closures] in
+  let x = Marshal.from_string s 0 in
+  test 508 (x#test1 = "footest5test3test442");
+  test 509 (x#test2 = false);
+  test 510 (x#test3 = "footest5test3test442");
+  test 511 (x#test4 = 42L);
+  test 512 (Oo.id x = Oo.id x0 + 1)     (* PR#5610 *)
+
+(* Test for infix pointers *)
+let test_infix () =
+  let t = true and
+      f = false in
+  let rec odd n =
+    if n = 0
+    then f
+    else even (n-1)
+  and even n =
+    if n = 0
+    then t
+    else odd (n-1)
+  in
+  let s = Marshal.to_string (odd, even) [Marshal.Closures] in
+  let (odd', even': (int -> bool) * (int -> bool)) = Marshal.from_string s 0 in
+  test 600 (odd' 41 = true);
+  test 601 (odd' 41 = odd 41);
+  test 602 (odd' 142 = false);
+  test 603 (odd' 142 = odd 142);
+  test 604 (even' 41 = false);
+  test 605 (even' 41 = even 41);
+  test 606 (even' 142 = true);
+  test 607 (even' 142 = even 142)
+
+
+let test_mutual_rec_regression () =
+  (* this regression was reported by Cedric Pasteur in PR#5772 *)
+  let rec test_one q x = x > 3
+  and test_list q = List.for_all (test_one q) q in
+  let g () = () in
+  let f q = if test_list q then g () in
+
+  test 700 (try ignore (Marshal.to_string f [Marshal.Closures]); true
+            with _ -> false)
+
 let main() =
   if Array.length Sys.argv <= 2 then begin
     test_out "intext.data"; test_in "intext.data";
@@ -433,7 +555,11 @@
     test_string();
     test_buffer();
     test_size();
-    test_block()
+    test_block();
+    test_deep();
+    test_objects();
+    test_infix ();
+    test_mutual_rec_regression ();
   end else
   if Sys.argv.(1) = "make" then begin
     let n = int_of_string Sys.argv.(2) in
diff -Nru ocaml-3.12.1/testsuite/tests/lib-marshal/intext.reference ocaml-4.01.0/testsuite/tests/lib-marshal/intext.reference
--- ocaml-3.12.1/testsuite/tests/lib-marshal/intext.reference	2010-01-25 14:05:37.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-marshal/intext.reference	2012-10-05 16:04:13.000000000 +0000
@@ -147,3 +147,27 @@
 Test 422 passed.
 Test 423 passed.
 Test 424 passed.
+Test 425 passed.
+Test 426 passed.
+Test 500 passed.
+Test 501 passed.
+Test 502 passed.
+Test 503 passed.
+Test 504 passed.
+Test 505 passed.
+Test 506 passed.
+Test 507 passed.
+Test 508 passed.
+Test 509 passed.
+Test 510 passed.
+Test 511 passed.
+Test 512 passed.
+Test 600 passed.
+Test 601 passed.
+Test 602 passed.
+Test 603 passed.
+Test 604 passed.
+Test 605 passed.
+Test 606 passed.
+Test 607 passed.
+Test 700 passed.
diff -Nru ocaml-3.12.1/testsuite/tests/lib-marshal/intextaux.c ocaml-4.01.0/testsuite/tests/lib-marshal/intextaux.c
--- ocaml-3.12.1/testsuite/tests/lib-marshal/intextaux.c	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-marshal/intextaux.c	2012-10-17 20:09:16.000000000 +0000
@@ -1,9 +1,21 @@
+/***********************************************************************/
+/*                                                                     */
+/*                                OCaml                                */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 2001 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the Q Public License version 1.0.               */
+/*                                                                     */
+/***********************************************************************/
+
 #include 
 #include 
 
 value marshal_to_block(value vbuf, value vlen, value v, value vflags)
 {
-  return Val_long(output_value_to_block(v, vflags, 
+  return Val_long(output_value_to_block(v, vflags,
                                         (char *) vbuf, Long_val(vlen)));
 }
 
diff -Nru ocaml-3.12.1/testsuite/tests/lib-num/Makefile ocaml-4.01.0/testsuite/tests/lib-num/Makefile
--- ocaml-3.12.1/testsuite/tests/lib-num/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-num/Makefile	2013-05-17 12:03:58.000000000 +0000
@@ -1,7 +1,21 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 MODULES=test test_nats test_big_ints test_ratios test_nums test_io
 MAIN_MODULE=end_test
-ADD_COMPFLAGS=-w a
 LIBRARIES=nums
+ADD_COMPFLAGS=-w a -I $(OTOPDIR)/otherlibs/num
+LD_PATH=$(TOPDIR)/otherlibs/num
 
-include ../../makefiles/Makefile.one
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-num/end_test.ml ocaml-4.01.0/testsuite/tests/lib-num/end_test.ml
--- ocaml-3.12.1/testsuite/tests/lib-num/end_test.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-num/end_test.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1 +1,13 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 Test.end_tests ();;
diff -Nru ocaml-3.12.1/testsuite/tests/lib-num/end_test.reference ocaml-4.01.0/testsuite/tests/lib-num/end_test.reference
--- ocaml-3.12.1/testsuite/tests/lib-num/end_test.reference	2010-05-03 10:26:50.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-num/end_test.reference	2013-05-08 08:55:42.000000000 +0000
@@ -82,6 +82,8 @@
 shift_right_towards_zero_big_int
  1... 2...
 extract_big_int
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10...
+hashing of big integers
  1... 2... 3... 4... 5... 6...
 create_ratio
  1... 2... 3... 4... 5... 6... 7... 8...
diff -Nru ocaml-3.12.1/testsuite/tests/lib-num/test.ml ocaml-4.01.0/testsuite/tests/lib-num/test.ml
--- ocaml-3.12.1/testsuite/tests/lib-num/test.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-num/test.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 open Printf;;
 
 let flush_all () = flush stdout; flush stderr;;
diff -Nru ocaml-3.12.1/testsuite/tests/lib-num/test_big_ints.ml ocaml-4.01.0/testsuite/tests/lib-num/test_big_ints.ml
--- ocaml-3.12.1/testsuite/tests/lib-num/test_big_ints.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-num/test_big_ints.ml	2013-05-08 08:55:42.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 open Test;;
 open Nat;;
 open Big_int;;
@@ -56,52 +68,52 @@
 test 1
 eq_big_int (add_big_int zero_big_int zero_big_int, zero_big_int);;
 test 2
-eq_big_int (add_big_int zero_big_int (big_int_of_int 1), 
+eq_big_int (add_big_int zero_big_int (big_int_of_int 1),
             big_int_of_int 1);;
 test 3
-eq_big_int (add_big_int (big_int_of_int 1) zero_big_int, 
+eq_big_int (add_big_int (big_int_of_int 1) zero_big_int,
             big_int_of_int 1);;
 test 4
-eq_big_int (add_big_int zero_big_int (big_int_of_int (-1)), 
+eq_big_int (add_big_int zero_big_int (big_int_of_int (-1)),
             big_int_of_int (-1));;
 test 5
-eq_big_int (add_big_int (big_int_of_int (-1)) zero_big_int, 
+eq_big_int (add_big_int (big_int_of_int (-1)) zero_big_int,
             big_int_of_int (-1));;
 test 6
-eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int 1), 
+eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int 1),
             big_int_of_int 2);;
 test 7
-eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int 2), 
+eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int 2),
             big_int_of_int 3);;
 test 8
-eq_big_int (add_big_int (big_int_of_int 2) (big_int_of_int 1), 
+eq_big_int (add_big_int (big_int_of_int 2) (big_int_of_int 1),
             big_int_of_int 3);;
 test 9
-eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int (-1)), 
+eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int (-1)),
             big_int_of_int (-2));;
 test 10
-eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int (-2)), 
+eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int (-2)),
             big_int_of_int (-3));;
 test 11
-eq_big_int (add_big_int (big_int_of_int (-2)) (big_int_of_int (-1)), 
+eq_big_int (add_big_int (big_int_of_int (-2)) (big_int_of_int (-1)),
             big_int_of_int (-3));;
 test 12
-eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int (-1)), 
+eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int (-1)),
             zero_big_int);;
 test 13
-eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int 1), 
+eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int 1),
             zero_big_int);;
 test 14
-eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int (-2)), 
+eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int (-2)),
             big_int_of_int (-1));;
 test 15
-eq_big_int (add_big_int (big_int_of_int (-2)) (big_int_of_int 1), 
+eq_big_int (add_big_int (big_int_of_int (-2)) (big_int_of_int 1),
             big_int_of_int (-1));;
 test 16
-eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int 2), 
+eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int 2),
             big_int_of_int 1);;
 test 17
-eq_big_int (add_big_int (big_int_of_int 2) (big_int_of_int (-1)), 
+eq_big_int (add_big_int (big_int_of_int 2) (big_int_of_int (-1)),
             big_int_of_int 1);;
 
 
@@ -110,52 +122,52 @@
 test 1
 eq_big_int (sub_big_int zero_big_int zero_big_int, zero_big_int);;
 test 2
-eq_big_int (sub_big_int zero_big_int (big_int_of_int 1), 
+eq_big_int (sub_big_int zero_big_int (big_int_of_int 1),
             big_int_of_int (-1));;
 test 3
-eq_big_int (sub_big_int (big_int_of_int 1) zero_big_int, 
+eq_big_int (sub_big_int (big_int_of_int 1) zero_big_int,
             big_int_of_int 1);;
 test 4
-eq_big_int (sub_big_int zero_big_int (big_int_of_int (-1)), 
+eq_big_int (sub_big_int zero_big_int (big_int_of_int (-1)),
             big_int_of_int 1);;
 test 5
-eq_big_int (sub_big_int (big_int_of_int (-1)) zero_big_int, 
+eq_big_int (sub_big_int (big_int_of_int (-1)) zero_big_int,
             big_int_of_int (-1));;
 test 6
-eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int 1), 
+eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int 1),
             zero_big_int);;
 test 7
-eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int 2), 
+eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int 2),
             big_int_of_int (-1));;
 test 8
-eq_big_int (sub_big_int (big_int_of_int 2) (big_int_of_int 1), 
+eq_big_int (sub_big_int (big_int_of_int 2) (big_int_of_int 1),
             big_int_of_int 1);;
 test 9
-eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int (-1)), 
+eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int (-1)),
             zero_big_int);;
 test 10
-eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int (-2)), 
+eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int (-2)),
             big_int_of_int 1);;
 test 11
-eq_big_int (sub_big_int (big_int_of_int (-2)) (big_int_of_int (-1)), 
+eq_big_int (sub_big_int (big_int_of_int (-2)) (big_int_of_int (-1)),
             big_int_of_int (-1));;
 test 12
-eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int (-1)), 
+eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int (-1)),
             big_int_of_int 2);;
 test 13
-eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int 1), 
+eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int 1),
             big_int_of_int (-2));;
 test 14
-eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int (-2)), 
+eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int (-2)),
             big_int_of_int 3);;
 test 15
-eq_big_int (sub_big_int (big_int_of_int (-2)) (big_int_of_int 1), 
+eq_big_int (sub_big_int (big_int_of_int (-2)) (big_int_of_int 1),
             big_int_of_int (-3));;
 test 16
-eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int 2), 
+eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int 2),
             big_int_of_int (-3));;
 test 17
-eq_big_int (sub_big_int (big_int_of_int 2) (big_int_of_int (-1)), 
+eq_big_int (sub_big_int (big_int_of_int 2) (big_int_of_int (-1)),
             big_int_of_int 3);;
 
 testing_function "mult_int_big_int";;
@@ -172,21 +184,21 @@
 testing_function "mult_big_int";;
 
 test 1
-eq_big_int (mult_big_int zero_big_int zero_big_int, 
+eq_big_int (mult_big_int zero_big_int zero_big_int,
             zero_big_int);;
 test 2
-eq_big_int (mult_big_int (big_int_of_int 2) (big_int_of_int 3), 
+eq_big_int (mult_big_int (big_int_of_int 2) (big_int_of_int 3),
             big_int_of_int 6);;
 test 3
-eq_big_int (mult_big_int (big_int_of_int 2) (big_int_of_int (-3)), 
+eq_big_int (mult_big_int (big_int_of_int 2) (big_int_of_int (-3)),
             big_int_of_int (-6));;
-test 4 
-eq_big_int (mult_big_int (big_int_of_string "12724951") 
-                         (big_int_of_string "81749606400"), 
+test 4
+eq_big_int (mult_big_int (big_int_of_string "12724951")
+                         (big_int_of_string "81749606400"),
             big_int_of_string "1040259735709286400");;
-test 5 
-eq_big_int (mult_big_int (big_int_of_string "26542080") 
-                          (big_int_of_string "81749606400"), 
+test 5
+eq_big_int (mult_big_int (big_int_of_string "26542080")
+                          (big_int_of_string "81749606400"),
             big_int_of_string "2169804593037312000");;
 
 testing_function "quomod_big_int";;
@@ -201,14 +213,14 @@
  test 3 eq_big_int (quotient, big_int_of_int (-1)) &&
  test 4 eq_big_int (modulo, zero_big_int);;
 
-let (quotient, modulo) = 
+let (quotient, modulo) =
       quomod_big_int (big_int_of_int (-1)) (big_int_of_int 1) in
- test 5 eq_big_int (quotient, big_int_of_int (-1)) && 
+ test 5 eq_big_int (quotient, big_int_of_int (-1)) &&
  test 6 eq_big_int (modulo, zero_big_int);;
 
-let (quotient, modulo) = 
+let (quotient, modulo) =
       quomod_big_int (big_int_of_int 3) (big_int_of_int 2) in
- test 7 eq_big_int (quotient, big_int_of_int 1) && 
+ test 7 eq_big_int (quotient, big_int_of_int 1) &&
  test 8 eq_big_int (modulo, big_int_of_int 1);;
 
 let (quotient, modulo) =
@@ -221,12 +233,12 @@
  test 11 eq_big_int (quotient, big_int_of_int (-2)) &&
  test 12 eq_big_int (modulo, big_int_of_int 1);;
 
-let (quotient, modulo) = 
+let (quotient, modulo) =
       quomod_big_int (big_int_of_int 1) (big_int_of_int 2) in
- test 13 eq_big_int (quotient, zero_big_int) && 
+ test 13 eq_big_int (quotient, zero_big_int) &&
  test 14 eq_big_int (modulo, big_int_of_int 1);;
 
-let (quotient, modulo) = 
+let (quotient, modulo) =
       quomod_big_int (big_int_of_int (-1)) (big_int_of_int 3) in
  test 15 eq_big_int (quotient, minus_big_int unit_big_int) &&
  test 16 eq_big_int (modulo, big_int_of_int 2);;
@@ -236,22 +248,22 @@
 Division_by_zero
 ;;
 
-let (quotient, modulo) = 
+let (quotient, modulo) =
       quomod_big_int (big_int_of_int 10) (big_int_of_int 20) in
  test 18 eq_big_int (quotient, big_int_of_int 0) &&
  test 19 eq_big_int (modulo, big_int_of_int 10);;
 
-let (quotient, modulo) = 
+let (quotient, modulo) =
       quomod_big_int (big_int_of_int (-10)) (big_int_of_int 20) in
  test 20 eq_big_int (quotient, big_int_of_int (-1)) &&
  test 21 eq_big_int (modulo, big_int_of_int 10);;
 
-let (quotient, modulo) = 
+let (quotient, modulo) =
       quomod_big_int (big_int_of_int 10) (big_int_of_int (-20)) in
  test 22 eq_big_int (quotient, big_int_of_int 0) &&
  test 23 eq_big_int (modulo, big_int_of_int 10);;
 
-let (quotient, modulo) = 
+let (quotient, modulo) =
       quomod_big_int (big_int_of_int (-10)) (big_int_of_int (-20)) in
  test 24 eq_big_int (quotient, big_int_of_int 1) &&
  test 25 eq_big_int (modulo, big_int_of_int 10);;
@@ -260,28 +272,28 @@
 testing_function "gcd_big_int";;
 
 test 1
-eq_big_int (gcd_big_int zero_big_int zero_big_int, 
+eq_big_int (gcd_big_int zero_big_int zero_big_int,
             zero_big_int);;
 test 2
-eq_big_int (gcd_big_int zero_big_int (big_int_of_int 1), 
+eq_big_int (gcd_big_int zero_big_int (big_int_of_int 1),
             big_int_of_int 1);;
 test 3
-eq_big_int (gcd_big_int (big_int_of_int 1) zero_big_int, 
+eq_big_int (gcd_big_int (big_int_of_int 1) zero_big_int,
             big_int_of_int 1);;
 test 4
-eq_big_int (gcd_big_int (big_int_of_int 1) (big_int_of_int 2), 
+eq_big_int (gcd_big_int (big_int_of_int 1) (big_int_of_int 2),
             big_int_of_int 1);;
 test 5
-eq_big_int (gcd_big_int (big_int_of_int 2) (big_int_of_int 1), 
+eq_big_int (gcd_big_int (big_int_of_int 2) (big_int_of_int 1),
             big_int_of_int 1);;
 test 6
-eq_big_int (gcd_big_int (big_int_of_int 1) (big_int_of_int 1), 
+eq_big_int (gcd_big_int (big_int_of_int 1) (big_int_of_int 1),
             big_int_of_int 1);;
 test 7
-eq_big_int (gcd_big_int (big_int_of_int 9) (big_int_of_int 16), 
+eq_big_int (gcd_big_int (big_int_of_int 9) (big_int_of_int 16),
             big_int_of_int 1);;
 test 8
-eq_big_int (gcd_big_int (big_int_of_int 12) (big_int_of_int 16), 
+eq_big_int (gcd_big_int (big_int_of_int 12) (big_int_of_int 16),
             big_int_of_int 4);;
 
 for i = 9 to 28 do
@@ -404,7 +416,7 @@
 let bi2 = big_int_of_string (implode (rev ("3" :: tl l))) in
 
 test 10
-eq_big_int (bi1, (add_big_int (mult_big_int bi2 (big_int_of_string "10")) 
+eq_big_int (bi1, (add_big_int (mult_big_int bi2 (big_int_of_string "10"))
                               (big_int_of_string "2")))
 (* test 11
  &&
@@ -444,7 +456,7 @@
 eq_big_int (big_int_of_nat (power_base_int 10 8), big_int_of_int 100000000)
 ;;
 test 3
-eq_big_int (big_int_of_nat (power_base_int 2 (length_of_int + 2)), 
+eq_big_int (big_int_of_nat (power_base_int 2 (length_of_int + 2)),
             big_int_of_nat (let nat = make_nat 2 in
                               set_digit_nat nat 1 1;
                               nat))
@@ -920,5 +932,36 @@
   (extract_big_int (big_int_of_int64 0x123456789ABCDEFL) 0 32,
    big_int_of_int64 2309737967L);;
 test 6 eq_big_int
-  (extract_big_int (big_int_of_int (-1)) 2048 254,
-   zero_big_int);;
+  (extract_big_int (big_int_of_int (-1)) 0 16,
+   big_int_of_int 0xFFFF);;
+test 7 eq_big_int
+  (extract_big_int (big_int_of_int (-1)) 1027 12,
+   big_int_of_int 0xFFF);;
+test 8 eq_big_int
+  (extract_big_int (big_int_of_int (-1234567)) 0 16,
+   big_int_of_int 10617);;
+test 9 eq_big_int
+  (extract_big_int (minus_big_int (power_int_positive_int 2 64)) 64 20,
+   big_int_of_int 0xFFFFF);;
+test 10 eq_big_int
+  (extract_big_int (pred_big_int (minus_big_int (power_int_positive_int 2 64))) 64 20,
+   big_int_of_int 0xFFFFE);;
+
+testing_function "hashing of big integers";;
+
+test 1 eq_int (Hashtbl.hash zero_big_int,
+               955772237);;
+test 2 eq_int (Hashtbl.hash unit_big_int,
+               992063522);;
+test 3 eq_int (Hashtbl.hash (minus_big_int unit_big_int),
+               161678167);;
+test 4 eq_int (Hashtbl.hash (big_int_of_string "123456789123456789"),
+               755417385);;
+test 5 eq_int (Hashtbl.hash (sub_big_int
+                               (big_int_of_string "123456789123456789")
+                               (big_int_of_string "123456789123456789")),
+               955772237);;
+test 6 eq_int (Hashtbl.hash (sub_big_int
+                               (big_int_of_string "123456789123456789")
+                               (big_int_of_string "123456789123456788")),
+              992063522);;
diff -Nru ocaml-3.12.1/testsuite/tests/lib-num/test_io.ml ocaml-4.01.0/testsuite/tests/lib-num/test_io.ml
--- ocaml-3.12.1/testsuite/tests/lib-num/test_io.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-num/test_io.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 open Test
 open Nat
 open Big_int
diff -Nru ocaml-3.12.1/testsuite/tests/lib-num/test_nats.ml ocaml-4.01.0/testsuite/tests/lib-num/test_nats.ml
--- ocaml-3.12.1/testsuite/tests/lib-num/test_nats.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-num/test_nats.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,9 +1,21 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 open Test;;
 open Nat;;
 
 (* Can compare nats less than 2**32 *)
 let equal_nat n1 n2 =
- eq_nat n1 0 (num_digits_nat n1 0 1) 
+ eq_nat n1 0 (num_digits_nat n1 0 1)
         n2 0 (num_digits_nat n2 0 1);;
 
 testing_function "num_digits_nat";;
@@ -108,10 +120,10 @@
 let s = "3333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333" in
 test 21 equal_nat (
 nat_of_string s,
-(let nat = make_nat 15 in 
+(let nat = make_nat 15 in
   set_digit_nat nat 0 3;
-  set_mult_digit_nat nat 0 15 
-                 (nat_of_string (String.sub s 0 135)) 0 14 
+  set_mult_digit_nat nat 0 15
+                 (nat_of_string (String.sub s 0 135)) 0 14
                  (nat_of_int 10) 0;
   nat))
 ;;
diff -Nru ocaml-3.12.1/testsuite/tests/lib-num/test_nums.ml ocaml-4.01.0/testsuite/tests/lib-num/test_nums.ml
--- ocaml-3.12.1/testsuite/tests/lib-num/test_nums.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-num/test_nums.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 open Test;;
 open Nat;;
 open Big_int;;
@@ -12,10 +24,10 @@
 test 2
 eq_num (add_num (Int 1) (Big_int (big_int_of_int 3)), Int 4);;
 test 3
-eq_num (add_num (Int 1) (Ratio (ratio_of_string "3/4")), 
+eq_num (add_num (Int 1) (Ratio (ratio_of_string "3/4")),
         Ratio (ratio_of_string "7/4"));;
 test 4
-eq_num (add_num (Big_int (big_int_of_int 1)) (Ratio (ratio_of_string "3/4")), 
+eq_num (add_num (Big_int (big_int_of_int 1)) (Ratio (ratio_of_string "3/4")),
         Ratio (ratio_of_string "7/4"));;
 test 5
 eq_num (add_num (Big_int (big_int_of_int 1)) (Big_int (big_int_of_int 3)),
@@ -27,10 +39,10 @@
 eq_num (add_num (Ratio (ratio_of_string "2/3")) (Ratio (ratio_of_string "3/4")),
         Ratio (ratio_of_string "17/12"));;
 test 8
-eq_num (add_num (Int least_int) (Int 1), 
+eq_num (add_num (Int least_int) (Int 1),
         Int (- (pred biggest_int)));;
 test 9
-eq_num (add_num (Int biggest_int) (Int 1), 
+eq_num (add_num (Int biggest_int) (Int 1),
         Big_int (minus_big_int (pred_big_int (big_int_of_int least_int))));;
 
 testing_function "sub_num";;
@@ -40,10 +52,10 @@
 test 2
 eq_num (sub_num (Int 1) (Big_int (big_int_of_int 3)), Int (-2));;
 test 3
-eq_num (sub_num (Int 1) (Ratio (ratio_of_string "3/4")), 
+eq_num (sub_num (Int 1) (Ratio (ratio_of_string "3/4")),
         Ratio (ratio_of_string "1/4"));;
 test 4
-eq_num (sub_num (Big_int (big_int_of_int 1)) (Ratio (ratio_of_string "3/4")), 
+eq_num (sub_num (Big_int (big_int_of_int 1)) (Ratio (ratio_of_string "3/4")),
         Ratio (ratio_of_string "1/4"));;
 test 5
 eq_num (sub_num (Big_int (big_int_of_int 1)) (Big_int (big_int_of_int 3)),
@@ -55,7 +67,7 @@
 eq_num (sub_num (Ratio (ratio_of_string "2/3")) (Ratio (ratio_of_string "3/4")),
         Ratio (ratio_of_string "-1/12"));;
 test 9
-eq_num (sub_num (Int least_int) (Int (-1)), 
+eq_num (sub_num (Int least_int) (Int (-1)),
         Int (- (pred biggest_int)));;
 test 10
 eq_num (sub_num (Int (-1)) (Int biggest_int), pred_num (Int least_int));;
@@ -68,12 +80,12 @@
 eq_num (mult_num (Int 127) (Int (int_of_string "257")),
                   Int (int_of_string "32639"));;
 test 3
-eq_num (mult_num (Int 257) (Int (int_of_string "260")), 
+eq_num (mult_num (Int 257) (Int (int_of_string "260")),
         Big_int (big_int_of_string "66820"));;
 test 4
 eq_num (mult_num (Int 2) (Big_int (big_int_of_int 3)), Int 6);;
 test 5
-eq_num (mult_num (Int 10) (Ratio (ratio_of_string "3/4")), 
+eq_num (mult_num (Int 10) (Ratio (ratio_of_string "3/4")),
         Ratio (ratio_of_string "15/2"));;
 test 6
 eq_num (mult_num (Big_int (big_int_of_int 10)) (Ratio (ratio_of_string "3/4")),
@@ -93,31 +105,31 @@
 test 1
 eq_num (div_num (Int 6) (Int 3), Int 2);;
 test 2
-eq_num (div_num (Int (int_of_string "32639")) 
+eq_num (div_num (Int (int_of_string "32639"))
                  (Int (int_of_string "257")), Int 127);;
 test 3
-eq_num (div_num (Big_int (big_int_of_string "66820")) 
-                 (Int (int_of_string "257")), 
+eq_num (div_num (Big_int (big_int_of_string "66820"))
+                 (Int (int_of_string "257")),
         Int 260);;
 test 4
 eq_num (div_num (Int 6) (Big_int (big_int_of_int 3)), Int 2);;
 test 5
-eq_num (div_num (Ratio (ratio_of_string "15/2")) 
+eq_num (div_num (Ratio (ratio_of_string "15/2"))
                  (Int 10),
-        Ratio (ratio_of_string "3/4"));; 
+        Ratio (ratio_of_string "3/4"));;
 test 6
 eq_num (div_num (Big_int (big_int_of_int 6)) (Big_int (big_int_of_int 3)),
         Int 2);;
-test 7 
-eq_num (div_num (Ratio (ratio_of_string "15/2")) 
+test 7
+eq_num (div_num (Ratio (ratio_of_string "15/2"))
                  (Big_int (big_int_of_int 10)),
         Ratio (ratio_of_string "3/4"));;
 test 8
-eq_num (div_num (Ratio (ratio_of_string "15/2")) 
+eq_num (div_num (Ratio (ratio_of_string "15/2"))
                  (Ratio (ratio_of_string "3/4")),
         Big_int (big_int_of_int 10));;
 test 9
-eq_num (div_num (Ratio (ratio_of_string "1/2")) 
+eq_num (div_num (Ratio (ratio_of_string "1/2"))
                  (Ratio (ratio_of_string "3/4")),
         Ratio (ratio_of_string "2/3"));;
 
@@ -137,7 +149,7 @@
 test 1
 eq_num (num_of_ratio (ratio_of_string "4/2"), Int 2);;
 test 2
-eq_num (num_of_ratio (ratio_of_string "11811160075/11"), 
+eq_num (num_of_ratio (ratio_of_string "11811160075/11"),
         Big_int (big_int_of_string "1073741825"));;
 test 3
 eq_num (num_of_ratio (ratio_of_string "123456789012/1234"),
@@ -205,13 +217,13 @@
 
 test 3 eq (f1 (0/1), true);;
 
-test 4 eq (f1 (let n = num_of_string "2000000000000000000000000" in n-n) , 
+test 4 eq (f1 (let n = num_of_string "2000000000000000000000000" in n-n) ,
             true);;
 
-test 5 eq (f1 (let n = num_of_string "2000000000000000000000000" in n/n-1) , 
+test 5 eq (f1 (let n = num_of_string "2000000000000000000000000" in n/n-1) ,
             true);;
 
-test 6 eq (f1 (let n = num_of_string "2000000000000000000000000" in n+1) , 
+test 6 eq (f1 (let n = num_of_string "2000000000000000000000000" in n+1) ,
             false);;
 
 test 7 eq (f1 (1/2), false);;
diff -Nru ocaml-3.12.1/testsuite/tests/lib-num/test_ratios.ml ocaml-4.01.0/testsuite/tests/lib-num/test_ratios.ml
--- ocaml-3.12.1/testsuite/tests/lib-num/test_ratios.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-num/test_ratios.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 open Test;;
 open Nat;;
 open Big_int;;
diff -Nru ocaml-3.12.1/testsuite/tests/lib-num-2/Makefile ocaml-4.01.0/testsuite/tests/lib-num-2/Makefile
--- ocaml-3.12.1/testsuite/tests/lib-num-2/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-num-2/Makefile	2013-05-17 12:03:58.000000000 +0000
@@ -1,5 +1,20 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 LIBRARIES=nums
+ADD_COMPFLAGS=-I $(OTOPDIR)/otherlibs/num
+LD_PATH=$(TOPDIR)/otherlibs/num
 PROGRAM_ARGS=1000
 
-include ../../makefiles/Makefile.several
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-num-2/pi_big_int.ml ocaml-4.01.0/testsuite/tests/lib-num-2/pi_big_int.ml
--- ocaml-3.12.1/testsuite/tests/lib-num-2/pi_big_int.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-num-2/pi_big_int.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(*************************************************************************)
+(*                                                                       *)
+(*                                 OCaml                                 *)
+(*                                                                       *)
+(*            Pierre Weis, projet Estime, INRIA Rocquencourt             *)
+(*                                                                       *)
+(*   Copyright 2008 Institut National de Recherche en Informatique et    *)
+(*   en Automatique.  All rights reserved.  This file is distributed     *)
+(*   under the terms of the Q Public License version 1.0.                *)
+(*                                                                       *)
+(*************************************************************************)
+
 (* Pi digits computed with the sreaming algorithm given on pages 4, 6
    & 7 of "Unbounded Spigot Algorithms for the Digits of Pi", Jeremy
    Gibbons, August 2004. *)
diff -Nru ocaml-3.12.1/testsuite/tests/lib-num-2/pi_num.ml ocaml-4.01.0/testsuite/tests/lib-num-2/pi_num.ml
--- ocaml-3.12.1/testsuite/tests/lib-num-2/pi_num.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-num-2/pi_num.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,14 @@
+(*************************************************************************)
+(*                                                                       *)
+(*                                 OCaml                                 *)
+(*                                                                       *)
+(*            Pierre Weis, projet Estime, INRIA Rocquencourt             *)
+(*                                                                       *)
+(*   Copyright 2008 Institut National de Recherche en Informatique et    *)
+(*   en Automatique.  All rights reserved.  This file is distributed     *)
+(*   under the terms of the Q Public License version 1.0.                *)
+(*                                                                       *)
+(*************************************************************************)
 
 (* Pi digits computed with the sreaming algorithm given on pages 4, 6
    & 7 of "Unbounded Spigot Algorithms for the Digits of Pi", Jeremy
diff -Nru ocaml-3.12.1/testsuite/tests/lib-printf/Makefile ocaml-4.01.0/testsuite/tests/lib-printf/Makefile
--- ocaml-3.12.1/testsuite/tests/lib-printf/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-printf/Makefile	2013-05-07 09:39:38.000000000 +0000
@@ -0,0 +1,19 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+#MODULES=
+MAIN_MODULE=tprintf
+ADD_COMPFLAGS=-I $(OTOPDIR)/testsuite/lib
+ADD_MODULES=testing
+
+include ../../makefiles/Makefile.one
+include ../../makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-printf/tprintf.ml ocaml-4.01.0/testsuite/tests/lib-printf/tprintf.ml
--- ocaml-3.12.1/testsuite/tests/lib-printf/tprintf.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-printf/tprintf.ml	2013-04-29 16:52:45.000000000 +0000
@@ -0,0 +1,493 @@
+(*************************************************************************)
+(*                                                                       *)
+(*                                OCaml                                  *)
+(*                                                                       *)
+(*         Damien Doligez, projet Gallium, INRIA Rocquencourt            *)
+(*                                                                       *)
+(*   Copyright 2011 Institut National de Recherche en Informatique et    *)
+(*   en Automatique.  All rights reserved.  This file is distributed     *)
+(*   under the terms of the Q Public License version 1.0.                *)
+(*                                                                       *)
+(*************************************************************************)
+
+(*
+
+A test file for the Printf module.
+
+*)
+
+open Testing;;
+open Printf;;
+
+try
+
+  printf "d/i positive\n%!";
+  test (sprintf "%d/%i" 42 43 = "42/43");
+  test (sprintf "%-4d/%-5i" 42 43 = "42  /43   ");
+  test (sprintf "%04d/%05i" 42 43 = "0042/00043");
+  test (sprintf "%+d/%+i" 42 43 = "+42/+43");
+  test (sprintf "% d/% i" 42 43 = " 42/ 43");
+  test (sprintf "%#d/%#i" 42 43 = "42/43");
+  test (sprintf "%4d/%5i" 42 43 = "  42/   43");
+  test (sprintf "%*d/%*i" 4 42 5 43 = "  42/   43");
+  test (sprintf "%-0+#4d/%-0 #5i" 42 43 = "+42 / 43  ");
+
+  printf "\nd/i negative\n%!";
+  test (sprintf "%d/%i" (-42) (-43) = "-42/-43");
+  test (sprintf "%-4d/%-5i" (-42) (-43) = "-42 /-43  ");
+  test (sprintf "%04d/%05i" (-42) (-43) = "-042/-0043");
+  test (sprintf "%+d/%+i" (-42) (-43) = "-42/-43");
+  test (sprintf "% d/% i" (-42) (-43) = "-42/-43");
+  test (sprintf "%#d/%#i" (-42) (-43) = "-42/-43");
+  test (sprintf "%4d/%5i" (-42) (-43) = " -42/  -43");
+  test (sprintf "%*d/%*i" 4 (-42) 5 (-43) = " -42/  -43");
+  test (sprintf "%-0+ #4d/%-0+ #5i" (-42) (-43) = "-42 /-43  ");
+
+  printf "\nu positive\n%!";
+  test (sprintf "%u" 42 = "42");
+  test (sprintf "%-4u" 42 = "42  ");
+  test (sprintf "%04u" 42 = "0042");
+  test (sprintf "%+u" 42 = "42");
+  test (sprintf "% u" 42 = "42");
+  test (sprintf "%#u" 42 = "42");
+  test (sprintf "%4u" 42 = "  42");
+  test (sprintf "%*u" 4 42 = "  42");
+  test (sprintf "%-0+ #6d" 42 = "+42   ");
+
+  printf "\nu negative\n%!";
+  begin match Sys.word_size with
+  | 32 ->
+     test (sprintf "%u" (-1) = "2147483647");
+  | 64 ->
+     test (sprintf "%u" (-1) = "9223372036854775807");
+  | _ -> test false
+  end;
+
+  printf "\nx positive\n%!";
+  test (sprintf "%x" 42 = "2a");
+  test (sprintf "%-4x" 42 = "2a  ");
+  test (sprintf "%04x" 42 = "002a");
+  test (sprintf "%+x" 42 = "2a");
+  test (sprintf "% x" 42 = "2a");
+  test (sprintf "%#x" 42 = "0x2a");
+  test (sprintf "%4x" 42 = "  2a");
+  test (sprintf "%*x" 5 42 = "   2a");
+  test (sprintf "%-0+ #*x" 5 42 = "0x2a ");
+
+  printf "\nx negative\n%!";
+  begin match Sys.word_size with
+  | 32 ->
+     test (sprintf "%x" (-42) = "7fffffd6");
+  | 64 ->
+     test (sprintf "%x" (-42) = "7fffffffffffffd6");
+  | _ -> test false
+  end;
+
+  printf "\nX positive\n%!";
+  test (sprintf "%X" 42 = "2A");
+  test (sprintf "%-4X" 42 = "2A  ");
+  test (sprintf "%04X" 42 = "002A");
+  test (sprintf "%+X" 42 = "2A");
+  test (sprintf "% X" 42 = "2A");
+  test (sprintf "%#X" 42 = "0X2A");
+  test (sprintf "%4X" 42 = "  2A");
+  test (sprintf "%*X" 5 42 = "   2A");
+  test (sprintf "%-0+ #*X" 5 42 = "0X2A ");
+
+  printf "\nx negative\n%!";
+  begin match Sys.word_size with
+  | 32 ->
+     test (sprintf "%X" (-42) = "7FFFFFD6");
+  | 64 ->
+     test (sprintf "%X" (-42) = "7FFFFFFFFFFFFFD6");
+  | _ -> test false
+  end;
+
+  printf "\no positive\n%!";
+  test (sprintf "%o" 42 = "52");
+  test (sprintf "%-4o" 42 = "52  ");
+  test (sprintf "%04o" 42 = "0052");
+  test (sprintf "%+o" 42 = "52");
+  test (sprintf "% o" 42 = "52");
+  test (sprintf "%#o" 42 = "052");
+  test (sprintf "%4o" 42 = "  52");
+  test (sprintf "%*o" 5 42 = "   52");
+  test (sprintf "%-0+ #*o" 5 42 = "052  ");
+
+  printf "\no negative\n%!";
+  begin match Sys.word_size with
+  | 32 ->
+     test (sprintf "%o" (-42) = "17777777726");
+  | 64 ->
+     test (sprintf "%o" (-42) = "777777777777777777726");
+  | _ -> test false
+  end;
+
+  printf "\ns\n%!";
+  test (sprintf "%s" "foo" = "foo");
+  test (sprintf "%-5s" "foo" = "foo  ");
+  test (sprintf "%05s" "foo" = "  foo");
+  test (sprintf "%+s" "foo" = "foo");
+  test (sprintf "% s" "foo" = "foo");
+  test (sprintf "%#s" "foo" = "foo");
+  test (sprintf "%5s" "foo" = "  foo");
+  test (sprintf "%1s" "foo" = "foo");
+  test (sprintf "%*s" 6 "foo" = "   foo");
+  test (sprintf "%*s" 2 "foo" = "foo");
+  test (sprintf "%-0+ #5s" "foo" = "foo  ");
+  test (sprintf "%s@" "foo" = "foo@");
+  test (sprintf "%s@inria.fr" "foo" = "foo@inria.fr");
+  test (sprintf "%s@%s" "foo" "inria.fr" = "foo@inria.fr");
+
+  printf "\nS\n%!";
+  test (sprintf "%S" "fo\"o" = "\"fo\\\"o\"");
+(*  test (sprintf "%-5S" "foo" = "\"foo\"  ");   padding not done *)
+(*  test (sprintf "%05S" "foo" = "  \"foo\"");   padding not done *)
+  test (sprintf "%+S" "foo" = "\"foo\"");
+  test (sprintf "% S" "foo" = "\"foo\"");
+  test (sprintf "%#S" "foo" = "\"foo\"");
+(*  test (sprintf "%5S" "foo" = "  \"foo\"");    padding not done *)
+  test (sprintf "%1S" "foo" = "\"foo\"");
+(*  test (sprintf "%*S" 6 "foo" = "   \"foo\"");  padding not done *)
+  test (sprintf "%*S" 2 "foo" = "\"foo\"");
+(*  test (sprintf "%-0+ #5S" "foo" = "\"foo\"  ");  padding not done *)
+  test (sprintf "%S@" "foo" = "\"foo\"@");
+  test (sprintf "%S@inria.fr" "foo" = "\"foo\"@inria.fr");
+  test (sprintf "%S@%S" "foo" "inria.fr" = "\"foo\"@\"inria.fr\"");
+
+  printf "\nc\n%!";
+  test (sprintf "%c" 'c' = "c");
+(*  test (sprintf "%-4c" 'c' = "c   ");    padding not done *)
+(*  test (sprintf "%04c" 'c' = "   c");    padding not done *)
+  test (sprintf "%+c" 'c' = "c");
+  test (sprintf "% c" 'c' = "c");
+  test (sprintf "%#c" 'c' = "c");
+(*  test (sprintf "%4c" 'c' = "   c");     padding not done *)
+(*  test (sprintf "%*c" 2 'c' = " c");     padding not done *)
+(*  test (sprintf "%-0+ #4c" 'c' = "c   ");  padding not done *)
+
+  printf "\nC\n%!";
+  test (sprintf "%C" 'c' = "'c'");
+  test (sprintf "%C" '\'' = "'\\''");
+(*  test (sprintf "%-4C" 'c' = "c   ");    padding not done *)
+(*  test (sprintf "%04C" 'c' = "   c");    padding not done *)
+  test (sprintf "%+C" 'c' = "'c'");
+  test (sprintf "% C" 'c' = "'c'");
+  test (sprintf "%#C" 'c' = "'c'");
+(*  test (sprintf "%4C" 'c' = " 'c'");     padding not done *)
+(*  test (sprintf "%*C" 2 'c' = "'c'");     padding not done *)
+(*  test (sprintf "%-0+ #4C" 'c' = "'c' ");  padding not done *)
+
+  printf "\nf\n%!";
+  test (sprintf "%f" (-42.42) = "-42.420000");
+  test (sprintf "%-13f" (-42.42) = "-42.420000   ");
+  test (sprintf "%013f" (-42.42) = "-00042.420000");
+  test (sprintf "%+f" 42.42 = "+42.420000");
+  test (sprintf "% f" 42.42 = " 42.420000");
+  test (sprintf "%#f" 42.42 = "42.420000");
+  test (sprintf "%13f" 42.42 = "    42.420000");
+  test (sprintf "%*f" 12 42.42 = "   42.420000");
+  test (sprintf "%-0+ #12f" 42.42 = "+42.420000  ");
+  test (sprintf "%.3f" (-42.42) = "-42.420");
+  test (sprintf "%-13.3f" (-42.42) = "-42.420      ");
+  test (sprintf "%013.3f" (-42.42) = "-00000042.420");
+  test (sprintf "%+.3f" 42.42 = "+42.420");
+  test (sprintf "% .3f" 42.42 = " 42.420");
+  test (sprintf "%#.3f" 42.42 = "42.420");
+  test (sprintf "%13.3f" 42.42 = "       42.420");
+  test (sprintf "%*.*f" 12 3 42.42 = "      42.420");
+  test (sprintf "%-0+ #12.3f" 42.42 = "+42.420     ");
+
+  (* Under Windows (mingw and maybe also MSVC), the stdlib uses three
+     digits for the exponent instead of the two used by Linux and BSD.
+     Check that the two strings are equal, except that there may be an
+     extra zero, and if there is one, there may be a missing space or
+     zero. All in the first string relative to the second. *)
+  let ( =* ) s1 s2 =
+    let ss1 = s1 ^ "$" in
+    let ss2 = s2 ^ "$" in
+    let rec loop i1 i2 extra missing =
+      if i1 = String.length ss1 && i2 = String.length ss2 then begin
+        if extra then true else not missing
+      end else if i1 = String.length ss1 || i2 = String.length ss2 then
+        false
+      else begin
+        match ss1.[i1], ss2.[i2] with
+        | x, y when x = y -> loop (i1+1) (i2+1) extra missing
+        | '0', _ when not extra -> loop (i1+1) i2 true missing
+        | _, (' '|'0') when not missing -> loop i1 (i2+1) extra true
+        | _, _ -> false
+      end
+    in
+    loop 0 0 false false
+  in
+
+  printf "\nF\n%!";
+  test (sprintf "%F" 42.42 = "42.42");
+  test (sprintf "%F" 42.42e42 =* "4.242e+43");
+  test (sprintf "%F" 42.00 = "42.");
+  test (sprintf "%F" 0.042 = "0.042");
+(* no padding, no precision
+  test (sprintf "%.3F" 42.42 = "42.420");
+  test (sprintf "%12.3F" 42.42e42 = "   4.242e+43");
+  test (sprintf "%.3F" 42.00 = "42.000");
+  test (sprintf "%.3F" 0.0042 = "0.004");
+*)
+
+  printf "\ne\n%!";
+  test (sprintf "%e" (-42.42) =* "-4.242000e+01");
+  test (sprintf "%-15e" (-42.42) =* "-4.242000e+01  ");
+  test (sprintf "%015e" (-42.42) =* "-004.242000e+01");
+  test (sprintf "%+e" 42.42 =* "+4.242000e+01");
+  test (sprintf "% e" 42.42 =* " 4.242000e+01");
+  test (sprintf "%#e" 42.42 =* "4.242000e+01");
+  test (sprintf "%15e" 42.42 =* "   4.242000e+01");
+  test (sprintf "%*e" 14 42.42 =* "  4.242000e+01");
+  test (sprintf "%-0+ #14e" 42.42 =* "+4.242000e+01 ");
+  test (sprintf "%.3e" (-42.42) =* "-4.242e+01");
+  test (sprintf "%-15.3e" (-42.42) =* "-4.242e+01     ");
+  test (sprintf "%015.3e" (-42.42) =* "-000004.242e+01");
+  test (sprintf "%+.3e" 42.42 =* "+4.242e+01");
+  test (sprintf "% .3e" 42.42 =* " 4.242e+01");
+  test (sprintf "%#.3e" 42.42 =* "4.242e+01");
+  test (sprintf "%15.3e" 42.42 =* "      4.242e+01");
+  test (sprintf "%*.*e" 11 3 42.42 =* "  4.242e+01");
+  test (sprintf "%-0+ #14.3e" 42.42 =* "+4.242e+01    ");
+
+  printf "\nE\n%!";
+  test (sprintf "%E" (-42.42) =* "-4.242000E+01");
+  test (sprintf "%-15E" (-42.42) =* "-4.242000E+01  ");
+  test (sprintf "%015E" (-42.42) =* "-004.242000E+01");
+  test (sprintf "%+E" 42.42 =* "+4.242000E+01");
+  test (sprintf "% E" 42.42 =* " 4.242000E+01");
+  test (sprintf "%#E" 42.42 =* "4.242000E+01");
+  test (sprintf "%15E" 42.42 =* "   4.242000E+01");
+  test (sprintf "%*E" 14 42.42 =* "  4.242000E+01");
+  test (sprintf "%-0+ #14E" 42.42 =* "+4.242000E+01 ");
+  test (sprintf "%.3E" (-42.42) =* "-4.242E+01");
+  test (sprintf "%-15.3E" (-42.42) =* "-4.242E+01     ");
+  test (sprintf "%015.3E" (-42.42) =* "-000004.242E+01");
+  test (sprintf "%+.3E" 42.42 =* "+4.242E+01");
+  test (sprintf "% .3E" 42.42 =* " 4.242E+01");
+  test (sprintf "%#.3E" 42.42 =* "4.242E+01");
+  test (sprintf "%15.3E" 42.42 =* "      4.242E+01");
+  test (sprintf "%*.*E" 11 3 42.42 =* "  4.242E+01");
+  test (sprintf "%-0+ #14.3E" 42.42 =* "+4.242E+01    ");
+
+(* %g gives strange results that correspond to neither %f nor %e
+  printf "\ng\n%!";
+  test (sprintf "%g" (-42.42) = "-42.42000");
+  test (sprintf "%-15g" (-42.42) = "-42.42000      ");
+  test (sprintf "%015g" (-42.42) = "-00000042.42000");
+  test (sprintf "%+g" 42.42 = "+42.42000");
+  test (sprintf "% g" 42.42 = " 42.42000");
+  test (sprintf "%#g" 42.42 = "42.42000");
+  test (sprintf "%15g" 42.42 = "       42.42000");
+  test (sprintf "%*g" 14 42.42 = "      42.42000");
+  test (sprintf "%-0+ #14g" 42.42 = "+42.42000     ");
+  test (sprintf "%.3g" (-42.42) = "-42.420");
+*)
+
+(* Same for %G
+  printf "\nG\n%!";
+*)
+
+  printf "\nB\n%!";
+  test (sprintf "%B" true = "true");
+  test (sprintf "%B" false = "false");
+
+  printf "\nld/li positive\n%!";
+  test (sprintf "%ld/%li" 42l 43l = "42/43");
+  test (sprintf "%-4ld/%-5li" 42l 43l = "42  /43   ");
+  test (sprintf "%04ld/%05li" 42l 43l = "0042/00043");
+  test (sprintf "%+ld/%+li" 42l 43l = "+42/+43");
+  test (sprintf "% ld/% li" 42l 43l = " 42/ 43");
+  test (sprintf "%#ld/%#li" 42l 43l = "42/43");
+  test (sprintf "%4ld/%5li" 42l 43l = "  42/   43");
+  test (sprintf "%*ld/%*li" 4 42l 5 43l = "  42/   43");
+  test (sprintf "%-0+#4ld/%-0 #5li" 42l 43l = "+42 / 43  ");
+
+  printf "\nld/li negative\n%!";
+  test (sprintf "%ld/%li" (-42l) (-43l) = "-42/-43");
+  test (sprintf "%-4ld/%-5li" (-42l) (-43l) = "-42 /-43  ");
+  test (sprintf "%04ld/%05li" (-42l) (-43l) = "-042/-0043");
+  test (sprintf "%+ld/%+li" (-42l) (-43l) = "-42/-43");
+  test (sprintf "% ld/% li" (-42l) (-43l) = "-42/-43");
+  test (sprintf "%#ld/%#li" (-42l) (-43l) = "-42/-43");
+  test (sprintf "%4ld/%5li" (-42l) (-43l) = " -42/  -43");
+  test (sprintf "%*ld/%*li" 4 (-42l) 5 (-43l) = " -42/  -43");
+  test (sprintf "%-0+ #4ld/%-0+ #5li" (-42l) (-43l) = "-42 /-43  ");
+
+  printf "\nlu positive\n%!";
+  test (sprintf "%lu" 42l = "42");
+  test (sprintf "%-4lu" 42l = "42  ");
+  test (sprintf "%04lu" 42l = "0042");
+  test (sprintf "%+lu" 42l = "42");
+  test (sprintf "% lu" 42l = "42");
+  test (sprintf "%#lu" 42l = "42");
+  test (sprintf "%4lu" 42l = "  42");
+  test (sprintf "%*lu" 4 42l = "  42");
+  test (sprintf "%-0+ #6ld" 42l = "+42   ");
+
+  printf "\nlu negative\n%!";
+  test (sprintf "%lu" (-1l) = "4294967295");
+
+  printf "\nlx positive\n%!";
+  test (sprintf "%lx" 42l = "2a");
+  test (sprintf "%-4lx" 42l = "2a  ");
+  test (sprintf "%04lx" 42l = "002a");
+  test (sprintf "%+lx" 42l = "2a");
+  test (sprintf "% lx" 42l = "2a");
+  test (sprintf "%#lx" 42l = "0x2a");
+  test (sprintf "%4lx" 42l = "  2a");
+  test (sprintf "%*lx" 5 42l = "   2a");
+  test (sprintf "%-0+ #*lx" 5 42l = "0x2a ");
+
+  printf "\nlx negative\n%!";
+  test (sprintf "%lx" (-42l) = "ffffffd6");
+
+  printf "\nlX positive\n%!";
+  test (sprintf "%lX" 42l = "2A");
+  test (sprintf "%-4lX" 42l = "2A  ");
+  test (sprintf "%04lX" 42l = "002A");
+  test (sprintf "%+lX" 42l = "2A");
+  test (sprintf "% lX" 42l = "2A");
+  test (sprintf "%#lX" 42l = "0X2A");
+  test (sprintf "%4lX" 42l = "  2A");
+  test (sprintf "%*lX" 5 42l = "   2A");
+  test (sprintf "%-0+ #*lX" 5 42l = "0X2A ");
+
+  printf "\nlx negative\n%!";
+  test (sprintf "%lX" (-42l) = "FFFFFFD6");
+
+  printf "\nlo positive\n%!";
+  test (sprintf "%lo" 42l = "52");
+  test (sprintf "%-4lo" 42l = "52  ");
+  test (sprintf "%04lo" 42l = "0052");
+  test (sprintf "%+lo" 42l = "52");
+  test (sprintf "% lo" 42l = "52");
+  test (sprintf "%#lo" 42l = "052");
+  test (sprintf "%4lo" 42l = "  52");
+  test (sprintf "%*lo" 5 42l = "   52");
+  test (sprintf "%-0+ #*lo" 5 42l = "052  ");
+
+  printf "\nlo negative\n%!";
+  test (sprintf "%lo" (-42l) = "37777777726");
+
+  (* Nativeint not tested: looks like too much work, and anyway it should
+     work like Int32 or Int64. *)
+
+  printf "\nLd/Li positive\n%!";
+  test (sprintf "%Ld/%Li" 42L 43L = "42/43");
+  test (sprintf "%-4Ld/%-5Li" 42L 43L = "42  /43   ");
+  test (sprintf "%04Ld/%05Li" 42L 43L = "0042/00043");
+  test (sprintf "%+Ld/%+Li" 42L 43L = "+42/+43");
+  test (sprintf "% Ld/% Li" 42L 43L = " 42/ 43");
+  test (sprintf "%#Ld/%#Li" 42L 43L = "42/43");
+  test (sprintf "%4Ld/%5Li" 42L 43L = "  42/   43");
+  test (sprintf "%*Ld/%*Li" 4 42L 5 43L = "  42/   43");
+  test (sprintf "%-0+#4Ld/%-0 #5Li" 42L 43L = "+42 / 43  ");
+
+  printf "\nLd/Li negative\n%!";
+  test (sprintf "%Ld/%Li" (-42L) (-43L) = "-42/-43");
+  test (sprintf "%-4Ld/%-5Li" (-42L) (-43L) = "-42 /-43  ");
+  test (sprintf "%04Ld/%05Li" (-42L) (-43L) = "-042/-0043");
+  test (sprintf "%+Ld/%+Li" (-42L) (-43L) = "-42/-43");
+  test (sprintf "% Ld/% Li" (-42L) (-43L) = "-42/-43");
+  test (sprintf "%#Ld/%#Li" (-42L) (-43L) = "-42/-43");
+  test (sprintf "%4Ld/%5Li" (-42L) (-43L) = " -42/  -43");
+  test (sprintf "%*Ld/%*Li" 4 (-42L) 5 (-43L) = " -42/  -43");
+  test (sprintf "%-0+ #4Ld/%-0+ #5Li" (-42L) (-43L) = "-42 /-43  ");
+
+  printf "\nLu positive\n%!";
+  test (sprintf "%Lu" 42L = "42");
+  test (sprintf "%-4Lu" 42L = "42  ");
+  test (sprintf "%04Lu" 42L = "0042");
+  test (sprintf "%+Lu" 42L = "42");
+  test (sprintf "% Lu" 42L = "42");
+  test (sprintf "%#Lu" 42L = "42");
+  test (sprintf "%4Lu" 42L = "  42");
+  test (sprintf "%*Lu" 4 42L = "  42");
+  test (sprintf "%-0+ #6Ld" 42L = "+42   ");
+
+  printf "\nLu negative\n%!";
+  test (sprintf "%Lu" (-1L) = "18446744073709551615");
+
+  printf "\nLx positive\n%!";
+  test (sprintf "%Lx" 42L = "2a");
+  test (sprintf "%-4Lx" 42L = "2a  ");
+  test (sprintf "%04Lx" 42L = "002a");
+  test (sprintf "%+Lx" 42L = "2a");
+  test (sprintf "% Lx" 42L = "2a");
+  test (sprintf "%#Lx" 42L = "0x2a");
+  test (sprintf "%4Lx" 42L = "  2a");
+  test (sprintf "%*Lx" 5 42L = "   2a");
+  test (sprintf "%-0+ #*Lx" 5 42L = "0x2a ");
+
+  printf "\nLx negative\n%!";
+  test (sprintf "%Lx" (-42L) = "ffffffffffffffd6");
+
+  printf "\nLX positive\n%!";
+  test (sprintf "%LX" 42L = "2A");
+  test (sprintf "%-4LX" 42L = "2A  ");
+  test (sprintf "%04LX" 42L = "002A");
+  test (sprintf "%+LX" 42L = "2A");
+  test (sprintf "% LX" 42L = "2A");
+  test (sprintf "%#LX" 42L = "0X2A");
+  test (sprintf "%4LX" 42L = "  2A");
+  test (sprintf "%*LX" 5 42L = "   2A");
+  test (sprintf "%-0+ #*LX" 5 42L = "0X2A ");
+
+  printf "\nLx negative\n%!";
+  test (sprintf "%LX" (-42L) = "FFFFFFFFFFFFFFD6");
+
+  printf "\nLo positive\n%!";
+  test (sprintf "%Lo" 42L = "52");
+  test (sprintf "%-4Lo" 42L = "52  ");
+  test (sprintf "%04Lo" 42L = "0052");
+  test (sprintf "%+Lo" 42L = "52");
+  test (sprintf "% Lo" 42L = "52");
+  test (sprintf "%#Lo" 42L = "052");
+  test (sprintf "%4Lo" 42L = "  52");
+  test (sprintf "%*Lo" 5 42L = "   52");
+  test (sprintf "%-0+ #*Lo" 5 42L = "052  ");
+
+  printf "\nLo negative\n%!";
+  test (sprintf "%Lo" (-42L) = "1777777777777777777726");
+
+  printf "\na\n%!";
+  let x = ref () in
+  let f () y = if y == x then "ok" else "wrong" in
+  test (sprintf "%a" f x = "ok");
+
+  printf "\nt\n%!";
+  let f () = "ok" in
+  test (sprintf "%t" f = "ok");
+
+  (* Work as expected. Prints the format string type digest.
+     If you want to print the contents of the format string,
+     do not use a meta format; simply convert the format string
+     to a string and print it using %s. *)
+
+  printf "\n{...%%}\n%!";
+  let f = format_of_string "%4g/%s" in
+  test (sprintf "%{%#0F%S%}" f = "%f%s");
+
+  printf "\n(...%%)\n%!";
+  let f = format_of_string "%d/foo/%s" in
+  test (sprintf "%(%d%s%)" f 42 "bar" = "42/foo/bar");
+
+  printf "\n! %% @ , and constants\n%!";
+  test (sprintf "%!" = "");
+  test (sprintf "%%" = "%");
+  test (sprintf "%@" = "@");
+  test (sprintf "%," = "");
+  test (sprintf "@" = "@");
+  test (sprintf "@@" = "@@");
+  test (sprintf "@%%" = "@%");
+
+  printf "\nend of tests\n%!";
+with e ->
+  printf "unexpected exception: %s\n%!" (Printexc.to_string e);
+  test false;
+;;
diff -Nru ocaml-3.12.1/testsuite/tests/lib-printf/tprintf.reference ocaml-4.01.0/testsuite/tests/lib-printf/tprintf.reference
--- ocaml-3.12.1/testsuite/tests/lib-printf/tprintf.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-printf/tprintf.reference	2013-04-29 12:59:43.000000000 +0000
@@ -0,0 +1,91 @@
+d/i positive
+ 0 1 2 3 4 5 6 7 8
+d/i negative
+ 9 10 11 12 13 14 15 16 17
+u positive
+ 18 19 20 21 22 23 24 25 26
+u negative
+ 27
+x positive
+ 28 29 30 31 32 33 34 35 36
+x negative
+ 37
+X positive
+ 38 39 40 41 42 43 44 45 46
+x negative
+ 47
+o positive
+ 48 49 50 51 52 53 54 55 56
+o negative
+ 57
+s
+ 58 59 60 61 62 63 64 65 66 67 68 69 70 71
+S
+ 72 73 74 75 76 77 78 79 80
+c
+ 81 82 83 84
+C
+ 85 86 87 88 89
+f
+ 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
+F
+ 108 109 110 111
+e
+ 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
+E
+ 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
+B
+ 148 149
+ld/li positive
+ 150 151 152 153 154 155 156 157 158
+ld/li negative
+ 159 160 161 162 163 164 165 166 167
+lu positive
+ 168 169 170 171 172 173 174 175 176
+lu negative
+ 177
+lx positive
+ 178 179 180 181 182 183 184 185 186
+lx negative
+ 187
+lX positive
+ 188 189 190 191 192 193 194 195 196
+lx negative
+ 197
+lo positive
+ 198 199 200 201 202 203 204 205 206
+lo negative
+ 207
+Ld/Li positive
+ 208 209 210 211 212 213 214 215 216
+Ld/Li negative
+ 217 218 219 220 221 222 223 224 225
+Lu positive
+ 226 227 228 229 230 231 232 233 234
+Lu negative
+ 235
+Lx positive
+ 236 237 238 239 240 241 242 243 244
+Lx negative
+ 245
+LX positive
+ 246 247 248 249 250 251 252 253 254
+Lx negative
+ 255
+Lo positive
+ 256 257 258 259 260 261 262 263 264
+Lo negative
+ 265
+a
+ 266
+t
+ 267
+{...%}
+ 268
+(...%)
+ 269
+! % @ , and constants
+ 270 271 272 273 274 275 276
+end of tests
+
+All tests succeeded.
diff -Nru ocaml-3.12.1/testsuite/tests/lib-random/Makefile ocaml-4.01.0/testsuite/tests/lib-random/Makefile
--- ocaml-3.12.1/testsuite/tests/lib-random/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-random/Makefile	2013-06-06 11:45:02.000000000 +0000
@@ -0,0 +1,15 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-random/rand.ml ocaml-4.01.0/testsuite/tests/lib-random/rand.ml
--- ocaml-3.12.1/testsuite/tests/lib-random/rand.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-random/rand.ml	2013-06-06 11:45:02.000000000 +0000
@@ -0,0 +1,6 @@
+let () =
+  Random.self_init ();
+  let x = Random.int 10000 in
+  Random.self_init ();
+  let y = Random.int 1000 in
+  if x = y then print_endline "FAILED" else print_endline "PASSED"
diff -Nru ocaml-3.12.1/testsuite/tests/lib-random/rand.reference ocaml-4.01.0/testsuite/tests/lib-random/rand.reference
--- ocaml-3.12.1/testsuite/tests/lib-random/rand.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-random/rand.reference	2013-06-06 11:45:02.000000000 +0000
@@ -0,0 +1 @@
+PASSED
diff -Nru ocaml-3.12.1/testsuite/tests/lib-scanf/.ignore ocaml-4.01.0/testsuite/tests/lib-scanf/.ignore
--- ocaml-3.12.1/testsuite/tests/lib-scanf/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-scanf/.ignore	2012-07-27 11:31:21.000000000 +0000
@@ -0,0 +1 @@
+tscanf_data
diff -Nru ocaml-3.12.1/testsuite/tests/lib-scanf/Makefile ocaml-4.01.0/testsuite/tests/lib-scanf/Makefile
--- ocaml-3.12.1/testsuite/tests/lib-scanf/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-scanf/Makefile	2013-05-07 09:39:38.000000000 +0000
@@ -1,7 +1,21 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 #MODULES=
 MAIN_MODULE=tscanf
-ADD_COMPFLAGS=-I $(BASEDIR)/lib
+ADD_COMPFLAGS=-I $(OTOPDIR)/testsuite/lib
 ADD_MODULES=testing
+TEST_TEMP_FILES=tscanf_data
 
-include ../../makefiles/Makefile.one
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-scanf/tscanf.ml ocaml-4.01.0/testsuite/tests/lib-scanf/tscanf.ml
--- ocaml-3.12.1/testsuite/tests/lib-scanf/tscanf.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-scanf/tscanf.ml	2013-03-17 15:40:57.000000000 +0000
@@ -1,6 +1,6 @@
 (*************************************************************************)
 (*                                                                       *)
-(*                            Objective Caml                             *)
+(*                                 OCaml                                 *)
 (*                                                                       *)
 (*            Pierre Weis, projet Cristal, INRIA Rocquencourt            *)
 (*                                                                       *)
@@ -10,7 +10,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: tscanf.ml 10713 2010-10-08 11:53:19Z doligez $
+(*
 
 A testbed file for the module Scanf.
 
@@ -187,22 +187,7 @@
 
 let test_fmt fmt s = unit fmt s = s;;
 
-(* The following test9_string is a result for test9 scanning.
-   Test9_string is the string "",
-   that is character i tréma, followed by french right guillemet,
-   followed by inverted question mark.
-   It is NOT the string "Ôªø",
-   that is uppercase o with circonflex accent, followed by commercial a,
-   followed by empty set.
-
-   In other words, the string "" has the following 3 characters
-   "\239\187\191".
-   It has NOT the characters "\212\170\248"!
-
-   Beware with automatic translation by your own local settings
-   (being your locale or your OS!)
-*)
-let test9_string = "";;
+let test9_string = "\239\187\191";;
 
 let test_S = test_fmt "%S";;
 let test9 () =
@@ -245,10 +230,10 @@
   Scanf.bscanf ib "%S" id in
 
   let res =
-    sscanf "Une chaîne: \"celle-ci\" et \"celle-là\"!"
+    sscanf "Une chaine: \"celle-ci\" et \"celle-la\"!"
            "%s %s %S %s %S %s"
            (fun s1 s2 s3 s4 s5 s6 -> s1 ^ s2 ^ s3 ^ s4 ^ s5 ^ s6) in
-  res = "Unechaîne:celle-cietcelle-là!" &&
+  res = "Unechaine:celle-cietcelle-la!" &&
   (* Testing the result of reading a %S string. *)
   unit "\"a\\\n  b\"" = "ab" &&
   unit "\"\\\n  ab\"" = "ab" &&
@@ -265,15 +250,15 @@
 
 (* %[] style *)
 let test11 () =
-  sscanf "Pierre	Weis	70" "%s %s %s"
+  sscanf "Pierre\tWeis\t70" "%s %s %s"
     (fun prenom nom poids ->
      prenom = "Pierre" && nom = "Weis" && int_of_string poids = 70)
   &&
-  sscanf "Jean-Luc	de Léage	68" "%[^	] %[^	] %d"
+  sscanf "Jean-Luc\tde Leage\t68" "%[^\t] %[^\t] %d"
     (fun prenom nom poids ->
-     prenom = "Jean-Luc" && nom = "de Léage" && poids = 68)
+     prenom = "Jean-Luc" && nom = "de Leage" && poids = 68)
   &&
-  sscanf "Daniel	de Rauglaudre	66" "%s@\t %s@\t %d"
+  sscanf "Daniel\tde Rauglaudre\t66" "%s@\t %s@\t %d"
     (fun prenom nom poids ->
      prenom = "Daniel" && nom = "de Rauglaudre" && poids = 66)
 ;;
@@ -585,7 +570,7 @@
  (test27 ())
 ;;
 
-(* To scan a Caml string:
+(* To scan an OCaml string:
    the format is "\"%s@\"".
    A better way would be to add a %S (String.escaped), a %C (Char.escaped).
    This is now available. *)
@@ -950,7 +935,7 @@
 
 (* The prefered reader functionnals. *)
 
-(* To read a list as in Caml (elements are ``blank + semicolon + blank''
+(* To read a list as in OCaml (elements are ``blank + semicolon + blank''
    separated, and the list is enclosed in brackets). *)
 let rec read_elems read_elem accu ib =
   kscanf ib (fun ib exc -> accu)
@@ -1355,7 +1340,7 @@
     failwith (Printf.sprintf "in file %s, unexpected end of file" fname)
 ;;
 
-(* Simpy test that the list of lines read from the file are the list of lines
+(* Simply test that the list of lines read from the file is the list of lines
    written to it!. *)
 let test54 () =
   get_lines tscanf_data_file = tscanf_data_file_lines
@@ -1444,12 +1429,22 @@
 test (test57 ())
 ;;
 
-(*
 let test58 () =
+     sscanf "string1%string2" "%s@%%s" id = "string1"
+  && sscanf "string1%string2" "%s@%%%s" (^) = "string1string2"
+  && sscanf "string1@string2" "%[a-z0-9]@%s" (^) = "string1string2"
+  && sscanf "string1@%string2" "%[a-z0-9]%@%%%s" (^) = "string1string2"
 ;;
 
 test (test58 ())
 ;;
+
+(*
+let test59 () =
+;;
+
+test (test59 ())
+;;
 *)
 
 (* To be continued ...
diff -Nru ocaml-3.12.1/testsuite/tests/lib-scanf/tscanf.reference ocaml-4.01.0/testsuite/tests/lib-scanf/tscanf.reference
--- ocaml-3.12.1/testsuite/tests/lib-scanf/tscanf.reference	2010-01-25 14:38:01.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-scanf/tscanf.reference	2012-07-30 18:04:46.000000000 +0000
@@ -1,2 +1,2 @@
-0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 
+ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
 All tests succeeded.
diff -Nru ocaml-3.12.1/testsuite/tests/lib-scanf/tscanf_data ocaml-4.01.0/testsuite/tests/lib-scanf/tscanf_data
--- ocaml-3.12.1/testsuite/tests/lib-scanf/tscanf_data	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-scanf/tscanf_data	1970-01-01 00:00:00.000000000 +0000
@@ -1 +0,0 @@
-"Objective" -> "Caml";
diff -Nru ocaml-3.12.1/testsuite/tests/lib-scanf-2/Makefile ocaml-4.01.0/testsuite/tests/lib-scanf-2/Makefile
--- ocaml-3.12.1/testsuite/tests/lib-scanf-2/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-scanf-2/Makefile	2013-05-17 12:49:42.000000000 +0000
@@ -1,21 +1,57 @@
-default: compile run
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
 
-compile: tscanf2_io.cmo tscanf2_io.cmx
+BASEDIR=../..
+
+COMPFLAGS=-I $(OTOPDIR)/otherlibs/$(UNIXLIBVAR)unix
+LD_PATH=$(TOPDIR)/otherlibs/$(UNIXLIBVAR)unix
+
+.PHONY: default
+default:
+	@$(SET_LD_PATH) $(MAKE) compile run
+
+.PHONY: compile
+compile: tscanf2_io.cmo
+	@rm -f master.byte master.native master.native.exe
+	@rm -f slave.byte slave.native slave.native.exe
 	@$(OCAMLC) unix.cma tscanf2_io.cmo -o master.byte tscanf2_master.ml
 	@$(OCAMLC) tscanf2_io.cmo -o slave.byte tscanf2_slave.ml
-	@$(OCAMLOPT) unix.cmxa tscanf2_io.cmx -o master.native tscanf2_master.ml
-	@$(OCAMLOPT) tscanf2_io.cmx -o slave.native tscanf2_slave.ml
+	@if $(BYTECODE_ONLY); then : ; else \
+	  $(MAKE) tscanf2_io.cmx; \
+	  $(OCAMLOPT) unix.cmxa tscanf2_io.cmx -o master.native$(EXE) \
+	              tscanf2_master.ml; \
+	  $(OCAMLOPT) tscanf2_io.cmx -o slave.native$(EXE) tscanf2_slave.ml; \
+	fi
 
 run:
 	@printf " ... testing with ocamlc"
-	@./master.byte ./slave.byte > result.byte 2>&1
-	@diff -q reference result.byte > /dev/null || (echo " => failed" && exit 1)
-	@printf " ocamlopt"
-	@./master.native ./slave.native > result.native 2>&1
-	@diff -q reference result.native > /dev/null || (echo " => failed" && exit 1)
-	@echo " => passed"
+	@$(OCAMLRUN) ./master.byte "$(OTOPDIR)/boot/ocamlrun$(EXE) \
+	                                     `$(CYGPATH) ./slave.byte`" \
+	             >result.byte 2>&1
+	@$(DIFF) reference result.byte >/dev/null \
+	&& if $(BYTECODE_ONLY); then : ; else \
+	     printf " ocamlopt"; \
+	     ./master.native$(EXE) "`$(CYGPATH) ./slave.native`" \
+	                           >result.native 2>&1; \
+	     $(DIFF) reference result.native >/dev/null; \
+	   fi \
+	&& echo " => passed" || echo " => failed"
+
+.PHONY: promote
+promote:
+	@cp result.byte reference
 
+.PHONY: clean
 clean: defaultclean
 	@rm -f master.* slave.* result.*
 
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-scanf-2/tscanf2_io.ml ocaml-4.01.0/testsuite/tests/lib-scanf-2/tscanf2_io.ml
--- ocaml-3.12.1/testsuite/tests/lib-scanf-2/tscanf2_io.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-scanf-2/tscanf2_io.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*             Pierre Weis, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2005 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* A very simple communication module using buffers. It should help detecting
    advanced character reading by Scanf when using stdin. *)
 
diff -Nru ocaml-3.12.1/testsuite/tests/lib-scanf-2/tscanf2_master.ml ocaml-4.01.0/testsuite/tests/lib-scanf-2/tscanf2_master.ml
--- ocaml-3.12.1/testsuite/tests/lib-scanf-2/tscanf2_master.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-scanf-2/tscanf2_master.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*             Pierre Weis, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2005 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* A very simple master:
    - first launch a slave process,
    - then repeat a random number of times:
diff -Nru ocaml-3.12.1/testsuite/tests/lib-scanf-2/tscanf2_slave.ml ocaml-4.01.0/testsuite/tests/lib-scanf-2/tscanf2_slave.ml
--- ocaml-3.12.1/testsuite/tests/lib-scanf-2/tscanf2_slave.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-scanf-2/tscanf2_slave.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*             Pierre Weis, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2005 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* A very simple slave:
    - read the string " Ping" on stdin,
    - then print the string "-pong" on stderr,
diff -Nru ocaml-3.12.1/testsuite/tests/lib-set/Makefile ocaml-4.01.0/testsuite/tests/lib-set/Makefile
--- ocaml-3.12.1/testsuite/tests/lib-set/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-set/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,15 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-set/testmap.ml ocaml-4.01.0/testsuite/tests/lib-set/testmap.ml
--- ocaml-3.12.1/testsuite/tests/lib-set/testmap.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-set/testmap.ml	2013-03-19 07:22:12.000000000 +0000
@@ -0,0 +1,134 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+module M = Map.Make(struct type t = int let compare (x:t) y = compare x y end)
+
+let img x m = try Some(M.find x m) with Not_found -> None
+
+let testvals = [0;1;2;3;4;5;6;7;8;9]
+
+let check msg cond =
+  if not (List.for_all cond testvals) then
+    Printf.printf "Test %s FAILED\n%!" msg
+
+let checkbool msg b =
+  if not b then
+    Printf.printf "Test %s FAILED\n%!" msg
+
+let uncurry (f: 'a -> 'b -> 'c) (x, y: 'a * 'b) : 'c = f x y
+
+let test x v s1 s2 =
+
+  checkbool "is_empty"
+    (M.is_empty s1 = List.for_all (fun i -> img i s1 = None) testvals);
+
+  check "mem"
+    (fun i -> M.mem i s1 = (img i s1 <> None));
+
+  check "add"
+    (let s = M.add x v s1 in
+     fun i -> img i s = (if i = x then Some v else img i s1));
+
+  check "singleton"
+    (let s = M.singleton x v in
+     fun i -> img i s = (if i = x then Some v else None));
+
+  check "remove"
+    (let s = M.remove x s1 in
+     fun i -> img i s = (if i = x then None else img i s1));
+
+  check "merge-union"
+    (let f _ o1 o2 =
+       match o1, o2 with
+       | Some v1, Some v2 -> Some (v1 +. v2)
+       | None, _ -> o2
+       | _, None -> o1 in
+     let s = M.merge f s1 s2 in
+     fun i -> img i s = f i (img i s1) (img i s2));
+
+  check "merge-inter"
+    (let f _ o1 o2 =
+       match o1, o2 with
+       | Some v1, Some v2 -> Some (v1 -. v2)
+       | _, _ -> None in
+     let s = M.merge f s1 s2 in
+     fun i -> img i s = f i (img i s1) (img i s2));
+
+  checkbool "bindings"
+    (let rec extract = function
+       | [] -> []
+       | hd :: tl ->
+           match img hd s1 with
+           | None -> extract tl
+           | Some v ->(hd,  v) :: extract tl in
+     M.bindings s1 = extract testvals);
+
+  checkbool "for_all"
+    (let p x y = x mod 2 = 0 in
+     M.for_all p s1 = List.for_all (uncurry p) (M.bindings s1));
+
+  checkbool "exists"
+    (let p x y = x mod 3 = 0 in
+     M.exists p s1 = List.exists (uncurry p) (M.bindings s1));
+
+  checkbool "filter"
+    (let p x y = x >= 3 && x <= 6 in
+     M.bindings(M.filter p s1) = List.filter (uncurry p) (M.bindings s1));
+
+  checkbool "partition"
+    (let p x y = x >= 3 && x <= 6 in
+     let (st,sf) = M.partition p s1
+     and (lt,lf) = List.partition (uncurry p) (M.bindings s1) in
+     M.bindings st = lt && M.bindings sf = lf);
+
+  checkbool "cardinal"
+    (M.cardinal s1 = List.length (M.bindings s1));
+
+  checkbool "min_binding"
+    (try
+       let (k,v) = M.min_binding s1 in
+       img k s1 = Some v && M.for_all (fun i _ -> k <= i) s1
+     with Not_found ->
+       M.is_empty s1);
+
+  checkbool "max_binding"
+    (try
+       let (k,v) = M.max_binding s1 in
+       img k s1 = Some v && M.for_all (fun i _ -> k >= i) s1
+     with Not_found ->
+       M.is_empty s1);
+
+  checkbool "choose"
+    (try
+       let (x,v) = M.choose s1 in img x s1 = Some v
+     with Not_found ->
+       M.is_empty s1);
+
+  check "split"
+    (let (l, p, r) = M.split x s1 in
+     fun i ->
+       if i < x then img i l = img i s1
+       else if i > x then img i r = img i s1
+       else p = img i s1)
+
+let rkey() = Random.int 10
+
+let rdata() = Random.float 1.0
+
+let rmap() =
+  let s = ref M.empty in
+  for i = 1 to Random.int 10 do s := M.add (rkey()) (rdata()) !s done;
+  !s
+
+let _ =
+  Random.init 42;
+  for i = 1 to 25000 do test (rkey()) (rdata()) (rmap()) (rmap()) done
diff -Nru ocaml-3.12.1/testsuite/tests/lib-set/testset.ml ocaml-4.01.0/testsuite/tests/lib-set/testset.ml
--- ocaml-3.12.1/testsuite/tests/lib-set/testset.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-set/testset.ml	2013-03-19 07:22:12.000000000 +0000
@@ -0,0 +1,131 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+module S = Set.Make(struct type t = int let compare (x:t) y = compare x y end)
+
+let testvals = [0;1;2;3;4;5;6;7;8;9]
+
+let check msg cond =
+  if not (List.for_all cond testvals) then
+    Printf.printf "Test %s FAILED\n%!" msg
+
+let checkbool msg b =
+  if not b then
+    Printf.printf "Test %s FAILED\n%!" msg
+
+let normalize_cmp c =
+  if c = 0 then 0 else if c > 0 then 1 else -1
+
+let test x s1 s2 =
+
+  checkbool "is_empty"
+    (S.is_empty s1 = List.for_all (fun i -> not (S.mem i s1)) testvals);
+
+  check "add"
+    (let s = S.add x s1 in
+     fun i -> S.mem i s = (S.mem i s1 || i = x));
+
+  check "singleton"
+    (let s = S.singleton x in
+     fun i -> S.mem i s = (i = x));
+
+  check "remove"
+    (let s = S.remove x s1 in
+     fun i -> S.mem i s = (S.mem i s1 && i <> x));
+
+  check "union"
+    (let s = S.union s1 s2 in
+     fun i -> S.mem i s = (S.mem i s1 || S.mem i s2));
+
+  check "inter"
+    (let s = S.inter s1 s2 in
+     fun i -> S.mem i s = (S.mem i s1 && S.mem i s2));
+
+  check "diff"
+    (let s = S.diff s1 s2 in
+     fun i -> S.mem i s = (S.mem i s1 && not (S.mem i s2)));
+
+  checkbool "elements"
+    (S.elements s1 = List.filter (fun i -> S.mem i s1) testvals);
+
+  checkbool "compare"
+    (normalize_cmp (S.compare s1 s2) = normalize_cmp (compare (S.elements s1) (S.elements s2)));
+
+  checkbool "equal"
+    (S.equal s1 s2 = (S.elements s1 = S.elements s2));
+
+  check "subset"
+    (let b = S.subset s1 s2 in
+     fun i -> if b && S.mem i s1 then S.mem i s2 else true);
+
+  checkbool "subset2"
+    (let b = S.subset s1 s2 in
+     b || not (S.is_empty (S.diff s1 s2)));
+
+  checkbool "for_all"
+    (let p x = x mod 2 = 0 in
+     S.for_all p s1 = List.for_all p (S.elements s1));
+
+  checkbool "exists"
+    (let p x = x mod 3 = 0 in
+     S.exists p s1 = List.exists p (S.elements s1));
+
+  checkbool "filter"
+    (let p x = x >= 3 && x <= 6 in
+     S.elements(S.filter p s1) = List.filter p (S.elements s1));
+
+  checkbool "partition"
+    (let p x = x >= 3 && x <= 6 in
+     let (st,sf) = S.partition p s1
+     and (lt,lf) = List.partition p (S.elements s1) in
+     S.elements st = lt && S.elements sf = lf);
+
+  checkbool "cardinal"
+    (S.cardinal s1 = List.length (S.elements s1));
+
+  checkbool "min_elt"
+    (try
+       let m = S.min_elt s1 in
+       S.mem m s1 && S.for_all (fun i -> m <= i) s1
+     with Not_found ->
+       S.is_empty s1);
+
+  checkbool "max_elt"
+    (try
+       let m = S.max_elt s1 in
+       S.mem m s1 && S.for_all (fun i -> m >= i) s1
+     with Not_found ->
+       S.is_empty s1);
+
+  checkbool "choose"
+    (try
+       let x = S.choose s1 in S.mem x s1
+     with Not_found ->
+       S.is_empty s1);
+
+  check "split"
+    (let (l, p, r) = S.split x s1 in
+     fun i ->
+       if i < x then S.mem i l = S.mem i s1
+       else if i > x then S.mem i r = S.mem i s1
+       else p = S.mem i s1)
+
+let relt() = Random.int 10
+
+let rset() =
+  let s = ref S.empty in
+  for i = 1 to Random.int 10 do s := S.add (relt()) !s done;
+  !s
+
+let _ =
+  Random.init 42;
+  for i = 1 to 25000 do test (relt()) (rset()) (rset()) done
diff -Nru ocaml-3.12.1/testsuite/tests/lib-str/Makefile ocaml-4.01.0/testsuite/tests/lib-str/Makefile
--- ocaml-3.12.1/testsuite/tests/lib-str/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-str/Makefile	2013-05-17 12:03:58.000000000 +0000
@@ -1,4 +1,19 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 LIBRARIES=str
+ADD_COMPFLAGS=-I $(OTOPDIR)/otherlibs/str
+LD_PATH=$(TOPDIR)/otherlibs/str
 
-include ../../makefiles/Makefile.several
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-str/t01.ml ocaml-4.01.0/testsuite/tests/lib-str/t01.ml
--- ocaml-3.12.1/testsuite/tests/lib-str/t01.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-str/t01.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 open Printf
 
 let build_result ngroups input =
@@ -34,7 +46,7 @@
 let num_failures = ref 0
 
 let test res1 res2 =
-  if res1 = res2 
+  if res1 = res2
   then print_char '.'
   else begin print_string " FAIL "; incr num_failures end
 
@@ -743,7 +755,7 @@
   test (Str.split_delim (Str.regexp "[ \t]+") " si non e vero\t")
        [""; "si"; "non"; "e"; "vero"; ""];
   test (Str.full_split (Str.regexp "[ \t]+") " si non\te vero\t")
-       [Str.Delim " "; Str.Text "si"; 
+       [Str.Delim " "; Str.Text "si";
         Str.Delim " "; Str.Text "non";
         Str.Delim "\t"; Str.Text "e";
         Str.Delim " "; Str.Text "vero"; Str.Delim "\t"];
@@ -752,7 +764,7 @@
   (* See "REX: XML Shallow Parsing with Regular Expressions",
      Robert D. Cameron, Simon Fraser University, CMPT TR 1998-17. *)
   start_test "XML tokenization";
-  begin 
+  begin
     let _TextSE = "[^<]+" in
     let _UntilHyphen = "[^-]*-" in
     let _Until2Hyphens = _UntilHyphen ^ "\\([^-]" ^ _UntilHyphen ^ "\\)*-" in
diff -Nru ocaml-3.12.1/testsuite/tests/lib-stream/Makefile ocaml-4.01.0/testsuite/tests/lib-stream/Makefile
--- ocaml-3.12.1/testsuite/tests/lib-stream/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-stream/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,16 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+MODULES=testing
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-stream/count_concat_bug.ml ocaml-4.01.0/testsuite/tests/lib-stream/count_concat_bug.ml
--- ocaml-3.12.1/testsuite/tests/lib-stream/count_concat_bug.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-stream/count_concat_bug.ml	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,69 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Gabriel Scherer, projet Gallium, INRIA Rocquencourt        *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+let is_empty s =
+  try Stream.empty s; true with Stream.Failure -> false
+
+let test_icons =
+  let s = Stream.of_string "ab" in
+  let s = Stream.icons 'c' s in
+  Testing.test (Stream.next s = 'c');
+  Testing.test (Stream.next s = 'a');
+  Testing.test (Stream.next s = 'b');
+  Testing.test (is_empty s);
+  ()
+
+let test_lcons =
+  let s = Stream.of_string "ab" in
+  let s = Stream.lcons (fun () -> 'c') s in
+  Testing.test (Stream.next s = 'c');
+  Testing.test (Stream.next s = 'a');
+  Testing.test (Stream.next s = 'b');
+  Testing.test (is_empty s);
+  ()
+
+let test_iapp =
+  let s = Stream.of_string "ab" in
+  let s = Stream.iapp (Stream.of_list ['c']) s in
+  Testing.test (Stream.next s = 'c');
+  Testing.test (Stream.next s = 'a');
+  Testing.test (Stream.next s = 'b');
+  Testing.test (is_empty s);
+  ()
+
+let test_lapp_right =
+  let s1 = Stream.of_list ['c'] in
+  let s2 = Stream.of_string "ab" in
+  let s = Stream.lapp (fun () -> s1) s2 in
+  Testing.test (Stream.next s = 'c');
+  Testing.test (Stream.next s = 'a');
+  Testing.test (Stream.next s = 'b');
+  Testing.test (is_empty s);
+  ()
+
+let test_lapp_left =
+  let s1 = Stream.of_string "bc" in
+  let s2 = Stream.of_list ['a'] in
+  Testing.test (Stream.next s1 = 'b');
+  let s = Stream.lapp (fun () -> s1) s2 in
+  Testing.test (Stream.next s = 'c');
+  Testing.test (Stream.next s = 'a');
+  Testing.test (is_empty s);
+  ()
+
+let test_slazy =
+  let s = Stream.of_string "ab" in
+  Testing.test (Stream.next s = 'a');
+  let s = Stream.slazy (fun () -> s) in
+  Testing.test (Stream.next s = 'b');
+  Testing.test (is_empty s);
+  ()
diff -Nru ocaml-3.12.1/testsuite/tests/lib-stream/count_concat_bug.reference ocaml-4.01.0/testsuite/tests/lib-stream/count_concat_bug.reference
--- ocaml-3.12.1/testsuite/tests/lib-stream/count_concat_bug.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-stream/count_concat_bug.reference	2012-07-30 18:04:46.000000000 +0000
@@ -0,0 +1,2 @@
+ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
+All tests succeeded.
diff -Nru ocaml-3.12.1/testsuite/tests/lib-systhreads/Makefile ocaml-4.01.0/testsuite/tests/lib-systhreads/Makefile
--- ocaml-3.12.1/testsuite/tests/lib-systhreads/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-systhreads/Makefile	2013-05-17 12:03:58.000000000 +0000
@@ -1,5 +1,20 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 LIBRARIES=unix threads
-ADD_COMPFLAGS=-thread
+ADD_COMPFLAGS=-thread -I $(OTOPDIR)/otherlibs/systhreads \
+	      -I $(OTOPDIR)/otherlibs/$(UNIXLIBVAR)unix
+LD_PATH=$(TOPDIR)/otherlibs/systhreads:$(TOPDIR)/otherlibs/$(UNIXLIBVAR)unix
 
-include ../../makefiles/Makefile.several
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-systhreads/testfork.ml ocaml-4.01.0/testsuite/tests/lib-systhreads/testfork.ml
--- ocaml-3.12.1/testsuite/tests/lib-systhreads/testfork.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-systhreads/testfork.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,8 +1,20 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* POSIX threads and fork() *)
 
 let compute_thread c = ignore c
 (*
-  while true do 
+  while true do
     print_char c; flush stdout;
     for i = 1 to 100000 do ignore(ref []) done
   done
@@ -14,6 +26,7 @@
   print_string "Forking..."; print_newline();
   match Unix.fork() with
   | 0 ->
+      Thread.delay 0.5;
       print_string "In child..."; print_newline();
       Gc.minor();
       print_string "Child did minor GC."; print_newline();
@@ -23,10 +36,8 @@
       exit 0
   | pid ->
       print_string "In parent..."; print_newline();
-      Thread.delay 2.0;
+      Thread.delay 4.0;
       print_string "Parent is exiting."; print_newline();
       exit 0
 
 let _ = main()
-
-      
diff -Nru ocaml-3.12.1/testsuite/tests/lib-systhreads/testfork.precheck ocaml-4.01.0/testsuite/tests/lib-systhreads/testfork.precheck
--- ocaml-3.12.1/testsuite/tests/lib-systhreads/testfork.precheck	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-systhreads/testfork.precheck	2013-04-29 17:02:29.000000000 +0000
@@ -0,0 +1,17 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#           Damien Doligez, projet Gallium, INRIA Rocquencourt          #
+#                                                                       #
+#   Copyright 2013 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+case `sed -n -e '/OTHERLIBRARIES=/s// /p' ../../../config/Makefile` in
+  *' unix '*) exit 0;;
+  *) exit 3;;
+esac
+
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/.cvsignore ocaml-4.01.0/testsuite/tests/lib-threads/.cvsignore
--- ocaml-3.12.1/testsuite/tests/lib-threads/.cvsignore	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1 +0,0 @@
-*.byt
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/.ignore ocaml-4.01.0/testsuite/tests/lib-threads/.ignore
--- ocaml-3.12.1/testsuite/tests/lib-threads/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/.ignore	2012-07-17 15:31:12.000000000 +0000
@@ -0,0 +1 @@
+*.byt
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/Makefile ocaml-4.01.0/testsuite/tests/lib-threads/Makefile
--- ocaml-3.12.1/testsuite/tests/lib-threads/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/Makefile	2013-05-17 12:49:42.000000000 +0000
@@ -1,5 +1,20 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 LIBRARIES=unix threads
-ADD_COMPFLAGS=-thread
+ADD_COMPFLAGS=-thread -I $(OTOPDIR)/otherlibs/systhreads \
+	      -I $(OTOPDIR)/otherlibs/$(UNIXLIBVAR)unix
+LD_PATH=$(TOPDIR)/otherlibs/systhreads:$(TOPDIR)/otherlibs/$(UNIXLIBVAR)unix
 
-include ../../makefiles/Makefile.several
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/close.ml ocaml-4.01.0/testsuite/tests/lib-threads/close.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/close.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/close.ml	2013-05-15 15:24:52.000000000 +0000
@@ -1,15 +1,30 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let main () =
   let (rd, wr) = Unix.pipe() in
-  let _ = Thread.create
+  let t = Thread.create
     (fun () ->
-      ignore (Unix.write wr "0123456789" 0 10);
-      Thread.delay 3.0;
+      Thread.delay 1.0;
       print_endline "closing fd...";
-      Unix.close rd)
+      Unix.close wr;
+    )
     () in
   let buf = String.create 10 in
   print_endline "reading...";
-  ignore (Unix.read rd buf 0 10);
-  print_endline "read returned"
+  begin try ignore (Unix.read rd buf 0 10) with Unix.Unix_error _ -> () end;
+  print_endline "read returned";
+  t
+
+let t = Unix.handle_unix_error main ()
 
-let _ = Unix.handle_unix_error main ()
+let _ = Thread.join t
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/close.reference ocaml-4.01.0/testsuite/tests/lib-threads/close.reference
--- ocaml-3.12.1/testsuite/tests/lib-threads/close.reference	2010-01-28 15:42:08.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/close.reference	2013-05-15 09:31:58.000000000 +0000
@@ -1,2 +1,3 @@
 reading...
+closing fd...
 read returned
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/sieve.ml ocaml-4.01.0/testsuite/tests/lib-threads/sieve.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/sieve.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/sieve.ml	2013-04-29 18:00:49.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 open Printf
 open Thread
 
@@ -28,6 +40,6 @@
   in Thread.create (integers 2) ch;
      print_primes ch max;;
 
-let _ = go 1000
+let _ = go 500
 
 ;;
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/sieve.reference ocaml-4.01.0/testsuite/tests/lib-threads/sieve.reference
--- ocaml-3.12.1/testsuite/tests/lib-threads/sieve.reference	2010-01-28 15:42:08.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/sieve.reference	2013-04-29 18:00:49.000000000 +0000
@@ -93,76 +93,3 @@
 487
 491
 499
-503
-509
-521
-523
-541
-547
-557
-563
-569
-571
-577
-587
-593
-599
-601
-607
-613
-617
-619
-631
-641
-643
-647
-653
-659
-661
-673
-677
-683
-691
-701
-709
-719
-727
-733
-739
-743
-751
-757
-761
-769
-773
-787
-797
-809
-811
-821
-823
-827
-829
-839
-853
-857
-859
-863
-877
-881
-883
-887
-907
-911
-919
-929
-937
-941
-947
-953
-967
-971
-977
-983
-991
-997
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test-file-short-lines ocaml-4.01.0/testsuite/tests/lib-threads/test-file-short-lines
--- ocaml-3.12.1/testsuite/tests/lib-threads/test-file-short-lines	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test-file-short-lines	2013-04-29 17:02:29.000000000 +0000
@@ -0,0 +1,10 @@
+##
+# Host Database
+#
+# localhost is used to configure the loopback interface
+# when the system is booting.  Do not change this entry.
+##
+127.0.0.1	localhost
+255.255.255.255	broadcasthost
+::1             localhost 
+fe80::1%lo0	localhost
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test1.checker ocaml-4.01.0/testsuite/tests/lib-threads/test1.checker
--- ocaml-3.12.1/testsuite/tests/lib-threads/test1.checker	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test1.checker	2013-05-07 11:26:42.000000000 +0000
@@ -1 +1,13 @@
-sort test1.result | diff -q test1.reference -
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+LC_ALL=C $SORT test1.result | $DIFF test1.reference -
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test1.ml ocaml-4.01.0/testsuite/tests/lib-threads/test1.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/test1.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test1.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Classic producer-consumer *)
 
 type 'a prodcons =
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test2.checker ocaml-4.01.0/testsuite/tests/lib-threads/test2.checker
--- ocaml-3.12.1/testsuite/tests/lib-threads/test2.checker	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test2.checker	2012-10-17 20:09:16.000000000 +0000
@@ -1 +1,13 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
 sed -e 1q test2.result | grep -q '^[ab]*'
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test2.ml ocaml-4.01.0/testsuite/tests/lib-threads/test2.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/test2.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test2.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let yield = ref false
 
 let print_message c =
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test3.checker ocaml-4.01.0/testsuite/tests/lib-threads/test3.checker
--- ocaml-3.12.1/testsuite/tests/lib-threads/test3.checker	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test3.checker	2012-10-17 20:09:16.000000000 +0000
@@ -1 +1,13 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
 sed -e 1q test3.result | grep -q '^[ab]*'
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test3.ml ocaml-4.01.0/testsuite/tests/lib-threads/test3.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/test3.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test3.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let print_message delay c =
   while true do
     print_char c; flush stdout; Thread.delay delay
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test3.precheck ocaml-4.01.0/testsuite/tests/lib-threads/test3.precheck
--- ocaml-3.12.1/testsuite/tests/lib-threads/test3.precheck	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test3.precheck	2013-04-29 18:23:28.000000000 +0000
@@ -0,0 +1,13 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#           Damien Doligez, projet Gallium, INRIA Rocquencourt          #
+#                                                                       #
+#   Copyright 2013 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+$CANKILL
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test3.runner ocaml-4.01.0/testsuite/tests/lib-threads/test3.runner
--- ocaml-3.12.1/testsuite/tests/lib-threads/test3.runner	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test3.runner	2013-05-16 12:20:59.000000000 +0000
@@ -1,4 +1,16 @@
-./program > test3.result &
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+$RUNTIME ./program >test3.result &
 pid=$!
 sleep 5
-kill -9 $pid
\ No newline at end of file
+kill -9 $pid
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test4.checker ocaml-4.01.0/testsuite/tests/lib-threads/test4.checker
--- ocaml-3.12.1/testsuite/tests/lib-threads/test4.checker	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test4.checker	2013-05-07 11:26:42.000000000 +0000
@@ -1 +1,13 @@
-sort -u test4.result | diff -q test4.reference -
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+LC_ALL=C $SORT -u test4.result | $DIFF test4.reference -
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test4.ml ocaml-4.01.0/testsuite/tests/lib-threads/test4.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/test4.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test4.ml	2013-06-14 08:06:07.000000000 +0000
@@ -1,11 +1,24 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let output_lock = Mutex.create()
 
 let rec fib n = if n <= 2 then 1 else fib(n-1) + fib(n-2)
 
 let fibtask n =
   while true do
+    let res = fib n in
     Mutex.lock output_lock;
-    print_int(fib n); print_newline();
+    print_int res; print_newline();
     Mutex.unlock output_lock
   done
 
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test4.runner ocaml-4.01.0/testsuite/tests/lib-threads/test4.runner
--- ocaml-3.12.1/testsuite/tests/lib-threads/test4.runner	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test4.runner	2013-05-16 12:20:59.000000000 +0000
@@ -1 +1,13 @@
-./program < test4.data > test4.result 2> /dev/null || true
\ No newline at end of file
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+$RUNTIME ./program test4.result 2>/dev/null || true
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test5.checker ocaml-4.01.0/testsuite/tests/lib-threads/test5.checker
--- ocaml-3.12.1/testsuite/tests/lib-threads/test5.checker	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test5.checker	2013-05-07 11:26:42.000000000 +0000
@@ -1 +1,13 @@
-sort -u test5.result | diff -q test5.reference -
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+LC_ALL=C $SORT -u test5.result | $DIFF test5.reference -
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test5.ml ocaml-4.01.0/testsuite/tests/lib-threads/test5.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/test5.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test5.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 open Event
 
 let ch = (new_channel() : string channel)
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test5.precheck ocaml-4.01.0/testsuite/tests/lib-threads/test5.precheck
--- ocaml-3.12.1/testsuite/tests/lib-threads/test5.precheck	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test5.precheck	2013-04-29 17:02:29.000000000 +0000
@@ -0,0 +1,13 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#           Damien Doligez, projet Gallium, INRIA Rocquencourt          #
+#                                                                       #
+#   Copyright 2013 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+$CANKILL
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test5.runner ocaml-4.01.0/testsuite/tests/lib-threads/test5.runner
--- ocaml-3.12.1/testsuite/tests/lib-threads/test5.runner	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test5.runner	2013-05-16 12:20:59.000000000 +0000
@@ -1,4 +1,16 @@
-./program > test5.result &
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+$RUNTIME ./program >test5.result &
 pid=$!
-sleep 1
-kill -9 $pid
\ No newline at end of file
+sleep 3
+kill -9 $pid
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test6.checker ocaml-4.01.0/testsuite/tests/lib-threads/test6.checker
--- ocaml-3.12.1/testsuite/tests/lib-threads/test6.checker	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test6.checker	2013-05-07 11:26:42.000000000 +0000
@@ -1 +1,13 @@
-sort -u test6.result | diff -q test6.reference -
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+LC_ALL=C $SORT -u test6.result | $DIFF test6.reference -
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test6.ml ocaml-4.01.0/testsuite/tests/lib-threads/test6.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/test6.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test6.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 open Event
 
 let ch = (new_channel() : string channel)
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test6.precheck ocaml-4.01.0/testsuite/tests/lib-threads/test6.precheck
--- ocaml-3.12.1/testsuite/tests/lib-threads/test6.precheck	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test6.precheck	2013-04-29 17:02:29.000000000 +0000
@@ -0,0 +1,13 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#           Damien Doligez, projet Gallium, INRIA Rocquencourt          #
+#                                                                       #
+#   Copyright 2013 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+$CANKILL
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test6.runner ocaml-4.01.0/testsuite/tests/lib-threads/test6.runner
--- ocaml-3.12.1/testsuite/tests/lib-threads/test6.runner	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test6.runner	2013-05-16 12:20:59.000000000 +0000
@@ -1,4 +1,16 @@
-./program > test6.result &
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+$RUNTIME ./program >test6.result &
 pid=$!
 sleep 1
 kill -9 $pid
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test7.checker ocaml-4.01.0/testsuite/tests/lib-threads/test7.checker
--- ocaml-3.12.1/testsuite/tests/lib-threads/test7.checker	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test7.checker	2012-10-17 20:09:16.000000000 +0000
@@ -1 +1,13 @@
-test `grep -E '^-?[0123456789]+$' test7.result | wc -l` = `cat test7.result | wc -l`
\ No newline at end of file
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+test `grep -E '^-?[0123456789]+$' test7.result | wc -l` = `cat test7.result | wc -l`
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test7.ml ocaml-4.01.0/testsuite/tests/lib-threads/test7.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/test7.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test7.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 open Event
 
 let add_ch = new_channel()
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test7.precheck ocaml-4.01.0/testsuite/tests/lib-threads/test7.precheck
--- ocaml-3.12.1/testsuite/tests/lib-threads/test7.precheck	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test7.precheck	2013-04-29 17:02:29.000000000 +0000
@@ -0,0 +1,13 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#           Damien Doligez, projet Gallium, INRIA Rocquencourt          #
+#                                                                       #
+#   Copyright 2013 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+$CANKILL
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test7.runner ocaml-4.01.0/testsuite/tests/lib-threads/test7.runner
--- ocaml-3.12.1/testsuite/tests/lib-threads/test7.runner	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test7.runner	2013-05-16 12:20:59.000000000 +0000
@@ -1,4 +1,16 @@
-./program > test7.result &
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+$RUNTIME ./program >test7.result &
 pid=$!
 sleep 1
 kill -9 $pid
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test8.ml ocaml-4.01.0/testsuite/tests/lib-threads/test8.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/test8.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test8.ml	2013-05-22 13:04:00.000000000 +0000
@@ -1,22 +1,38 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 open Event
 
-type 'a buffer_channel = { input: 'a channel; output: 'a channel }
+type 'a buffer_channel = {
+  input: 'a channel;
+  output: 'a channel;
+  thread: Thread.t;
+}
 
 let new_buffer_channel() =
   let ic = new_channel() in
   let oc = new_channel() in
-  let buff = Queue.create() in
   let rec buffer_process front rear =
     match (front, rear) with
-      ([], []) -> buffer_process [sync(receive ic)] []
+    | (["EOF"], []) -> Thread.exit ()
+    | ([], []) -> buffer_process [sync(receive ic)] []
     | (hd::tl, _) ->
         select [
           wrap (receive ic) (fun x -> buffer_process front (x::rear));
           wrap (send oc hd) (fun () -> buffer_process tl rear)
         ]
     | ([], _) -> buffer_process (List.rev rear) [] in
-  Thread.create (buffer_process []) [];
-  { input = ic; output = oc }
+  let t = Thread.create (buffer_process []) [] in
+  { input = ic; output = oc; thread = t }
 
 let buffer_send bc data =
   sync(send bc.input data)
@@ -40,5 +56,8 @@
   print_string (sync(buffer_receive box)); print_newline()
 
 let _ =
-  Thread.create f ();
-  g()
+  let t = Thread.create f () in
+  g();
+  buffer_send box "EOF";
+  Thread.join box.thread;
+  Thread.join t
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test8.precheck ocaml-4.01.0/testsuite/tests/lib-threads/test8.precheck
--- ocaml-3.12.1/testsuite/tests/lib-threads/test8.precheck	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test8.precheck	2013-06-27 18:20:24.000000000 +0000
@@ -0,0 +1,13 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#           Damien Doligez, projet Gallium, INRIA Rocquencourt          #
+#                                                                       #
+#   Copyright 2013 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+$CANKILL
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test9.checker ocaml-4.01.0/testsuite/tests/lib-threads/test9.checker
--- ocaml-3.12.1/testsuite/tests/lib-threads/test9.checker	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test9.checker	2013-05-07 11:26:42.000000000 +0000
@@ -0,0 +1,13 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#          Damien Doligez, projet Gallium, INRIA Rocquencourt           #
+#                                                                       #
+#   Copyright 2013 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+LC_ALL=C $SORT test9.result | $DIFF test9.reference -
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test9.ml ocaml-4.01.0/testsuite/tests/lib-threads/test9.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/test9.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test9.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 open Event
 
 type 'a swap_chan = ('a * 'a channel) channel
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test9.precheck ocaml-4.01.0/testsuite/tests/lib-threads/test9.precheck
--- ocaml-3.12.1/testsuite/tests/lib-threads/test9.precheck	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test9.precheck	2013-06-27 18:20:24.000000000 +0000
@@ -0,0 +1,13 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#           Damien Doligez, projet Gallium, INRIA Rocquencourt          #
+#                                                                       #
+#   Copyright 2013 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+$CANKILL
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/test9.reference ocaml-4.01.0/testsuite/tests/lib-threads/test9.reference
--- ocaml-3.12.1/testsuite/tests/lib-threads/test9.reference	2010-01-28 15:42:08.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/test9.reference	2013-04-18 14:19:23.000000000 +0000
@@ -1,2 +1,2 @@
-g F
 f G
+g F
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/testA.checker ocaml-4.01.0/testsuite/tests/lib-threads/testA.checker
--- ocaml-3.12.1/testsuite/tests/lib-threads/testA.checker	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/testA.checker	2013-05-07 11:26:42.000000000 +0000
@@ -1 +1,13 @@
-sort testA.result | diff -q testA.reference -
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+LC_ALL=C $SORT testA.result | $DIFF testA.reference -
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/testA.ml ocaml-4.01.0/testsuite/tests/lib-threads/testA.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/testA.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/testA.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let private_data = (Hashtbl.create 17 : (Thread.t, string) Hashtbl.t)
 let private_data_lock = Mutex.create()
 let output_lock = Mutex.create()
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/testexit.checker ocaml-4.01.0/testsuite/tests/lib-threads/testexit.checker
--- ocaml-3.12.1/testsuite/tests/lib-threads/testexit.checker	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/testexit.checker	2013-05-07 11:26:42.000000000 +0000
@@ -1 +1,13 @@
-sort testexit.result | diff -q testexit.reference -
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+LC_ALL=C $SORT testexit.result | $DIFF testexit.reference -
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/testexit.ml ocaml-4.01.0/testsuite/tests/lib-threads/testexit.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/testexit.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/testexit.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Test Thread.exit *)
 
 let somethread (name, limit, last) =
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/testio.ml ocaml-4.01.0/testsuite/tests/lib-threads/testio.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/testio.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/testio.ml	2013-04-29 17:02:29.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Test a file copy function *)
 
 let test msg producer consumer src dst =
@@ -107,7 +119,7 @@
   test "0...8192 byte chunks"
        (copy_random 8192) (copy_random 8192) ifile ofile;
   test "line per line, short lines"
-       copy_line copy_line "/etc/hosts" ofile;
+       copy_line copy_line "test-file-short-lines" ofile;
   let linesfile = Filename.temp_file "lines" "" in
   make_lines linesfile;
   test "line per line, short and long lines"
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/testsieve.ml ocaml-4.01.0/testsuite/tests/lib-threads/testsieve.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/testsieve.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/testsieve.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let sieve primes=
   Event.sync (Event.send primes 0);
   Event.sync (Event.send primes 1);
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/testsignal.checker ocaml-4.01.0/testsuite/tests/lib-threads/testsignal.checker
--- ocaml-3.12.1/testsuite/tests/lib-threads/testsignal.checker	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/testsignal.checker	2012-10-17 20:09:16.000000000 +0000
@@ -1 +1,13 @@
-sed -e 1q testsignal.result | grep -q '^[ab]*Got ctrl-C, exiting...$' 
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+sed -e 1q testsignal.result | grep -q '^[ab]*Got ctrl-C, exiting...$'
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/testsignal.ml ocaml-4.01.0/testsuite/tests/lib-threads/testsignal.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/testsignal.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/testsignal.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let sighandler _ =
   print_string "Got ctrl-C, exiting..."; print_newline();
   exit 0
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/testsignal.precheck ocaml-4.01.0/testsuite/tests/lib-threads/testsignal.precheck
--- ocaml-3.12.1/testsuite/tests/lib-threads/testsignal.precheck	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/testsignal.precheck	2013-04-29 17:02:29.000000000 +0000
@@ -0,0 +1,13 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#           Damien Doligez, projet Gallium, INRIA Rocquencourt          #
+#                                                                       #
+#   Copyright 2013 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+$CANKILL
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/testsignal.runner ocaml-4.01.0/testsuite/tests/lib-threads/testsignal.runner
--- ocaml-3.12.1/testsuite/tests/lib-threads/testsignal.runner	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/testsignal.runner	2013-05-16 12:20:59.000000000 +0000
@@ -1,4 +1,16 @@
-./program > testsignal.result &
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+$RUNTIME ./program >testsignal.result &
 pid=$!
 sleep 3
-kill -INT $pid
\ No newline at end of file
+kill -INT $pid
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/testsignal2.checker ocaml-4.01.0/testsuite/tests/lib-threads/testsignal2.checker
--- ocaml-3.12.1/testsuite/tests/lib-threads/testsignal2.checker	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/testsignal2.checker	2012-10-17 20:09:16.000000000 +0000
@@ -1 +1,13 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
 sed -e 1q testsignal2.result | grep -q '^[ab]*'
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/testsignal2.ml ocaml-4.01.0/testsuite/tests/lib-threads/testsignal2.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/testsignal2.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/testsignal2.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let print_message delay c =
   while true do
     print_char c; flush stdout; Thread.delay delay
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/testsignal2.precheck ocaml-4.01.0/testsuite/tests/lib-threads/testsignal2.precheck
--- ocaml-3.12.1/testsuite/tests/lib-threads/testsignal2.precheck	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/testsignal2.precheck	2013-04-29 17:02:29.000000000 +0000
@@ -0,0 +1,13 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#           Damien Doligez, projet Gallium, INRIA Rocquencourt          #
+#                                                                       #
+#   Copyright 2013 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+$CANKILL
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/testsignal2.runner ocaml-4.01.0/testsuite/tests/lib-threads/testsignal2.runner
--- ocaml-3.12.1/testsuite/tests/lib-threads/testsignal2.runner	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/testsignal2.runner	2013-05-16 12:20:59.000000000 +0000
@@ -1,6 +1,18 @@
-./program > testsignal2.result &
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+$RUNTIME ./program >testsignal2.result &
 pid=$!
 sleep 3
 kill -INT $pid
 sleep 1
-kill -9 $pid || true
+kill -9 $pid 2>&- || true
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/testsocket.ml ocaml-4.01.0/testsuite/tests/lib-threads/testsocket.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/testsocket.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/testsocket.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 open Unix
 
 let engine verbose number address =
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/testsocket.precheck ocaml-4.01.0/testsuite/tests/lib-threads/testsocket.precheck
--- ocaml-3.12.1/testsuite/tests/lib-threads/testsocket.precheck	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/testsocket.precheck	2013-06-11 13:20:32.000000000 +0000
@@ -0,0 +1,23 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#           Damien Doligez, projet Gallium, INRIA Rocquencourt          #
+#                                                                       #
+#   Copyright 2013 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+
+##########################################
+##########################################
+####  TEMPORARY                       ####
+##########################################
+##########################################
+
+# disable this test on Windows non-cygwin ports until we decide
+# how to fix PR#5325 and PR#5578
+
+$CANKILL
\ No newline at end of file
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/token1.ml ocaml-4.01.0/testsuite/tests/lib-threads/token1.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/token1.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/token1.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Performance test for mutexes and conditions *)
 
 let mut = Mutex.create()
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/token2.ml ocaml-4.01.0/testsuite/tests/lib-threads/token2.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/token2.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/token2.ml	2013-05-15 15:24:52.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Performance test for I/O scheduling *)
 
 let mut = Mutex.create()
@@ -7,13 +19,13 @@
 let token = ref 0
 
 let process (n, ins, outs, nprocs) =
-  let buf = String.create 1 in
-  while true do
+  let buf = String.make 1 '.' in
+  while buf <> "-" do
     Unix.read ins.(n) buf 0 1;
     (* Printf.printf "Thread %d got the token\n" n; *)
     if n = 0 then begin
       decr niter;
-      if !niter <= 0 then exit 0
+      if !niter <= 0 then buf.[0] <- '-';
     end;
     let next = if n + 1 >= nprocs then 0 else n + 1 in
     (* Printf.printf "Thread %d sending token to thread %d\n" n next; *)
@@ -25,12 +37,15 @@
   let iter = try int_of_string Sys.argv.(2) with _ -> 1000 in
   let ins = Array.create nprocs Unix.stdin in
   let outs = Array.create nprocs Unix.stdout in
+  let threads = Array.create nprocs (Thread.self ()) in
   for n = 0 to nprocs - 1 do
     let (i, o) = Unix.pipe() in ins.(n) <- i; outs.(n) <- o
   done;
   niter := iter;
-  for i = 0 to nprocs - 1 do Thread.create process (i, ins, outs, nprocs) done;
+  for i = 0 to nprocs - 1 do
+    threads.(i) <- Thread.create process (i, ins, outs, nprocs)
+  done;
   Unix.write outs.(0) "X" 0 1;
-  Thread.delay 3600.
+  for i = 0 to nprocs - 1 do Thread.join threads.(i) done
 
 let _ = main()
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/torture.ml ocaml-4.01.0/testsuite/tests/lib-threads/torture.ml
--- ocaml-3.12.1/testsuite/tests/lib-threads/torture.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/torture.ml	2013-05-16 07:44:41.000000000 +0000
@@ -1,25 +1,41 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Torture test - lots of GC *)
 
+let finished = ref false;;
+
 let gc_thread () =
-  while true do
+  while not !finished do
 (*    print_string "gc"; print_newline(); *)
     Gc.minor();
     Thread.yield()
   done
 
 let stdin_thread () =
-  while true do
-    print_string "> "; flush stdout;
+  while not !finished do
+    print_string ">"; flush stdout;
     let s = read_line() in
-    print_string ">>> "; print_string s; print_newline()
+    print_string " >>> "; print_string s; print_newline()
   done
 
 let writer_thread (oc, size) =
-  while true do
+  while not !finished do
 (*    print_string "writer "; print_int size; print_newline(); *)
     let buff = String.make size 'a' in
     Unix.write oc buff 0 size
-  done
+  done;
+  let buff = String.make size 'b' in
+  Unix.write oc buff 0 size
 
 let reader_thread (ic, size) =
   while true do
@@ -28,18 +44,23 @@
     let n = Unix.read ic buff 0 size in
 (*    print_string "reader "; print_int n; print_newline(); *)
     for i = 0 to n-1 do
-      if buff.[i] <> 'a' then prerr_endline "error in reader_thread"
+      if buff.[i] = 'b' then raise Exit
+      else if buff.[i] <> 'a' then prerr_endline "error in reader_thread"
     done
   done
 
 let main() =
-  Thread.create gc_thread ();
+  let t1 = Thread.create gc_thread () in
   let (out1, in1) = Unix.pipe() in
-  Thread.create writer_thread (in1, 4096);
-  Thread.create reader_thread (out1, 4096);
+  let t2 = Thread.create writer_thread (in1, 4096) in
+  let t3 = Thread.create reader_thread (out1, 4096) in
   let (out2, in2) = Unix.pipe() in
-  Thread.create writer_thread (in2, 16);
-  Thread.create reader_thread (out2, 16);
-  stdin_thread()
+  let t4 = Thread.create writer_thread (in2, 16) in
+  let t5 = Thread.create reader_thread (out2, 16) in
+  try
+    stdin_thread()
+  with _ ->
+    finished := true;
+    List.iter Thread.join [t1; t2; t3; t4; t5]
 
 let _ = main()
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/torture.reference ocaml-4.01.0/testsuite/tests/lib-threads/torture.reference
--- ocaml-3.12.1/testsuite/tests/lib-threads/torture.reference	2010-01-28 15:42:08.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/torture.reference	2012-07-30 18:04:46.000000000 +0000
@@ -1,4 +1,4 @@
 > >>> abc
 > >>> def
 > >>> ghi
-> 
\ No newline at end of file
+>
\ No newline at end of file
diff -Nru ocaml-3.12.1/testsuite/tests/lib-threads/torture.runner ocaml-4.01.0/testsuite/tests/lib-threads/torture.runner
--- ocaml-3.12.1/testsuite/tests/lib-threads/torture.runner	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/lib-threads/torture.runner	2013-05-16 12:20:59.000000000 +0000
@@ -1 +1,13 @@
-./program < torture.data > torture.result 2> /dev/null || true
\ No newline at end of file
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+$RUNTIME ./program torture.result 2>/dev/null || true
diff -Nru ocaml-3.12.1/testsuite/tests/misc/Makefile ocaml-4.01.0/testsuite/tests/misc/Makefile
--- ocaml-3.12.1/testsuite/tests/misc/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,2 +1,15 @@
-include ../../makefiles/Makefile.several
-include ../../makefiles/Makefile.common
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/misc/bdd.ml ocaml-4.01.0/testsuite/tests/misc/bdd.ml
--- ocaml-3.12.1/testsuite/tests/misc/bdd.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc/bdd.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,9 +10,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: bdd.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
-(* Translated to Caml by Xavier Leroy *)
+(* Translated to OCaml by Xavier Leroy *)
 (* Original code written in SML by ... *)
 
 type bdd = One | Zero | Node of bdd * int * int * bdd
@@ -24,8 +22,8 @@
   | Node(l, v, _, h) ->
       if vars.(v) then eval h vars else eval l vars
 
-let getId bdd = 
-  match bdd with 
+let getId bdd =
+  match bdd with
     Node(_,_,id,_) -> id
   | Zero           -> 0
   | One            -> 1
@@ -42,10 +40,10 @@
       let newSz_1 = newSize-1 in
       let newArr  = Array.create newSize [] in
       let rec copyBucket bucket =
-                match bucket with 
+                match bucket with
                   []     -> ()
-                | n :: ns ->  
-                    match n with 
+                | n :: ns ->
+                    match n with
                     | Node(l,v,_,h) ->
                        let ind = hashVal (getId l) (getId h) v land newSz_1
                        in
@@ -80,18 +78,18 @@
 
 let mkNode low v high =
    let idl = getId low in
-   let idh = getId high 
+   let idh = getId high
    in
      if idl = idh
      then low
      else let ind      = hashVal idl idh v land  (!sz_1) in
           let bucket   = (!htab).(ind) in
-          let rec lookup b = 
-                    match b with 
+          let rec lookup b =
+                    match b with
                       [] -> let n = Node(low, v, (incr nodeC; !nodeC), high)
                             in
                              insert (getId low) (getId high) v ind bucket n; n
-                    | n :: ns -> 
+                    | n :: ns ->
                         match n with
                         | Node(l,v',id,h) ->
                            if v = v' && idl = getId l && idh = getId h
@@ -104,7 +102,7 @@
 type ordering = LESS | EQUAL | GREATER
 
 let cmpVar (x : int) (y : int) =
-  if xy then GREATER else EQUAL 
+  if xy then GREATER else EQUAL
 
 let zero = Zero
 let one  = One
@@ -123,7 +121,7 @@
 let notslot2  = Array.create cacheSize one
 let hash x y  = ((x lsl 1)+y) mod cacheSize
 
-let rec not n = 
+let rec not n =
 match n with
   Zero -> One
 | One  -> Zero
@@ -134,9 +132,9 @@
                                in
                                  notslot1.(h) <- id; notslot2.(h) <- f; f
 
-let rec and2 n1 n2 = 
+let rec and2 n1 n2 =
 match n1 with
-  Node(l1, v1, i1, r1) 
+  Node(l1, v1, i1, r1)
   -> (match n2 with
         Node(l2, v2, i2, r2)
         -> let h = hash i1 i2
@@ -147,8 +145,8 @@
                           | LESS    -> mkNode (and2 l1 n2) v1 (and2 r1 n2)
                           | GREATER -> mkNode (and2 n1 l2) v2 (and2 n1 r2)
                   in
-                   andslot1.(h) <- i1; 
-                   andslot2.(h) <- i2; 
+                   andslot1.(h) <- i1;
+                   andslot2.(h) <- i2;
                    andslot3.(h) <- f;
                    f
      | Zero -> Zero
@@ -157,9 +155,9 @@
 |  One  -> n2
 
 
-let rec xor n1 n2 = 
+let rec xor n1 n2 =
 match n1 with
-  Node(l1, v1, i1, r1) 
+  Node(l1, v1, i1, r1)
   -> (match n2 with
         Node(l2, v2, i2, r2)
         -> let h = hash i1 i2
@@ -174,19 +172,19 @@
                    andslot2.(h) <- i2;
                    andslot3.(h) <- f;
                    f
-     | Zero -> n1 
+     | Zero -> n1
      | One  -> not n1)
 |  Zero -> n2
 |  One  -> not n2
 
-let hwb n = 
+let hwb n =
   let rec h i j = if i=j
                   then mkVar i
                   else  xor (and2 (not(mkVar j)) (h i (j-1)))
                             (and2 (mkVar j)      (g i (j-1)))
       and g i j = if i=j
                   then mkVar i
-                  else xor (and2 (not(mkVar i)) (h (i+1) j)) 
+                  else xor (and2 (not(mkVar i)) (h (i+1) j))
                            (and2 (mkVar i)      (g (i+1) j))
   in
      h 0 (n-1)
diff -Nru ocaml-3.12.1/testsuite/tests/misc/boyer.ml ocaml-4.01.0/testsuite/tests/misc/boyer.ml
--- ocaml-3.12.1/testsuite/tests/misc/boyer.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc/boyer.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: boyer.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (* Manipulations over terms *)
 
 type term =
@@ -29,7 +27,7 @@
       print_string head.name;
       List.iter (fun t -> print_string " "; print_term t) argl;
       print_string ")"
- 
+
 let lemmas = ref ([] : head list)
 
 (* Replacement for property lists *)
@@ -120,13 +118,13 @@
 let _ =
 add (CProp
 ("equal",
- [CProp ("compile",[CVar 5]); 
+ [CProp ("compile",[CVar 5]);
   CProp
   ("reverse",
    [CProp ("codegen",[CProp ("optimize",[CVar 5]); CProp ("nil",[])])])]));
 add (CProp
 ("equal",
- [CProp ("eqp",[CVar 23; CVar 24]); 
+ [CProp ("eqp",[CVar 23; CVar 24]);
   CProp ("equal",[CProp ("fix",[CVar 23]); CProp ("fix",[CVar 24])])]));
 add (CProp
 ("equal",
@@ -139,120 +137,120 @@
  [CProp ("ge",[CVar 23; CVar 24]); CProp ("le",[CVar 24; CVar 23])]));
 add (CProp
 ("equal",
- [CProp ("boolean",[CVar 23]); 
+ [CProp ("boolean",[CVar 23]);
   CProp
   ("or",
-   [CProp ("equal",[CVar 23; CProp ("true",[])]); 
+   [CProp ("equal",[CVar 23; CProp ("true",[])]);
     CProp ("equal",[CVar 23; CProp ("false",[])])])]));
 add (CProp
 ("equal",
- [CProp ("iff",[CVar 23; CVar 24]); 
+ [CProp ("iff",[CVar 23; CVar 24]);
   CProp
   ("and",
-   [CProp ("implies",[CVar 23; CVar 24]); 
+   [CProp ("implies",[CVar 23; CVar 24]);
     CProp ("implies",[CVar 24; CVar 23])])]));
 add (CProp
 ("equal",
- [CProp ("even1",[CVar 23]); 
+ [CProp ("even1",[CVar 23]);
   CProp
   ("if",
-   [CProp ("zerop",[CVar 23]); CProp ("true",[]); 
+   [CProp ("zerop",[CVar 23]); CProp ("true",[]);
     CProp ("odd",[CProp ("sub1",[CVar 23])])])]));
 add (CProp
 ("equal",
- [CProp ("countps_",[CVar 11; CVar 15]); 
+ [CProp ("countps_",[CVar 11; CVar 15]);
   CProp ("countps_loop",[CVar 11; CVar 15; CProp ("zero",[])])]));
 add (CProp
 ("equal",
- [CProp ("fact_",[CVar 8]); 
+ [CProp ("fact_",[CVar 8]);
   CProp ("fact_loop",[CVar 8; CProp ("one",[])])]));
 add (CProp
 ("equal",
- [CProp ("reverse_",[CVar 23]); 
+ [CProp ("reverse_",[CVar 23]);
   CProp ("reverse_loop",[CVar 23; CProp ("nil",[])])]));
 add (CProp
 ("equal",
- [CProp ("divides",[CVar 23; CVar 24]); 
+ [CProp ("divides",[CVar 23; CVar 24]);
   CProp ("zerop",[CProp ("remainder",[CVar 24; CVar 23])])]));
 add (CProp
 ("equal",
- [CProp ("assume_true",[CVar 21; CVar 0]); 
+ [CProp ("assume_true",[CVar 21; CVar 0]);
   CProp ("cons",[CProp ("cons",[CVar 21; CProp ("true",[])]); CVar 0])]));
 add (CProp
 ("equal",
- [CProp ("assume_false",[CVar 21; CVar 0]); 
+ [CProp ("assume_false",[CVar 21; CVar 0]);
   CProp ("cons",[CProp ("cons",[CVar 21; CProp ("false",[])]); CVar 0])]));
 add (CProp
 ("equal",
- [CProp ("tautology_checker",[CVar 23]); 
+ [CProp ("tautology_checker",[CVar 23]);
   CProp ("tautologyp",[CProp ("normalize",[CVar 23]); CProp ("nil",[])])]));
 add (CProp
 ("equal",
- [CProp ("falsify",[CVar 23]); 
+ [CProp ("falsify",[CVar 23]);
   CProp ("falsify1",[CProp ("normalize",[CVar 23]); CProp ("nil",[])])]));
 add (CProp
 ("equal",
- [CProp ("prime",[CVar 23]); 
+ [CProp ("prime",[CVar 23]);
   CProp
   ("and",
-   [CProp ("not",[CProp ("zerop",[CVar 23])]); 
+   [CProp ("not",[CProp ("zerop",[CVar 23])]);
     CProp
     ("not",
-     [CProp ("equal",[CVar 23; CProp ("add1",[CProp ("zero",[])])])]); 
+     [CProp ("equal",[CVar 23; CProp ("add1",[CProp ("zero",[])])])]);
     CProp ("prime1",[CVar 23; CProp ("sub1",[CVar 23])])])]));
 add (CProp
 ("equal",
- [CProp ("and",[CVar 15; CVar 16]); 
+ [CProp ("and",[CVar 15; CVar 16]);
   CProp
   ("if",
-   [CVar 15; 
-    CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]); 
+   [CVar 15;
+    CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]);
     CProp ("false",[])])]));
 add (CProp
 ("equal",
- [CProp ("or",[CVar 15; CVar 16]); 
+ [CProp ("or",[CVar 15; CVar 16]);
   CProp
   ("if",
-   [CVar 15; CProp ("true",[]); 
-    CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]); 
+   [CVar 15; CProp ("true",[]);
+    CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]);
     CProp ("false",[])])]));
 add (CProp
 ("equal",
- [CProp ("not",[CVar 15]); 
+ [CProp ("not",[CVar 15]);
   CProp ("if",[CVar 15; CProp ("false",[]); CProp ("true",[])])]));
 add (CProp
 ("equal",
- [CProp ("implies",[CVar 15; CVar 16]); 
+ [CProp ("implies",[CVar 15; CVar 16]);
   CProp
   ("if",
-   [CVar 15; 
-    CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]); 
+   [CVar 15;
+    CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]);
     CProp ("true",[])])]));
 add (CProp
 ("equal",
- [CProp ("fix",[CVar 23]); 
+ [CProp ("fix",[CVar 23]);
   CProp ("if",[CProp ("numberp",[CVar 23]); CVar 23; CProp ("zero",[])])]));
 add (CProp
 ("equal",
- [CProp ("if",[CProp ("if",[CVar 0; CVar 1; CVar 2]); CVar 3; CVar 4]); 
+ [CProp ("if",[CProp ("if",[CVar 0; CVar 1; CVar 2]); CVar 3; CVar 4]);
   CProp
   ("if",
-   [CVar 0; CProp ("if",[CVar 1; CVar 3; CVar 4]); 
+   [CVar 0; CProp ("if",[CVar 1; CVar 3; CVar 4]);
     CProp ("if",[CVar 2; CVar 3; CVar 4])])]));
 add (CProp
 ("equal",
- [CProp ("zerop",[CVar 23]); 
+ [CProp ("zerop",[CVar 23]);
   CProp
   ("or",
-   [CProp ("equal",[CVar 23; CProp ("zero",[])]); 
+   [CProp ("equal",[CVar 23; CProp ("zero",[])]);
     CProp ("not",[CProp ("numberp",[CVar 23])])])]));
 add (CProp
 ("equal",
- [CProp ("plus",[CProp ("plus",[CVar 23; CVar 24]); CVar 25]); 
+ [CProp ("plus",[CProp ("plus",[CVar 23; CVar 24]); CVar 25]);
   CProp ("plus",[CVar 23; CProp ("plus",[CVar 24; CVar 25])])]));
 add (CProp
 ("equal",
- [CProp ("equal",[CProp ("plus",[CVar 0; CVar 1]); CProp ("zero",[])]); 
+ [CProp ("equal",[CProp ("plus",[CVar 0; CVar 1]); CProp ("zero",[])]);
   CProp ("and",[CProp ("zerop",[CVar 0]); CProp ("zerop",[CVar 1])])]));
 add (CProp
 ("equal",[CProp ("difference",[CVar 23; CVar 23]); CProp ("zero",[])]));
@@ -260,90 +258,90 @@
 ("equal",
  [CProp
   ("equal",
-   [CProp ("plus",[CVar 0; CVar 1]); CProp ("plus",[CVar 0; CVar 2])]); 
+   [CProp ("plus",[CVar 0; CVar 1]); CProp ("plus",[CVar 0; CVar 2])]);
   CProp ("equal",[CProp ("fix",[CVar 1]); CProp ("fix",[CVar 2])])]));
 add (CProp
 ("equal",
  [CProp
-  ("equal",[CProp ("zero",[]); CProp ("difference",[CVar 23; CVar 24])]); 
+  ("equal",[CProp ("zero",[]); CProp ("difference",[CVar 23; CVar 24])]);
   CProp ("not",[CProp ("gt",[CVar 24; CVar 23])])]));
 add (CProp
 ("equal",
- [CProp ("equal",[CVar 23; CProp ("difference",[CVar 23; CVar 24])]); 
+ [CProp ("equal",[CVar 23; CProp ("difference",[CVar 23; CVar 24])]);
   CProp
   ("and",
-   [CProp ("numberp",[CVar 23]); 
+   [CProp ("numberp",[CVar 23]);
     CProp
     ("or",
-     [CProp ("equal",[CVar 23; CProp ("zero",[])]); 
+     [CProp ("equal",[CVar 23; CProp ("zero",[])]);
       CProp ("zerop",[CVar 24])])])]));
 add (CProp
 ("equal",
  [CProp
   ("meaning",
-   [CProp ("plus_tree",[CProp ("append",[CVar 23; CVar 24])]); CVar 0]); 
+   [CProp ("plus_tree",[CProp ("append",[CVar 23; CVar 24])]); CVar 0]);
   CProp
   ("plus",
-   [CProp ("meaning",[CProp ("plus_tree",[CVar 23]); CVar 0]); 
+   [CProp ("meaning",[CProp ("plus_tree",[CVar 23]); CVar 0]);
     CProp ("meaning",[CProp ("plus_tree",[CVar 24]); CVar 0])])]));
 add (CProp
 ("equal",
  [CProp
   ("meaning",
-   [CProp ("plus_tree",[CProp ("plus_fringe",[CVar 23])]); CVar 0]); 
+   [CProp ("plus_tree",[CProp ("plus_fringe",[CVar 23])]); CVar 0]);
   CProp ("fix",[CProp ("meaning",[CVar 23; CVar 0])])]));
 add (CProp
 ("equal",
- [CProp ("append",[CProp ("append",[CVar 23; CVar 24]); CVar 25]); 
+ [CProp ("append",[CProp ("append",[CVar 23; CVar 24]); CVar 25]);
   CProp ("append",[CVar 23; CProp ("append",[CVar 24; CVar 25])])]));
 add (CProp
 ("equal",
- [CProp ("reverse",[CProp ("append",[CVar 0; CVar 1])]); 
+ [CProp ("reverse",[CProp ("append",[CVar 0; CVar 1])]);
   CProp
   ("append",[CProp ("reverse",[CVar 1]); CProp ("reverse",[CVar 0])])]));
 add (CProp
 ("equal",
- [CProp ("times",[CVar 23; CProp ("plus",[CVar 24; CVar 25])]); 
+ [CProp ("times",[CVar 23; CProp ("plus",[CVar 24; CVar 25])]);
   CProp
   ("plus",
-   [CProp ("times",[CVar 23; CVar 24]); 
+   [CProp ("times",[CVar 23; CVar 24]);
     CProp ("times",[CVar 23; CVar 25])])]));
 add (CProp
 ("equal",
- [CProp ("times",[CProp ("times",[CVar 23; CVar 24]); CVar 25]); 
+ [CProp ("times",[CProp ("times",[CVar 23; CVar 24]); CVar 25]);
   CProp ("times",[CVar 23; CProp ("times",[CVar 24; CVar 25])])]));
 add (CProp
 ("equal",
  [CProp
-  ("equal",[CProp ("times",[CVar 23; CVar 24]); CProp ("zero",[])]); 
+  ("equal",[CProp ("times",[CVar 23; CVar 24]); CProp ("zero",[])]);
   CProp ("or",[CProp ("zerop",[CVar 23]); CProp ("zerop",[CVar 24])])]));
 add (CProp
 ("equal",
- [CProp ("exec",[CProp ("append",[CVar 23; CVar 24]); CVar 15; CVar 4]); 
+ [CProp ("exec",[CProp ("append",[CVar 23; CVar 24]); CVar 15; CVar 4]);
   CProp
   ("exec",[CVar 24; CProp ("exec",[CVar 23; CVar 15; CVar 4]); CVar 4])]));
 add (CProp
 ("equal",
- [CProp ("mc_flatten",[CVar 23; CVar 24]); 
+ [CProp ("mc_flatten",[CVar 23; CVar 24]);
   CProp ("append",[CProp ("flatten",[CVar 23]); CVar 24])]));
 add (CProp
 ("equal",
- [CProp ("member",[CVar 23; CProp ("append",[CVar 0; CVar 1])]); 
+ [CProp ("member",[CVar 23; CProp ("append",[CVar 0; CVar 1])]);
   CProp
   ("or",
-   [CProp ("member",[CVar 23; CVar 0]); 
+   [CProp ("member",[CVar 23; CVar 0]);
     CProp ("member",[CVar 23; CVar 1])])]));
 add (CProp
 ("equal",
- [CProp ("member",[CVar 23; CProp ("reverse",[CVar 24])]); 
+ [CProp ("member",[CVar 23; CProp ("reverse",[CVar 24])]);
   CProp ("member",[CVar 23; CVar 24])]));
 add (CProp
 ("equal",
- [CProp ("length",[CProp ("reverse",[CVar 23])]); 
+ [CProp ("length",[CProp ("reverse",[CVar 23])]);
   CProp ("length",[CVar 23])]));
 add (CProp
 ("equal",
- [CProp ("member",[CVar 0; CProp ("intersect",[CVar 1; CVar 2])]); 
+ [CProp ("member",[CVar 0; CProp ("intersect",[CVar 1; CVar 2])]);
   CProp
   ("and",
    [CProp ("member",[CVar 0; CVar 1]); CProp ("member",[CVar 0; CVar 2])])]));
@@ -351,89 +349,89 @@
 ("equal",[CProp ("nth",[CProp ("zero",[]); CVar 8]); CProp ("zero",[])]));
 add (CProp
 ("equal",
- [CProp ("exp",[CVar 8; CProp ("plus",[CVar 9; CVar 10])]); 
+ [CProp ("exp",[CVar 8; CProp ("plus",[CVar 9; CVar 10])]);
   CProp
   ("times",
    [CProp ("exp",[CVar 8; CVar 9]); CProp ("exp",[CVar 8; CVar 10])])]));
 add (CProp
 ("equal",
- [CProp ("exp",[CVar 8; CProp ("times",[CVar 9; CVar 10])]); 
+ [CProp ("exp",[CVar 8; CProp ("times",[CVar 9; CVar 10])]);
   CProp ("exp",[CProp ("exp",[CVar 8; CVar 9]); CVar 10])]));
 add (CProp
 ("equal",
- [CProp ("reverse_loop",[CVar 23; CVar 24]); 
+ [CProp ("reverse_loop",[CVar 23; CVar 24]);
   CProp ("append",[CProp ("reverse",[CVar 23]); CVar 24])]));
 add (CProp
 ("equal",
- [CProp ("reverse_loop",[CVar 23; CProp ("nil",[])]); 
+ [CProp ("reverse_loop",[CVar 23; CProp ("nil",[])]);
   CProp ("reverse",[CVar 23])]));
 add (CProp
 ("equal",
- [CProp ("count_list",[CVar 25; CProp ("sort_lp",[CVar 23; CVar 24])]); 
+ [CProp ("count_list",[CVar 25; CProp ("sort_lp",[CVar 23; CVar 24])]);
   CProp
   ("plus",
-   [CProp ("count_list",[CVar 25; CVar 23]); 
+   [CProp ("count_list",[CVar 25; CVar 23]);
     CProp ("count_list",[CVar 25; CVar 24])])]));
 add (CProp
 ("equal",
  [CProp
   ("equal",
-   [CProp ("append",[CVar 0; CVar 1]); CProp ("append",[CVar 0; CVar 2])]); 
+   [CProp ("append",[CVar 0; CVar 1]); CProp ("append",[CVar 0; CVar 2])]);
   CProp ("equal",[CVar 1; CVar 2])]));
 add (CProp
 ("equal",
  [CProp
   ("plus",
-   [CProp ("remainder",[CVar 23; CVar 24]); 
-    CProp ("times",[CVar 24; CProp ("quotient",[CVar 23; CVar 24])])]); 
+   [CProp ("remainder",[CVar 23; CVar 24]);
+    CProp ("times",[CVar 24; CProp ("quotient",[CVar 23; CVar 24])])]);
   CProp ("fix",[CVar 23])]));
 add (CProp
 ("equal",
  [CProp
-  ("power_eval",[CProp ("big_plus",[CVar 11; CVar 8; CVar 1]); CVar 1]); 
+  ("power_eval",[CProp ("big_plus",[CVar 11; CVar 8; CVar 1]); CVar 1]);
   CProp ("plus",[CProp ("power_eval",[CVar 11; CVar 1]); CVar 8])]));
 add (CProp
 ("equal",
  [CProp
   ("power_eval",
-   [CProp ("big_plus",[CVar 23; CVar 24; CVar 8; CVar 1]); CVar 1]); 
+   [CProp ("big_plus",[CVar 23; CVar 24; CVar 8; CVar 1]); CVar 1]);
   CProp
   ("plus",
-   [CVar 8; 
+   [CVar 8;
     CProp
     ("plus",
-     [CProp ("power_eval",[CVar 23; CVar 1]); 
+     [CProp ("power_eval",[CVar 23; CVar 1]);
       CProp ("power_eval",[CVar 24; CVar 1])])])]));
 add (CProp
 ("equal",
  [CProp ("remainder",[CVar 24; CProp ("one",[])]); CProp ("zero",[])]));
 add (CProp
 ("equal",
- [CProp ("lt",[CProp ("remainder",[CVar 23; CVar 24]); CVar 24]); 
+ [CProp ("lt",[CProp ("remainder",[CVar 23; CVar 24]); CVar 24]);
   CProp ("not",[CProp ("zerop",[CVar 24])])]));
 add (CProp
 ("equal",[CProp ("remainder",[CVar 23; CVar 23]); CProp ("zero",[])]));
 add (CProp
 ("equal",
- [CProp ("lt",[CProp ("quotient",[CVar 8; CVar 9]); CVar 8]); 
+ [CProp ("lt",[CProp ("quotient",[CVar 8; CVar 9]); CVar 8]);
   CProp
   ("and",
-   [CProp ("not",[CProp ("zerop",[CVar 8])]); 
+   [CProp ("not",[CProp ("zerop",[CVar 8])]);
     CProp
     ("or",
-     [CProp ("zerop",[CVar 9]); 
+     [CProp ("zerop",[CVar 9]);
       CProp ("not",[CProp ("equal",[CVar 9; CProp ("one",[])])])])])]));
 add (CProp
 ("equal",
- [CProp ("lt",[CProp ("remainder",[CVar 23; CVar 24]); CVar 23]); 
+ [CProp ("lt",[CProp ("remainder",[CVar 23; CVar 24]); CVar 23]);
   CProp
   ("and",
-   [CProp ("not",[CProp ("zerop",[CVar 24])]); 
-    CProp ("not",[CProp ("zerop",[CVar 23])]); 
+   [CProp ("not",[CProp ("zerop",[CVar 24])]);
+    CProp ("not",[CProp ("zerop",[CVar 23])]);
     CProp ("not",[CProp ("lt",[CVar 23; CVar 24])])])]));
 add (CProp
 ("equal",
- [CProp ("power_eval",[CProp ("power_rep",[CVar 8; CVar 1]); CVar 1]); 
+ [CProp ("power_eval",[CProp ("power_rep",[CVar 8; CVar 1]); CVar 1]);
   CProp ("fix",[CVar 8])]));
 add (CProp
 ("equal",
@@ -441,199 +439,199 @@
   ("power_eval",
    [CProp
     ("big_plus",
-     [CProp ("power_rep",[CVar 8; CVar 1]); 
-      CProp ("power_rep",[CVar 9; CVar 1]); CProp ("zero",[]); 
-      CVar 1]); 
-    CVar 1]); 
+     [CProp ("power_rep",[CVar 8; CVar 1]);
+      CProp ("power_rep",[CVar 9; CVar 1]); CProp ("zero",[]);
+      CVar 1]);
+    CVar 1]);
   CProp ("plus",[CVar 8; CVar 9])]));
 add (CProp
 ("equal",
  [CProp ("gcd",[CVar 23; CVar 24]); CProp ("gcd",[CVar 24; CVar 23])]));
 add (CProp
 ("equal",
- [CProp ("nth",[CProp ("append",[CVar 0; CVar 1]); CVar 8]); 
+ [CProp ("nth",[CProp ("append",[CVar 0; CVar 1]); CVar 8]);
   CProp
   ("append",
-   [CProp ("nth",[CVar 0; CVar 8]); 
+   [CProp ("nth",[CVar 0; CVar 8]);
     CProp
     ("nth",
      [CVar 1; CProp ("difference",[CVar 8; CProp ("length",[CVar 0])])])])]));
 add (CProp
 ("equal",
- [CProp ("difference",[CProp ("plus",[CVar 23; CVar 24]); CVar 23]); 
+ [CProp ("difference",[CProp ("plus",[CVar 23; CVar 24]); CVar 23]);
   CProp ("fix",[CVar 24])]));
 add (CProp
 ("equal",
- [CProp ("difference",[CProp ("plus",[CVar 24; CVar 23]); CVar 23]); 
+ [CProp ("difference",[CProp ("plus",[CVar 24; CVar 23]); CVar 23]);
   CProp ("fix",[CVar 24])]));
 add (CProp
 ("equal",
  [CProp
   ("difference",
-   [CProp ("plus",[CVar 23; CVar 24]); CProp ("plus",[CVar 23; CVar 25])]); 
+   [CProp ("plus",[CVar 23; CVar 24]); CProp ("plus",[CVar 23; CVar 25])]);
   CProp ("difference",[CVar 24; CVar 25])]));
 add (CProp
 ("equal",
- [CProp ("times",[CVar 23; CProp ("difference",[CVar 2; CVar 22])]); 
+ [CProp ("times",[CVar 23; CProp ("difference",[CVar 2; CVar 22])]);
   CProp
   ("difference",
-   [CProp ("times",[CVar 2; CVar 23]); 
+   [CProp ("times",[CVar 2; CVar 23]);
     CProp ("times",[CVar 22; CVar 23])])]));
 add (CProp
 ("equal",
- [CProp ("remainder",[CProp ("times",[CVar 23; CVar 25]); CVar 25]); 
+ [CProp ("remainder",[CProp ("times",[CVar 23; CVar 25]); CVar 25]);
   CProp ("zero",[])]));
 add (CProp
 ("equal",
  [CProp
   ("difference",
-   [CProp ("plus",[CVar 1; CProp ("plus",[CVar 0; CVar 2])]); CVar 0]); 
+   [CProp ("plus",[CVar 1; CProp ("plus",[CVar 0; CVar 2])]); CVar 0]);
   CProp ("plus",[CVar 1; CVar 2])]));
 add (CProp
 ("equal",
  [CProp
   ("difference",
-   [CProp ("add1",[CProp ("plus",[CVar 24; CVar 25])]); CVar 25]); 
+   [CProp ("add1",[CProp ("plus",[CVar 24; CVar 25])]); CVar 25]);
   CProp ("add1",[CVar 24])]));
 add (CProp
 ("equal",
  [CProp
   ("lt",
-   [CProp ("plus",[CVar 23; CVar 24]); CProp ("plus",[CVar 23; CVar 25])]); 
+   [CProp ("plus",[CVar 23; CVar 24]); CProp ("plus",[CVar 23; CVar 25])]);
   CProp ("lt",[CVar 24; CVar 25])]));
 add (CProp
 ("equal",
  [CProp
   ("lt",
-   [CProp ("times",[CVar 23; CVar 25]); 
-    CProp ("times",[CVar 24; CVar 25])]); 
+   [CProp ("times",[CVar 23; CVar 25]);
+    CProp ("times",[CVar 24; CVar 25])]);
   CProp
   ("and",
-   [CProp ("not",[CProp ("zerop",[CVar 25])]); 
+   [CProp ("not",[CProp ("zerop",[CVar 25])]);
     CProp ("lt",[CVar 23; CVar 24])])]));
 add (CProp
 ("equal",
- [CProp ("lt",[CVar 24; CProp ("plus",[CVar 23; CVar 24])]); 
+ [CProp ("lt",[CVar 24; CProp ("plus",[CVar 23; CVar 24])]);
   CProp ("not",[CProp ("zerop",[CVar 23])])]));
 add (CProp
 ("equal",
  [CProp
   ("gcd",
-   [CProp ("times",[CVar 23; CVar 25]); 
-    CProp ("times",[CVar 24; CVar 25])]); 
+   [CProp ("times",[CVar 23; CVar 25]);
+    CProp ("times",[CVar 24; CVar 25])]);
   CProp ("times",[CVar 25; CProp ("gcd",[CVar 23; CVar 24])])]));
 add (CProp
 ("equal",
- [CProp ("value",[CProp ("normalize",[CVar 23]); CVar 0]); 
+ [CProp ("value",[CProp ("normalize",[CVar 23]); CVar 0]);
   CProp ("value",[CVar 23; CVar 0])]));
 add (CProp
 ("equal",
  [CProp
   ("equal",
-   [CProp ("flatten",[CVar 23]); 
-    CProp ("cons",[CVar 24; CProp ("nil",[])])]); 
+   [CProp ("flatten",[CVar 23]);
+    CProp ("cons",[CVar 24; CProp ("nil",[])])]);
   CProp
   ("and",
    [CProp ("nlistp",[CVar 23]); CProp ("equal",[CVar 23; CVar 24])])]));
 add (CProp
 ("equal",
- [CProp ("listp",[CProp ("gother",[CVar 23])]); 
+ [CProp ("listp",[CProp ("gother",[CVar 23])]);
   CProp ("listp",[CVar 23])]));
 add (CProp
 ("equal",
- [CProp ("samefringe",[CVar 23; CVar 24]); 
+ [CProp ("samefringe",[CVar 23; CVar 24]);
   CProp
   ("equal",[CProp ("flatten",[CVar 23]); CProp ("flatten",[CVar 24])])]));
 add (CProp
 ("equal",
  [CProp
   ("equal",
-   [CProp ("greatest_factor",[CVar 23; CVar 24]); CProp ("zero",[])]); 
+   [CProp ("greatest_factor",[CVar 23; CVar 24]); CProp ("zero",[])]);
   CProp
   ("and",
    [CProp
     ("or",
-     [CProp ("zerop",[CVar 24]); 
-      CProp ("equal",[CVar 24; CProp ("one",[])])]); 
+     [CProp ("zerop",[CVar 24]);
+      CProp ("equal",[CVar 24; CProp ("one",[])])]);
     CProp ("equal",[CVar 23; CProp ("zero",[])])])]));
 add (CProp
 ("equal",
  [CProp
   ("equal",
-   [CProp ("greatest_factor",[CVar 23; CVar 24]); CProp ("one",[])]); 
+   [CProp ("greatest_factor",[CVar 23; CVar 24]); CProp ("one",[])]);
   CProp ("equal",[CVar 23; CProp ("one",[])])]));
 add (CProp
 ("equal",
- [CProp ("numberp",[CProp ("greatest_factor",[CVar 23; CVar 24])]); 
+ [CProp ("numberp",[CProp ("greatest_factor",[CVar 23; CVar 24])]);
   CProp
   ("not",
    [CProp
     ("and",
      [CProp
       ("or",
-       [CProp ("zerop",[CVar 24]); 
-        CProp ("equal",[CVar 24; CProp ("one",[])])]); 
+       [CProp ("zerop",[CVar 24]);
+        CProp ("equal",[CVar 24; CProp ("one",[])])]);
       CProp ("not",[CProp ("numberp",[CVar 23])])])])]));
 add (CProp
 ("equal",
- [CProp ("times_list",[CProp ("append",[CVar 23; CVar 24])]); 
+ [CProp ("times_list",[CProp ("append",[CVar 23; CVar 24])]);
   CProp
   ("times",
    [CProp ("times_list",[CVar 23]); CProp ("times_list",[CVar 24])])]));
 add (CProp
 ("equal",
- [CProp ("prime_list",[CProp ("append",[CVar 23; CVar 24])]); 
+ [CProp ("prime_list",[CProp ("append",[CVar 23; CVar 24])]);
   CProp
   ("and",
    [CProp ("prime_list",[CVar 23]); CProp ("prime_list",[CVar 24])])]));
 add (CProp
 ("equal",
- [CProp ("equal",[CVar 25; CProp ("times",[CVar 22; CVar 25])]); 
+ [CProp ("equal",[CVar 25; CProp ("times",[CVar 22; CVar 25])]);
   CProp
   ("and",
-   [CProp ("numberp",[CVar 25]); 
+   [CProp ("numberp",[CVar 25]);
     CProp
     ("or",
-     [CProp ("equal",[CVar 25; CProp ("zero",[])]); 
+     [CProp ("equal",[CVar 25; CProp ("zero",[])]);
       CProp ("equal",[CVar 22; CProp ("one",[])])])])]));
 add (CProp
 ("equal",
- [CProp ("ge",[CVar 23; CVar 24]); 
+ [CProp ("ge",[CVar 23; CVar 24]);
   CProp ("not",[CProp ("lt",[CVar 23; CVar 24])])]));
 add (CProp
 ("equal",
- [CProp ("equal",[CVar 23; CProp ("times",[CVar 23; CVar 24])]); 
+ [CProp ("equal",[CVar 23; CProp ("times",[CVar 23; CVar 24])]);
   CProp
   ("or",
-   [CProp ("equal",[CVar 23; CProp ("zero",[])]); 
+   [CProp ("equal",[CVar 23; CProp ("zero",[])]);
     CProp
     ("and",
-     [CProp ("numberp",[CVar 23]); 
+     [CProp ("numberp",[CVar 23]);
       CProp ("equal",[CVar 24; CProp ("one",[])])])])]));
 add (CProp
 ("equal",
- [CProp ("remainder",[CProp ("times",[CVar 24; CVar 23]); CVar 24]); 
+ [CProp ("remainder",[CProp ("times",[CVar 24; CVar 23]); CVar 24]);
   CProp ("zero",[])]));
 add (CProp
 ("equal",
- [CProp ("equal",[CProp ("times",[CVar 0; CVar 1]); CProp ("one",[])]); 
+ [CProp ("equal",[CProp ("times",[CVar 0; CVar 1]); CProp ("one",[])]);
   CProp
   ("and",
-   [CProp ("not",[CProp ("equal",[CVar 0; CProp ("zero",[])])]); 
-    CProp ("not",[CProp ("equal",[CVar 1; CProp ("zero",[])])]); 
-    CProp ("numberp",[CVar 0]); CProp ("numberp",[CVar 1]); 
-    CProp ("equal",[CProp ("sub1",[CVar 0]); CProp ("zero",[])]); 
+   [CProp ("not",[CProp ("equal",[CVar 0; CProp ("zero",[])])]);
+    CProp ("not",[CProp ("equal",[CVar 1; CProp ("zero",[])])]);
+    CProp ("numberp",[CVar 0]); CProp ("numberp",[CVar 1]);
+    CProp ("equal",[CProp ("sub1",[CVar 0]); CProp ("zero",[])]);
     CProp ("equal",[CProp ("sub1",[CVar 1]); CProp ("zero",[])])])]));
 add (CProp
 ("equal",
  [CProp
   ("lt",
-   [CProp ("length",[CProp ("delete",[CVar 23; CVar 11])]); 
-    CProp ("length",[CVar 11])]); 
+   [CProp ("length",[CProp ("delete",[CVar 23; CVar 11])]);
+    CProp ("length",[CVar 11])]);
   CProp ("member",[CVar 23; CVar 11])]));
 add (CProp
 ("equal",
- [CProp ("sort2",[CProp ("delete",[CVar 23; CVar 11])]); 
+ [CProp ("sort2",[CProp ("delete",[CVar 23; CVar 11])]);
   CProp ("delete",[CVar 23; CProp ("sort2",[CVar 11])])]));
 add (CProp ("equal",[CProp ("dsort",[CVar 23]); CProp ("sort2",[CVar 23])]));
 add (CProp
@@ -642,145 +640,145 @@
   ("length",
    [CProp
     ("cons",
-     [CVar 0; 
+     [CVar 0;
       CProp
       ("cons",
-       [CVar 1; 
+       [CVar 1;
         CProp
         ("cons",
-         [CVar 2; 
+         [CVar 2;
           CProp
           ("cons",
-           [CVar 3; 
+           [CVar 3;
             CProp ("cons",[CVar 4; CProp ("cons",[CVar 5; CVar 6])])])])])])])
   ; CProp ("plus",[CProp ("six",[]); CProp ("length",[CVar 6])])]));
 add (CProp
 ("equal",
  [CProp
   ("difference",
-   [CProp ("add1",[CProp ("add1",[CVar 23])]); CProp ("two",[])]); 
+   [CProp ("add1",[CProp ("add1",[CVar 23])]); CProp ("two",[])]);
   CProp ("fix",[CVar 23])]));
 add (CProp
 ("equal",
  [CProp
   ("quotient",
-   [CProp ("plus",[CVar 23; CProp ("plus",[CVar 23; CVar 24])]); 
-    CProp ("two",[])]); 
+   [CProp ("plus",[CVar 23; CProp ("plus",[CVar 23; CVar 24])]);
+    CProp ("two",[])]);
   CProp
   ("plus",[CVar 23; CProp ("quotient",[CVar 24; CProp ("two",[])])])]));
 add (CProp
 ("equal",
- [CProp ("sigma",[CProp ("zero",[]); CVar 8]); 
+ [CProp ("sigma",[CProp ("zero",[]); CVar 8]);
   CProp
   ("quotient",
    [CProp ("times",[CVar 8; CProp ("add1",[CVar 8])]); CProp ("two",[])])]));
 add (CProp
 ("equal",
- [CProp ("plus",[CVar 23; CProp ("add1",[CVar 24])]); 
+ [CProp ("plus",[CVar 23; CProp ("add1",[CVar 24])]);
   CProp
   ("if",
-   [CProp ("numberp",[CVar 24]); 
-    CProp ("add1",[CProp ("plus",[CVar 23; CVar 24])]); 
+   [CProp ("numberp",[CVar 24]);
+    CProp ("add1",[CProp ("plus",[CVar 23; CVar 24])]);
     CProp ("add1",[CVar 23])])]));
 add (CProp
 ("equal",
  [CProp
   ("equal",
-   [CProp ("difference",[CVar 23; CVar 24]); 
-    CProp ("difference",[CVar 25; CVar 24])]); 
+   [CProp ("difference",[CVar 23; CVar 24]);
+    CProp ("difference",[CVar 25; CVar 24])]);
   CProp
   ("if",
-   [CProp ("lt",[CVar 23; CVar 24]); 
-    CProp ("not",[CProp ("lt",[CVar 24; CVar 25])]); 
+   [CProp ("lt",[CVar 23; CVar 24]);
+    CProp ("not",[CProp ("lt",[CVar 24; CVar 25])]);
     CProp
     ("if",
-     [CProp ("lt",[CVar 25; CVar 24]); 
-      CProp ("not",[CProp ("lt",[CVar 24; CVar 23])]); 
+     [CProp ("lt",[CVar 25; CVar 24]);
+      CProp ("not",[CProp ("lt",[CVar 24; CVar 23])]);
       CProp ("equal",[CProp ("fix",[CVar 23]); CProp ("fix",[CVar 25])])])])])
 );
 add (CProp
 ("equal",
  [CProp
   ("meaning",
-   [CProp ("plus_tree",[CProp ("delete",[CVar 23; CVar 24])]); CVar 0]); 
+   [CProp ("plus_tree",[CProp ("delete",[CVar 23; CVar 24])]); CVar 0]);
   CProp
   ("if",
-   [CProp ("member",[CVar 23; CVar 24]); 
+   [CProp ("member",[CVar 23; CVar 24]);
     CProp
     ("difference",
-     [CProp ("meaning",[CProp ("plus_tree",[CVar 24]); CVar 0]); 
-      CProp ("meaning",[CVar 23; CVar 0])]); 
+     [CProp ("meaning",[CProp ("plus_tree",[CVar 24]); CVar 0]);
+      CProp ("meaning",[CVar 23; CVar 0])]);
     CProp ("meaning",[CProp ("plus_tree",[CVar 24]); CVar 0])])]));
 add (CProp
 ("equal",
- [CProp ("times",[CVar 23; CProp ("add1",[CVar 24])]); 
+ [CProp ("times",[CVar 23; CProp ("add1",[CVar 24])]);
   CProp
   ("if",
-   [CProp ("numberp",[CVar 24]); 
+   [CProp ("numberp",[CVar 24]);
     CProp
     ("plus",
-     [CVar 23; CProp ("times",[CVar 23; CVar 24]); 
+     [CVar 23; CProp ("times",[CVar 23; CVar 24]);
       CProp ("fix",[CVar 23])])])]));
 add (CProp
 ("equal",
- [CProp ("nth",[CProp ("nil",[]); CVar 8]); 
+ [CProp ("nth",[CProp ("nil",[]); CVar 8]);
   CProp
   ("if",[CProp ("zerop",[CVar 8]); CProp ("nil",[]); CProp ("zero",[])])]));
 add (CProp
 ("equal",
- [CProp ("last",[CProp ("append",[CVar 0; CVar 1])]); 
+ [CProp ("last",[CProp ("append",[CVar 0; CVar 1])]);
   CProp
   ("if",
-   [CProp ("listp",[CVar 1]); CProp ("last",[CVar 1]); 
+   [CProp ("listp",[CVar 1]); CProp ("last",[CVar 1]);
     CProp
     ("if",
-     [CProp ("listp",[CVar 0]); 
-      CProp ("cons",[CProp ("car",[CProp ("last",[CVar 0])]); CVar 1]); 
+     [CProp ("listp",[CVar 0]);
+      CProp ("cons",[CProp ("car",[CProp ("last",[CVar 0])]); CVar 1]);
       CVar 1])])]));
 add (CProp
 ("equal",
- [CProp ("equal",[CProp ("lt",[CVar 23; CVar 24]); CVar 25]); 
+ [CProp ("equal",[CProp ("lt",[CVar 23; CVar 24]); CVar 25]);
   CProp
   ("if",
-   [CProp ("lt",[CVar 23; CVar 24]); 
-    CProp ("equal",[CProp ("true",[]); CVar 25]); 
+   [CProp ("lt",[CVar 23; CVar 24]);
+    CProp ("equal",[CProp ("true",[]); CVar 25]);
     CProp ("equal",[CProp ("false",[]); CVar 25])])]));
 add (CProp
 ("equal",
- [CProp ("assignment",[CVar 23; CProp ("append",[CVar 0; CVar 1])]); 
+ [CProp ("assignment",[CVar 23; CProp ("append",[CVar 0; CVar 1])]);
   CProp
   ("if",
-   [CProp ("assignedp",[CVar 23; CVar 0]); 
-    CProp ("assignment",[CVar 23; CVar 0]); 
+   [CProp ("assignedp",[CVar 23; CVar 0]);
+    CProp ("assignment",[CVar 23; CVar 0]);
     CProp ("assignment",[CVar 23; CVar 1])])]));
 add (CProp
 ("equal",
- [CProp ("car",[CProp ("gother",[CVar 23])]); 
+ [CProp ("car",[CProp ("gother",[CVar 23])]);
   CProp
   ("if",
-   [CProp ("listp",[CVar 23]); 
+   [CProp ("listp",[CVar 23]);
     CProp ("car",[CProp ("flatten",[CVar 23])]); CProp ("zero",[])])]));
 add (CProp
 ("equal",
- [CProp ("flatten",[CProp ("cdr",[CProp ("gother",[CVar 23])])]); 
+ [CProp ("flatten",[CProp ("cdr",[CProp ("gother",[CVar 23])])]);
   CProp
   ("if",
-   [CProp ("listp",[CVar 23]); 
-    CProp ("cdr",[CProp ("flatten",[CVar 23])]); 
+   [CProp ("listp",[CVar 23]);
+    CProp ("cdr",[CProp ("flatten",[CVar 23])]);
     CProp ("cons",[CProp ("zero",[]); CProp ("nil",[])])])]));
 add (CProp
 ("equal",
- [CProp ("quotient",[CProp ("times",[CVar 24; CVar 23]); CVar 24]); 
+ [CProp ("quotient",[CProp ("times",[CVar 24; CVar 23]); CVar 24]);
   CProp
   ("if",
-   [CProp ("zerop",[CVar 24]); CProp ("zero",[]); 
+   [CProp ("zerop",[CVar 24]); CProp ("zero",[]);
     CProp ("fix",[CVar 23])])]));
 add (CProp
 ("equal",
- [CProp ("get",[CVar 9; CProp ("set",[CVar 8; CVar 21; CVar 12])]); 
+ [CProp ("get",[CVar 9; CProp ("set",[CVar 8; CVar 21; CVar 12])]);
   CProp
   ("if",
-   [CProp ("eqp",[CVar 9; CVar 8]); CVar 21; 
+   [CProp ("eqp",[CVar 9; CVar 8]); CVar 21;
     CProp ("get",[CVar 9; CVar 12])])]))
 
 (* Tautology checker *)
@@ -822,7 +820,7 @@
   end
 
 
-let tautp x = 
+let tautp x =
 (*  print_term x; print_string"\n"; *)
   let y = rewrite x in
 (*    print_term y; print_string "\n"; *)
diff -Nru ocaml-3.12.1/testsuite/tests/misc/fib.ml ocaml-4.01.0/testsuite/tests/misc/fib.ml
--- ocaml-3.12.1/testsuite/tests/misc/fib.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc/fib.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,15 +10,12 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: fib.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 let rec fib n =
   if n < 2 then 1 else fib(n-1) + fib(n-2)
 
 let _ =
   let n =
-    if Array.length Sys.argv >= 2 
+    if Array.length Sys.argv >= 2
     then int_of_string Sys.argv.(1)
     else 40 in
   print_int(fib n); print_newline(); exit 0
-
diff -Nru ocaml-3.12.1/testsuite/tests/misc/hamming.ml ocaml-4.01.0/testsuite/tests/misc/hamming.ml
--- ocaml-3.12.1/testsuite/tests/misc/hamming.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc/hamming.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*          Damien Doligez, projet Moscova, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: hamming.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (* We cannot use bignums because we don't do custom runtimes, but
    int64 is a bit short, so we roll our own 37-digit numbers...
 *)
diff -Nru ocaml-3.12.1/testsuite/tests/misc/nucleic.ml ocaml-4.01.0/testsuite/tests/misc/nucleic.ml
--- ocaml-3.12.1/testsuite/tests/misc/nucleic.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc/nucleic.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: nucleic.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (* Use floating-point arithmetic *)
 
 external (+) : float -> float -> float = "%addfloat"
@@ -60,14 +58,14 @@
    matrices don't have the perspective terms and are the transpose of
    Paul's one.  See also "M\"antyl\"a, M. (1985) An Introduction to
    Solid Modeling, Computer Science Press" Appendix A.
-  
+
    The components of a transformation matrix are named like this:
-  
+
     a  b  c
     d  e  f
     g  h  i
    tx ty tz
-  
+
    The components tx, ty, and tz are the translation vector.
 *)
 
@@ -208,7 +206,7 @@
 
 (*
    Numbering of atoms follows the paper:
-  
+
    IUPAC-IUB Joint Commission on Biochemical Nomenclature (JCBN)
    (1983) Abbreviations and Symbols for the Description of
    Conformations of Polynucleotide Chains.  Eur. J. Biochem 131,
@@ -273,7 +271,7 @@
   = c1'
 
 let
-nuc_C2 
+nuc_C2
 (N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
    p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
    c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
@@ -287,7 +285,7 @@
   = c3'
 
 let
-nuc_C4 
+nuc_C4
 (N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
    p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
    c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
@@ -301,7 +299,7 @@
   = c4'
 
 let
-nuc_N1 
+nuc_N1
 (N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
    p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
    c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
@@ -2896,13 +2894,13 @@
 (* -- DOMAINS ---------------------------------------------------------------*)
 
 (* Primary structure:   strand A CUGCCACGUCUG, strand B CAGACGUGGCAG
-  
+
    Secondary structure: strand A CUGCCACGUCUG
                                  ||||||||||||
                                  GACGGUGCAGAC strand B
-  
+
    Tertiary structure:
-  
+
       5' end of strand A C1----G12 3' end of strand B
                        U2-------A11
                       G3-------C10
@@ -2915,13 +2913,13 @@
                       G3--------C10
                        A2-------U11
      5' end of strand B C1----G12 3' end of strand A
-  
+
    "helix", "stacked" and "connected" describe the spatial relationship
    between two consecutive nucleotides. E.g. the nucleotides C1 and U2
    from the strand A.
-  
+
    "wc" (stands for Watson-Crick and is a type of base-pairing),
-   and "wc-dumas" describe the spatial relationship between 
+   and "wc-dumas" describe the spatial relationship between
    nucleotides from two chains that are growing in opposite directions.
    E.g. the nucleotides C1 from strand A and G12 from strand B.
 *)
@@ -2965,7 +2963,7 @@
 reference n i partial_inst = [ mk_var i tfo_id n ]
 
 (* The transformation matrix for wc is from:
-  
+
    Chandrasekaran R. et al (1989) A Re-Examination of the Crystal
    Structure of A-DNA Using Fiber Diffraction Data. J. Biomol.
    Struct. & Dynamics 6(6):1189-1202.
@@ -3047,7 +3045,7 @@
 a38_g37 nucl i j partial_inst
   = mk_var i (dgf_base a38_g37_tfo (get_var j partial_inst) nucl) nucl
 
-let   
+let
 stacked3' nucl i j partial_inst
   = (a38_g37 nucl i j partial_inst) :: (helix3' nucl i j partial_inst)
 
@@ -3146,7 +3144,7 @@
      stacked5' rU   5  4; (*   | 4.5 Angstroms *)
      stacked5' rC   6  5  (* <-'               *)
     ]
-  
+
 (* Pseudoknot constraint *)
 
 let
@@ -3212,7 +3210,7 @@
   let max_dist = ref 0.0 in
   for i = 0 to pred (Array.length atoms) do
     let p = atoms.(i) in
-    let distance = 
+    let distance =
       let pos = absolute_pos v p
       in sqrt ((pos.x * pos.x) + (pos.y * pos.y) + (pos.z * pos.z)) in
     if distance > !max_dist then max_dist := distance
diff -Nru ocaml-3.12.1/testsuite/tests/misc/sieve.ml ocaml-4.01.0/testsuite/tests/misc/sieve.ml
--- ocaml-3.12.1/testsuite/tests/misc/sieve.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc/sieve.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: sieve.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (* Eratosthene's sieve *)
 
 (* interval min max = [min; min+1; ...; max-1; max] *)
@@ -51,6 +49,6 @@
 
 
 let _ =
-  do_list (fun n -> print_int n; print_string " ") (sieve 50000);
+  do_list (fun n -> print_string " "; print_int n) (sieve 50000);
   print_newline();
   exit 0
diff -Nru ocaml-3.12.1/testsuite/tests/misc/sieve.reference ocaml-4.01.0/testsuite/tests/misc/sieve.reference
--- ocaml-3.12.1/testsuite/tests/misc/sieve.reference	2010-01-25 14:09:53.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc/sieve.reference	2012-07-30 18:04:46.000000000 +0000
@@ -1 +1 @@
-2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947 953 967 971 977 983 991 997 1009 1013 1019 1021 1031 1033 1039 1049 1051 1061 1063 1069 1087 1091 1093 1097 1103 1109 1117 1123 1129 1151 1153 1163 1171 1181 1187 1193 1201 1213 1217 1223 1229 1231 1237 1249 1259 1277 1279 1283 1289 1291 1297 1301 1303 1307 1319 1321 1327 1361 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439 1447 1451 1453 1459 1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543 1549 1553 1559 1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627 1637 1657 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753 1759 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877 1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997 1999 2003 2011 2017 2027 2029 2039 2053 2063 2069 2081 2083 2087 2089 2099 2111 2113 2129 2131 2137 2141 2143 2153 2161 2179 2203 2207 2213 2221 2237 2239 2243 2251 2267 2269 2273 2281 2287 2293 2297 2309 2311 2333 2339 2341 2347 2351 2357 2371 2377 2381 2383 2389 2393 2399 2411 2417 2423 2437 2441 2447 2459 2467 2473 2477 2503 2521 2531 2539 2543 2549 2551 2557 2579 2591 2593 2609 2617 2621 2633 2647 2657 2659 2663 2671 2677 2683 2687 2689 2693 2699 2707 2711 2713 2719 2729 2731 2741 2749 2753 2767 2777 2789 2791 2797 2801 2803 2819 2833 2837 2843 2851 2857 2861 2879 2887 2897 2903 2909 2917 2927 2939 2953 2957 2963 2969 2971 2999 3001 3011 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089 3109 3119 3121 3137 3163 3167 3169 3181 3187 3191 3203 3209 3217 3221 3229 3251 3253 3257 3259 3271 3299 3301 3307 3313 3319 3323 3329 3331 3343 3347 3359 3361 3371 3373 3389 3391 3407 3413 3433 3449 3457 3461 3463 3467 3469 3491 3499 3511 3517 3527 3529 3533 3539 3541 3547 3557 3559 3571 3581 3583 3593 3607 3613 3617 3623 3631 3637 3643 3659 3671 3673 3677 3691 3697 3701 3709 3719 3727 3733 3739 3761 3767 3769 3779 3793 3797 3803 3821 3823 3833 3847 3851 3853 3863 3877 3881 3889 3907 3911 3917 3919 3923 3929 3931 3943 3947 3967 3989 4001 4003 4007 4013 4019 4021 4027 4049 4051 4057 4073 4079 4091 4093 4099 4111 4127 4129 4133 4139 4153 4157 4159 4177 4201 4211 4217 4219 4229 4231 4241 4243 4253 4259 4261 4271 4273 4283 4289 4297 4327 4337 4339 4349 4357 4363 4373 4391 4397 4409 4421 4423 4441 4447 4451 4457 4463 4481 4483 4493 4507 4513 4517 4519 4523 4547 4549 4561 4567 4583 4591 4597 4603 4621 4637 4639 4643 4649 4651 4657 4663 4673 4679 4691 4703 4721 4723 4729 4733 4751 4759 4783 4787 4789 4793 4799 4801 4813 4817 4831 4861 4871 4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973 4987 4993 4999 5003 5009 5011 5021 5023 5039 5051 5059 5077 5081 5087 5099 5101 5107 5113 5119 5147 5153 5167 5171 5179 5189 5197 5209 5227 5231 5233 5237 5261 5273 5279 5281 5297 5303 5309 5323 5333 5347 5351 5381 5387 5393 5399 5407 5413 5417 5419 5431 5437 5441 5443 5449 5471 5477 5479 5483 5501 5503 5507 5519 5521 5527 5531 5557 5563 5569 5573 5581 5591 5623 5639 5641 5647 5651 5653 5657 5659 5669 5683 5689 5693 5701 5711 5717 5737 5741 5743 5749 5779 5783 5791 5801 5807 5813 5821 5827 5839 5843 5849 5851 5857 5861 5867 5869 5879 5881 5897 5903 5923 5927 5939 5953 5981 5987 6007 6011 6029 6037 6043 6047 6053 6067 6073 6079 6089 6091 6101 6113 6121 6131 6133 6143 6151 6163 6173 6197 6199 6203 6211 6217 6221 6229 6247 6257 6263 6269 6271 6277 6287 6299 6301 6311 6317 6323 6329 6337 6343 6353 6359 6361 6367 6373 6379 6389 6397 6421 6427 6449 6451 6469 6473 6481 6491 6521 6529 6547 6551 6553 6563 6569 6571 6577 6581 6599 6607 6619 6637 6653 6659 6661 6673 6679 6689 6691 6701 6703 6709 6719 6733 6737 6761 6763 6779 6781 6791 6793 6803 6823 6827 6829 6833 6841 6857 6863 6869 6871 6883 6899 6907 6911 6917 6947 6949 6959 6961 6967 6971 6977 6983 6991 6997 7001 7013 7019 7027 7039 7043 7057 7069 7079 7103 7109 7121 7127 7129 7151 7159 7177 7187 7193 7207 7211 7213 7219 7229 7237 7243 7247 7253 7283 7297 7307 7309 7321 7331 7333 7349 7351 7369 7393 7411 7417 7433 7451 7457 7459 7477 7481 7487 7489 7499 7507 7517 7523 7529 7537 7541 7547 7549 7559 7561 7573 7577 7583 7589 7591 7603 7607 7621 7639 7643 7649 7669 7673 7681 7687 7691 7699 7703 7717 7723 7727 7741 7753 7757 7759 7789 7793 7817 7823 7829 7841 7853 7867 7873 7877 7879 7883 7901 7907 7919 7927 7933 7937 7949 7951 7963 7993 8009 8011 8017 8039 8053 8059 8069 8081 8087 8089 8093 8101 8111 8117 8123 8147 8161 8167 8171 8179 8191 8209 8219 8221 8231 8233 8237 8243 8263 8269 8273 8287 8291 8293 8297 8311 8317 8329 8353 8363 8369 8377 8387 8389 8419 8423 8429 8431 8443 8447 8461 8467 8501 8513 8521 8527 8537 8539 8543 8563 8573 8581 8597 8599 8609 8623 8627 8629 8641 8647 8663 8669 8677 8681 8689 8693 8699 8707 8713 8719 8731 8737 8741 8747 8753 8761 8779 8783 8803 8807 8819 8821 8831 8837 8839 8849 8861 8863 8867 8887 8893 8923 8929 8933 8941 8951 8963 8969 8971 8999 9001 9007 9011 9013 9029 9041 9043 9049 9059 9067 9091 9103 9109 9127 9133 9137 9151 9157 9161 9173 9181 9187 9199 9203 9209 9221 9227 9239 9241 9257 9277 9281 9283 9293 9311 9319 9323 9337 9341 9343 9349 9371 9377 9391 9397 9403 9413 9419 9421 9431 9433 9437 9439 9461 9463 9467 9473 9479 9491 9497 9511 9521 9533 9539 9547 9551 9587 9601 9613 9619 9623 9629 9631 9643 9649 9661 9677 9679 9689 9697 9719 9721 9733 9739 9743 9749 9767 9769 9781 9787 9791 9803 9811 9817 9829 9833 9839 9851 9857 9859 9871 9883 9887 9901 9907 9923 9929 9931 9941 9949 9967 9973 10007 10009 10037 10039 10061 10067 10069 10079 10091 10093 10099 10103 10111 10133 10139 10141 10151 10159 10163 10169 10177 10181 10193 10211 10223 10243 10247 10253 10259 10267 10271 10273 10289 10301 10303 10313 10321 10331 10333 10337 10343 10357 10369 10391 10399 10427 10429 10433 10453 10457 10459 10463 10477 10487 10499 10501 10513 10529 10531 10559 10567 10589 10597 10601 10607 10613 10627 10631 10639 10651 10657 10663 10667 10687 10691 10709 10711 10723 10729 10733 10739 10753 10771 10781 10789 10799 10831 10837 10847 10853 10859 10861 10867 10883 10889 10891 10903 10909 10937 10939 10949 10957 10973 10979 10987 10993 11003 11027 11047 11057 11059 11069 11071 11083 11087 11093 11113 11117 11119 11131 11149 11159 11161 11171 11173 11177 11197 11213 11239 11243 11251 11257 11261 11273 11279 11287 11299 11311 11317 11321 11329 11351 11353 11369 11383 11393 11399 11411 11423 11437 11443 11447 11467 11471 11483 11489 11491 11497 11503 11519 11527 11549 11551 11579 11587 11593 11597 11617 11621 11633 11657 11677 11681 11689 11699 11701 11717 11719 11731 11743 11777 11779 11783 11789 11801 11807 11813 11821 11827 11831 11833 11839 11863 11867 11887 11897 11903 11909 11923 11927 11933 11939 11941 11953 11959 11969 11971 11981 11987 12007 12011 12037 12041 12043 12049 12071 12073 12097 12101 12107 12109 12113 12119 12143 12149 12157 12161 12163 12197 12203 12211 12227 12239 12241 12251 12253 12263 12269 12277 12281 12289 12301 12323 12329 12343 12347 12373 12377 12379 12391 12401 12409 12413 12421 12433 12437 12451 12457 12473 12479 12487 12491 12497 12503 12511 12517 12527 12539 12541 12547 12553 12569 12577 12583 12589 12601 12611 12613 12619 12637 12641 12647 12653 12659 12671 12689 12697 12703 12713 12721 12739 12743 12757 12763 12781 12791 12799 12809 12821 12823 12829 12841 12853 12889 12893 12899 12907 12911 12917 12919 12923 12941 12953 12959 12967 12973 12979 12983 13001 13003 13007 13009 13033 13037 13043 13049 13063 13093 13099 13103 13109 13121 13127 13147 13151 13159 13163 13171 13177 13183 13187 13217 13219 13229 13241 13249 13259 13267 13291 13297 13309 13313 13327 13331 13337 13339 13367 13381 13397 13399 13411 13417 13421 13441 13451 13457 13463 13469 13477 13487 13499 13513 13523 13537 13553 13567 13577 13591 13597 13613 13619 13627 13633 13649 13669 13679 13681 13687 13691 13693 13697 13709 13711 13721 13723 13729 13751 13757 13759 13763 13781 13789 13799 13807 13829 13831 13841 13859 13873 13877 13879 13883 13901 13903 13907 13913 13921 13931 13933 13963 13967 13997 13999 14009 14011 14029 14033 14051 14057 14071 14081 14083 14087 14107 14143 14149 14153 14159 14173 14177 14197 14207 14221 14243 14249 14251 14281 14293 14303 14321 14323 14327 14341 14347 14369 14387 14389 14401 14407 14411 14419 14423 14431 14437 14447 14449 14461 14479 14489 14503 14519 14533 14537 14543 14549 14551 14557 14561 14563 14591 14593 14621 14627 14629 14633 14639 14653 14657 14669 14683 14699 14713 14717 14723 14731 14737 14741 14747 14753 14759 14767 14771 14779 14783 14797 14813 14821 14827 14831 14843 14851 14867 14869 14879 14887 14891 14897 14923 14929 14939 14947 14951 14957 14969 14983 15013 15017 15031 15053 15061 15073 15077 15083 15091 15101 15107 15121 15131 15137 15139 15149 15161 15173 15187 15193 15199 15217 15227 15233 15241 15259 15263 15269 15271 15277 15287 15289 15299 15307 15313 15319 15329 15331 15349 15359 15361 15373 15377 15383 15391 15401 15413 15427 15439 15443 15451 15461 15467 15473 15493 15497 15511 15527 15541 15551 15559 15569 15581 15583 15601 15607 15619 15629 15641 15643 15647 15649 15661 15667 15671 15679 15683 15727 15731 15733 15737 15739 15749 15761 15767 15773 15787 15791 15797 15803 15809 15817 15823 15859 15877 15881 15887 15889 15901 15907 15913 15919 15923 15937 15959 15971 15973 15991 16001 16007 16033 16057 16061 16063 16067 16069 16073 16087 16091 16097 16103 16111 16127 16139 16141 16183 16187 16189 16193 16217 16223 16229 16231 16249 16253 16267 16273 16301 16319 16333 16339 16349 16361 16363 16369 16381 16411 16417 16421 16427 16433 16447 16451 16453 16477 16481 16487 16493 16519 16529 16547 16553 16561 16567 16573 16603 16607 16619 16631 16633 16649 16651 16657 16661 16673 16691 16693 16699 16703 16729 16741 16747 16759 16763 16787 16811 16823 16829 16831 16843 16871 16879 16883 16889 16901 16903 16921 16927 16931 16937 16943 16963 16979 16981 16987 16993 17011 17021 17027 17029 17033 17041 17047 17053 17077 17093 17099 17107 17117 17123 17137 17159 17167 17183 17189 17191 17203 17207 17209 17231 17239 17257 17291 17293 17299 17317 17321 17327 17333 17341 17351 17359 17377 17383 17387 17389 17393 17401 17417 17419 17431 17443 17449 17467 17471 17477 17483 17489 17491 17497 17509 17519 17539 17551 17569 17573 17579 17581 17597 17599 17609 17623 17627 17657 17659 17669 17681 17683 17707 17713 17729 17737 17747 17749 17761 17783 17789 17791 17807 17827 17837 17839 17851 17863 17881 17891 17903 17909 17911 17921 17923 17929 17939 17957 17959 17971 17977 17981 17987 17989 18013 18041 18043 18047 18049 18059 18061 18077 18089 18097 18119 18121 18127 18131 18133 18143 18149 18169 18181 18191 18199 18211 18217 18223 18229 18233 18251 18253 18257 18269 18287 18289 18301 18307 18311 18313 18329 18341 18353 18367 18371 18379 18397 18401 18413 18427 18433 18439 18443 18451 18457 18461 18481 18493 18503 18517 18521 18523 18539 18541 18553 18583 18587 18593 18617 18637 18661 18671 18679 18691 18701 18713 18719 18731 18743 18749 18757 18773 18787 18793 18797 18803 18839 18859 18869 18899 18911 18913 18917 18919 18947 18959 18973 18979 19001 19009 19013 19031 19037 19051 19069 19073 19079 19081 19087 19121 19139 19141 19157 19163 19181 19183 19207 19211 19213 19219 19231 19237 19249 19259 19267 19273 19289 19301 19309 19319 19333 19373 19379 19381 19387 19391 19403 19417 19421 19423 19427 19429 19433 19441 19447 19457 19463 19469 19471 19477 19483 19489 19501 19507 19531 19541 19543 19553 19559 19571 19577 19583 19597 19603 19609 19661 19681 19687 19697 19699 19709 19717 19727 19739 19751 19753 19759 19763 19777 19793 19801 19813 19819 19841 19843 19853 19861 19867 19889 19891 19913 19919 19927 19937 19949 19961 19963 19973 19979 19991 19993 19997 20011 20021 20023 20029 20047 20051 20063 20071 20089 20101 20107 20113 20117 20123 20129 20143 20147 20149 20161 20173 20177 20183 20201 20219 20231 20233 20249 20261 20269 20287 20297 20323 20327 20333 20341 20347 20353 20357 20359 20369 20389 20393 20399 20407 20411 20431 20441 20443 20477 20479 20483 20507 20509 20521 20533 20543 20549 20551 20563 20593 20599 20611 20627 20639 20641 20663 20681 20693 20707 20717 20719 20731 20743 20747 20749 20753 20759 20771 20773 20789 20807 20809 20849 20857 20873 20879 20887 20897 20899 20903 20921 20929 20939 20947 20959 20963 20981 20983 21001 21011 21013 21017 21019 21023 21031 21059 21061 21067 21089 21101 21107 21121 21139 21143 21149 21157 21163 21169 21179 21187 21191 21193 21211 21221 21227 21247 21269 21277 21283 21313 21317 21319 21323 21341 21347 21377 21379 21383 21391 21397 21401 21407 21419 21433 21467 21481 21487 21491 21493 21499 21503 21517 21521 21523 21529 21557 21559 21563 21569 21577 21587 21589 21599 21601 21611 21613 21617 21647 21649 21661 21673 21683 21701 21713 21727 21737 21739 21751 21757 21767 21773 21787 21799 21803 21817 21821 21839 21841 21851 21859 21863 21871 21881 21893 21911 21929 21937 21943 21961 21977 21991 21997 22003 22013 22027 22031 22037 22039 22051 22063 22067 22073 22079 22091 22093 22109 22111 22123 22129 22133 22147 22153 22157 22159 22171 22189 22193 22229 22247 22259 22271 22273 22277 22279 22283 22291 22303 22307 22343 22349 22367 22369 22381 22391 22397 22409 22433 22441 22447 22453 22469 22481 22483 22501 22511 22531 22541 22543 22549 22567 22571 22573 22613 22619 22621 22637 22639 22643 22651 22669 22679 22691 22697 22699 22709 22717 22721 22727 22739 22741 22751 22769 22777 22783 22787 22807 22811 22817 22853 22859 22861 22871 22877 22901 22907 22921 22937 22943 22961 22963 22973 22993 23003 23011 23017 23021 23027 23029 23039 23041 23053 23057 23059 23063 23071 23081 23087 23099 23117 23131 23143 23159 23167 23173 23189 23197 23201 23203 23209 23227 23251 23269 23279 23291 23293 23297 23311 23321 23327 23333 23339 23357 23369 23371 23399 23417 23431 23447 23459 23473 23497 23509 23531 23537 23539 23549 23557 23561 23563 23567 23581 23593 23599 23603 23609 23623 23627 23629 23633 23663 23669 23671 23677 23687 23689 23719 23741 23743 23747 23753 23761 23767 23773 23789 23801 23813 23819 23827 23831 23833 23857 23869 23873 23879 23887 23893 23899 23909 23911 23917 23929 23957 23971 23977 23981 23993 24001 24007 24019 24023 24029 24043 24049 24061 24071 24077 24083 24091 24097 24103 24107 24109 24113 24121 24133 24137 24151 24169 24179 24181 24197 24203 24223 24229 24239 24247 24251 24281 24317 24329 24337 24359 24371 24373 24379 24391 24407 24413 24419 24421 24439 24443 24469 24473 24481 24499 24509 24517 24527 24533 24547 24551 24571 24593 24611 24623 24631 24659 24671 24677 24683 24691 24697 24709 24733 24749 24763 24767 24781 24793 24799 24809 24821 24841 24847 24851 24859 24877 24889 24907 24917 24919 24923 24943 24953 24967 24971 24977 24979 24989 25013 25031 25033 25037 25057 25073 25087 25097 25111 25117 25121 25127 25147 25153 25163 25169 25171 25183 25189 25219 25229 25237 25243 25247 25253 25261 25301 25303 25307 25309 25321 25339 25343 25349 25357 25367 25373 25391 25409 25411 25423 25439 25447 25453 25457 25463 25469 25471 25523 25537 25541 25561 25577 25579 25583 25589 25601 25603 25609 25621 25633 25639 25643 25657 25667 25673 25679 25693 25703 25717 25733 25741 25747 25759 25763 25771 25793 25799 25801 25819 25841 25847 25849 25867 25873 25889 25903 25913 25919 25931 25933 25939 25943 25951 25969 25981 25997 25999 26003 26017 26021 26029 26041 26053 26083 26099 26107 26111 26113 26119 26141 26153 26161 26171 26177 26183 26189 26203 26209 26227 26237 26249 26251 26261 26263 26267 26293 26297 26309 26317 26321 26339 26347 26357 26371 26387 26393 26399 26407 26417 26423 26431 26437 26449 26459 26479 26489 26497 26501 26513 26539 26557 26561 26573 26591 26597 26627 26633 26641 26647 26669 26681 26683 26687 26693 26699 26701 26711 26713 26717 26723 26729 26731 26737 26759 26777 26783 26801 26813 26821 26833 26839 26849 26861 26863 26879 26881 26891 26893 26903 26921 26927 26947 26951 26953 26959 26981 26987 26993 27011 27017 27031 27043 27059 27061 27067 27073 27077 27091 27103 27107 27109 27127 27143 27179 27191 27197 27211 27239 27241 27253 27259 27271 27277 27281 27283 27299 27329 27337 27361 27367 27397 27407 27409 27427 27431 27437 27449 27457 27479 27481 27487 27509 27527 27529 27539 27541 27551 27581 27583 27611 27617 27631 27647 27653 27673 27689 27691 27697 27701 27733 27737 27739 27743 27749 27751 27763 27767 27773 27779 27791 27793 27799 27803 27809 27817 27823 27827 27847 27851 27883 27893 27901 27917 27919 27941 27943 27947 27953 27961 27967 27983 27997 28001 28019 28027 28031 28051 28057 28069 28081 28087 28097 28099 28109 28111 28123 28151 28163 28181 28183 28201 28211 28219 28229 28277 28279 28283 28289 28297 28307 28309 28319 28349 28351 28387 28393 28403 28409 28411 28429 28433 28439 28447 28463 28477 28493 28499 28513 28517 28537 28541 28547 28549 28559 28571 28573 28579 28591 28597 28603 28607 28619 28621 28627 28631 28643 28649 28657 28661 28663 28669 28687 28697 28703 28711 28723 28729 28751 28753 28759 28771 28789 28793 28807 28813 28817 28837 28843 28859 28867 28871 28879 28901 28909 28921 28927 28933 28949 28961 28979 29009 29017 29021 29023 29027 29033 29059 29063 29077 29101 29123 29129 29131 29137 29147 29153 29167 29173 29179 29191 29201 29207 29209 29221 29231 29243 29251 29269 29287 29297 29303 29311 29327 29333 29339 29347 29363 29383 29387 29389 29399 29401 29411 29423 29429 29437 29443 29453 29473 29483 29501 29527 29531 29537 29567 29569 29573 29581 29587 29599 29611 29629 29633 29641 29663 29669 29671 29683 29717 29723 29741 29753 29759 29761 29789 29803 29819 29833 29837 29851 29863 29867 29873 29879 29881 29917 29921 29927 29947 29959 29983 29989 30011 30013 30029 30047 30059 30071 30089 30091 30097 30103 30109 30113 30119 30133 30137 30139 30161 30169 30181 30187 30197 30203 30211 30223 30241 30253 30259 30269 30271 30293 30307 30313 30319 30323 30341 30347 30367 30389 30391 30403 30427 30431 30449 30467 30469 30491 30493 30497 30509 30517 30529 30539 30553 30557 30559 30577 30593 30631 30637 30643 30649 30661 30671 30677 30689 30697 30703 30707 30713 30727 30757 30763 30773 30781 30803 30809 30817 30829 30839 30841 30851 30853 30859 30869 30871 30881 30893 30911 30931 30937 30941 30949 30971 30977 30983 31013 31019 31033 31039 31051 31063 31069 31079 31081 31091 31121 31123 31139 31147 31151 31153 31159 31177 31181 31183 31189 31193 31219 31223 31231 31237 31247 31249 31253 31259 31267 31271 31277 31307 31319 31321 31327 31333 31337 31357 31379 31387 31391 31393 31397 31469 31477 31481 31489 31511 31513 31517 31531 31541 31543 31547 31567 31573 31583 31601 31607 31627 31643 31649 31657 31663 31667 31687 31699 31721 31723 31727 31729 31741 31751 31769 31771 31793 31799 31817 31847 31849 31859 31873 31883 31891 31907 31957 31963 31973 31981 31991 32003 32009 32027 32029 32051 32057 32059 32063 32069 32077 32083 32089 32099 32117 32119 32141 32143 32159 32173 32183 32189 32191 32203 32213 32233 32237 32251 32257 32261 32297 32299 32303 32309 32321 32323 32327 32341 32353 32359 32363 32369 32371 32377 32381 32401 32411 32413 32423 32429 32441 32443 32467 32479 32491 32497 32503 32507 32531 32533 32537 32561 32563 32569 32573 32579 32587 32603 32609 32611 32621 32633 32647 32653 32687 32693 32707 32713 32717 32719 32749 32771 32779 32783 32789 32797 32801 32803 32831 32833 32839 32843 32869 32887 32909 32911 32917 32933 32939 32941 32957 32969 32971 32983 32987 32993 32999 33013 33023 33029 33037 33049 33053 33071 33073 33083 33091 33107 33113 33119 33149 33151 33161 33179 33181 33191 33199 33203 33211 33223 33247 33287 33289 33301 33311 33317 33329 33331 33343 33347 33349 33353 33359 33377 33391 33403 33409 33413 33427 33457 33461 33469 33479 33487 33493 33503 33521 33529 33533 33547 33563 33569 33577 33581 33587 33589 33599 33601 33613 33617 33619 33623 33629 33637 33641 33647 33679 33703 33713 33721 33739 33749 33751 33757 33767 33769 33773 33791 33797 33809 33811 33827 33829 33851 33857 33863 33871 33889 33893 33911 33923 33931 33937 33941 33961 33967 33997 34019 34031 34033 34039 34057 34061 34123 34127 34129 34141 34147 34157 34159 34171 34183 34211 34213 34217 34231 34253 34259 34261 34267 34273 34283 34297 34301 34303 34313 34319 34327 34337 34351 34361 34367 34369 34381 34403 34421 34429 34439 34457 34469 34471 34483 34487 34499 34501 34511 34513 34519 34537 34543 34549 34583 34589 34591 34603 34607 34613 34631 34649 34651 34667 34673 34679 34687 34693 34703 34721 34729 34739 34747 34757 34759 34763 34781 34807 34819 34841 34843 34847 34849 34871 34877 34883 34897 34913 34919 34939 34949 34961 34963 34981 35023 35027 35051 35053 35059 35069 35081 35083 35089 35099 35107 35111 35117 35129 35141 35149 35153 35159 35171 35201 35221 35227 35251 35257 35267 35279 35281 35291 35311 35317 35323 35327 35339 35353 35363 35381 35393 35401 35407 35419 35423 35437 35447 35449 35461 35491 35507 35509 35521 35527 35531 35533 35537 35543 35569 35573 35591 35593 35597 35603 35617 35671 35677 35729 35731 35747 35753 35759 35771 35797 35801 35803 35809 35831 35837 35839 35851 35863 35869 35879 35897 35899 35911 35923 35933 35951 35963 35969 35977 35983 35993 35999 36007 36011 36013 36017 36037 36061 36067 36073 36083 36097 36107 36109 36131 36137 36151 36161 36187 36191 36209 36217 36229 36241 36251 36263 36269 36277 36293 36299 36307 36313 36319 36341 36343 36353 36373 36383 36389 36433 36451 36457 36467 36469 36473 36479 36493 36497 36523 36527 36529 36541 36551 36559 36563 36571 36583 36587 36599 36607 36629 36637 36643 36653 36671 36677 36683 36691 36697 36709 36713 36721 36739 36749 36761 36767 36779 36781 36787 36791 36793 36809 36821 36833 36847 36857 36871 36877 36887 36899 36901 36913 36919 36923 36929 36931 36943 36947 36973 36979 36997 37003 37013 37019 37021 37039 37049 37057 37061 37087 37097 37117 37123 37139 37159 37171 37181 37189 37199 37201 37217 37223 37243 37253 37273 37277 37307 37309 37313 37321 37337 37339 37357 37361 37363 37369 37379 37397 37409 37423 37441 37447 37463 37483 37489 37493 37501 37507 37511 37517 37529 37537 37547 37549 37561 37567 37571 37573 37579 37589 37591 37607 37619 37633 37643 37649 37657 37663 37691 37693 37699 37717 37747 37781 37783 37799 37811 37813 37831 37847 37853 37861 37871 37879 37889 37897 37907 37951 37957 37963 37967 37987 37991 37993 37997 38011 38039 38047 38053 38069 38083 38113 38119 38149 38153 38167 38177 38183 38189 38197 38201 38219 38231 38237 38239 38261 38273 38281 38287 38299 38303 38317 38321 38327 38329 38333 38351 38371 38377 38393 38431 38447 38449 38453 38459 38461 38501 38543 38557 38561 38567 38569 38593 38603 38609 38611 38629 38639 38651 38653 38669 38671 38677 38693 38699 38707 38711 38713 38723 38729 38737 38747 38749 38767 38783 38791 38803 38821 38833 38839 38851 38861 38867 38873 38891 38903 38917 38921 38923 38933 38953 38959 38971 38977 38993 39019 39023 39041 39043 39047 39079 39089 39097 39103 39107 39113 39119 39133 39139 39157 39161 39163 39181 39191 39199 39209 39217 39227 39229 39233 39239 39241 39251 39293 39301 39313 39317 39323 39341 39343 39359 39367 39371 39373 39383 39397 39409 39419 39439 39443 39451 39461 39499 39503 39509 39511 39521 39541 39551 39563 39569 39581 39607 39619 39623 39631 39659 39667 39671 39679 39703 39709 39719 39727 39733 39749 39761 39769 39779 39791 39799 39821 39827 39829 39839 39841 39847 39857 39863 39869 39877 39883 39887 39901 39929 39937 39953 39971 39979 39983 39989 40009 40013 40031 40037 40039 40063 40087 40093 40099 40111 40123 40127 40129 40151 40153 40163 40169 40177 40189 40193 40213 40231 40237 40241 40253 40277 40283 40289 40343 40351 40357 40361 40387 40423 40427 40429 40433 40459 40471 40483 40487 40493 40499 40507 40519 40529 40531 40543 40559 40577 40583 40591 40597 40609 40627 40637 40639 40693 40697 40699 40709 40739 40751 40759 40763 40771 40787 40801 40813 40819 40823 40829 40841 40847 40849 40853 40867 40879 40883 40897 40903 40927 40933 40939 40949 40961 40973 40993 41011 41017 41023 41039 41047 41051 41057 41077 41081 41113 41117 41131 41141 41143 41149 41161 41177 41179 41183 41189 41201 41203 41213 41221 41227 41231 41233 41243 41257 41263 41269 41281 41299 41333 41341 41351 41357 41381 41387 41389 41399 41411 41413 41443 41453 41467 41479 41491 41507 41513 41519 41521 41539 41543 41549 41579 41593 41597 41603 41609 41611 41617 41621 41627 41641 41647 41651 41659 41669 41681 41687 41719 41729 41737 41759 41761 41771 41777 41801 41809 41813 41843 41849 41851 41863 41879 41887 41893 41897 41903 41911 41927 41941 41947 41953 41957 41959 41969 41981 41983 41999 42013 42017 42019 42023 42043 42061 42071 42073 42083 42089 42101 42131 42139 42157 42169 42179 42181 42187 42193 42197 42209 42221 42223 42227 42239 42257 42281 42283 42293 42299 42307 42323 42331 42337 42349 42359 42373 42379 42391 42397 42403 42407 42409 42433 42437 42443 42451 42457 42461 42463 42467 42473 42487 42491 42499 42509 42533 42557 42569 42571 42577 42589 42611 42641 42643 42649 42667 42677 42683 42689 42697 42701 42703 42709 42719 42727 42737 42743 42751 42767 42773 42787 42793 42797 42821 42829 42839 42841 42853 42859 42863 42899 42901 42923 42929 42937 42943 42953 42961 42967 42979 42989 43003 43013 43019 43037 43049 43051 43063 43067 43093 43103 43117 43133 43151 43159 43177 43189 43201 43207 43223 43237 43261 43271 43283 43291 43313 43319 43321 43331 43391 43397 43399 43403 43411 43427 43441 43451 43457 43481 43487 43499 43517 43541 43543 43573 43577 43579 43591 43597 43607 43609 43613 43627 43633 43649 43651 43661 43669 43691 43711 43717 43721 43753 43759 43777 43781 43783 43787 43789 43793 43801 43853 43867 43889 43891 43913 43933 43943 43951 43961 43963 43969 43973 43987 43991 43997 44017 44021 44027 44029 44041 44053 44059 44071 44087 44089 44101 44111 44119 44123 44129 44131 44159 44171 44179 44189 44201 44203 44207 44221 44249 44257 44263 44267 44269 44273 44279 44281 44293 44351 44357 44371 44381 44383 44389 44417 44449 44453 44483 44491 44497 44501 44507 44519 44531 44533 44537 44543 44549 44563 44579 44587 44617 44621 44623 44633 44641 44647 44651 44657 44683 44687 44699 44701 44711 44729 44741 44753 44771 44773 44777 44789 44797 44809 44819 44839 44843 44851 44867 44879 44887 44893 44909 44917 44927 44939 44953 44959 44963 44971 44983 44987 45007 45013 45053 45061 45077 45083 45119 45121 45127 45131 45137 45139 45161 45179 45181 45191 45197 45233 45247 45259 45263 45281 45289 45293 45307 45317 45319 45329 45337 45341 45343 45361 45377 45389 45403 45413 45427 45433 45439 45481 45491 45497 45503 45523 45533 45541 45553 45557 45569 45587 45589 45599 45613 45631 45641 45659 45667 45673 45677 45691 45697 45707 45737 45751 45757 45763 45767 45779 45817 45821 45823 45827 45833 45841 45853 45863 45869 45887 45893 45943 45949 45953 45959 45971 45979 45989 46021 46027 46049 46051 46061 46073 46091 46093 46099 46103 46133 46141 46147 46153 46171 46181 46183 46187 46199 46219 46229 46237 46261 46271 46273 46279 46301 46307 46309 46327 46337 46349 46351 46381 46399 46411 46439 46441 46447 46451 46457 46471 46477 46489 46499 46507 46511 46523 46549 46559 46567 46573 46589 46591 46601 46619 46633 46639 46643 46649 46663 46679 46681 46687 46691 46703 46723 46727 46747 46751 46757 46769 46771 46807 46811 46817 46819 46829 46831 46853 46861 46867 46877 46889 46901 46919 46933 46957 46993 46997 47017 47041 47051 47057 47059 47087 47093 47111 47119 47123 47129 47137 47143 47147 47149 47161 47189 47207 47221 47237 47251 47269 47279 47287 47293 47297 47303 47309 47317 47339 47351 47353 47363 47381 47387 47389 47407 47417 47419 47431 47441 47459 47491 47497 47501 47507 47513 47521 47527 47533 47543 47563 47569 47581 47591 47599 47609 47623 47629 47639 47653 47657 47659 47681 47699 47701 47711 47713 47717 47737 47741 47743 47777 47779 47791 47797 47807 47809 47819 47837 47843 47857 47869 47881 47903 47911 47917 47933 47939 47947 47951 47963 47969 47977 47981 48017 48023 48029 48049 48073 48079 48091 48109 48119 48121 48131 48157 48163 48179 48187 48193 48197 48221 48239 48247 48259 48271 48281 48299 48311 48313 48337 48341 48353 48371 48383 48397 48407 48409 48413 48437 48449 48463 48473 48479 48481 48487 48491 48497 48523 48527 48533 48539 48541 48563 48571 48589 48593 48611 48619 48623 48647 48649 48661 48673 48677 48679 48731 48733 48751 48757 48761 48767 48779 48781 48787 48799 48809 48817 48821 48823 48847 48857 48859 48869 48871 48883 48889 48907 48947 48953 48973 48989 48991 49003 49009 49019 49031 49033 49037 49043 49057 49069 49081 49103 49109 49117 49121 49123 49139 49157 49169 49171 49177 49193 49199 49201 49207 49211 49223 49253 49261 49277 49279 49297 49307 49331 49333 49339 49363 49367 49369 49391 49393 49409 49411 49417 49429 49433 49451 49459 49463 49477 49481 49499 49523 49529 49531 49537 49547 49549 49559 49597 49603 49613 49627 49633 49639 49663 49667 49669 49681 49697 49711 49727 49739 49741 49747 49757 49783 49787 49789 49801 49807 49811 49823 49831 49843 49853 49871 49877 49891 49919 49921 49927 49937 49939 49943 49957 49991 49993 49999 
+ 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947 953 967 971 977 983 991 997 1009 1013 1019 1021 1031 1033 1039 1049 1051 1061 1063 1069 1087 1091 1093 1097 1103 1109 1117 1123 1129 1151 1153 1163 1171 1181 1187 1193 1201 1213 1217 1223 1229 1231 1237 1249 1259 1277 1279 1283 1289 1291 1297 1301 1303 1307 1319 1321 1327 1361 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439 1447 1451 1453 1459 1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543 1549 1553 1559 1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627 1637 1657 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753 1759 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877 1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997 1999 2003 2011 2017 2027 2029 2039 2053 2063 2069 2081 2083 2087 2089 2099 2111 2113 2129 2131 2137 2141 2143 2153 2161 2179 2203 2207 2213 2221 2237 2239 2243 2251 2267 2269 2273 2281 2287 2293 2297 2309 2311 2333 2339 2341 2347 2351 2357 2371 2377 2381 2383 2389 2393 2399 2411 2417 2423 2437 2441 2447 2459 2467 2473 2477 2503 2521 2531 2539 2543 2549 2551 2557 2579 2591 2593 2609 2617 2621 2633 2647 2657 2659 2663 2671 2677 2683 2687 2689 2693 2699 2707 2711 2713 2719 2729 2731 2741 2749 2753 2767 2777 2789 2791 2797 2801 2803 2819 2833 2837 2843 2851 2857 2861 2879 2887 2897 2903 2909 2917 2927 2939 2953 2957 2963 2969 2971 2999 3001 3011 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089 3109 3119 3121 3137 3163 3167 3169 3181 3187 3191 3203 3209 3217 3221 3229 3251 3253 3257 3259 3271 3299 3301 3307 3313 3319 3323 3329 3331 3343 3347 3359 3361 3371 3373 3389 3391 3407 3413 3433 3449 3457 3461 3463 3467 3469 3491 3499 3511 3517 3527 3529 3533 3539 3541 3547 3557 3559 3571 3581 3583 3593 3607 3613 3617 3623 3631 3637 3643 3659 3671 3673 3677 3691 3697 3701 3709 3719 3727 3733 3739 3761 3767 3769 3779 3793 3797 3803 3821 3823 3833 3847 3851 3853 3863 3877 3881 3889 3907 3911 3917 3919 3923 3929 3931 3943 3947 3967 3989 4001 4003 4007 4013 4019 4021 4027 4049 4051 4057 4073 4079 4091 4093 4099 4111 4127 4129 4133 4139 4153 4157 4159 4177 4201 4211 4217 4219 4229 4231 4241 4243 4253 4259 4261 4271 4273 4283 4289 4297 4327 4337 4339 4349 4357 4363 4373 4391 4397 4409 4421 4423 4441 4447 4451 4457 4463 4481 4483 4493 4507 4513 4517 4519 4523 4547 4549 4561 4567 4583 4591 4597 4603 4621 4637 4639 4643 4649 4651 4657 4663 4673 4679 4691 4703 4721 4723 4729 4733 4751 4759 4783 4787 4789 4793 4799 4801 4813 4817 4831 4861 4871 4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973 4987 4993 4999 5003 5009 5011 5021 5023 5039 5051 5059 5077 5081 5087 5099 5101 5107 5113 5119 5147 5153 5167 5171 5179 5189 5197 5209 5227 5231 5233 5237 5261 5273 5279 5281 5297 5303 5309 5323 5333 5347 5351 5381 5387 5393 5399 5407 5413 5417 5419 5431 5437 5441 5443 5449 5471 5477 5479 5483 5501 5503 5507 5519 5521 5527 5531 5557 5563 5569 5573 5581 5591 5623 5639 5641 5647 5651 5653 5657 5659 5669 5683 5689 5693 5701 5711 5717 5737 5741 5743 5749 5779 5783 5791 5801 5807 5813 5821 5827 5839 5843 5849 5851 5857 5861 5867 5869 5879 5881 5897 5903 5923 5927 5939 5953 5981 5987 6007 6011 6029 6037 6043 6047 6053 6067 6073 6079 6089 6091 6101 6113 6121 6131 6133 6143 6151 6163 6173 6197 6199 6203 6211 6217 6221 6229 6247 6257 6263 6269 6271 6277 6287 6299 6301 6311 6317 6323 6329 6337 6343 6353 6359 6361 6367 6373 6379 6389 6397 6421 6427 6449 6451 6469 6473 6481 6491 6521 6529 6547 6551 6553 6563 6569 6571 6577 6581 6599 6607 6619 6637 6653 6659 6661 6673 6679 6689 6691 6701 6703 6709 6719 6733 6737 6761 6763 6779 6781 6791 6793 6803 6823 6827 6829 6833 6841 6857 6863 6869 6871 6883 6899 6907 6911 6917 6947 6949 6959 6961 6967 6971 6977 6983 6991 6997 7001 7013 7019 7027 7039 7043 7057 7069 7079 7103 7109 7121 7127 7129 7151 7159 7177 7187 7193 7207 7211 7213 7219 7229 7237 7243 7247 7253 7283 7297 7307 7309 7321 7331 7333 7349 7351 7369 7393 7411 7417 7433 7451 7457 7459 7477 7481 7487 7489 7499 7507 7517 7523 7529 7537 7541 7547 7549 7559 7561 7573 7577 7583 7589 7591 7603 7607 7621 7639 7643 7649 7669 7673 7681 7687 7691 7699 7703 7717 7723 7727 7741 7753 7757 7759 7789 7793 7817 7823 7829 7841 7853 7867 7873 7877 7879 7883 7901 7907 7919 7927 7933 7937 7949 7951 7963 7993 8009 8011 8017 8039 8053 8059 8069 8081 8087 8089 8093 8101 8111 8117 8123 8147 8161 8167 8171 8179 8191 8209 8219 8221 8231 8233 8237 8243 8263 8269 8273 8287 8291 8293 8297 8311 8317 8329 8353 8363 8369 8377 8387 8389 8419 8423 8429 8431 8443 8447 8461 8467 8501 8513 8521 8527 8537 8539 8543 8563 8573 8581 8597 8599 8609 8623 8627 8629 8641 8647 8663 8669 8677 8681 8689 8693 8699 8707 8713 8719 8731 8737 8741 8747 8753 8761 8779 8783 8803 8807 8819 8821 8831 8837 8839 8849 8861 8863 8867 8887 8893 8923 8929 8933 8941 8951 8963 8969 8971 8999 9001 9007 9011 9013 9029 9041 9043 9049 9059 9067 9091 9103 9109 9127 9133 9137 9151 9157 9161 9173 9181 9187 9199 9203 9209 9221 9227 9239 9241 9257 9277 9281 9283 9293 9311 9319 9323 9337 9341 9343 9349 9371 9377 9391 9397 9403 9413 9419 9421 9431 9433 9437 9439 9461 9463 9467 9473 9479 9491 9497 9511 9521 9533 9539 9547 9551 9587 9601 9613 9619 9623 9629 9631 9643 9649 9661 9677 9679 9689 9697 9719 9721 9733 9739 9743 9749 9767 9769 9781 9787 9791 9803 9811 9817 9829 9833 9839 9851 9857 9859 9871 9883 9887 9901 9907 9923 9929 9931 9941 9949 9967 9973 10007 10009 10037 10039 10061 10067 10069 10079 10091 10093 10099 10103 10111 10133 10139 10141 10151 10159 10163 10169 10177 10181 10193 10211 10223 10243 10247 10253 10259 10267 10271 10273 10289 10301 10303 10313 10321 10331 10333 10337 10343 10357 10369 10391 10399 10427 10429 10433 10453 10457 10459 10463 10477 10487 10499 10501 10513 10529 10531 10559 10567 10589 10597 10601 10607 10613 10627 10631 10639 10651 10657 10663 10667 10687 10691 10709 10711 10723 10729 10733 10739 10753 10771 10781 10789 10799 10831 10837 10847 10853 10859 10861 10867 10883 10889 10891 10903 10909 10937 10939 10949 10957 10973 10979 10987 10993 11003 11027 11047 11057 11059 11069 11071 11083 11087 11093 11113 11117 11119 11131 11149 11159 11161 11171 11173 11177 11197 11213 11239 11243 11251 11257 11261 11273 11279 11287 11299 11311 11317 11321 11329 11351 11353 11369 11383 11393 11399 11411 11423 11437 11443 11447 11467 11471 11483 11489 11491 11497 11503 11519 11527 11549 11551 11579 11587 11593 11597 11617 11621 11633 11657 11677 11681 11689 11699 11701 11717 11719 11731 11743 11777 11779 11783 11789 11801 11807 11813 11821 11827 11831 11833 11839 11863 11867 11887 11897 11903 11909 11923 11927 11933 11939 11941 11953 11959 11969 11971 11981 11987 12007 12011 12037 12041 12043 12049 12071 12073 12097 12101 12107 12109 12113 12119 12143 12149 12157 12161 12163 12197 12203 12211 12227 12239 12241 12251 12253 12263 12269 12277 12281 12289 12301 12323 12329 12343 12347 12373 12377 12379 12391 12401 12409 12413 12421 12433 12437 12451 12457 12473 12479 12487 12491 12497 12503 12511 12517 12527 12539 12541 12547 12553 12569 12577 12583 12589 12601 12611 12613 12619 12637 12641 12647 12653 12659 12671 12689 12697 12703 12713 12721 12739 12743 12757 12763 12781 12791 12799 12809 12821 12823 12829 12841 12853 12889 12893 12899 12907 12911 12917 12919 12923 12941 12953 12959 12967 12973 12979 12983 13001 13003 13007 13009 13033 13037 13043 13049 13063 13093 13099 13103 13109 13121 13127 13147 13151 13159 13163 13171 13177 13183 13187 13217 13219 13229 13241 13249 13259 13267 13291 13297 13309 13313 13327 13331 13337 13339 13367 13381 13397 13399 13411 13417 13421 13441 13451 13457 13463 13469 13477 13487 13499 13513 13523 13537 13553 13567 13577 13591 13597 13613 13619 13627 13633 13649 13669 13679 13681 13687 13691 13693 13697 13709 13711 13721 13723 13729 13751 13757 13759 13763 13781 13789 13799 13807 13829 13831 13841 13859 13873 13877 13879 13883 13901 13903 13907 13913 13921 13931 13933 13963 13967 13997 13999 14009 14011 14029 14033 14051 14057 14071 14081 14083 14087 14107 14143 14149 14153 14159 14173 14177 14197 14207 14221 14243 14249 14251 14281 14293 14303 14321 14323 14327 14341 14347 14369 14387 14389 14401 14407 14411 14419 14423 14431 14437 14447 14449 14461 14479 14489 14503 14519 14533 14537 14543 14549 14551 14557 14561 14563 14591 14593 14621 14627 14629 14633 14639 14653 14657 14669 14683 14699 14713 14717 14723 14731 14737 14741 14747 14753 14759 14767 14771 14779 14783 14797 14813 14821 14827 14831 14843 14851 14867 14869 14879 14887 14891 14897 14923 14929 14939 14947 14951 14957 14969 14983 15013 15017 15031 15053 15061 15073 15077 15083 15091 15101 15107 15121 15131 15137 15139 15149 15161 15173 15187 15193 15199 15217 15227 15233 15241 15259 15263 15269 15271 15277 15287 15289 15299 15307 15313 15319 15329 15331 15349 15359 15361 15373 15377 15383 15391 15401 15413 15427 15439 15443 15451 15461 15467 15473 15493 15497 15511 15527 15541 15551 15559 15569 15581 15583 15601 15607 15619 15629 15641 15643 15647 15649 15661 15667 15671 15679 15683 15727 15731 15733 15737 15739 15749 15761 15767 15773 15787 15791 15797 15803 15809 15817 15823 15859 15877 15881 15887 15889 15901 15907 15913 15919 15923 15937 15959 15971 15973 15991 16001 16007 16033 16057 16061 16063 16067 16069 16073 16087 16091 16097 16103 16111 16127 16139 16141 16183 16187 16189 16193 16217 16223 16229 16231 16249 16253 16267 16273 16301 16319 16333 16339 16349 16361 16363 16369 16381 16411 16417 16421 16427 16433 16447 16451 16453 16477 16481 16487 16493 16519 16529 16547 16553 16561 16567 16573 16603 16607 16619 16631 16633 16649 16651 16657 16661 16673 16691 16693 16699 16703 16729 16741 16747 16759 16763 16787 16811 16823 16829 16831 16843 16871 16879 16883 16889 16901 16903 16921 16927 16931 16937 16943 16963 16979 16981 16987 16993 17011 17021 17027 17029 17033 17041 17047 17053 17077 17093 17099 17107 17117 17123 17137 17159 17167 17183 17189 17191 17203 17207 17209 17231 17239 17257 17291 17293 17299 17317 17321 17327 17333 17341 17351 17359 17377 17383 17387 17389 17393 17401 17417 17419 17431 17443 17449 17467 17471 17477 17483 17489 17491 17497 17509 17519 17539 17551 17569 17573 17579 17581 17597 17599 17609 17623 17627 17657 17659 17669 17681 17683 17707 17713 17729 17737 17747 17749 17761 17783 17789 17791 17807 17827 17837 17839 17851 17863 17881 17891 17903 17909 17911 17921 17923 17929 17939 17957 17959 17971 17977 17981 17987 17989 18013 18041 18043 18047 18049 18059 18061 18077 18089 18097 18119 18121 18127 18131 18133 18143 18149 18169 18181 18191 18199 18211 18217 18223 18229 18233 18251 18253 18257 18269 18287 18289 18301 18307 18311 18313 18329 18341 18353 18367 18371 18379 18397 18401 18413 18427 18433 18439 18443 18451 18457 18461 18481 18493 18503 18517 18521 18523 18539 18541 18553 18583 18587 18593 18617 18637 18661 18671 18679 18691 18701 18713 18719 18731 18743 18749 18757 18773 18787 18793 18797 18803 18839 18859 18869 18899 18911 18913 18917 18919 18947 18959 18973 18979 19001 19009 19013 19031 19037 19051 19069 19073 19079 19081 19087 19121 19139 19141 19157 19163 19181 19183 19207 19211 19213 19219 19231 19237 19249 19259 19267 19273 19289 19301 19309 19319 19333 19373 19379 19381 19387 19391 19403 19417 19421 19423 19427 19429 19433 19441 19447 19457 19463 19469 19471 19477 19483 19489 19501 19507 19531 19541 19543 19553 19559 19571 19577 19583 19597 19603 19609 19661 19681 19687 19697 19699 19709 19717 19727 19739 19751 19753 19759 19763 19777 19793 19801 19813 19819 19841 19843 19853 19861 19867 19889 19891 19913 19919 19927 19937 19949 19961 19963 19973 19979 19991 19993 19997 20011 20021 20023 20029 20047 20051 20063 20071 20089 20101 20107 20113 20117 20123 20129 20143 20147 20149 20161 20173 20177 20183 20201 20219 20231 20233 20249 20261 20269 20287 20297 20323 20327 20333 20341 20347 20353 20357 20359 20369 20389 20393 20399 20407 20411 20431 20441 20443 20477 20479 20483 20507 20509 20521 20533 20543 20549 20551 20563 20593 20599 20611 20627 20639 20641 20663 20681 20693 20707 20717 20719 20731 20743 20747 20749 20753 20759 20771 20773 20789 20807 20809 20849 20857 20873 20879 20887 20897 20899 20903 20921 20929 20939 20947 20959 20963 20981 20983 21001 21011 21013 21017 21019 21023 21031 21059 21061 21067 21089 21101 21107 21121 21139 21143 21149 21157 21163 21169 21179 21187 21191 21193 21211 21221 21227 21247 21269 21277 21283 21313 21317 21319 21323 21341 21347 21377 21379 21383 21391 21397 21401 21407 21419 21433 21467 21481 21487 21491 21493 21499 21503 21517 21521 21523 21529 21557 21559 21563 21569 21577 21587 21589 21599 21601 21611 21613 21617 21647 21649 21661 21673 21683 21701 21713 21727 21737 21739 21751 21757 21767 21773 21787 21799 21803 21817 21821 21839 21841 21851 21859 21863 21871 21881 21893 21911 21929 21937 21943 21961 21977 21991 21997 22003 22013 22027 22031 22037 22039 22051 22063 22067 22073 22079 22091 22093 22109 22111 22123 22129 22133 22147 22153 22157 22159 22171 22189 22193 22229 22247 22259 22271 22273 22277 22279 22283 22291 22303 22307 22343 22349 22367 22369 22381 22391 22397 22409 22433 22441 22447 22453 22469 22481 22483 22501 22511 22531 22541 22543 22549 22567 22571 22573 22613 22619 22621 22637 22639 22643 22651 22669 22679 22691 22697 22699 22709 22717 22721 22727 22739 22741 22751 22769 22777 22783 22787 22807 22811 22817 22853 22859 22861 22871 22877 22901 22907 22921 22937 22943 22961 22963 22973 22993 23003 23011 23017 23021 23027 23029 23039 23041 23053 23057 23059 23063 23071 23081 23087 23099 23117 23131 23143 23159 23167 23173 23189 23197 23201 23203 23209 23227 23251 23269 23279 23291 23293 23297 23311 23321 23327 23333 23339 23357 23369 23371 23399 23417 23431 23447 23459 23473 23497 23509 23531 23537 23539 23549 23557 23561 23563 23567 23581 23593 23599 23603 23609 23623 23627 23629 23633 23663 23669 23671 23677 23687 23689 23719 23741 23743 23747 23753 23761 23767 23773 23789 23801 23813 23819 23827 23831 23833 23857 23869 23873 23879 23887 23893 23899 23909 23911 23917 23929 23957 23971 23977 23981 23993 24001 24007 24019 24023 24029 24043 24049 24061 24071 24077 24083 24091 24097 24103 24107 24109 24113 24121 24133 24137 24151 24169 24179 24181 24197 24203 24223 24229 24239 24247 24251 24281 24317 24329 24337 24359 24371 24373 24379 24391 24407 24413 24419 24421 24439 24443 24469 24473 24481 24499 24509 24517 24527 24533 24547 24551 24571 24593 24611 24623 24631 24659 24671 24677 24683 24691 24697 24709 24733 24749 24763 24767 24781 24793 24799 24809 24821 24841 24847 24851 24859 24877 24889 24907 24917 24919 24923 24943 24953 24967 24971 24977 24979 24989 25013 25031 25033 25037 25057 25073 25087 25097 25111 25117 25121 25127 25147 25153 25163 25169 25171 25183 25189 25219 25229 25237 25243 25247 25253 25261 25301 25303 25307 25309 25321 25339 25343 25349 25357 25367 25373 25391 25409 25411 25423 25439 25447 25453 25457 25463 25469 25471 25523 25537 25541 25561 25577 25579 25583 25589 25601 25603 25609 25621 25633 25639 25643 25657 25667 25673 25679 25693 25703 25717 25733 25741 25747 25759 25763 25771 25793 25799 25801 25819 25841 25847 25849 25867 25873 25889 25903 25913 25919 25931 25933 25939 25943 25951 25969 25981 25997 25999 26003 26017 26021 26029 26041 26053 26083 26099 26107 26111 26113 26119 26141 26153 26161 26171 26177 26183 26189 26203 26209 26227 26237 26249 26251 26261 26263 26267 26293 26297 26309 26317 26321 26339 26347 26357 26371 26387 26393 26399 26407 26417 26423 26431 26437 26449 26459 26479 26489 26497 26501 26513 26539 26557 26561 26573 26591 26597 26627 26633 26641 26647 26669 26681 26683 26687 26693 26699 26701 26711 26713 26717 26723 26729 26731 26737 26759 26777 26783 26801 26813 26821 26833 26839 26849 26861 26863 26879 26881 26891 26893 26903 26921 26927 26947 26951 26953 26959 26981 26987 26993 27011 27017 27031 27043 27059 27061 27067 27073 27077 27091 27103 27107 27109 27127 27143 27179 27191 27197 27211 27239 27241 27253 27259 27271 27277 27281 27283 27299 27329 27337 27361 27367 27397 27407 27409 27427 27431 27437 27449 27457 27479 27481 27487 27509 27527 27529 27539 27541 27551 27581 27583 27611 27617 27631 27647 27653 27673 27689 27691 27697 27701 27733 27737 27739 27743 27749 27751 27763 27767 27773 27779 27791 27793 27799 27803 27809 27817 27823 27827 27847 27851 27883 27893 27901 27917 27919 27941 27943 27947 27953 27961 27967 27983 27997 28001 28019 28027 28031 28051 28057 28069 28081 28087 28097 28099 28109 28111 28123 28151 28163 28181 28183 28201 28211 28219 28229 28277 28279 28283 28289 28297 28307 28309 28319 28349 28351 28387 28393 28403 28409 28411 28429 28433 28439 28447 28463 28477 28493 28499 28513 28517 28537 28541 28547 28549 28559 28571 28573 28579 28591 28597 28603 28607 28619 28621 28627 28631 28643 28649 28657 28661 28663 28669 28687 28697 28703 28711 28723 28729 28751 28753 28759 28771 28789 28793 28807 28813 28817 28837 28843 28859 28867 28871 28879 28901 28909 28921 28927 28933 28949 28961 28979 29009 29017 29021 29023 29027 29033 29059 29063 29077 29101 29123 29129 29131 29137 29147 29153 29167 29173 29179 29191 29201 29207 29209 29221 29231 29243 29251 29269 29287 29297 29303 29311 29327 29333 29339 29347 29363 29383 29387 29389 29399 29401 29411 29423 29429 29437 29443 29453 29473 29483 29501 29527 29531 29537 29567 29569 29573 29581 29587 29599 29611 29629 29633 29641 29663 29669 29671 29683 29717 29723 29741 29753 29759 29761 29789 29803 29819 29833 29837 29851 29863 29867 29873 29879 29881 29917 29921 29927 29947 29959 29983 29989 30011 30013 30029 30047 30059 30071 30089 30091 30097 30103 30109 30113 30119 30133 30137 30139 30161 30169 30181 30187 30197 30203 30211 30223 30241 30253 30259 30269 30271 30293 30307 30313 30319 30323 30341 30347 30367 30389 30391 30403 30427 30431 30449 30467 30469 30491 30493 30497 30509 30517 30529 30539 30553 30557 30559 30577 30593 30631 30637 30643 30649 30661 30671 30677 30689 30697 30703 30707 30713 30727 30757 30763 30773 30781 30803 30809 30817 30829 30839 30841 30851 30853 30859 30869 30871 30881 30893 30911 30931 30937 30941 30949 30971 30977 30983 31013 31019 31033 31039 31051 31063 31069 31079 31081 31091 31121 31123 31139 31147 31151 31153 31159 31177 31181 31183 31189 31193 31219 31223 31231 31237 31247 31249 31253 31259 31267 31271 31277 31307 31319 31321 31327 31333 31337 31357 31379 31387 31391 31393 31397 31469 31477 31481 31489 31511 31513 31517 31531 31541 31543 31547 31567 31573 31583 31601 31607 31627 31643 31649 31657 31663 31667 31687 31699 31721 31723 31727 31729 31741 31751 31769 31771 31793 31799 31817 31847 31849 31859 31873 31883 31891 31907 31957 31963 31973 31981 31991 32003 32009 32027 32029 32051 32057 32059 32063 32069 32077 32083 32089 32099 32117 32119 32141 32143 32159 32173 32183 32189 32191 32203 32213 32233 32237 32251 32257 32261 32297 32299 32303 32309 32321 32323 32327 32341 32353 32359 32363 32369 32371 32377 32381 32401 32411 32413 32423 32429 32441 32443 32467 32479 32491 32497 32503 32507 32531 32533 32537 32561 32563 32569 32573 32579 32587 32603 32609 32611 32621 32633 32647 32653 32687 32693 32707 32713 32717 32719 32749 32771 32779 32783 32789 32797 32801 32803 32831 32833 32839 32843 32869 32887 32909 32911 32917 32933 32939 32941 32957 32969 32971 32983 32987 32993 32999 33013 33023 33029 33037 33049 33053 33071 33073 33083 33091 33107 33113 33119 33149 33151 33161 33179 33181 33191 33199 33203 33211 33223 33247 33287 33289 33301 33311 33317 33329 33331 33343 33347 33349 33353 33359 33377 33391 33403 33409 33413 33427 33457 33461 33469 33479 33487 33493 33503 33521 33529 33533 33547 33563 33569 33577 33581 33587 33589 33599 33601 33613 33617 33619 33623 33629 33637 33641 33647 33679 33703 33713 33721 33739 33749 33751 33757 33767 33769 33773 33791 33797 33809 33811 33827 33829 33851 33857 33863 33871 33889 33893 33911 33923 33931 33937 33941 33961 33967 33997 34019 34031 34033 34039 34057 34061 34123 34127 34129 34141 34147 34157 34159 34171 34183 34211 34213 34217 34231 34253 34259 34261 34267 34273 34283 34297 34301 34303 34313 34319 34327 34337 34351 34361 34367 34369 34381 34403 34421 34429 34439 34457 34469 34471 34483 34487 34499 34501 34511 34513 34519 34537 34543 34549 34583 34589 34591 34603 34607 34613 34631 34649 34651 34667 34673 34679 34687 34693 34703 34721 34729 34739 34747 34757 34759 34763 34781 34807 34819 34841 34843 34847 34849 34871 34877 34883 34897 34913 34919 34939 34949 34961 34963 34981 35023 35027 35051 35053 35059 35069 35081 35083 35089 35099 35107 35111 35117 35129 35141 35149 35153 35159 35171 35201 35221 35227 35251 35257 35267 35279 35281 35291 35311 35317 35323 35327 35339 35353 35363 35381 35393 35401 35407 35419 35423 35437 35447 35449 35461 35491 35507 35509 35521 35527 35531 35533 35537 35543 35569 35573 35591 35593 35597 35603 35617 35671 35677 35729 35731 35747 35753 35759 35771 35797 35801 35803 35809 35831 35837 35839 35851 35863 35869 35879 35897 35899 35911 35923 35933 35951 35963 35969 35977 35983 35993 35999 36007 36011 36013 36017 36037 36061 36067 36073 36083 36097 36107 36109 36131 36137 36151 36161 36187 36191 36209 36217 36229 36241 36251 36263 36269 36277 36293 36299 36307 36313 36319 36341 36343 36353 36373 36383 36389 36433 36451 36457 36467 36469 36473 36479 36493 36497 36523 36527 36529 36541 36551 36559 36563 36571 36583 36587 36599 36607 36629 36637 36643 36653 36671 36677 36683 36691 36697 36709 36713 36721 36739 36749 36761 36767 36779 36781 36787 36791 36793 36809 36821 36833 36847 36857 36871 36877 36887 36899 36901 36913 36919 36923 36929 36931 36943 36947 36973 36979 36997 37003 37013 37019 37021 37039 37049 37057 37061 37087 37097 37117 37123 37139 37159 37171 37181 37189 37199 37201 37217 37223 37243 37253 37273 37277 37307 37309 37313 37321 37337 37339 37357 37361 37363 37369 37379 37397 37409 37423 37441 37447 37463 37483 37489 37493 37501 37507 37511 37517 37529 37537 37547 37549 37561 37567 37571 37573 37579 37589 37591 37607 37619 37633 37643 37649 37657 37663 37691 37693 37699 37717 37747 37781 37783 37799 37811 37813 37831 37847 37853 37861 37871 37879 37889 37897 37907 37951 37957 37963 37967 37987 37991 37993 37997 38011 38039 38047 38053 38069 38083 38113 38119 38149 38153 38167 38177 38183 38189 38197 38201 38219 38231 38237 38239 38261 38273 38281 38287 38299 38303 38317 38321 38327 38329 38333 38351 38371 38377 38393 38431 38447 38449 38453 38459 38461 38501 38543 38557 38561 38567 38569 38593 38603 38609 38611 38629 38639 38651 38653 38669 38671 38677 38693 38699 38707 38711 38713 38723 38729 38737 38747 38749 38767 38783 38791 38803 38821 38833 38839 38851 38861 38867 38873 38891 38903 38917 38921 38923 38933 38953 38959 38971 38977 38993 39019 39023 39041 39043 39047 39079 39089 39097 39103 39107 39113 39119 39133 39139 39157 39161 39163 39181 39191 39199 39209 39217 39227 39229 39233 39239 39241 39251 39293 39301 39313 39317 39323 39341 39343 39359 39367 39371 39373 39383 39397 39409 39419 39439 39443 39451 39461 39499 39503 39509 39511 39521 39541 39551 39563 39569 39581 39607 39619 39623 39631 39659 39667 39671 39679 39703 39709 39719 39727 39733 39749 39761 39769 39779 39791 39799 39821 39827 39829 39839 39841 39847 39857 39863 39869 39877 39883 39887 39901 39929 39937 39953 39971 39979 39983 39989 40009 40013 40031 40037 40039 40063 40087 40093 40099 40111 40123 40127 40129 40151 40153 40163 40169 40177 40189 40193 40213 40231 40237 40241 40253 40277 40283 40289 40343 40351 40357 40361 40387 40423 40427 40429 40433 40459 40471 40483 40487 40493 40499 40507 40519 40529 40531 40543 40559 40577 40583 40591 40597 40609 40627 40637 40639 40693 40697 40699 40709 40739 40751 40759 40763 40771 40787 40801 40813 40819 40823 40829 40841 40847 40849 40853 40867 40879 40883 40897 40903 40927 40933 40939 40949 40961 40973 40993 41011 41017 41023 41039 41047 41051 41057 41077 41081 41113 41117 41131 41141 41143 41149 41161 41177 41179 41183 41189 41201 41203 41213 41221 41227 41231 41233 41243 41257 41263 41269 41281 41299 41333 41341 41351 41357 41381 41387 41389 41399 41411 41413 41443 41453 41467 41479 41491 41507 41513 41519 41521 41539 41543 41549 41579 41593 41597 41603 41609 41611 41617 41621 41627 41641 41647 41651 41659 41669 41681 41687 41719 41729 41737 41759 41761 41771 41777 41801 41809 41813 41843 41849 41851 41863 41879 41887 41893 41897 41903 41911 41927 41941 41947 41953 41957 41959 41969 41981 41983 41999 42013 42017 42019 42023 42043 42061 42071 42073 42083 42089 42101 42131 42139 42157 42169 42179 42181 42187 42193 42197 42209 42221 42223 42227 42239 42257 42281 42283 42293 42299 42307 42323 42331 42337 42349 42359 42373 42379 42391 42397 42403 42407 42409 42433 42437 42443 42451 42457 42461 42463 42467 42473 42487 42491 42499 42509 42533 42557 42569 42571 42577 42589 42611 42641 42643 42649 42667 42677 42683 42689 42697 42701 42703 42709 42719 42727 42737 42743 42751 42767 42773 42787 42793 42797 42821 42829 42839 42841 42853 42859 42863 42899 42901 42923 42929 42937 42943 42953 42961 42967 42979 42989 43003 43013 43019 43037 43049 43051 43063 43067 43093 43103 43117 43133 43151 43159 43177 43189 43201 43207 43223 43237 43261 43271 43283 43291 43313 43319 43321 43331 43391 43397 43399 43403 43411 43427 43441 43451 43457 43481 43487 43499 43517 43541 43543 43573 43577 43579 43591 43597 43607 43609 43613 43627 43633 43649 43651 43661 43669 43691 43711 43717 43721 43753 43759 43777 43781 43783 43787 43789 43793 43801 43853 43867 43889 43891 43913 43933 43943 43951 43961 43963 43969 43973 43987 43991 43997 44017 44021 44027 44029 44041 44053 44059 44071 44087 44089 44101 44111 44119 44123 44129 44131 44159 44171 44179 44189 44201 44203 44207 44221 44249 44257 44263 44267 44269 44273 44279 44281 44293 44351 44357 44371 44381 44383 44389 44417 44449 44453 44483 44491 44497 44501 44507 44519 44531 44533 44537 44543 44549 44563 44579 44587 44617 44621 44623 44633 44641 44647 44651 44657 44683 44687 44699 44701 44711 44729 44741 44753 44771 44773 44777 44789 44797 44809 44819 44839 44843 44851 44867 44879 44887 44893 44909 44917 44927 44939 44953 44959 44963 44971 44983 44987 45007 45013 45053 45061 45077 45083 45119 45121 45127 45131 45137 45139 45161 45179 45181 45191 45197 45233 45247 45259 45263 45281 45289 45293 45307 45317 45319 45329 45337 45341 45343 45361 45377 45389 45403 45413 45427 45433 45439 45481 45491 45497 45503 45523 45533 45541 45553 45557 45569 45587 45589 45599 45613 45631 45641 45659 45667 45673 45677 45691 45697 45707 45737 45751 45757 45763 45767 45779 45817 45821 45823 45827 45833 45841 45853 45863 45869 45887 45893 45943 45949 45953 45959 45971 45979 45989 46021 46027 46049 46051 46061 46073 46091 46093 46099 46103 46133 46141 46147 46153 46171 46181 46183 46187 46199 46219 46229 46237 46261 46271 46273 46279 46301 46307 46309 46327 46337 46349 46351 46381 46399 46411 46439 46441 46447 46451 46457 46471 46477 46489 46499 46507 46511 46523 46549 46559 46567 46573 46589 46591 46601 46619 46633 46639 46643 46649 46663 46679 46681 46687 46691 46703 46723 46727 46747 46751 46757 46769 46771 46807 46811 46817 46819 46829 46831 46853 46861 46867 46877 46889 46901 46919 46933 46957 46993 46997 47017 47041 47051 47057 47059 47087 47093 47111 47119 47123 47129 47137 47143 47147 47149 47161 47189 47207 47221 47237 47251 47269 47279 47287 47293 47297 47303 47309 47317 47339 47351 47353 47363 47381 47387 47389 47407 47417 47419 47431 47441 47459 47491 47497 47501 47507 47513 47521 47527 47533 47543 47563 47569 47581 47591 47599 47609 47623 47629 47639 47653 47657 47659 47681 47699 47701 47711 47713 47717 47737 47741 47743 47777 47779 47791 47797 47807 47809 47819 47837 47843 47857 47869 47881 47903 47911 47917 47933 47939 47947 47951 47963 47969 47977 47981 48017 48023 48029 48049 48073 48079 48091 48109 48119 48121 48131 48157 48163 48179 48187 48193 48197 48221 48239 48247 48259 48271 48281 48299 48311 48313 48337 48341 48353 48371 48383 48397 48407 48409 48413 48437 48449 48463 48473 48479 48481 48487 48491 48497 48523 48527 48533 48539 48541 48563 48571 48589 48593 48611 48619 48623 48647 48649 48661 48673 48677 48679 48731 48733 48751 48757 48761 48767 48779 48781 48787 48799 48809 48817 48821 48823 48847 48857 48859 48869 48871 48883 48889 48907 48947 48953 48973 48989 48991 49003 49009 49019 49031 49033 49037 49043 49057 49069 49081 49103 49109 49117 49121 49123 49139 49157 49169 49171 49177 49193 49199 49201 49207 49211 49223 49253 49261 49277 49279 49297 49307 49331 49333 49339 49363 49367 49369 49391 49393 49409 49411 49417 49429 49433 49451 49459 49463 49477 49481 49499 49523 49529 49531 49537 49547 49549 49559 49597 49603 49613 49627 49633 49639 49663 49667 49669 49681 49697 49711 49727 49739 49741 49747 49757 49783 49787 49789 49801 49807 49811 49823 49831 49843 49853 49871 49877 49891 49919 49921 49927 49937 49939 49943 49957 49991 49993 49999
diff -Nru ocaml-3.12.1/testsuite/tests/misc/sorts.ml ocaml-4.01.0/testsuite/tests/misc/sorts.ml
--- ocaml-3.12.1/testsuite/tests/misc/sorts.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc/sorts.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Damien Doligez, projet Moscova, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2000 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Test bench for sorting algorithms. *)
 
 
@@ -451,7 +463,7 @@
   let cmp = aux.prepf compare (<=) in
   table3 limit (f cmp) (fun n -> aux.prepd (mkfloats n));
 ;;
-
+
 (************************************************************************)
 (* merge sort on lists *)
 
@@ -501,7 +513,7 @@
   in
   mergeall_rev (init [] l)
 ;;
-
+
 let lmerge_1b cmp l =
   let rec init accu = function
     | [] -> accu
@@ -544,7 +556,7 @@
   in
   mergeall_rev (init [] l)
 ;;
-
+
 let lmerge_1c cmp l =
   let rec init accu = function
     | [] -> accu
@@ -591,7 +603,7 @@
   in
   mergeall_rev (init [] l)
 ;;
-
+
 let lmerge_1d cmp l =
   let rec init accu = function
     | [] -> accu
@@ -642,7 +654,7 @@
   in
   mergeall_rev (init [] l)
 ;;
-
+
 (************************************************************************)
 (* merge sort on lists, user-contributed (NOT STABLE) *)
 
@@ -704,7 +716,7 @@
     mergeall false (initlist l [])
 
 (* END code contributed by Yann Coscoy *)
-
+
 (************************************************************************)
 (* merge sort on short lists, Francois Pottier *)
 
@@ -760,7 +772,7 @@
         sort (List.length l) l
   ;;
 (* END code contributed by Francois Pottier *)
-
+
 (************************************************************************)
 (* merge sort on short lists, Francois Pottier,
    adapted to new-style interface *)
@@ -817,7 +829,7 @@
         sort (List.length l) l
   ;;
 (* END code contributed by Francois Pottier *)
-
+
 (************************************************************************)
 (* merge sort on short lists a la Pottier, modified merge *)
 
@@ -871,7 +883,7 @@
   let len = List.length l in
   if len < 2 then l else sort len l
 ;;
-
+
 (************************************************************************)
 (* merge sort on short lists a la Pottier, logarithmic stack space *)
 
@@ -943,7 +955,7 @@
   if len < 2 then l else sort len l
 ;;
 
-
+
 (************************************************************************)
 (* merge sort on short lists a la Pottier, logarithmic stack space,
    in place: input list is freed as the output is being computed. *)
@@ -1021,7 +1033,7 @@
   let len = List.length l in
   if len < 2 then l else sort len l
 ;;
-
+
 (************************************************************************)
 (* chop-free version of Pottier's code, binary version *)
 
@@ -1055,7 +1067,7 @@
   while !len > 0 do incr i; len := !len lsr 1; done;
   sort_prefix !i
 ;;
-
+
 (************************************************************************)
 (* chop-free version of Pottier's code, dichotomic version,
    ground cases 1 & 2 *)
@@ -1086,7 +1098,7 @@
   let len = List.length l in
   if len <= 1 then l else sort_prefix len
 ;;
-
+
 (************************************************************************)
 (* chop-free version of Pottier's code, dichotomic version,
    ground cases 2 & 3 *)
@@ -1126,7 +1138,7 @@
   let len = List.length l in
   if len <= 1 then l else sort_prefix len
 ;;
-
+
 (************************************************************************)
 (* chop-free, ref-free version of Pottier's code, dichotomic version,
    ground cases 2 & 3, modified merge *)
@@ -1171,7 +1183,7 @@
   let len = List.length l in
   if len <= 1 then l else fst (sort_prefix len l)
 ;;
-
+
 (************************************************************************)
 (* merge sort on arrays, merge with tail-rec function *)
 
@@ -1218,7 +1230,7 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 let amerge_1b cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
     let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
@@ -1276,7 +1288,7 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 let cutoff = 3;;
 let amerge_1c cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
@@ -1329,7 +1341,7 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 let cutoff = 4;;
 let amerge_1d cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
@@ -1382,7 +1394,7 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 let cutoff = 5;;
 let amerge_1e cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
@@ -1435,7 +1447,7 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 let cutoff = 6;;
 let amerge_1f cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
@@ -1488,7 +1500,7 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 let cutoff = 7;;
 let amerge_1g cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
@@ -1541,7 +1553,7 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 let cutoff = 8;;
 let amerge_1h cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
@@ -1594,7 +1606,7 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 let cutoff = 9;;
 let amerge_1i cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
@@ -1647,7 +1659,7 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 let cutoff = 10;;
 let amerge_1j cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
@@ -1700,13 +1712,13 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 (* FIXME a essayer: *)
 (* list->array->list direct et array->list->array direct *)
 (* overhead = 1/3, 1/4, etc. *)
 (* overhead = sqrt (n) *)
 (* overhead = n/3 jusqu'a 30k, 30k jusqu'a 900M, sqrt (n) au-dela *)
-
+
 (************************************************************************)
 (* merge sort on arrays, merge with loop *)
 
@@ -1754,7 +1766,7 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 let amerge_3b cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
     let i1 = ref src1ofs
@@ -1815,7 +1827,7 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 let cutoff = 3;;
 let amerge_3c cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
@@ -1870,7 +1882,7 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 let cutoff = 4;;
 let amerge_3d cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
@@ -1925,7 +1937,7 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 let cutoff = 5;;
 let amerge_3e cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
@@ -1980,7 +1992,7 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 let cutoff = 6;;
 let amerge_3f cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
@@ -2035,7 +2047,7 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 let cutoff = 7;;
 let amerge_3g cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
@@ -2090,7 +2102,7 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 let cutoff = 8;;
 let amerge_3h cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
@@ -2145,7 +2157,7 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 let cutoff = 9;;
 let amerge_3i cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
@@ -2200,7 +2212,7 @@
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
-
+
 let cutoff = 10;;
 let amerge_3j cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
@@ -2257,7 +2269,7 @@
 ;;
 
 (* FIXME essayer bottom-up merge on arrays ? *)
-
+
 (************************************************************************)
 (* Shell sort on arrays *)
 
@@ -2281,7 +2293,7 @@
     step := !step / 3;
   done;
 ;;
-
+
 let ashell_2 cmp a =
   let l = Array.length a in
   let step = ref 1 in
@@ -2300,7 +2312,7 @@
     step := !step / 3;
   done;
 ;;
-
+
 let ashell_3 cmp a =
   let l = Array.length a in
   let step = ref 1 in
@@ -2326,7 +2338,7 @@
     step := !step / 3;
   done;
 ;;
-
+
 let force = Lazy.force;;
 
 type iilist = Cons of int * iilist Lazy.t;;
@@ -2367,7 +2379,7 @@
   in
   loop2 sc;
 ;;
-
+
 (************************************************************************)
 (* Quicksort on arrays *)
 let cutoff = 1;;
@@ -2431,7 +2443,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 2;;
 let aquick_1b cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -2493,7 +2505,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 3;;
 let aquick_1c cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -2555,7 +2567,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 4;;
 let aquick_1d cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -2617,7 +2629,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 5;;
 let aquick_1e cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -2679,7 +2691,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 6;;
 let aquick_1f cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -2741,7 +2753,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 7;;
 let aquick_1g cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -2803,7 +2815,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 1;;
 let aquick_2a cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -2863,7 +2875,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 2;;
 let aquick_2b cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -2923,7 +2935,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 3;;
 let aquick_2c cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -2983,7 +2995,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 4;;
 let aquick_2d cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -3043,7 +3055,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 5;;
 let aquick_2e cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -3103,7 +3115,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 6;;
 let aquick_2f cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -3163,7 +3175,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 7;;
 let aquick_2g cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -3223,7 +3235,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 1;;
 let aquick_3a cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -3288,7 +3300,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 2;;
 let aquick_3b cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -3353,7 +3365,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 3;;
 let aquick_3c cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -3418,7 +3430,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 4;;
 let aquick_3d cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -3483,7 +3495,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 5;;
 let aquick_3e cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -3548,7 +3560,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 6;;
 let aquick_3f cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -3613,7 +3625,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 7;;
 let aquick_3g cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -3678,7 +3690,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 8;;
 let aquick_3h cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -3743,7 +3755,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 9;;
 let aquick_3i cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -3808,7 +3820,7 @@
     done;
   end;
 ;;
-
+
 let cutoff = 10;;
 let aquick_3j cmp a =
   let rec qsort l r =     (* ASSUMES r - l >= 2 *)
@@ -3873,7 +3885,7 @@
     done;
   end;
 ;;
-
+
 (************************************************************************)
 (* Heap sort on arrays (top-down, ternary) *)
 
@@ -3913,7 +3925,7 @@
   done;
   if !l > 1 then begin let e = a.(1) in a.(1) <- a.(0); a.(0) <- e; end;
 ;;
-
+
 (************************************************************************)
 (* Heap sort on arrays (top-down, binary) *)
 
@@ -3945,7 +3957,7 @@
     down i 0 e;
   done;
 ;;
-
+
 (************************************************************************)
 (* Heap sort on arrays (bottom-up, ternary) *)
 
@@ -3999,7 +4011,7 @@
   done;
   if l > 1 then (let e = a.(1) in a.(1) <- a.(0); a.(0) <- e);
 ;;
-
+
 (************************************************************************)
 (* Heap sort on arrays (bottom-up, binary) *)
 
@@ -4045,7 +4057,7 @@
   done;
   if l > 1 then (let e = a.(1) in a.(1) <- a.(0); a.(0) <- e);
 ;;
-
+
 (************************************************************************)
 (* heap sort, top-down, ternary, recursive final loop *)
 
@@ -4102,7 +4114,7 @@
     | 2 -> loop1 (l-1) l3;
     | _ -> assert false;
 ;;
-
+
 (************************************************************************)
 (* heap sort, top-down, ternary, with exception *)
 
@@ -4161,7 +4173,7 @@
     a.(j) <- e;
   done;
 ;;
-
+
 (************************************************************************)
 (* merge sort on lists via arrays *)
 
@@ -4231,7 +4243,7 @@
   in
   loop 0 l
 ;;
-
+
 (************************************************************************)
 
 let lold = [
@@ -4475,5 +4487,3 @@
 ;;
 
 if not !Sys.interactive then Printexc.catch main ();;
-
-(* $Id: sorts.ml 10713 2010-10-08 11:53:19Z doligez $ *)
diff -Nru ocaml-3.12.1/testsuite/tests/misc/takc.ml ocaml-4.01.0/testsuite/tests/misc/takc.ml
--- ocaml-3.12.1/testsuite/tests/misc/takc.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc/takc.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: takc.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 let rec tak x y z =
   if x > y then tak (tak (x-1) y z) (tak (y-1) z x) (tak (z-1) x y)
            else z
@@ -20,4 +18,3 @@
   if n <= 0 then 0 else tak 18 12 6 + repeat(n-1)
 
 let _ = print_int (repeat 2000); print_newline(); exit 0
-
diff -Nru ocaml-3.12.1/testsuite/tests/misc/taku.ml ocaml-4.01.0/testsuite/tests/misc/taku.ml
--- ocaml-3.12.1/testsuite/tests/misc/taku.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc/taku.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: taku.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 let rec tak (x, y, z) =
   if x > y then tak(tak (x-1, y, z), tak (y-1, z, x), tak (z-1, x, y))
            else z
diff -Nru ocaml-3.12.1/testsuite/tests/misc/weaktest.ml ocaml-4.01.0/testsuite/tests/misc/weaktest.ml
--- ocaml-3.12.1/testsuite/tests/misc/weaktest.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc/weaktest.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,4 +1,14 @@
-(* $Id: weaktest.ml 10713 2010-10-08 11:53:19Z doligez $ *)
+(*************************************************************************)
+(*                                                                       *)
+(*                                OCaml                                  *)
+(*                                                                       *)
+(*         Damien Doligez, projet Gallium, INRIA Rocquencourt            *)
+(*                                                                       *)
+(*   Copyright 2008 Institut National de Recherche en Informatique et    *)
+(*   en Automatique.  All rights reserved.  This file is distributed     *)
+(*   under the terms of the Q Public License version 1.0.                *)
+(*                                                                       *)
+(*************************************************************************)
 
 let debug = false;;
 
diff -Nru ocaml-3.12.1/testsuite/tests/misc-kb/Makefile ocaml-4.01.0/testsuite/tests/misc-kb/Makefile
--- ocaml-3.12.1/testsuite/tests/misc-kb/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc-kb/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,6 +1,19 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 MODULES=terms equations orderings kb
 MAIN_MODULE=kbmain
 ADD_COMPFLAGS=-w a
 
-include ../../makefiles/Makefile.one
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/misc-kb/equations.ml ocaml-4.01.0/testsuite/tests/misc-kb/equations.ml
--- ocaml-3.12.1/testsuite/tests/misc-kb/equations.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc-kb/equations.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,13 +10,11 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: equations.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (****************** Equation manipulations *************)
 
 open Terms
 
-type rule = 
+type rule =
   { number: int;
     numvars: int;
     lhs: term;
@@ -53,7 +51,7 @@
 
 
 let pretty_rules rules = List.iter pretty_rule rules
- 
+
 (****************** Rewriting **************************)
 
 (* Top-level rewriting. Let eq:L=R be an equation, M be a term such that L<=M.
@@ -112,4 +110,3 @@
     mrewrite_all rules (mrewrite1 rules m)
   with Failure _ ->
     m
-
diff -Nru ocaml-3.12.1/testsuite/tests/misc-kb/equations.mli ocaml-4.01.0/testsuite/tests/misc-kb/equations.mli
--- ocaml-3.12.1/testsuite/tests/misc-kb/equations.mli	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc-kb/equations.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,11 +10,9 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: equations.mli 10713 2010-10-08 11:53:19Z doligez $ *)
-
 open Terms
 
-type rule = 
+type rule =
   { number: int;
     numvars: int;
     lhs: term;
diff -Nru ocaml-3.12.1/testsuite/tests/misc-kb/kb.ml ocaml-4.01.0/testsuite/tests/misc-kb/kb.ml
--- ocaml-3.12.1/testsuite/tests/misc-kb/kb.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc-kb/kb.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: kb.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 open Terms
 open Equations
 
@@ -37,7 +35,7 @@
 
 
 (* Ex :
-let (m,_) = <> 
+let (m,_) = <>
 and (n,_) = <> in super m n
 ==> [[1],[2,Term ("B",[])];                      x <- B
      [2],[2,Term ("A",[]); 1,Term ("B",[])]]     x <- A  y <- B
@@ -109,7 +107,7 @@
 
 (* Improved Knuth-Bendix completion procedure *)
 
-let kb_completion greater = 
+let kb_completion greater =
   let rec kbrec j rules =
   let rec process failures (k,l) eqs =
 (****
@@ -165,7 +163,7 @@
                   (strict_critical_pairs el (rename rl.numvars el))
         else
           try
-            let rk = get_rule k rules in 
+            let rk = get_rule k rules in
             let ek = (rk.lhs, rk.rhs) in
               process failures (k,l)
                       (mutual_critical_pairs el (rename rl.numvars ek))
@@ -185,4 +183,3 @@
       kb_completion greater n complete_rules [] (n,n) eqs in
     print_string "Canonical set found :"; print_newline();
     pretty_rules (List.rev completed_rules)
-
diff -Nru ocaml-3.12.1/testsuite/tests/misc-kb/kb.mli ocaml-4.01.0/testsuite/tests/misc-kb/kb.mli
--- ocaml-3.12.1/testsuite/tests/misc-kb/kb.mli	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc-kb/kb.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: kb.mli 10713 2010-10-08 11:53:19Z doligez $ *)
-
 open Terms
 open Equations
 
diff -Nru ocaml-3.12.1/testsuite/tests/misc-kb/kbmain.ml ocaml-4.01.0/testsuite/tests/misc-kb/kbmain.ml
--- ocaml-3.12.1/testsuite/tests/misc-kb/kbmain.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc-kb/kbmain.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: kbmain.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 open Terms
 open Equations
 open Orderings
@@ -72,11 +70,10 @@
     if r1 = r2 then Equal else
     if r1 > r2 then Greater else NotGE
 
-let group_order = rpo group_precedence lex_ext 
+let group_order = rpo group_precedence lex_ext
 
 let greater pair =
   match group_order pair with Greater -> true | _ -> false
 
 let _ =
   for i = 1 to 20 do kb_complete greater [] geom_rules done
-
diff -Nru ocaml-3.12.1/testsuite/tests/misc-kb/orderings.ml ocaml-4.01.0/testsuite/tests/misc-kb/orderings.ml
--- ocaml-3.12.1/testsuite/tests/misc-kb/orderings.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc-kb/orderings.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,13 +10,11 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: orderings.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (*********************** Recursive Path Ordering ****************************)
 
 open Terms
 
-type ordering = 
+type ordering =
     Greater
   | Equal
   | NotGE
@@ -65,10 +63,10 @@
       | ( _ , []) -> Greater
       | (x1::l1, x2::l2) ->
           match order (x1,x2) with
-            Greater -> if List.for_all (fun n' -> gt_ord order (m,n')) l2 
+            Greater -> if List.for_all (fun n' -> gt_ord order (m,n')) l2
                        then Greater else NotGE
           | Equal -> lexrec (l1,l2)
-          | NotGE -> if List.exists (fun m' -> ge_ord order (m',n)) l1 
+          | NotGE -> if List.exists (fun m' -> ge_ord order (m',n)) l1
                      then Greater else NotGE in
       lexrec (sons1, sons2)
   | _ -> failwith "lex_ext"
@@ -76,9 +74,9 @@
 
 (* Recursive path ordering *)
 
-let rpo op_order ext = 
+let rpo op_order ext =
   let rec rporec (m,n) =
-    if m = n then Equal else 
+    if m = n then Equal else
       match m with
           Var vm -> NotGE
         | Term(op1,sons1) ->
@@ -96,4 +94,3 @@
                         if List.exists (fun m' -> ge_ord rporec (m',n)) sons1
                         then Greater else NotGE
   in rporec
-
diff -Nru ocaml-3.12.1/testsuite/tests/misc-kb/orderings.mli ocaml-4.01.0/testsuite/tests/misc-kb/orderings.mli
--- ocaml-3.12.1/testsuite/tests/misc-kb/orderings.mli	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc-kb/orderings.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,11 +10,9 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: orderings.mli 10713 2010-10-08 11:53:19Z doligez $ *)
-
 open Terms
 
-type ordering = 
+type ordering =
     Greater
   | Equal
   | NotGE
diff -Nru ocaml-3.12.1/testsuite/tests/misc-kb/terms.ml ocaml-4.01.0/testsuite/tests/misc-kb/terms.ml
--- ocaml-3.12.1/testsuite/tests/misc-kb/terms.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc-kb/terms.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,11 +10,9 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: terms.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (****************** Term manipulations *****************)
 
-type term = 
+type term =
     Var of int
   | Term of string * term list
 
@@ -22,7 +20,7 @@
   match l1 with
     []   -> l2
   | a::r -> if List.mem a l2 then union r l2 else a :: union r l2
-  
+
 
 let rec vars = function
     Var n -> [n]
@@ -73,7 +71,7 @@
 
 (* A naive unification algorithm. *)
 
-let compsubst subst1 subst2 = 
+let compsubst subst1 subst2 =
   (List.map (fun (v,t) -> (v, substitute subst1 t)) subst2) @ subst1
 
 
@@ -133,5 +131,3 @@
         pretty_term m
   | m ->
       pretty_term m
-
-
diff -Nru ocaml-3.12.1/testsuite/tests/misc-kb/terms.mli ocaml-4.01.0/testsuite/tests/misc-kb/terms.mli
--- ocaml-3.12.1/testsuite/tests/misc-kb/terms.mli	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc-kb/terms.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,9 +10,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: terms.mli 10713 2010-10-08 11:53:19Z doligez $ *)
-
-type term = 
+type term =
     Var of int
   | Term of string * term list
 
diff -Nru ocaml-3.12.1/testsuite/tests/misc-unsafe/Makefile ocaml-4.01.0/testsuite/tests/misc-unsafe/Makefile
--- ocaml-3.12.1/testsuite/tests/misc-unsafe/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc-unsafe/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,16 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 UNSAFE=ON
-include ../../makefiles/Makefile.several
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/misc-unsafe/almabench.ml ocaml-4.01.0/testsuite/tests/misc-unsafe/almabench.ml
--- ocaml-3.12.1/testsuite/tests/misc-unsafe/almabench.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc-unsafe/almabench.ml	2012-10-17 20:09:16.000000000 +0000
@@ -1,6 +1,6 @@
 (*
  * ALMABENCH 1.0.1
- * Objective Caml version
+ *      OCaml     version
  *
  *     A number-crunching benchmark designed for cross-language and vendor
  *     comparisons.
@@ -16,7 +16,7 @@
  *     Longitudes, Paris, France), as detailed in Astronomy & Astrophysics
  *     282, 663 (1994)
  *
- *    Note that the code herein is design for the purpose of testing 
+ *    Note that the code herein is design for the purpose of testing
  *     computational performance; error handling and other such "niceties"
  *    is virtually non-existent.
  *
@@ -68,7 +68,7 @@
   [|  19.2184460618;     -3716e-10;  979e-10 |];
   [|  30.1103868694;    -16635e-10;  686e-10 |] |]
 
-and dlm =        
+and dlm =
   [| [| 252.25090552; 5381016286.88982;  -1.92789 |];
      [| 181.97980085; 2106641364.33548;   0.59381 |];
      [| 100.46645683; 1295977422.83429;  -2.04411 |];
@@ -151,7 +151,7 @@
 
 (* tables giving the trigonometric terms to be added to the mean elements of
    the mean longitudes . *)
-and kq = 
+and kq =
   [| [|  3086.0; 15746.0; 69613.0; 59899.0; 75645.0; 88306.0; 12661.0; 2658.0;  0.0;   0.0 |];
      [| 21863.0; 32794.0; 10931.0;    73.0;  4387.0; 26934.0;  1473.0; 2157.0;  0.0;   0.0 |];
      [|    10.0; 16002.0; 21863.0; 10931.0;  1473.0; 32004.0;  4387.0;   73.0;  0.0;   0.0 |];
@@ -181,15 +181,15 @@
      [|  71234.0;-41116.0; 5334.0;-4935.0;-1848.0;   66.0;  434.0;-1748.0;  3780.0; -701.0 |];
      [| -47645.0; 11647.0; 2166.0; 3194.0;  679.0;    0.0; -244.0; -419.0; -2531.0;   48.0 |] |]
 
-  
+
 (* Normalize angle into the range -pi <= A < +pi. *)
 let anpm a =
   let w = mod_float a twopi in
     if abs_float w >= pic then begin
       if a < 0.0 then
-	w +. twopi
+        w +. twopi
       else
-	w -. twopi
+        w -. twopi
     end else
       w
 
@@ -204,10 +204,10 @@
   and de  = e.(np).(0) +. (e.(np).(1) +. e.(np).(2) *. t ) *. t
   and dp  = anpm ((3600.0 *. pi.(np).(0) +. (pi.(np).(1) +. pi.(np).(2) *. t ) *. t ) *. a2r )
   and  di  = (3600.0 *. dinc.(np).(0) +. (dinc.(np).(1) +. dinc.(np).(2) *. t ) *. t ) *. a2r
-  and doh = anpm ((3600.0 *. omega.(np).(0) +. (omega.(np).(1) +. omega.(np).(2) *. t ) *. t ) *. a2r )     
-	      (* apply the trigonometric terms. *)
+  and doh = anpm ((3600.0 *. omega.(np).(0) +. (omega.(np).(1) +. omega.(np).(2) *. t ) *. t ) *. a2r )
+              (* apply the trigonometric terms. *)
   and dmu = 0.35953620 *. t in
-    
+
   (* loop invariant *)
   let kp = kp.(np) and kq = kq.(np) and ca = ca.(np) and sa = sa.(np)
   and cl = cl.(np) and sl = sl.(np) in
@@ -231,20 +231,20 @@
     (* iterative solution of kepler's equation to get eccentric anomaly. *)
     let am = !dl -. dp in
     let ae = ref (am +. de *. sin am)
-    and k = ref 0 in 
+    and k = ref 0 in
     let dae = ref ((am -. !ae +. de *. sin !ae) /. (1.0 -. de *. cos !ae)) in
       ae := !ae +. !dae;
       incr k;
       while !k < 10 or abs_float !dae >= 1e-12 do
-	dae := (am -. !ae +. de *. sin !ae) /. (1.0 -. de *. cos !ae);
-	ae := !ae +. !dae;
-	incr k
+        dae := (am -. !ae +. de *. sin !ae) /. (1.0 -. de *. cos !ae);
+        ae := !ae +. !dae;
+        incr k
       done;
-      
+
       (* true anomaly. *)
       let ae2 = !ae /. 2.0 in
-      let at  = 2.0 *. atan2 (sqrt ((1.0 +. de) /. (1.0 -. de)) *. sin ae2)  (cos ae2) 
-		  (* distance (au) and speed (radians per day). *)
+      let at  = 2.0 *. atan2 (sqrt ((1.0 +. de) /. (1.0 -. de)) *. sin ae2)  (cos ae2)
+                  (* distance (au) and speed (radians per day). *)
       and r = !da *. (1.0 -. de *. cos !ae)
       and v = gaussk *. sqrt ((1.0 +. 1.0 /. amas.(np) ) /. (!da *. !da *. !da))
       and si2   = sin (di /. 2.0) in
@@ -253,7 +253,7 @@
       and tl = at +. dp in
       let xsw = sin tl
       and xcw = cos tl in
-      let xm2  = 2.0 *. (xp *. xcw -. xq *. xsw ) 
+      let xm2  = 2.0 *. (xp *. xcw -. xq *. xsw )
       and xf = !da /. sqrt (1.0 -. de *. de)
       and ci2 = cos (di /. 2.0) in
       let xms = (de *. sin dp +. xsw) *. xf
@@ -265,42 +265,42 @@
       and y = r *. (xsw +. xm2 *. xq)
       and z = r *. (-.xm2 *. ci2) in
 
-	(* rotate to equatorial. *)
-	pv.(0).(0) <- x;
-	pv.(0).(1) <- y *. coseps -. z *. sineps;
-	pv.(0).(2) <- y *. sineps +. z *. coseps;
-
-	(* velocity (j2000 ecliptic xdot,ydot,zdot in au/d). *)
-	let x = v *. ((-1.0 +. 2.0 *. xp *. xp) *. xms +. xpxq2 *. xmc)
-	and y = v *. (( 1.0 -. 2.0 *. xq *. xq ) *. xmc -. xpxq2 *. xms)
-	and z = v *. (2.0 *. ci2 *. (xp *. xms +. xq *. xmc)) in
-
-	  (* rotate to equatorial *)
-	  pv.(1).(0) <- x;
-	  pv.(1).(1) <- y *. coseps -. z *. sineps;
-	  pv.(1).(2) <- y *. sineps +. z *. coseps
+        (* rotate to equatorial. *)
+        pv.(0).(0) <- x;
+        pv.(0).(1) <- y *. coseps -. z *. sineps;
+        pv.(0).(2) <- y *. sineps +. z *. coseps;
+
+        (* velocity (j2000 ecliptic xdot,ydot,zdot in au/d). *)
+        let x = v *. ((-1.0 +. 2.0 *. xp *. xp) *. xms +. xpxq2 *. xmc)
+        and y = v *. (( 1.0 -. 2.0 *. xq *. xq ) *. xmc -. xpxq2 *. xms)
+        and z = v *. (2.0 *. ci2 *. (xp *. xms +. xq *. xmc)) in
+
+          (* rotate to equatorial *)
+          pv.(1).(0) <- x;
+          pv.(1).(1) <- y *. coseps -. z *. sineps;
+          pv.(1).(2) <- y *. sineps +. z *. coseps
 
 
-(* Computes RA, Declination, and distance from a state vector returned by 
+(* Computes RA, Declination, and distance from a state vector returned by
  * planetpv. *)
 let radecdist state rdd =
   (* Distance *)
   rdd.(2) <- sqrt (state.(0).(0) *. state.(0).(0)
-		 +. state.(0).(1) *. state.(0).(1)
-		 +. state.(0).(2) *. state.(0).(2));
+                 +. state.(0).(1) *. state.(0).(1)
+                 +. state.(0).(2) *. state.(0).(2));
   (* RA *)
   rdd.(0) <- atan2 state.(0).(1) state.(0).(0) *. r2h;
   if rdd.(0) < 0.0 then rdd.(0) <- rdd.(0) +. 24.0;
-  
+
   (* Declination *)
   rdd.(1) <- asin (state.(0).(2) /. rdd.(2)) *. r2d
-  
+
 
 
 (* Entry point. Calculate RA and Dec for noon on every day in 1900-2100 *)
 let _ =
   let jd = [| 0.0; 0.0 |]
-  and pv = [| [| 0.0; 0.0; 0.0 |]; [| 0.0; 0.0; 0.0 |] |] 
+  and pv = [| [| 0.0; 0.0; 0.0 |]; [| 0.0; 0.0; 0.0 |] |]
   and position = [| 0.0; 0.0; 0.0 |] in
   (* Test *)
   jd.(0) <- j2000;
@@ -317,8 +317,8 @@
     for n = 0 to test_length - 1 do
       jd.(0) <- jd.(0) +. 1.0;
       for p = 0 to 7 do
-	planetpv jd p pv;
-	radecdist pv position;
+        planetpv jd p pv;
+        radecdist pv position;
       done
     done
   done
diff -Nru ocaml-3.12.1/testsuite/tests/misc-unsafe/fft.ml ocaml-4.01.0/testsuite/tests/misc-unsafe/fft.ml
--- ocaml-3.12.1/testsuite/tests/misc-unsafe/fft.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc-unsafe/fft.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: fft.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 let pi = 3.14159265358979323846
 
 let tpi = 2.0 *. pi
@@ -19,17 +17,17 @@
 let fft px py np =
   let i = ref 2 in
   let m = ref 1 in
-  
+
   while (!i < np) do
-    i := !i + !i; 
+    i := !i + !i;
     m := !m + 1
   done;
 
-  let n = !i in  
-  
+  let n = !i in
+
   if n <> np then begin
     for i = np+1 to n do
-      px.(i) <- 0.0; 
+      px.(i) <- 0.0;
       py.(i) <- 0.0
     done;
     print_string "Use "; print_int n;
@@ -38,7 +36,7 @@
 
   let n2 = ref(n+n) in
   for k = 1 to !m-1 do
-    n2 := !n2 / 2; 
+    n2 := !n2 / 2;
     let n4 = !n2 / 4 in
     let e  = tpi /. float !n2 in
 
@@ -51,7 +49,7 @@
       let ss3 = sin(a3) in
       let is = ref j in
       let id = ref(2 * !n2) in
-  
+
         while !is < n do
           let i0r = ref !is in
           while !i0r < n do
@@ -71,13 +69,13 @@
              let r1 = r1 +. s2 in
              let s2 = r2 -. s1 in
              let r2 = r2 +. s1 in
-             px.(i2) <- r1*.cc1 -. s2*.ss1; 
+             px.(i2) <- r1*.cc1 -. s2*.ss1;
              py.(i2) <- -.s2*.cc1 -. r1*.ss1;
              px.(i3) <- s3*.cc3 +. r2*.ss3;
              py.(i3) <- r2*.cc3 -. s3*.ss3;
              i0r := i0 + !id
           done;
-          is := 2 * !id - !n2 + j; 
+          is := 2 * !id - !n2 + j;
           id := 4 * !id
         done
     done
@@ -89,7 +87,7 @@
 
   let is = ref 1 in
   let id = ref 4 in
-  
+
   while !is < n do
     let i0r = ref !is in
     while !i0r <= n do
@@ -103,7 +101,7 @@
       py.(i1) <- r1 -. py.(i1);
       i0r := i0 + !id
     done;
-    is := 2 * !id - 1; 
+    is := 2 * !id - 1;
     id := 4 * !id
   done;
 
@@ -112,11 +110,11 @@
 (*************************)
 
   let j = ref 1 in
-  
+
   for i = 1 to n - 1 do
     if i < !j then begin
       let xt = px.(!j) in
-      px.(!j) <- px.(i); 
+      px.(!j) <- px.(i);
       px.(i) <- xt;
       let xt = py.(!j) in
       py.(!j) <- py.(i);
@@ -124,7 +122,7 @@
     end;
     let k = ref(n / 2) in
     while !k < !j do
-      j := !j - !k; 
+      j := !j - !k;
       k := !k / 2
     done;
     j := !j + !k
@@ -170,12 +168,12 @@
   for i = 0 to np-1 do
       let a = abs_float(pxr.(i+1) -. float i) in
       if !zr < a then begin
-         zr := a; 
+         zr := a;
          kr := i
       end;
       let a = abs_float(pxi.(i+1)) in
       if !zi < a then begin
-         zi := a; 
+         zi := a;
          ki := i
       end
   done;
@@ -186,4 +184,3 @@
 
 let _ =
   let np = ref 16 in for i = 1 to 16 do test !np; np := !np*2 done
-
diff -Nru ocaml-3.12.1/testsuite/tests/misc-unsafe/quicksort.ml ocaml-4.01.0/testsuite/tests/misc-unsafe/quicksort.ml
--- ocaml-3.12.1/testsuite/tests/misc-unsafe/quicksort.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc-unsafe/quicksort.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: quicksort.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (* Good test for loops. Best compiled with -unsafe. *)
 
 let rec qsort lo hi (a : int array) =
diff -Nru ocaml-3.12.1/testsuite/tests/misc-unsafe/soli.ml ocaml-4.01.0/testsuite/tests/misc-unsafe/soli.ml
--- ocaml-3.12.1/testsuite/tests/misc-unsafe/soli.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/misc-unsafe/soli.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,9 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: soli.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
-
 type peg = Out | Empty | Peg
 
 let board = [|
diff -Nru ocaml-3.12.1/testsuite/tests/prim-bswap/Makefile ocaml-4.01.0/testsuite/tests/prim-bswap/Makefile
--- ocaml-3.12.1/testsuite/tests/prim-bswap/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/prim-bswap/Makefile	2013-01-06 17:22:09.000000000 +0000
@@ -0,0 +1,17 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                    Benedikt Meurer, os-cillation GmbH                 #
+#                                                                       #
+#     Copyright 1998 Institut National de Recherche en Informatique     #
+#     et en Automatique. Copyright 2013 Benedikt Meurer. All rights     #
+#     reserved.  This file is distributed  under the terms of the Q     #
+#     Public License version 1.0.                                       #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/prim-bswap/bswap.ml ocaml-4.01.0/testsuite/tests/prim-bswap/bswap.ml
--- ocaml-3.12.1/testsuite/tests/prim-bswap/bswap.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/prim-bswap/bswap.ml	2013-01-06 17:22:09.000000000 +0000
@@ -0,0 +1,30 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                   Benedikt Meurer, os-cillation GmbH                *)
+(*                                                                     *)
+(*    Copyright 1998 Institut National de Recherche en Informatique    *)
+(*    et en Automatique. Copyright 2013 Benedikt Meurer. All rights    *)
+(*    reserved.  This file is distributed  under the terms of the Q    *)
+(*    Public License version 1.0.                                      *)
+(*                                                                     *)
+(***********************************************************************)
+
+open Printf
+
+external bswap16: int -> int = "%bswap16"
+external bswap32: int32 -> int32 = "%bswap_int32"
+external bswap64: int64 -> int64 = "%bswap_int64"
+
+let d16 = [0x11223344;
+           0x0000f0f0]
+let d32 = [0x11223344l;
+           0xf0f0f0f0l]
+let d64 = [0x1122334455667788L;
+           0xf0f0f0f0f0f0f0f0L]
+
+let _ =
+  List.iter (fun x -> printf "%x\n" (bswap16 x)) d16;
+  List.iter (fun x -> printf "%lx\n" (bswap32 x)) d32;
+  List.iter (fun x -> printf "%Lx\n" (bswap64 x)) d64
diff -Nru ocaml-3.12.1/testsuite/tests/prim-bswap/bswap.reference ocaml-4.01.0/testsuite/tests/prim-bswap/bswap.reference
--- ocaml-3.12.1/testsuite/tests/prim-bswap/bswap.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/prim-bswap/bswap.reference	2013-01-06 17:22:09.000000000 +0000
@@ -0,0 +1,6 @@
+4433
+f0f0
+44332211
+f0f0f0f0
+8877665544332211
+f0f0f0f0f0f0f0f0
diff -Nru ocaml-3.12.1/testsuite/tests/prim-revapply/Makefile ocaml-4.01.0/testsuite/tests/prim-revapply/Makefile
--- ocaml-3.12.1/testsuite/tests/prim-revapply/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/prim-revapply/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,16 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/prim-revapply/apply.ml ocaml-4.01.0/testsuite/tests/prim-revapply/apply.ml
--- ocaml-3.12.1/testsuite/tests/prim-revapply/apply.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/prim-revapply/apply.ml	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,48 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                  Fabrice Le Fessant, INRIA Saclay                   *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+external ( @@ ) :  ('a -> 'b) -> 'a -> 'b = "%apply"
+
+let f x = x + x
+let g x = x * x
+let h x = x + 1
+let add x y = x + y
+
+let _ =
+  List.iter (fun x ->
+    print_int x; print_newline ()
+  )
+    [
+      f @@ 3; (* 6 *)
+      g @@ f @@ 3; (* 36 *)
+      f @@ g @@ 3; (* 18 *)
+      h @@ g @@ f @@ 3; (* 37 *)
+      add 4 @@ g @@ f @@ add 3 @@ add 2 @@ 3; (* 260 *)
+    ]
+external ( @@ ) :  ('a -> 'b) -> 'a -> 'b = "%apply"
+
+let f x = x + x
+let g x = x * x
+let h x = x + 1
+let add x y = x + y
+
+let _ =
+  List.iter (fun x ->
+    print_int x; print_newline ()
+  )
+    [
+      f @@ 3; (* 6 *)
+      g @@ f @@ 3; (* 36 *)
+      f @@ g @@ 3; (* 18 *)
+      h @@ g @@ f @@ 3; (* 37 *)
+      add 4 @@ g @@ f @@ add 3 @@ add 2 @@ 3; (* 260 *)
+    ]
diff -Nru ocaml-3.12.1/testsuite/tests/prim-revapply/apply.reference ocaml-4.01.0/testsuite/tests/prim-revapply/apply.reference
--- ocaml-3.12.1/testsuite/tests/prim-revapply/apply.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/prim-revapply/apply.reference	2012-01-23 14:49:39.000000000 +0000
@@ -0,0 +1,10 @@
+6
+36
+18
+37
+260
+6
+36
+18
+37
+260
diff -Nru ocaml-3.12.1/testsuite/tests/prim-revapply/revapply.ml ocaml-4.01.0/testsuite/tests/prim-revapply/revapply.ml
--- ocaml-3.12.1/testsuite/tests/prim-revapply/revapply.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/prim-revapply/revapply.ml	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,30 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                  Fabrice Le Fessant, INRIA Saclay                   *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+
+let f x = x + x
+let g x = x * x
+let h x = x + 1
+let add x y = x + y
+
+let _ =
+  List.iter (fun x ->
+    print_int x; print_newline ()
+  )
+    [
+      3 |> f; (* 6 *)
+      3 |> f |> g; (* 36 *)
+      3 |> g |> f; (* 18 *)
+      3 |> f |> g |> h; (* 37 *)
+      3 |> add 2 |> add 3 |> f |> g |> add 4; (* 260 *)
+    ]
diff -Nru ocaml-3.12.1/testsuite/tests/prim-revapply/revapply.reference ocaml-4.01.0/testsuite/tests/prim-revapply/revapply.reference
--- ocaml-3.12.1/testsuite/tests/prim-revapply/revapply.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/prim-revapply/revapply.reference	2012-01-23 14:49:39.000000000 +0000
@@ -0,0 +1,5 @@
+6
+36
+18
+37
+260
diff -Nru ocaml-3.12.1/testsuite/tests/regression/camlp4-class-type-plus/Makefile ocaml-4.01.0/testsuite/tests/regression/camlp4-class-type-plus/Makefile
--- ocaml-3.12.1/testsuite/tests/regression/camlp4-class-type-plus/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/regression/camlp4-class-type-plus/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,17 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+ADD_COMPFLAGS = -pp 'camlp4o'
+MAIN_MODULE = camlp4_class_type_plus_ok
+
+include ../../../makefiles/Makefile.okbad
+include ../../../makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/regression/camlp4-class-type-plus/camlp4_class_type_plus_ok.ml ocaml-4.01.0/testsuite/tests/regression/camlp4-class-type-plus/camlp4_class_type_plus_ok.ml
--- ocaml-3.12.1/testsuite/tests/regression/camlp4-class-type-plus/camlp4_class_type_plus_ok.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/regression/camlp4-class-type-plus/camlp4_class_type_plus_ok.ml	2013-04-04 15:27:13.000000000 +0000
@@ -0,0 +1,21 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Damien Doligez, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2011 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+type t;;
+type xdr_value;;
+
+class type [ 't ] engine = object
+end;;
+
+module type T = sig
+class unbound_async_call : t -> [xdr_value] engine;;
+end;;
diff -Nru ocaml-3.12.1/testsuite/tests/regression/pr5080-notes/Makefile ocaml-4.01.0/testsuite/tests/regression/pr5080-notes/Makefile
--- ocaml-3.12.1/testsuite/tests/regression/pr5080-notes/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/regression/pr5080-notes/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,17 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+ADD_COMPFLAGS = -pp 'camlp4o pa_macro.cmo'
+MAIN_MODULE = pr5080_notes_ok
+
+include ../../../makefiles/Makefile.okbad
+include ../../../makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/regression/pr5080-notes/pr5080_notes_ok.ml ocaml-4.01.0/testsuite/tests/regression/pr5080-notes/pr5080_notes_ok.ml
--- ocaml-3.12.1/testsuite/tests/regression/pr5080-notes/pr5080_notes_ok.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/regression/pr5080-notes/pr5080_notes_ok.ml	2013-04-04 15:27:13.000000000 +0000
@@ -0,0 +1,16 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Damien Doligez, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2011 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+let marshal_int f  =
+  match [] with
+  | _ :: `INT n :: _ -> f n
+  | _ -> failwith "marshal_int"
diff -Nru ocaml-3.12.1/testsuite/tests/regression/pr5233/Makefile ocaml-4.01.0/testsuite/tests/regression/pr5233/Makefile
--- ocaml-3.12.1/testsuite/tests/regression/pr5233/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/regression/pr5233/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,16 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+MAIN_MODULE=pr5233
+
+include ../../../makefiles/Makefile.one
+include ../../../makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/regression/pr5233/pr5233.ml ocaml-4.01.0/testsuite/tests/regression/pr5233/pr5233.ml
--- ocaml-3.12.1/testsuite/tests/regression/pr5233/pr5233.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/regression/pr5233/pr5233.ml	2013-04-04 15:27:13.000000000 +0000
@@ -0,0 +1,62 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Damien Doligez, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+open Printf;;
+
+(* PR#5233: Create a dangling pointer and use it to access random parts
+   of the heap. *)
+
+(* The buggy weak array will end up in smuggle. *)
+let smuggle = ref (Weak.create 1);;
+
+(* This will be the weak array (W). *)
+let t = ref (Weak.create 1);;
+
+(* Set a finalisation function on W. *)
+Gc.finalise (fun w -> smuggle := w) !t;;
+
+(* Free W and run its finalisation function. *)
+t := Weak.create 1;;
+Gc.full_major ();;
+
+(* smuggle now contains W, whose pointers are not erased, even
+   when the contents is deallocated. *)
+
+let size = 1_000_000;;
+
+let check o =
+  printf "checking...";
+  match o with
+  | None -> printf " no value\n";
+  | Some s ->
+     printf " value found  /  testing...";
+     for i = 0 to size - 1 do
+       if s.[i] != ' ' then failwith "bad";
+     done;
+     printf " ok\n";
+;;
+
+Weak.set !smuggle 0 (Some (String.make size ' '));;
+
+(* Check the data just to make sure. *)
+check (Weak.get !smuggle 0);;
+
+(* Get a dangling pointer in W. *)
+Gc.full_major ();;
+
+(* Fill the heap with other stuff. *)
+let rec fill n accu = if n = 0 then accu else fill (n-1) (123 :: accu);;
+let r = fill ((Gc.stat ()).Gc.heap_words / 3) [];;
+Gc.minor ();;
+
+(* Now follow the dangling pointer and exhibit the problem. *)
+check (Weak.get !smuggle 0);;
diff -Nru ocaml-3.12.1/testsuite/tests/regression/pr5233/pr5233.reference ocaml-4.01.0/testsuite/tests/regression/pr5233/pr5233.reference
--- ocaml-3.12.1/testsuite/tests/regression/pr5233/pr5233.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/regression/pr5233/pr5233.reference	2012-06-21 13:43:03.000000000 +0000
@@ -0,0 +1,2 @@
+checking... value found  /  testing... ok
+checking... no value
diff -Nru ocaml-3.12.1/testsuite/tests/regression/pr5757/Makefile ocaml-4.01.0/testsuite/tests/regression/pr5757/Makefile
--- ocaml-3.12.1/testsuite/tests/regression/pr5757/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/regression/pr5757/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,16 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+MAIN_MODULE=pr5757
+
+include ../../../makefiles/Makefile.one
+include ../../../makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/regression/pr5757/pr5757.ml ocaml-4.01.0/testsuite/tests/regression/pr5757/pr5757.ml
--- ocaml-3.12.1/testsuite/tests/regression/pr5757/pr5757.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/regression/pr5757/pr5757.ml	2013-04-04 15:27:13.000000000 +0000
@@ -0,0 +1,17 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Damien Doligez, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+Random.init 3;;
+for i = 0 to 100_000 do
+  ignore (String.create (Random.int 1_000_000))
+done;;
+Printf.printf "hello world\n";;
diff -Nru ocaml-3.12.1/testsuite/tests/regression/pr5757/pr5757.reference ocaml-4.01.0/testsuite/tests/regression/pr5757/pr5757.reference
--- ocaml-3.12.1/testsuite/tests/regression/pr5757/pr5757.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/regression/pr5757/pr5757.reference	2012-09-10 09:52:09.000000000 +0000
@@ -0,0 +1 @@
+hello world
diff -Nru ocaml-3.12.1/testsuite/tests/regression/pr6024/Makefile ocaml-4.01.0/testsuite/tests/regression/pr6024/Makefile
--- ocaml-3.12.1/testsuite/tests/regression/pr6024/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/regression/pr6024/Makefile	2013-05-29 15:56:25.000000000 +0000
@@ -0,0 +1,16 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#           Damien Doligez, projet Gallium, INRIA Rocquencourt          #
+#                                                                       #
+#   Copyright 2013 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+MAIN_MODULE=pr6024
+
+include ../../../makefiles/Makefile.one
+include ../../../makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/regression/pr6024/pr6024.ml ocaml-4.01.0/testsuite/tests/regression/pr6024/pr6024.ml
--- ocaml-3.12.1/testsuite/tests/regression/pr6024/pr6024.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/regression/pr6024/pr6024.ml	2013-05-29 15:56:25.000000000 +0000
@@ -0,0 +1,13 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Damien Doligez, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2013 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+Format.printf "@[%@-@@-@]@.";;
diff -Nru ocaml-3.12.1/testsuite/tests/regression/pr6024/pr6024.reference ocaml-4.01.0/testsuite/tests/regression/pr6024/pr6024.reference
--- ocaml-3.12.1/testsuite/tests/regression/pr6024/pr6024.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/regression/pr6024/pr6024.reference	2013-05-29 15:56:25.000000000 +0000
@@ -0,0 +1 @@
+@-@-
diff -Nru ocaml-3.12.1/testsuite/tests/regression-camlp4-class-type-plus/Makefile ocaml-4.01.0/testsuite/tests/regression-camlp4-class-type-plus/Makefile
--- ocaml-3.12.1/testsuite/tests/regression-camlp4-class-type-plus/Makefile	2011-06-10 17:39:11.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/regression-camlp4-class-type-plus/Makefile	1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-ADD_COMPFLAGS = -pp 'camlp4o'
-MAIN_MODULE = camlp4_class_type_plus_ok
-
-include ../../makefiles/Makefile.okbad
-include ../../makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/regression-camlp4-class-type-plus/camlp4_class_type_plus_ok.ml ocaml-4.01.0/testsuite/tests/regression-camlp4-class-type-plus/camlp4_class_type_plus_ok.ml
--- ocaml-3.12.1/testsuite/tests/regression-camlp4-class-type-plus/camlp4_class_type_plus_ok.ml	2011-06-10 17:39:11.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/regression-camlp4-class-type-plus/camlp4_class_type_plus_ok.ml	1970-01-01 00:00:00.000000000 +0000
@@ -1,9 +0,0 @@
-type t;;
-type xdr_value;;
-
-class type [ 't ] engine = object
-end;;
-
-module type T = sig
-class unbound_async_call : t -> [xdr_value] engine;;
-end;;
diff -Nru ocaml-3.12.1/testsuite/tests/regression-pr5080-notes/Makefile ocaml-4.01.0/testsuite/tests/regression-pr5080-notes/Makefile
--- ocaml-3.12.1/testsuite/tests/regression-pr5080-notes/Makefile	2011-06-10 17:39:11.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/regression-pr5080-notes/Makefile	1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-ADD_COMPFLAGS = -pp 'camlp4o pa_macro.cmo'
-MAIN_MODULE = pr5080_notes_ok
-
-include ../../makefiles/Makefile.okbad
-include ../../makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/regression-pr5080-notes/pr5080_notes_ok.ml ocaml-4.01.0/testsuite/tests/regression-pr5080-notes/pr5080_notes_ok.ml
--- ocaml-3.12.1/testsuite/tests/regression-pr5080-notes/pr5080_notes_ok.ml	2011-06-10 17:39:11.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/regression-pr5080-notes/pr5080_notes_ok.ml	1970-01-01 00:00:00.000000000 +0000
@@ -1,4 +0,0 @@
-let marshal_int f  =
-  match [] with
-  | _ :: `INT n :: _ -> f n
-  | _ -> failwith "marshal_int"
diff -Nru ocaml-3.12.1/testsuite/tests/runtime-errors/.ignore ocaml-4.01.0/testsuite/tests/runtime-errors/.ignore
--- ocaml-3.12.1/testsuite/tests/runtime-errors/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/runtime-errors/.ignore	2011-07-20 15:37:36.000000000 +0000
@@ -0,0 +1 @@
+*.bytecode
diff -Nru ocaml-3.12.1/testsuite/tests/runtime-errors/.svnignore ocaml-4.01.0/testsuite/tests/runtime-errors/.svnignore
--- ocaml-3.12.1/testsuite/tests/runtime-errors/.svnignore	2011-05-17 12:08:13.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/runtime-errors/.svnignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,11 +0,0 @@
-#!/bin/sh
-
-svn propset svn:ignore -F - . < $$f.result 2>&1; true); \
-	  diff -q $$f.reference $$f.result > /dev/null || (echo " => failed" && exit 1) && echo " => passed"; \
-	  printf " ... testing '`basename $$f bytecode`native':"; \
-	  (./`basename $$f bytecode`native > `basename $$f bytecode`native.result 2>&1; true); \
-	  diff -q `basename $$f bytecode`native.reference `basename $$f bytecode`native.result > /dev/null || (echo " => failed" && exit 1) && echo " => passed"; \
+	  $(OCAMLRUN) ./$$f >$$f.result 2>&1 || true; \
+	  DIFF="$(DIFF)" sh $$f.checker \
+	  && echo " => passed" || echo " => failed"; \
+	  fn=`basename $$f bytecode`native; \
+	  if $(BYTECODE_ONLY) || [ ! -f "$${fn}$(EXE)" ] ; then : ; else \
+	    printf " ... testing '$$fn':"; \
+	    ./$${fn}$(EXE) >$$fn.result 2>&1 || true; \
+	    DIFF="$(DIFF)" sh $$fn.checker \
+	    && echo " => passed" || echo " => failed"; \
+	  fi; \
 	done
 
+.PHONY: promote
+promote: defaultpromote
+
+.PHONY: clean
 clean: defaultclean
-	@rm -f *.bytecode *.native *.result
+	@rm -f *.bytecode *.native *.native.exe *.result
 
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/runtime-errors/stackoverflow.bytecode.checker ocaml-4.01.0/testsuite/tests/runtime-errors/stackoverflow.bytecode.checker
--- ocaml-3.12.1/testsuite/tests/runtime-errors/stackoverflow.bytecode.checker	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/runtime-errors/stackoverflow.bytecode.checker	2013-04-29 17:02:29.000000000 +0000
@@ -0,0 +1,14 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#           Damien Doligez, projet Gallium, INRIA Rocquencourt          #
+#                                                                       #
+#   Copyright 2013 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+$DIFF stackoverflow.bytecode.reference stackoverflow.bytecode.result
+
diff -Nru ocaml-3.12.1/testsuite/tests/runtime-errors/stackoverflow.bytecode.reference ocaml-4.01.0/testsuite/tests/runtime-errors/stackoverflow.bytecode.reference
--- ocaml-3.12.1/testsuite/tests/runtime-errors/stackoverflow.bytecode.reference	2010-01-25 14:26:23.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/runtime-errors/stackoverflow.bytecode.reference	2011-12-20 14:38:53.000000000 +0000
@@ -1,5 +1,4 @@
-x = 196608
-x = 131072
-x = 65536
+x = 20000
+x = 10000
 x = 0
 Stack overflow caught
diff -Nru ocaml-3.12.1/testsuite/tests/runtime-errors/stackoverflow.ml ocaml-4.01.0/testsuite/tests/runtime-errors/stackoverflow.ml
--- ocaml-3.12.1/testsuite/tests/runtime-errors/stackoverflow.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/runtime-errors/stackoverflow.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1,5 +1,17 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2001 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let rec f x =
-  if x land 0xFFFF <> 0
+  if not (x = 0 || x = 10000 || x = 20000)
   then 1 + f (x + 1)
   else
     try
diff -Nru ocaml-3.12.1/testsuite/tests/runtime-errors/stackoverflow.native.checker ocaml-4.01.0/testsuite/tests/runtime-errors/stackoverflow.native.checker
--- ocaml-3.12.1/testsuite/tests/runtime-errors/stackoverflow.native.checker	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/runtime-errors/stackoverflow.native.checker	2013-04-29 17:02:29.000000000 +0000
@@ -0,0 +1,14 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#           Damien Doligez, projet Gallium, INRIA Rocquencourt          #
+#                                                                       #
+#   Copyright 2013 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+$DIFF stackoverflow.native.reference stackoverflow.native.result
+
diff -Nru ocaml-3.12.1/testsuite/tests/runtime-errors/stackoverflow.native.reference ocaml-4.01.0/testsuite/tests/runtime-errors/stackoverflow.native.reference
--- ocaml-3.12.1/testsuite/tests/runtime-errors/stackoverflow.native.reference	2010-01-25 14:26:23.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/runtime-errors/stackoverflow.native.reference	2011-12-20 14:38:53.000000000 +0000
@@ -1,65 +1,4 @@
-x = 4128768
-x = 4063232
-x = 3997696
-x = 3932160
-x = 3866624
-x = 3801088
-x = 3735552
-x = 3670016
-x = 3604480
-x = 3538944
-x = 3473408
-x = 3407872
-x = 3342336
-x = 3276800
-x = 3211264
-x = 3145728
-x = 3080192
-x = 3014656
-x = 2949120
-x = 2883584
-x = 2818048
-x = 2752512
-x = 2686976
-x = 2621440
-x = 2555904
-x = 2490368
-x = 2424832
-x = 2359296
-x = 2293760
-x = 2228224
-x = 2162688
-x = 2097152
-x = 2031616
-x = 1966080
-x = 1900544
-x = 1835008
-x = 1769472
-x = 1703936
-x = 1638400
-x = 1572864
-x = 1507328
-x = 1441792
-x = 1376256
-x = 1310720
-x = 1245184
-x = 1179648
-x = 1114112
-x = 1048576
-x = 983040
-x = 917504
-x = 851968
-x = 786432
-x = 720896
-x = 655360
-x = 589824
-x = 524288
-x = 458752
-x = 393216
-x = 327680
-x = 262144
-x = 196608
-x = 131072
-x = 65536
+x = 20000
+x = 10000
 x = 0
 Stack overflow caught
diff -Nru ocaml-3.12.1/testsuite/tests/runtime-errors/syserror.bytecode.checker ocaml-4.01.0/testsuite/tests/runtime-errors/syserror.bytecode.checker
--- ocaml-3.12.1/testsuite/tests/runtime-errors/syserror.bytecode.checker	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/runtime-errors/syserror.bytecode.checker	2013-04-29 17:02:29.000000000 +0000
@@ -0,0 +1,16 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#           Damien Doligez, projet Gallium, INRIA Rocquencourt          #
+#                                                                       #
+#   Copyright 2013 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+grep 'Fatal error: exception Sys_error' syserror.bytecode.result >/dev/null
+
+
+
diff -Nru ocaml-3.12.1/testsuite/tests/runtime-errors/syserror.ml ocaml-4.01.0/testsuite/tests/runtime-errors/syserror.ml
--- ocaml-3.12.1/testsuite/tests/runtime-errors/syserror.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/runtime-errors/syserror.ml	2013-04-04 15:27:13.000000000 +0000
@@ -1 +1,13 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 let channel = open_out "titi:/toto"
diff -Nru ocaml-3.12.1/testsuite/tests/runtime-errors/syserror.native.checker ocaml-4.01.0/testsuite/tests/runtime-errors/syserror.native.checker
--- ocaml-3.12.1/testsuite/tests/runtime-errors/syserror.native.checker	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/runtime-errors/syserror.native.checker	2013-04-29 17:02:29.000000000 +0000
@@ -0,0 +1,13 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#           Damien Doligez, projet Gallium, INRIA Rocquencourt          #
+#                                                                       #
+#   Copyright 2013 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+grep 'Fatal error: exception Sys_error' syserror.native.result >/dev/null
diff -Nru ocaml-3.12.1/testsuite/tests/tool-lexyacc/.ignore ocaml-4.01.0/testsuite/tests/tool-lexyacc/.ignore
--- ocaml-3.12.1/testsuite/tests/tool-lexyacc/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-lexyacc/.ignore	2012-07-17 15:31:12.000000000 +0000
@@ -0,0 +1,3 @@
+scanner.ml
+grammar.mli
+grammar.ml
diff -Nru ocaml-3.12.1/testsuite/tests/tool-lexyacc/.svnignore ocaml-4.01.0/testsuite/tests/tool-lexyacc/.svnignore
--- ocaml-3.12.1/testsuite/tests/tool-lexyacc/.svnignore	2011-05-17 12:08:13.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-lexyacc/.svnignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,13 +0,0 @@
-#!/bin/sh
-
-svn propset svn:ignore -F - . < []
   | a::l -> if List.mem a l2 then subtract l l2 else a :: subtract l l2
-
diff -Nru ocaml-3.12.1/testsuite/tests/tool-lexyacc/grammar.mly ocaml-4.01.0/testsuite/tests/tool-lexyacc/grammar.mly
--- ocaml-3.12.1/testsuite/tests/tool-lexyacc/grammar.mly	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-lexyacc/grammar.mly	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -10,8 +10,6 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: grammar.mly 10713 2010-10-08 11:53:19Z doligez $ */
-
 /* The grammar for lexer definitions */
 
 %{
@@ -50,7 +48,7 @@
 other_definitions:
     other_definitions Tand definition
         { $3::$1 }
-  |     
+  |
         { [] }
 ;
 definition:
@@ -111,4 +109,3 @@
 ;
 
 %%
-
diff -Nru ocaml-3.12.1/testsuite/tests/tool-lexyacc/input ocaml-4.01.0/testsuite/tests/tool-lexyacc/input
--- ocaml-3.12.1/testsuite/tests/tool-lexyacc/input	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-lexyacc/input	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: input 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (* The lexical analyzer for lexer definitions. *)
 
 {
@@ -21,27 +19,27 @@
 }
 
 rule main = parse
-    [' ' '\010' '\013' '\009' ] + 
+    [' ' '\010' '\013' '\009' ] +
     { main lexbuf }
-  | "(*" 
+  | "(*"
     { comment_depth := 1;
       comment lexbuf;
       main lexbuf }
   | (['A'-'Z' 'a'-'z'] | '_' ['A'-'Z' 'a'-'z' '\'' '0'-'9'])
-    ( '_' ? ['A'-'Z' 'a'-'z' ''' '0'-'9'] ) * 
+    ( '_' ? ['A'-'Z' 'a'-'z' ''' '0'-'9'] ) *
     { match Lexing.lexeme lexbuf with
         "rule" -> Trule
       | "parse" -> Tparse
       | "and" -> Tand
       | "eof" -> Teof
       | s -> Tident s }
-  | '"' 
+  | '"'
     { reset_string_buffer();
       string lexbuf;
       Tstring(get_stored_string()) }
-  | "'" 
+  | "'"
     { Tchar(char lexbuf) }
-  | '{' 
+  | '{'
     { let n1 = Lexing.lexeme_end lexbuf in
         brace_depth := 1;
         let n2 = action lexbuf in
@@ -66,68 +64,68 @@
     { raise(Lexical_error("illegal character " ^ Lexing.lexeme lexbuf)) }
 
 and action = parse
-    '{' 
+    '{'
     { incr brace_depth;
       action lexbuf }
-  | '}' 
+  | '}'
     { decr brace_depth;
       if !brace_depth = 0 then Lexing.lexeme_start lexbuf else action lexbuf }
-  | '"' 
+  | '"'
     { reset_string_buffer();
       string lexbuf;
       reset_string_buffer();
       action lexbuf }
   | '\''
     { let _ = char lexbuf in action lexbuf }
-  | "(*" 
+  | "(*"
     { comment_depth := 1;
       comment lexbuf;
       action lexbuf }
-  | eof 
+  | eof
     { raise (Lexical_error "unterminated action") }
-  | _ 
+  | _
     { action lexbuf }
-      
+
 and string = parse
-    '"' 
+    '"'
     { () }
   | '\\' [' ' '\010' '\013' '\009' '\026' '\012'] +
     { string lexbuf }
-  | '\\' ['\\' '"' 'n' 't' 'b' 'r'] 
+  | '\\' ['\\' '"' 'n' 't' 'b' 'r']
     { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
       string lexbuf }
-  | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] 
+  | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
     { store_string_char(char_for_decimal_code lexbuf 1);
       string lexbuf }
-  | eof 
+  | eof
     { raise(Lexical_error "unterminated string") }
-  | _ 
+  | _
     { store_string_char(Lexing.lexeme_char lexbuf 0);
       string lexbuf }
 
 and char = parse
-    [^ '\\'] "'" 
+    [^ '\\'] "'"
     { Lexing.lexeme_char lexbuf 0 }
-  | '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'" 
+  | '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'"
     { char_for_backslash (Lexing.lexeme_char lexbuf 1) }
-  | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'" 
+  | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
     { char_for_decimal_code lexbuf 1 }
-  | _ 
+  | _
     { raise(Lexical_error "bad character constant") }
 
 and comment = parse
-    "(*" 
+    "(*"
     { incr comment_depth; comment lexbuf }
-  | "*)" 
+  | "*)"
     { decr comment_depth;
       if !comment_depth = 0 then () else comment lexbuf }
-  | '"' 
+  | '"'
     { reset_string_buffer();
       string lexbuf;
       reset_string_buffer();
       comment lexbuf }
-  | eof 
+  | eof
     { raise(Lexical_error "unterminated comment") }
-  | _ 
+  | _
     { comment lexbuf }
 ;;
diff -Nru ocaml-3.12.1/testsuite/tests/tool-lexyacc/input.ml ocaml-4.01.0/testsuite/tests/tool-lexyacc/input.ml
--- ocaml-3.12.1/testsuite/tests/tool-lexyacc/input.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-lexyacc/input.ml	1970-01-01 00:00:00.000000000 +0000
@@ -1,312 +0,0 @@
-
-open Syntax
-open Grammar
-open Scan_aux
-
-let rec action_43 lexbuf = (
- comment lexbuf )
-and action_42 lexbuf = (
- raise(Lexical_error "unterminated comment") )
-and action_41 lexbuf = (
- reset_string_buffer();
-      string lexbuf;
-      reset_string_buffer();
-      comment lexbuf )
-and action_40 lexbuf = (
- decr comment_depth;
-      if !comment_depth = 0 then () else comment lexbuf )
-and action_39 lexbuf = (
- incr comment_depth; comment lexbuf )
-and action_38 lexbuf = (
- raise(Lexical_error "bad character constant") )
-and action_37 lexbuf = (
- char_for_decimal_code lexbuf 1 )
-and action_36 lexbuf = (
- char_for_backslash (Lexing.lexeme_char lexbuf 1) )
-and action_35 lexbuf = (
- Lexing.lexeme_char lexbuf 0 )
-and action_34 lexbuf = (
- store_string_char(Lexing.lexeme_char lexbuf 0);
-      string lexbuf )
-and action_33 lexbuf = (
- raise(Lexical_error "unterminated string") )
-and action_32 lexbuf = (
- store_string_char(char_for_decimal_code lexbuf 1);
-      string lexbuf )
-and action_31 lexbuf = (
- store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
-      string lexbuf )
-and action_30 lexbuf = (
- string lexbuf )
-and action_29 lexbuf = (
- () )
-and action_28 lexbuf = (
- action lexbuf )
-and action_27 lexbuf = (
- raise (Lexical_error "unterminated action") )
-and action_26 lexbuf = (
- comment_depth := 1;
-      comment lexbuf;
-      action lexbuf )
-and action_25 lexbuf = (
- let _ = char lexbuf in action lexbuf )
-and action_24 lexbuf = (
- reset_string_buffer();
-      string lexbuf;
-      reset_string_buffer();
-      action lexbuf )
-and action_23 lexbuf = (
- decr brace_depth;
-      if !brace_depth = 0 then Lexing.lexeme_start lexbuf else action lexbuf )
-and action_22 lexbuf = (
- incr brace_depth;
-      action lexbuf )
-and action_21 lexbuf = (
- raise(Lexical_error("illegal character " ^ Lexing.lexeme lexbuf)) )
-and action_20 lexbuf = (
- raise(Lexical_error "unterminated lexer definition") )
-and action_19 lexbuf = (
- Tdash )
-and action_18 lexbuf = (
- Tcaret )
-and action_17 lexbuf = (
- Trparen )
-and action_16 lexbuf = (
- Tlparen )
-and action_15 lexbuf = (
- Tplus )
-and action_14 lexbuf = (
- Tmaybe )
-and action_13 lexbuf = (
- Tstar )
-and action_12 lexbuf = (
- Trbracket )
-and action_11 lexbuf = (
- Tlbracket )
-and action_10 lexbuf = (
- Teof )
-and action_9 lexbuf = (
- Tunderscore )
-and action_8 lexbuf = (
- Tor )
-and action_7 lexbuf = (
- Tend )
-and action_6 lexbuf = (
- Tequal )
-and action_5 lexbuf = (
- let n1 = Lexing.lexeme_end lexbuf in
-        brace_depth := 1;
-        let n2 = action lexbuf in
-          Taction(Location(n1, n2)) )
-and action_4 lexbuf = (
- Tchar(char lexbuf) )
-and action_3 lexbuf = (
- reset_string_buffer();
-      string lexbuf;
-      Tstring(get_stored_string()) )
-and action_2 lexbuf = (
- match Lexing.lexeme lexbuf with
-        "rule" -> Trule
-      | "parse" -> Tparse
-      | "and" -> Tand
-      | "eof" -> Teof
-      | s -> Tident s )
-and action_1 lexbuf = (
- comment_depth := 1;
-      comment lexbuf;
-      main lexbuf )
-and action_0 lexbuf = (
- main lexbuf )
-and state_0 lexbuf =
-  match lexing.next_char lexbuf with
-    'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A' -> state_51 lexbuf
- |  ' '|'\013'|'\n'|'\t' -> state_40 lexbuf
- |  '|' -> action_8 lexbuf
- |  '{' -> action_5 lexbuf
- |  'e' -> state_56 lexbuf
- |  '_' -> state_55 lexbuf
- |  '^' -> action_18 lexbuf
- |  ']' -> action_12 lexbuf
- |  '[' -> action_11 lexbuf
- |  '?' -> action_14 lexbuf
- |  '=' -> action_6 lexbuf
- |  ';' -> state_48 lexbuf
- |  '-' -> action_19 lexbuf
- |  '+' -> action_15 lexbuf
- |  '*' -> action_13 lexbuf
- |  ')' -> action_17 lexbuf
- |  '(' -> state_43 lexbuf
- |  '\'' -> action_4 lexbuf
- |  '"' -> action_3 lexbuf
- |  '\000' -> action_20 lexbuf
- |  _ -> action_21 lexbuf
-and state_1 lexbuf =
-  match lexing.next_char lexbuf with
-    '}' -> action_23 lexbuf
- |  '{' -> action_22 lexbuf
- |  '(' -> state_34 lexbuf
- |  '\'' -> action_25 lexbuf
- |  '"' -> action_24 lexbuf
- |  '\000' -> action_27 lexbuf
- |  _ -> action_28 lexbuf
-and state_2 lexbuf =
-  match lexing.next_char lexbuf with
-    '\\' -> state_24 lexbuf
- |  '"' -> action_29 lexbuf
- |  '\000' -> action_33 lexbuf
- |  _ -> action_34 lexbuf
-and state_3 lexbuf =
-  match lexing.next_char lexbuf with
-    '\\' -> state_13 lexbuf
- |  '\000' -> lexing.backtrack lexbuf
- |  _ -> state_12 lexbuf
-and state_4 lexbuf =
-  match lexing.next_char lexbuf with
-    '*' -> state_9 lexbuf
- |  '(' -> state_8 lexbuf
- |  '"' -> action_41 lexbuf
- |  '\000' -> action_42 lexbuf
- |  _ -> action_43 lexbuf
-and state_8 lexbuf =
-  Lexing.set_backtrack lexbuf action_43;
-  match lexing.next_char lexbuf with
-    '*' -> action_39 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_9 lexbuf =
-  Lexing.set_backtrack lexbuf action_43;
-  match lexing.next_char lexbuf with
-    ')' -> action_40 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_12 lexbuf =
-  Lexing.set_backtrack lexbuf action_38;
-  match lexing.next_char lexbuf with
-    '\'' -> action_35 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_13 lexbuf =
-  Lexing.set_backtrack lexbuf action_38;
-  match lexing.next_char lexbuf with
-    '9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0' -> state_15 lexbuf
- |  't'|'r'|'n'|'b'|'\\'|'\'' -> state_14 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_14 lexbuf =
-  match lexing.next_char lexbuf with
-    '\'' -> action_36 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_15 lexbuf =
-  match lexing.next_char lexbuf with
-    '9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0' -> state_16 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_16 lexbuf =
-  match lexing.next_char lexbuf with
-    '9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0' -> state_17 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_17 lexbuf =
-  match lexing.next_char lexbuf with
-    '\'' -> action_37 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_24 lexbuf =
-  Lexing.set_backtrack lexbuf action_34;
-  match lexing.next_char lexbuf with
-    '9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0' -> state_27 lexbuf
- |  't'|'r'|'n'|'b'|'\\'|'"' -> action_31 lexbuf
- |  ' '|'\026'|'\013'|'\012'|'\n'|'\t' -> state_25 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_25 lexbuf =
-  Lexing.set_backtrack lexbuf action_30;
-  match lexing.next_char lexbuf with
-    ' '|'\026'|'\013'|'\012'|'\n'|'\t' -> state_25 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_27 lexbuf =
-  match lexing.next_char lexbuf with
-    '9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0' -> state_28 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_28 lexbuf =
-  match lexing.next_char lexbuf with
-    '9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0' -> action_32 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_34 lexbuf =
-  Lexing.set_backtrack lexbuf action_28;
-  match lexing.next_char lexbuf with
-    '*' -> action_26 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_40 lexbuf =
-  Lexing.set_backtrack lexbuf action_0;
-  match lexing.next_char lexbuf with
-    ' '|'\013'|'\n'|'\t' -> state_65 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_43 lexbuf =
-  Lexing.set_backtrack lexbuf action_16;
-  match lexing.next_char lexbuf with
-    '*' -> action_1 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_48 lexbuf =
-  Lexing.set_backtrack lexbuf action_21;
-  match lexing.next_char lexbuf with
-    ';' -> action_7 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_51 lexbuf =
-  Lexing.set_backtrack lexbuf action_2;
-  match lexing.next_char lexbuf with
-    'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
- |  '_' -> state_60 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_55 lexbuf =
-  Lexing.set_backtrack lexbuf action_9;
-  match lexing.next_char lexbuf with
-    'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_56 lexbuf =
-  Lexing.set_backtrack lexbuf action_2;
-  match lexing.next_char lexbuf with
-    'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
- |  'o' -> state_61 lexbuf
- |  '_' -> state_60 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_59 lexbuf =
-  Lexing.set_backtrack lexbuf action_2;
-  match lexing.next_char lexbuf with
-    'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
- |  '_' -> state_60 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_60 lexbuf =
-  match lexing.next_char lexbuf with
-    'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_61 lexbuf =
-  Lexing.set_backtrack lexbuf action_2;
-  match lexing.next_char lexbuf with
-    'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
- |  'f' -> state_62 lexbuf
- |  '_' -> state_60 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_62 lexbuf =
-  Lexing.set_backtrack lexbuf action_2;
-  match lexing.next_char lexbuf with
-    'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
- |  '_' -> state_60 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and state_65 lexbuf =
-  Lexing.set_backtrack lexbuf action_0;
-  match lexing.next_char lexbuf with
-    ' '|'\013'|'\n'|'\t' -> state_65 lexbuf
- |  _ -> lexing.backtrack lexbuf
-and main lexbuf =
-  Lexing.init lexbuf;
-  state_0 lexbuf
-
-and action lexbuf =
-  Lexing.init lexbuf;
-  state_1 lexbuf
-
-and string lexbuf =
-  Lexing.init lexbuf;
-  state_2 lexbuf
-
-and char lexbuf =
-  Lexing.init lexbuf;
-  state_3 lexbuf
-
-and comment lexbuf =
-  Lexing.init lexbuf;
-  state_4 lexbuf
-
diff -Nru ocaml-3.12.1/testsuite/tests/tool-lexyacc/lexgen.ml ocaml-4.01.0/testsuite/tests/tool-lexyacc/lexgen.ml
--- ocaml-3.12.1/testsuite/tests/tool-lexyacc/lexgen.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-lexyacc/lexgen.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: lexgen.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (* Compiling a lexer definition *)
 
 open Syntax
@@ -200,7 +198,7 @@
 let todo = ref ([] : (transition list * int) list)
 let next = ref 0
 
-let get_state st = 
+let get_state st =
   try
     Hashtbl.find memory st
   with Not_found ->
@@ -222,7 +220,7 @@
   | ps -> Goto (get_state ps)
 
 
-let transition_from chars follow pos_set = 
+let transition_from chars follow pos_set =
   let tr = Array.create 256 []
   and shift = Array.create 256 Backtrack in
     List.iter
@@ -263,4 +261,3 @@
     Array.create (number_of_states()) (Perform 0) in
   List.iter (fun (auto, i) -> v.(i) <- auto) states;
   (initial_states, v, actions)
-
diff -Nru ocaml-3.12.1/testsuite/tests/tool-lexyacc/main.ml ocaml-4.01.0/testsuite/tests/tool-lexyacc/main.ml
--- ocaml-3.12.1/testsuite/tests/tool-lexyacc/main.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-lexyacc/main.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: main.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (* The lexer generator. Command-line parsing. *)
 
 open Syntax
diff -Nru ocaml-3.12.1/testsuite/tests/tool-lexyacc/main.reference ocaml-4.01.0/testsuite/tests/tool-lexyacc/main.reference
--- ocaml-3.12.1/testsuite/tests/tool-lexyacc/main.reference	2010-01-25 14:20:30.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-lexyacc/main.reference	2012-07-30 18:04:46.000000000 +0000
@@ -310,4 +310,3 @@
 and comment lexbuf =
   Lexing.init lexbuf;
   state_4 lexbuf
-
diff -Nru ocaml-3.12.1/testsuite/tests/tool-lexyacc/output.ml ocaml-4.01.0/testsuite/tests/tool-lexyacc/output.ml
--- ocaml-3.12.1/testsuite/tests/tool-lexyacc/output.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-lexyacc/output.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: output.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (* Generating a DFA as a set of mutually recursive functions *)
 
 open Syntax
@@ -137,7 +135,7 @@
 
 
 (* 3- Generating the entry points *)
-          
+
 let rec output_entries = function
     [] -> failwith "output_entries"
   | (name,state_num) :: rest ->
@@ -146,7 +144,7 @@
       output_string !oc ("  state_" ^ string_of_int state_num ^
                         " lexbuf\n");
       match rest with
-        [] -> output_string !oc "\n"; ()
+        [] -> ()
       | _  -> output_string !oc "\nand "; output_entries rest
 
 
@@ -164,6 +162,3 @@
     output_state i st.(i)
   done;
   output_entries initial_st
-
-
-
diff -Nru ocaml-3.12.1/testsuite/tests/tool-lexyacc/scan_aux.ml ocaml-4.01.0/testsuite/tests/tool-lexyacc/scan_aux.ml
--- ocaml-3.12.1/testsuite/tests/tool-lexyacc/scan_aux.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-lexyacc/scan_aux.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: scan_aux.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (* Auxiliaries for the lexical analyzer *)
 
 let brace_depth = ref 0
@@ -57,4 +55,3 @@
   Char.chr(100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) +
             10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) +
                  (Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48))
-
diff -Nru ocaml-3.12.1/testsuite/tests/tool-lexyacc/scanner.mll ocaml-4.01.0/testsuite/tests/tool-lexyacc/scanner.mll
--- ocaml-3.12.1/testsuite/tests/tool-lexyacc/scanner.mll	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-lexyacc/scanner.mll	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: scanner.mll 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (* The lexical analyzer for lexer definitions. *)
 
 {
@@ -21,27 +19,27 @@
 }
 
 rule main = parse
-    [' ' '\010' '\013' '\009' ] + 
+    [' ' '\010' '\013' '\009' ] +
     { main lexbuf }
-  | "(*" 
+  | "(*"
     { comment_depth := 1;
       comment lexbuf;
       main lexbuf }
   | (['A'-'Z' 'a'-'z'] | '_' ['A'-'Z' 'a'-'z' '\'' '0'-'9'])
-    ( '_' ? ['A'-'Z' 'a'-'z' ''' '0'-'9'] ) * 
+    ( '_' ? ['A'-'Z' 'a'-'z' ''' '0'-'9'] ) *
     { match Lexing.lexeme lexbuf with
         "rule" -> Trule
       | "parse" -> Tparse
       | "and" -> Tand
       | "eof" -> Teof
       | s -> Tident s }
-  | '"' 
+  | '"'
     { reset_string_buffer();
       string lexbuf;
       Tstring(get_stored_string()) }
-  | "'" 
+  | "'"
     { Tchar(char lexbuf) }
-  | '{' 
+  | '{'
     { let n1 = Lexing.lexeme_end lexbuf in
         brace_depth := 1;
         let n2 = action lexbuf in
@@ -66,67 +64,67 @@
     { raise(Lexical_error("illegal character " ^ Lexing.lexeme lexbuf)) }
 
 and action = parse
-    '{' 
+    '{'
     { incr brace_depth;
       action lexbuf }
-  | '}' 
+  | '}'
     { decr brace_depth;
       if !brace_depth = 0 then Lexing.lexeme_start lexbuf else action lexbuf }
-  | '"' 
+  | '"'
     { reset_string_buffer();
       string lexbuf;
       reset_string_buffer();
       action lexbuf }
   | '\''
     { let _ = char lexbuf in action lexbuf }
-  | "(*" 
+  | "(*"
     { comment_depth := 1;
       comment lexbuf;
       action lexbuf }
-  | eof 
+  | eof
     { raise (Lexical_error "unterminated action") }
-  | _ 
+  | _
     { action lexbuf }
-      
+
 and string = parse
-    '"' 
+    '"'
     { () }
   | '\\' [' ' '\010' '\013' '\009' '\026' '\012'] +
     { string lexbuf }
-  | '\\' ['\\' '"' 'n' 't' 'b' 'r'] 
+  | '\\' ['\\' '"' 'n' 't' 'b' 'r']
     { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
       string lexbuf }
-  | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] 
+  | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
     { store_string_char(char_for_decimal_code lexbuf 1);
       string lexbuf }
-  | eof 
+  | eof
     { raise(Lexical_error "unterminated string") }
-  | _ 
+  | _
     { store_string_char(Lexing.lexeme_char lexbuf 0);
       string lexbuf }
 
 and char = parse
-    [^ '\\'] "'" 
+    [^ '\\'] "'"
     { Lexing.lexeme_char lexbuf 0 }
-  | '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'" 
+  | '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'"
     { char_for_backslash (Lexing.lexeme_char lexbuf 1) }
-  | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'" 
+  | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
     { char_for_decimal_code lexbuf 1 }
-  | _ 
+  | _
     { raise(Lexical_error "bad character constant") }
 
 and comment = parse
-    "(*" 
+    "(*"
     { incr comment_depth; comment lexbuf }
-  | "*)" 
+  | "*)"
     { decr comment_depth;
       if !comment_depth = 0 then () else comment lexbuf }
-  | '"' 
+  | '"'
     { reset_string_buffer();
       string lexbuf;
       reset_string_buffer();
       comment lexbuf }
-  | eof 
+  | eof
     { raise(Lexical_error "unterminated comment") }
-  | _ 
+  | _
     { comment lexbuf }
diff -Nru ocaml-3.12.1/testsuite/tests/tool-lexyacc/syntax.ml ocaml-4.01.0/testsuite/tests/tool-lexyacc/syntax.ml
--- ocaml-3.12.1/testsuite/tests/tool-lexyacc/syntax.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-lexyacc/syntax.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: syntax.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (* The shallow abstract syntax *)
 
 type location =
diff -Nru ocaml-3.12.1/testsuite/tests/tool-ocaml/Makefile ocaml-4.01.0/testsuite/tests/tool-ocaml/Makefile
--- ocaml-3.12.1/testsuite/tests/tool-ocaml/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-ocaml/Makefile	2013-05-03 15:52:56.000000000 +0000
@@ -1,16 +1,33 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 SHOULD_FAIL=t060-raise.ml
 
 compile: lib.cmo
 	@for file in t*.ml; do \
 	  printf " ... testing '$$file'"; \
 	  if [ `echo $(SHOULD_FAIL) | grep $$file` ]; then \
-	    $(OCAML) -w a lib.cmo $$file 2> /dev/null && (echo " => failed" && exit 1) || echo " => passed"; \
+	    $(OCAML) -w a lib.cmo $$file 2>/dev/null \
+	    && echo " => failed" || echo " => passed"; \
 	  else \
-	    $(OCAML) -w a lib.cmo $$file 2> /dev/null && echo " => passed" || (echo " => failed" && exit 1); \
+	    $(OCAML) -w a lib.cmo $$file 2>/dev/null \
+	    && echo " => passed" || echo " => failed"; \
 	  fi; \
 	done
 
+promote:
+
 clean: defaultclean
 	@rm -f ./a.out
 
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/tool-ocaml/lib.ml ocaml-4.01.0/testsuite/tests/tool-ocaml/lib.ml
--- ocaml-3.12.1/testsuite/tests/tool-ocaml/lib.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-ocaml/lib.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,5 +1,3 @@
-(* file $Id: lib.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 external raise : exn -> 'a = "%raise"
 
 external not : bool -> bool = "%boolnot"
@@ -42,5 +40,3 @@
 external weak_get: 'a weak_t -> int -> 'a option = "caml_weak_get";;
 
 let x = 42;;
-
-(* eof $Id: lib.ml 10713 2010-10-08 11:53:19Z doligez $ *)
diff -Nru ocaml-3.12.1/testsuite/tests/tool-ocaml/t240-c_call3.ml ocaml-4.01.0/testsuite/tests/tool-ocaml/t240-c_call3.ml
--- ocaml-3.12.1/testsuite/tests/tool-ocaml/t240-c_call3.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-ocaml/t240-c_call3.ml	2012-07-30 18:04:46.000000000 +0000
@@ -1,5 +1,5 @@
 open Lib;;
-if Hashtbl.hash_param 5 6 [1;2;3] <> 196799 then raise Not_found;;
+if Hashtbl.hash_param 5 6 [1;2;3] <> 697606130 then raise Not_found;;
 
 (**
        0 CONSTINT 42
diff -Nru ocaml-3.12.1/testsuite/tests/tool-ocaml/t301-object.ml ocaml-4.01.0/testsuite/tests/tool-ocaml/t301-object.ml
--- ocaml-3.12.1/testsuite/tests/tool-ocaml/t301-object.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-ocaml/t301-object.ml	2012-10-15 17:50:56.000000000 +0000
@@ -7,8 +7,6 @@
   t301-object.ml -o t301-object.byte
 
 ***)
-(* $Id: t301-object.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 
 class c = object (self)
   method pubmet = 1
@@ -25,5 +23,3 @@
   if x <> 1 then raise Not_found;
   if y <> 2 then raise Not_found;
   if z <> 4 then raise Not_found;;
-
-(**** eof $Id: t301-object.ml 10713 2010-10-08 11:53:19Z doligez $ *)
diff -Nru ocaml-3.12.1/testsuite/tests/tool-ocamldoc/.ignore ocaml-4.01.0/testsuite/tests/tool-ocamldoc/.ignore
--- ocaml-3.12.1/testsuite/tests/tool-ocamldoc/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-ocamldoc/.ignore	2011-08-04 14:59:13.000000000 +0000
@@ -0,0 +1,4 @@
+*.html
+*.sty
+*.css
+ocamldoc.out
diff -Nru ocaml-3.12.1/testsuite/tests/tool-ocamldoc/.svnignore ocaml-4.01.0/testsuite/tests/tool-ocamldoc/.svnignore
--- ocaml-3.12.1/testsuite/tests/tool-ocamldoc/.svnignore	2011-05-17 12:08:13.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-ocamldoc/.svnignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,14 +0,0 @@
-#!/bin/sh
-
-svn propset svn:ignore -F - . < /dev/null && echo " => passed" || (echo " => failed" && exit 1); \
+	  F="`basename $$file .ml`"; \
+	  $(OCAMLDOC) $(DOCFLAGS) -hide-warnings -g $(CUSTOM_MODULE).cmo \
+	              -o $$F.result $$file; \
+	  $(DIFF) $$F.reference $$F.result >/dev/null \
+	  && echo " => passed" || echo " => failed"; \
 	done;
-	@$(OCAMLDOC) -html t*.ml 2>&1 | grep -v test_types_display || true
-	@$(OCAMLDOC) -latex t*.ml 2>&1 | grep -v test_types_display || true
+	@$(OCAMLDOC) $(DOCFLAGS) -hide-warnings -html t*.ml 2>&1 \
+	  | grep -v test_types_display || true
+	@$(OCAMLDOC) $(DOCFLAGS) -hide-warnings -latex t*.ml 2>&1 \
+	  | grep -v test_types_display || true
 
+.PHONY: promote
+promote: defaultpromote
 
+.PHONY: clean
 clean: defaultclean
 	@rm -f *.result *.html *.tex *.log *.out *.sty *.toc *.css *.aux
 
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/tool-ocamldoc/odoc_test.ml ocaml-4.01.0/testsuite/tests/tool-ocamldoc/odoc_test.ml
--- ocaml-3.12.1/testsuite/tests/tool-ocamldoc/odoc_test.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-ocamldoc/odoc_test.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,4 +1,5 @@
 (***********************************************************************)
+(*                                                                     *)
 (*                             OCamldoc                                *)
 (*                                                                     *)
 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
@@ -9,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_test.ml 10713 2010-10-08 11:53:19Z doligez $ *)
-
 (** Custom generator to perform test on ocamldoc. *)
 
 open Odoc_info
@@ -27,86 +26,91 @@
     inherit Odoc_info.Scan.scanner
 
     val mutable test_kinds = []
-    val mutable fmt = Format.str_formatter 
+    val mutable fmt = Format.str_formatter
 
     method must_display_types = List.mem Types_display test_kinds
 
     method set_test_kinds_from_module m =
       test_kinds <- List.fold_left
-	  (fun acc (s, _) ->
-	    match s with
-	      "test_types_display" -> Types_display :: acc
-	    | _ -> acc
-	  )
-	  []
-	  (
-	   match m.m_info with
-	     None -> []
-	   | Some i -> i.i_custom
-	  )
+          (fun acc (s, _) ->
+            match s with
+              "test_types_display" -> Types_display :: acc
+            | _ -> acc
+          )
+          []
+          (
+           match m.m_info with
+             None -> []
+           | Some i -> i.i_custom
+          )
     method! scan_type t =
       match test_kinds with
-	[] -> ()
-      |	_ ->
-	  p fmt "# type %s:\n" t.ty_name;
-	  if self#must_display_types then
-	    (
-	     p fmt "# manifest (Odoc_info.string_of_type_expr):\n<[%s]>\n"
-	       (match t.ty_manifest with
-		 None -> "None"
-	       | Some e -> Odoc_info.string_of_type_expr e
-	       );
-	    );
+        [] -> ()
+      | _ ->
+          p fmt "# type %s:\n" t.ty_name;
+          if self#must_display_types then
+            (
+             p fmt "# manifest (Odoc_info.string_of_type_expr):\n<[%s]>\n"
+               (match t.ty_manifest with
+                 None -> "None"
+               | Some e -> Odoc_info.string_of_type_expr e
+               );
+            );
 
 
     method! scan_module_pre m =
       p fmt "#\n# module %s:\n" m.m_name ;
       if self#must_display_types then
-	(
-	 p fmt "# Odoc_info.string_of_module_type:\n<[%s]>\n"
-	   (Odoc_info.string_of_module_type m.m_type);
-	 p fmt "# Odoc_info.string_of_module_type ~complete: true :\n<[%s]>\n"
-	   (Odoc_info.string_of_module_type ~complete: true m.m_type);
-	);
+        (
+         p fmt "# Odoc_info.string_of_module_type:\n<[%s]>\n"
+           (Odoc_info.string_of_module_type m.m_type);
+         p fmt "# Odoc_info.string_of_module_type ~complete: true :\n<[%s]>\n"
+           (Odoc_info.string_of_module_type ~complete: true m.m_type);
+        );
       true
 
     method! scan_module_type_pre m =
       p fmt "#\n# module type %s:\n" m.mt_name ;
       if self#must_display_types then
-	(
-	 p fmt "# Odoc_info.string_of_module_type:\n<[%s]>\n"
-	   (match m.mt_type with
-	     None -> "None"
-	   | Some t -> Odoc_info.string_of_module_type t
-	   );
-	 p fmt "# Odoc_info.string_of_module_type ~complete: true :\n<[%s]>\n"
-	   (match m.mt_type with
-	     None -> "None"
-	   | Some t -> Odoc_info.string_of_module_type ~complete: true t
-	   );
-	);
+        (
+         p fmt "# Odoc_info.string_of_module_type:\n<[%s]>\n"
+           (match m.mt_type with
+             None -> "None"
+           | Some t -> Odoc_info.string_of_module_type t
+           );
+         p fmt "# Odoc_info.string_of_module_type ~complete: true :\n<[%s]>\n"
+           (match m.mt_type with
+             None -> "None"
+           | Some t -> Odoc_info.string_of_module_type ~complete: true t
+           );
+        );
       true
 
     method generate (module_list: Odoc_info.Module.t_module list) =
-      let oc = open_out !Odoc_info.Args.out_file in
+      let oc = open_out !Odoc_info.Global.out_file in
       fmt <- Format.formatter_of_out_channel oc;
       (
        try
-	 List.iter
-	   (fun m -> 
-	     self#set_test_kinds_from_module m;
-	     self#scan_module_list [m];
-	   )
-	   module_list
+         List.iter
+           (fun m ->
+             self#set_test_kinds_from_module m;
+             self#scan_module_list [m];
+           )
+           module_list
        with
-	 e ->
-	   prerr_endline (Printexc.to_string e)
+         e ->
+           prerr_endline (Printexc.to_string e)
       );
       Format.pp_print_flush fmt ();
       close_out oc
   end
 
-
-let my_generator = new string_gen
-let _ = Odoc_info.Args.set_doc_generator 
-    (Some (my_generator :> Odoc_info.Args.doc_generator))
+let _ =
+  let module My_generator = struct
+    class generator =
+    let inst = new string_gen in
+    object
+      method generate = inst#generate
+    end
+  end in
+  Odoc_args.set_generator (Odoc_gen.Base (module My_generator : Odoc_gen.Base))
diff -Nru ocaml-3.12.1/testsuite/tests/tool-ocamldoc/t01.ml ocaml-4.01.0/testsuite/tests/tool-ocamldoc/t01.ml
--- ocaml-3.12.1/testsuite/tests/tool-ocamldoc/t01.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-ocamldoc/t01.ml	2012-07-30 18:04:46.000000000 +0000
@@ -7,7 +7,7 @@
 
 
 module M = struct
-  let y = 2 
+  let y = 2
 
 end
 
diff -Nru ocaml-3.12.1/testsuite/tests/tool-ocamldoc/t03.ml ocaml-4.01.0/testsuite/tests/tool-ocamldoc/t03.ml
--- ocaml-3.12.1/testsuite/tests/tool-ocamldoc/t03.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/tool-ocamldoc/t03.ml	2012-07-30 18:04:46.000000000 +0000
@@ -4,4 +4,4 @@
 
 module type MT2 = sig type t val x : t end;;
 module type Gee = MT2 with type t = float ;;
-module T = (val (if true then (module Foo:MT2 with type t = int) else (module Bar: MT2 with type t = int)) : MT2 with type t = int);;
\ No newline at end of file
+module T = (val (if true then (module Foo:MT2 with type t = int) else (module Bar: MT2 with type t = int)) : MT2 with type t = int);;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-fstclassmod/.svnignore ocaml-4.01.0/testsuite/tests/typing-fstclassmod/.svnignore
--- ocaml-3.12.1/testsuite/tests/typing-fstclassmod/.svnignore	2011-05-17 12:08:13.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-fstclassmod/.svnignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,10 +0,0 @@
-#!/bin/sh
-
-svn propset svn:ignore -F - . < 'a list ty
+  | Pair: ('a ty * 'b ty) -> ('a * 'b) ty
+;;
+
+(* Tagging data *)
+
+type variant =
+  | VInt of int
+  | VString of string
+  | VList of variant list
+  | VPair of variant * variant
+
+let rec variantize: type t. t ty -> t -> variant =
+  fun ty x ->
+    (* type t is abstract here *)
+    match ty with
+    | Int -> VInt x  (* in this branch: t = int *)
+    | String -> VString x (* t = string *)
+    | List ty1 ->
+        VList (List.map (variantize ty1) x)
+        (* t = 'a list for some 'a *)
+    | Pair (ty1, ty2) ->
+        VPair (variantize ty1 (fst x), variantize ty2 (snd x))
+        (* t = ('a, 'b) for some 'a and 'b *)
+
+exception VariantMismatch
+
+let rec devariantize: type t. t ty -> variant -> t =
+  fun ty v ->
+    match ty, v with
+    | Int, VInt x -> x
+    | String, VString x -> x
+    | List ty1, VList vl ->
+        List.map (devariantize ty1) vl
+    | Pair (ty1, ty2), VPair (x1, x2) ->
+        (devariantize ty1 x1, devariantize ty2 x2)
+    | _ -> raise VariantMismatch
+;;
+
+(* Handling records *)
+
+type 'a ty =
+  | Int: int ty
+  | String: string ty
+  | List: 'a ty -> 'a list ty
+  | Pair: ('a ty * 'b ty) -> ('a * 'b) ty
+  | Record: 'a record -> 'a ty
+
+and 'a record =
+    {
+     path: string;
+     fields: 'a field_ list;
+    }
+
+and 'a field_ =
+  | Field: ('a, 'b) field -> 'a field_
+
+and ('a, 'b) field =
+    {
+     label: string;
+     field_type: 'b ty;
+     get: ('a -> 'b);
+    }
+;;
+
+(* Again *)
+
+type variant =
+  | VInt of int
+  | VString of string
+  | VList of variant list
+  | VPair of variant * variant
+  | VRecord of (string * variant) list
+
+let rec variantize: type t. t ty -> t -> variant =
+  fun ty x ->
+    (* type t is abstract here *)
+    match ty with
+    | Int -> VInt x  (* in this branch: t = int *)
+    | String -> VString x (* t = string *)
+    | List ty1 ->
+        VList (List.map (variantize ty1) x)
+        (* t = 'a list for some 'a *)
+    | Pair (ty1, ty2) ->
+        VPair (variantize ty1 (fst x), variantize ty2 (snd x))
+        (* t = ('a, 'b) for some 'a and 'b *)
+    | Record {fields} ->
+        VRecord
+          (List.map (fun (Field{field_type; label; get}) ->
+                       (label, variantize field_type (get x))) fields)
+;;
+
+(* Extraction *)
+
+type 'a ty =
+  | Int: int ty
+  | String: string ty
+  | List: 'a ty -> 'a list ty
+  | Pair: ('a ty * 'b ty) -> ('a * 'b) ty
+  | Record: ('a, 'builder) record -> 'a ty
+
+and ('a, 'builder) record =
+    {
+     path: string;
+     fields: ('a, 'builder) field list;
+     create_builder: (unit -> 'builder);
+     of_builder: ('builder -> 'a);
+    }
+
+and ('a, 'builder) field =
+  | Field: ('a, 'builder, 'b) field_ -> ('a, 'builder) field
+
+and ('a, 'builder, 'b) field_ =
+  {
+   label: string;
+   field_type: 'b ty;
+   get: ('a -> 'b);
+   set: ('builder -> 'b -> unit);
+  }
+
+let rec devariantize: type t. t ty -> variant -> t =
+  fun ty v ->
+    match ty, v with
+    | Int, VInt x -> x
+    | String, VString x -> x
+    | List ty1, VList vl ->
+        List.map (devariantize ty1) vl
+    | Pair (ty1, ty2), VPair (x1, x2) ->
+        (devariantize ty1 x1, devariantize ty2 x2)
+    | Record {fields; create_builder; of_builder}, VRecord fl ->
+        if List.length fields <> List.length fl then raise VariantMismatch;
+        let builder = create_builder () in
+        List.iter2
+          (fun (Field {label; field_type; set}) (lab, v) ->
+            if label <> lab then raise VariantMismatch;
+            set builder (devariantize field_type v)
+          )
+          fields fl;
+        of_builder builder
+    | _ -> raise VariantMismatch
+;;
+
+type my_record  =
+    {
+     a: int;
+     b: string list;
+    }
+
+let my_record =
+  let fields =
+    [
+     Field {label = "a"; field_type = Int;
+            get = (fun {a} -> a);
+            set = (fun (r, _) x -> r := Some x)};
+     Field {label = "b"; field_type = List String;
+            get = (fun {b} -> b);
+            set = (fun (_, r) x -> r := Some x)};
+    ]
+  in
+  let create_builder () = (ref None, ref None) in
+  let of_builder (a, b) =
+    match !a, !b with
+    | Some a, Some b -> {a; b}
+    | _ -> failwith "Some fields are missing in record of type my_record"
+  in
+  Record {path = "My_module.my_record"; fields; create_builder; of_builder}
+;;
+
+(* Extension to recursive types and polymorphic variants *)
+(* by Jacques Garrigue *)
+
+type noarg = Noarg
+
+type (_,_) ty =
+  | Int: (int,_) ty
+  | String: (string,_) ty
+  | List: ('a,'e) ty -> ('a list, 'e) ty
+  | Option: ('a,'e) ty -> ('a option, 'e) ty
+  | Pair: (('a,'e) ty * ('b,'e) ty) -> ('a * 'b,'e) ty
+  (* Support for type variables and recursive types *)
+  | Var: ('a, 'a -> 'e) ty
+  | Rec: ('a, 'a -> 'e) ty -> ('a,'e) ty
+  | Pop: ('a, 'e) ty -> ('a, 'b -> 'e) ty
+  (* Change the representation of a type *)
+  | Conv: string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
+  (* Sum types (both normal sums and polymorphic variants) *)
+  | Sum: ('a, 'e, 'b) ty_sum -> ('a, 'e) ty
+
+and ('a, 'e, 'b) ty_sum =
+    { sum_proj: 'a -> string * 'e ty_dyn option;
+      sum_cases: (string * ('e,'b) ty_case) list;
+      sum_inj: 'c. ('b,'c) ty_sel * 'c -> 'a; }
+
+and 'e ty_dyn =              (* dynamic type *)
+  | Tdyn : ('a,'e) ty * 'a -> 'e ty_dyn
+
+and (_,_) ty_sel =           (* selector from a list of types *)
+  | Thd : ('a -> 'b, 'a) ty_sel
+  | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
+
+and (_,_) ty_case =          (* type a sum case *)
+  | TCarg : ('b,'a) ty_sel * ('a,'e) ty -> ('e,'b) ty_case
+  | TCnoarg : ('b,noarg) ty_sel -> ('e,'b) ty_case
+;;
+
+type _ ty_env =              (* type variable substitution *)
+  | Enil : unit ty_env
+  | Econs : ('a,'e) ty * 'e ty_env -> ('a -> 'e) ty_env
+;;
+
+(* Comparing selectors *)
+type (_,_) eq = Eq: ('a,'a) eq
+
+let rec eq_sel : type a b c. (a,b) ty_sel -> (a,c) ty_sel -> (b,c) eq option =
+  fun s1 s2 ->
+    match s1, s2 with
+    | Thd, Thd -> Some Eq
+    | Ttl s1, Ttl s2 ->
+        (match eq_sel s1 s2 with None -> None | Some Eq -> Some Eq)
+    | _ -> None
+
+(* Auxiliary function to get the type of a case from its selector *)
+let rec get_case : type a b e.
+  (b, a) ty_sel -> (string * (e,b) ty_case) list -> string * (a, e) ty option =
+  fun sel cases ->
+  match cases with
+  | (name, TCnoarg sel') :: rem ->
+      begin match eq_sel sel sel' with
+      | None -> get_case sel rem
+      | Some Eq -> name, None
+      end
+  | (name, TCarg (sel', ty)) :: rem ->
+      begin match eq_sel sel sel' with
+      | None -> get_case sel rem
+      | Some Eq -> name, Some ty
+      end
+  | [] -> raise Not_found
+;;
+
+(* Untyped representation of values *)
+type variant =
+  | VInt of int
+  | VString of string
+  | VList of variant list
+  | VOption of variant option
+  | VPair of variant * variant
+  | VConv of string * variant
+  | VSum of string * variant option
+
+let may_map f = function Some x -> Some (f x) | None -> None
+
+let rec variantize : type a e. e ty_env -> (a,e) ty -> a -> variant =
+  fun e ty v ->
+  match ty with
+  | Int -> VInt v
+  | String -> VString v
+  | List t -> VList (List.map (variantize e t) v)
+  | Option t -> VOption (may_map (variantize e t) v)
+  | Pair (t1, t2) -> VPair (variantize e t1 (fst v), variantize e t2 (snd v))
+  | Rec t -> variantize (Econs (ty, e)) t v
+  | Pop t -> (match e with Econs (_, e') -> variantize e' t v)
+  | Var -> (match e with Econs (t, e') -> variantize e' t v)
+  | Conv (s, proj, inj, t) -> VConv (s, variantize e t (proj v))
+  | Sum ops ->
+      let tag, arg = ops.sum_proj v in
+      VSum (tag, may_map (function Tdyn (ty,arg) -> variantize e ty arg) arg)
+;;
+
+let rec devariantize : type t e. e ty_env -> (t, e) ty -> variant -> t =
+  fun e ty v ->
+  match ty, v with
+  | Int, VInt x -> x
+  | String, VString x -> x
+  | List ty1, VList vl ->
+      List.map (devariantize e ty1) vl
+  | Pair (ty1, ty2), VPair (x1, x2) ->
+      (devariantize e ty1 x1, devariantize e ty2 x2)
+  | Rec t, _ -> devariantize (Econs (ty, e)) t v
+  | Pop t, _ -> (match e with Econs (_, e') -> devariantize e' t v)
+  | Var, _ -> (match e with Econs (t, e') -> devariantize e' t v)
+  | Conv (s, proj, inj, t), VConv (s', v) when s = s' ->
+      inj (devariantize e t v)
+  | Sum ops, VSum (tag, a) ->
+      begin try match List.assoc tag ops.sum_cases, a with
+      | TCarg (sel, t), Some a -> ops.sum_inj (sel, devariantize e t a)
+      | TCnoarg sel, None -> ops.sum_inj (sel, Noarg)
+      | _ -> raise VariantMismatch
+      with Not_found -> raise VariantMismatch
+      end
+  | _ -> raise VariantMismatch
+;;
+
+(* First attempt: represent 1-constructor variants using Conv *)
+let wrap_A t = Conv ("`A", (fun (`A x) -> x), (fun x -> `A x), t);;
+
+let ty a = Rec (wrap_A (Option (Pair (a, Var)))) ;;
+let v = variantize Enil (ty Int);;
+let x = v (`A (Some (1, `A (Some (2, `A None))))) ;;
+
+(* Can also use it to decompose a tuple *)
+
+let triple t1 t2 t3 =
+  Conv ("Triple", (fun (a,b,c) -> (a,(b,c))),
+        (fun (a,(b,c)) -> (a,b,c)), Pair (t1, Pair (t2, t3)))
+
+let v = variantize Enil (triple String Int Int) ("A", 2, 3) ;;
+
+(* Second attempt: introduce a real sum construct *)
+let ty_abc =
+  (* Could also use [get_case] for proj, but direct definition is shorter *)
+  let proj = function
+      `A n -> "A", Some (Tdyn (Int, n))
+    | `B s -> "B", Some (Tdyn (String, s))
+    | `C   -> "C", None
+  (* Define inj in advance to be able to write the type annotation easily *)
+  and inj : type c. (int -> string -> noarg -> unit, c) ty_sel * c ->
+    [`A of int | `B of string | `C] = function
+        Thd, v -> `A v
+      | Ttl Thd, v -> `B v
+      | Ttl (Ttl Thd), Noarg -> `C
+  in
+  (* Coherence of sum_inj and sum_cases is checked by the typing *)
+  Sum { sum_proj = proj; sum_inj = inj; sum_cases =
+        [ "A", TCarg (Thd, Int); "B", TCarg (Ttl Thd, String);
+          "C", TCnoarg (Ttl (Ttl Thd)) ] }
+;;
+
+let v = variantize Enil ty_abc (`A 3)
+let a = devariantize Enil ty_abc v
+
+(* And an example with recursion... *)
+type 'a vlist = [`Nil | `Cons of 'a * 'a vlist]
+
+let ty_list : type a e. (a, e) ty -> (a vlist, e) ty = fun t ->
+  let tcons = Pair (Pop t, Var) in
+  Rec (Sum {
+       sum_proj = (function
+           `Nil -> "Nil", None
+         | `Cons p -> "Cons", Some (Tdyn (tcons, p)));
+       sum_cases = ["Nil", TCnoarg Thd; "Cons", TCarg (Ttl Thd, tcons)];
+       sum_inj = fun (type c) ->
+         (function
+         | Thd, Noarg -> `Nil
+         | Ttl Thd, v -> `Cons v
+         : (noarg -> a * a vlist -> unit, c) ty_sel * c -> a vlist)
+         (* One can also write the type annotation directly *)
+     })
+
+let v = variantize Enil (ty_list Int) (`Cons (1, `Cons (2, `Nil))) ;;
+
+
+(* Simpler but weaker approach *)
+
+type (_,_) ty =
+  | Int: (int,_) ty
+  | String: (string,_) ty
+  | List: ('a,'e) ty -> ('a list, 'e) ty
+  | Option: ('a,'e) ty -> ('a option, 'e) ty
+  | Pair: (('a,'e) ty * ('b,'e) ty) -> ('a * 'b,'e) ty
+  | Var: ('a, 'a -> 'e) ty
+  | Rec: ('a, 'a -> 'e) ty -> ('a,'e) ty
+  | Pop: ('a, 'e) ty -> ('a, 'b -> 'e) ty
+  | Conv: string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
+  | Sum: ('a -> string * 'e ty_dyn option) * (string * 'e ty_dyn option -> 'a)
+             -> ('a, 'e) ty
+and 'e ty_dyn =
+  | Tdyn : ('a,'e) ty * 'a -> 'e ty_dyn
+
+let ty_abc : ([`A of int | `B of string | `C],'e) ty =
+  (* Could also use [get_case] for proj, but direct definition is shorter *)
+  Sum (
+  (function
+      `A n -> "A", Some (Tdyn (Int, n))
+    | `B s -> "B", Some (Tdyn (String, s))
+    | `C   -> "C", None),
+  (function
+      "A", Some (Tdyn (Int, n)) -> `A n
+    | "B", Some (Tdyn (String, s)) -> `B s
+    | "C", None -> `C
+    | _ -> invalid_arg "ty_abc"))
+;;
+
+(* Breaks: no way to pattern-match on a full recursive type *)
+let ty_list : type a e. (a,e) ty -> (a vlist,e) ty = fun t ->
+  let targ = Pair (Pop t, Var) in
+  Rec (Sum (
+  (function `Nil -> "Nil", None
+    | `Cons p -> "Cons", Some (Tdyn (targ, p))),
+  (function "Nil", None -> `Nil
+    | "Cons", Some (Tdyn (Pair (_, Var), (p : a * a vlist))) -> `Cons p)))
+;;
+
+(* Define Sum using object instead of record for first-class polymorphism *)
+
+type (_,_) ty =
+  | Int: (int,_) ty
+  | String: (string,_) ty
+  | List: ('a,'e) ty -> ('a list, 'e) ty
+  | Option: ('a,'e) ty -> ('a option, 'e) ty
+  | Pair: (('a,'e) ty * ('b,'e) ty) -> ('a * 'b,'e) ty
+  | Var: ('a, 'a -> 'e) ty
+  | Rec: ('a, 'a -> 'e) ty -> ('a,'e) ty
+  | Pop: ('a, 'e) ty -> ('a, 'b -> 'e) ty
+  | Conv: string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
+  | Sum: < proj: 'a -> string * 'e ty_dyn option;
+           cases: (string * ('e,'b) ty_case) list;
+           inj: 'c. ('b,'c) ty_sel * 'c -> 'a >
+          -> ('a, 'e) ty
+
+and 'e ty_dyn =
+  | Tdyn : ('a,'e) ty * 'a -> 'e ty_dyn
+
+and (_,_) ty_sel =
+  | Thd : ('a -> 'b, 'a) ty_sel
+  | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
+
+and (_,_) ty_case =
+  | TCarg : ('b,'a) ty_sel * ('a,'e) ty -> ('e,'b) ty_case
+  | TCnoarg : ('b,noarg) ty_sel -> ('e,'b) ty_case
+;;
+
+let ty_abc : ([`A of int | `B of string | `C] as 'a, 'e) ty =
+  Sum (object
+    method proj = function
+        `A n -> "A", Some (Tdyn (Int, n))
+      | `B s -> "B", Some (Tdyn (String, s))
+      | `C -> "C", None
+    method cases =
+      [ "A", TCarg (Thd, Int); "B", TCarg (Ttl Thd, String);
+        "C", TCnoarg (Ttl (Ttl Thd)) ];
+    method inj : type c.
+        (int -> string -> noarg -> unit, c) ty_sel * c ->
+          [`A of int | `B of string | `C] =
+      function
+        Thd, v -> `A v
+      | Ttl Thd, v -> `B v
+      | Ttl (Ttl Thd), Noarg -> `C
+      | _ -> assert false
+  end)
+
+type 'a vlist = [`Nil | `Cons of 'a * 'a vlist]
+
+let ty_list : type a e. (a, e) ty -> (a vlist, e) ty = fun t ->
+  let tcons = Pair (Pop t, Var) in
+  Rec (Sum (object
+    method proj = function
+        `Nil -> "Nil", None
+      | `Cons p -> "Cons", Some (Tdyn (tcons, p))
+    method cases = ["Nil", TCnoarg Thd; "Cons", TCarg (Ttl Thd, tcons)]
+    method inj : type c.(noarg -> a * a vlist -> unit, c) ty_sel * c -> a vlist
+    = function
+      | Thd, Noarg -> `Nil
+      | Ttl Thd, v -> `Cons v
+  end))
+;;
+
+(*
+type (_,_) ty_assoc =
+  | Anil : (unit,'e) ty_assoc
+  | Acons : string * ('a,'e) ty * ('b,'e) ty_assoc -> ('a -> 'b, 'e) ty_assoc
+
+and (_,_) ty_pvar =
+  | Pnil : ('a,'e) ty_pvar
+  | Pconst : 't * ('b,'e) ty_pvar -> ('t -> 'b, 'e) ty_pvar
+  | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar
+*)
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/dynamic_frisch.ml.principal.reference ocaml-4.01.0/testsuite/tests/typing-gadts/dynamic_frisch.ml.principal.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/dynamic_frisch.ml.principal.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/dynamic_frisch.ml.principal.reference	2013-02-09 08:42:11.000000000 +0000
@@ -0,0 +1,177 @@
+
+#                       type 'a ty =
+    Int : int ty
+  | String : string ty
+  | List : 'a ty -> 'a list ty
+  | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
+#                                                                     type variant =
+    VInt of int
+  | VString of string
+  | VList of variant list
+  | VPair of variant * variant
+val variantize : 't ty -> 't -> variant = 
+exception VariantMismatch
+val devariantize : 't ty -> variant -> 't = 
+#                                                   type 'a ty =
+    Int : int ty
+  | String : string ty
+  | List : 'a ty -> 'a list ty
+  | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
+  | Record : 'a record -> 'a ty
+and 'a record = { path : string; fields : 'a field_ list; }
+and 'a field_ = Field : ('a, 'b) field -> 'a field_
+and ('a, 'b) field = { label : string; field_type : 'b ty; get : 'a -> 'b; }
+#                                                     type variant =
+    VInt of int
+  | VString of string
+  | VList of variant list
+  | VPair of variant * variant
+  | VRecord of (string * variant) list
+val variantize : 't ty -> 't -> variant = 
+#                                                                                                   type 'a ty =
+    Int : int ty
+  | String : string ty
+  | List : 'a ty -> 'a list ty
+  | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
+  | Record : ('a, 'builder) record -> 'a ty
+and ('a, 'builder) record = {
+  path : string;
+  fields : ('a, 'builder) field list;
+  create_builder : unit -> 'builder;
+  of_builder : 'builder -> 'a;
+}
+and ('a, 'builder) field =
+    Field : ('a, 'builder, 'b) field_ -> ('a, 'builder) field
+and ('a, 'builder, 'b) field_ = {
+  label : string;
+  field_type : 'b ty;
+  get : 'a -> 'b;
+  set : 'builder -> 'b -> unit;
+}
+val devariantize : 't ty -> variant -> 't = 
+#                                                   type my_record = { a : int; b : string list; }
+val my_record : my_record ty =
+  Record
+   {path = "My_module.my_record";
+    fields =
+     [Field {label = "a"; field_type = Int; get = ; set = };
+      Field {label = "b"; field_type = List String; get = ; set = }];
+    create_builder = ; of_builder = }
+#                                                                         type noarg = Noarg
+type (_, _) ty =
+    Int : (int, 'c) ty
+  | String : (string, 'd) ty
+  | List : ('a, 'e) ty -> ('a list, 'e) ty
+  | Option : ('a, 'e) ty -> ('a option, 'e) ty
+  | Pair : (('a, 'e) ty * ('b, 'e) ty) -> ('a * 'b, 'e) ty
+  | Var : ('a, 'a -> 'e) ty
+  | Rec : ('a, 'a -> 'e) ty -> ('a, 'e) ty
+  | Pop : ('a, 'e) ty -> ('a, 'b -> 'e) ty
+  | Conv : string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
+  | Sum : ('a, 'e, 'b) ty_sum -> ('a, 'e) ty
+and ('a, 'e, 'b) ty_sum = {
+  sum_proj : 'a -> string * 'e ty_dyn option;
+  sum_cases : (string * ('e, 'b) ty_case) list;
+  sum_inj : 'c. ('b, 'c) ty_sel * 'c -> 'a;
+}
+and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
+and (_, _) ty_sel =
+    Thd : ('a -> 'b, 'a) ty_sel
+  | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
+and (_, _) ty_case =
+    TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
+  | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
+#         type _ ty_env =
+    Enil : unit ty_env
+  | Econs : ('a, 'e) ty * 'e ty_env -> ('a -> 'e) ty_env
+#                                                         type (_, _) eq = Eq : ('a, 'a) eq
+val eq_sel : ('a, 'b) ty_sel -> ('a, 'c) ty_sel -> ('b, 'c) eq option = 
+val get_case :
+  ('b, 'a) ty_sel ->
+  (string * ('e, 'b) ty_case) list -> string * ('a, 'e) ty option = 
+#                                                         type variant =
+    VInt of int
+  | VString of string
+  | VList of variant list
+  | VOption of variant option
+  | VPair of variant * variant
+  | VConv of string * variant
+  | VSum of string * variant option
+val may_map : ('a -> 'b) -> 'a option -> 'b option = 
+val variantize : 'e ty_env -> ('a, 'e) ty -> 'a -> variant = 
+#                                               val devariantize : 'e ty_env -> ('t, 'e) ty -> variant -> 't = 
+#     val wrap_A : ('a, 'b) ty -> ([ `A of 'a ], 'b) ty = 
+#   val ty : ('a, ([ `A of ('a * 'b) option ] as 'b) -> 'c) ty -> ('b, 'c) ty =
+  
+# val v : ([ `A of (int * 'a) option ] as 'a) -> variant = 
+# val x : variant =
+  VConv ("`A",
+   VOption
+    (Some
+      (VPair (VInt 1,
+        VConv ("`A",
+         VOption (Some (VPair (VInt 2, VConv ("`A", VOption None)))))))))
+#               val triple :
+  ('a, 'b) ty -> ('c, 'b) ty -> ('d, 'b) ty -> ('a * 'c * 'd, 'b) ty = 
+val v : variant =
+  VConv ("Triple", VPair (VString "A", VPair (VInt 2, VInt 3)))
+#                                       val ty_abc : ([ `A of int | `B of string | `C ], 'a) ty =
+  Sum
+   {sum_proj = ;
+    sum_cases =
+     [("A", TCarg (Thd, Int)); ("B", TCarg (Ttl Thd, String));
+      ("C", TCnoarg (Ttl (Ttl Thd)))];
+    sum_inj = }
+#                                             val a : [ `A of int | `B of string | `C ] = `A 3
+type 'a vlist = [ `Cons of 'a * 'a vlist | `Nil ]
+val ty_list : ('a, 'e) ty -> ('a vlist, 'e) ty = 
+val v : variant =
+  VSum ("Cons",
+   Some
+    (VPair (VInt 1, VSum ("Cons", Some (VPair (VInt 2, VSum ("Nil", None)))))))
+#                                                               type (_, _) ty =
+    Int : (int, 'c) ty
+  | String : (string, 'd) ty
+  | List : ('a, 'e) ty -> ('a list, 'e) ty
+  | Option : ('a, 'e) ty -> ('a option, 'e) ty
+  | Pair : (('a, 'e) ty * ('b, 'e) ty) -> ('a * 'b, 'e) ty
+  | Var : ('a, 'a -> 'e) ty
+  | Rec : ('a, 'a -> 'e) ty -> ('a, 'e) ty
+  | Pop : ('a, 'e) ty -> ('a, 'b -> 'e) ty
+  | Conv : string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
+  | Sum : ('a -> string * 'e ty_dyn option) *
+      (string * 'e ty_dyn option -> 'a) -> ('a, 'e) ty
+and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
+val ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = Sum (, )
+#                   Characters 327-344:
+      | "Cons", Some (Tdyn (Pair (_, Var), (p : a * a vlist))) -> `Cons p)))
+                                           ^^^^^^^^^^^^^^^^^
+Error: This pattern matches values of type a * a vlist
+       but a pattern was expected which matches values of type
+         a#5 = ex#34 * ex#35
+       Type a is not compatible with type ex#34 
+#                                                         type (_, _) ty =
+    Int : (int, 'd) ty
+  | String : (string, 'f) ty
+  | List : ('a, 'e) ty -> ('a list, 'e) ty
+  | Option : ('a, 'e) ty -> ('a option, 'e) ty
+  | Pair : (('a, 'e) ty * ('b, 'e) ty) -> ('a * 'b, 'e) ty
+  | Var : ('a, 'a -> 'e) ty
+  | Rec : ('a, 'a -> 'e) ty -> ('a, 'e) ty
+  | Pop : ('a, 'e) ty -> ('a, 'b -> 'e) ty
+  | Conv : string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
+  | Sum :
+      < cases : (string * ('e, 'b) ty_case) list;
+        inj : 'c. ('b, 'c) ty_sel * 'c -> 'a;
+        proj : 'a -> string * 'e ty_dyn option > -> ('a, 'e) ty
+and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
+and (_, _) ty_sel =
+    Thd : ('a -> 'b, 'a) ty_sel
+  | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
+and (_, _) ty_case =
+    TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
+  | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
+#                                                                     val ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = Sum 
+type 'a vlist = [ `Cons of 'a * 'a vlist | `Nil ]
+val ty_list : ('a, 'e) ty -> ('a vlist, 'e) ty = 
+#   * * * * * * * * *   
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/dynamic_frisch.ml.reference ocaml-4.01.0/testsuite/tests/typing-gadts/dynamic_frisch.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/dynamic_frisch.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/dynamic_frisch.ml.reference	2013-02-09 08:42:11.000000000 +0000
@@ -0,0 +1,177 @@
+
+#                       type 'a ty =
+    Int : int ty
+  | String : string ty
+  | List : 'a ty -> 'a list ty
+  | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
+#                                                                     type variant =
+    VInt of int
+  | VString of string
+  | VList of variant list
+  | VPair of variant * variant
+val variantize : 't ty -> 't -> variant = 
+exception VariantMismatch
+val devariantize : 't ty -> variant -> 't = 
+#                                                   type 'a ty =
+    Int : int ty
+  | String : string ty
+  | List : 'a ty -> 'a list ty
+  | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
+  | Record : 'a record -> 'a ty
+and 'a record = { path : string; fields : 'a field_ list; }
+and 'a field_ = Field : ('a, 'b) field -> 'a field_
+and ('a, 'b) field = { label : string; field_type : 'b ty; get : 'a -> 'b; }
+#                                                     type variant =
+    VInt of int
+  | VString of string
+  | VList of variant list
+  | VPair of variant * variant
+  | VRecord of (string * variant) list
+val variantize : 't ty -> 't -> variant = 
+#                                                                                                   type 'a ty =
+    Int : int ty
+  | String : string ty
+  | List : 'a ty -> 'a list ty
+  | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
+  | Record : ('a, 'builder) record -> 'a ty
+and ('a, 'builder) record = {
+  path : string;
+  fields : ('a, 'builder) field list;
+  create_builder : unit -> 'builder;
+  of_builder : 'builder -> 'a;
+}
+and ('a, 'builder) field =
+    Field : ('a, 'builder, 'b) field_ -> ('a, 'builder) field
+and ('a, 'builder, 'b) field_ = {
+  label : string;
+  field_type : 'b ty;
+  get : 'a -> 'b;
+  set : 'builder -> 'b -> unit;
+}
+val devariantize : 't ty -> variant -> 't = 
+#                                                   type my_record = { a : int; b : string list; }
+val my_record : my_record ty =
+  Record
+   {path = "My_module.my_record";
+    fields =
+     [Field {label = "a"; field_type = Int; get = ; set = };
+      Field {label = "b"; field_type = List String; get = ; set = }];
+    create_builder = ; of_builder = }
+#                                                                         type noarg = Noarg
+type (_, _) ty =
+    Int : (int, 'c) ty
+  | String : (string, 'd) ty
+  | List : ('a, 'e) ty -> ('a list, 'e) ty
+  | Option : ('a, 'e) ty -> ('a option, 'e) ty
+  | Pair : (('a, 'e) ty * ('b, 'e) ty) -> ('a * 'b, 'e) ty
+  | Var : ('a, 'a -> 'e) ty
+  | Rec : ('a, 'a -> 'e) ty -> ('a, 'e) ty
+  | Pop : ('a, 'e) ty -> ('a, 'b -> 'e) ty
+  | Conv : string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
+  | Sum : ('a, 'e, 'b) ty_sum -> ('a, 'e) ty
+and ('a, 'e, 'b) ty_sum = {
+  sum_proj : 'a -> string * 'e ty_dyn option;
+  sum_cases : (string * ('e, 'b) ty_case) list;
+  sum_inj : 'c. ('b, 'c) ty_sel * 'c -> 'a;
+}
+and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
+and (_, _) ty_sel =
+    Thd : ('a -> 'b, 'a) ty_sel
+  | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
+and (_, _) ty_case =
+    TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
+  | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
+#         type _ ty_env =
+    Enil : unit ty_env
+  | Econs : ('a, 'e) ty * 'e ty_env -> ('a -> 'e) ty_env
+#                                                         type (_, _) eq = Eq : ('a, 'a) eq
+val eq_sel : ('a, 'b) ty_sel -> ('a, 'c) ty_sel -> ('b, 'c) eq option = 
+val get_case :
+  ('b, 'a) ty_sel ->
+  (string * ('e, 'b) ty_case) list -> string * ('a, 'e) ty option = 
+#                                                         type variant =
+    VInt of int
+  | VString of string
+  | VList of variant list
+  | VOption of variant option
+  | VPair of variant * variant
+  | VConv of string * variant
+  | VSum of string * variant option
+val may_map : ('a -> 'b) -> 'a option -> 'b option = 
+val variantize : 'e ty_env -> ('a, 'e) ty -> 'a -> variant = 
+#                                               val devariantize : 'e ty_env -> ('t, 'e) ty -> variant -> 't = 
+#     val wrap_A : ('a, 'b) ty -> ([ `A of 'a ], 'b) ty = 
+#   val ty : ('a, ([ `A of ('a * 'b) option ] as 'b) -> 'c) ty -> ('b, 'c) ty =
+  
+# val v : ([ `A of (int * 'a) option ] as 'a) -> variant = 
+# val x : variant =
+  VConv ("`A",
+   VOption
+    (Some
+      (VPair (VInt 1,
+        VConv ("`A",
+         VOption (Some (VPair (VInt 2, VConv ("`A", VOption None)))))))))
+#               val triple :
+  ('a, 'b) ty -> ('c, 'b) ty -> ('d, 'b) ty -> ('a * 'c * 'd, 'b) ty = 
+val v : variant =
+  VConv ("Triple", VPair (VString "A", VPair (VInt 2, VInt 3)))
+#                                       val ty_abc : ([ `A of int | `B of string | `C ], 'a) ty =
+  Sum
+   {sum_proj = ;
+    sum_cases =
+     [("A", TCarg (Thd, Int)); ("B", TCarg (Ttl Thd, String));
+      ("C", TCnoarg (Ttl (Ttl Thd)))];
+    sum_inj = }
+#                                             val a : [ `A of int | `B of string | `C ] = `A 3
+type 'a vlist = [ `Cons of 'a * 'a vlist | `Nil ]
+val ty_list : ('a, 'e) ty -> ('a vlist, 'e) ty = 
+val v : variant =
+  VSum ("Cons",
+   Some
+    (VPair (VInt 1, VSum ("Cons", Some (VPair (VInt 2, VSum ("Nil", None)))))))
+#                                                               type (_, _) ty =
+    Int : (int, 'c) ty
+  | String : (string, 'd) ty
+  | List : ('a, 'e) ty -> ('a list, 'e) ty
+  | Option : ('a, 'e) ty -> ('a option, 'e) ty
+  | Pair : (('a, 'e) ty * ('b, 'e) ty) -> ('a * 'b, 'e) ty
+  | Var : ('a, 'a -> 'e) ty
+  | Rec : ('a, 'a -> 'e) ty -> ('a, 'e) ty
+  | Pop : ('a, 'e) ty -> ('a, 'b -> 'e) ty
+  | Conv : string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
+  | Sum : ('a -> string * 'e ty_dyn option) *
+      (string * 'e ty_dyn option -> 'a) -> ('a, 'e) ty
+and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
+val ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = Sum (, )
+#                   Characters 327-344:
+      | "Cons", Some (Tdyn (Pair (_, Var), (p : a * a vlist))) -> `Cons p)))
+                                           ^^^^^^^^^^^^^^^^^
+Error: This pattern matches values of type a * a vlist
+       but a pattern was expected which matches values of type
+         a#5 = ex#34 * ex#35
+       Type a is not compatible with type ex#34 
+#                                                         type (_, _) ty =
+    Int : (int, 'd) ty
+  | String : (string, 'f) ty
+  | List : ('a, 'e) ty -> ('a list, 'e) ty
+  | Option : ('a, 'e) ty -> ('a option, 'e) ty
+  | Pair : (('a, 'e) ty * ('b, 'e) ty) -> ('a * 'b, 'e) ty
+  | Var : ('a, 'a -> 'e) ty
+  | Rec : ('a, 'a -> 'e) ty -> ('a, 'e) ty
+  | Pop : ('a, 'e) ty -> ('a, 'b -> 'e) ty
+  | Conv : string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty
+  | Sum :
+      < cases : (string * ('e, 'b) ty_case) list;
+        inj : 'c. ('b, 'c) ty_sel * 'c -> 'a;
+        proj : 'a -> string * 'e ty_dyn option > -> ('a, 'e) ty
+and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
+and (_, _) ty_sel =
+    Thd : ('a -> 'b, 'a) ty_sel
+  | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
+and (_, _) ty_case =
+    TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
+  | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
+#                                                                     val ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = Sum 
+type 'a vlist = [ `Cons of 'a * 'a vlist | `Nil ]
+val ty_list : ('a, 'e) ty -> ('a vlist, 'e) ty = 
+#   * * * * * * * * *   
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/omega07.ml ocaml-4.01.0/testsuite/tests/typing-gadts/omega07.ml
--- ocaml-3.12.1/testsuite/tests/typing-gadts/omega07.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/omega07.ml	2013-04-30 05:26:57.000000000 +0000
@@ -0,0 +1,800 @@
+(*
+   An attempt at encoding omega examples from the 2nd Central European
+   Functional Programming School:
+     Generic Programming in Omega, by Tim Sheard and Nathan Linger
+          http://web.cecs.pdx.edu/~sheard/
+*)
+
+(* Basic types *)
+
+type ('a,'b) sum = Inl of 'a | Inr of 'b
+
+type zero = Zero
+type 'a succ = Succ of 'a
+type _ nat =
+  | NZ : zero nat
+  | NS : 'a nat -> 'a succ nat
+;;
+
+(* 2: A simple example *)
+
+type (_,_) seq =
+  | Snil  : ('a,zero) seq
+  | Scons : 'a * ('a,'n) seq -> ('a, 'n succ) seq
+;;
+
+let l1 = Scons (3, Scons (5, Snil)) ;;
+
+(* We do not have type level functions, so we need to use witnesses. *)
+(* We copy here the definitions from section 3.9 *)
+(* Note the addition of the ['a nat] argument to PlusZ, since we do not
+   have kinds *)
+type (_,_,_) plus =
+  | PlusZ : 'a nat -> (zero, 'a, 'a) plus
+  | PlusS : ('a,'b,'c) plus -> ('a succ, 'b, 'c succ) plus
+;;
+
+let rec length : type a n. (a,n) seq -> n nat = function
+  | Snil -> NZ
+  | Scons (_, s) -> NS (length s)
+;;
+
+(* app returns the catenated lists with a witness proving that
+   the size is the sum of its two inputs *)
+type (_,_,_) app = App : ('a,'p) seq * ('n,'m,'p) plus -> ('a,'n,'m) app
+
+let rec app : type a n m. (a,n) seq -> (a,m) seq -> (a,n,m) app =
+  fun xs ys ->
+  match xs with
+  | Snil -> App (ys, PlusZ (length ys))
+  | Scons (x, xs') ->
+      match app xs' ys with
+      | App (xs'', pl) -> App (Scons (x, xs''), PlusS pl)
+;;
+(* Note: it would be nice to be able to handle existentials in
+   let definitions *)
+
+(* 3.1 Feature: kinds *)
+
+(* We do not have kinds, but we can encode them as predicates *)
+
+type tp = TP
+type nd = ND
+type ('a,'b) fk = FK
+type _ shape =
+  | Tp : tp shape
+  | Nd : nd shape
+  | Fk : 'a shape * 'b shape -> ('a,'b) fk shape
+;;
+type tt = TT
+type ff = FF
+type _ boolean =
+  | BT : tt boolean
+  | BF : ff boolean
+;;
+
+(* 3.3 Feature : GADTs *)
+
+type (_,_) path =
+  | Pnone : 'a -> (tp,'a) path
+  | Phere : (nd,'a) path
+  | Pleft : ('x,'a) path -> (('x,'y) fk, 'a) path
+  | Pright : ('y,'a) path -> (('x,'y) fk, 'a) path
+;;
+type (_,_) tree =
+  | Ttip  : (tp,'a) tree
+  | Tnode : 'a -> (nd,'a) tree
+  | Tfork : ('x,'a) tree * ('y,'a) tree -> (('x,'y)fk, 'a) tree
+;;
+let tree1 = Tfork (Tfork (Ttip, Tnode 4), Tfork (Tnode 4, Tnode 3))
+;;
+let rec find : type sh.
+    ('a -> 'a -> bool) -> 'a -> (sh,'a) tree -> (sh,'a) path list
+  = fun eq n t ->
+    match t with
+    | Ttip -> []
+    | Tnode m ->
+        if eq n m then [Phere] else []
+    | Tfork (x, y) ->
+        List.map (fun x -> Pleft x) (find eq n x) @
+        List.map (fun x -> Pright x) (find eq n y)
+;;
+let rec extract : type sh. (sh,'a) path -> (sh,'a) tree -> 'a = fun p t ->
+  match (p, t) with
+  | Pnone x, Ttip -> x
+  | Phere, Tnode y -> y
+  | Pleft p, Tfork(l,_) -> extract p l
+  | Pright p, Tfork(_,r) -> extract p r
+;;
+
+(* 3.4 Pattern : Witness *)
+
+type (_,_) le =
+  | LeZ : 'a nat -> (zero, 'a) le
+  | LeS : ('n, 'm) le -> ('n succ, 'm succ) le
+;;
+type _ even =
+  | EvenZ : zero even
+  | EvenSS : 'n even -> 'n succ succ even
+;;
+type one = zero succ
+type two = one succ
+type three = two succ
+type four = three succ
+;;
+let even0 : zero even = EvenZ
+let even2 : two even = EvenSS EvenZ
+let even4 : four even = EvenSS (EvenSS EvenZ)
+;;
+let p1 : (two, one, three) plus = PlusS (PlusS (PlusZ (NS NZ)))
+;;
+let rec summandLessThanSum : type a b c. (a,b,c) plus -> (a,c) le = fun p ->
+  match p with
+  | PlusZ n -> LeZ n
+  | PlusS p' -> LeS (summandLessThanSum p')
+;;
+
+(* 3.8 Pattern: Leibniz Equality *)
+
+type (_,_) equal = Eq : ('a,'a) equal
+
+let convert : type a b. (a,b) equal -> a -> b = fun Eq x -> x
+
+let rec sameNat : type a b. a nat -> b nat -> (a,b) equal option = fun a b ->
+  match a, b with
+  | NZ, NZ -> Some Eq
+  | NS a', NS b' ->
+      begin match sameNat a' b' with
+      | Some Eq -> Some Eq
+      | None -> None
+      end
+  | _ -> None
+;;
+
+(* Extra: associativity of addition *)
+
+let rec plus_func : type a b m n.
+  (a,b,m) plus -> (a,b,n) plus -> (m,n) equal =
+  fun p1 p2 ->
+  match p1, p2 with
+  | PlusZ _, PlusZ _ -> Eq
+  | PlusS p1', PlusS p2' ->
+      let Eq = plus_func p1' p2' in Eq
+
+let rec plus_assoc : type a b c ab bc m n.
+  (a,b,ab) plus -> (ab,c,m) plus ->
+  (b,c,bc) plus -> (a,bc,n) plus -> (m,n) equal = fun p1 p2 p3 p4 ->
+  match p1, p4 with
+  | PlusZ b, PlusZ bc ->
+      let Eq = plus_func p2 p3 in Eq
+  | PlusS p1', PlusS p4' ->
+      let PlusS p2' = p2 in
+      let Eq = plus_assoc p1' p2' p3 p4' in Eq
+;;
+
+(* 3.9 Computing Programs and Properties Simultaneously *)
+
+(* Plus and app1 are moved to section 2 *)
+
+let smaller : type a b. (a succ, b succ) le -> (a,b) le =
+  function LeS x -> x ;;
+
+type (_,_) diff = Diff : 'c nat * ('a,'c,'b) plus -> ('a,'b) diff ;;
+
+(*
+let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff =
+  fun le a b ->
+  match a, b, le with
+  | NZ, m, _ -> Diff (m, PlusZ m)
+  | NS x, NZ, _ -> assert false
+  | NS x, NS y, q ->
+      match diff (smaller q) x y with Diff (m, p) -> Diff (m, PlusS p)
+;;
+*)
+
+let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff =
+  fun le a b ->
+  match le, a, b with
+  | LeZ _, _, m -> Diff (m, PlusZ m)
+  | LeS q, NS x, NS y ->
+      match diff q x y with Diff (m, p) -> Diff (m, PlusS p)
+;;
+
+let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff =
+  fun le a b ->
+  match a, b,le with (* warning *)
+  | NZ, m, LeZ _ -> Diff (m, PlusZ m)
+  | NS x, NS y, LeS q ->
+      match diff q x y with Diff (m, p) -> Diff (m, PlusS p)
+;;
+
+let rec diff : type a b. (a,b) le -> b nat -> (a,b) diff =
+  fun le b ->
+  match b,le with
+  | m, LeZ _ -> Diff (m, PlusZ m)
+  | NS y, LeS q ->
+      match diff q y with Diff (m, p) -> Diff (m, PlusS p)
+;;
+
+type (_,_) filter = Filter : ('m,'n) le * ('a,'m) seq -> ('a,'n) filter
+
+let rec leS' : type m n. (m,n) le -> (m,n succ) le = function
+  | LeZ n -> LeZ (NS n)
+  | LeS le -> LeS (leS' le)
+;;
+
+let rec filter : type a n. (a -> bool) -> (a,n) seq -> (a,n) filter =
+  fun f s ->
+  match s with
+  | Snil -> Filter (LeZ NZ, Snil)
+  | Scons (a,l) ->
+      match filter f l with Filter (le, l') ->
+        if f a then Filter (LeS le, Scons (a, l'))
+        else Filter (leS' le, l')
+;;
+
+(* 4.1 AVL trees *)
+
+type (_,_,_) balance =
+  | Less : ('h, 'h succ, 'h succ) balance
+  | Same : ('h, 'h, 'h) balance
+  | More : ('h succ, 'h, 'h succ) balance
+
+type _ avl =
+  | Leaf : zero avl
+  | Node :
+      ('hL, 'hR, 'hMax) balance * 'hL avl * int * 'hR avl -> 'hMax succ avl
+
+type avl' = Avl : 'h avl -> avl'
+;;
+
+let empty = Avl Leaf
+
+let rec elem : type h. int -> h avl -> bool = fun x t ->
+  match t with
+  | Leaf -> false
+  | Node (_, l, y, r) ->
+      x = y || if x < y then elem x l else elem x r
+;;
+
+let rec rotr : type n. (n succ succ) avl -> int -> n avl ->
+  ((n succ succ) avl, (n succ succ succ) avl) sum =
+  fun tL y tR ->
+  match tL with
+  | Node (Same, a, x, b) -> Inr (Node (Less, a, x, Node (More, b, y, tR)))
+  | Node (More, a, x, b) -> Inl (Node (Same, a, x, Node (Same, b, y, tR)))
+  | Node (Less, a, x, Node (Same, b, z, c)) ->
+      Inl (Node (Same, Node (Same, a, x, b), z, Node (Same, c, y, tR)))
+  | Node (Less, a, x, Node (Less, b, z, c)) ->
+      Inl (Node (Same, Node (More, a, x, b), z, Node (Same, c, y, tR)))
+  | Node (Less, a, x, Node (More, b, z, c)) ->
+      Inl (Node (Same, Node (Same, a, x, b), z, Node (Less, c, y, tR)))
+;;
+let rec rotl : type n. n avl -> int -> (n succ succ) avl ->
+  ((n succ succ) avl, (n succ succ succ) avl) sum =
+  fun tL u tR ->
+  match tR with
+  | Node (Same, a, x, b) -> Inr (Node (More, Node (Less, tL, u, a), x, b))
+  | Node (Less, a, x, b) -> Inl (Node (Same, Node (Same, tL, u, a), x, b))
+  | Node (More, Node (Same, a, x, b), y, c) ->
+      Inl (Node (Same, Node (Same, tL, u, a), x, Node (Same, b, y, c)))
+  | Node (More, Node (Less, a, x, b), y, c) ->
+      Inl (Node (Same, Node (More, tL, u, a), x, Node (Same, b, y, c)))
+  | Node (More, Node (More, a, x, b), y, c) ->
+      Inl (Node (Same, Node (Same, tL, u, a), x, Node (Less, b, y, c)))
+;;
+let rec ins : type n. int -> n avl -> (n avl, (n succ) avl) sum =
+  fun x t ->
+  match t with
+  | Leaf -> Inr (Node (Same, Leaf, x, Leaf))
+  | Node (bal, a, y, b) ->
+      if x = y then Inl t else
+      if x < y then begin
+        match ins x a with
+        | Inl a -> Inl (Node (bal, a, y, b))
+        | Inr a ->
+            match bal with
+            | Less -> Inl (Node (Same, a, y, b))
+            | Same -> Inr (Node (More, a, y, b))
+            | More -> rotr a y b
+      end else begin
+        match ins x b with
+        | Inl b -> Inl (Node (bal, a, y, b) : n avl)
+        | Inr b ->
+            match bal with
+            | More -> Inl (Node (Same, a, y, b) : n avl)
+            | Same -> Inr (Node (Less, a, y, b) : n succ avl)
+            | Less -> rotl a y b
+      end
+;;
+
+let insert x (Avl t) =
+  match ins x t with
+  | Inl t -> Avl t
+  | Inr t -> Avl t
+;;
+
+let rec del_min : type n. (n succ) avl -> int * (n avl, (n succ) avl) sum =
+  function
+  | Node (Less, Leaf, x, r) -> (x, Inl r)
+  | Node (Same, Leaf, x, r) -> (x, Inl r)
+  | Node (bal, (Node _ as l) , x, r) ->
+      match del_min l with
+      | y, Inr l -> (y, Inr (Node (bal, l, x, r)))
+      | y, Inl l ->
+          (y, match bal with
+          | Same -> Inr (Node (Less, l, x, r))
+          | More -> Inl (Node (Same, l, x, r))
+          | Less -> rotl l x r)
+
+type _ avl_del =
+  | Dsame : 'n avl -> 'n avl_del
+  | Ddecr : ('m succ, 'n) equal * 'm avl -> 'n avl_del
+
+let rec del : type n. int -> n avl -> n avl_del = fun y t ->
+  match t with
+  | Leaf -> Dsame Leaf
+  | Node (bal, l, x, r) ->
+      if x = y then begin
+        match r with
+        | Leaf ->
+            begin match bal with
+            | Same -> Ddecr (Eq, l)
+            | More -> Ddecr (Eq, l)
+            end
+        | Node _ ->
+            begin match bal, del_min r with
+            | _, (z, Inr r) -> Dsame (Node (bal, l, z, r))
+            | Same, (z, Inl r) -> Dsame (Node (More, l, z, r))
+            | Less, (z, Inl r) -> Ddecr (Eq, Node (Same, l, z, r))
+            | More, (z, Inl r) ->
+                match rotr l z r with
+                | Inl t -> Ddecr (Eq, t)
+                | Inr t -> Dsame t
+            end
+      end else if y < x then begin
+        match del y l with
+        | Dsame l -> Dsame (Node (bal, l, x, r))
+        | Ddecr(Eq,l) ->
+            begin match bal with
+            | Same -> Dsame (Node (Less, l, x, r))
+            | More -> Ddecr (Eq, Node (Same, l, x, r))
+            | Less ->
+                match rotl l x r with
+                | Inl t -> Ddecr (Eq, t)
+                | Inr t -> Dsame t
+            end
+      end else begin
+        match del y r with
+        | Dsame r -> Dsame (Node (bal, l, x, r))
+        | Ddecr(Eq,r) ->
+            begin match bal with
+            | Same -> Dsame (Node (More, l, x, r))
+            | Less -> Ddecr (Eq, Node (Same, l, x, r))
+            | More ->
+                match rotr l x r with
+                | Inl t -> Ddecr (Eq, t)
+                | Inr t -> Dsame t
+            end
+      end
+;;
+
+let delete x (Avl t) =
+  match del x t with
+  | Dsame t -> Avl t
+  | Ddecr (_, t) -> Avl t
+;;
+
+
+(* Exercise 22: Red-black trees *)
+
+type red = RED
+type black = BLACK
+type (_,_) sub_tree =
+  | Bleaf : (black, zero) sub_tree
+  | Rnode :
+      (black, 'n) sub_tree * int * (black, 'n) sub_tree -> (red, 'n) sub_tree
+  | Bnode :
+      ('cL, 'n) sub_tree * int * ('cR, 'n) sub_tree -> (black, 'n succ) sub_tree
+
+type rb_tree = Root : (black, 'n) sub_tree -> rb_tree
+;;
+
+type dir = LeftD | RightD
+
+type (_,_) ctxt =
+  | CNil : (black,'n) ctxt
+  | CRed : int * dir * (black,'n) sub_tree * (red,'n) ctxt -> (black,'n) ctxt
+  | CBlk : int * dir * ('c1,'n) sub_tree * (black, 'n succ) ctxt -> ('c,'n) ctxt
+;;
+
+let blacken = function
+    Rnode (l, e, r) -> Bnode (l, e, r)
+
+type _ crep =
+  | Red : red crep
+  | Black : black crep
+
+let color : type c n. (c,n) sub_tree -> c crep = function
+  | Bleaf -> Black
+  | Rnode _ -> Red
+  | Bnode _ -> Black
+;;
+
+let rec fill : type c n. (c,n) ctxt -> (c,n) sub_tree -> rb_tree =
+  fun ct t ->
+  match ct with
+  | CNil -> Root t
+  | CRed (e, LeftD, uncle, c) -> fill c (Rnode (uncle, e, t))
+  | CRed (e, RightD, uncle, c) -> fill c (Rnode (t, e, uncle))
+  | CBlk (e, LeftD, uncle, c) -> fill c (Bnode (uncle, e, t))
+  | CBlk (e, RightD, uncle, c) -> fill c (Bnode (t, e, uncle))
+;;
+let recolor d1 pE sib d2 gE uncle t =
+  match d1, d2 with
+  | LeftD, RightD -> Rnode (Bnode (sib, pE, t), gE, uncle)
+  | RightD, RightD -> Rnode (Bnode (t, pE, sib), gE, uncle)
+  | LeftD, LeftD -> Rnode (uncle, gE, Bnode (sib, pE, t))
+  | RightD, LeftD -> Rnode (uncle, gE, Bnode (t, pE, sib))
+;;
+let rotate d1 pE sib d2 gE uncle (Rnode (x, e, y)) =
+  match d1, d2 with
+  | RightD, RightD -> Bnode (Rnode (x,e,y), pE, Rnode (sib, gE, uncle))
+  | LeftD,  RightD -> Bnode (Rnode (sib, pE, x), e, Rnode (y, gE, uncle))
+  | LeftD,  LeftD  -> Bnode (Rnode (uncle, gE, sib), pE, Rnode (x,e,y))
+  | RightD, LeftD  -> Bnode (Rnode (uncle, gE, x), e, Rnode (y, pE, sib))
+;;
+let rec repair : type c n. (red,n) sub_tree -> (c,n) ctxt -> rb_tree =
+  fun t ct ->
+  match ct with
+  | CNil -> Root (blacken t)
+  | CBlk (e, LeftD, sib, c) -> fill c (Bnode (sib, e, t))
+  | CBlk (e, RightD, sib, c) -> fill c (Bnode (t, e, sib))
+  | CRed (e, dir, sib, CBlk (e', dir', uncle, ct)) ->
+      match color uncle with
+      | Red -> repair (recolor dir e sib dir' e' (blacken uncle) t) ct
+      | Black -> fill ct (rotate dir e sib dir' e' uncle t)
+;;
+let rec ins : type c n. int -> (c,n) sub_tree -> (c,n) ctxt -> rb_tree =
+  fun e t ct ->
+  match t with
+  | Rnode (l, e', r) ->
+      if e < e' then ins e l (CRed (e', RightD, r, ct))
+                else ins e r (CRed (e', LeftD, l, ct))
+  | Bnode (l, e', r) ->
+      if e < e' then ins e l (CBlk (e', RightD, r, ct))
+                else ins e r (CBlk (e', LeftD, l, ct))
+  | Bleaf -> repair (Rnode (Bleaf, e, Bleaf)) ct
+;;
+let insert e (Root t) = ins e t CNil
+;;
+
+(* 5.7 typed object languages using GADTs *)
+
+type _ term =
+  | Const : int -> int term
+  | Add   : (int * int -> int) term
+  | LT    : (int * int -> bool) term
+  | Ap    : ('a -> 'b) term * 'a term -> 'b term
+  | Pair  : 'a term * 'b term -> ('a * 'b) term
+
+let ex1 = Ap (Add, Pair (Const 3, Const 5))
+let ex2 = Pair (ex1, Const 1)
+
+let rec eval_term : type a. a term -> a = function
+  | Const x -> x
+  | Add -> fun (x,y) -> x+y
+  | LT  -> fun (x,y) -> x eval_term f (eval_term x)
+  | Pair(x,y) -> (eval_term x, eval_term y)
+
+type _ rep =
+  | Rint  : int rep
+  | Rbool : bool rep
+  | Rpair : 'a rep * 'b rep -> ('a * 'b) rep
+  | Rfun  : 'a rep * 'b rep -> ('a -> 'b) rep
+
+type (_,_) equal = Eq : ('a,'a) equal
+
+let rec rep_equal : type a b. a rep -> b rep -> (a, b) equal option =
+  fun ra rb ->
+  match ra, rb with
+  | Rint, Rint -> Some Eq
+  | Rbool, Rbool -> Some Eq
+  | Rpair (a1, a2), Rpair (b1, b2) ->
+      begin match rep_equal a1 b1 with
+      | None -> None
+      | Some Eq -> match rep_equal a2 b2 with
+        | None -> None
+        | Some Eq -> Some Eq
+      end
+  | Rfun (a1, a2), Rfun (b1, b2) ->
+      begin match rep_equal a1 b1 with
+      | None -> None
+      | Some Eq -> match rep_equal a2 b2 with
+        | None -> None
+        | Some Eq -> Some Eq
+      end
+  | _ -> None
+;;
+
+type assoc = Assoc : string * 'a rep * 'a -> assoc
+
+let rec assoc : type a. string -> a rep -> assoc list -> a =
+  fun x r -> function
+  | [] -> raise Not_found
+  | Assoc (x', r', v) :: env ->
+      if x = x' then
+        match rep_equal r r' with
+        | None -> failwith ("Wrong type for " ^ x)
+        | Some Eq -> v
+      else assoc x r env
+
+type _ term =
+  | Var   : string * 'a rep -> 'a term
+  | Abs   : string * 'a rep * 'b term -> ('a -> 'b) term
+  | Const : int -> int term
+  | Add   : (int * int -> int) term
+  | LT    : (int * int -> bool) term
+  | Ap    : ('a -> 'b) term * 'a term -> 'b term
+  | Pair  : 'a term * 'b term -> ('a * 'b) term
+
+let rec eval_term : type a. assoc list -> a term -> a =
+  fun env -> function
+  | Var (x, r) -> assoc x r env
+  | Abs (x, r, e) -> fun v -> eval_term (Assoc (x, r, v) :: env) e
+  | Const x -> x
+  | Add -> fun (x,y) -> x+y
+  | LT  -> fun (x,y) -> x eval_term env f (eval_term env x)
+  | Pair(x,y) -> (eval_term env x, eval_term env y)
+;;
+
+let ex3 = Abs ("x", Rint, Ap (Add, Pair (Var("x",Rint), Var("x",Rint))))
+let ex4 = Ap (ex3, Const 3)
+
+let v4 = eval_term [] ex4
+;;
+
+(* 5.9/5.10 Language with binding *)
+
+type rnil = RNIL
+type ('a,'b,'c) rcons = RCons of 'a * 'b * 'c
+
+type _ is_row =
+  | Rnil  : rnil is_row
+  | Rcons : 'c is_row -> ('a,'b,'c) rcons is_row
+
+type (_,_) lam =
+  | Const : int -> ('e, int) lam
+  | Var : 'a -> (('a,'t,'e) rcons, 't) lam
+  | Shift : ('e,'t) lam -> (('a,'q,'e) rcons, 't) lam
+  | Abs : 'a * (('a,'s,'e) rcons, 't) lam -> ('e, 's -> 't) lam
+  | App : ('e, 's -> 't) lam * ('e, 's) lam -> ('e, 't) lam
+
+type x = X
+type y = Y
+
+let ex1 = App (Var X, Shift (Var Y))
+let ex2 = Abs (X, Abs (Y, App (Shift (Var X), Var Y)))
+;;
+
+type _ env =
+  | Enil : rnil env
+  | Econs : 'a * 't * 'e env -> ('a, 't, 'e) rcons env
+
+let rec eval_lam : type e t. e env -> (e, t) lam -> t =
+  fun env m ->
+  match env, m with
+  | _, Const n -> n
+  | Econs (_, v, r), Var _ -> v
+  | Econs (_, _, r), Shift e -> eval_lam r e
+  | _, Abs (n, body) -> fun x -> eval_lam (Econs (n, x, env)) body
+  | _, App (f, x)    -> eval_lam env f (eval_lam env x)
+;;
+
+type add = Add
+type suc = Suc
+
+let env0 = Econs (Zero, 0, Econs (Suc, succ, Econs (Add, (+), Enil)))
+
+let _0 : (_, int) lam = Var Zero
+let suc x = App (Shift (Var Suc : (_, int -> int) lam), x)
+let _1 = suc _0
+let _2 = suc _1
+let _3 = suc _2
+let add = Shift (Shift (Var Add : (_, int -> int -> int) lam))
+
+let double = Abs (X, App (App (Shift add, Var X), Var X))
+let ex3 = App (double, _3)
+;;
+
+let v3 = eval_lam env0 ex3
+;;
+
+(* 5.13: Constructing typing derivations at runtime *)
+
+(* Modified slightly to use the language of 5.10, since this is more fun.
+   Of course this works also with the language of 5.12. *)
+
+type _ rep =
+  | I : int rep
+  | Ar : 'a rep * 'b rep -> ('a -> 'b) rep
+
+let rec compare : type a b. a rep -> b rep -> (string, (a,b) equal) sum =
+  fun a b ->
+  match a, b with
+  | I, I -> Inr Eq
+  | Ar(x,y), Ar(s,t) ->
+      begin match compare x s with
+      | Inl _ as e -> e
+      | Inr Eq -> match compare y t with
+        | Inl _ as e -> e
+        | Inr Eq as e -> e
+      end
+  | I, Ar _ -> Inl "I <> Ar _"
+  | Ar _, I -> Inl "Ar _ <> I"
+;;
+
+type term =
+  | C of int
+  | Ab : string * 'a rep * term -> term
+  | Ap of term * term
+  | V of string
+
+type _ ctx =
+  | Cnil : rnil ctx
+  | Ccons : 't * string * 'x rep * 'e ctx -> ('t,'x,'e) rcons ctx
+;;
+
+type _ checked =
+  | Cerror of string
+  | Cok : ('e,'t) lam * 't rep -> 'e checked
+
+let rec lookup : type e. string -> e ctx -> e checked =
+  fun name ctx ->
+  match ctx with
+  | Cnil -> Cerror ("Name not found: " ^ name)
+  | Ccons (l,s,t,rs) ->
+      if s = name then Cok (Var l,t) else
+      match lookup name rs with
+      | Cerror m -> Cerror m
+      | Cok (v, t) -> Cok (Shift v, t)
+;;
+
+let rec tc : type n e. n nat -> e ctx -> term -> e checked =
+  fun n ctx t ->
+  match t with
+  | V s -> lookup s ctx
+  | Ap(f,x) ->
+      begin match tc n ctx f with
+      | Cerror _ as e -> e
+      | Cok (f', ft) -> match tc n ctx x with
+        | Cerror _ as e -> e
+        | Cok (x', xt) ->
+            match ft with
+            | Ar (a, b) ->
+                begin match compare a xt with
+                | Inl s -> Cerror s
+                | Inr Eq -> Cok (App (f',x'), b)
+                end
+            | _ -> Cerror "Non fun in Ap"
+      end
+  | Ab(s,t,body) ->
+      begin match tc (NS n) (Ccons (n, s, t, ctx)) body with
+      | Cerror _ as e -> e
+      | Cok (body', et) -> Cok (Abs (n, body'), Ar (t, et))
+      end
+  | C m -> Cok (Const m, I)
+;;
+
+let ctx0 =
+  Ccons (Zero, "0", I,
+         Ccons (Suc, "S", Ar(I,I),
+                Ccons (Add, "+", Ar(I,Ar(I,I)), Cnil)))
+
+let ex1 = Ab ("x", I, Ap(Ap(V"+",V"x"),V"x"));;
+let c1 = tc NZ ctx0 ex1;;
+let ex2 = Ap (ex1, C 3);;
+let c2 = tc NZ ctx0 ex2;;
+
+let eval_checked env = function
+  | Cerror s -> failwith s
+  | Cok (e, I) -> (eval_lam env e : int)
+  | Cok _ -> failwith "Can only evaluate expressions of type I"
+;;
+
+let v2 = eval_checked env0 c2 ;;
+
+(* 5.12 Soundness *)
+
+type pexp = PEXP
+type pval = PVAL
+type _ mode =
+  | Pexp : pexp mode
+  | Pval : pval mode
+
+type ('a,'b) tarr = TARR
+type tint = TINT
+
+type (_,_) rel =
+  | IntR : (tint, int) rel
+  | IntTo : ('b, 's) rel -> ((tint, 'b) tarr, int -> 's) rel
+
+type (_,_,_) lam =
+  | Const : ('a,'b) rel * 'b -> (pval, 'env, 'a) lam
+  | Var : 'a -> (pval, ('a,'t,'e) rcons, 't) lam
+  | Shift : ('m,'e,'t) lam -> ('m, ('a,'q,'e) rcons, 't) lam
+  | Lam : 'a * ('m, ('a,'s,'e) rcons, 't) lam -> (pval, 'e, ('s,'t) tarr) lam
+  | App : ('m1, 'e, ('s,'t) tarr) lam * ('m2, 'e, 's) lam -> (pexp, 'e, 't) lam
+;;
+
+let ex1 = App (Lam (X, Var X), Const (IntR, 3))
+
+let rec mode : type m e t. (m,e,t) lam -> m mode = function
+  | Lam (v, body) -> Pval
+  | Var v -> Pval
+  | Const (r, v) -> Pval
+  | Shift e -> mode e
+  | App _ -> Pexp
+;;
+
+type (_,_) sub =
+  | Id : ('r,'r) sub
+  | Bind : 't * ('m,'r2,'x) lam * ('r,'r2) sub -> (('t,'x,'r) rcons, 'r2) sub
+  | Push : ('r1,'r2) sub -> (('a,'b,'r1) rcons, ('a,'b,'r2) rcons) sub
+
+type (_,_) lam' = Ex : ('m, 's, 't) lam -> ('s,'t) lam'
+;;
+
+let rec subst : type m1 r t s. (m1,r,t) lam -> (r,s) sub -> (s,t) lam' =
+  fun t s ->
+  match t, s with
+  | _, Id -> Ex t
+  | Const(r,c), sub -> Ex (Const (r,c))
+  | Var v, Bind (x, e, r) -> Ex e
+  | Var v, Push sub -> Ex (Var v)
+  | Shift e, Bind (_, _, r) -> subst e r
+  | Shift e, Push sub ->
+      (match subst e sub with Ex a -> Ex (Shift a))
+  | App(f,x), sub ->
+      (match subst f sub, subst x sub with Ex g, Ex y -> Ex (App (g,y)))
+  | Lam(v,x), sub ->
+      (match subst x (Push sub) with Ex body -> Ex (Lam (v, body)))
+;;
+
+type closed = rnil
+
+type 'a rlam = ((pexp,closed,'a) lam, (pval,closed,'a) lam) sum ;;
+
+let rec rule : type a b.
+  (pval, closed, (a,b) tarr) lam -> (pval, closed, a) lam -> b rlam =
+  fun v1 v2 ->
+  match v1, v2 with
+  | Lam(x,body), v ->
+      begin
+        match subst body (Bind (x, v, Id)) with Ex term ->
+        match mode term with
+        | Pexp -> Inl term
+        | Pval -> Inr term
+      end
+  | Const (IntTo b, f), Const (IntR, x) ->
+      Inr (Const (b, f x))
+;;
+let rec onestep : type m t. (m,closed,t) lam -> t rlam = function
+  | Lam (v, body) -> Inr (Lam (v, body))
+  | Const (r, v)  -> Inr (Const (r, v))
+  | App (e1, e2) ->
+      match mode e1, mode e2 with
+      | Pexp, _->
+          begin match onestep e1 with
+          | Inl e -> Inl(App(e,e2))
+          | Inr v -> Inl(App(v,e2))
+          end
+      | Pval, Pexp ->
+          begin match onestep e2 with
+          | Inl e -> Inl(App(e1,e))
+          | Inr v -> Inl(App(e1,v))
+          end
+      | Pval, Pval -> rule e1 e2
+;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/omega07.ml.principal.reference ocaml-4.01.0/testsuite/tests/typing-gadts/omega07.ml.principal.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/omega07.ml.principal.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/omega07.ml.principal.reference	2013-04-30 05:26:57.000000000 +0000
@@ -0,0 +1,312 @@
+
+# * * * * *                       type ('a, 'b) sum = Inl of 'a | Inr of 'b
+type zero = Zero
+type 'a succ = Succ of 'a
+type _ nat = NZ : zero nat | NS : 'a nat -> 'a succ nat
+#             type (_, _) seq =
+    Snil : ('a, zero) seq
+  | Scons : 'a * ('a, 'n) seq -> ('a, 'n succ) seq
+#   val l1 : (int, zero succ succ) seq = Scons (3, Scons (5, Snil))
+#       *         type (_, _, _) plus =
+    PlusZ : 'a nat -> (zero, 'a, 'a) plus
+  | PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus
+#         val length : ('a, 'n) seq -> 'n nat = 
+#   *                     type (_, _, _) app =
+    App : ('a, 'p) seq * ('n, 'm, 'p) plus -> ('a, 'n, 'm) app
+val app : ('a, 'n) seq -> ('a, 'm) seq -> ('a, 'n, 'm) app = 
+# *                           type tp = TP
+type nd = ND
+type ('a, 'b) fk = FK
+type _ shape =
+    Tp : tp shape
+  | Nd : nd shape
+  | Fk : 'a shape * 'b shape -> ('a, 'b) fk shape
+#           type tt = TT
+type ff = FF
+type _ boolean = BT : tt boolean | BF : ff boolean
+#                 type (_, _) path =
+    Pnone : 'a -> (tp, 'a) path
+  | Phere : (nd, 'a) path
+  | Pleft : ('x, 'a) path -> (('x, 'y) fk, 'a) path
+  | Pright : ('y, 'a) path -> (('x, 'y) fk, 'a) path
+#         type (_, _) tree =
+    Ttip : (tp, 'a) tree
+  | Tnode : 'a -> (nd, 'a) tree
+  | Tfork : ('x, 'a) tree * ('y, 'a) tree -> (('x, 'y) fk, 'a) tree
+#   val tree1 : (((tp, nd) fk, (nd, nd) fk) fk, int) tree =
+  Tfork (Tfork (Ttip, Tnode 4), Tfork (Tnode 4, Tnode 3))
+#                     val find : ('a -> 'a -> bool) -> 'a -> ('sh, 'a) tree -> ('sh, 'a) path list =
+  
+#             val extract : ('sh, 'a) path -> ('sh, 'a) tree -> 'a = 
+#             type (_, _) le =
+    LeZ : 'a nat -> (zero, 'a) le
+  | LeS : ('n, 'm) le -> ('n succ, 'm succ) le
+#       type _ even = EvenZ : zero even | EvenSS : 'n even -> 'n succ succ even
+#         type one = zero succ
+type two = one succ
+type three = two succ
+type four = three succ
+#       val even0 : zero even = EvenZ
+val even2 : two even = EvenSS EvenZ
+val even4 : four even = EvenSS (EvenSS EvenZ)
+#   val p1 : (two, one, three) plus = PlusS (PlusS (PlusZ (NS NZ)))
+#         val summandLessThanSum : ('a, 'b, 'c) plus -> ('a, 'c) le = 
+#                                 type (_, _) equal = Eq : ('a, 'a) equal
+val convert : ('a, 'b) equal -> 'a -> 'b = 
+val sameNat : 'a nat -> 'b nat -> ('a, 'b) equal option = 
+#                                         val plus_func : ('a, 'b, 'm) plus -> ('a, 'b, 'n) plus -> ('m, 'n) equal =
+  
+val plus_assoc :
+  ('a, 'b, 'ab) plus ->
+  ('ab, 'c, 'm) plus ->
+  ('b, 'c, 'bc) plus -> ('a, 'bc, 'n) plus -> ('m, 'n) equal = 
+#             val smaller : ('a succ, 'b succ) le -> ('a, 'b) le = 
+#   type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
+#   * * * * * * * * *                 val diff : ('a, 'b) le -> 'a nat -> 'b nat -> ('a, 'b) diff = 
+#               Characters 87-243:
+  ..match a, b,le with (* warning *)
+    | NZ, m, LeZ _ -> Diff (m, PlusZ m)
+    | NS x, NS y, LeS q ->
+        match diff q x y with Diff (m, p) -> Diff (m, PlusS p)
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+(NS _, NZ, _)
+val diff : ('a, 'b) le -> 'a nat -> 'b nat -> ('a, 'b) diff = 
+#               val diff : ('a, 'b) le -> 'b nat -> ('a, 'b) diff = 
+#             type (_, _) filter = Filter : ('m, 'n) le * ('a, 'm) seq -> ('a, 'n) filter
+val leS' : ('m, 'n) le -> ('m, 'n succ) le = 
+#                   val filter : ('a -> bool) -> ('a, 'n) seq -> ('a, 'n) filter = 
+#                             type (_, _, _) balance =
+    Less : ('h, 'h succ, 'h succ) balance
+  | Same : ('h, 'h, 'h) balance
+  | More : ('h succ, 'h, 'h succ) balance
+type _ avl =
+    Leaf : zero avl
+  | Node : ('hL, 'hR, 'hMax) balance * 'hL avl * int *
+      'hR avl -> 'hMax succ avl
+type avl' = Avl : 'h avl -> avl'
+#                 val empty : avl' = Avl Leaf
+val elem : int -> 'h avl -> bool = 
+#                           val rotr :
+  'n succ succ avl ->
+  int -> 'n avl -> ('n succ succ avl, 'n succ succ succ avl) sum = 
+#                         val rotl :
+  'n avl ->
+  int -> 'n succ succ avl -> ('n succ succ avl, 'n succ succ succ avl) sum =
+  
+#                                               val ins : int -> 'n avl -> ('n avl, 'n succ avl) sum = 
+#           val insert : int -> avl' -> avl' = 
+#                                                                                                                                 val del_min : 'n succ avl -> int * ('n avl, 'n succ avl) sum = 
+type _ avl_del =
+    Dsame : 'n avl -> 'n avl_del
+  | Ddecr : ('m succ, 'n) equal * 'm avl -> 'n avl_del
+val del : int -> 'n avl -> 'n avl_del = 
+#           val delete : int -> avl' -> avl' = 
+#                             type red = RED
+type black = BLACK
+type (_, _) sub_tree =
+    Bleaf : (black, zero) sub_tree
+  | Rnode : (black, 'n) sub_tree * int *
+      (black, 'n) sub_tree -> (red, 'n) sub_tree
+  | Bnode : ('cL, 'n) sub_tree * int *
+      ('cR, 'n) sub_tree -> (black, 'n succ) sub_tree
+type rb_tree = Root : (black, 'n) sub_tree -> rb_tree
+#               type dir = LeftD | RightD
+type (_, _) ctxt =
+    CNil : (black, 'n) ctxt
+  | CRed : int * dir * (black, 'n) sub_tree *
+      (red, 'n) ctxt -> (black, 'n) ctxt
+  | CBlk : int * dir * ('c1, 'n) sub_tree *
+      (black, 'n succ) ctxt -> ('c, 'n) ctxt
+#                         val blacken : (red, 'a) sub_tree -> (black, 'a succ) sub_tree = 
+type _ crep = Red : red crep | Black : black crep
+val color : ('c, 'n) sub_tree -> 'c crep = 
+#                   val fill : ('c, 'n) ctxt -> ('c, 'n) sub_tree -> rb_tree = 
+#             val recolor :
+  dir ->
+  int ->
+  ('a, 'b) sub_tree ->
+  dir ->
+  int ->
+  (black, 'b succ) sub_tree -> ('c, 'b) sub_tree -> (red, 'b succ) sub_tree =
+  
+#             val rotate :
+  dir ->
+  int ->
+  (black, 'a) sub_tree ->
+  dir ->
+  int ->
+  (black, 'a) sub_tree -> (red, 'a) sub_tree -> (black, 'a succ) sub_tree =
+  
+#                     val repair : (red, 'n) sub_tree -> ('c, 'n) ctxt -> rb_tree = 
+#                     val ins : int -> ('c, 'n) sub_tree -> ('c, 'n) ctxt -> rb_tree = 
+#   val insert : int -> rb_tree -> rb_tree = 
+#                                                                                                 type _ term =
+    Const : int -> int term
+  | Add : (int * int -> int) term
+  | LT : (int * int -> bool) term
+  | Ap : ('a -> 'b) term * 'a term -> 'b term
+  | Pair : 'a term * 'b term -> ('a * 'b) term
+val ex1 : int term = Ap (Add, Pair (Const 3, Const 5))
+val ex2 : (int * int) term =
+  Pair (Ap (Add, Pair (Const 3, Const 5)), Const 1)
+val eval_term : 'a term -> 'a = 
+type _ rep =
+    Rint : int rep
+  | Rbool : bool rep
+  | Rpair : 'a rep * 'b rep -> ('a * 'b) rep
+  | Rfun : 'a rep * 'b rep -> ('a -> 'b) rep
+type (_, _) equal = Eq : ('a, 'a) equal
+val rep_equal : 'a rep -> 'b rep -> ('a, 'b) equal option = 
+#                                                               type assoc = Assoc : string * 'a rep * 'a -> assoc
+val assoc : string -> 'a rep -> assoc list -> 'a = 
+type _ term =
+    Var : string * 'a rep -> 'a term
+  | Abs : string * 'a rep * 'b term -> ('a -> 'b) term
+  | Const : int -> int term
+  | Add : (int * int -> int) term
+  | LT : (int * int -> bool) term
+  | Ap : ('a -> 'b) term * 'a term -> 'b term
+  | Pair : 'a term * 'b term -> ('a * 'b) term
+val eval_term : assoc list -> 'a term -> 'a = 
+#           val ex3 : (int -> int) term =
+  Abs ("x", Rint, Ap (Add, Pair (Var ("x", Rint), Var ("x", Rint))))
+val ex4 : int term =
+  Ap (Abs ("x", Rint, Ap (Add, Pair (Var ("x", Rint), Var ("x", Rint)))),
+   Const 3)
+val v4 : int = 6
+#                                             type rnil = RNIL
+type ('a, 'b, 'c) rcons = RCons of 'a * 'b * 'c
+type _ is_row =
+    Rnil : rnil is_row
+  | Rcons : 'c is_row -> ('a, 'b, 'c) rcons is_row
+type (_, _) lam =
+    Const : int -> ('e, int) lam
+  | Var : 'a -> (('a, 't, 'e) rcons, 't) lam
+  | Shift : ('e, 't) lam -> (('a, 'q, 'e) rcons, 't) lam
+  | Abs : 'a * (('a, 's, 'e) rcons, 't) lam -> ('e, 's -> 't) lam
+  | App : ('e, 's -> 't) lam * ('e, 's) lam -> ('e, 't) lam
+type x = X
+type y = Y
+val ex1 : ((x, 'a -> 'b, (y, 'a, 'c) rcons) rcons, 'b) lam =
+  App (Var X, Shift (Var Y))
+val ex2 : ('a, ('b -> 'c) -> 'b -> 'c) lam =
+  Abs (, Abs (, App (Shift (Var ), Var )))
+#                           type _ env =
+    Enil : rnil env
+  | Econs : 'a * 't * 'e env -> ('a, 't, 'e) rcons env
+val eval_lam : 'e env -> ('e, 't) lam -> 't = 
+#                               type add = Add
+type suc = Suc
+val env0 :
+  (zero, int, (suc, int -> int, (add, int -> int -> int, rnil) rcons) rcons)
+  rcons env = Econs (Zero, 0, Econs (Suc, , Econs (Add, , Enil)))
+val _0 : ((zero, int, 'a) rcons, int) lam = Var Zero
+val suc :
+  (('a, 'b, (suc, int -> int, 'c) rcons) rcons, int) lam ->
+  (('a, 'b, (suc, int -> int, 'c) rcons) rcons, int) lam = 
+val _1 :
+  ((zero, int, (suc, int -> int, (add, int -> int -> int, '_a) rcons) rcons)
+   rcons, int)
+  lam = App (Shift (Var Suc), Var Zero)
+val _2 :
+  ((zero, int, (suc, int -> int, (add, int -> int -> int, '_a) rcons) rcons)
+   rcons, int)
+  lam = App (Shift (Var Suc), App (Shift (Var Suc), Var Zero))
+val _3 :
+  ((zero, int, (suc, int -> int, (add, int -> int -> int, '_a) rcons) rcons)
+   rcons, int)
+  lam =
+  App (Shift (Var Suc),
+   App (Shift (Var Suc), App (Shift (Var Suc), Var Zero)))
+val add :
+  (('a, 'b, ('c, 'd, (add, int -> int -> int, 'e) rcons) rcons) rcons,
+   int -> int -> int)
+  lam = Shift (Shift (Var Add))
+val double :
+  (('a, 'b, ('c, 'd, (add, int -> int -> int, 'e) rcons) rcons) rcons,
+   int -> int)
+  lam =
+  Abs (,
+   App (App (Shift (Shift (Shift (Var Add))), Var ), Var ))
+val ex3 :
+  ((zero, int, (suc, int -> int, (add, int -> int -> int, '_a) rcons) rcons)
+   rcons, int)
+  lam =
+  App
+   (Abs (,
+     App (App (Shift (Shift (Shift (Var Add))), Var ), Var )),
+   App (Shift (Var Suc),
+    App (Shift (Var Suc), App (Shift (Var Suc), Var Zero))))
+#     val v3 : int = 6
+#       *                                       type _ rep = I : int rep | Ar : 'a rep * 'b rep -> ('a -> 'b) rep
+val compare : 'a rep -> 'b rep -> (string, ('a, 'b) equal) sum = 
+#                     type term =
+    C of int
+  | Ab : string * 'a rep * term -> term
+  | Ap of term * term
+  | V of string
+type _ ctx =
+    Cnil : rnil ctx
+  | Ccons : 't * string * 'x rep * 'e ctx -> ('t, 'x, 'e) rcons ctx
+#                             type _ checked = Cerror of string | Cok : ('e, 't) lam * 't rep -> 'e checked
+val lookup : string -> 'e ctx -> 'e checked = 
+#                                                   val tc : 'n nat -> 'e ctx -> term -> 'e checked = 
+#             val ctx0 :
+  (zero, int, (suc, int -> int, (add, int -> int -> int, rnil) rcons) rcons)
+  rcons ctx =
+  Ccons (Zero, "0", I,
+   Ccons (Suc, "S", Ar (I, I), Ccons (Add, "+", Ar (I, Ar (I, I)), Cnil)))
+val ex1 : term = Ab ("x", I, Ap (Ap (V "+", V "x"), V "x"))
+# val c1 :
+  (zero, int, (suc, int -> int, (add, int -> int -> int, rnil) rcons) rcons)
+  rcons checked =
+  Cok
+   (Abs (,
+     App (App (Shift (Shift (Shift (Var Add))), Var ), Var )),
+   Ar (I, I))
+# val ex2 : term = Ap (Ab ("x", I, Ap (Ap (V "+", V "x"), V "x")), C 3)
+# val c2 :
+  (zero, int, (suc, int -> int, (add, int -> int -> int, rnil) rcons) rcons)
+  rcons checked =
+  Cok
+   (App
+     (Abs (,
+       App (App (Shift (Shift (Shift (Var Add))), Var ), Var )),
+     Const 3),
+   I)
+#           val eval_checked : 'a env -> 'a checked -> int = 
+#   val v2 : int = 6
+#                                             type pexp = PEXP
+type pval = PVAL
+type _ mode = Pexp : pexp mode | Pval : pval mode
+type ('a, 'b) tarr = TARR
+type tint = TINT
+type (_, _) rel =
+    IntR : (tint, int) rel
+  | IntTo : ('b, 's) rel -> ((tint, 'b) tarr, int -> 's) rel
+type (_, _, _) lam =
+    Const : ('a, 'b) rel * 'b -> (pval, 'env, 'a) lam
+  | Var : 'a -> (pval, ('a, 't, 'e) rcons, 't) lam
+  | Shift : ('m, 'e, 't) lam -> ('m, ('a, 'q, 'e) rcons, 't) lam
+  | Lam : 'a *
+      ('m, ('a, 's, 'e) rcons, 't) lam -> (pval, 'e, ('s, 't) tarr) lam
+  | App : ('m1, 'e, ('s, 't) tarr) lam *
+      ('m2, 'e, 's) lam -> (pexp, 'e, 't) lam
+#                   val ex1 : (pexp, 'a, tint) lam =
+  App (Lam (, Var ), Const (IntR, ))
+val mode : ('m, 'e, 't) lam -> 'm mode = 
+#               type (_, _) sub =
+    Id : ('r, 'r) sub
+  | Bind : 't * ('m, 'r2, 'x) lam *
+      ('r, 'r2) sub -> (('t, 'x, 'r) rcons, 'r2) sub
+  | Push : ('r1, 'r2) sub -> (('a, 'b, 'r1) rcons, ('a, 'b, 'r2) rcons) sub
+type (_, _) lam' = Ex : ('m, 's, 't) lam -> ('s, 't) lam'
+#                               val subst : ('m1, 'r, 't) lam -> ('r, 's) sub -> ('s, 't) lam' = 
+#       type closed = rnil
+type 'a rlam = ((pexp, closed, 'a) lam, (pval, closed, 'a) lam) sum
+#                             val rule :
+  (pval, closed, ('a, 'b) tarr) lam -> (pval, closed, 'a) lam -> 'b rlam =
+  
+#                                 val onestep : ('m, closed, 't) lam -> 't rlam = 
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/omega07.ml.reference ocaml-4.01.0/testsuite/tests/typing-gadts/omega07.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/omega07.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/omega07.ml.reference	2013-04-30 05:26:57.000000000 +0000
@@ -0,0 +1,312 @@
+
+# * * * * *                       type ('a, 'b) sum = Inl of 'a | Inr of 'b
+type zero = Zero
+type 'a succ = Succ of 'a
+type _ nat = NZ : zero nat | NS : 'a nat -> 'a succ nat
+#             type (_, _) seq =
+    Snil : ('a, zero) seq
+  | Scons : 'a * ('a, 'n) seq -> ('a, 'n succ) seq
+#   val l1 : (int, zero succ succ) seq = Scons (3, Scons (5, Snil))
+#       *         type (_, _, _) plus =
+    PlusZ : 'a nat -> (zero, 'a, 'a) plus
+  | PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus
+#         val length : ('a, 'n) seq -> 'n nat = 
+#   *                     type (_, _, _) app =
+    App : ('a, 'p) seq * ('n, 'm, 'p) plus -> ('a, 'n, 'm) app
+val app : ('a, 'n) seq -> ('a, 'm) seq -> ('a, 'n, 'm) app = 
+# *                           type tp = TP
+type nd = ND
+type ('a, 'b) fk = FK
+type _ shape =
+    Tp : tp shape
+  | Nd : nd shape
+  | Fk : 'a shape * 'b shape -> ('a, 'b) fk shape
+#           type tt = TT
+type ff = FF
+type _ boolean = BT : tt boolean | BF : ff boolean
+#                 type (_, _) path =
+    Pnone : 'a -> (tp, 'a) path
+  | Phere : (nd, 'a) path
+  | Pleft : ('x, 'a) path -> (('x, 'y) fk, 'a) path
+  | Pright : ('y, 'a) path -> (('x, 'y) fk, 'a) path
+#         type (_, _) tree =
+    Ttip : (tp, 'a) tree
+  | Tnode : 'a -> (nd, 'a) tree
+  | Tfork : ('x, 'a) tree * ('y, 'a) tree -> (('x, 'y) fk, 'a) tree
+#   val tree1 : (((tp, nd) fk, (nd, nd) fk) fk, int) tree =
+  Tfork (Tfork (Ttip, Tnode 4), Tfork (Tnode 4, Tnode 3))
+#                     val find : ('a -> 'a -> bool) -> 'a -> ('sh, 'a) tree -> ('sh, 'a) path list =
+  
+#             val extract : ('sh, 'a) path -> ('sh, 'a) tree -> 'a = 
+#             type (_, _) le =
+    LeZ : 'a nat -> (zero, 'a) le
+  | LeS : ('n, 'm) le -> ('n succ, 'm succ) le
+#       type _ even = EvenZ : zero even | EvenSS : 'n even -> 'n succ succ even
+#         type one = zero succ
+type two = one succ
+type three = two succ
+type four = three succ
+#       val even0 : zero even = EvenZ
+val even2 : two even = EvenSS EvenZ
+val even4 : four even = EvenSS (EvenSS EvenZ)
+#   val p1 : (two, one, three) plus = PlusS (PlusS (PlusZ (NS NZ)))
+#         val summandLessThanSum : ('a, 'b, 'c) plus -> ('a, 'c) le = 
+#                                 type (_, _) equal = Eq : ('a, 'a) equal
+val convert : ('a, 'b) equal -> 'a -> 'b = 
+val sameNat : 'a nat -> 'b nat -> ('a, 'b) equal option = 
+#                                         val plus_func : ('a, 'b, 'm) plus -> ('a, 'b, 'n) plus -> ('m, 'n) equal =
+  
+val plus_assoc :
+  ('a, 'b, 'ab) plus ->
+  ('ab, 'c, 'm) plus ->
+  ('b, 'c, 'bc) plus -> ('a, 'bc, 'n) plus -> ('m, 'n) equal = 
+#             val smaller : ('a succ, 'b succ) le -> ('a, 'b) le = 
+#   type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
+#   * * * * * * * * *                 val diff : ('a, 'b) le -> 'a nat -> 'b nat -> ('a, 'b) diff = 
+#               Characters 87-243:
+  ..match a, b,le with (* warning *)
+    | NZ, m, LeZ _ -> Diff (m, PlusZ m)
+    | NS x, NS y, LeS q ->
+        match diff q x y with Diff (m, p) -> Diff (m, PlusS p)
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+(NS _, NZ, _)
+val diff : ('a, 'b) le -> 'a nat -> 'b nat -> ('a, 'b) diff = 
+#               val diff : ('a, 'b) le -> 'b nat -> ('a, 'b) diff = 
+#             type (_, _) filter = Filter : ('m, 'n) le * ('a, 'm) seq -> ('a, 'n) filter
+val leS' : ('m, 'n) le -> ('m, 'n succ) le = 
+#                   val filter : ('a -> bool) -> ('a, 'n) seq -> ('a, 'n) filter = 
+#                             type (_, _, _) balance =
+    Less : ('h, 'h succ, 'h succ) balance
+  | Same : ('h, 'h, 'h) balance
+  | More : ('h succ, 'h, 'h succ) balance
+type _ avl =
+    Leaf : zero avl
+  | Node : ('hL, 'hR, 'hMax) balance * 'hL avl * int *
+      'hR avl -> 'hMax succ avl
+type avl' = Avl : 'h avl -> avl'
+#                 val empty : avl' = Avl Leaf
+val elem : int -> 'h avl -> bool = 
+#                           val rotr :
+  'n succ succ avl ->
+  int -> 'n avl -> ('n succ succ avl, 'n succ succ succ avl) sum = 
+#                         val rotl :
+  'n avl ->
+  int -> 'n succ succ avl -> ('n succ succ avl, 'n succ succ succ avl) sum =
+  
+#                                               val ins : int -> 'n avl -> ('n avl, 'n succ avl) sum = 
+#           val insert : int -> avl' -> avl' = 
+#                                                                                                                                 val del_min : 'n succ avl -> int * ('n avl, 'n succ avl) sum = 
+type _ avl_del =
+    Dsame : 'n avl -> 'n avl_del
+  | Ddecr : ('m succ, 'n) equal * 'm avl -> 'n avl_del
+val del : int -> 'n avl -> 'n avl_del = 
+#           val delete : int -> avl' -> avl' = 
+#                             type red = RED
+type black = BLACK
+type (_, _) sub_tree =
+    Bleaf : (black, zero) sub_tree
+  | Rnode : (black, 'n) sub_tree * int *
+      (black, 'n) sub_tree -> (red, 'n) sub_tree
+  | Bnode : ('cL, 'n) sub_tree * int *
+      ('cR, 'n) sub_tree -> (black, 'n succ) sub_tree
+type rb_tree = Root : (black, 'n) sub_tree -> rb_tree
+#               type dir = LeftD | RightD
+type (_, _) ctxt =
+    CNil : (black, 'n) ctxt
+  | CRed : int * dir * (black, 'n) sub_tree *
+      (red, 'n) ctxt -> (black, 'n) ctxt
+  | CBlk : int * dir * ('c1, 'n) sub_tree *
+      (black, 'n succ) ctxt -> ('c, 'n) ctxt
+#                         val blacken : (red, 'a) sub_tree -> (black, 'a succ) sub_tree = 
+type _ crep = Red : red crep | Black : black crep
+val color : ('c, 'n) sub_tree -> 'c crep = 
+#                   val fill : ('c, 'n) ctxt -> ('c, 'n) sub_tree -> rb_tree = 
+#             val recolor :
+  dir ->
+  int ->
+  ('a, 'b) sub_tree ->
+  dir ->
+  int ->
+  (black, 'b succ) sub_tree -> ('c, 'b) sub_tree -> (red, 'b succ) sub_tree =
+  
+#             val rotate :
+  dir ->
+  int ->
+  (black, 'a) sub_tree ->
+  dir ->
+  int ->
+  (black, 'a) sub_tree -> (red, 'a) sub_tree -> (black, 'a succ) sub_tree =
+  
+#                     val repair : (red, 'n) sub_tree -> ('c, 'n) ctxt -> rb_tree = 
+#                     val ins : int -> ('c, 'n) sub_tree -> ('c, 'n) ctxt -> rb_tree = 
+#   val insert : int -> rb_tree -> rb_tree = 
+#                                                                                                 type _ term =
+    Const : int -> int term
+  | Add : (int * int -> int) term
+  | LT : (int * int -> bool) term
+  | Ap : ('a -> 'b) term * 'a term -> 'b term
+  | Pair : 'a term * 'b term -> ('a * 'b) term
+val ex1 : int term = Ap (Add, Pair (Const 3, Const 5))
+val ex2 : (int * int) term =
+  Pair (Ap (Add, Pair (Const 3, Const 5)), Const 1)
+val eval_term : 'a term -> 'a = 
+type _ rep =
+    Rint : int rep
+  | Rbool : bool rep
+  | Rpair : 'a rep * 'b rep -> ('a * 'b) rep
+  | Rfun : 'a rep * 'b rep -> ('a -> 'b) rep
+type (_, _) equal = Eq : ('a, 'a) equal
+val rep_equal : 'a rep -> 'b rep -> ('a, 'b) equal option = 
+#                                                               type assoc = Assoc : string * 'a rep * 'a -> assoc
+val assoc : string -> 'a rep -> assoc list -> 'a = 
+type _ term =
+    Var : string * 'a rep -> 'a term
+  | Abs : string * 'a rep * 'b term -> ('a -> 'b) term
+  | Const : int -> int term
+  | Add : (int * int -> int) term
+  | LT : (int * int -> bool) term
+  | Ap : ('a -> 'b) term * 'a term -> 'b term
+  | Pair : 'a term * 'b term -> ('a * 'b) term
+val eval_term : assoc list -> 'a term -> 'a = 
+#           val ex3 : (int -> int) term =
+  Abs ("x", Rint, Ap (Add, Pair (Var ("x", Rint), Var ("x", Rint))))
+val ex4 : int term =
+  Ap (Abs ("x", Rint, Ap (Add, Pair (Var ("x", Rint), Var ("x", Rint)))),
+   Const 3)
+val v4 : int = 6
+#                                             type rnil = RNIL
+type ('a, 'b, 'c) rcons = RCons of 'a * 'b * 'c
+type _ is_row =
+    Rnil : rnil is_row
+  | Rcons : 'c is_row -> ('a, 'b, 'c) rcons is_row
+type (_, _) lam =
+    Const : int -> ('e, int) lam
+  | Var : 'a -> (('a, 't, 'e) rcons, 't) lam
+  | Shift : ('e, 't) lam -> (('a, 'q, 'e) rcons, 't) lam
+  | Abs : 'a * (('a, 's, 'e) rcons, 't) lam -> ('e, 's -> 't) lam
+  | App : ('e, 's -> 't) lam * ('e, 's) lam -> ('e, 't) lam
+type x = X
+type y = Y
+val ex1 : ((x, 'a -> 'b, (y, 'a, 'c) rcons) rcons, 'b) lam =
+  App (Var X, Shift (Var Y))
+val ex2 : ('a, ('b -> 'c) -> 'b -> 'c) lam =
+  Abs (, Abs (, App (Shift (Var ), Var )))
+#                           type _ env =
+    Enil : rnil env
+  | Econs : 'a * 't * 'e env -> ('a, 't, 'e) rcons env
+val eval_lam : 'e env -> ('e, 't) lam -> 't = 
+#                               type add = Add
+type suc = Suc
+val env0 :
+  (zero, int, (suc, int -> int, (add, int -> int -> int, rnil) rcons) rcons)
+  rcons env = Econs (Zero, 0, Econs (Suc, , Econs (Add, , Enil)))
+val _0 : ((zero, int, 'a) rcons, int) lam = Var Zero
+val suc :
+  (('a, 'b, (suc, int -> int, 'c) rcons) rcons, int) lam ->
+  (('a, 'b, (suc, int -> int, 'c) rcons) rcons, int) lam = 
+val _1 :
+  ((zero, int, (suc, int -> int, (add, int -> int -> int, '_a) rcons) rcons)
+   rcons, int)
+  lam = App (Shift (Var Suc), Var Zero)
+val _2 :
+  ((zero, int, (suc, int -> int, (add, int -> int -> int, '_a) rcons) rcons)
+   rcons, int)
+  lam = App (Shift (Var Suc), App (Shift (Var Suc), Var Zero))
+val _3 :
+  ((zero, int, (suc, int -> int, (add, int -> int -> int, '_a) rcons) rcons)
+   rcons, int)
+  lam =
+  App (Shift (Var Suc),
+   App (Shift (Var Suc), App (Shift (Var Suc), Var Zero)))
+val add :
+  (('a, 'b, ('c, 'd, (add, int -> int -> int, 'e) rcons) rcons) rcons,
+   int -> int -> int)
+  lam = Shift (Shift (Var Add))
+val double :
+  (('a, 'b, ('c, 'd, (add, int -> int -> int, 'e) rcons) rcons) rcons,
+   int -> int)
+  lam =
+  Abs (,
+   App (App (Shift (Shift (Shift (Var Add))), Var ), Var ))
+val ex3 :
+  ((zero, int, (suc, int -> int, (add, int -> int -> int, '_a) rcons) rcons)
+   rcons, int)
+  lam =
+  App
+   (Abs (,
+     App (App (Shift (Shift (Shift (Var Add))), Var ), Var )),
+   App (Shift (Var Suc),
+    App (Shift (Var Suc), App (Shift (Var Suc), Var Zero))))
+#     val v3 : int = 6
+#       *                                       type _ rep = I : int rep | Ar : 'a rep * 'b rep -> ('a -> 'b) rep
+val compare : 'a rep -> 'b rep -> (string, ('a, 'b) equal) sum = 
+#                     type term =
+    C of int
+  | Ab : string * 'a rep * term -> term
+  | Ap of term * term
+  | V of string
+type _ ctx =
+    Cnil : rnil ctx
+  | Ccons : 't * string * 'x rep * 'e ctx -> ('t, 'x, 'e) rcons ctx
+#                             type _ checked = Cerror of string | Cok : ('e, 't) lam * 't rep -> 'e checked
+val lookup : string -> 'e ctx -> 'e checked = 
+#                                                   val tc : 'n nat -> 'e ctx -> term -> 'e checked = 
+#             val ctx0 :
+  (zero, int, (suc, int -> int, (add, int -> int -> int, rnil) rcons) rcons)
+  rcons ctx =
+  Ccons (Zero, "0", I,
+   Ccons (Suc, "S", Ar (I, I), Ccons (Add, "+", Ar (I, Ar (I, I)), Cnil)))
+val ex1 : term = Ab ("x", I, Ap (Ap (V "+", V "x"), V "x"))
+# val c1 :
+  (zero, int, (suc, int -> int, (add, int -> int -> int, rnil) rcons) rcons)
+  rcons checked =
+  Cok
+   (Abs (,
+     App (App (Shift (Shift (Shift (Var Add))), Var ), Var )),
+   Ar (I, I))
+# val ex2 : term = Ap (Ab ("x", I, Ap (Ap (V "+", V "x"), V "x")), C 3)
+# val c2 :
+  (zero, int, (suc, int -> int, (add, int -> int -> int, rnil) rcons) rcons)
+  rcons checked =
+  Cok
+   (App
+     (Abs (,
+       App (App (Shift (Shift (Shift (Var Add))), Var ), Var )),
+     Const 3),
+   I)
+#           val eval_checked : 'a env -> 'a checked -> int = 
+#   val v2 : int = 6
+#                                             type pexp = PEXP
+type pval = PVAL
+type _ mode = Pexp : pexp mode | Pval : pval mode
+type ('a, 'b) tarr = TARR
+type tint = TINT
+type (_, _) rel =
+    IntR : (tint, int) rel
+  | IntTo : ('b, 's) rel -> ((tint, 'b) tarr, int -> 's) rel
+type (_, _, _) lam =
+    Const : ('a, 'b) rel * 'b -> (pval, 'env, 'a) lam
+  | Var : 'a -> (pval, ('a, 't, 'e) rcons, 't) lam
+  | Shift : ('m, 'e, 't) lam -> ('m, ('a, 'q, 'e) rcons, 't) lam
+  | Lam : 'a *
+      ('m, ('a, 's, 'e) rcons, 't) lam -> (pval, 'e, ('s, 't) tarr) lam
+  | App : ('m1, 'e, ('s, 't) tarr) lam *
+      ('m2, 'e, 's) lam -> (pexp, 'e, 't) lam
+#                   val ex1 : (pexp, 'a, tint) lam =
+  App (Lam (, Var ), Const (IntR, ))
+val mode : ('m, 'e, 't) lam -> 'm mode = 
+#               type (_, _) sub =
+    Id : ('r, 'r) sub
+  | Bind : 't * ('m, 'r2, 'x) lam *
+      ('r, 'r2) sub -> (('t, 'x, 'r) rcons, 'r2) sub
+  | Push : ('r1, 'r2) sub -> (('a, 'b, 'r1) rcons, ('a, 'b, 'r2) rcons) sub
+type (_, _) lam' = Ex : ('m, 's, 't) lam -> ('s, 't) lam'
+#                               val subst : ('m1, 'r, 't) lam -> ('r, 's) sub -> ('s, 't) lam' = 
+#       type closed = rnil
+type 'a rlam = ((pexp, closed, 'a) lam, (pval, closed, 'a) lam) sum
+#                             val rule :
+  (pval, closed, ('a, 'b) tarr) lam -> (pval, closed, 'a) lam -> 'b rlam =
+  
+#                                 val onestep : ('m, closed, 't) lam -> 't rlam = 
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5332.ml ocaml-4.01.0/testsuite/tests/typing-gadts/pr5332.ml
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5332.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5332.ml	2011-08-09 13:59:41.000000000 +0000
@@ -0,0 +1,17 @@
+type ('env, 'a) var =
+ | Zero : ('a * 'env, 'a) var
+ | Succ : ('env, 'a) var -> ('b * 'env, 'a) var
+;;
+type ('env, 'a) typ =
+ | Tint : ('env, int) typ
+ | Tbool : ('env, bool) typ
+ | Tvar : ('env, 'a) var -> ('env, 'a) typ
+;;
+let f : type env a. (env, a) typ -> (env, a) typ -> int = fun ta tb ->
+ match ta, tb with
+   | Tint, Tint -> 0
+   | Tbool, Tbool -> 1
+   | Tvar var, tb -> 2
+;;
+let x = f Tint (Tvar Zero)
+;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5332.ml.reference ocaml-4.01.0/testsuite/tests/typing-gadts/pr5332.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5332.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5332.ml.reference	2012-07-30 18:04:46.000000000 +0000
@@ -0,0 +1,19 @@
+
+#       type ('env, 'a) var =
+    Zero : ('a * 'env, 'a) var
+  | Succ : ('env, 'a) var -> ('b * 'env, 'a) var
+#         type ('env, 'a) typ =
+    Tint : ('env, int) typ
+  | Tbool : ('env, bool) typ
+  | Tvar : ('env, 'a) var -> ('env, 'a) typ
+#           Characters 72-156:
+  .match ta, tb with
+     | Tint, Tint -> 0
+     | Tbool, Tbool -> 1
+     | Tvar var, tb -> 2
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+(Tbool, Tvar _)
+val f : ('env, 'a) typ -> ('env, 'a) typ -> int = 
+#   Exception: Match_failure ("//toplevel//", 9, 1).
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5689.ml ocaml-4.01.0/testsuite/tests/typing-gadts/pr5689.ml
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5689.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5689.ml	2012-07-18 03:21:12.000000000 +0000
@@ -0,0 +1,74 @@
+type inkind = [ `Link | `Nonlink ]
+
+type _ inline_t =
+   | Text: string -> [< inkind > `Nonlink ] inline_t
+   | Bold: 'a inline_t list -> 'a inline_t
+   | Link: string -> [< inkind > `Link ] inline_t
+   | Mref: string * [ `Nonlink ] inline_t list -> [< inkind > `Link ] inline_t
+;;
+
+let uppercase seq =
+   let rec process: type a. a inline_t -> a inline_t = function
+       | Text txt       -> Text (String.uppercase txt)
+       | Bold xs        -> Bold (List.map process xs)
+       | Link lnk       -> Link lnk
+       | Mref (lnk, xs) -> Mref (lnk, List.map process xs)
+   in List.map process seq
+;;
+
+type ast_t =
+   | Ast_Text of string
+   | Ast_Bold of ast_t list
+   | Ast_Link of string
+   | Ast_Mref of string * ast_t list
+;;
+
+let inlineseq_from_astseq seq =
+   let rec process_nonlink = function
+       | Ast_Text txt  -> Text txt
+       | Ast_Bold xs   -> Bold (List.map process_nonlink xs)
+       | _             -> assert false in
+   let rec process_any = function
+       | Ast_Text txt       -> Text txt
+       | Ast_Bold xs        -> Bold (List.map process_any xs)
+       | Ast_Link lnk       -> Link lnk
+       | Ast_Mref (lnk, xs) -> Mref (lnk, List.map process_nonlink xs)
+   in List.map process_any seq
+;;
+
+(* OK *)
+type _ linkp =
+ | Nonlink : [ `Nonlink ] linkp
+ | Maylink : inkind linkp
+;;
+let inlineseq_from_astseq seq =
+ let rec process : type a. a linkp -> ast_t -> a inline_t =
+   fun allow_link ast ->
+     match (allow_link, ast) with
+     | (Maylink, Ast_Text txt)    -> Text txt
+     | (Nonlink, Ast_Text txt)    -> Text txt
+     | (x, Ast_Bold xs)           -> Bold (List.map (process x) xs)
+     | (Maylink, Ast_Link lnk)    -> Link lnk
+     | (Nonlink, Ast_Link _)      -> assert false
+     | (Maylink, Ast_Mref (lnk, xs)) ->
+         Mref (lnk, List.map (process Nonlink) xs)
+     | (Nonlink, Ast_Mref _)      -> assert false
+   in List.map (process Maylink) seq
+;;
+
+(* Bad *)
+type _ linkp2 = Kind : 'a linkp -> ([< inkind ] as 'a) linkp2
+;;
+let inlineseq_from_astseq seq =
+let rec process : type a. a linkp2 -> ast_t -> a inline_t =
+  fun allow_link ast ->
+    match (allow_link, ast) with
+    | (Kind _, Ast_Text txt)    -> Text txt
+    | (x, Ast_Bold xs)           -> Bold (List.map (process x) xs)
+    | (Kind Maylink, Ast_Link lnk)    -> Link lnk
+    | (Kind Nonlink, Ast_Link _)      -> assert false
+    | (Kind Maylink, Ast_Mref (lnk, xs)) ->
+        Mref (lnk, List.map (process (Kind Nonlink)) xs)
+    | (Kind Nonlink, Ast_Mref _)      -> assert false
+  in List.map (process (Kind Maylink)) seq
+;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5689.ml.principal.reference ocaml-4.01.0/testsuite/tests/typing-gadts/pr5689.ml.principal.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5689.ml.principal.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5689.ml.principal.reference	2013-04-18 23:41:29.000000000 +0000
@@ -0,0 +1,27 @@
+
+#               type inkind = [ `Link | `Nonlink ]
+type _ inline_t =
+    Text : string -> [< inkind > `Nonlink ] inline_t
+  | Bold : 'a inline_t list -> 'a inline_t
+  | Link : string -> [< inkind > `Link ] inline_t
+  | Mref : string *
+      [ `Nonlink ] inline_t list -> [< inkind > `Link ] inline_t
+#                 val uppercase : 'a inline_t list -> 'a inline_t list = 
+#             type ast_t =
+    Ast_Text of string
+  | Ast_Bold of ast_t list
+  | Ast_Link of string
+  | Ast_Mref of string * ast_t list
+#                         val inlineseq_from_astseq : ast_t list -> inkind inline_t list = 
+#           type _ linkp = Nonlink : [ `Nonlink ] linkp | Maylink : inkind linkp
+#                           val inlineseq_from_astseq : ast_t list -> inkind inline_t list = 
+#       type _ linkp2 = Kind : 'a linkp -> ([< inkind ] as 'a) linkp2
+#                         Characters 184-192:
+      | (Kind _, Ast_Text txt)    -> Text txt
+                                     ^^^^^^^^
+Error: This expression has type ([< inkind > `Nonlink ] as 'a) inline_t
+       but an expression was expected of type a inline_t
+       Type 'a = [< `Link | `Nonlink > `Nonlink ] is not compatible with type
+         a = [< `Link | `Nonlink ] 
+       Types for tag `Nonlink are incompatible
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5689.ml.reference ocaml-4.01.0/testsuite/tests/typing-gadts/pr5689.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5689.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5689.ml.reference	2013-04-18 23:41:29.000000000 +0000
@@ -0,0 +1,27 @@
+
+#               type inkind = [ `Link | `Nonlink ]
+type _ inline_t =
+    Text : string -> [< inkind > `Nonlink ] inline_t
+  | Bold : 'a inline_t list -> 'a inline_t
+  | Link : string -> [< inkind > `Link ] inline_t
+  | Mref : string *
+      [ `Nonlink ] inline_t list -> [< inkind > `Link ] inline_t
+#                 val uppercase : 'a inline_t list -> 'a inline_t list = 
+#             type ast_t =
+    Ast_Text of string
+  | Ast_Bold of ast_t list
+  | Ast_Link of string
+  | Ast_Mref of string * ast_t list
+#                         val inlineseq_from_astseq : ast_t list -> inkind inline_t list = 
+#           type _ linkp = Nonlink : [ `Nonlink ] linkp | Maylink : inkind linkp
+#                           val inlineseq_from_astseq : ast_t list -> inkind inline_t list = 
+#       type _ linkp2 = Kind : 'a linkp -> ([< inkind ] as 'a) linkp2
+#                         Characters 184-192:
+      | (Kind _, Ast_Text txt)    -> Text txt
+                                     ^^^^^^^^
+Error: This expression has type ([< inkind > `Nonlink ] as 'a) inline_t
+       but an expression was expected of type a inline_t
+       Type 'a = [< `Link | `Nonlink > `Nonlink ] is not compatible with type
+         a = [< `Link | `Nonlink ] 
+       Types for tag `Nonlink are incompatible
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5785.ml ocaml-4.01.0/testsuite/tests/typing-gadts/pr5785.ml
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5785.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5785.ml	2012-10-12 01:34:51.000000000 +0000
@@ -0,0 +1,10 @@
+module Add (T : sig type two end) =
+struct
+  type _ t =
+  | One : [`One] t
+  | Two : T.two t
+
+  let add (type a) : a t * a t -> string = function
+    | One, One -> "two"
+    | Two, Two -> "four"
+end;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5785.ml.reference ocaml-4.01.0/testsuite/tests/typing-gadts/pr5785.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5785.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5785.ml.reference	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,15 @@
+
+#                   Characters 137-194:
+  ...........................................function
+      | One, One -> "two"
+      | Two, Two -> "four"
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+(Two, One)
+module Add :
+  functor (T : sig type two end) ->
+    sig
+      type _ t = One : [ `One ] t | Two : T.two t
+      val add : 'a t * 'a t -> string
+    end
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5848.ml ocaml-4.01.0/testsuite/tests/typing-gadts/pr5848.ml
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5848.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5848.ml	2012-12-07 02:28:58.000000000 +0000
@@ -0,0 +1,14 @@
+module B : sig
+ type (_, _) t = Eq: ('a, 'a) t
+ val f: 'a -> 'b -> ('a, 'b) t
+end
+=
+struct
+ type (_, _) t = Eq: ('a, 'a) t
+ let f t1 t2 = Obj.magic Eq
+end;;
+
+let of_type: type a. a -> a = fun x ->
+  match B.f x 4 with
+  | Eq -> 5
+;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5848.ml.reference ocaml-4.01.0/testsuite/tests/typing-gadts/pr5848.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5848.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5848.ml.reference	2012-12-08 02:40:56.000000000 +0000
@@ -0,0 +1,8 @@
+
+#                 module B :
+  sig type (_, _) t = Eq : ('a, 'a) t val f : 'a -> 'b -> ('a, 'b) t end
+#         Characters 65-67:
+    | Eq -> 5
+      ^^
+Error: The GADT constructor Eq of type B.t must be qualified in this pattern.
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5906.ml ocaml-4.01.0/testsuite/tests/typing-gadts/pr5906.ml
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5906.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5906.ml	2013-01-25 04:26:02.000000000 +0000
@@ -0,0 +1,17 @@
+type _ constant =
+  | Int: int -> int constant
+  | Bool: bool -> bool constant
+
+type (_, _, _) binop =
+  | Eq: ('a, 'a, bool) binop
+  | Leq: ('a, 'a, bool) binop
+  | Add: (int, int, int) binop
+
+let eval (type a) (type b) (type c) (bop:(a,b,c) binop) (x:a constant) (y:b constant) : c constant =
+  match bop, x, y with
+  | Eq, Bool x, Bool y -> Bool (if x then y else not y)
+  | Leq, Int x, Int y -> Bool (x <= y)
+  | Leq, Bool x, Bool y -> Bool (x <= y)
+  | Add, Int x, Int y -> Int (x + y)
+
+let _ = eval Eq (Int 2) (Int 3)
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5906.ml.reference ocaml-4.01.0/testsuite/tests/typing-gadts/pr5906.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5906.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5906.ml.reference	2013-01-25 04:26:02.000000000 +0000
@@ -0,0 +1,5 @@
+
+#                                   
+Characters 524-524:
+  Error: Syntax error
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5948.ml ocaml-4.01.0/testsuite/tests/typing-gadts/pr5948.ml
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5948.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5948.ml	2013-03-13 04:59:10.000000000 +0000
@@ -0,0 +1,30 @@
+type tag = [`TagA | `TagB | `TagC];;
+
+type 'a poly = 
+    AandBTags : [< `TagA of int | `TagB ] poly
+  | ATag : [< `TagA of int] poly
+(* constraint 'a = [< `TagA of int | `TagB] *)
+;;
+
+let intA = function `TagA i -> i
+let intB = function `TagB -> 4
+;;
+
+let intAorB = function 
+    `TagA i -> i
+  | `TagB -> 4
+;;
+
+type _ wrapPoly = 
+    WrapPoly : 'a poly -> ([< `TagA of int | `TagB] as 'a) wrapPoly
+;;
+
+let example6 : type a. a wrapPoly -> (a -> int) =
+  fun w -> 
+    match w with
+    | WrapPoly ATag -> intA
+    | WrapPoly _ -> intA (* This should not be allowed *)
+;;
+
+let _ =  example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *)
+;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5948.ml.reference ocaml-4.01.0/testsuite/tests/typing-gadts/pr5948.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5948.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5948.ml.reference	2013-03-13 04:59:10.000000000 +0000
@@ -0,0 +1,22 @@
+
+# type tag = [ `TagA | `TagB | `TagC ]
+#           type 'a poly =
+    AandBTags : [< `TagA of int | `TagB ] poly
+  | ATag : [< `TagA of int ] poly
+#       val intA : [< `TagA of 'a ] -> 'a = 
+val intB : [< `TagB ] -> int = 
+#         val intAorB : [< `TagA of int | `TagB ] -> int = 
+#       type _ wrapPoly =
+    WrapPoly : 'a poly -> ([< `TagA of int | `TagB ] as 'a) wrapPoly
+#             Characters 103-107:
+      | WrapPoly ATag -> intA
+                         ^^^^
+Error: This expression has type ([< `TagA of 'b ] as 'a) -> 'b
+       but an expression was expected of type a -> int
+       Type 'a is not compatible with type a = [< `TagA of int | `TagB ] 
+       The first variant type does not allow tag(s) `TagB
+#     Characters 10-18:
+  let _ =  example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *)
+           ^^^^^^^^
+Error: Unbound value example6
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5981.ml ocaml-4.01.0/testsuite/tests/typing-gadts/pr5981.ml
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5981.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5981.ml	2013-04-12 10:20:14.000000000 +0000
@@ -0,0 +1,22 @@
+module F(S : sig type 'a t end) = struct
+  type _ ab =
+      A : int S.t ab
+    | B : float S.t ab
+
+  let f : int S.t ab -> float S.t ab -> string =
+    fun (l : int S.t ab) (r : float S.t ab) -> match l, r with
+    | A, B -> "f A B"
+end;;
+
+module F(S : sig type 'a t end) = struct
+  type a = int * int
+  type b = int -> int
+
+  type _ ab =
+      A : a S.t ab
+    | B : b S.t ab
+
+  let f : a S.t ab -> b S.t ab -> string =
+    fun l r -> match l, r with
+    | A, B -> "f A B"
+end;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5981.ml.reference ocaml-4.01.0/testsuite/tests/typing-gadts/pr5981.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5981.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5981.ml.reference	2013-04-12 10:20:14.000000000 +0000
@@ -0,0 +1,28 @@
+
+#                 Characters 196-233:
+  ...............................................match l, r with
+      | A, B -> "f A B"
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+(A, A)
+module F :
+  functor (S : sig type 'a t end) ->
+    sig
+      type _ ab = A : int S.t ab | B : float S.t ab
+      val f : int S.t ab -> float S.t ab -> string
+    end
+#                         Characters 197-234:
+  ...............match l, r with
+      | A, B -> "f A B"
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+(A, A)
+module F :
+  functor (S : sig type 'a t end) ->
+    sig
+      type a = int * int
+      type b = int -> int
+      type _ ab = A : a S.t ab | B : b S.t ab
+      val f : a S.t ab -> b S.t ab -> string
+    end
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5985.ml ocaml-4.01.0/testsuite/tests/typing-gadts/pr5985.ml
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5985.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5985.ml	2013-06-18 13:05:56.000000000 +0000
@@ -0,0 +1,94 @@
+(* Report from Jeremy Yallop *)
+module F (S : sig type 'a s end) = struct
+  include S
+  type _ t = T : 'a -> 'a s t
+end;; (* fail *)
+(*
+module M = F (struct type 'a s = int end) ;;
+let M.T x = M.T 3 in x = true;;
+*)
+
+(* Fix it using #-annotations *)
+module F (S : sig type #'a s end) = struct
+  include S
+  type _ t = T : 'a -> 'a s t
+end;; (* syntax error *)
+(*
+module M = F (struct type 'a s = int end) ;; (* fail *)
+module M = F (struct type 'a s = new int end) ;; (* ok *)
+let M.T x = M.T 3 in x = true;; (* fail *)
+let M.T x = M.T 3 in x = 3;; (* ok *)
+*)
+
+(* Another version using OCaml 2.00 objects *)
+module F(T:sig type 'a t end) = struct
+  class ['a] c x =
+    object constraint 'a = 'b T.t val x' : 'b = x method x = x' end
+end;; (* fail *)
+
+(* It is not OK to allow modules exported by other compilation units *)
+type (_,_) eq = Eq : ('a,'a) eq;;
+let eq = Obj.magic Eq;;
+(* pretend that Queue.t is not injective *)
+let eq : ('a Queue.t, 'b Queue.t) eq = eq;;
+type _ t = T : 'a -> 'a Queue.t t;; (* fail *)
+(*
+let castT (type a) (type b) (x : a t) (e: (a, b) eq) : b t =
+  let Eq = e in (x : b t);;
+let T (x : bool) = castT (T 3) eq;; (* we found a contradiction *)
+*)
+
+(* The following signature should not be accepted *)
+module type S = sig
+  type 'a s
+  type _ t = T : 'a -> 'a s t
+end;; (* fail *)
+(* Otherwise we can write the following *)
+module rec M : (S with type 'a s = unit) = M;;
+(* For the above reason, we cannot allow the abstract declaration
+   of s and the definition of t to be in the same module, as
+   we could create the signature using [module type of ...] *)
+
+
+(* Another problem with variance *)
+module M = struct type 'a t = 'a -> unit end;;
+module F(X:sig type #'a t end) =
+  struct type +'a s = S of 'b constraint 'a = 'b X.t end;; (* fail *)
+(*
+module N = F(M);;
+let o = N.S (object end);;
+let N.S o' = (o :>  M.t N.s);; (* unsound! *)
+*)
+
+(* And yet another *)
+type 'a q = Q;;
+type +'a t = 'b constraint 'a = 'b q;;
+(* shoud fail: we do not know for sure the variance of Queue.t *)
+
+type +'a t = T of 'a;;
+type +'a s = 'b constraint 'a = 'b t;; (* ok *)
+type -'a s = 'b constraint 'a = 'b t;; (* fail *)
+type +'a u = 'a t;;
+type 'a t = T of ('a -> 'a);;
+type -'a s = 'b constraint 'a = 'b t;; (* ok *)
+type +'a s = 'b constraint 'a = 'b q t;; (* ok *)
+type +'a s = 'b constraint 'a = 'b t q;; (* fail *)
+
+
+(* the problem from lablgtk2 *)
+
+module Gobject = struct
+  type -'a obj
+end
+open Gobject;;
+
+class virtual ['a] item_container =
+ object
+   constraint 'a = < as_item : [>`widget] obj; .. >
+   method virtual add : 'a -> unit
+ end;;
+
+
+(* Another variance anomaly, should not expand t in g before checking *)
+type +'a t = unit constraint 'a = 'b list;;
+type _ g = G : 'a -> 'a t g;; (* fail *)
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5985.ml.reference ocaml-4.01.0/testsuite/tests/typing-gadts/pr5985.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5985.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5985.ml.reference	2013-06-18 13:05:56.000000000 +0000
@@ -0,0 +1,75 @@
+
+#         Characters 92-115:
+    type _ t = T : 'a -> 'a s t
+        ^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable cannot be deduced
+       from the type parameters.
+# * * *             Characters 131-134:
+  module F (S : sig type #'a s end) = struct
+                ^^^
+Syntax error: 'end' expected, the highlighted 'sig' might be unmatched
+# * * * * *             Characters 296-374:
+  ........['a] c x =
+      object constraint 'a = 'b T.t val x' : 'b = x method x = x' end
+Error: In this definition, a type variable cannot be deduced
+       from the type parameters.
+#     type (_, _) eq = Eq : ('a, 'a) eq
+# val eq : 'a = 
+#   val eq : ('a Queue.t, 'b Queue.t) eq = Eq
+# Characters 4-33:
+  type _ t = T : 'a -> 'a Queue.t t;; (* fail *)
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable cannot be deduced
+       from the type parameters.
+# * * * *             Characters 254-277:
+    type _ t = T : 'a -> 'a s t
+        ^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable cannot be deduced
+       from the type parameters.
+#   Characters 59-60:
+  module rec M : (S with type 'a s = unit) = M;;
+                  ^
+Error: Unbound module type S
+# * *         module M : sig type 'a t = 'a -> unit end
+#   Characters 11-14:
+  module F(X:sig type #'a t end) =
+             ^^^
+Syntax error: 'end' expected, the highlighted 'sig' might be unmatched
+# * * * *       type 'a q = Q
+# Characters 5-36:
+  type +'a t = 'b constraint 'a = 'b q;;
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable has a variance that
+       cannot be deduced from the type parameters.
+       It was expected to be unrestricted, but it is covariant.
+#     type 'a t = T of 'a
+# type +'a s = 'b constraint 'a = 'b t
+# Characters 5-36:
+  type -'a s = 'b constraint 'a = 'b t;; (* fail *)
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable has a variance that
+       is not reflected by its occurrence in type parameters.
+       It was expected to be contravariant, but it is covariant.
+# type 'a u = 'a t
+# type 'a t = T of ('a -> 'a)
+# type -'a s = 'b constraint 'a = 'b t
+# type +'a s = 'b constraint 'a = 'b q t
+# Characters 5-38:
+  type +'a s = 'b constraint 'a = 'b t q;; (* fail *)
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable has a variance that
+       cannot be deduced from the type parameters.
+       It was expected to be unrestricted, but it is covariant.
+#               module Gobject : sig type -'a obj end
+#           class virtual ['a] item_container :
+  object
+    constraint 'a = < as_item : [> `widget ] Gobject.obj; .. >
+    method virtual add : 'a -> unit
+  end
+#       type +'a t = unit constraint 'a = 'b list
+# Characters 4-27:
+  type _ g = G : 'a -> 'a t g;; (* fail *)
+      ^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable cannot be deduced
+       from the type parameters.
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5989.ml ocaml-4.01.0/testsuite/tests/typing-gadts/pr5989.ml
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5989.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5989.ml	2013-04-18 23:41:29.000000000 +0000
@@ -0,0 +1,35 @@
+type (_, _) t =
+    Any : ('a, 'b) t
+  | Eq : ('a, 'a) t
+;;
+
+module M :
+sig
+  type s = private [> `A]
+  val eq : (s, [`A | `B]) t
+end =
+struct
+  type s = [`A | `B]
+  let eq = Eq
+end;;
+
+let f : (M.s, [`A | `B]) t -> string = function
+  | Any -> "Any"
+;;
+
+let () = print_endline (f M.eq) ;;
+
+module N :
+sig
+  type s = private < a : int; .. >
+  val eq : (s, ) t
+end =
+struct
+  type s = 
+  let eq = Eq
+end
+;;
+
+let f : (N.s, ) t -> string = function
+  | Any -> "Any"
+;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5989.ml.reference ocaml-4.01.0/testsuite/tests/typing-gadts/pr5989.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5989.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5989.ml.reference	2013-04-18 23:41:29.000000000 +0000
@@ -0,0 +1,24 @@
+
+#       type (_, _) t = Any : ('a, 'b) t | Eq : ('a, 'a) t
+#                   module M : sig type s = private [> `A ] val eq : (s, [ `A | `B ]) t end
+#       Characters 40-65:
+  .......................................function
+    | Any -> "Any"
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+Eq
+val f : (M.s, [ `A | `B ]) t -> string = 
+#   Exception: Match_failure ("//toplevel//", 14, 39).
+#                     module N :
+  sig
+    type s = private < a : int; .. >
+    val eq : (s, < a : int; b : bool >) t
+  end
+#       Characters 50-75:
+  .................................................function
+    | Any -> "Any"
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+Eq
+val f : (N.s, < a : int; b : bool >) t -> string = 
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5997.ml ocaml-4.01.0/testsuite/tests/typing-gadts/pr5997.ml
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5997.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5997.ml	2013-04-22 23:53:24.000000000 +0000
@@ -0,0 +1,28 @@
+type (_, _) comp =
+  | Eq : ('a, 'a) comp
+  | Diff : ('a, 'b) comp
+;;
+
+module U = struct type t = T end;;
+
+module M : sig
+  type t = T
+  val comp : (U.t, t) comp
+end = struct
+  include U
+  let comp = Eq
+end;;
+
+match M.comp with | Diff -> false;;
+
+module U = struct type t = {x : int} end;;
+
+module M : sig
+  type t = {x : int}
+  val comp : (U.t, t) comp
+end = struct
+  include U
+  let comp = Eq
+end;;
+
+match M.comp with | Diff -> false;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr5997.ml.reference ocaml-4.01.0/testsuite/tests/typing-gadts/pr5997.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr5997.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr5997.ml.reference	2013-04-22 23:53:24.000000000 +0000
@@ -0,0 +1,21 @@
+
+#       type (_, _) comp = Eq : ('a, 'a) comp | Diff : ('a, 'b) comp
+#   module U : sig type t = T end
+#               module M : sig type t = T val comp : (U.t, t) comp end
+#   Characters 1-34:
+  match M.comp with | Diff -> false;;
+  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+Eq
+Exception: Match_failure ("//toplevel//", 13, 0).
+#   module U : sig type t = { x : int; } end
+#               module M : sig type t = { x : int; } val comp : (U.t, t) comp end
+#   Characters 1-34:
+  match M.comp with | Diff -> false;;
+  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+Eq
+Exception: Match_failure ("//toplevel//", 22, 0).
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr6158.ml ocaml-4.01.0/testsuite/tests/typing-gadts/pr6158.ml
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr6158.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr6158.ml	2013-09-05 08:58:16.000000000 +0000
@@ -0,0 +1,9 @@
+type 'a t = T of 'a
+type 'a s = S of 'a
+
+type (_, _) eq = Refl : ('a, 'a) eq;;
+
+let f : (int s, int t) eq -> unit = function Refl -> ();;
+
+module M (S : sig type 'a t = T of 'a type 'a s = T of 'a end) =
+struct let f : ('a S.s, 'a S.t) eq -> unit = function Refl -> () end;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr6158.ml.principal.reference ocaml-4.01.0/testsuite/tests/typing-gadts/pr6158.ml.principal.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr6158.ml.principal.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr6158.ml.principal.reference	2013-09-05 08:58:16.000000000 +0000
@@ -0,0 +1,19 @@
+
+#       type 'a t = T of 'a
+type 'a s = S of 'a
+type (_, _) eq = Refl : ('a, 'a) eq
+#   Characters 46-50:
+  let f : (int s, int t) eq -> unit = function Refl -> ();;
+                                               ^^^^
+Error: This pattern matches values of type (int s, int s) eq
+       but a pattern was expected which matches values of type
+         (int s, int t) eq
+       Type int s is not compatible with type int t 
+#     Characters 120-124:
+  struct let f : ('a S.s, 'a S.t) eq -> unit = function Refl -> () end;;
+                                                        ^^^^
+Error: This pattern matches values of type (ex#0 S.s, ex#1 S.t) eq
+       but a pattern was expected which matches values of type
+         (ex#0 S.s, ex#0 S.t) eq
+       The type constructor ex#0 would escape its scope
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr6158.ml.reference ocaml-4.01.0/testsuite/tests/typing-gadts/pr6158.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr6158.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr6158.ml.reference	2013-09-05 08:58:16.000000000 +0000
@@ -0,0 +1,15 @@
+
+#       type 'a t = T of 'a
+type 'a s = S of 'a
+type (_, _) eq = Refl : ('a, 'a) eq
+#   Characters 46-50:
+  let f : (int s, int t) eq -> unit = function Refl -> ();;
+                                               ^^^^
+Error: This pattern matches values of type (int s, int s) eq
+       but a pattern was expected which matches values of type
+         (int s, int t) eq
+       Type int s is not compatible with type int t 
+#     module M :
+  functor (S : sig type 'a t = T of 'a type 'a s = T of 'a end) ->
+    sig val f : (a#0 S.s, a#0 S.t) eq -> unit end
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr6163.ml ocaml-4.01.0/testsuite/tests/typing-gadts/pr6163.ml
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr6163.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr6163.ml	2013-09-06 05:48:29.000000000 +0000
@@ -0,0 +1,14 @@
+type _ nat = 
+    Zero : [`Zero] nat
+  | Succ : 'a nat -> [`Succ of 'a] nat;;
+type 'a pre_nat = [`Zero | `Succ of 'a];;
+type aux =
+  | Aux : [`Succ of [<[<[<[`Zero] pre_nat] pre_nat] pre_nat]] nat -> aux;;
+
+let f (Aux x) =
+  match x with
+  | Succ Zero -> "1"
+  | Succ (Succ Zero) -> "2"
+  | Succ (Succ (Succ Zero)) -> "3"
+  | Succ (Succ (Succ (Succ Zero))) -> "4"
+;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr6163.ml.principal.reference ocaml-4.01.0/testsuite/tests/typing-gadts/pr6163.ml.principal.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr6163.ml.principal.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr6163.ml.principal.reference	2013-09-06 05:48:29.000000000 +0000
@@ -0,0 +1,18 @@
+
+#     type _ nat = Zero : [ `Zero ] nat | Succ : 'a nat -> [ `Succ of 'a ] nat
+# type 'a pre_nat = [ `Succ of 'a | `Zero ]
+#   type aux =
+    Aux :
+      [ `Succ of [< [< [< [ `Zero ] pre_nat ] pre_nat ] pre_nat ] ] nat -> 
+      aux
+#               Characters 19-157:
+  ..match x with
+    | Succ Zero -> "1"
+    | Succ (Succ Zero) -> "2"
+    | Succ (Succ (Succ Zero)) -> "3"
+    | Succ (Succ (Succ (Succ Zero))) -> "4"
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+Succ (Succ (Succ (Succ (Succ _))))
+val f : aux -> string = 
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/pr6163.ml.reference ocaml-4.01.0/testsuite/tests/typing-gadts/pr6163.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/pr6163.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/pr6163.ml.reference	2013-09-06 05:48:29.000000000 +0000
@@ -0,0 +1,18 @@
+
+#     type _ nat = Zero : [ `Zero ] nat | Succ : 'a nat -> [ `Succ of 'a ] nat
+# type 'a pre_nat = [ `Succ of 'a | `Zero ]
+#   type aux =
+    Aux :
+      [ `Succ of [< [< [< [ `Zero ] pre_nat ] pre_nat ] pre_nat ] ] nat -> 
+      aux
+#               Characters 19-157:
+  ..match x with
+    | Succ Zero -> "1"
+    | Succ (Succ Zero) -> "2"
+    | Succ (Succ (Succ Zero)) -> "3"
+    | Succ (Succ (Succ (Succ Zero))) -> "4"
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+Succ (Succ (Succ (Succ (Succ _))))
+val f : aux -> string = 
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/term-conv.ml ocaml-4.01.0/testsuite/tests/typing-gadts/term-conv.ml
--- ocaml-3.12.1/testsuite/tests/typing-gadts/term-conv.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/term-conv.ml	2011-11-24 09:02:48.000000000 +0000
@@ -0,0 +1,139 @@
+(* HOAS to de Bruijn, by chak *)
+(* http://www.cse.unsw.edu.au/~chak/haskell/term-conv/ *)
+
+module Typeable = struct
+  type 'a ty =
+    | Int: int ty
+    | String: string ty
+    | List: 'a ty -> 'a list ty
+    | Pair: ('a ty * 'b ty) -> ('a * 'b) ty
+    | Fun: ('a ty * 'b ty) -> ('a -> 'b) ty
+
+  type (_,_) eq = Eq : ('a,'a) eq
+
+  exception CastFailure
+  let rec check_eq : type t t'. t ty -> t' ty -> (t,t') eq = fun t t' ->
+    match t, t' with
+    | Int, Int -> Eq
+    | String, String -> Eq
+    | List t, List t' -> (match check_eq t t' with Eq -> Eq)
+    | Pair (t1,t2), Pair (t1',t2') ->
+        (match check_eq t1 t1', check_eq t2 t2' with Eq, Eq -> Eq)
+    | Fun (t1,t2), Fun (t1',t2') ->
+        (match check_eq t1 t1', check_eq t2 t2' with Eq, Eq -> Eq)
+    | _ -> raise CastFailure
+
+  let gcast : type t t'. t ty -> t' ty -> t -> t' = fun t t' x ->
+    match check_eq t t' with Eq -> x
+end;;
+
+module HOAS = struct
+  open Typeable
+
+  type _ term =
+    | Tag : 't ty * int -> 't term
+    | Con : 't -> 't term
+    | Lam : 's ty * ('s term -> 't term) -> ('s -> 't) term
+    | App : ('s -> 't) term * 's term -> 't term
+
+  let rec intp : type t. t term -> t = function
+    | Tag (_, ix) -> failwith "HOAS.intp"
+    | Con v      -> v
+    | Lam (_, f) -> fun x -> intp (f (Con x))
+    | App (f, a) -> intp f (intp a)
+end;;
+
+module DeBruijn = struct
+  type ('env,'t) ix =
+    | ZeroIx : ('env * 't, 't) ix
+    | SuccIx : ('env,'t) ix -> ('env * 's, 't) ix
+
+  let rec to_int : type env t. (env,t) ix -> int = function
+    | ZeroIx   -> 0
+    | SuccIx n -> to_int n + 1
+
+  type ('env,'t) term =
+    | Var : ('env,'t) ix -> ('env,'t) term
+    | Con : 't -> ('env,'t) term
+    | Lam : ('env * 's, 't) term -> ('env, 's -> 't) term
+    | App : ('env, 's -> 't) term * ('env, 's) term -> ('env, 't) term
+
+  type _ stack =
+    | Empty : unit stack
+    | Push : 'env stack * 't -> ('env * 't) stack
+
+  let rec prj : type env t. (env,t) ix -> env stack -> t = fun i s ->
+    match i, s with
+    | ZeroIx, Push (s,v) -> v
+    | SuccIx i, Push (s,_) -> prj i s
+
+  let rec intp : type env t. (env,t) term -> env stack -> t = fun t s ->
+    match t with
+    | Var ix -> prj ix s
+    | Con v  -> v
+    | Lam b  -> fun x -> intp b (Push (s, x))
+    | App(f,a) -> intp f s (intp a s)
+end;;
+
+module Convert = struct
+  type (_,_) layout =
+    | EmptyLayout : ('env, unit) layout
+    | PushLayout  :
+        't Typeable.ty * ('env,'env') layout * ('env,'t) DeBruijn.ix
+           -> ('env,'env' * 't) layout
+
+  let rec size : type env env'. (env,env') layout -> int = function
+    | EmptyLayout -> 0
+    | PushLayout (_, lyt, _) -> size lyt + 1
+
+  let rec inc : type env env'. (env,env') layout -> (env * 't, env') layout =
+    function
+      | EmptyLayout -> EmptyLayout
+      | PushLayout (t, lyt, ix) -> PushLayout (t, inc lyt, DeBruijn.SuccIx ix)
+
+  let rec prj : type env env' t.
+        t Typeable.ty -> int -> (env,env') layout -> (env,t) DeBruijn.ix
+    = fun t n -> function
+      | EmptyLayout -> failwith "Convert.prj: internal error"
+      | PushLayout (t', l, ix) ->
+          if n = 0 then
+            match Typeable.check_eq t t' with Typeable.Eq -> ix
+          else prj t (n-1) l
+
+  let rec cvt :
+    type env t. (env,env) layout -> t HOAS.term -> (env,t) DeBruijn.term =
+    fun lyt -> function
+      | HOAS.Tag (t, sz) -> DeBruijn.Var (prj t (size lyt - sz -1) lyt)
+      | HOAS.Con v -> DeBruijn.Con v
+      | HOAS.Lam (t, f) ->
+          let lyt' = PushLayout (t, inc lyt, DeBruijn.ZeroIx) in
+          DeBruijn.Lam (cvt lyt' (f (HOAS.Tag (t, size lyt))))
+      | HOAS.App (f, a) ->
+          DeBruijn.App (cvt lyt f, cvt lyt a)
+
+  let convert t = cvt EmptyLayout t
+end;;
+
+module Main = struct
+  open HOAS
+  let i t = Lam (t, fun x -> x)
+  let zero t = Lam (Typeable.Fun(t,t), fun f -> Lam(t, fun x -> x))
+  let one t = Lam (Typeable.Fun(t,t), fun f -> Lam(t, fun x -> App (f, x)))
+  let two t =
+    Lam (Typeable.Fun(t,t), fun f -> Lam(t, fun x -> App (f, App (f, x))))
+  let three t =
+    Lam (Typeable.Fun(t,t),
+         fun f -> Lam(t, fun x -> App (f, App (f, App (f, x)))))
+  let plus t =
+    let t1 = Typeable.Fun(t,t) in let t2 = Typeable.Fun(t1,t1) in
+    Lam (t2, fun m -> Lam (t2, fun n ->
+      Lam (t1, fun f -> Lam(t, fun x -> App(App(m,f), App(App(n,f),x))))))
+
+  let plus_2_3 t = App (App (plus t, two t), three t)
+
+  open Convert
+
+  let i' = convert (i Typeable.Int)
+  let plus_2_3' = convert (plus_2_3 Typeable.Int)
+  let eval_plus_2_3' = DeBruijn.intp plus_2_3' DeBruijn.Empty succ 0
+end;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/term-conv.ml.principal.reference ocaml-4.01.0/testsuite/tests/typing-gadts/term-conv.ml.principal.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/term-conv.ml.principal.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/term-conv.ml.principal.reference	2012-07-30 18:04:46.000000000 +0000
@@ -0,0 +1,71 @@
+
+#                                                       module Typeable :
+  sig
+    type 'a ty =
+        Int : int ty
+      | String : string ty
+      | List : 'a ty -> 'a list ty
+      | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
+      | Fun : ('a ty * 'b ty) -> ('a -> 'b) ty
+    type (_, _) eq = Eq : ('a, 'a) eq
+    exception CastFailure
+    val check_eq : 't ty -> 't' ty -> ('t, 't') eq
+    val gcast : 't ty -> 't' ty -> 't -> 't'
+  end
+#                               module HOAS :
+  sig
+    type _ term =
+        Tag : 't Typeable.ty * int -> 't term
+      | Con : 't -> 't term
+      | Lam : 's Typeable.ty * ('s term -> 't term) -> ('s -> 't) term
+      | App : ('s -> 't) term * 's term -> 't term
+    val intp : 't term -> 't
+  end
+#                                                               module DeBruijn :
+  sig
+    type ('env, 't) ix =
+        ZeroIx : ('env * 't, 't) ix
+      | SuccIx : ('env, 't) ix -> ('env * 's, 't) ix
+    val to_int : ('env, 't) ix -> int
+    type ('env, 't) term =
+        Var : ('env, 't) ix -> ('env, 't) term
+      | Con : 't -> ('env, 't) term
+      | Lam : ('env * 's, 't) term -> ('env, 's -> 't) term
+      | App : ('env, 's -> 't) term * ('env, 's) term -> ('env, 't) term
+    type _ stack =
+        Empty : unit stack
+      | Push : 'env stack * 't -> ('env * 't) stack
+    val prj : ('env, 't) ix -> 'env stack -> 't
+    val intp : ('env, 't) term -> 'env stack -> 't
+  end
+#                                                                             module Convert :
+  sig
+    type (_, _) layout =
+        EmptyLayout : ('env, unit) layout
+      | PushLayout : 't Typeable.ty * ('env, 'env') layout *
+          ('env, 't) DeBruijn.ix -> ('env, 'env' * 't) layout
+    val size : ('env, 'env') layout -> int
+    val inc : ('env, 'env') layout -> ('env * 't, 'env') layout
+    val prj :
+      't Typeable.ty -> int -> ('env, 'env') layout -> ('env, 't) DeBruijn.ix
+    val cvt : ('env, 'env) layout -> 't HOAS.term -> ('env, 't) DeBruijn.term
+    val convert : 'a HOAS.term -> (unit, 'a) DeBruijn.term
+  end
+#                                               module Main :
+  sig
+    val i : 'a Typeable.ty -> ('a -> 'a) HOAS.term
+    val zero : 'a Typeable.ty -> (('a -> 'a) -> 'a -> 'a) HOAS.term
+    val one : 'a Typeable.ty -> (('a -> 'a) -> 'a -> 'a) HOAS.term
+    val two : 'a Typeable.ty -> (('a -> 'a) -> 'a -> 'a) HOAS.term
+    val three : 'a Typeable.ty -> (('a -> 'a) -> 'a -> 'a) HOAS.term
+    val plus :
+      'a Typeable.ty ->
+      ((('a -> 'a) -> 'a -> 'a) ->
+       (('a -> 'a) -> 'a -> 'a) -> ('a -> 'a) -> 'a -> 'a)
+      HOAS.term
+    val plus_2_3 : 'a Typeable.ty -> (('a -> 'a) -> 'a -> 'a) HOAS.term
+    val i' : (unit, int -> int) DeBruijn.term
+    val plus_2_3' : (unit, (int -> int) -> int -> int) DeBruijn.term
+    val eval_plus_2_3' : int
+  end
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/term-conv.ml.reference ocaml-4.01.0/testsuite/tests/typing-gadts/term-conv.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/term-conv.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/term-conv.ml.reference	2012-07-30 18:04:46.000000000 +0000
@@ -0,0 +1,71 @@
+
+#                                                       module Typeable :
+  sig
+    type 'a ty =
+        Int : int ty
+      | String : string ty
+      | List : 'a ty -> 'a list ty
+      | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
+      | Fun : ('a ty * 'b ty) -> ('a -> 'b) ty
+    type (_, _) eq = Eq : ('a, 'a) eq
+    exception CastFailure
+    val check_eq : 't ty -> 't' ty -> ('t, 't') eq
+    val gcast : 't ty -> 't' ty -> 't -> 't'
+  end
+#                               module HOAS :
+  sig
+    type _ term =
+        Tag : 't Typeable.ty * int -> 't term
+      | Con : 't -> 't term
+      | Lam : 's Typeable.ty * ('s term -> 't term) -> ('s -> 't) term
+      | App : ('s -> 't) term * 's term -> 't term
+    val intp : 't term -> 't
+  end
+#                                                               module DeBruijn :
+  sig
+    type ('env, 't) ix =
+        ZeroIx : ('env * 't, 't) ix
+      | SuccIx : ('env, 't) ix -> ('env * 's, 't) ix
+    val to_int : ('env, 't) ix -> int
+    type ('env, 't) term =
+        Var : ('env, 't) ix -> ('env, 't) term
+      | Con : 't -> ('env, 't) term
+      | Lam : ('env * 's, 't) term -> ('env, 's -> 't) term
+      | App : ('env, 's -> 't) term * ('env, 's) term -> ('env, 't) term
+    type _ stack =
+        Empty : unit stack
+      | Push : 'env stack * 't -> ('env * 't) stack
+    val prj : ('env, 't) ix -> 'env stack -> 't
+    val intp : ('env, 't) term -> 'env stack -> 't
+  end
+#                                                                             module Convert :
+  sig
+    type (_, _) layout =
+        EmptyLayout : ('env, unit) layout
+      | PushLayout : 't Typeable.ty * ('env, 'env') layout *
+          ('env, 't) DeBruijn.ix -> ('env, 'env' * 't) layout
+    val size : ('env, 'env') layout -> int
+    val inc : ('env, 'env') layout -> ('env * 't, 'env') layout
+    val prj :
+      't Typeable.ty -> int -> ('env, 'env') layout -> ('env, 't) DeBruijn.ix
+    val cvt : ('env, 'env) layout -> 't HOAS.term -> ('env, 't) DeBruijn.term
+    val convert : 'a HOAS.term -> (unit, 'a) DeBruijn.term
+  end
+#                                               module Main :
+  sig
+    val i : 'a Typeable.ty -> ('a -> 'a) HOAS.term
+    val zero : 'a Typeable.ty -> (('a -> 'a) -> 'a -> 'a) HOAS.term
+    val one : 'a Typeable.ty -> (('a -> 'a) -> 'a -> 'a) HOAS.term
+    val two : 'a Typeable.ty -> (('a -> 'a) -> 'a -> 'a) HOAS.term
+    val three : 'a Typeable.ty -> (('a -> 'a) -> 'a -> 'a) HOAS.term
+    val plus :
+      'a Typeable.ty ->
+      ((('a -> 'a) -> 'a -> 'a) ->
+       (('a -> 'a) -> 'a -> 'a) -> ('a -> 'a) -> 'a -> 'a)
+      HOAS.term
+    val plus_2_3 : 'a Typeable.ty -> (('a -> 'a) -> 'a -> 'a) HOAS.term
+    val i' : (unit, int -> int) DeBruijn.term
+    val plus_2_3' : (unit, (int -> int) -> int -> int) DeBruijn.term
+    val eval_plus_2_3' : int
+  end
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/test.ml ocaml-4.01.0/testsuite/tests/typing-gadts/test.ml
--- ocaml-3.12.1/testsuite/tests/typing-gadts/test.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/test.ml	2013-06-17 03:03:37.000000000 +0000
@@ -0,0 +1,539 @@
+module Exp =
+  struct
+
+    type _ t =
+      | IntLit : int -> int t
+      | BoolLit : bool -> bool t
+      | Pair : 'a t * 'b t -> ('a * 'b) t
+      | App : ('a -> 'b) t * 'a t -> 'b t
+      | Abs : ('a -> 'b) -> ('a -> 'b) t
+
+
+    let rec eval : type s . s t -> s =
+      function
+        | IntLit x -> x
+        | BoolLit y -> y
+        | Pair (x,y) ->
+            (eval x,eval y)
+        | App (f,a) ->
+            (eval f) (eval a)
+        | Abs f -> f
+
+    let discern : type a. a t -> _ = function
+        IntLit _ -> 1
+      | BoolLit _ -> 2
+      | Pair _ -> 3
+      | App _ -> 4
+      | Abs _ -> 5
+  end
+;;
+
+module List =
+  struct
+    type zero
+    type _ t =
+      | Nil : zero t
+      | Cons : 'a * 'b t -> ('a * 'b) t
+    let head =
+      function
+        | Cons (a,b) -> a
+    let tail =
+      function
+        | Cons (a,b) -> b
+    let rec length : type a . a t -> int =
+      function
+        | Nil -> 0
+        | Cons (a,b) -> length b
+  end
+;;
+
+module Nonexhaustive =
+  struct
+    type 'a u =
+      | C1 : int -> int u
+      | C2 : bool -> bool u
+
+    type 'a v =
+      | C1 : int -> int v
+
+    let unexhaustive : type s . s u -> s =
+      function
+        | C2 x -> x
+
+
+    module M : sig type t type u end =
+      struct
+        type t = int
+        type u = bool
+      end
+    type 'a t =
+      | Foo : M.t -> M.t t
+      | Bar : M.u -> M.u t
+    let same_type : type s . s t * s t -> bool  =
+      function
+        | Foo _ , Foo _ -> true
+        | Bar _, Bar _ -> true
+  end
+;;
+
+module Exhaustive =
+  struct
+    type t = int
+    type u = bool
+    type 'a v =
+      | Foo : t -> t v
+      | Bar : u -> u v
+
+    let same_type : type s . s v * s v -> bool  =
+      function
+        | Foo _ , Foo _ -> true
+        | Bar _, Bar _ -> true
+  end
+;;
+
+module Existential_escape =
+  struct
+    type _ t = C : int -> int t
+    type u = D : 'a t -> u
+    let eval (D x) = x
+  end
+;;
+
+module Rectype =
+  struct
+    type (_,_) t = C : ('a,'a) t
+    let _ =
+      fun (type s) ->
+        let a : (s, s * s) t = failwith "foo" in
+        match a with
+          C ->
+            ()
+  end
+;;
+
+module Or_patterns =
+struct
+      type _ t =
+      | IntLit : int -> int t
+      | BoolLit : bool -> bool t
+
+    let rec eval : type s . s t -> unit =
+      function
+        | (IntLit _ | BoolLit _) -> ()
+
+end
+;;
+
+module Polymorphic_variants =
+  struct
+      type _ t =
+      | IntLit : int -> int t
+      | BoolLit : bool -> bool t
+
+    let rec eval : type s . [`A] * s t -> unit =
+      function
+        | `A, IntLit _ -> ()
+        | `A, BoolLit _ -> ()
+  end
+;;
+
+module Propagation = struct
+  type _ t =
+      IntLit : int -> int t
+    | BoolLit : bool -> bool t
+
+  let check : type s. s t -> s = function
+    | IntLit n -> n
+    | BoolLit b -> b
+
+  let check : type s. s t -> s = fun x ->
+    let r = match x with
+    | IntLit n -> (n : s )
+    | BoolLit b -> b
+    in r
+end
+;;
+
+module Normal_constrs = struct
+  type a = A
+  type b = B
+
+  let f = function A -> 1 | B -> 2
+end;;
+
+type _ t = Int : int t ;;
+
+let ky x y = ignore (x = y); x ;;
+
+let test : type a. a t -> a =
+  function Int -> ky (1 : a) 1
+;;
+
+let test : type a. a t -> _ =
+  function Int -> 1       (* ok *)
+;;
+
+let test : type a. a t -> _ =
+  function Int -> ky (1 : a) 1  (* fails *)
+;;
+
+let test : type a. a t -> a = fun x ->
+  let r = match x with Int -> ky (1 : a) 1  (* fails *)
+  in r
+;;
+let test : type a. a t -> a = fun x ->
+  let r = match x with Int -> ky 1 (1 : a)  (* fails *)
+  in r
+;;
+let test (type a) x =
+  let r = match (x : a t) with Int -> ky 1 1
+  in r
+;;
+let test : type a. a t -> a = fun x ->
+  let r = match x with Int -> (1 : a)       (* ok! *)
+  in r
+;;
+let test : type a. a t -> _ = fun x ->
+  let r = match x with Int -> 1       (* ok! *)
+  in r
+;;
+let test : type a. a t -> a = fun x ->
+  let r : a = match x with Int -> 1
+  in r (* ok *)
+;;
+let test2 : type a. a t -> a option = fun x ->
+  let r = ref None in
+  begin match x with Int -> r := Some (1 : a) end;
+  !r (* ok *)
+;;
+let test2 : type a. a t -> a option = fun x ->
+  let r : a option ref = ref None in
+  begin match x with Int -> r := Some 1 end;
+  !r (* ok *)
+;;
+let test2 : type a. a t -> a option = fun x ->
+  let r : a option ref = ref None in
+  let u = ref None in
+  begin match x with Int -> r := Some 1; u := !r end;
+  !u
+;; (* ok (u non-ambiguous) *)
+let test2 : type a. a t -> a option = fun x ->
+  let r : a option ref = ref None in
+  let u = ref None in
+  begin match x with Int -> u := Some 1; r := !u end;
+  !u
+;; (* fails because u : (int | a) option ref *)
+let test2 : type a. a t -> a option = fun x ->
+  let u = ref None in
+  let r : a option ref = ref None in
+  begin match x with Int -> r := Some 1; u := !r end;
+  !u
+;; (* ok *)
+let test2 : type a. a t -> a option = fun x ->
+  let u = ref None in
+  let a =
+    let r : a option ref = ref None in
+    begin match x with Int -> r := Some 1; u := !r end;
+    !u
+  in a
+;; (* ok *)
+let either = ky
+let we_y1x (type a) (x : a) (v : a t) =
+  match v with Int -> let y = either 1 x in y
+;; (* fail *)
+
+(* Effect of external consraints *)
+let f (type a) (x : a t) y =
+  ignore (y : a);
+  let r = match x with Int -> (y : a) in (* ok *)
+  r
+;;
+let f (type a) (x : a t) y =
+  let r = match x with Int -> (y : a) in
+  ignore (y : a); (* ok *)
+  r
+;;
+let f (type a) (x : a t) y =
+  ignore (y : a);
+  let r = match x with Int -> y in (* ok *)
+  r
+;;
+let f (type a) (x : a t) y =
+  let r = match x with Int -> y in
+  ignore (y : a); (* ok *)
+  r
+;;
+let f (type a) (x : a t) (y : a) =
+  match x with Int -> y (* returns 'a *)
+;;
+
+(* Combination with local modules *)
+
+let f (type a) (x : a t) y =
+  match x with Int ->
+    let module M = struct type b = a let z = (y : b) end
+    in M.z
+;; (* fails because of aliasing... *)
+
+let f (type a) (x : a t) y =
+  match x with Int ->
+    let module M = struct type b = int let z = (y : b) end
+    in M.z
+;; (* ok *)
+
+(* Objects and variants *)
+
+type _ h =
+  | Has_m :  h
+  | Has_b :  h
+
+let f : type a. a h -> a = function
+  | Has_m -> object method m = 1 end
+  | Has_b -> object method b = true end
+;;
+type _ j =
+  | Has_A : [`A of int] j
+  | Has_B : [`B of bool] j
+
+let f : type a. a j -> a = function
+  | Has_A -> `A 1
+  | Has_B -> `B true
+;;
+
+type (_,_) eq = Eq : ('a,'a) eq ;;
+
+let f : type a b. (a,b) eq -> ( as 'c) -> ( as 'c) =
+  fun Eq o -> o
+;; (* fail *)
+
+let f : type a b. (a,b) eq ->  ->  =
+  fun Eq o -> o
+;; (* fail *)
+
+let f (type a) (type b) (eq : (a,b) eq) (o : ) :  =
+  match eq with Eq -> o ;; (* should fail *)
+
+let f : type a b. (a,b) eq ->  ->  =
+  fun Eq o -> o
+;; (* ok *)
+
+let int_of_bool : (bool,int) eq = Obj.magic Eq;;
+
+let x = object method m = true end;;
+let y = (x, f int_of_bool x);;
+
+let f : type a. (a, int) eq ->  -> bool =
+  fun Eq o -> ignore (o : ); o#m = 3
+;; (* should be ok *)
+
+let f : type a b. (a,b) eq -> < m : a; .. > -> < m : b > =
+  fun eq o ->
+    ignore (o : < m : a >);
+    let r : < m : b > = match eq with Eq -> o in (* fail with principal *)
+    r;;
+
+let f : type a b. (a,b) eq -> < m : a; .. > -> < m : b > =
+  fun eq o ->
+    let r : < m : b > = match eq with Eq -> o in (* fail *)
+    ignore (o : < m : a >);
+    r;;
+
+let f : type a b. (a,b) eq -> [> `A of a] -> [> `A of b] =
+  fun Eq o -> o ;; (* fail *)
+
+let f (type a) (type b) (eq : (a,b) eq) (v : [> `A of a]) : [> `A of b] =
+  match eq with Eq -> v ;; (* should fail *)
+
+let f : type a b. (a,b) eq -> [< `A of a | `B] -> [< `A of b | `B] =
+  fun Eq o -> o ;; (* fail *)
+
+let f : type a b. (a,b) eq -> [`A of a | `B] -> [`A of b | `B] =
+  fun Eq o -> o ;; (* ok *)
+
+let f : type a. (a, int) eq -> [`A of a] -> bool =
+  fun Eq v -> match v with `A 1 -> true | _ -> false
+;; (* ok *)
+
+let f : type a b. (a,b) eq -> [> `A of a | `B] -> [`A of b | `B] =
+  fun eq o ->
+    ignore (o : [< `A of a | `B]);
+    let r : [`A of b | `B] = match eq with Eq -> o in (* fail with principal *)
+    r;;
+
+let f : type a b. (a,b) eq -> [> `A of a | `B] -> [`A of b | `B] =
+  fun eq o ->
+    let r : [`A of b | `B] = match eq with Eq -> o in (* fail *)
+    ignore (o : [< `A of a | `B]);
+    r;;
+
+(* Pattern matching *)
+
+type 'a t =
+    A of int | B of bool | C of float | D of 'a
+
+type _ ty =
+  | TE : 'a ty -> 'a array ty
+  | TA : int ty
+  | TB : bool ty
+  | TC : float ty
+  | TD : string -> bool ty
+
+let f : type a. a ty -> a t -> int = fun x y ->
+  match x, y with
+  | _, A z -> z
+  | _, B z -> if z then 1 else 2
+  | _, C z -> truncate z
+  | TE TC, D [|1.0|] -> 14
+  | TA, D 0 -> -1
+  | TA, D z -> z
+  | TD "bye", D false -> 13
+  | TD "hello", D true -> 12
+ (* | TB, D z -> if z then 1 else 2 *)
+  | TC, D z -> truncate z
+  | _, D _ -> 0
+;;
+
+let f : type a. a ty -> a t -> int = fun x y ->
+  match x, y with
+  | _, A z -> z
+  | _, B z -> if z then 1 else 2
+  | _, C z -> truncate z
+  | TE TC, D [|1.0|] -> 14
+  | TA, D 0 -> -1
+  | TA, D z -> z
+;; (* warn *)
+
+let f : type a. a ty -> a t -> int = fun x y ->
+  match y, x with
+  | A z, _ -> z
+  | B z, _ -> if z then 1 else 2
+  | C z, _ -> truncate z
+  | D [|1.0|], TE TC -> 14
+  | D 0, TA -> -1
+  | D z, TA -> z
+;; (* fail *)
+
+type ('a,'b) pair = {right:'a; left:'b}
+
+let f : type a. a ty -> a t -> int = fun x y ->
+  match {left=x; right=y} with
+  | {left=_; right=A z} -> z
+  | {left=_; right=B z} -> if z then 1 else 2
+  | {left=_; right=C z} -> truncate z
+  | {left=TE TC; right=D [|1.0|]} -> 14
+  | {left=TA; right=D 0} -> -1
+  | {left=TA; right=D z} -> z
+;; (* fail *)
+
+type ('a,'b) pair = {left:'a; right:'b}
+
+let f : type a. a ty -> a t -> int = fun x y ->
+  match {left=x; right=y} with
+  | {left=_; right=A z} -> z
+  | {left=_; right=B z} -> if z then 1 else 2
+  | {left=_; right=C z} -> truncate z
+  | {left=TE TC; right=D [|1.0|]} -> 14
+  | {left=TA; right=D 0} -> -1
+  | {left=TA; right=D z} -> z
+;; (* ok *)
+
+(* Injectivity *)
+
+module M : sig type 'a t val eq : ('a t, 'b t) eq end =
+  struct type 'a t = int let eq = Eq end
+;;
+
+let f : type a b. (a M.t, b M.t) eq -> (a, b) eq =
+  function Eq -> Eq (* fail *)
+;;
+
+let f : type a b. (a M.t * a, b M.t * b) eq -> (a, b) eq =
+  function Eq -> Eq (* ok *)
+;;
+
+let f : type a b. (a * a M.t, b * b M.t) eq -> (a, b) eq =
+  function Eq -> Eq (* ok *)
+;;
+
+(* Applications of polymorphic variants *)
+
+type _ t =
+  | V1 : [`A | `B] t
+  | V2 : [`C | `D] t
+
+let f : type a. a t -> a = function
+  | V1 -> `A
+  | V2 -> `C
+;;
+
+f V1;;
+
+(* PR#5425 and PR#5427 *)
+
+type _ int_foo =
+  | IF_constr :  int_foo
+
+type _ int_bar =
+  | IB_constr :  int_bar
+;;
+
+let g (type t) (x:t) (e : t int_foo) (e' : t int_bar) =
+  let IF_constr, IB_constr = e, e' in
+  (x:)
+;;
+
+let g (type t) (x:t) (e : t int_foo) (e' : t int_bar) =
+  let IF_constr, IB_constr = e, e' in
+  (x:)
+;;
+
+let g (type t) (x:t) (e : t int_foo) (e' : t int_bar) =
+  let IF_constr, IB_constr = e, e' in
+  (x:)
+;;
+
+let g (type t) (x:t) (e : t int_foo) (e' : t int_bar) : t =
+  let IF_constr, IB_constr = e, e' in
+  (x:)
+;;
+
+let g (type t) (x:t) (e : t int_foo) (e' : t int_bar) =
+  let IF_constr, IB_constr = e, e' in
+  x, x#foo, x#bar
+;;
+
+(* PR#5554 *)
+
+type 'a ty = Int : int -> int ty;;
+
+let f : type a. a ty -> a =
+  fun x -> match x with Int y -> y;;
+
+let g : type a. a ty -> a =
+  let () = () in
+  fun x -> match x with Int y -> y;;
+
+(* Printing of anonymous variables *)
+
+module M = struct type _ t = int end;;
+module M = struct type _ t = T : int t end;;
+module N = M;;
+
+(* Principality *)
+
+(* adding a useless equation should not break inference *)
+let f : type a b. (a,b) eq -> (a,int) eq -> a -> b -> _ = fun ab aint a b ->
+  let Eq = ab in
+  let x =
+    let Eq = aint in
+    if true then a else b
+  in ignore x
+;; (* ok *)
+
+let f : type a b. (a,b) eq -> (b,int) eq -> a -> b -> _ = fun ab bint a b ->
+  let Eq = ab in
+  let x =
+    let Eq = bint in
+    if true then a else b
+  in ignore x
+;; (* ok *)
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/test.ml.principal.reference ocaml-4.01.0/testsuite/tests/typing-gadts/test.ml.principal.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/test.ml.principal.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/test.ml.principal.reference	2013-06-17 03:03:37.000000000 +0000
@@ -0,0 +1,317 @@
+
+#                                                         module Exp :
+  sig
+    type _ t =
+        IntLit : int -> int t
+      | BoolLit : bool -> bool t
+      | Pair : 'a t * 'b t -> ('a * 'b) t
+      | App : ('a -> 'b) t * 'a t -> 'b t
+      | Abs : ('a -> 'b) -> ('a -> 'b) t
+    val eval : 's t -> 's
+    val discern : 'a t -> int
+  end
+#                                     module List :
+  sig
+    type zero
+    type _ t = Nil : zero t | Cons : 'a * 'b t -> ('a * 'b) t
+    val head : ('a * 'b) t -> 'a
+    val tail : ('a * 'b) t -> 'b t
+    val length : 'a t -> int
+  end
+#                                                         Characters 196-224:
+  ......function
+          | C2 x -> x
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+C1 _
+Characters 458-529:
+  ......function
+          | Foo _ , Foo _ -> true
+          | Bar _, Bar _ -> true
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+(Bar _, Foo _)
+module Nonexhaustive :
+  sig
+    type 'a u = C1 : int -> int u | C2 : bool -> bool u
+    type 'a v = C1 : int -> int v
+    val unexhaustive : 's u -> 's
+    module M : sig type t type u end
+    type 'a t = Foo : M.t -> M.t t | Bar : M.u -> M.u t
+    val same_type : 's t * 's t -> bool
+  end
+#                             module Exhaustive :
+  sig
+    type t = int
+    type u = bool
+    type 'a v = Foo : t -> t v | Bar : u -> u v
+    val same_type : 's v * 's v -> bool
+  end
+#               Characters 118-119:
+      let eval (D x) = x
+                       ^
+Error: This expression has type a#2 t but an expression was expected of type
+         a#2 t
+       The type constructor a#2 would escape its scope
+#                       Characters 174-175:
+            C ->
+            ^
+Error: Recursive local constraint when unifying (s, s) t with (s, s * s) t
+#                         Characters 178-186:
+          | (IntLit _ | BoolLit _) -> ()
+             ^^^^^^^^
+Error: This pattern matches values of type int t
+       but a pattern was expected which matches values of type s t
+       Type int is not compatible with type s 
+#                         module Polymorphic_variants :
+  sig
+    type _ t = IntLit : int -> int t | BoolLit : bool -> bool t
+    val eval : [ `A ] * 's t -> unit
+  end
+#                                 Characters 299-300:
+      | BoolLit b -> b
+                     ^
+Error: This expression has type bool but an expression was expected of type s
+#             Characters 87-88:
+    let f = function A -> 1 | B -> 2
+                              ^
+Error: This pattern matches values of type b
+       but a pattern was expected which matches values of type a
+#   type _ t = Int : int t
+#   val ky : 'a -> 'a -> 'a = 
+#       val test : 'a t -> 'a = 
+#       val test : 'a t -> int = 
+#       Characters 49-61:
+    function Int -> ky (1 : a) 1  (* fails *)
+                    ^^^^^^^^^^^^
+Error: This expression has type a = int
+       but an expression was expected of type a = int
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+#         Characters 70-82:
+    let r = match x with Int -> ky (1 : a) 1  (* fails *)
+                                ^^^^^^^^^^^^
+Error: This expression has type a = int
+       but an expression was expected of type a = int
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+#       Characters 69-81:
+    let r = match x with Int -> ky 1 (1 : a)  (* fails *)
+                                ^^^^^^^^^^^^
+Error: This expression has type a = int
+       but an expression was expected of type a = int
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+#       val test : 'a t -> int = 
+#       val test : 'a t -> 'a = 
+#       val test : 'a t -> int = 
+#       val test : 'a t -> 'a = 
+#         val test2 : 'a t -> 'a option = 
+#         val test2 : 'a t -> 'a option = 
+#           val test2 : 'a t -> 'a option = 
+#           Characters 152-154:
+    begin match x with Int -> u := Some 1; r := !u end;
+                                                ^^
+Error: This expression has type int option
+       but an expression was expected of type a option
+       Type int is not compatible with type a = int 
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+#           val test2 : 'a t -> 'a option = 
+#               val test2 : 'a t -> 'a option = 
+#       Characters 100-101:
+    match v with Int -> let y = either 1 x in y
+                                              ^
+Error: This expression has type a = int
+       but an expression was expected of type a = int
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+#             val f : 'a t -> 'a -> 'a = 
+#         val f : 'a t -> 'a -> 'a = 
+#         val f : 'a t -> 'a -> 'a = 
+#         val f : 'a t -> 'a -> 'a = 
+#     val f : 'a t -> 'a -> 'a = 
+#               Characters 136-137:
+      let module M = struct type b = a let z = (y : b) end
+                                                ^
+Error: This expression has type a = int
+       but an expression was expected of type b = int
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+#           val f : 'a t -> int -> int = 
+#                     type _ h = Has_m : < m : int > h | Has_b : < b : bool > h
+val f : 'a h -> 'a = 
+#               type _ j = Has_A : [ `A of int ] j | Has_B : [ `B of bool ] j
+val f : 'a j -> 'a = 
+#   type (_, _) eq = Eq : ('a, 'a) eq
+#       Characters 5-91:
+  ....f : type a b. (a,b) eq -> ( as 'c) -> ( as 'c) =
+    fun Eq o -> o
+Error: The universal type variable 'b cannot be generalized:
+       it is already bound to another variable.
+#       Characters 74-75:
+    fun Eq o -> o
+                ^
+Error: This expression has type < m : a; .. >
+       but an expression was expected of type < m : b; .. >
+       Type a is not compatible with type b = a 
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+#     Characters 97-98:
+    match eq with Eq -> o ;; (* should fail *)
+                        ^
+Error: This expression has type < m : a; .. >
+       but an expression was expected of type < m : b; .. >
+       Type a is not compatible with type b = a 
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+#       val f : ('a, 'b) eq -> < m : 'a > -> < m : 'b > = 
+#   val int_of_bool : (bool, int) eq = Eq
+#   val x : < m : bool > = 
+# val y : < m : bool > * < m : int > = (, )
+#       val f : ('a, int) eq -> < m : 'a > -> bool = 
+#           Characters 146-147:
+      let r : < m : b > = match eq with Eq -> o in (* fail with principal *)
+                                              ^
+Error: This expression has type < m : a >
+       but an expression was expected of type < m : b >
+       Type a is not compatible with type b = a 
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+#           Characters 118-119:
+      let r : < m : b > = match eq with Eq -> o in (* fail *)
+                                              ^
+Error: This expression has type < m : a; .. >
+       but an expression was expected of type < m : b >
+       Type a is not compatible with type b = a 
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+#     Characters 74-75:
+    fun Eq o -> o ;; (* fail *)
+                ^
+Error: This expression has type [> `A of a ]
+       but an expression was expected of type [> `A of b ]
+       Type a is not compatible with type b = a 
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+#     Characters 97-98:
+    match eq with Eq -> v ;; (* should fail *)
+                        ^
+Error: This expression has type [> `A of a ]
+       but an expression was expected of type [> `A of b ]
+       Type a is not compatible with type b = a 
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+#     Characters 5-85:
+  ....f : type a b. (a,b) eq -> [< `A of a | `B] -> [< `A of b | `B] =
+    fun Eq o -> o..............
+Error: This definition has type
+         ('a, 'b) eq -> ([< `A of 'b & 'a | `B ] as 'c) -> 'c
+       which is less general than 'a0 'b0. ('a0, 'b0) eq -> 'c -> 'c
+#     val f : ('a, 'b) eq -> [ `A of 'a | `B ] -> [ `A of 'b | `B ] = 
+#       val f : ('a, int) eq -> [ `A of 'a ] -> bool = 
+#           Characters 166-167:
+      let r : [`A of b | `B] = match eq with Eq -> o in (* fail with principal *)
+                                                   ^
+Error: This expression has type [ `A of a | `B ]
+       but an expression was expected of type [ `A of b | `B ]
+       Type a is not compatible with type b = a 
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+#           Characters 131-132:
+      let r : [`A of b | `B] = match eq with Eq -> o in (* fail *)
+                                                   ^
+Error: This expression has type [> `A of a | `B ]
+       but an expression was expected of type [ `A of b | `B ]
+       Type a is not compatible with type b = a 
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+#                                                     type 'a t = A of int | B of bool | C of float | D of 'a
+type _ ty =
+    TE : 'a ty -> 'a array ty
+  | TA : int ty
+  | TB : bool ty
+  | TC : float ty
+  | TD : string -> bool ty
+val f : 'a ty -> 'a t -> int = 
+#                   Characters 51-202:
+  ..match x, y with
+    | _, A z -> z
+    | _, B z -> if z then 1 else 2
+    | _, C z -> truncate z
+    | TE TC, D [|1.0|] -> 14
+    | TA, D 0 -> -1
+    | TA, D z -> z
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+(TE TC, D [|  |])
+val f : 'a ty -> 'a t -> int = 
+#                   Characters 147-154:
+    | D [|1.0|], TE TC -> 14
+        ^^^^^^^
+Error: This pattern matches values of type 'a array
+       but a pattern was expected which matches values of type a
+#                       Characters 259-266:
+    | {left=TE TC; right=D [|1.0|]} -> 14
+                           ^^^^^^^
+Error: This pattern matches values of type 'a array
+       but a pattern was expected which matches values of type a
+#                       Characters 92-334:
+  ..match {left=x; right=y} with
+    | {left=_; right=A z} -> z
+    | {left=_; right=B z} -> if z then 1 else 2
+    | {left=_; right=C z} -> truncate z
+    | {left=TE TC; right=D [|1.0|]} -> 14
+    | {left=TA; right=D 0} -> -1
+    | {left=TA; right=D z} -> z
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+{left=TE TC; right=D [|  |]}
+type ('a, 'b) pair = { left : 'a; right : 'b; }
+val f : 'a ty -> 'a t -> int = 
+#           module M : sig type 'a t val eq : ('a t, 'b t) eq end
+#       Characters 69-71:
+    function Eq -> Eq (* fail *)
+                   ^^
+Error: This expression has type (a, a) eq
+       but an expression was expected of type (a, b) eq
+       Type a is not compatible with type b 
+#       val f : ('a M.t * 'a, 'b M.t * 'b) eq -> ('a, 'b) eq = 
+#       val f : ('a * 'a M.t, 'b * 'b M.t) eq -> ('a, 'b) eq = 
+#                     type _ t = V1 : [ `A | `B ] t | V2 : [ `C | `D ] t
+val f : 'a t -> 'a = 
+#   - : [ `A | `B ] = `A
+#                 type _ int_foo = IF_constr : < foo : int; .. > int_foo
+type _ int_bar = IB_constr : < bar : int; .. > int_bar
+#         Characters 98-99:
+    (x:)
+     ^
+Error: This expression has type t = < foo : int; .. >
+       but an expression was expected of type < foo : int >
+       Type ex#17 = < bar : int; .. > is not compatible with type <  > 
+       The second object type has no method bar
+#         Characters 98-99:
+    (x:)
+     ^
+Error: This expression has type t = < foo : int; .. >
+       but an expression was expected of type < bar : int; foo : int >
+       Type ex#19 = < bar : int; .. > is not compatible with type
+         < bar : int > 
+       The first object type has an abstract row, it cannot be closed
+#         Characters 98-99:
+    (x:)
+     ^
+Error: This expression has type < bar : int; foo : int; .. > as 'a
+       but an expression was expected of type 'a
+       The type constructor ex#22 would escape its scope
+#         val g : 'a -> 'a int_foo -> 'a int_bar -> 'a = 
+#         val g : 'a -> 'a int_foo -> 'a int_bar -> 'a * int * int = 
+#       type 'a ty = Int : int -> int ty
+#     val f : 'a ty -> 'a = 
+#       val g : 'a ty -> 'a = 
+#       module M : sig type _ t = int end
+# module M : sig type _ t = T : int t end
+# module N : sig type 'a t = 'a M.t = T : int t end
+#                     val f : ('a, 'b) eq -> ('a, int) eq -> 'a -> 'b -> unit = 
+#               val f : ('a, 'b) eq -> ('b, int) eq -> 'a -> 'b -> unit = 
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/test.ml.reference ocaml-4.01.0/testsuite/tests/typing-gadts/test.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/test.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/test.ml.reference	2013-06-17 03:03:37.000000000 +0000
@@ -0,0 +1,303 @@
+
+#                                                         module Exp :
+  sig
+    type _ t =
+        IntLit : int -> int t
+      | BoolLit : bool -> bool t
+      | Pair : 'a t * 'b t -> ('a * 'b) t
+      | App : ('a -> 'b) t * 'a t -> 'b t
+      | Abs : ('a -> 'b) -> ('a -> 'b) t
+    val eval : 's t -> 's
+    val discern : 'a t -> int
+  end
+#                                     module List :
+  sig
+    type zero
+    type _ t = Nil : zero t | Cons : 'a * 'b t -> ('a * 'b) t
+    val head : ('a * 'b) t -> 'a
+    val tail : ('a * 'b) t -> 'b t
+    val length : 'a t -> int
+  end
+#                                                         Characters 196-224:
+  ......function
+          | C2 x -> x
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+C1 _
+Characters 458-529:
+  ......function
+          | Foo _ , Foo _ -> true
+          | Bar _, Bar _ -> true
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+(Bar _, Foo _)
+module Nonexhaustive :
+  sig
+    type 'a u = C1 : int -> int u | C2 : bool -> bool u
+    type 'a v = C1 : int -> int v
+    val unexhaustive : 's u -> 's
+    module M : sig type t type u end
+    type 'a t = Foo : M.t -> M.t t | Bar : M.u -> M.u t
+    val same_type : 's t * 's t -> bool
+  end
+#                             module Exhaustive :
+  sig
+    type t = int
+    type u = bool
+    type 'a v = Foo : t -> t v | Bar : u -> u v
+    val same_type : 's v * 's v -> bool
+  end
+#               Characters 118-119:
+      let eval (D x) = x
+                       ^
+Error: This expression has type a#2 t but an expression was expected of type
+         a#2 t
+       The type constructor a#2 would escape its scope
+#                       Characters 174-175:
+            C ->
+            ^
+Error: Recursive local constraint when unifying (s, s) t with (s, s * s) t
+#                         Characters 178-186:
+          | (IntLit _ | BoolLit _) -> ()
+             ^^^^^^^^
+Error: This pattern matches values of type int t
+       but a pattern was expected which matches values of type s t
+       Type int is not compatible with type s 
+#                         module Polymorphic_variants :
+  sig
+    type _ t = IntLit : int -> int t | BoolLit : bool -> bool t
+    val eval : [ `A ] * 's t -> unit
+  end
+#                                 module Propagation :
+  sig
+    type _ t = IntLit : int -> int t | BoolLit : bool -> bool t
+    val check : 's t -> 's
+  end
+#             Characters 87-88:
+    let f = function A -> 1 | B -> 2
+                              ^
+Error: The variant type a has no constructor B
+#   type _ t = Int : int t
+#   val ky : 'a -> 'a -> 'a = 
+#       val test : 'a t -> 'a = 
+#       val test : 'a t -> int = 
+#       Characters 49-61:
+    function Int -> ky (1 : a) 1  (* fails *)
+                    ^^^^^^^^^^^^
+Error: This expression has type a = int
+       but an expression was expected of type a = int
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+#         Characters 70-82:
+    let r = match x with Int -> ky (1 : a) 1  (* fails *)
+                                ^^^^^^^^^^^^
+Error: This expression has type a = int
+       but an expression was expected of type a = int
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+#       Characters 69-81:
+    let r = match x with Int -> ky 1 (1 : a)  (* fails *)
+                                ^^^^^^^^^^^^
+Error: This expression has type a = int
+       but an expression was expected of type a = int
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+#       val test : 'a t -> int = 
+#       val test : 'a t -> 'a = 
+#       val test : 'a t -> int = 
+#       val test : 'a t -> 'a = 
+#         val test2 : 'a t -> 'a option = 
+#         val test2 : 'a t -> 'a option = 
+#           val test2 : 'a t -> 'a option = 
+#           Characters 152-154:
+    begin match x with Int -> u := Some 1; r := !u end;
+                                                ^^
+Error: This expression has type int option
+       but an expression was expected of type a option
+       Type int is not compatible with type a = int 
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+#           val test2 : 'a t -> 'a option = 
+#               val test2 : 'a t -> 'a option = 
+#       Characters 100-101:
+    match v with Int -> let y = either 1 x in y
+                                              ^
+Error: This expression has type a = int
+       but an expression was expected of type a = int
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+#             val f : 'a t -> 'a -> 'a = 
+#         val f : 'a t -> 'a -> 'a = 
+#         val f : 'a t -> 'a -> 'a = 
+#         val f : 'a t -> 'a -> 'a = 
+#     val f : 'a t -> 'a -> 'a = 
+#               Characters 136-137:
+      let module M = struct type b = a let z = (y : b) end
+                                                ^
+Error: This expression has type a = int
+       but an expression was expected of type b = int
+       This instance of int is ambiguous:
+       it would escape the scope of its equation
+#           val f : 'a t -> int -> int = 
+#                     type _ h = Has_m : < m : int > h | Has_b : < b : bool > h
+val f : 'a h -> 'a = 
+#               type _ j = Has_A : [ `A of int ] j | Has_B : [ `B of bool ] j
+val f : 'a j -> 'a = 
+#   type (_, _) eq = Eq : ('a, 'a) eq
+#       Characters 5-91:
+  ....f : type a b. (a,b) eq -> ( as 'c) -> ( as 'c) =
+    fun Eq o -> o
+Error: The universal type variable 'b cannot be generalized:
+       it is already bound to another variable.
+#       Characters 74-75:
+    fun Eq o -> o
+                ^
+Error: This expression has type < m : a; .. >
+       but an expression was expected of type < m : b; .. >
+       Type a is not compatible with type b = a 
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+#     Characters 97-98:
+    match eq with Eq -> o ;; (* should fail *)
+                        ^
+Error: This expression has type < m : a; .. >
+       but an expression was expected of type < m : b; .. >
+       Type a is not compatible with type b = a 
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+#       val f : ('a, 'b) eq -> < m : 'a > -> < m : 'b > = 
+#   val int_of_bool : (bool, int) eq = Eq
+#   val x : < m : bool > = 
+# val y : < m : bool > * < m : int > = (, )
+#       val f : ('a, int) eq -> < m : 'a > -> bool = 
+#           val f : ('a, 'b) eq -> < m : 'a > -> < m : 'b > = 
+#           Characters 118-119:
+      let r : < m : b > = match eq with Eq -> o in (* fail *)
+                                              ^
+Error: This expression has type < m : a; .. >
+       but an expression was expected of type < m : b >
+       Type a is not compatible with type b = a 
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+#     Characters 74-75:
+    fun Eq o -> o ;; (* fail *)
+                ^
+Error: This expression has type [> `A of a ]
+       but an expression was expected of type [> `A of b ]
+       Type a is not compatible with type b = a 
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+#     Characters 97-98:
+    match eq with Eq -> v ;; (* should fail *)
+                        ^
+Error: This expression has type [> `A of a ]
+       but an expression was expected of type [> `A of b ]
+       Type a is not compatible with type b = a 
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+#     Characters 5-85:
+  ....f : type a b. (a,b) eq -> [< `A of a | `B] -> [< `A of b | `B] =
+    fun Eq o -> o..............
+Error: This definition has type
+         ('a, 'b) eq -> ([< `A of 'b & 'a | `B ] as 'c) -> 'c
+       which is less general than 'a0 'b0. ('a0, 'b0) eq -> 'c -> 'c
+#     val f : ('a, 'b) eq -> [ `A of 'a | `B ] -> [ `A of 'b | `B ] = 
+#       val f : ('a, int) eq -> [ `A of 'a ] -> bool = 
+#           val f : ('a, 'b) eq -> [ `A of 'a | `B ] -> [ `A of 'b | `B ] = 
+#           Characters 131-132:
+      let r : [`A of b | `B] = match eq with Eq -> o in (* fail *)
+                                                   ^
+Error: This expression has type [> `A of a | `B ]
+       but an expression was expected of type [ `A of b | `B ]
+       Type a is not compatible with type b = a 
+       This instance of a is ambiguous:
+       it would escape the scope of its equation
+#                                                     type 'a t = A of int | B of bool | C of float | D of 'a
+type _ ty =
+    TE : 'a ty -> 'a array ty
+  | TA : int ty
+  | TB : bool ty
+  | TC : float ty
+  | TD : string -> bool ty
+val f : 'a ty -> 'a t -> int = 
+#                   Characters 51-202:
+  ..match x, y with
+    | _, A z -> z
+    | _, B z -> if z then 1 else 2
+    | _, C z -> truncate z
+    | TE TC, D [|1.0|] -> 14
+    | TA, D 0 -> -1
+    | TA, D z -> z
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+(TE TC, D [|  |])
+val f : 'a ty -> 'a t -> int = 
+#                   Characters 147-154:
+    | D [|1.0|], TE TC -> 14
+        ^^^^^^^
+Error: This pattern matches values of type 'a array
+       but a pattern was expected which matches values of type a
+#                       Characters 259-266:
+    | {left=TE TC; right=D [|1.0|]} -> 14
+                           ^^^^^^^
+Error: This pattern matches values of type 'a array
+       but a pattern was expected which matches values of type a
+#                       Characters 92-334:
+  ..match {left=x; right=y} with
+    | {left=_; right=A z} -> z
+    | {left=_; right=B z} -> if z then 1 else 2
+    | {left=_; right=C z} -> truncate z
+    | {left=TE TC; right=D [|1.0|]} -> 14
+    | {left=TA; right=D 0} -> -1
+    | {left=TA; right=D z} -> z
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+{left=TE TC; right=D [|  |]}
+type ('a, 'b) pair = { left : 'a; right : 'b; }
+val f : 'a ty -> 'a t -> int = 
+#           module M : sig type 'a t val eq : ('a t, 'b t) eq end
+#       Characters 69-71:
+    function Eq -> Eq (* fail *)
+                   ^^
+Error: This expression has type (a, a) eq
+       but an expression was expected of type (a, b) eq
+       Type a is not compatible with type b 
+#       val f : ('a M.t * 'a, 'b M.t * 'b) eq -> ('a, 'b) eq = 
+#       val f : ('a * 'a M.t, 'b * 'b M.t) eq -> ('a, 'b) eq = 
+#                     type _ t = V1 : [ `A | `B ] t | V2 : [ `C | `D ] t
+val f : 'a t -> 'a = 
+#   - : [ `A | `B ] = `A
+#                 type _ int_foo = IF_constr : < foo : int; .. > int_foo
+type _ int_bar = IB_constr : < bar : int; .. > int_bar
+#         Characters 98-99:
+    (x:)
+     ^
+Error: This expression has type t = < foo : int; .. >
+       but an expression was expected of type < foo : int >
+       Type ex#17 = < bar : int; .. > is not compatible with type <  > 
+       The second object type has no method bar
+#         Characters 98-99:
+    (x:)
+     ^
+Error: This expression has type t = < foo : int; .. >
+       but an expression was expected of type < bar : int; foo : int >
+       Type ex#19 = < bar : int; .. > is not compatible with type
+         < bar : int > 
+       The first object type has an abstract row, it cannot be closed
+#         Characters 98-99:
+    (x:)
+     ^
+Error: This expression has type < bar : int; foo : int; .. > as 'a
+       but an expression was expected of type 'a
+       The type constructor ex#22 would escape its scope
+#         val g : 'a -> 'a int_foo -> 'a int_bar -> 'a = 
+#         val g : 'a -> 'a int_foo -> 'a int_bar -> 'a * int * int = 
+#       type 'a ty = Int : int -> int ty
+#     val f : 'a ty -> 'a = 
+#       val g : 'a ty -> 'a = 
+#       module M : sig type _ t = int end
+# module M : sig type _ t = T : int t end
+# module N : sig type 'a t = 'a M.t = T : int t end
+#                     val f : ('a, 'b) eq -> ('a, int) eq -> 'a -> 'b -> unit = 
+#               val f : ('a, 'b) eq -> ('b, int) eq -> 'a -> 'b -> unit = 
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/yallop_bugs.ml ocaml-4.01.0/testsuite/tests/typing-gadts/yallop_bugs.ml
--- ocaml-3.12.1/testsuite/tests/typing-gadts/yallop_bugs.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/yallop_bugs.ml	2011-11-24 09:02:48.000000000 +0000
@@ -0,0 +1,45 @@
+(* Injectivity *)
+
+type (_, _) eq = Refl : ('a, 'a) eq
+
+let magic : 'a 'b. 'a -> 'b =
+  fun (type a) (type b) (x : a) ->
+    let module M =
+      (functor (T : sig type 'a t end) ->
+       struct
+         let f (Refl : (a T.t, b T.t) eq) = (x :> b)
+       end)
+        (struct type 'a t = unit end)
+    in M.f Refl
+;;
+
+(* Variance and subtyping *)
+
+type (_, +_) eq = Refl : ('a, 'a) eq
+
+let magic : 'a 'b. 'a -> 'b =
+  fun (type a) (type b) (x : a) ->
+    let bad_proof (type a) =
+      (Refl : (< m : a>, ) eq :> (, < >) eq) in
+    let downcast : type a. (a, < >) eq -> < > -> a =
+      fun (type a) (Refl : (a, < >) eq) (s : < >) -> (s :> a) in
+    (downcast bad_proof ((object method m = x end) :> < >)) # m
+;;
+
+(* Record patterns *)
+
+type _ t =
+  | IntLit : int t
+  | BoolLit : bool t
+
+let check : type s . s t * s -> bool = function
+  | BoolLit, false -> false
+  | IntLit , 6 -> false
+;;
+
+type ('a, 'b) pair = { fst : 'a; snd : 'b }
+
+let check : type s . (s t, s) pair -> bool = function
+  | {fst = BoolLit; snd = false} -> false
+  | {fst = IntLit ; snd =  6} -> false
+;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference ocaml-4.01.0/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference	2012-07-30 18:04:46.000000000 +0000
@@ -0,0 +1,29 @@
+
+#                           Characters 240-248:
+           let f (Refl : (a T.t, b T.t) eq) = (x :> b)
+                                              ^^^^^^^^
+Error: Type a is not a subtype of b 
+#                         Characters 36-67:
+  type (_, +_) eq = Refl : ('a, 'a) eq
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this GADT definition, the variance of some parameter
+       cannot be checked
+#                     Characters 115-175:
+  .......................................function
+    | BoolLit, false -> false
+    | IntLit , 6 -> false
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+(IntLit, 0)
+type _ t = IntLit : int t | BoolLit : bool t
+val check : 's t * 's -> bool = 
+#             Characters 91-180:
+  .............................................function
+    | {fst = BoolLit; snd = false} -> false
+    | {fst = IntLit ; snd =  6} -> false
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+{fst=IntLit; snd=0}
+type ('a, 'b) pair = { fst : 'a; snd : 'b; }
+val check : ('s t, 's) pair -> bool = 
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-gadts/yallop_bugs.ml.reference ocaml-4.01.0/testsuite/tests/typing-gadts/yallop_bugs.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-gadts/yallop_bugs.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-gadts/yallop_bugs.ml.reference	2012-07-30 18:04:46.000000000 +0000
@@ -0,0 +1,29 @@
+
+#                           Characters 240-248:
+           let f (Refl : (a T.t, b T.t) eq) = (x :> b)
+                                              ^^^^^^^^
+Error: Type a is not a subtype of b 
+#                         Characters 36-67:
+  type (_, +_) eq = Refl : ('a, 'a) eq
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this GADT definition, the variance of some parameter
+       cannot be checked
+#                     Characters 115-175:
+  .......................................function
+    | BoolLit, false -> false
+    | IntLit , 6 -> false
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+(IntLit, 0)
+type _ t = IntLit : int t | BoolLit : bool t
+val check : 's t * 's -> bool = 
+#             Characters 91-180:
+  .............................................function
+    | {fst = BoolLit; snd = false} -> false
+    | {fst = IntLit ; snd =  6} -> false
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+{fst=IntLit; snd=0}
+type ('a, 'b) pair = { fst : 'a; snd : 'b; }
+val check : ('s t, 's) pair -> bool = 
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-implicit_unpack/Makefile ocaml-4.01.0/testsuite/tests/typing-implicit_unpack/Makefile
--- ocaml-3.12.1/testsuite/tests/typing-implicit_unpack/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-implicit_unpack/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,15 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.toplevel
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml ocaml-4.01.0/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml
--- ocaml-3.12.1/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml	2012-07-30 18:04:46.000000000 +0000
@@ -0,0 +1,165 @@
+(*
+   Implicit unpack allows to omit the signature in (val ...) expressions.
+
+   It also adds (module M : S) and (module M) patterns, relying on
+   implicit (val ...) for the implementation. Such patterns can only
+   be used in function definition, match clauses, and let ... in.
+
+   New: implicit pack is also supported, and you only need to be able
+   to infer the the module type path from the context.
+ *)
+(* ocaml -principal *)
+
+(* Use a module pattern *)
+let sort (type s) (module Set : Set.S with type elt = s) l =
+  Set.elements (List.fold_right Set.add l Set.empty)
+
+(* No real improvement here? *)
+let make_set (type s) cmp : (module Set.S with type elt = s) =
+  (module Set.Make (struct type t = s let compare = cmp end))
+
+(* No type annotation here *)
+let sort_cmp (type s) cmp =
+  sort (module Set.Make (struct type t = s let compare = cmp end))
+
+module type S = sig type t val x : t end;;
+let f (module M : S with type t = int) = M.x;;
+let f (module M : S with type t = 'a) = M.x;; (* Error *)
+let f (type a) (module M : S with type t = a) = M.x;;
+f (module struct type t = int let x = 1 end);;
+
+type 'a s = {s: (module S with type t = 'a)};;
+{s=(module struct type t = int let x = 1 end)};;
+let f {s=(module M)} = M.x;; (* Error *)
+let f (type a) ({s=(module M)} : a s) = M.x;;
+
+type s = {s: (module S with type t = int)};;
+let f {s=(module M)} = M.x;;
+let f {s=(module M)} {s=(module N)} = M.x + N.x;;
+
+module type S = sig val x : int end;;
+let f (module M : S) y (module N : S) = M.x + y + N.x;;
+let m = (module struct let x = 3 end);; (* Error *)
+let m = (module struct let x = 3 end : S);;
+f m 1 m;;
+f m 1 (module struct let x = 2 end);;
+
+let (module M) = m in M.x;;
+let (module M) = m;; (* Error: only allowed in [let .. in] *)
+class c = let (module M) = m in object end;; (* Error again *)
+module M = (val m);;
+
+module type S' = sig val f : int -> int end;;
+(* Even works with recursion, but must be fully explicit *)
+let rec (module M : S') =
+  (module struct let f n = if n <= 0 then 1 else n * M.f (n-1) end : S')
+in M.f 3;;
+
+(* Subtyping *)
+
+module type S = sig type t type u val x : t * u end
+let f (l : (module S with type t = int and type u = bool) list) =
+  (l :> (module S with type u = bool) list)
+
+(* GADTs from the manual *)
+(* the only modification is in to_string *)
+
+module TypEq : sig
+  type ('a, 'b) t
+  val apply: ('a, 'b) t -> 'a -> 'b
+  val refl: ('a, 'a) t
+  val sym: ('a, 'b) t -> ('b, 'a) t
+end = struct
+  type ('a, 'b) t = ('a -> 'b) * ('b -> 'a)
+  let refl = (fun x -> x), (fun x -> x)
+  let apply (f, _) x = f x
+  let sym (f, g) = (g, f)
+end
+
+module rec Typ : sig
+  module type PAIR = sig
+    type t and t1 and t2
+    val eq: (t, t1 * t2) TypEq.t
+    val t1: t1 Typ.typ
+    val t2: t2 Typ.typ
+  end
+
+  type 'a typ =
+    | Int of ('a, int) TypEq.t
+    | String of ('a, string) TypEq.t
+    | Pair of (module PAIR with type t = 'a)
+end = Typ
+
+let int = Typ.Int TypEq.refl
+
+let str = Typ.String TypEq.refl
+
+let pair (type s1) (type s2) t1 t2 =
+  let module P = struct
+    type t = s1 * s2
+    type t1 = s1
+    type t2 = s2
+    let eq = TypEq.refl
+    let t1 = t1
+    let t2 = t2
+  end in
+  Typ.Pair (module P)
+
+open Typ
+let rec to_string: 'a. 'a Typ.typ -> 'a -> string =
+  fun (type s) t x ->
+    match (t : s typ) with
+    | Int eq -> string_of_int (TypEq.apply eq x)
+    | String eq -> Printf.sprintf "%S" (TypEq.apply eq x)
+    | Pair (module P) ->
+        let (x1, x2) = TypEq.apply P.eq x in
+        Printf.sprintf "(%s,%s)" (to_string P.t1 x1) (to_string P.t2 x2)
+
+(* Wrapping maps *)
+module type MapT = sig
+  include Map.S
+  type data
+  type map
+  val of_t : data t -> map
+  val to_t : map -> data t
+end
+
+type ('k,'d,'m) map =
+    (module MapT with type key = 'k and type data = 'd and type map = 'm)
+
+let add (type k) (type d) (type m) (m:(k,d,m) map) x y s =
+   let module M =
+     (val m:MapT with type key = k and type data = d and type map = m) in
+   M.of_t (M.add x y (M.to_t s))
+
+module SSMap = struct
+  include Map.Make(String)
+  type data = string
+  type map = data t
+  let of_t x = x
+  let to_t x = x
+end
+
+let ssmap =
+  (module SSMap:
+   MapT with type key = string and type data = string and type map = SSMap.map)
+;;
+
+let ssmap =
+  (module struct include SSMap end :
+   MapT with type key = string and type data = string and type map = SSMap.map)
+;;
+
+let ssmap =
+  (let module S = struct include SSMap end in (module S) :
+  (module
+   MapT with type key = string and type data = string and type map = SSMap.map))
+;;
+
+let ssmap =
+  (module SSMap: MapT with type key = _ and type data = _ and type map = _)
+;;
+
+let ssmap : (_,_,_) map = (module SSMap);;
+
+add ssmap;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml.reference ocaml-4.01.0/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml.reference	2012-07-30 18:04:46.000000000 +0000
@@ -0,0 +1,166 @@
+
+# * * * * * * * * *                               val sort : (module Set.S with type elt = 'a) -> 'a list -> 'a list = 
+val make_set : ('a -> 'a -> int) -> (module Set.S with type elt = 'a) = 
+val sort_cmp : ('a -> 'a -> int) -> 'a list -> 'a list = 
+module type S = sig type t val x : t end
+# val f : (module S with type t = int) -> int = 
+# Characters 6-37:
+  let f (module M : S with type t = 'a) = M.x;; (* Error *)
+        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The type of this packed module contains variables:
+(module S with type t = 'a)
+# val f : (module S with type t = 'a) -> 'a = 
+# - : int = 1
+#   type 'a s = { s : (module S with type t = 'a); }
+# - : int s = {s = }
+# Characters 9-19:
+  let f {s=(module M)} = M.x;; (* Error *)
+           ^^^^^^^^^^
+Error: The type of this packed module contains variables:
+(module S with type t = 'a)
+# val f : 'a s -> 'a = 
+#   type s = { s : (module S with type t = int); }
+# val f : s -> int = 
+# val f : s -> s -> int = 
+#   module type S = sig val x : int end
+# val f : (module S) -> int -> (module S) -> int = 
+# Characters 8-37:
+  let m = (module struct let x = 3 end);; (* Error *)
+          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The signature for this packaged module couldn't be inferred.
+# val m : (module S) = 
+# - : int = 7
+# - : int = 6
+#   - : int = 3
+# Characters 4-14:
+  let (module M) = m;; (* Error: only allowed in [let .. in] *)
+      ^^^^^^^^^^
+Error: Modules are not allowed in this pattern.
+# Characters 14-24:
+  class c = let (module M) = m in object end;; (* Error again *)
+                ^^^^^^^^^^
+Error: Modules are not allowed in this pattern.
+# module M : S
+#   module type S' = sig val f : int -> int end
+#       - : int = 6
+#                                                                                                                                                                                   module type S = sig type t type u val x : t * u end
+val f :
+  (module S with type t = int and type u = bool) list ->
+  (module S with type u = bool) list = 
+module TypEq :
+  sig
+    type ('a, 'b) t
+    val apply : ('a, 'b) t -> 'a -> 'b
+    val refl : ('a, 'a) t
+    val sym : ('a, 'b) t -> ('b, 'a) t
+  end
+module rec Typ :
+  sig
+    module type PAIR =
+      sig
+        type t
+        and t1
+        and t2
+        val eq : (t, t1 * t2) TypEq.t
+        val t1 : t1 Typ.typ
+        val t2 : t2 Typ.typ
+      end
+    type 'a typ =
+        Int of ('a, int) TypEq.t
+      | String of ('a, string) TypEq.t
+      | Pair of (module PAIR with type t = 'a)
+  end
+val int : int Typ.typ = Int 
+val str : string Typ.typ = String 
+val pair : 'a Typ.typ -> 'b Typ.typ -> ('a * 'b) Typ.typ = 
+val to_string : 'a Typ.typ -> 'a -> string = 
+module type MapT =
+  sig
+    type key
+    type +'a t
+    val empty : 'a t
+    val is_empty : 'a t -> bool
+    val mem : key -> 'a t -> bool
+    val add : key -> 'a -> 'a t -> 'a t
+    val singleton : key -> 'a -> 'a t
+    val remove : key -> 'a t -> 'a t
+    val merge :
+      (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+    val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
+    val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+    val iter : (key -> 'a -> unit) -> 'a t -> unit
+    val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val for_all : (key -> 'a -> bool) -> 'a t -> bool
+    val exists : (key -> 'a -> bool) -> 'a t -> bool
+    val filter : (key -> 'a -> bool) -> 'a t -> 'a t
+    val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+    val cardinal : 'a t -> int
+    val bindings : 'a t -> (key * 'a) list
+    val min_binding : 'a t -> key * 'a
+    val max_binding : 'a t -> key * 'a
+    val choose : 'a t -> key * 'a
+    val split : key -> 'a t -> 'a t * 'a option * 'a t
+    val find : key -> 'a t -> 'a
+    val map : ('a -> 'b) -> 'a t -> 'b t
+    val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
+    type data
+    type map
+    val of_t : data t -> map
+    val to_t : map -> data t
+  end
+type ('k, 'd, 'm) map =
+    (module MapT with type data = 'd and type key = 'k and type map = 'm)
+val add : ('a, 'b, 'c) map -> 'a -> 'b -> 'c -> 'c = 
+module SSMap :
+  sig
+    type key = String.t
+    type 'a t = 'a Map.Make(String).t
+    val empty : 'a t
+    val is_empty : 'a t -> bool
+    val mem : key -> 'a t -> bool
+    val add : key -> 'a -> 'a t -> 'a t
+    val singleton : key -> 'a -> 'a t
+    val remove : key -> 'a t -> 'a t
+    val merge :
+      (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+    val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
+    val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+    val iter : (key -> 'a -> unit) -> 'a t -> unit
+    val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val for_all : (key -> 'a -> bool) -> 'a t -> bool
+    val exists : (key -> 'a -> bool) -> 'a t -> bool
+    val filter : (key -> 'a -> bool) -> 'a t -> 'a t
+    val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+    val cardinal : 'a t -> int
+    val bindings : 'a t -> (key * 'a) list
+    val min_binding : 'a t -> key * 'a
+    val max_binding : 'a t -> key * 'a
+    val choose : 'a t -> key * 'a
+    val split : key -> 'a t -> 'a t * 'a option * 'a t
+    val find : key -> 'a t -> 'a
+    val map : ('a -> 'b) -> 'a t -> 'b t
+    val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
+    type data = string
+    type map = data t
+    val of_t : 'a -> 'a
+    val to_t : 'a -> 'a
+  end
+val ssmap :
+  (module MapT with type data = string and type key = string and type map = 
+   SSMap.map) =
+  
+#         val ssmap :
+  (module MapT with type data = string and type key = string and type map = 
+   SSMap.map) =
+  
+#           val ssmap :
+  (module MapT with type data = string and type key = string and type map = 
+   SSMap.map) =
+  
+#       val ssmap :
+  (module MapT with type data = SSMap.data and type key = SSMap.key and type map = 
+   SSMap.map) =
+  
+#   val ssmap : (SSMap.key, SSMap.data, SSMap.map) map = 
+#   - : SSMap.key -> SSMap.data -> SSMap.map -> SSMap.map = 
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-labels/.svnignore ocaml-4.01.0/testsuite/tests/typing-labels/.svnignore
--- ocaml-3.12.1/testsuite/tests/typing-labels/.svnignore	2011-05-17 12:08:13.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-labels/.svnignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,10 +0,0 @@
-#!/bin/sh
-
-svn propset svn:ignore -F - . < 'a -> bool = 
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-misc/labels.ml ocaml-4.01.0/testsuite/tests/typing-misc/labels.ml
--- ocaml-3.12.1/testsuite/tests/typing-misc/labels.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-misc/labels.ml	2012-12-27 03:15:09.000000000 +0000
@@ -0,0 +1,4 @@
+(* PR#5835 *)
+
+let f ~x = x + 1;;
+f ?x:0;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-misc/labels.ml.principal.reference ocaml-4.01.0/testsuite/tests/typing-misc/labels.ml.principal.reference
--- ocaml-3.12.1/testsuite/tests/typing-misc/labels.ml.principal.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-misc/labels.ml.principal.reference	2013-02-19 03:12:36.000000000 +0000
@@ -0,0 +1,8 @@
+
+#     val f : x:int -> int = 
+# Characters 5-6:
+  f ?x:0;;
+       ^
+Warning 43: the label x is not optional.
+- : int = 1
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-misc/labels.ml.reference ocaml-4.01.0/testsuite/tests/typing-misc/labels.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-misc/labels.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-misc/labels.ml.reference	2013-02-19 03:12:36.000000000 +0000
@@ -0,0 +1,8 @@
+
+#     val f : x:int -> int = 
+# Characters 5-6:
+  f ?x:0;;
+       ^
+Warning 43: the label x is not optional.
+- : int = 1
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-misc/occur_check.ml ocaml-4.01.0/testsuite/tests/typing-misc/occur_check.ml
--- ocaml-3.12.1/testsuite/tests/typing-misc/occur_check.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-misc/occur_check.ml	2013-01-26 01:43:11.000000000 +0000
@@ -0,0 +1,5 @@
+(* PR#5907 *)
+
+type 'a t = 'a;;
+let f (g : 'a list -> 'a t -> 'a) s = g s s;;
+let f (g : 'a * 'b -> 'a t -> 'a) s = g s s;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-misc/occur_check.ml.reference ocaml-4.01.0/testsuite/tests/typing-misc/occur_check.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-misc/occur_check.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-misc/occur_check.ml.reference	2013-01-26 01:43:11.000000000 +0000
@@ -0,0 +1,15 @@
+
+#     type 'a t = 'a
+# Characters 42-43:
+  let f (g : 'a list -> 'a t -> 'a) s = g s s;;
+                                            ^
+Error: This expression has type 'a list
+       but an expression was expected of type 'a t = 'a
+       The type variable 'a occurs inside 'a list
+# Characters 42-43:
+  let f (g : 'a * 'b -> 'a t -> 'a) s = g s s;;
+                                            ^
+Error: This expression has type 'a * 'b
+       but an expression was expected of type 'a t = 'a
+       The type variable 'a occurs inside 'a * 'b
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-misc/polyvars.ml ocaml-4.01.0/testsuite/tests/typing-misc/polyvars.ml
--- ocaml-3.12.1/testsuite/tests/typing-misc/polyvars.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-misc/polyvars.ml	2013-01-15 05:22:28.000000000 +0000
@@ -0,0 +1,7 @@
+type ab = [ `A | `B ];;
+let f (x : [`A]) = match x with #ab -> 1;;
+let f x = ignore (match x with #ab -> 1); ignore (x : [`A]);;
+let f x = ignore (match x with `A|`B -> 1); ignore (x : [`A]);;
+
+let f (x : [< `A | `B]) = match x with `A | `B | `C -> 0;; (* warn *)
+let f (x : [`A | `B]) = match x with `A | `B | `C -> 0;; (* fail *)
diff -Nru ocaml-3.12.1/testsuite/tests/typing-misc/polyvars.ml.principal.reference ocaml-4.01.0/testsuite/tests/typing-misc/polyvars.ml.principal.reference
--- ocaml-3.12.1/testsuite/tests/typing-misc/polyvars.ml.principal.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-misc/polyvars.ml.principal.reference	2013-01-15 05:22:28.000000000 +0000
@@ -0,0 +1,32 @@
+
+# type ab = [ `A | `B ]
+# Characters 32-35:
+  let f (x : [`A]) = match x with #ab -> 1;;
+                                  ^^^
+Error: This pattern matches values of type [? `A | `B ]
+       but a pattern was expected which matches values of type [ `A ]
+       The second variant type does not allow tag(s) `B
+# Characters 31-34:
+  let f x = ignore (match x with #ab -> 1); ignore (x : [`A]);;
+                                 ^^^
+Error: This pattern matches values of type [? `B ]
+       but a pattern was expected which matches values of type [ `A ]
+       Types for tag `B are incompatible
+# Characters 34-36:
+  let f x = ignore (match x with `A|`B -> 1); ignore (x : [`A]);;
+                                    ^^
+Error: This pattern matches values of type [? `B ]
+       but a pattern was expected which matches values of type [ `A ]
+       Types for tag `B are incompatible
+#   Characters 50-52:
+  let f (x : [< `A | `B]) = match x with `A | `B | `C -> 0;; (* warn *)
+                                                   ^^
+Warning 12: this sub-pattern is unused.
+val f : [< `A | `B ] -> int = 
+# Characters 47-49:
+  let f (x : [`A | `B]) = match x with `A | `B | `C -> 0;; (* fail *)
+                                                 ^^
+Error: This pattern matches values of type [? `C ]
+       but a pattern was expected which matches values of type [ `A | `B ]
+       The second variant type does not allow tag(s) `C
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-misc/polyvars.ml.reference ocaml-4.01.0/testsuite/tests/typing-misc/polyvars.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-misc/polyvars.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-misc/polyvars.ml.reference	2013-01-15 05:22:28.000000000 +0000
@@ -0,0 +1,32 @@
+
+# type ab = [ `A | `B ]
+# Characters 32-35:
+  let f (x : [`A]) = match x with #ab -> 1;;
+                                  ^^^
+Error: This pattern matches values of type [? `A | `B ]
+       but a pattern was expected which matches values of type [ `A ]
+       The second variant type does not allow tag(s) `B
+# Characters 31-34:
+  let f x = ignore (match x with #ab -> 1); ignore (x : [`A]);;
+                                 ^^^
+Error: This pattern matches values of type [? `B ]
+       but a pattern was expected which matches values of type [ `A ]
+       The second variant type does not allow tag(s) `B
+# Characters 34-36:
+  let f x = ignore (match x with `A|`B -> 1); ignore (x : [`A]);;
+                                    ^^
+Error: This pattern matches values of type [? `B ]
+       but a pattern was expected which matches values of type [ `A ]
+       The second variant type does not allow tag(s) `B
+#   Characters 50-52:
+  let f (x : [< `A | `B]) = match x with `A | `B | `C -> 0;; (* warn *)
+                                                   ^^
+Warning 12: this sub-pattern is unused.
+val f : [< `A | `B ] -> int = 
+# Characters 47-49:
+  let f (x : [`A | `B]) = match x with `A | `B | `C -> 0;; (* fail *)
+                                                 ^^
+Error: This pattern matches values of type [? `C ]
+       but a pattern was expected which matches values of type [ `A | `B ]
+       The second variant type does not allow tag(s) `C
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-misc/records.ml ocaml-4.01.0/testsuite/tests/typing-misc/records.ml
--- ocaml-3.12.1/testsuite/tests/typing-misc/records.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-misc/records.ml	2012-12-27 02:34:49.000000000 +0000
@@ -0,0 +1,38 @@
+(* undefined labels *)
+type t = {x:int;y:int};;
+{x=3;z=2};;
+fun {x=3;z=2} -> ();;
+
+(* mixed labels *)
+{x=3; contents=2};;
+
+(* private types *)
+type u = private {mutable u:int};;
+{u=3};;
+fun x -> x.u <- 3;;
+
+(* Punning and abbreviations *)
+module M = struct
+  type t = {x: int; y: int}
+end;;
+
+let f {M.x; y} = x+y;;
+let r = {M.x=1; y=2};;
+let z = f r;;
+
+(* messages *)
+type foo = { mutable y:int };;
+let f (r: int) = r.y <- 3;;
+
+(* bugs *)
+type foo = { y: int; z: int };;
+type bar = { x: int };;
+let f (r: bar) = ({ r with z = 3 } : foo)
+
+type foo = { x: int };;
+let r : foo = { ZZZ.x = 2 };;
+
+(ZZZ.X : int option);;
+
+(* PR#5865 *)
+let f (x : Complex.t) = x.Complex.z;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-misc/records.ml.principal.reference ocaml-4.01.0/testsuite/tests/typing-misc/records.ml.principal.reference
--- ocaml-3.12.1/testsuite/tests/typing-misc/records.ml.principal.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-misc/records.ml.principal.reference	2012-12-27 02:34:49.000000000 +0000
@@ -0,0 +1,54 @@
+
+#   type t = { x : int; y : int; }
+# Characters 5-6:
+  {x=3;z=2};;
+       ^
+Error: Unbound record field z
+# Characters 9-10:
+  fun {x=3;z=2} -> ();;
+           ^
+Error: Unbound record field z
+#     Characters 26-34:
+  {x=3; contents=2};;
+        ^^^^^^^^
+Error: The record field contents belongs to the type 'a ref
+       but is mixed here with fields of type t
+#     type u = private { mutable u : int; }
+# Characters 0-5:
+  {u=3};;
+  ^^^^^
+Error: Cannot create values of the private type u
+# Characters 11-12:
+  fun x -> x.u <- 3;;
+             ^
+Error: Cannot assign field u of the private type u
+#         module M : sig type t = { x : int; y : int; } end
+#   val f : M.t -> int = 
+# val r : M.t = {M.x = 1; y = 2}
+# val z : int = 3
+#     type foo = { mutable y : int; }
+# Characters 17-18:
+  let f (r: int) = r.y <- 3;;
+                   ^
+Error: This expression has type int but an expression was expected of type
+         foo
+#     type foo = { y : int; z : int; }
+# type bar = { x : int; }
+#     Characters 20-21:
+  let f (r: bar) = ({ r with z = 3 } : foo)
+                      ^
+Error: This expression has type bar but an expression was expected of type
+         foo
+# Characters 16-21:
+  let r : foo = { ZZZ.x = 2 };;
+                  ^^^^^
+Error: Unbound module ZZZ
+#   Characters 2-7:
+  (ZZZ.X : int option);;
+   ^^^^^
+Error: Unbound module ZZZ
+#     Characters 41-50:
+  let f (x : Complex.t) = x.Complex.z;;
+                            ^^^^^^^^^
+Error: Unbound record field Complex.z
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-misc/records.ml.reference ocaml-4.01.0/testsuite/tests/typing-misc/records.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-misc/records.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-misc/records.ml.reference	2012-12-27 02:34:49.000000000 +0000
@@ -0,0 +1,54 @@
+
+#   type t = { x : int; y : int; }
+# Characters 5-6:
+  {x=3;z=2};;
+       ^
+Error: Unbound record field z
+# Characters 9-10:
+  fun {x=3;z=2} -> ();;
+           ^
+Error: Unbound record field z
+#     Characters 26-34:
+  {x=3; contents=2};;
+        ^^^^^^^^
+Error: The record field contents belongs to the type 'a ref
+       but is mixed here with fields of type t
+#     type u = private { mutable u : int; }
+# Characters 0-5:
+  {u=3};;
+  ^^^^^
+Error: Cannot create values of the private type u
+# Characters 11-12:
+  fun x -> x.u <- 3;;
+             ^
+Error: Cannot assign field u of the private type u
+#         module M : sig type t = { x : int; y : int; } end
+#   val f : M.t -> int = 
+# val r : M.t = {M.x = 1; y = 2}
+# val z : int = 3
+#     type foo = { mutable y : int; }
+# Characters 17-18:
+  let f (r: int) = r.y <- 3;;
+                   ^
+Error: This expression has type int but an expression was expected of type
+         foo
+#     type foo = { y : int; z : int; }
+# type bar = { x : int; }
+#     Characters 20-21:
+  let f (r: bar) = ({ r with z = 3 } : foo)
+                      ^
+Error: This expression has type bar but an expression was expected of type
+         foo
+# Characters 16-21:
+  let r : foo = { ZZZ.x = 2 };;
+                  ^^^^^
+Error: Unbound module ZZZ
+#   Characters 2-7:
+  (ZZZ.X : int option);;
+   ^^^^^
+Error: Unbound module ZZZ
+#     Characters 41-50:
+  let f (x : Complex.t) = x.Complex.z;;
+                            ^^^^^^^^^
+Error: Unbound record field Complex.z
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-modules/Makefile ocaml-4.01.0/testsuite/tests/typing-modules/Makefile
--- ocaml-3.12.1/testsuite/tests/typing-modules/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-modules/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,14 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
 include ../../makefiles/Makefile.toplevel
 include ../../makefiles/Makefile.common
-
diff -Nru ocaml-3.12.1/testsuite/tests/typing-modules/Test.ml ocaml-4.01.0/testsuite/tests/typing-modules/Test.ml
--- ocaml-3.12.1/testsuite/tests/typing-modules/Test.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-modules/Test.ml	2013-06-17 01:54:50.000000000 +0000
@@ -1,5 +1,56 @@
+(* with module *)
+
 module type S = sig type t and s = t end;;
 module type S' = S with type t := int;;
 
 module type S = sig module rec M : sig end and N : sig end end;;
 module type S' = S with module M := String;;
+
+(* with module type *)
+(*
+module type S = sig module type T module F(X:T) : T end;;
+module type T0 = sig type t end;;
+module type S1 = S with module type T = T0;;
+module type S2 = S with module type T := T0;;
+module type S3 = S with module type T := sig type t = int end;;
+module H = struct
+  include (Hashtbl : module type of Hashtbl with
+           type statistics := Hashtbl.statistics
+           and module type S := Hashtbl.S
+           and module Make := Hashtbl.Make
+           and module MakeSeeded := Hashtbl.MakeSeeded
+           and module type SeededS := Hashtbl.SeededS
+           and module type HashedType := Hashtbl.HashedType
+           and module type SeededHashedType := Hashtbl.SeededHashedType)
+end;;
+*)
+
+(* A subtle problem appearing with -principal *)
+type -'a t
+class type c = object method m : [ `A ] t end;;
+module M : sig val v : (#c as 'a) -> 'a end =
+  struct let v x = ignore (x :> c); x end;;
+
+(* PR#4838 *)
+
+let id = let module M = struct end in fun x -> x;;
+
+(* PR#4511 *)
+
+let ko = let module M = struct end in fun _ -> ();;
+
+(* PR#5993 *)
+
+module M : sig type -'a t = private int end =
+  struct type +'a t = private int end
+;;
+
+(* PR#6005 *)
+
+module type A = sig type t = X of int end;;
+type u = X of bool;;
+module type B = A with type t = u;; (* fail *)
+
+(* PR#5815 *)
+
+module type S = sig exception Foo of int  exception Foo of bool end;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-modules/Test.ml.principal.reference ocaml-4.01.0/testsuite/tests/typing-modules/Test.ml.principal.reference
--- ocaml-3.12.1/testsuite/tests/typing-modules/Test.ml.principal.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-modules/Test.ml.principal.reference	2013-06-17 01:54:50.000000000 +0000
@@ -0,0 +1,32 @@
+
+#     module type S = sig type t and s = t end
+# module type S' = sig type s = int end
+#   module type S = sig module rec M : sig  end and N : sig  end end
+# module type S' = sig module rec N : sig  end end
+#     * * * * * * * * * * * * * * * *         type -'a t
+class type c = object method m : [ `A ] t end
+#   module M : sig val v : (#c as 'a) -> 'a end
+#       val id : 'a -> 'a = 
+#       val ko : 'a -> unit = 
+#           Characters 64-99:
+    struct type +'a t = private int end
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type +'a t = private int end
+       is not included in
+         sig type -'a t = private int end
+       Type declarations do not match:
+         type +'a t = private int
+       is not included in
+         type -'a t = private int
+       Their variances do not agree.
+#       module type A = sig type t = X of int end
+# type u = X of bool
+# Characters 23-33:
+  module type B = A with type t = u;; (* fail *)
+                         ^^^^^^^^^^
+Error: This variant or record definition does not match that of type u
+       The types for field X are not equal.
+#       module type S = sig exception Foo of bool end
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-modules/Test.ml.reference ocaml-4.01.0/testsuite/tests/typing-modules/Test.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-modules/Test.ml.reference	2010-08-21 02:27:53.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-modules/Test.ml.reference	2013-06-17 01:54:50.000000000 +0000
@@ -1,6 +1,32 @@
 
-# module type S = sig type t and s = t end
+#     module type S = sig type t and s = t end
 # module type S' = sig type s = int end
 #   module type S = sig module rec M : sig  end and N : sig  end end
 # module type S' = sig module rec N : sig  end end
+#     * * * * * * * * * * * * * * * *         type -'a t
+class type c = object method m : [ `A ] t end
+#   module M : sig val v : (#c as 'a) -> 'a end
+#       val id : 'a -> 'a = 
+#       val ko : 'a -> unit = 
+#           Characters 64-99:
+    struct type +'a t = private int end
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type +'a t = private int end
+       is not included in
+         sig type -'a t = private int end
+       Type declarations do not match:
+         type +'a t = private int
+       is not included in
+         type -'a t = private int
+       Their variances do not agree.
+#       module type A = sig type t = X of int end
+# type u = X of bool
+# Characters 23-33:
+  module type B = A with type t = u;; (* fail *)
+                         ^^^^^^^^^^
+Error: This variant or record definition does not match that of type u
+       The types for field X are not equal.
+#       module type S = sig exception Foo of bool end
 # 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-modules/pr5911.ml ocaml-4.01.0/testsuite/tests/typing-modules/pr5911.ml
--- ocaml-3.12.1/testsuite/tests/typing-modules/pr5911.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-modules/pr5911.ml	2013-01-29 00:54:06.000000000 +0000
@@ -0,0 +1,14 @@
+module type S = sig
+ type t
+ val x : t
+end;;
+
+module Good (X : S with type t := unit) = struct
+ let () = X.x
+end;;
+
+module type T = sig module M : S end;;
+
+module Bad (X : T with type M.t := unit) = struct
+ let () = X.M.x
+end;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-modules/pr5911.ml.reference ocaml-4.01.0/testsuite/tests/typing-modules/pr5911.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-modules/pr5911.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-modules/pr5911.ml.reference	2013-01-29 00:54:06.000000000 +0000
@@ -0,0 +1,9 @@
+
+#       module type S = sig type t val x : t end
+#       module Good : functor (X : sig val x : unit end) -> sig  end
+#   module type T = sig module M : S end
+#       Characters 33-35:
+  module Bad (X : T with type M.t := unit) = struct
+                                  ^^
+Error: Syntax error
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-modules-bugs/Makefile ocaml-4.01.0/testsuite/tests/typing-modules-bugs/Makefile
--- ocaml-3.12.1/testsuite/tests/typing-modules-bugs/Makefile	2011-06-11 08:29:36.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-modules-bugs/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,2 +1,14 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
 include ../../makefiles/Makefile.okbad
 include ../../makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/typing-modules-bugs/pr5164_ok.ml ocaml-4.01.0/testsuite/tests/typing-modules-bugs/pr5164_ok.ml
--- ocaml-3.12.1/testsuite/tests/typing-modules-bugs/pr5164_ok.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-modules-bugs/pr5164_ok.ml	2012-07-30 18:04:46.000000000 +0000
@@ -1,7 +1,7 @@
 module type INCLUDING = sig
   include module type of List
   include module type of ListLabels
-end 
+end
 
 module Including_typed: INCLUDING = struct
   include List
diff -Nru ocaml-3.12.1/testsuite/tests/typing-modules-bugs/pr5914_ok.ml ocaml-4.01.0/testsuite/tests/typing-modules-bugs/pr5914_ok.ml
--- ocaml-3.12.1/testsuite/tests/typing-modules-bugs/pr5914_ok.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-modules-bugs/pr5914_ok.ml	2013-06-22 07:58:57.000000000 +0000
@@ -0,0 +1,18 @@
+type 't a = [ `A ]
+type 't wrap = 't constraint 't = [> 't wrap a ]
+type t = t a wrap
+
+module T = struct
+  let foo : 't wrap -> 't wrap -> unit = fun _ _ -> ()
+  let bar : ('a a wrap as 'a) = `A
+end
+
+module Good : sig
+  val bar: t
+  val foo: t -> t -> unit
+end = T
+
+module Bad : sig
+  val foo: t -> t -> unit
+  val bar: t
+end = T
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects/.svnignore ocaml-4.01.0/testsuite/tests/typing-objects/.svnignore
--- ocaml-3.12.1/testsuite/tests/typing-objects/.svnignore	2011-05-17 12:08:13.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects/.svnignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,10 +0,0 @@
-#!/bin/sh
-
-svn propset svn:ignore -F - . < int_comparable);;
-(new sorted_list ())#add c3;;   (* Echec : leq n'est pas binaire *)
+(new sorted_list ())#add c3;;   (* Error; strange message with -principal *)
 
 let sort (l : #comparable list) = Sort.list (fun x -> x#leq) l;;
 let pr l =
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects/Exemples.ml.principal.reference ocaml-4.01.0/testsuite/tests/typing-objects/Exemples.ml.principal.reference
--- ocaml-3.12.1/testsuite/tests/typing-objects/Exemples.ml.principal.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects/Exemples.ml.principal.reference	2013-02-09 08:42:11.000000000 +0000
@@ -0,0 +1,358 @@
+
+#           class point :
+  int ->
+  object val mutable x : int method get_x : int method move : int -> unit end
+#   val p : point = 
+#   - : int = 7
+# - : unit = ()
+# - : int = 10
+#   val q : < get_x : int; move : int -> unit > = 
+#   - : int * int = (10, 17)
+#           class color_point :
+  int ->
+  string ->
+  object
+    val c : string
+    val mutable x : int
+    method color : string
+    method get_x : int
+    method move : int -> unit
+  end
+#   val p' : color_point = 
+#   - : int * string = (5, "red")
+#   val l : point list = [; ]
+#   val get_x : < get_x : 'a; .. > -> 'a = 
+# val set_x : < set_x : 'a; .. > -> 'a = 
+# - : int list = [10; 5]
+#           Characters 7-96:
+  ......ref x_init = object
+    val mutable x = x_init
+    method get = x
+    method set y = x <- y
+  end..
+Error: Some type variables are unbound in this type:
+         class ref :
+           'a ->
+           object
+             val mutable x : 'a
+             method get : 'a
+             method set : 'a -> unit
+           end
+       The method get has type 'a where 'a is unbound
+#           class ref :
+  int ->
+  object val mutable x : int method get : int method set : int -> unit end
+#           class ['a] ref :
+  'a -> object val mutable x : 'a method get : 'a method set : 'a -> unit end
+#   - : int = 2
+#             class ['a] circle :
+  'a ->
+  object
+    constraint 'a = < move : int -> unit; .. >
+    val mutable center : 'a
+    method center : 'a
+    method move : int -> unit
+    method set_center : 'a -> unit
+  end
+#               class ['a] circle :
+  'a ->
+  object
+    constraint 'a = #point
+    val mutable center : 'a
+    method center : 'a
+    method move : int -> unit
+    method set_center : 'a -> unit
+  end
+#   val c : point circle = 
+val c' : < color : string; get_x : int; move : int -> unit > circle = 
+#           class ['a] color_circle :
+  'a ->
+  object
+    constraint 'a = #color_point
+    val mutable center : 'a
+    method center : 'a
+    method color : string
+    method move : int -> unit
+    method set_center : 'a -> unit
+  end
+#   Characters 28-29:
+  let c'' = new color_circle p;;
+                             ^
+Error: This expression has type point but an expression was expected of type
+         #color_point
+       The first object type has no method color
+# val c'' : color_point color_circle = 
+#   - : color_point circle = 
+# Characters 0-21:
+  (c'' :> point circle);;                 (* Echec *)
+  ^^^^^^^^^^^^^^^^^^^^^
+Error: Type
+         color_point color_circle =
+           < center : color_point; color : string; move : int -> unit;
+             set_center : color_point -> unit >
+       is not a subtype of
+         point circle =
+           < center : point; move : int -> unit; set_center : point -> unit > 
+       Type point is not a subtype of color_point 
+# Characters 9-55:
+  fun x -> (x : color_point color_circle :> point circle);;
+           ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type
+         color_point color_circle =
+           < center : color_point; color : string; move : int -> unit;
+             set_center : color_point -> unit >
+       is not a subtype of
+         point circle =
+           < center : point; move : int -> unit; set_center : point -> unit > 
+       Type point is not a subtype of color_point 
+#         class printable_point :
+  int ->
+  object
+    val mutable x : int
+    method get_x : int
+    method move : int -> unit
+    method print : unit
+  end
+#   val p : printable_point = 
+# 7- : unit = ()
+#                     Characters 85-102:
+    inherit printable_point y as super
+            ^^^^^^^^^^^^^^^^^
+Warning 13: the following instance variables are overridden by the class printable_point :
+  x
+The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
+class printable_color_point :
+  int ->
+  string ->
+  object
+    val c : string
+    val mutable x : int
+    method color : string
+    method get_x : int
+    method move : int -> unit
+    method print : unit
+  end
+#   val p' : printable_color_point = 
+# (7, red)- : unit = ()
+#           class functional_point :
+  int ->
+  object ('a) val x : int method get_x : int method move : int -> 'a end
+#   val p : functional_point = 
+#   - : int = 7
+# - : int = 10
+# - : int = 7
+#   - : #functional_point -> functional_point = 
+#                                                                       class virtual ['a] lst :
+  unit ->
+  object
+    method virtual hd : 'a
+    method iter : ('a -> unit) -> unit
+    method map : ('a -> 'a) -> 'a lst
+    method virtual null : bool
+    method print : ('a -> unit) -> unit
+    method virtual tl : 'a lst
+  end
+and ['a] nil :
+  unit ->
+  object
+    method hd : 'a
+    method iter : ('a -> unit) -> unit
+    method map : ('a -> 'a) -> 'a lst
+    method null : bool
+    method print : ('a -> unit) -> unit
+    method tl : 'a lst
+  end
+and ['a] cons :
+  'a ->
+  'a lst ->
+  object
+    val h : 'a
+    val t : 'a lst
+    method hd : 'a
+    method iter : ('a -> unit) -> unit
+    method map : ('a -> 'a) -> 'a lst
+    method null : bool
+    method print : ('a -> unit) -> unit
+    method tl : 'a lst
+  end
+#   val l1 : int lst = 
+#   (3::10::[])- : unit = ()
+#   val l2 : int lst = 
+# (4::11::[])- : unit = ()
+#       val map_list : ('a -> 'b) -> 'a lst -> 'b lst = 
+#   val p1 : printable_color_point lst = 
+# ((3, red)::(10, red)::[])- : unit = ()
+#           class virtual comparable :
+  unit -> object ('a) method virtual leq : 'a -> bool end
+#             class int_comparable :
+  int -> object ('a) val x : int method leq : 'a -> bool method x : int end
+#           class int_comparable2 :
+  int ->
+  object ('a)
+    val x : int
+    val mutable x' : int
+    method leq : 'a -> bool
+    method set_x : int -> unit
+    method x : int
+  end
+#                         class ['a] sorted_list :
+  unit ->
+  object
+    constraint 'a = #comparable
+    val mutable l : 'a list
+    method add : 'a -> unit
+    method hd : 'a
+  end
+#   val l : _#comparable sorted_list = 
+# val c : int_comparable = 
+# - : unit = ()
+#   val c2 : int_comparable2 = 
+# Characters 6-28:
+  l#add (c2 :> int_comparable);;      (* Echec : 'a comp2 n'est un sous-type *)
+        ^^^^^^^^^^^^^^^^^^^^^^
+Error: Type
+         int_comparable2 =
+           < leq : int_comparable2 -> bool; set_x : int -> unit; x : int >
+       is not a subtype of
+         int_comparable = < leq : int_comparable -> bool; x : int > 
+       Type int_comparable = < leq : int_comparable -> bool; x : int >
+       is not a subtype of
+         int_comparable2 =
+           < leq : int_comparable2 -> bool; set_x : int -> unit; x : int > 
+# - : unit = ()
+#             class int_comparable3 :
+  int ->
+  object
+    val mutable x : int
+    method leq : int_comparable -> bool
+    method setx : int -> unit
+    method x : int
+  end
+#   val c3 : int_comparable3 = 
+# - : unit = ()
+# Characters 25-27:
+  (new sorted_list ())#add c3;;   (* Error; strange message with -principal *)
+                           ^^
+Error: This expression has type
+         int_comparable3 =
+           < leq : int_comparable -> bool; setx : int -> unit; x : int >
+       but an expression was expected of type
+         #comparable as 'a = < leq : 'a -> bool; .. >
+       Type int_comparable = < leq : int_comparable -> bool; x : int >
+       is not compatible with type 'a = < leq : 'a -> bool; .. > 
+       The first object type has no method setx
+#   val sort : (#comparable as 'a) list -> 'a list = 
+#     Characters 13-66:
+    List.map (fun c -> print_int c#x; print_string " ") l;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 10: this expression should have type unit.
+val pr : < x : int; .. > list -> unit = 
+#   val l : int_comparable list = [; ; ]
+# 5 2 4 
+- : unit = ()
+# 2 4 5 
+- : unit = ()
+# val l : int_comparable2 list = [; ]
+# 2 0 
+- : unit = ()
+# 0 2 
+- : unit = ()
+#     val min : (#comparable as 'a) -> 'a -> 'a = 
+#   - : int = 7
+# - : int = 3
+#                                 class ['a] link :
+  'a ->
+  object ('b)
+    val mutable next : 'b option
+    val mutable x : 'a
+    method append : 'b option -> unit
+    method next : 'b option
+    method set_next : 'b option -> unit
+    method set_x : 'a -> unit
+    method x : 'a
+  end
+#                   class ['a] double_link :
+  'a ->
+  object ('b)
+    val mutable next : 'b option
+    val mutable prev : 'b option
+    val mutable x : 'a
+    method append : 'b option -> unit
+    method next : 'b option
+    method prev : 'b option
+    method set_next : 'b option -> unit
+    method set_prev : 'b option -> unit
+    method set_x : 'a -> unit
+    method x : 'a
+  end
+#           val fold_right : ('a -> 'b -> 'b) -> 'a #link option -> 'b -> 'b = 
+#                                       class calculator :
+  unit ->
+  object ('a)
+    val mutable acc : float
+    val mutable arg : float
+    val mutable equals : 'a -> float
+    method acc : float
+    method add : 'a
+    method arg : float
+    method enter : float -> 'a
+    method equals : float
+    method sub : 'a
+  end
+#   - : float = 5.
+# - : float = 1.5
+# - : float = 15.
+#                       class calculator :
+  unit ->
+  object ('a)
+    val mutable acc : float
+    val mutable arg : float
+    val mutable equals : 'a -> float
+    method acc : float
+    method add : 'a
+    method arg : float
+    method enter : float -> 'a
+    method equals : float
+    method sub : 'a
+  end
+#   - : float = 5.
+# - : float = 1.5
+# - : float = 15.
+#                                 class calculator :
+  float ->
+  float ->
+  object
+    val acc : float
+    val arg : float
+    method add : calculator
+    method enter : float -> calculator
+    method equals : float
+    method sub : calculator
+  end
+and calculator_add :
+  float ->
+  float ->
+  object
+    val acc : float
+    val arg : float
+    method add : calculator
+    method enter : float -> calculator
+    method equals : float
+    method sub : calculator
+  end
+and calculator_sub :
+  float ->
+  float ->
+  object
+    val acc : float
+    val arg : float
+    method add : calculator
+    method enter : float -> calculator
+    method equals : float
+    method sub : calculator
+  end
+#   val calculator : calculator = 
+#   - : float = 5.
+# - : float = 1.5
+# - : float = 15.
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects/Exemples.ml.reference ocaml-4.01.0/testsuite/tests/typing-objects/Exemples.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-objects/Exemples.ml.reference	2010-06-18 10:27:18.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects/Exemples.ml.reference	2013-02-09 08:42:11.000000000 +0000
@@ -93,7 +93,7 @@
        is not a subtype of
          point circle =
            < center : point; move : int -> unit; set_center : point -> unit > 
-Type point = point is not a subtype of color_point = color_point 
+       Type point is not a subtype of color_point 
 # Characters 9-55:
   fun x -> (x : color_point color_circle :> point circle);;
            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
@@ -104,7 +104,7 @@
        is not a subtype of
          point circle =
            < center : point; move : int -> unit; set_center : point -> unit > 
-Type point = point is not a subtype of color_point = color_point 
+       Type point is not a subtype of color_point 
 #         class printable_point :
   int ->
   object
@@ -215,10 +215,10 @@
            < leq : int_comparable2 -> bool; set_x : int -> unit; x : int >
        is not a subtype of
          int_comparable = < leq : int_comparable -> bool; x : int > 
-Type int_comparable = < leq : int_comparable -> bool; x : int >
-is not a subtype of
-  int_comparable2 =
-    < leq : int_comparable2 -> bool; set_x : int -> unit; x : int > 
+       Type int_comparable = < leq : int_comparable -> bool; x : int >
+       is not a subtype of
+         int_comparable2 =
+           < leq : int_comparable2 -> bool; set_x : int -> unit; x : int > 
 # - : unit = ()
 #             class int_comparable3 :
   int ->
@@ -231,7 +231,7 @@
 #   val c3 : int_comparable3 = 
 # - : unit = ()
 # Characters 25-27:
-  (new sorted_list ())#add c3;;   (* Echec : leq n'est pas binaire *)
+  (new sorted_list ())#add c3;;   (* Error; strange message with -principal *)
                            ^^
 Error: This expression has type
          int_comparable3 =
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects/Makefile ocaml-4.01.0/testsuite/tests/typing-objects/Makefile
--- ocaml-3.12.1/testsuite/tests/typing-objects/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,3 +1,15 @@
-include ../../makefiles/Makefile.toplevel
-include ../../makefiles/Makefile.common
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
 
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.toplevel
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects/Tests.ml ocaml-4.01.0/testsuite/tests/typing-objects/Tests.ml
--- ocaml-3.12.1/testsuite/tests/typing-objects/Tests.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects/Tests.ml	2012-07-30 18:04:46.000000000 +0000
@@ -159,7 +159,7 @@
 
 class c a = object val x = 1 val y = 1 val z = 1 val a = a end;;
 class d b = object val z = 2 val t = 2 val u = 2 val b = b end;;
-class e () = object 
+class e () = object
   val x = 3
   inherit c 5
   val y = 3
@@ -302,3 +302,33 @@
 let x = new d () in x#n, x#o;;
 
 class c () = object method virtual m : int method private m = 1 end;;
+
+(* Marshaling (cf. PR#5436) *)
+
+Oo.id (object end);;
+Oo.id (object end);;
+Oo.id (object end);;
+let o = object end in
+  let s = Marshal.to_string o [] in
+  let o' : < > = Marshal.from_string s 0 in
+  let o'' : < > = Marshal.from_string s 0 in
+  (Oo.id o, Oo.id o', Oo.id o'');;
+
+let o = object val x = 33 method m = x end in
+  let s = Marshal.to_string o [Marshal.Closures] in
+  let o' :  = Marshal.from_string s 0 in
+  let o'' :  = Marshal.from_string s 0 in
+  (Oo.id o, Oo.id o', Oo.id o'', o#m, o'#m);;
+
+let o = object val x = 33 val y = 44 method m = x end in
+  let s = Marshal.to_string o [Marshal.Closures] in
+  let o' :  = Marshal.from_string s 0 in
+  let o'' :  = Marshal.from_string s 0 in
+  (Oo.id o, Oo.id o', Oo.id o'', o#m, o'#m);;
+
+(* Recursion (cf. PR#5291) *)
+
+class a = let _ = new b in object end
+and b = let _ = new a in object end;;
+
+class a = let _ = new a in object end;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects/Tests.ml.principal.reference ocaml-4.01.0/testsuite/tests/typing-objects/Tests.ml.principal.reference
--- ocaml-3.12.1/testsuite/tests/typing-objects/Tests.ml.principal.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects/Tests.ml.principal.reference	2013-02-09 08:42:11.000000000 +0000
@@ -0,0 +1,312 @@
+
+#   - : < x : int > ->
+    < x : int > -> < x : int > -> < x : int > * < x : int > * < x : int >
+= 
+#               class ['a] c : unit -> object constraint 'a = int method f : int c end
+and ['a] d : unit -> object constraint 'a = int method f : int c end
+#                 Characters 238-275:
+  ........d () = object
+    inherit ['a] c ()
+  end..
+Error: Some type variables are unbound in this type:
+         class d : unit -> object method f : 'a -> unit end
+       The method f has type 'a -> unit where 'a is unbound
+#             class virtual c : unit -> object  end
+and ['a] d :
+  unit -> object constraint 'a = < x : int; .. > method f : 'a -> int end
+#                 class ['a] c : unit -> object constraint 'a = int end
+and ['a] d : unit -> object constraint 'a = int #c end
+# *             class ['a] c :
+  'a -> object ('a) constraint 'a = < f : 'a; .. > method f : 'a end
+# - : ('a c as 'a) -> 'a = 
+# *           Characters 134-176:
+  ......x () = object
+    method virtual f : int
+  end..
+Error: This class should be virtual. The following methods are undefined : f
+#               Characters 139-147:
+  class virtual c ((x : 'a): < f : int >) = object (_ : 'a) end
+                                                   ^^^^^^^^
+Error: This pattern cannot match self: it only matches values of type
+       < f : int >
+#           Characters 38-110:
+  ......['a] c () = object
+    constraint 'a = int
+    method f x = (x : bool c)
+  end..
+Error: The abbreviation c is used with parameters bool c
+       wich are incompatible with constraints int c
+#             class ['a, 'b] c :
+  unit ->
+  object
+    constraint 'a = int -> 'c
+    constraint 'b = 'a * < x : 'b > * 'c * 'd
+    method f : 'a -> 'b -> unit
+  end
+#     class ['a, 'b] d :
+  unit ->
+  object
+    constraint 'a = int -> 'c
+    constraint 'b = 'a * < x : 'b > * 'c * 'd
+    method f : 'a -> 'b -> unit
+  end
+#     val x : '_a list ref = {contents = []}
+#     Characters 6-50:
+  ......['a] c () = object
+    method f = (x : 'a)
+  end..
+Error: The type of this class,
+       class ['a] c :
+         unit -> object constraint 'a = '_b list ref method f : 'a end,
+       contains type variables that cannot be generalized
+#       Characters 24-52:
+  type 'a c = 
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In the definition of d, type int c should be 'a c
+#   type 'a c = < f : 'a c; g : 'a d >
+and 'a d = < f : 'a c >
+#   type 'a c = < f : 'a c >
+and 'a d = < f : int c >
+#   type 'a u = < x : 'a >
+and 'a t = 'a t u
+#   Characters 18-32:
+  and 'a t = 'a t u;;
+     ^^^^^^^^^^^^^^
+Error: The type abbreviation t is cyclic
+# type 'a u = 'a
+# Characters 5-18:
+  type t = t u * t u;;
+       ^^^^^^^^^^^^^
+Error: The type abbreviation t is cyclic
+#   type t = < x : 'a > as 'a
+# type 'a u = 'a
+# - : t -> t u -> bool = 
+# - : t -> t u -> bool = 
+#                         module M :
+  sig
+    class ['a, 'b] c :
+      int ->
+      'b ->
+      object
+        constraint 'a = int -> bool
+        val x : float list
+        val y : 'b
+        method f : 'a -> unit
+        method g : 'b
+      end
+  end
+#                   module M' :
+  sig
+    class virtual ['a, 'b] c :
+      int ->
+      'b ->
+      object
+        constraint 'a = int -> bool
+        val x : float list
+        val y : 'b
+        method f : 'a -> unit
+        method g : 'b
+      end
+  end
+# class ['a, 'b] d :
+  unit ->
+  'b ->
+  object
+    constraint 'a = int -> bool
+    val x : float list
+    val y : 'b
+    method f : 'a -> unit
+    method g : 'b
+  end
+# class ['a, 'b] e :
+  unit ->
+  'b ->
+  object
+    constraint 'a = int -> bool
+    val x : float list
+    val y : 'b
+    method f : 'a -> unit
+    method g : 'b
+  end
+# - : string = "a"
+# - : int = 10
+# - : float = 7.1
+# # - : bool = true
+#     module M : sig class ['a] c : unit -> object method f : 'a -> unit end end
+#   module M' : sig class ['a] c : unit -> object method f : 'a -> unit end end
+# - : ('a #M.c as 'b) -> 'b = 
+# - : ('a #M'.c as 'b) -> 'b = 
+# class ['a] c : 'a #c -> object  end
+# class ['a] c : 'a #c -> object  end
+#     class c : unit -> object method f : int end
+and d : unit -> object method f : int end
+# class e : unit -> object method f : int end
+# - : int = 2
+# Characters 30-34:
+  class c () = object val x = - true val y = -. () end;;
+                                ^^^^
+Error: This expression has type bool but an expression was expected of type
+         int
+#   class c : unit -> object method f : int method g : int method h : int end
+# class d : unit -> object method h : int method i : int method j : int end
+#               class e :
+  unit ->
+  object
+    method f : int
+    method g : int
+    method h : int
+    method i : int
+    method j : int
+  end
+# val e : e = 
+# - : int * int * int * int * int = (1, 3, 2, 2, 3)
+#   class c : 'a -> object val a : 'a val x : int val y : int val z : int end
+# class d : 'a -> object val b : 'a val t : int val u : int val z : int end
+#                             Characters 42-45:
+    inherit c 5
+            ^^^
+Warning 13: the following instance variables are overridden by the class c :
+  x
+The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
+Characters 52-53:
+    val y = 3
+        ^
+Warning 13: the instance variable y is overridden.
+The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
+Characters 80-83:
+    inherit d 7
+            ^^^
+Warning 13: the following instance variables are overridden by the class d :
+  t z
+The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
+Characters 90-91:
+    val u = 3
+        ^
+Warning 13: the instance variable u is overridden.
+The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
+class e :
+  unit ->
+  object
+    val a : int
+    val b : int
+    val t : int
+    val u : int
+    val x : int
+    val y : int
+    val z : int
+    method a : int
+    method b : int
+    method t : int
+    method u : int
+    method x : int
+    method y : int
+    method z : int
+  end
+# val e : e = 
+# - : int * int * int * int * int * int * int = (1, 3, 2, 2, 3, 5, 7)
+#             class c :
+  int ->
+  int -> object val x : int val y : int method x : int method y : int end
+# class d :
+  int ->
+  int -> object val x : int val y : int method x : int method y : int end
+# - : int * int = (1, 2)
+# - : int * int = (1, 2)
+#     class ['a] c : 'a -> object  end
+# - : 'a -> 'a c = 
+#     * * * * * * * * * * * * * * * * * * * * *                             module M : sig class c : unit -> object method xc : int end end
+#         class d : unit -> object val x : int method xc : int method xd : int end
+# - : int * int = (1, 2)
+#         Characters 7-156:
+  ......virtual ['a] matrix (sz, init : int * 'a) = object
+    val m = Array.create_matrix sz sz init
+    method add (mtx : 'a matrix) = (mtx#m.(0).(0) : 'a)
+  end..
+Error: The abbreviation 'a matrix expands to type < add : 'a matrix -> 'a >
+       but is used with type < m : 'a array array; .. >
+#   class c : unit -> object method m : c end
+# - : c = 
+# module M : sig class c : unit -> object method m : c end end
+# - : M.c = 
+#   type uu = A of int | B of (< leq : 'a > as 'a)
+#   class virtual c : unit -> object ('a) method virtual m : 'a end
+#         module S : sig val f : (#c as 'a) -> 'a end
+#         Characters 12-43:
+  ............struct
+    let f (x : #c) = x
+  end......
+Error: Signature mismatch:
+       Modules do not match:
+         sig val f : (#c as 'a) -> 'a end
+       is not included in
+         sig val f : #c -> #c end
+       Values do not match:
+         val f : (#c as 'a) -> 'a
+       is not included in
+         val f : #c -> #c
+#   Characters 32-55:
+  module M = struct type t = int class t () = object end end;;
+                                 ^^^^^^^^^^^^^^^^^^^^^^^
+Error: Multiple definition of the type name t.
+       Names must be unique in a given structure or signature.
+#   - : < m : (< m : 'a > as 'b) -> 'b as 'a; .. > -> 'b = 
+#   Characters 10-39:
+  fun x -> (x : int -> bool :> 'a -> 'a);;
+           ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type int -> bool is not a subtype of int -> int 
+       Type bool is not a subtype of int 
+# Characters 9-40:
+  fun x -> (x : int -> bool :> int -> int);;
+           ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type int -> bool is not a subtype of int -> int 
+       Type bool is not a subtype of int 
+# - : <  > -> <  > = 
+# - : < .. > -> <  > = 
+#   val x : '_a list ref = {contents = []}
+#   module F : functor (X : sig  end) -> sig type t = int end
+# - : < m : int > list ref = {contents = []}
+#   type 'a t
+# Characters 9-19:
+  fun (x : 'a t as 'a) -> ();;
+           ^^^^^^^^^^
+Error: This alias is bound to type 'a t but is used as an instance of type 'a
+       The type variable 'a occurs inside 'a t
+# Characters 19-20:
+  fun (x : 'a t) -> (x : 'a); ();;
+                     ^
+Error: This expression has type 'a t but an expression was expected of type
+         'a
+       The type variable 'a occurs inside 'a t
+# type 'a t = < x : 'a >
+# - : ('a t as 'a) -> unit = 
+# Characters 18-26:
+  fun (x : 'a t) -> (x : 'a); ();;
+                    ^^^^^^^^
+Warning 10: this expression should have type unit.
+- : ('a t as 'a) t -> unit = 
+#         class ['a] c :
+  unit ->
+  object constraint 'a = (< .. > as 'b) -> unit method m : 'b -> unit end
+#       class ['a] c :
+  unit ->
+  object constraint 'a = unit -> (< .. > as 'b) method m : 'a -> 'b end
+#         class c : unit -> object method private m : int method n : int end
+#         class d :
+  unit -> object method private m : int method n : int method o : int end
+#   - : int * int = (1, 1)
+#   class c : unit -> object method m : int end
+#       - : int = 16
+# - : int = 17
+# - : int = 18
+#         - : int * int * int = (19, 20, 21)
+#           - : int * int * int * int * int = (22, 23, 24, 33, 33)
+#           - : int * int * int * int * int = (25, 26, 27, 33, 33)
+#         Characters 42-69:
+  class a = let _ = new b in object end
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of recursive class expression is not allowed
+#   Characters 11-38:
+  class a = let _ = new a in object end;;
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of recursive class expression is not allowed
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects/Tests.ml.reference ocaml-4.01.0/testsuite/tests/typing-objects/Tests.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-objects/Tests.ml.reference	2010-06-18 10:27:18.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects/Tests.ml.reference	2013-02-09 08:42:11.000000000 +0000
@@ -134,8 +134,8 @@
 # # - : bool = true
 #     module M : sig class ['a] c : unit -> object method f : 'a -> unit end end
 #   module M' : sig class ['a] c : unit -> object method f : 'a -> unit end end
-# - : ('b #M.c as 'a) -> 'a = 
-# - : ('b #M'.c as 'a) -> 'a = 
+# - : ('a #M.c as 'b) -> 'b = 
+# - : ('a #M'.c as 'b) -> 'b = 
 # class ['a] c : 'a #c -> object  end
 # class ['a] c : 'a #c -> object  end
 #     class c : unit -> object method f : int end
@@ -162,26 +162,26 @@
 # - : int * int * int * int * int = (1, 3, 2, 2, 3)
 #   class c : 'a -> object val a : 'a val x : int val y : int val z : int end
 # class d : 'a -> object val b : 'a val t : int val u : int val z : int end
-#                             Characters 43-46:
+#                             Characters 42-45:
     inherit c 5
             ^^^
 Warning 13: the following instance variables are overridden by the class c :
   x
 The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
-Characters 53-58:
+Characters 52-53:
     val y = 3
-        ^^^^^
+        ^
 Warning 13: the instance variable y is overridden.
 The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
-Characters 81-84:
+Characters 80-83:
     inherit d 7
             ^^^
 Warning 13: the following instance variables are overridden by the class d :
   t z
 The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
-Characters 91-96:
+Characters 90-91:
     val u = 3
-        ^^^^^
+        ^
 Warning 13: the instance variable u is overridden.
 The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
 class e :
@@ -254,10 +254,12 @@
   fun x -> (x : int -> bool :> 'a -> 'a);;
            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Type int -> bool is not a subtype of int -> int 
+       Type bool is not a subtype of int 
 # Characters 9-40:
   fun x -> (x : int -> bool :> int -> int);;
            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Type int -> bool is not a subtype of int -> int 
+       Type bool is not a subtype of int 
 # - : <  > -> <  > = 
 # - : < .. > -> <  > = 
 #   val x : '_a list ref = {contents = []}
@@ -268,18 +270,20 @@
   fun (x : 'a t as 'a) -> ();;
            ^^^^^^^^^^
 Error: This alias is bound to type 'a t but is used as an instance of type 'a
+       The type variable 'a occurs inside 'a t
 # Characters 19-20:
   fun (x : 'a t) -> (x : 'a); ();;
                      ^
 Error: This expression has type 'a t but an expression was expected of type
          'a
+       The type variable 'a occurs inside 'a t
 # type 'a t = < x : 'a >
 # - : ('a t as 'a) -> unit = 
 # Characters 18-26:
   fun (x : 'a t) -> (x : 'a); ();;
                     ^^^^^^^^
 Warning 10: this expression should have type unit.
-- : ('a t as 'a) -> unit = 
+- : ('a t as 'a) t -> unit = 
 #         class ['a] c :
   unit -> object constraint 'a = (< .. > as 'b) -> unit method m : 'a end
 #       class ['a] c :
@@ -290,4 +294,18 @@
   unit -> object method private m : int method n : int method o : int end
 #   - : int * int = (1, 1)
 #   class c : unit -> object method m : int end
+#       - : int = 16
+# - : int = 17
+# - : int = 18
+#         - : int * int * int = (19, 20, 21)
+#           - : int * int * int * int * int = (22, 23, 24, 33, 33)
+#           - : int * int * int * int * int = (25, 26, 27, 33, 33)
+#         Characters 42-69:
+  class a = let _ = new b in object end
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of recursive class expression is not allowed
+#   Characters 11-38:
+  class a = let _ = new a in object end;;
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of recursive class expression is not allowed
 # 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects/pr5619_bad.ml ocaml-4.01.0/testsuite/tests/typing-objects/pr5619_bad.ml
--- ocaml-3.12.1/testsuite/tests/typing-objects/pr5619_bad.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects/pr5619_bad.ml	2012-07-30 18:04:46.000000000 +0000
@@ -0,0 +1,29 @@
+class type foo_t =
+  object
+    method foo: string
+  end
+
+type 'a name =
+    Foo: foo_t name
+  | Int: int name
+;;
+
+class foo =
+  object(self)
+    method foo = "foo"
+    method cast =
+      function
+          Foo -> (self :> )
+        | _ -> raise Exit
+  end
+;;
+
+class foo: foo_t =
+  object(self)
+    method foo = "foo"
+    method cast: type a. a name -> a =
+      function
+          Foo -> (self :> foo_t)
+        | _ -> ((raise Exit) : a)
+  end
+;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects/pr5619_bad.ml.principal.reference ocaml-4.01.0/testsuite/tests/typing-objects/pr5619_bad.ml.principal.reference
--- ocaml-3.12.1/testsuite/tests/typing-objects/pr5619_bad.ml.principal.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects/pr5619_bad.ml.principal.reference	2012-07-30 18:04:46.000000000 +0000
@@ -0,0 +1,18 @@
+
+#                 class type foo_t = object method foo : string end
+type 'a name = Foo : foo_t name | Int : int name
+#                   class foo :
+  object method cast : foo_t name -> < foo : string > method foo : string end
+#                   Characters 22-184:
+  ..object(self)
+      method foo = "foo"
+      method cast: type a. a name -> a =
+        function
+            Foo -> (self :> foo_t)
+          | _ -> ((raise Exit) : a)
+    end
+Error: The class type
+         object method cast : 'a name -> 'a method foo : string end
+       is not matched by the class type foo_t
+       The public method cast cannot be hidden
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects/pr5619_bad.ml.reference ocaml-4.01.0/testsuite/tests/typing-objects/pr5619_bad.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-objects/pr5619_bad.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects/pr5619_bad.ml.reference	2012-07-30 18:04:46.000000000 +0000
@@ -0,0 +1,18 @@
+
+#                 class type foo_t = object method foo : string end
+type 'a name = Foo : foo_t name | Int : int name
+#                   class foo :
+  object method cast : foo_t name -> < foo : string > method foo : string end
+#                   Characters 22-184:
+  ..object(self)
+      method foo = "foo"
+      method cast: type a. a name -> a =
+        function
+            Foo -> (self :> foo_t)
+          | _ -> ((raise Exit) : a)
+    end
+Error: The class type
+         object method cast : 'a name -> 'a method foo : string end
+       is not matched by the class type foo_t
+       The public method cast cannot be hidden
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects/pr5858.ml ocaml-4.01.0/testsuite/tests/typing-objects/pr5858.ml
--- ocaml-3.12.1/testsuite/tests/typing-objects/pr5858.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects/pr5858.ml	2012-12-18 09:58:32.000000000 +0000
@@ -0,0 +1,2 @@
+class type c = object end;;
+module type S = sig class c: c end;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects/pr5858.ml.reference ocaml-4.01.0/testsuite/tests/typing-objects/pr5858.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-objects/pr5858.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects/pr5858.ml.reference	2012-12-18 09:58:32.000000000 +0000
@@ -0,0 +1,7 @@
+
+# class type c = object  end
+# Characters 29-30:
+  module type S = sig class c: c end;;
+                               ^
+Error: The class type c is not yet completely defined
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects/pr6123_bad.ml ocaml-4.01.0/testsuite/tests/typing-objects/pr6123_bad.ml
--- ocaml-3.12.1/testsuite/tests/typing-objects/pr6123_bad.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects/pr6123_bad.ml	2013-08-20 03:56:09.000000000 +0000
@@ -0,0 +1,23 @@
+class virtual name =
+object
+end
+
+and func (args_ty, ret_ty) =
+object(self)
+  inherit name
+
+  val mutable memo_args = None
+
+  method arguments =
+    match memo_args with
+    | Some xs -> xs
+    | None ->
+      let args = List.map (fun ty -> new argument(self, ty)) args_ty in
+        memo_args <- Some args; args
+end
+
+and argument (func, ty) =
+object
+  inherit name
+end
+;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects/pr6123_bad.ml.principal.reference ocaml-4.01.0/testsuite/tests/typing-objects/pr6123_bad.ml.principal.reference
--- ocaml-3.12.1/testsuite/tests/typing-objects/pr6123_bad.ml.principal.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects/pr6123_bad.ml.principal.reference	2013-08-20 03:56:09.000000000 +0000
@@ -0,0 +1,8 @@
+
+#                                             Characters 253-257:
+        let args = List.map (fun ty -> new argument(self, ty)) args_ty in
+                                                    ^^^^
+Error: This expression has type < arguments : 'b; .. > as 'a
+       but an expression was expected of type 'a
+       Self type cannot escape its class
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects/pr6123_bad.ml.reference ocaml-4.01.0/testsuite/tests/typing-objects/pr6123_bad.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-objects/pr6123_bad.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects/pr6123_bad.ml.reference	2013-08-20 03:56:09.000000000 +0000
@@ -0,0 +1,8 @@
+
+#                                             Characters 253-257:
+        let args = List.map (fun ty -> new argument(self, ty)) args_ty in
+                                                    ^^^^
+Error: This expression has type < arguments : 'b; .. > as 'a
+       but an expression was expected of type 'a
+       Self type cannot escape its class
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects-bugs/Makefile ocaml-4.01.0/testsuite/tests/typing-objects-bugs/Makefile
--- ocaml-3.12.1/testsuite/tests/typing-objects-bugs/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects-bugs/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,2 +1,15 @@
-include ../../makefiles/Makefile.okbad
-include ../../makefiles/Makefile.common
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.okbad
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects-bugs/pr3968_bad.ml ocaml-4.01.0/testsuite/tests/typing-objects-bugs/pr3968_bad.ml
--- ocaml-3.12.1/testsuite/tests/typing-objects-bugs/pr3968_bad.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects-bugs/pr3968_bad.ml	2012-07-30 18:04:46.000000000 +0000
@@ -1,18 +1,18 @@
-type expr = 
+type expr =
   [ `Abs of string * expr
   | `App of expr * expr
   ]
 
-class type exp = 
+class type exp =
 object
   method eval : (string, exp) Hashtbl.t -> expr
 end;;
 
-class app e1 e2 : exp = 
+class app e1 e2 : exp =
 object
-  val l = e1 
+  val l = e1
   val r = e2
-  method eval env = 
+  method eval env =
       match l with
     | `Abs(var,body) ->
         Hashtbl.add env var r;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects-bugs/pr4018_bad.ml ocaml-4.01.0/testsuite/tests/typing-objects-bugs/pr4018_bad.ml
--- ocaml-3.12.1/testsuite/tests/typing-objects-bugs/pr4018_bad.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects-bugs/pr4018_bad.ml	2012-07-30 18:04:46.000000000 +0000
@@ -8,7 +8,7 @@
    object (self : 'subject)
      val mutable observers = ([]: (('subject, 'event) observer) list)
      method add_observer obs = observers <- (obs :: observers)
-     method notify_observers (e : 'event) = 
+     method notify_observers (e : 'event) =
          List.iter (fun x -> x#notify self e) observers
    end
 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects-bugs/pr4766_ok.ml ocaml-4.01.0/testsuite/tests/typing-objects-bugs/pr4766_ok.ml
--- ocaml-3.12.1/testsuite/tests/typing-objects-bugs/pr4766_ok.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects-bugs/pr4766_ok.ml	2012-07-30 18:04:46.000000000 +0000
@@ -1,9 +1,9 @@
-class virtual ['a] c = 
-object (s : 'a) 
-  method virtual m : 'b 
+class virtual ['a] c =
+object (s : 'a)
+  method virtual m : 'b
 end
 
-let o = 
+let o =
     object (s :'a)
       inherit ['a] c
       method m = 42
diff -Nru ocaml-3.12.1/testsuite/tests/typing-objects-bugs/yamagata021012_ok.ml ocaml-4.01.0/testsuite/tests/typing-objects-bugs/yamagata021012_ok.ml
--- ocaml-3.12.1/testsuite/tests/typing-objects-bugs/yamagata021012_ok.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-objects-bugs/yamagata021012_ok.ml	2012-07-30 18:04:46.000000000 +0000
@@ -31,9 +31,9 @@
     method fold : 'b. ('a -> int -> 'b -> 'b) -> 'b -> 'b = fun f a0 ->
       let cur = self#first in
       let rec loop count a =
-	if count >= self#len then a else
-	let a' = f cur#get count a in
-	cur#incr (); loop (count + 1) a'
+        if count >= self#len then a else
+        let a' = f cur#get count a in
+        cur#incr (); loop (count + 1) a'
       in
       loop 0 a0
     method iter proc =
@@ -63,7 +63,7 @@
   let highest_bit = 1 lsl 30
   let lower_bits = highest_bit - 1
 
-  let char_of c = 
+  let char_of c =
     try Char.chr c with Invalid_argument _ ->  raise Out_of_range
 
   let of_char = Char.code
@@ -129,7 +129,7 @@
   object (self : 'self)
     inherit [cursor] ustorage_base
     val contents = buf
-    method first = new cursor (self :> text_raw) 0 
+    method first = new cursor (self :> text_raw) 0
     method len = (String.length contents) / 4
     method get i = get_buf contents (4 * i)
     method nth i = new cursor (self :> text_raw) i
diff -Nru ocaml-3.12.1/testsuite/tests/typing-poly/.svnignore ocaml-4.01.0/testsuite/tests/typing-poly/.svnignore
--- ocaml-3.12.1/testsuite/tests/typing-poly/.svnignore	2011-05-17 12:08:13.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-poly/.svnignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,10 +0,0 @@
-#!/bin/sh
-
-svn propset svn:ignore -F - . < 'a >) = (x : < m : 'b. 'b -> 'b >)
 ;;
@@ -448,7 +447,7 @@
 function 1,`B -> 1 | 1,_ -> 2;;
 
 (* pass typetexp, but fails during Typedecl.check_recursion *)
-type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b] 
+type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b]
 and  ('a, 'b) b = 'b -> unit constraint 'b = [> `A of ('a, 'b) a as 'a];;
 
 (* PR#1917: expanding may change original in Ctype.unify2 *)
@@ -459,12 +458,12 @@
   method as_a: ('a, 'b) a
 end and ['a, 'b] b = object
   method a: ('a, 'b) #a as 'a
-  method as_b: ('a, 'b) b 
+  method as_b: ('a, 'b) b
 end
 
 class type ['b] ca = object ('s) inherit ['s, 'b] a end
 class type ['a] cb = object ('s) inherit ['a, 's] b end
-	  
+
 type bt = 'b ca cb as 'b
 ;;
 
@@ -557,18 +556,31 @@
 let f6 x =
   (x :  ] as 'a> :>  ] as 'a>);;
 
+(* Keep sharing the epsilons *)
+let f x = if true then (x : < m : 'a. 'a -> 'a >) else x;;
+fun x -> (f x)#m;; (* Warning 18 *)
+let f (x, y) = if true then (x : < m : 'a. 'a -> 'a >) else x;;
+fun x -> (f (x,x))#m;; (* Warning 18 *)
+let f x = if true then [| (x : < m : 'a. 'a -> 'a >) |] else [|x|];;
+fun x -> (f x).(0)#m;; (* Warning 18 *)
+
 (* Not really principal? *)
 class c = object method id : 'a. 'a -> 'a = fun x -> x end;;
 type u = c option;;
 let just = function None -> failwith "just" | Some x -> x;;
 let f x = let l = [Some x; (None : u)] in (just(List.hd l))#id;;
 let g x =
-  let none = match None with y -> ignore [y;(None:u)]; y in
+  let none = (fun y -> ignore [y;(None:u)]; y) None in
   let x = List.hd [Some x; none] in (just x)#id;;
 let h x =
   let none = let y = None in ignore [y;(None:u)]; y in
   let x = List.hd [Some x; none] in (just x)#id;;
 
+(* Only solved for parameterless abbreviations *)
+type 'a u = c option;;
+let just = function None -> failwith "just" | Some x -> x;;
+let f x = let l = [Some x; (None : _ u)] in (just(List.hd l))#id;;
+
 (* polymorphic recursion *)
 
 let rec f : 'a. 'a -> _ = fun x -> 1 and g x = f x;;
@@ -620,5 +632,38 @@
 
 (* variant *)
 type t = {f: 'a. 'a -> unit};;
-{f=fun ?x y -> ()};;
-{f=fun ?x y -> y};; (* fail *)
+let f ?x y = () in {f};;
+let f ?x y = y in {f};; (* fail *)
+
+(* Polux Moon caml-list 2011-07-26 *)
+module Polux = struct
+  type 'par t = 'par
+  let ident v = v
+  class alias = object method alias : 'a . 'a t -> 'a = ident end
+  let f (x : ) = (x : )
+end;;
+
+(* PR#5560 *)
+
+let (a, b) = (raise Exit : int * int);;
+type t = { foo : int }
+let {foo} = (raise Exit : t);;
+type s = A of int
+let (A x) = (raise Exit : s);;
+
+(* PR#5224 *)
+
+type 'x t = < f : 'y. 'y t >;;
+
+(* PR#6056, PR#6057 *)
+let using_match b =
+  let f =
+    match b with
+    | true -> fun x -> x
+    | false -> fun x -> x
+  in
+  f 0,f
+;;
+
+match (fun x -> x), fun x -> x with x, y -> x, y;;
+match fun x -> x with x -> x, x;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-poly/poly.ml.principal.reference ocaml-4.01.0/testsuite/tests/typing-poly/poly.ml.principal.reference
--- ocaml-3.12.1/testsuite/tests/typing-poly/poly.ml.principal.reference	2010-06-18 10:27:18.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-poly/poly.ml.principal.reference	2013-06-28 10:47:57.000000000 +0000
@@ -1,19 +1,19 @@
 
-#   * * *       #   type 'a t = { t : 'a; }
+# * * *       #   type 'a t = { t : 'a; }
 # type 'a fold = { fold : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b; }
 # val f : 'a list -> 'a fold = 
 # - : int = 6
-#               class ['a] ilist :
-  'a list ->
-  object ('b)
-    val l : 'a list
-    method add : 'a -> 'b
-    method fold : f:('c -> 'a -> 'c) -> init:'c -> 'c
+#               class ['b] ilist :
+  'b list ->
+  object ('c)
+    val l : 'b list
+    method add : 'b -> 'c
+    method fold : f:('a -> 'b -> 'a) -> init:'a -> 'a
   end
 #         class virtual ['a] vlist :
-  object ('b)
-    method virtual add : 'a -> 'b
-    method virtual fold : f:('c -> 'a -> 'c) -> init:'c -> 'c
+  object ('c)
+    method virtual add : 'a -> 'c
+    method virtual fold : f:('b -> 'a -> 'b) -> init:'b -> 'b
   end
 #             class ilist2 :
   int list ->
@@ -25,52 +25,52 @@
 #             val ilist2 : 'a list -> 'a vlist = 
 #             class ['a] ilist3 :
   'a list ->
-  object ('b)
+  object ('c)
     val l : 'a list
-    method add : 'a -> 'b
-    method fold : f:('c -> 'a -> 'c) -> init:'c -> 'c
+    method add : 'a -> 'c
+    method fold : f:('b -> 'a -> 'b) -> init:'b -> 'b
   end
 #               class ['a] ilist4 :
   'a list ->
-  object ('b)
+  object ('c)
     val l : 'a list
-    method add : 'a -> 'b
-    method fold : f:('c -> 'a -> 'c) -> init:'c -> 'c
+    method add : 'a -> 'c
+    method fold : f:('b -> 'a -> 'b) -> init:'b -> 'b
   end
 #                 class ['a] ilist5 :
   'a list ->
-  object ('b)
+  object ('c)
     val l : 'a list
-    method add : 'a -> 'b
-    method fold : f:('c -> 'a -> 'c) -> init:'c -> 'c
-    method fold2 : f:('d -> 'a -> 'd) -> init:'d -> 'd
+    method add : 'a -> 'c
+    method fold : f:('b -> 'a -> 'b) -> init:'b -> 'b
+    method fold2 : f:('b -> 'a -> 'b) -> init:'b -> 'b
   end
 #                 class ['a] ilist6 :
   'a list ->
-  object ('b)
+  object ('c)
     val l : 'a list
-    method add : 'a -> 'b
-    method fold : f:('c -> 'a -> 'c) -> init:'c -> 'c
-    method fold2 : f:('d -> 'a -> 'd) -> init:'d -> 'd
+    method add : 'a -> 'c
+    method fold : f:('b -> 'a -> 'b) -> init:'b -> 'b
+    method fold2 : f:('b -> 'a -> 'b) -> init:'b -> 'b
   end
 #       class virtual ['a] olist :
-  object method virtual fold : f:('a -> 'b -> 'b) -> init:'b -> 'b end
+  object method virtual fold : f:('a -> 'c -> 'c) -> init:'c -> 'c end
 #         class ['a] onil :
-  object method fold : f:('a -> 'b -> 'b) -> init:'b -> 'b end
+  object method fold : f:('a -> 'c -> 'c) -> init:'c -> 'c end
 #             class ['a] ocons :
   hd:'a ->
   tl:'a olist ->
   object
     val hd : 'a
     val tl : 'a olist
-    method fold : f:('a -> 'b -> 'b) -> init:'b -> 'b
+    method fold : f:('a -> 'c -> 'c) -> init:'c -> 'c
   end
 #               class ['a] ostream :
   hd:'a ->
   tl:'a ostream ->
   object
     val hd : 'a
-    val tl : < empty : bool; fold : 'b. f:('a -> 'b -> 'b) -> init:'b -> 'b >
+    val tl : < empty : bool; fold : 'c. f:('a -> 'c -> 'c) -> init:'c -> 'c >
     method empty : bool
     method fold : f:('a -> 'c -> 'c) -> init:'c -> 'c
   end
@@ -118,14 +118,14 @@
 val p1 : point = 
 val cp : color_point = 
 val c : circle = 
-val d : float = 11.4536240470737098
+val d : float = 11.
 #   val f : < m : 'a. 'a -> 'a > -> < m : 'b. 'b -> 'b > = 
 #   Characters 41-42:
   let f (x : < m : 'a. 'a -> 'a list >) = (x : < m : 'b. 'b -> 'c >)
                                            ^
-Error: This expression has type < m : 'a. 'a -> 'a list >
-       but an expression was expected of type < m : 'a. 'a -> 'b >
-       The universal variable 'a would escape its scope
+Error: This expression has type < m : 'b. 'b -> 'b list >
+       but an expression was expected of type < m : 'b. 'b -> 'c >
+       The universal variable 'b would escape its scope
 #           class id : object method id : 'a -> 'a end
 #         class type id_spec = object method id : 'a -> 'a end
 #       class id_impl : object method id : 'a -> 'a end
@@ -142,13 +142,13 @@
 #           Characters 80-85:
     method id _ = x
               ^^^^^
-Error: This method has type 'a -> 'a which is less general than 'b. 'b -> 'b
+Error: This method has type 'b -> 'b which is less general than 'a. 'a -> 'a
 #                 Characters 92-159:
   ............x =
       match r with
         None -> r <- Some x; x
       | Some y -> y
-Error: This method has type 'a -> 'a which is less general than 'b. 'b -> 'b
+Error: This method has type 'b -> 'b which is less general than 'a. 'a -> 'a
 #         class c : object method m : 'a -> 'b -> 'a end
 #     val f1 : id -> int * bool = 
 #   val f2 : id -> int * bool = 
@@ -175,9 +175,9 @@
 Error: The type abbreviation foo is cyclic
 #     class ['a] bar : 'a -> object  end
 #   type 'a foo = 'a foo bar
-#   - : (< m : 'b. 'b * 'a > as 'a) -> 'c * (< m : 'e. 'e * 'd > as 'd) = 
-# - : (< m : 'b. 'a * 'b list > as 'a) ->
-    (< m : 'd. 'c * 'd list > as 'c) * 'e list
+#   - : (< m : 'a. 'a * 'b > as 'b) -> 'c * (< m : 'a. 'a * 'd > as 'd) = 
+# - : (< m : 'a. 'b * 'a list > as 'b) ->
+    (< m : 'a. 'c * 'a list > as 'c) * 'd list
 = 
 # val f :
   (< m : 'b. 'a * (< n : 'b; .. > as 'b) > as 'a) ->
@@ -186,11 +186,11 @@
 # - : (< p : 'b. < m : 'b; n : 'a; .. > as 'b > as 'a) ->
     (< m : 'c; n : < p : 'e. < m : 'e; n : 'd; .. > as 'e > as 'd; .. > as 'c)
 = 
-# - : (< m : 'b. 'b * < p : 'd. 'd * 'c * 'a > as 'c > as 'a) ->
+# - : (< m : 'a. 'a * < p : 'b. 'b * 'd * 'c > as 'd > as 'c) ->
     ('f *
-     < p : 'g.
-             'g * 'e *
-             (< m : 'i. 'i * < p : 'k. 'k * 'j * 'h > as 'j > as 'h) >
+     < p : 'b.
+             'b * 'e *
+             (< m : 'a. 'a * < p : 'b0. 'b0 * 'h * 'g > as 'h > as 'g) >
      as 'e)
 = 
 #   - : < m : 'a. < p : 'a; .. > as 'b > -> 'b = 
@@ -199,14 +199,14 @@
 #   type record = { r : < id : 'a. 'a -> 'a >; }
 # - : record -> 'a -> 'a = 
 # - : record -> 'a -> 'a = 
-#       class myself : object ('a) method self : 'b -> 'a end
+#       class myself : object ('b) method self : 'a -> 'b end
 #                       class number :
-  object ('a)
+  object ('b)
     val num : int
     method num : int
-    method prev : 'a
-    method succ : 'a
-    method switch : zero:(unit -> 'b) -> prev:('a -> 'b) -> 'b
+    method prev : 'b
+    method succ : 'b
+    method switch : zero:(unit -> 'a) -> prev:('b -> 'a) -> 'a
   end
 #     val id : 'a -> 'a = 
 #       class c : object method id : 'a -> 'a end
@@ -216,14 +216,14 @@
     val mutable count : int
     method count : int
     method id : 'a -> 'a
-    method old : 'b -> 'b
+    method old : 'a -> 'a
   end
 #             class ['a] olist :
   'a list ->
-  object ('b)
+  object ('c)
     val l : 'a list
-    method cons : 'a -> 'b
-    method fold : f:('a -> 'c -> 'c) -> init:'c -> 'c
+    method cons : 'a -> 'c
+    method fold : f:('a -> 'b -> 'b) -> init:'b -> 'b
   end
 #   val sum : int #olist -> int = 
 #   val count : 'a #olist -> int = 
@@ -244,16 +244,16 @@
 # Characters 17-25:
   let bad = {bad = ref None};;
                    ^^^^^^^^
-Error: This field value has type 'a option ref which is less general than
-         'b. 'b option ref
+Error: This field value has type 'b option ref which is less general than
+         'a. 'a option ref
 # type bad2 = { mutable bad2 : 'a. 'a option ref option; }
 # val bad2 : bad2 = {bad2 = None}
 # Characters 13-28:
   bad2.bad2 <- Some (ref None);;
                ^^^^^^^^^^^^^^^
-Error: This field value has type 'a option ref option
-       which is less general than 'b. 'b option ref option
-#       val f : < m : 'a. < p : 'a * 'b > as 'b > -> 'c -> unit = 
+Error: This field value has type 'b option ref option
+       which is less general than 'a. 'a option ref option
+#       val f : < m : 'a. < p : 'a * 'c > as 'c > -> 'b -> unit = 
 # val f :
   < m : 'a. 'a * (< p : int * 'b > as 'b) > ->
   (< p : int * 'c > as 'c) -> unit = 
@@ -265,10 +265,10 @@
 #           Characters 145-166:
   object method virtual visit : 'a.('a visitor -> 'a) end;;
                                 ^^^^^^^^^^^^^^^^^^^^^
-Error: This type scheme cannot quantify 'a :
-it escapes this scope.
+Error: The universal type variable 'a cannot be generalized:
+       it escapes its scope.
 #                 type ('a, 'b) list_visitor = < caseCons : 'b -> 'b list -> 'a; caseNil : 'a >
-type 'a alist = < visit : 'b. ('b, 'a) list_visitor -> 'b >
+type 'b alist = < visit : 'a. ('a, 'b) list_visitor -> 'a >
 class type ct = object ('a) method fold : ('b -> 'a -> 'b) -> 'b -> 'b end
 type t = { f : 'a 'b. ('b -> (#ct as 'a) -> 'b) -> 'b; }
 #     Characters 20-25:
@@ -281,7 +281,7 @@
   type ('a,'b) t constraint 'a = 'b and ('a,'b) u = ('a,'b) t;;
                                                     ^^^^^^^^^
 Error: Constraints are not satisfied in this type.
-Type ('a, 'b) t should be an instance of ('c, 'c) t
+       Type ('a, 'b) t should be an instance of ('c, 'c) t
 #     type 'a t = 'a
 and u = int t
 #     type 'a t constraint 'a = int
@@ -289,7 +289,7 @@
   type 'a u = 'a and 'a v = 'a u t;;
                             ^^^^^^
 Error: Constraints are not satisfied in this type.
-Type 'a u t should be an instance of int t
+       Type 'a u t should be an instance of int t
 # type 'a u = 'a constraint 'a = int
 and 'a v = 'a u t constraint 'a = int
 #     type g = int
@@ -298,9 +298,9 @@
   type 'a u = 'a and 'a v = 'a u t;;
                             ^^^^^^
 Error: Constraints are not satisfied in this type.
-Type 'a u t should be an instance of g t
+       Type 'a u t should be an instance of g t
 # type 'a u = 'a constraint 'a = g
-and 'a v = 'a u t constraint 'a = int
+and 'a v = 'a u t constraint 'a = g
 #     Characters 38-58:
   type 'a u = < m : 'a v > and 'a v = 'a list u;;
       ^^^^^^^^^^^^^^^^^^^^
@@ -347,13 +347,13 @@
 Warning 11: this match case is unused.
 - : int * [< `B ] -> int = 
 #       Characters 69-135:
-  type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b] 
+  type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b]
        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Constraints are not satisfied in this type.
-Type
-([> `B of 'a ], 'a) b as 'a
-should be an instance of
-(('b, [> `A of ('d, 'c) a as 'd ] as 'c) a as 'b, 'c) b
+       Type
+       ([> `B of 'a ], 'a) b as 'a
+       should be an instance of
+       (('b, [> `A of ('d, 'c) a as 'd ] as 'c) a as 'b, 'c) b
 #     *                           class type ['a, 'b] a =
   object
     constraint 'a = < as_a : ('a, 'b) a as 'c; b : 'b; .. >
@@ -412,9 +412,9 @@
 #         Characters 76-77:
     (x :  > as 'bar) >);;
      ^
-Error: This expression has type < m : 'b. 'b * < m : 'b * 'a > > as 'a
+Error: This expression has type < m : 'a. 'a * < m : 'a * 'b > > as 'b
        but an expression was expected of type
-         < m : 'b. 'b * (< m : 'b * < m : 'd. 'd * 'c > > as 'c) >
+         < m : 'a. 'a * (< m : 'a * < m : 'c. 'c * 'd > > as 'd) >
        Types for method m are incompatible
 #         Characters 176-177:
   let f (x : foo') = (x : bar');;
@@ -422,70 +422,71 @@
 Error: This expression has type foo' = < m : 'a. 'a * 'a foo >
        but an expression was expected of type bar' = < m : 'a. 'a * 'a bar >
        Type 'a foo = < m : 'a * 'a foo > is not compatible with type
-         'a bar = < m : 'a * < m : 'b. 'b * 'a bar > > 
+         'a bar = < m : 'a * < m : 'c. 'c * 'a bar > > 
        Type 'a foo = < m : 'a * 'a foo > is not compatible with type
-         < m : 'b. 'b * 'a bar > 
+         < m : 'c. 'c * 'a bar > 
        Types for method m are incompatible
 #     Characters 67-68:
     (x : )> as 'bar);;
      ^
 Error: This expression has type
-         < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) >
+         < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) >
        but an expression was expected of type
-         < m : 'a. 'a * ('a * < m : 'c. 'c * ('c * 'd) >) > as 'd
+         < m : 'b. 'b * ('b * < m : 'c. 'c * ('c * 'd) >) > as 'd
        Types for method m are incompatible
 #   Characters 66-67:
     (x : )> as 'bar);;
      ^
 Error: This expression has type
-         < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) >
+         < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) >
        but an expression was expected of type
-         < m : 'a. 'a * ('a * < m : 'c. 'c * ('a * 'd) >) > as 'd
+         < m : 'b. 'b * ('b * < m : 'c. 'c * ('b * 'd) >) > as 'd
        Types for method m are incompatible
 #   Characters 51-52:
     (x :  as 'bar)>);;
      ^
 Error: This expression has type < m : 'b. 'b * ('b * 'a) > as 'a
        but an expression was expected of type
-         < m : 'b. 'b * ('b * < m : 'd. 'd * 'c > as 'c) >
+         < m : 'b. 'b * ('b * < m : 'c. 'c * 'd > as 'd) >
        Types for method m are incompatible
 #     Characters 14-115:
   ....(x :  ('a *  'bar> as 'bar)>
          :>  ('a * 'foo)> as 'foo)..
-Error: Type < m : 'a. 'a -> ('a * (< m : 'd. 'd -> 'b as 'e > as 'c) as 'b) >
+Error: Type < m : 'a. 'a -> ('a * (< m : 'c. 'c -> 'b as 'e > as 'd) as 'b) >
        is not a subtype of < m : 'a. 'a -> ('a * 'f as 'h) as 'g > as 'f 
+       Type 'c. 'e is not a subtype of 'a. 'g 
 #       Characters 88-150:
   = struct let f (x :  as 'foo) = () end;;
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Signature mismatch:
        Modules do not match:
-         sig val f : (< m : 'b. 'b * ('b * 'a) > as 'a) -> unit end
+         sig val f : (< m : 'a. 'a * ('a * 'b) > as 'b) -> unit end
        is not included in
          sig
-           val f : < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) > -> unit
+           val f : < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) > -> unit
          end
        Values do not match:
-         val f : (< m : 'b. 'b * ('b * 'a) > as 'a) -> unit
+         val f : (< m : 'a. 'a * ('a * 'b) > as 'b) -> unit
        is not included in
-         val f : < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) > -> unit
+         val f : < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) > -> unit
 #     Characters 78-132:
   = struct type t =  as 'foo end;;
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Signature mismatch:
        Modules do not match:
-         sig type t = < m : 'b. 'b * ('b * 'a) > as 'a end
+         sig type t = < m : 'a. 'a * ('a * 'b) > as 'b end
        is not included in
-         sig type t = < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) > end
+         sig type t = < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) > end
        Type declarations do not match:
-         type t = < m : 'b. 'b * ('b * 'a) > as 'a
+         type t = < m : 'a. 'a * ('a * 'b) > as 'b
        is not included in
-         type t = < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) >
+         type t = < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) >
 #     module M : sig type 'a t type u = < m : 'a. 'a t > end
 #   module M : sig type 'a t val f : < m : 'a. 'a t > -> int end
 #     module M : sig type 'a t val f : < m : 'a. 'a t > -> int end
 #         val f :
-  (< m : 'b. 'b -> (< m : 'b. 'b -> 'c * <  > > as 'c) * < .. >; .. > as 'a) ->
-  'a -> bool = 
+  (< m : 'a. 'a -> (< m : 'a. 'a -> 'c * <  > > as 'c) * < .. >; .. > as 'b) ->
+  'b -> bool = 
 #         type t = [ `A | `B ]
 # type v = private [> t ]
 # - : t -> v = 
@@ -512,34 +513,67 @@
       :>  as 'b) -> int>)..
 Error: Type < m : 'a. (< p : int; .. > as 'a) -> int > is not a subtype of
          < m : 'b. (< p : int; q : int; .. > as 'b) -> int > 
+       Type < p : int; q : int; .. > as 'c is not a subtype of
+         < p : int; .. > as 'd 
 #     val f2 :
   < m : 'a. (< p : < a : int >; .. > as 'a) -> int > ->
-  < m : 'a. (< p : < a : int; b : int >; .. > as 'a) -> int > = 
+  < m : 'b. (< p : < a : int; b : int >; .. > as 'b) -> int > = 
 #     Characters 13-107:
   ..(x : ;..> as 'a) -> int>
       :> ;..> as 'b) -> int>)..
 Error: Type < m : 'a. (< p : < a : int; b : int >; .. > as 'a) -> int >
-       is not a subtype of < m : 'a. (< p : < a : int >; .. > as 'a) -> int > 
+       is not a subtype of < m : 'b. (< p : < a : int >; .. > as 'b) -> int > 
+       Type < a : int > is not a subtype of < a : int; b : int > 
 # Characters 11-55:
   let f4 x = (x : ;..> :> ;..>);;
              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Type < p : < a : int; b : int >; .. > is not a subtype of
          < p : < a : int >; .. > 
-The second object type has no method b
+       The second object type has no method b
 #   val f5 :
   < m : 'a. [< `A of < p : int > ] as 'a > ->
-  < m : 'a. [< `A of <  > ] as 'a > = 
+  < m : 'b. [< `A of <  > ] as 'b > = 
 #   Characters 13-83:
     (x :  ] as 'a> :>  ] as 'a>);;
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Type < m : 'a. [< `A of <  > ] as 'a > is not a subtype of
-         < m : 'a. [< `A of < p : int > ] as 'a > 
+         < m : 'b. [< `A of < p : int > ] as 'b > 
+       Type <  > is not a subtype of < p : int > 
+#     val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > = 
+# Characters 9-16:
+  fun x -> (f x)#m;; (* Warning 18 *)
+           ^^^^^^^
+Warning 18: this use of a polymorphic method is not principal.
+- : < m : 'a. 'a -> 'a > -> 'b -> 'b = 
+# val f : < m : 'a. 'a -> 'a > * 'b -> < m : 'a. 'a -> 'a > = 
+# Characters 9-20:
+  fun x -> (f (x,x))#m;; (* Warning 18 *)
+           ^^^^^^^^^^^
+Warning 18: this use of a polymorphic method is not principal.
+- : < m : 'a. 'a -> 'a > -> 'b -> 'b = 
+# val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > array = 
+# Characters 9-20:
+  fun x -> (f x).(0)#m;; (* Warning 18 *)
+           ^^^^^^^^^^^
+Warning 18: this use of a polymorphic method is not principal.
+- : < m : 'a. 'a -> 'a > -> 'b -> 'b = 
 #     class c : object method id : 'a -> 'a end
 # type u = c option
 # val just : 'a option -> 'a = 
-# val f : c -> 'a -> 'a = 
-#     val g : c -> 'a -> 'a = 
+# Characters 42-62:
+  let f x = let l = [Some x; (None : u)] in (just(List.hd l))#id;;
+                                            ^^^^^^^^^^^^^^^^^^^^
+Warning 18: this use of a polymorphic method is not principal.
+val f : c -> 'a -> 'a = 
+#     Characters 101-112:
+    let x = List.hd [Some x; none] in (just x)#id;;
+                                      ^^^^^^^^^^^
+Warning 18: this use of a polymorphic method is not principal.
+val g : c -> 'a -> 'a = 
 #     val h : < id : 'a; .. > -> 'a = 
+#     type 'a u = c option
+# val just : 'a option -> 'a = 
+# val f : c -> 'a -> 'a = 
 #       val f : 'a -> int = 
 val g : 'a -> int = 
 # type 'a t = Leaf of 'a | Node of ('a * 'a) t
@@ -548,7 +582,7 @@
     function Leaf _ -> 1 | Node x -> 1 + d x
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: This definition has type 'a t -> int which is less general than
-         'b. 'b t -> int
+         'a0. 'a0 t -> int
 #   Characters 34-78:
     function Leaf x -> x | Node x -> 1 + depth x;; (* fails *)
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
@@ -558,12 +592,12 @@
     function Leaf x -> x | Node x -> depth x;; (* fails *)
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: This definition has type 'a t -> 'a which is less general than
-         'b. 'b t -> 'a
+         'a0. 'a0 t -> 'a
 #   Characters 38-78:
     function Leaf x -> x | Node x -> depth x;; (* fails *)
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This definition has type 'a. 'a t -> 'a which is less general than
-         'b 'c. 'c t -> 'b
+Error: This definition has type 'b. 'b t -> 'b which is less general than
+         'a 'b. 'a t -> 'b
 #   val r : 'a list * '_b list ref = ([], {contents = []})
 val q : unit -> 'a list * '_b list ref = 
 # val f : 'a -> 'a = 
@@ -591,9 +625,26 @@
 val l : t = {f = }
 #     type t = { f : 'a. 'a -> unit; }
 # - : t = {f = }
-# Characters 3-16:
-  {f=fun ?x y -> y};; (* fail *)
-     ^^^^^^^^^^^^^
+# Characters 19-20:
+  let f ?x y = y in {f};; (* fail *)
+                     ^
 Error: This field value has type unit -> unit which is less general than
          'a. 'a -> unit
+#               module Polux :
+  sig
+    type 'par t = 'par
+    val ident : 'a -> 'a
+    class alias : object method alias : 'a t -> 'a end
+    val f : < m : 'a. 'a t > -> < m : 'a. 'a >
+  end
+#       Exception: Pervasives.Exit.
+#   Exception: Pervasives.Exit.
+#   Exception: Pervasives.Exit.
+#       Characters 20-44:
+  type 'x t = < f : 'y. 'y t >;;
+      ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In the definition of t, type 'y t should be 'x t
+#                   val using_match : bool -> int * ('a -> 'a) = 
+#   - : ('a -> 'a) * ('b -> 'b) = (, )
+# - : ('a -> 'a) * ('b -> 'b) = (, )
 # 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-poly/poly.ml.reference ocaml-4.01.0/testsuite/tests/typing-poly/poly.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-poly/poly.ml.reference	2010-06-18 10:27:18.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-poly/poly.ml.reference	2013-06-28 10:47:57.000000000 +0000
@@ -1,19 +1,19 @@
 
-#   * * *       #   type 'a t = { t : 'a; }
+# * * *       #   type 'a t = { t : 'a; }
 # type 'a fold = { fold : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b; }
 # val f : 'a list -> 'a fold = 
 # - : int = 6
-#               class ['a] ilist :
-  'a list ->
-  object ('b)
-    val l : 'a list
-    method add : 'a -> 'b
-    method fold : f:('c -> 'a -> 'c) -> init:'c -> 'c
+#               class ['b] ilist :
+  'b list ->
+  object ('c)
+    val l : 'b list
+    method add : 'b -> 'c
+    method fold : f:('a -> 'b -> 'a) -> init:'a -> 'a
   end
 #         class virtual ['a] vlist :
-  object ('b)
-    method virtual add : 'a -> 'b
-    method virtual fold : f:('c -> 'a -> 'c) -> init:'c -> 'c
+  object ('c)
+    method virtual add : 'a -> 'c
+    method virtual fold : f:('b -> 'a -> 'b) -> init:'b -> 'b
   end
 #             class ilist2 :
   int list ->
@@ -25,54 +25,54 @@
 #             val ilist2 : 'a list -> 'a vlist = 
 #             class ['a] ilist3 :
   'a list ->
-  object ('b)
+  object ('c)
     val l : 'a list
-    method add : 'a -> 'b
-    method fold : f:('c -> 'a -> 'c) -> init:'c -> 'c
+    method add : 'a -> 'c
+    method fold : f:('b -> 'a -> 'b) -> init:'b -> 'b
   end
 #               class ['a] ilist4 :
   'a list ->
-  object ('b)
+  object ('c)
     val l : 'a list
-    method add : 'a -> 'b
-    method fold : f:('c -> 'a -> 'c) -> init:'c -> 'c
+    method add : 'a -> 'c
+    method fold : f:('b -> 'a -> 'b) -> init:'b -> 'b
   end
 #                 class ['a] ilist5 :
   'a list ->
-  object ('b)
+  object ('c)
     val l : 'a list
-    method add : 'a -> 'b
-    method fold : f:('c -> 'a -> 'c) -> init:'c -> 'c
-    method fold2 : f:('d -> 'a -> 'd) -> init:'d -> 'd
+    method add : 'a -> 'c
+    method fold : f:('b -> 'a -> 'b) -> init:'b -> 'b
+    method fold2 : f:('b -> 'a -> 'b) -> init:'b -> 'b
   end
 #                 class ['a] ilist6 :
   'a list ->
-  object ('b)
+  object ('c)
     val l : 'a list
-    method add : 'a -> 'b
-    method fold : f:('c -> 'a -> 'c) -> init:'c -> 'c
-    method fold2 : f:('d -> 'a -> 'd) -> init:'d -> 'd
+    method add : 'a -> 'c
+    method fold : f:('b -> 'a -> 'b) -> init:'b -> 'b
+    method fold2 : f:('b -> 'a -> 'b) -> init:'b -> 'b
   end
 #       class virtual ['a] olist :
-  object method virtual fold : f:('a -> 'b -> 'b) -> init:'b -> 'b end
+  object method virtual fold : f:('a -> 'c -> 'c) -> init:'c -> 'c end
 #         class ['a] onil :
-  object method fold : f:('a -> 'b -> 'b) -> init:'b -> 'b end
+  object method fold : f:('a -> 'c -> 'c) -> init:'c -> 'c end
 #             class ['a] ocons :
   hd:'a ->
   tl:'a olist ->
   object
     val hd : 'a
     val tl : 'a olist
-    method fold : f:('a -> 'b -> 'b) -> init:'b -> 'b
+    method fold : f:('a -> 'c -> 'c) -> init:'c -> 'c
   end
 #               class ['a] ostream :
   hd:'a ->
   tl:'a ostream ->
   object
     val hd : 'a
-    val tl : 'a ostream
+    val tl : < empty : bool; fold : 'c. f:('a -> 'c -> 'c) -> init:'c -> 'c >
     method empty : bool
-    method fold : f:('a -> 'b -> 'b) -> init:'b -> 'b
+    method fold : f:('a -> 'c -> 'c) -> init:'c -> 'c
   end
 #                   class ['a] ostream1 :
   hd:'a ->
@@ -118,14 +118,14 @@
 val p1 : point = 
 val cp : color_point = 
 val c : circle = 
-val d : float = 11.4536240470737098
-#   val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > = 
+val d : float = 11.
+#   val f : < m : 'a. 'a -> 'a > -> < m : 'b. 'b -> 'b > = 
 #   Characters 41-42:
   let f (x : < m : 'a. 'a -> 'a list >) = (x : < m : 'b. 'b -> 'c >)
                                            ^
-Error: This expression has type < m : 'a. 'a -> 'a list >
-       but an expression was expected of type < m : 'a. 'a -> 'b >
-       The universal variable 'a would escape its scope
+Error: This expression has type < m : 'b. 'b -> 'b list >
+       but an expression was expected of type < m : 'b. 'b -> 'c >
+       The universal variable 'b would escape its scope
 #           class id : object method id : 'a -> 'a end
 #         class type id_spec = object method id : 'a -> 'a end
 #       class id_impl : object method id : 'a -> 'a end
@@ -142,13 +142,13 @@
 #           Characters 80-85:
     method id _ = x
               ^^^^^
-Error: This method has type 'a -> 'a which is less general than 'b. 'b -> 'b
+Error: This method has type 'b -> 'b which is less general than 'a. 'a -> 'a
 #                 Characters 92-159:
   ............x =
       match r with
         None -> r <- Some x; x
       | Some y -> y
-Error: This method has type 'a -> 'a which is less general than 'b. 'b -> 'b
+Error: This method has type 'b -> 'b which is less general than 'a. 'a -> 'a
 #         class c : object method m : 'a -> 'b -> 'a end
 #     val f1 : id -> int * bool = 
 #   val f2 : id -> int * bool = 
@@ -167,16 +167,16 @@
 Error: The type abbreviation foo is cyclic
 #     class ['a] bar : 'a -> object  end
 #   type 'a foo = 'a foo bar
-#   - : (< m : 'b. 'b * 'a > as 'a) -> 'c * 'a = 
-# - : (< m : 'b. 'a * 'b list > as 'a) -> 'a * 'c list = 
+#   - : (< m : 'a. 'a * 'b > as 'b) -> 'c * 'b = 
+# - : (< m : 'a. 'b * 'a list > as 'b) -> 'b * 'c list = 
 # val f :
   (< m : 'b. 'a * (< n : 'b; .. > as 'b) > as 'a) ->
   'a * (< n : 'c; .. > as 'c) = 
 # - : (< p : 'b. < m : 'b; n : 'a; .. > as 'b > as 'a) ->
     (< m : 'c; n : 'a; .. > as 'c)
 = 
-# - : (< m : 'b. 'b * < p : 'd. 'd * 'c * 'a > as 'c > as 'a) ->
-    ('f * < p : 'g. 'g * 'e * 'a > as 'e)
+# - : (< m : 'a. 'a * < p : 'b. 'b * 'd * 'c > as 'd > as 'c) ->
+    ('f * < p : 'b. 'b * 'e * 'c > as 'e)
 = 
 #   - : < m : 'a. < p : 'a; .. > as 'b > -> 'b = 
 #   type sum = T of < id : 'a. 'a -> 'a >
@@ -184,14 +184,14 @@
 #   type record = { r : < id : 'a. 'a -> 'a >; }
 # - : record -> 'a -> 'a = 
 # - : record -> 'a -> 'a = 
-#       class myself : object ('a) method self : 'b -> 'a end
+#       class myself : object ('b) method self : 'a -> 'b end
 #                       class number :
-  object ('a)
+  object ('b)
     val num : int
     method num : int
-    method prev : 'a
-    method succ : 'a
-    method switch : zero:(unit -> 'b) -> prev:('a -> 'b) -> 'b
+    method prev : 'b
+    method succ : 'b
+    method switch : zero:(unit -> 'a) -> prev:('b -> 'a) -> 'a
   end
 #     val id : 'a -> 'a = 
 #       class c : object method id : 'a -> 'a end
@@ -201,14 +201,14 @@
     val mutable count : int
     method count : int
     method id : 'a -> 'a
-    method old : 'b -> 'b
+    method old : 'a -> 'a
   end
 #             class ['a] olist :
   'a list ->
-  object ('b)
+  object ('c)
     val l : 'a list
-    method cons : 'a -> 'b
-    method fold : f:('a -> 'c -> 'c) -> init:'c -> 'c
+    method cons : 'a -> 'c
+    method fold : f:('a -> 'b -> 'b) -> init:'b -> 'b
   end
 #   val sum : int #olist -> int = 
 #   val count : 'a #olist -> int = 
@@ -229,16 +229,16 @@
 # Characters 17-25:
   let bad = {bad = ref None};;
                    ^^^^^^^^
-Error: This field value has type 'a option ref which is less general than
-         'b. 'b option ref
+Error: This field value has type 'b option ref which is less general than
+         'a. 'a option ref
 # type bad2 = { mutable bad2 : 'a. 'a option ref option; }
 # val bad2 : bad2 = {bad2 = None}
 # Characters 13-28:
   bad2.bad2 <- Some (ref None);;
                ^^^^^^^^^^^^^^^
-Error: This field value has type 'a option ref option
-       which is less general than 'b. 'b option ref option
-#       val f : < m : 'a. < p : 'a * 'b > as 'b > -> 'c -> unit = 
+Error: This field value has type 'b option ref option
+       which is less general than 'a. 'a option ref option
+#       val f : < m : 'a. < p : 'a * 'c > as 'c > -> 'b -> unit = 
 # val f : < m : 'a. 'a * (< p : int * 'b > as 'b) > -> 'b -> unit = 
 #       type 'a t = [ `A of 'a ]
 #       class c : object method m : ([> 'a t ] as 'a) -> unit end
@@ -248,10 +248,10 @@
 #           Characters 145-166:
   object method virtual visit : 'a.('a visitor -> 'a) end;;
                                 ^^^^^^^^^^^^^^^^^^^^^
-Error: This type scheme cannot quantify 'a :
-it escapes this scope.
+Error: The universal type variable 'a cannot be generalized:
+       it escapes its scope.
 #                 type ('a, 'b) list_visitor = < caseCons : 'b -> 'b list -> 'a; caseNil : 'a >
-type 'a alist = < visit : 'b. ('b, 'a) list_visitor -> 'b >
+type 'b alist = < visit : 'a. ('a, 'b) list_visitor -> 'a >
 class type ct = object ('a) method fold : ('b -> 'a -> 'b) -> 'b -> 'b end
 type t = { f : 'a 'b. ('b -> (#ct as 'a) -> 'b) -> 'b; }
 #     Characters 20-25:
@@ -264,7 +264,7 @@
   type ('a,'b) t constraint 'a = 'b and ('a,'b) u = ('a,'b) t;;
                                                     ^^^^^^^^^
 Error: Constraints are not satisfied in this type.
-Type ('a, 'b) t should be an instance of ('c, 'c) t
+       Type ('a, 'b) t should be an instance of ('c, 'c) t
 #     type 'a t = 'a
 and u = int t
 #     type 'a t constraint 'a = int
@@ -272,7 +272,7 @@
   type 'a u = 'a and 'a v = 'a u t;;
                             ^^^^^^
 Error: Constraints are not satisfied in this type.
-Type 'a u t should be an instance of int t
+       Type 'a u t should be an instance of int t
 # type 'a u = 'a constraint 'a = int
 and 'a v = 'a u t constraint 'a = int
 #     type g = int
@@ -281,9 +281,9 @@
   type 'a u = 'a and 'a v = 'a u t;;
                             ^^^^^^
 Error: Constraints are not satisfied in this type.
-Type 'a u t should be an instance of g t
+       Type 'a u t should be an instance of g t
 # type 'a u = 'a constraint 'a = g
-and 'a v = 'a u t constraint 'a = int
+and 'a v = 'a u t constraint 'a = g
 #     Characters 38-58:
   type 'a u = < m : 'a v > and 'a v = 'a list u;;
       ^^^^^^^^^^^^^^^^^^^^
@@ -330,13 +330,13 @@
 Warning 11: this match case is unused.
 - : int * [< `B ] -> int = 
 #       Characters 69-135:
-  type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b] 
+  type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b]
        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Constraints are not satisfied in this type.
-Type
-([> `B of 'a ], 'a) b as 'a
-should be an instance of
-(('b, [> `A of 'b ] as 'c) a as 'b, 'c) b
+       Type
+       ([> `B of 'a ], 'a) b as 'a
+       should be an instance of
+       (('b, [> `A of 'b ] as 'c) a as 'b, 'c) b
 #     *                           class type ['a, 'b] a =
   object
     constraint 'a = < as_a : ('a, 'b) a as 'c; b : 'b; .. >
@@ -395,9 +395,9 @@
 #         Characters 76-77:
     (x :  > as 'bar) >);;
      ^
-Error: This expression has type < m : 'b. 'b * < m : 'b * 'a > > as 'a
+Error: This expression has type < m : 'a. 'a * < m : 'a * 'b > > as 'b
        but an expression was expected of type
-         < m : 'b. 'b * (< m : 'b * < m : 'd. 'd * 'c > > as 'c) >
+         < m : 'a. 'a * (< m : 'a * < m : 'c. 'c * 'd > > as 'd) >
        Types for method m are incompatible
 #         Characters 176-177:
   let f (x : foo') = (x : bar');;
@@ -405,70 +405,66 @@
 Error: This expression has type foo' = < m : 'a. 'a * 'a foo >
        but an expression was expected of type bar' = < m : 'a. 'a * 'a bar >
        Type 'a foo = < m : 'a * 'a foo > is not compatible with type
-         'a bar = < m : 'a * < m : 'b. 'b * 'a bar > > 
+         'a bar = < m : 'a * < m : 'c. 'c * 'a bar > > 
        Type 'a foo = < m : 'a * 'a foo > is not compatible with type
-         < m : 'b. 'b * 'a bar > 
+         < m : 'c. 'c * 'a bar > 
        Types for method m are incompatible
 #     Characters 67-68:
     (x : )> as 'bar);;
      ^
 Error: This expression has type
-         < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) >
+         < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) >
        but an expression was expected of type
-         < m : 'a. 'a * ('a * < m : 'c. 'c * ('c * 'd) >) > as 'd
+         < m : 'b. 'b * ('b * < m : 'c. 'c * ('c * 'd) >) > as 'd
        Types for method m are incompatible
 #   Characters 66-67:
     (x : )> as 'bar);;
      ^
 Error: This expression has type
-         < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) >
+         < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) >
        but an expression was expected of type
-         < m : 'a. 'a * ('a * < m : 'c. 'c * ('a * 'd) >) > as 'd
+         < m : 'b. 'b * ('b * < m : 'c. 'c * ('b * 'd) >) > as 'd
        Types for method m are incompatible
 #   Characters 51-52:
     (x :  as 'bar)>);;
      ^
 Error: This expression has type < m : 'b. 'b * ('b * 'a) > as 'a
        but an expression was expected of type
-         < m : 'b. 'b * ('b * < m : 'd. 'd * 'c > as 'c) >
+         < m : 'b. 'b * ('b * < m : 'c. 'c * 'd > as 'd) >
        Types for method m are incompatible
 #     Characters 14-115:
   ....(x :  ('a *  'bar> as 'bar)>
          :>  ('a * 'foo)> as 'foo)..
-Error: Type < m : 'a. 'a -> ('a * (< m : 'd. 'd -> 'b as 'e > as 'c) as 'b) >
+Error: Type < m : 'a. 'a -> ('a * (< m : 'c. 'c -> 'b as 'e > as 'd) as 'b) >
        is not a subtype of < m : 'a. 'a -> ('a * 'f as 'h) as 'g > as 'f 
+       Type 'c. 'e is not a subtype of 'a. 'g 
 #       Characters 88-150:
   = struct let f (x :  as 'foo) = () end;;
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Signature mismatch:
-       Modules do not match:
-         sig val f : (< m : 'b. 'b * ('b * 'a) > as 'a) -> unit end
-       is not included in
-         sig
-           val f : < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) > -> unit
-         end
+       ...
        Values do not match:
-         val f : (< m : 'b. 'b * ('b * 'a) > as 'a) -> unit
+         val f : (< m : 'a. 'a * ('a * 'b) > as 'b) -> unit
        is not included in
-         val f : < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) > -> unit
+         val f : < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) > -> unit
 #     Characters 78-132:
   = struct type t =  as 'foo end;;
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Signature mismatch:
        Modules do not match:
-         sig type t = < m : 'b. 'b * ('b * 'a) > as 'a end
+         sig type t = < m : 'a. 'a * ('a * 'b) > as 'b end
        is not included in
-         sig type t = < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) > end
+         sig type t = < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) > end
        Type declarations do not match:
-         type t = < m : 'b. 'b * ('b * 'a) > as 'a
+         type t = < m : 'a. 'a * ('a * 'b) > as 'b
        is not included in
-         type t = < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) >
+         type t = < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) >
 #     module M : sig type 'a t type u = < m : 'a. 'a t > end
 #   module M : sig type 'a t val f : < m : 'a. 'a t > -> int end
 #     module M : sig type 'a t val f : < m : 'a. 'a t > -> int end
 #         val f :
-  (< m : 'b. 'b -> (< m : 'b. 'b -> 'c * <  > > as 'c) * < .. >; .. > as 'a) ->
-  'a -> bool = 
+  (< m : 'a. 'a -> (< m : 'a. 'a -> 'c * <  > > as 'c) * < .. >; .. > as 'b) ->
+  'b -> bool = 
 #         type t = [ `A | `B ]
 # type v = private [> t ]
 # - : t -> v = 
@@ -495,34 +491,47 @@
       :>  as 'b) -> int>)..
 Error: Type < m : 'a. (< p : int; .. > as 'a) -> int > is not a subtype of
          < m : 'b. (< p : int; q : int; .. > as 'b) -> int > 
+       Type < p : int; q : int; .. > as 'c is not a subtype of
+         < p : int; .. > as 'd 
 #     val f2 :
   < m : 'a. (< p : < a : int >; .. > as 'a) -> int > ->
-  < m : 'a. (< p : < a : int; b : int >; .. > as 'a) -> int > = 
+  < m : 'b. (< p : < a : int; b : int >; .. > as 'b) -> int > = 
 #     Characters 13-107:
   ..(x : ;..> as 'a) -> int>
       :> ;..> as 'b) -> int>)..
 Error: Type < m : 'a. (< p : < a : int; b : int >; .. > as 'a) -> int >
-       is not a subtype of < m : 'a. (< p : < a : int >; .. > as 'a) -> int > 
+       is not a subtype of < m : 'b. (< p : < a : int >; .. > as 'b) -> int > 
+       Type < a : int > is not a subtype of < a : int; b : int > 
 # Characters 11-55:
   let f4 x = (x : ;..> :> ;..>);;
              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Type < p : < a : int; b : int >; .. > is not a subtype of
          < p : < a : int >; .. > 
-The second object type has no method b
+       The second object type has no method b
 #   val f5 :
   < m : 'a. [< `A of < p : int > ] as 'a > ->
-  < m : 'a. [< `A of <  > ] as 'a > = 
+  < m : 'b. [< `A of <  > ] as 'b > = 
 #   Characters 13-83:
     (x :  ] as 'a> :>  ] as 'a>);;
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Type < m : 'a. [< `A of <  > ] as 'a > is not a subtype of
-         < m : 'a. [< `A of < p : int > ] as 'a > 
+         < m : 'b. [< `A of < p : int > ] as 'b > 
+       Type <  > is not a subtype of < p : int > 
+#     val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > = 
+# - : < m : 'a. 'a -> 'a > -> 'b -> 'b = 
+# val f : < m : 'a. 'a -> 'a > * 'b -> < m : 'a. 'a -> 'a > = 
+# - : < m : 'a. 'a -> 'a > -> 'b -> 'b = 
+# val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > array = 
+# - : < m : 'a. 'a -> 'a > -> 'b -> 'b = 
 #     class c : object method id : 'a -> 'a end
 # type u = c option
 # val just : 'a option -> 'a = 
 # val f : c -> 'a -> 'a = 
 #     val g : c -> 'a -> 'a = 
 #     val h : < id : 'a; .. > -> 'a = 
+#     type 'a u = c option
+# val just : 'a option -> 'a = 
+# val f : c -> 'a -> 'a = 
 #       val f : 'a -> int = 
 val g : 'a -> int = 
 # type 'a t = Leaf of 'a | Node of ('a * 'a) t
@@ -531,7 +540,7 @@
     function Leaf _ -> 1 | Node x -> 1 + d x
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: This definition has type 'a t -> int which is less general than
-         'b. 'b t -> int
+         'a0. 'a0 t -> int
 #   Characters 34-78:
     function Leaf x -> x | Node x -> 1 + depth x;; (* fails *)
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
@@ -541,12 +550,12 @@
     function Leaf x -> x | Node x -> depth x;; (* fails *)
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: This definition has type 'a t -> 'a which is less general than
-         'b. 'b t -> 'a
+         'a0. 'a0 t -> 'a
 #   Characters 38-78:
     function Leaf x -> x | Node x -> depth x;; (* fails *)
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This definition has type 'a. 'a t -> 'a which is less general than
-         'b 'c. 'c t -> 'b
+Error: This definition has type 'b. 'b t -> 'b which is less general than
+         'a 'b. 'a t -> 'b
 #   val r : 'a list * '_b list ref = ([], {contents = []})
 val q : unit -> 'a list * '_b list ref = 
 # val f : 'a -> 'a = 
@@ -574,9 +583,26 @@
 val l : t = {f = }
 #     type t = { f : 'a. 'a -> unit; }
 # - : t = {f = }
-# Characters 3-16:
-  {f=fun ?x y -> y};; (* fail *)
-     ^^^^^^^^^^^^^
+# Characters 19-20:
+  let f ?x y = y in {f};; (* fail *)
+                     ^
 Error: This field value has type unit -> unit which is less general than
          'a. 'a -> unit
+#               module Polux :
+  sig
+    type 'par t = 'par
+    val ident : 'a -> 'a
+    class alias : object method alias : 'a t -> 'a end
+    val f : < m : 'a. 'a t > -> < m : 'a. 'a >
+  end
+#       Exception: Pervasives.Exit.
+#   Exception: Pervasives.Exit.
+#   Exception: Pervasives.Exit.
+#       Characters 20-44:
+  type 'x t = < f : 'y. 'y t >;;
+      ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In the definition of t, type 'y t should be 'x t
+#                   val using_match : bool -> int * ('a -> 'a) = 
+#   - : ('a -> 'a) * ('b -> 'b) = (, )
+# - : ('a -> 'a) * ('b -> 'b) = (, )
 # 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-poly-bugs/Makefile ocaml-4.01.0/testsuite/tests/typing-poly-bugs/Makefile
--- ocaml-3.12.1/testsuite/tests/typing-poly-bugs/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-poly-bugs/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,15 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.okbad
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/typing-poly-bugs/pr5322_ok.ml ocaml-4.01.0/testsuite/tests/typing-poly-bugs/pr5322_ok.ml
--- ocaml-3.12.1/testsuite/tests/typing-poly-bugs/pr5322_ok.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-poly-bugs/pr5322_ok.ml	2012-07-30 18:04:46.000000000 +0000
@@ -0,0 +1,6 @@
+type 'par t = 'par
+module M : sig val x :  end =
+  struct let x :  = Obj.magic () end
+
+let ident v = v
+class alias = object method alias : 'a . 'a t -> 'a = ident end
diff -Nru ocaml-3.12.1/testsuite/tests/typing-poly-bugs/pr5673_bad.ml ocaml-4.01.0/testsuite/tests/typing-poly-bugs/pr5673_bad.ml
--- ocaml-3.12.1/testsuite/tests/typing-poly-bugs/pr5673_bad.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-poly-bugs/pr5673_bad.ml	2012-12-27 07:19:12.000000000 +0000
@@ -0,0 +1,23 @@
+module Classdef = struct
+  class virtual ['a, 'b, 'c] cl0 =
+    object 
+      constraint 'c = < m : 'a -> 'b -> int; .. > 
+    end
+
+  class virtual ['a, 'b] cl1 =
+    object
+      method virtual raise_trouble : int -> 'a
+      method virtual m : 'a -> 'b -> int
+    end
+
+  class virtual ['a, 'b] cl2 =
+    object
+      method virtual as_cl0 : ('a, 'b, ('a, 'b) cl1) cl0
+    end
+end
+
+type refer1 = < poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) >
+type refer2 = < poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) >
+
+(* Actually this should succeed ... *)
+let f (x : refer1) = (x : refer2)
diff -Nru ocaml-3.12.1/testsuite/tests/typing-poly-bugs/pr5673_ok.ml ocaml-4.01.0/testsuite/tests/typing-poly-bugs/pr5673_ok.ml
--- ocaml-3.12.1/testsuite/tests/typing-poly-bugs/pr5673_ok.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-poly-bugs/pr5673_ok.ml	2012-12-27 07:19:12.000000000 +0000
@@ -0,0 +1,23 @@
+module Classdef = struct
+  class virtual ['a, 'b, 'c] cl0 =
+    object 
+      constraint 'c = < m : 'a -> 'b -> int; .. > 
+    end
+
+  class virtual ['a, 'b] cl1 =
+    object
+      method virtual raise_trouble : int -> 'a
+      method virtual m : 'a -> 'b -> int
+    end
+
+  class virtual ['a, 'b] cl2 =
+    object
+      method virtual as_cl0 : ('a, 'b, ('a, 'b) cl1) cl0
+    end
+end
+
+module M : sig
+  type refer = { poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) }
+end = struct
+  type refer = { poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) }
+end
diff -Nru ocaml-3.12.1/testsuite/tests/typing-polyvariants-bugs/Makefile ocaml-4.01.0/testsuite/tests/typing-polyvariants-bugs/Makefile
--- ocaml-3.12.1/testsuite/tests/typing-polyvariants-bugs/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-polyvariants-bugs/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,2 +1,15 @@
-include ../../makefiles/Makefile.okbad
-include ../../makefiles/Makefile.common
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.okbad
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/typing-polyvariants-bugs/pr5057_ok.ml ocaml-4.01.0/testsuite/tests/typing-polyvariants-bugs/pr5057_ok.ml
--- ocaml-3.12.1/testsuite/tests/typing-polyvariants-bugs/pr5057_ok.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-polyvariants-bugs/pr5057_ok.ml	2012-07-30 18:04:46.000000000 +0000
@@ -5,7 +5,7 @@
 end
 
 let () =
-  let f flag = 
+  let f flag =
     let module T = TT in
     let _ = match flag with `A -> 0 | `B r -> r in
     let _ = match flag with `A -> T.IntSet.mem | `B r -> r in
diff -Nru ocaml-3.12.1/testsuite/tests/typing-polyvariants-bugs/pr5057a_bad.ml ocaml-4.01.0/testsuite/tests/typing-polyvariants-bugs/pr5057a_bad.ml
--- ocaml-3.12.1/testsuite/tests/typing-polyvariants-bugs/pr5057a_bad.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-polyvariants-bugs/pr5057a_bad.ml	2012-07-30 18:04:46.000000000 +0000
@@ -1,6 +1,6 @@
 (* This one should fail *)
 
-let f flag = 
+let f flag =
   let module T = Set.Make(struct type t = int let compare = compare end) in
   let _ = match flag with `A -> 0 | `B r -> r in
   let _ = match flag with `A -> T.mem | `B r -> r in
diff -Nru ocaml-3.12.1/testsuite/tests/typing-polyvariants-bugs-2/Makefile ocaml-4.01.0/testsuite/tests/typing-polyvariants-bugs-2/Makefile
--- ocaml-3.12.1/testsuite/tests/typing-polyvariants-bugs-2/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-polyvariants-bugs-2/Makefile	2013-05-03 15:52:56.000000000 +0000
@@ -1,7 +1,23 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 default:
 	@printf " ... testing 'pr3918':"
-	@($(OCAMLC) -c pr3918a.mli && $(OCAMLC) -c pr3918b.mli && $(OCAMLC) -c pr3918c.ml && echo " => passed") || echo " => failed"
+	@($(OCAMLC) -c pr3918a.mli \
+	&& $(OCAMLC) -c pr3918b.mli \
+	&& $(OCAMLC) -c pr3918c.ml \
+	&& echo " => passed") || echo " => failed"
 
 clean: defaultclean
 
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/typing-private/.svnignore ocaml-4.01.0/testsuite/tests/typing-private/.svnignore
--- ocaml-3.12.1/testsuite/tests/typing-private/.svnignore	2011-05-17 12:08:13.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-private/.svnignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,10 +0,0 @@
-#!/bin/sh
-
-svn propset svn:ignore -F - . < t
 end = M;;
 
-module M4 : sig   
+module M4 : sig
     type t = M.t = T of int
     val mk : int -> t
   end = M;;
 (* Error: The variant or record definition does not match that of type M.t *)
 
-module M5 : sig   
+module M5 : sig
   type t = M.t = private T of int
   val mk : int -> t
 end = M;;
 
-module M6 : sig   
+module M6 : sig
   type t = private T of int
   val mk : int -> t
 end = M;;
@@ -87,3 +87,19 @@
   type t = M'.t
   val mk : int -> t
 end = M';;
+
+module M : sig type 'a t = private T of 'a end =
+  struct type 'a t = T of 'a end;;
+
+module M1 : sig type 'a t = 'a M.t = private T of 'a end =
+  struct type 'a t = 'a M.t = private T of 'a end;;
+
+(* PR#6090 *)
+module Test = struct type t = private A end
+module Test2 : module type of Test with type t = Test.t = Test;;
+let f (x : Test.t) = (x : Test2.t);;
+let f Test2.A = ();;
+let a = Test2.A;; (* fail *)
+(* The following should fail from a semantical point of view,
+   but allow it for backward compatibility *)
+module Test2 : module type of Test with type t = private Test.t = Test;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-private/private.ml.reference ocaml-4.01.0/testsuite/tests/typing-private/private.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-private/private.ml.reference	2010-06-18 10:27:18.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-private/private.ml.reference	2013-07-31 02:18:46.000000000 +0000
@@ -7,7 +7,7 @@
 Error: This expression has type F0.t but an expression was expected of type
          Foobar.t
 #   module F : sig type t = Foobar.t end
-#   val f : F.t -> F.t = 
+#   val f : F.t -> Foobar.t = 
 #   module M : sig type t = < m : int > end
 # module M1 : sig type t = private < m : int; .. > end
 # module M2 : sig type t = private < m : int; .. > end
@@ -73,7 +73,7 @@
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Signature mismatch:
        Modules do not match:
-         sig type t = int val f : t -> t end
+         sig type t = int val f : int -> t end
        is not included in
          sig type t = private Foobar.t val f : int -> t end
        Type declarations do not match:
@@ -84,7 +84,7 @@
 #               module M1 : sig type t = M.t val mk : int -> t end
 #             module M2 : sig type t = M.t val mk : int -> t end
 #         module M3 : sig type t = M.t val mk : int -> t end
-#         Characters 29-47:
+#         Characters 26-44:
       type t = M.t = T of int
            ^^^^^^^^^^^^^^^^^^
 Error: This variant or record definition does not match that of type M.t
@@ -94,4 +94,15 @@
 #                   module M' :
   sig type t_priv = private T of int type t = t_priv val mk : int -> t end
 #         module M3' : sig type t = M'.t val mk : int -> t end
+#     module M : sig type 'a t = private T of 'a end
+#     module M1 : sig type 'a t = 'a M.t = private T of 'a end
+#       module Test : sig type t = private A end
+module Test2 : sig type t = Test.t = private A end
+# val f : Test.t -> Test2.t = 
+# val f : Test2.t -> unit = 
+# Characters 8-15:
+  let a = Test2.A;; (* fail *)
+          ^^^^^^^
+Error: Cannot create values of the private type Test2.t
+# *   module Test2 : sig type t = Test.t = private A end
 # 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-private-bugs/Makefile ocaml-4.01.0/testsuite/tests/typing-private-bugs/Makefile
--- ocaml-3.12.1/testsuite/tests/typing-private-bugs/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-private-bugs/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,2 +1,15 @@
-include ../../makefiles/Makefile.okbad
-include ../../makefiles/Makefile.common
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.okbad
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/typing-private-bugs/pr5026_bad.ml ocaml-4.01.0/testsuite/tests/typing-private-bugs/pr5026_bad.ml
--- ocaml-3.12.1/testsuite/tests/typing-private-bugs/pr5026_bad.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-private-bugs/pr5026_bad.ml	2012-07-30 18:04:46.000000000 +0000
@@ -3,7 +3,7 @@
 type -'typing wrapped = private sexp
 and +'a t = 'a typed wrapped
 and sexp = private untyped wrapped;;
-class type ['a] s3 = object 
+class type ['a] s3 = object
   val underlying : 'a t
 end;;
 class ['a] s3object r : ['a] s3 = object
diff -Nru ocaml-3.12.1/testsuite/tests/typing-private-bugs/pr5469_ok.ml ocaml-4.01.0/testsuite/tests/typing-private-bugs/pr5469_ok.ml
--- ocaml-3.12.1/testsuite/tests/typing-private-bugs/pr5469_ok.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-private-bugs/pr5469_ok.ml	2012-01-10 03:01:50.000000000 +0000
@@ -0,0 +1,7 @@
+module M (T:sig type t end)
+ = struct type t = private { t : T.t } end
+module P
+ = struct
+       module T = struct type t end
+       module R = M(T)
+ end
diff -Nru ocaml-3.12.1/testsuite/tests/typing-recmod/Makefile ocaml-4.01.0/testsuite/tests/typing-recmod/Makefile
--- ocaml-3.12.1/testsuite/tests/typing-recmod/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-recmod/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -1,2 +1,15 @@
-include ../../makefiles/Makefile.okbad
-include ../../makefiles/Makefile.common
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.okbad
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/typing-recmod/t02bad.ml ocaml-4.01.0/testsuite/tests/typing-recmod/t02bad.ml
--- ocaml-3.12.1/testsuite/tests/typing-recmod/t02bad.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-recmod/t02bad.ml	2012-07-30 18:04:46.000000000 +0000
@@ -1,4 +1,3 @@
 (* Bad (t = t) *)
 module rec A : sig type t = B.t end = struct type t = B.t end
        and B : sig type t = A.t end = struct type t = A.t end;;
-
diff -Nru ocaml-3.12.1/testsuite/tests/typing-recmod/t08bad.ml ocaml-4.01.0/testsuite/tests/typing-recmod/t08bad.ml
--- ocaml-3.12.1/testsuite/tests/typing-recmod/t08bad.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-recmod/t08bad.ml	2012-07-30 18:04:46.000000000 +0000
@@ -2,4 +2,3 @@
 module rec A : sig type 'a t =  end
              = struct type 'a t =  end
        and B : sig type 'a t = 'a A.t end = struct type 'a t = 'a A.t end;;
-
diff -Nru ocaml-3.12.1/testsuite/tests/typing-recmod/t13ok.ml ocaml-4.01.0/testsuite/tests/typing-recmod/t13ok.ml
--- ocaml-3.12.1/testsuite/tests/typing-recmod/t13ok.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-recmod/t13ok.ml	2012-07-30 18:04:46.000000000 +0000
@@ -1,5 +1,5 @@
 (* OK *)
 class type [ 'node ] extension = object method node : 'node end
-class type [ 'ext ] node = object constraint 'ext = 'ext node #extension end 
+class type [ 'ext ] node = object constraint 'ext = 'ext node #extension end
 class x = object method node : x node = assert false end
 type t = x node;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-recmod/t14bad.ml ocaml-4.01.0/testsuite/tests/typing-recmod/t14bad.ml
--- ocaml-3.12.1/testsuite/tests/typing-recmod/t14bad.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-recmod/t14bad.ml	2012-07-30 18:04:46.000000000 +0000
@@ -13,5 +13,5 @@
   end
 
   module rec U : T with module D = U' = U
-  and U' : S with type t = U'.t = U 
+  and U' : S with type t = U'.t = U
 end;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-recmod/t16ok.ml ocaml-4.01.0/testsuite/tests/typing-recmod/t16ok.ml
--- ocaml-3.12.1/testsuite/tests/typing-recmod/t16ok.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-recmod/t16ok.ml	2012-07-30 18:04:46.000000000 +0000
@@ -28,4 +28,3 @@
     let create l = new c l
   end
 end;;
-
diff -Nru ocaml-3.12.1/testsuite/tests/typing-recmod/t17ok.ml ocaml-4.01.0/testsuite/tests/typing-recmod/t17ok.ml
--- ocaml-3.12.1/testsuite/tests/typing-recmod/t17ok.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-recmod/t17ok.ml	2012-07-30 18:04:46.000000000 +0000
@@ -25,18 +25,17 @@
     type t = I of int * int | D of int * Diet.t * int
     val compare : t -> t -> int
     val iter : (int -> unit) -> t -> unit
-  end = 
+  end =
   struct
     type t = I of int * int | D of int * Diet.t * int
     let compare x1 x2 = 0
     let rec iter f = function
       | I (l, r) -> for i = l to r do f i done
       | D (_, d, _) -> Diet.iter (iter f) d
-  end 
+  end
 
   and Diet : SET with type t = Elt.t tree and type elt = Elt.t = MakeDiet(Elt)
 
   type t = Diet.t
   let iter f = Diet.iter (Elt.iter f)
 end
-
diff -Nru ocaml-3.12.1/testsuite/tests/typing-recmod/t18ok.ml ocaml-4.01.0/testsuite/tests/typing-recmod/t18ok.ml
--- ocaml-3.12.1/testsuite/tests/typing-recmod/t18ok.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-recmod/t18ok.ml	2012-07-30 18:04:46.000000000 +0000
@@ -22,5 +22,4 @@
     end
   = struct
       type t = DirCompare.t list
-    end      
-
+    end
diff -Nru ocaml-3.12.1/testsuite/tests/typing-recmod/t19ok.ml ocaml-4.01.0/testsuite/tests/typing-recmod/t19ok.ml
--- ocaml-3.12.1/testsuite/tests/typing-recmod/t19ok.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-recmod/t19ok.ml	2012-07-30 18:04:46.000000000 +0000
@@ -10,4 +10,3 @@
     module Other = A
   end
 end
-
diff -Nru ocaml-3.12.1/testsuite/tests/typing-recmod/t22ok.ml ocaml-4.01.0/testsuite/tests/typing-recmod/t22ok.ml
--- ocaml-3.12.1/testsuite/tests/typing-recmod/t22ok.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-recmod/t22ok.ml	2012-07-30 18:04:46.000000000 +0000
@@ -112,7 +112,7 @@
 ;;
 
 module rec Strengthen2
-  : sig type t 
+  : sig type t
         val f : t -> t
         module M : sig type u end
         module R : sig type v end
@@ -150,7 +150,7 @@
       | Node(l,r) -> 1 + max (PolyRec.depth l) (PolyRec.depth r)
     end
 ;;
-  
+
 (* Wrong LHS signatures (PR#4336) *)
 
 (*
@@ -212,7 +212,7 @@
   : sig
       type t = (string * Expr.t) list
       val fv: t -> StringSet.t
-      val bv: t -> StringSet.t    
+      val bv: t -> StringSet.t
       val simpl: t -> t
     end
   = struct
@@ -258,7 +258,7 @@
     val deleteMin: heap -> heap
   end
 
-module Bootstrap (MakeH: functor (Element:ORDERED) -> 
+module Bootstrap (MakeH: functor (Element:ORDERED) ->
                                     HEAP with module Elem = Element)
                  (Element: ORDERED) : HEAP with module Elem = Element =
   struct
@@ -268,7 +268,7 @@
           val eq: t -> t -> bool
           val lt: t -> t -> bool
           val leq: t -> t -> bool
-      end                  
+      end
     = struct
         type t = E | H of Elem.t * PrimH.heap
         let leq t1 t2 =
@@ -432,7 +432,7 @@
       module A = (Coerce1: sig val f: int -> int end)
       let g x = x
       let f x = if x <= 0 then 1 else A.f (x-1) * x
-    end 
+    end
 ;;
 
 let _ =
@@ -461,7 +461,7 @@
 end
 
 module rec Coerce5
-  : sig val blabla: int -> int val f: int -> int end 
+  : sig val blabla: int -> int val f: int -> int end
   = struct let blabla x = 0 let f x = 5 end
 and Coerce6
   : sig val at: int -> int end
@@ -473,16 +473,16 @@
 
 (* Miscellaneous bug reports *)
 
-module rec F 
+module rec F
   : sig type t = X of int | Y of int
         val f: t -> bool
     end
   = struct
-      type t = X of int | Y of int  
+      type t = X of int | Y of int
       let f = function
         | X _ -> false
         | _ -> true
-    end;; 
+    end;;
 
 let _ =
   test 100 (F.f (F.X 1)) false;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-rectypes-bugs/Makefile ocaml-4.01.0/testsuite/tests/typing-rectypes-bugs/Makefile
--- ocaml-3.12.1/testsuite/tests/typing-rectypes-bugs/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-rectypes-bugs/Makefile	2012-12-02 02:46:22.000000000 +0000
@@ -0,0 +1,15 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+include ../../makefiles/Makefile.okbad
+include ../../makefiles/Makefile.common
+COMPFLAGS = -rectypes
diff -Nru ocaml-3.12.1/testsuite/tests/typing-rectypes-bugs/pr5343_bad.ml ocaml-4.01.0/testsuite/tests/typing-rectypes-bugs/pr5343_bad.ml
--- ocaml-3.12.1/testsuite/tests/typing-rectypes-bugs/pr5343_bad.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-rectypes-bugs/pr5343_bad.ml	2012-12-02 02:46:22.000000000 +0000
@@ -0,0 +1,13 @@
+module M : sig
+  type 'a t
+  type u = u t and v = v t
+  val f : int -> u
+  val g : v -> bool
+end = struct
+  type 'a t = 'a
+  type u = int and v = bool
+  let f x = x
+  let g x = x
+end;;
+
+let h (x : int) : bool = M.g (M.f x);;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-short-paths/Makefile ocaml-4.01.0/testsuite/tests/typing-short-paths/Makefile
--- ocaml-3.12.1/testsuite/tests/typing-short-paths/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-short-paths/Makefile	2013-02-09 08:42:11.000000000 +0000
@@ -0,0 +1,16 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.toplevel
+include $(BASEDIR)/makefiles/Makefile.common
+TOPFLAGS = -short-paths
diff -Nru ocaml-3.12.1/testsuite/tests/typing-short-paths/pr5918.ml ocaml-4.01.0/testsuite/tests/typing-short-paths/pr5918.ml
--- ocaml-3.12.1/testsuite/tests/typing-short-paths/pr5918.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-short-paths/pr5918.ml	2013-02-13 01:39:48.000000000 +0000
@@ -0,0 +1,7 @@
+module rec A : sig
+ type t
+end = struct
+ type t = { a : unit; b : unit }
+ let _ = { a = () }
+end
+;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-short-paths/pr5918.ml.reference ocaml-4.01.0/testsuite/tests/typing-short-paths/pr5918.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-short-paths/pr5918.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-short-paths/pr5918.ml.reference	2013-02-13 01:39:48.000000000 +0000
@@ -0,0 +1,6 @@
+
+#             Characters 82-92:
+   let _ = { a = () }
+           ^^^^^^^^^^
+Error: Some record fields are undefined: b
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-short-paths/short-paths.ml ocaml-4.01.0/testsuite/tests/typing-short-paths/short-paths.ml
--- ocaml-3.12.1/testsuite/tests/typing-short-paths/short-paths.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-short-paths/short-paths.ml	2013-04-30 09:05:26.000000000 +0000
@@ -0,0 +1,48 @@
+module Core = struct
+  module Int = struct
+    module T = struct
+      type t = int
+      let compare = compare
+      let (+) x y = x + y
+    end
+    include T
+    module Map = Map.Make(T)
+  end
+
+  module Std = struct
+    module Int = Int
+  end
+end
+;;
+
+open Core.Std
+;;
+
+let x = Int.Map.empty ;;
+let y = x + x ;;
+
+(* Avoid ambiguity *)
+
+module M = struct type t = A type u = C end
+module N = struct type t = B end
+open M open N;;
+A;;
+B;;
+C;;
+
+include M open M;;
+C;;
+
+module L = struct type v = V end
+open L;;
+V;;
+module L = struct type v = V end
+open L;;
+V;;
+
+
+type t1 = A;;
+module M1 = struct type u = v and v = t1 end;;
+module N1 = struct type u = v and v = M1.v end;;
+type t1 = B;;
+module N2 = struct type u = v and v = M1.v end;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-short-paths/short-paths.ml.reference ocaml-4.01.0/testsuite/tests/typing-short-paths/short-paths.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-short-paths/short-paths.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-short-paths/short-paths.ml.reference	2013-05-02 01:02:15.000000000 +0000
@@ -0,0 +1,117 @@
+
+#                               module Core :
+  sig
+    module Int :
+      sig
+        module T :
+          sig
+            type t = int
+            val compare : 'a -> 'a -> t
+            val ( + ) : t -> t -> t
+          end
+        type t = int
+        val compare : 'a -> 'a -> t
+        val ( + ) : t -> t -> t
+        module Map :
+          sig
+            type key = t
+            type 'a t = 'a Map.Make(T).t
+            val empty : 'a t
+            val is_empty : 'a t -> bool
+            val mem : key -> 'a t -> bool
+            val add : key -> 'a -> 'a t -> 'a t
+            val singleton : key -> 'a -> 'a t
+            val remove : key -> 'a t -> 'a t
+            val merge :
+              (key -> 'a option -> 'b option -> 'c option) ->
+              'a t -> 'b t -> 'c t
+            val compare : ('a -> 'a -> key) -> 'a t -> 'a t -> key
+            val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+            val iter : (key -> 'a -> unit) -> 'a t -> unit
+            val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+            val for_all : (key -> 'a -> bool) -> 'a t -> bool
+            val exists : (key -> 'a -> bool) -> 'a t -> bool
+            val filter : (key -> 'a -> bool) -> 'a t -> 'a t
+            val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+            val cardinal : 'a t -> key
+            val bindings : 'a t -> (key * 'a) list
+            val min_binding : 'a t -> key * 'a
+            val max_binding : 'a t -> key * 'a
+            val choose : 'a t -> key * 'a
+            val split : key -> 'a t -> 'a t * 'a option * 'a t
+            val find : key -> 'a t -> 'a
+            val map : ('a -> 'b) -> 'a t -> 'b t
+            val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
+          end
+      end
+    module Std :
+      sig
+        module Int :
+          sig
+            module T :
+              sig
+                type t = int
+                val compare : 'a -> 'a -> t
+                val ( + ) : t -> t -> t
+              end
+            type t = int
+            val compare : 'a -> 'a -> t
+            val ( + ) : t -> t -> t
+            module Map :
+              sig
+                type key = t
+                type 'a t = 'a Map.Make(T).t
+                val empty : 'a t
+                val is_empty : 'a t -> bool
+                val mem : key -> 'a t -> bool
+                val add : key -> 'a -> 'a t -> 'a t
+                val singleton : key -> 'a -> 'a t
+                val remove : key -> 'a t -> 'a t
+                val merge :
+                  (key -> 'a option -> 'b option -> 'c option) ->
+                  'a t -> 'b t -> 'c t
+                val compare : ('a -> 'a -> key) -> 'a t -> 'a t -> key
+                val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+                val iter : (key -> 'a -> unit) -> 'a t -> unit
+                val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+                val for_all : (key -> 'a -> bool) -> 'a t -> bool
+                val exists : (key -> 'a -> bool) -> 'a t -> bool
+                val filter : (key -> 'a -> bool) -> 'a t -> 'a t
+                val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+                val cardinal : 'a t -> key
+                val bindings : 'a t -> (key * 'a) list
+                val min_binding : 'a t -> key * 'a
+                val max_binding : 'a t -> key * 'a
+                val choose : 'a t -> key * 'a
+                val split : key -> 'a t -> 'a t * 'a option * 'a t
+                val find : key -> 'a t -> 'a
+                val map : ('a -> 'b) -> 'a t -> 'b t
+                val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
+              end
+          end
+      end
+  end
+#     #   val x : 'a Int.Map.t = 
+# Characters 8-9:
+  let y = x + x ;;
+          ^
+Error: This expression has type 'a Int.Map.t
+       but an expression was expected of type int
+#           module M : sig type t = A type u = C end
+module N : sig type t = B end
+# - : M.t = A
+# - : N.t = B
+# - : u = C
+#   type t = M.t = A
+type u = M.u = C
+# - : u = C
+#     module L : sig type v = V end
+# - : v = V
+#   module L : sig type v = V end
+# - : v = V
+#     type t1 = A
+# module M1 : sig type u = v and v = t1 end
+# module N1 : sig type u = v and v = t1 end
+# type t1 = B
+# module N2 : sig type u = v and v = N1.v end
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-signatures/Makefile ocaml-4.01.0/testsuite/tests/typing-signatures/Makefile
--- ocaml-3.12.1/testsuite/tests/typing-signatures/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-signatures/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,15 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.toplevel
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/typing-signatures/els.ml ocaml-4.01.0/testsuite/tests/typing-signatures/els.ml
--- ocaml-3.12.1/testsuite/tests/typing-signatures/els.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-signatures/els.ml	2012-07-30 18:04:46.000000000 +0000
@@ -0,0 +1,92 @@
+(* Adapted from: An Expressive Language of Signatures
+   by Norman Ramsey, Kathleen Fisher and Paul Govereau *)
+
+module type VALUE = sig
+  type value (* a Lua value *)
+  type state (* the state of a Lua interpreter *)
+  type usert (* a user-defined value *)
+end;;
+
+module type CORE0 = sig
+  module V : VALUE
+  val setglobal : V.state -> string -> V.value -> unit
+  (* five more functions common to core and evaluator *)
+end;;
+
+module type CORE = sig
+  include CORE0
+  val apply : V.value -> V.state -> V.value list -> V.value
+  (* apply function f in state s to list of args *)
+end;;
+
+module type AST = sig
+  module Value : VALUE
+  type chunk
+  type program
+  val get_value : chunk -> Value.value
+end;;
+
+module type EVALUATOR = sig
+  module Value : VALUE
+  module Ast : (AST with module Value := Value)
+  type state = Value.state
+  type value = Value.value
+  exception Error of string
+  val compile : Ast.program -> string
+  include CORE0 with module V := Value
+end;;
+
+module type PARSER = sig
+  type chunk
+  val parse : string -> chunk
+end;;
+
+module type INTERP = sig
+  include EVALUATOR
+  module Parser : PARSER with type chunk = Ast.chunk
+  val dostring : state -> string -> value list
+  val mk : unit -> state
+end;;
+
+module type USERTYPE = sig
+  type t
+  val eq : t -> t -> bool
+  val to_string : t -> string
+end;;
+
+module type TYPEVIEW = sig
+  type combined
+  type t
+  val map : (combined -> t) * (t -> combined)
+end;;
+
+module type COMBINED_COMMON = sig
+  module T : sig type t end
+  module TV1 : TYPEVIEW with type combined := T.t
+  module TV2 : TYPEVIEW with type combined := T.t
+end;;
+
+module type COMBINED_TYPE = sig
+  module T : USERTYPE
+  include COMBINED_COMMON with module T := T
+end;;
+
+module type BARECODE = sig
+  type state
+  val init : state -> unit
+end;;
+
+module USERCODE(X : TYPEVIEW) = struct
+  module type F =
+      functor (C : CORE with type V.usert = X.combined) ->
+        BARECODE with type state := C.V.state
+end;;
+
+module Weapon = struct type t end;;
+
+module type WEAPON_LIB = sig
+  type t = Weapon.t
+  module T : USERTYPE with type t = t
+  module Make :
+    functor (TV : TYPEVIEW with type t = t) -> USERCODE(TV).F
+end;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-signatures/els.ml.reference ocaml-4.01.0/testsuite/tests/typing-signatures/els.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-signatures/els.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-signatures/els.ml.reference	2012-07-30 18:04:46.000000000 +0000
@@ -0,0 +1,93 @@
+
+# *             module type VALUE = sig type value type state type usert end
+#           module type CORE0 =
+  sig
+    module V : VALUE
+    val setglobal : V.state -> string -> V.value -> unit
+  end
+#           module type CORE =
+  sig
+    module V : VALUE
+    val setglobal : V.state -> string -> V.value -> unit
+    val apply : V.value -> V.state -> V.value list -> V.value
+  end
+#             module type AST =
+  sig
+    module Value : VALUE
+    type chunk
+    type program
+    val get_value : chunk -> Value.value
+  end
+#                   module type EVALUATOR =
+  sig
+    module Value : VALUE
+    module Ast :
+      sig type chunk type program val get_value : chunk -> Value.value end
+    type state = Value.state
+    type value = Value.value
+    exception Error of string
+    val compile : Ast.program -> string
+    val setglobal : Value.state -> string -> Value.value -> unit
+  end
+#         module type PARSER = sig type chunk val parse : string -> chunk end
+#             module type INTERP =
+  sig
+    module Value : VALUE
+    module Ast :
+      sig type chunk type program val get_value : chunk -> Value.value end
+    type state = Value.state
+    type value = Value.value
+    exception Error of string
+    val compile : Ast.program -> string
+    val setglobal : Value.state -> string -> Value.value -> unit
+    module Parser :
+      sig type chunk = Ast.chunk val parse : string -> chunk end
+    val dostring : state -> string -> value list
+    val mk : unit -> state
+  end
+#           module type USERTYPE =
+  sig type t val eq : t -> t -> bool val to_string : t -> string end
+#           module type TYPEVIEW =
+  sig type combined type t val map : (combined -> t) * (t -> combined) end
+#           module type COMBINED_COMMON =
+  sig
+    module T : sig type t end
+    module TV1 : sig type t val map : (T.t -> t) * (t -> T.t) end
+    module TV2 : sig type t val map : (T.t -> t) * (t -> T.t) end
+  end
+#         module type COMBINED_TYPE =
+  sig
+    module T : USERTYPE
+    module TV1 : sig type t val map : (T.t -> t) * (t -> T.t) end
+    module TV2 : sig type t val map : (T.t -> t) * (t -> T.t) end
+  end
+#         module type BARECODE = sig type state val init : state -> unit end
+#           module USERCODE :
+  functor (X : TYPEVIEW) ->
+    sig
+      module type F =
+        functor
+          (C : sig
+                 module V :
+                   sig type value type state type usert = X.combined end
+                 val setglobal : V.state -> string -> V.value -> unit
+                 val apply : V.value -> V.state -> V.value list -> V.value
+               end) ->
+          sig val init : C.V.state -> unit end
+    end
+#   module Weapon : sig type t end
+#             module type WEAPON_LIB =
+  sig
+    type t = Weapon.t
+    module T :
+      sig type t = t val eq : t -> t -> bool val to_string : t -> string end
+    module Make :
+      functor
+        (TV : sig
+                type combined
+                type t = t
+                val map : (combined -> t) * (t -> combined)
+              end) ->
+        USERCODE(TV).F
+  end
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-sigsubst/Makefile ocaml-4.01.0/testsuite/tests/typing-sigsubst/Makefile
--- ocaml-3.12.1/testsuite/tests/typing-sigsubst/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-sigsubst/Makefile	2012-10-17 20:09:16.000000000 +0000
@@ -0,0 +1,15 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.toplevel
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/typing-sigsubst/sigsubst.ml ocaml-4.01.0/testsuite/tests/typing-sigsubst/sigsubst.ml
--- ocaml-3.12.1/testsuite/tests/typing-sigsubst/sigsubst.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-sigsubst/sigsubst.ml	2012-07-21 01:12:51.000000000 +0000
@@ -0,0 +1,40 @@
+module type Printable = sig
+  type t
+  val print : Format.formatter -> t -> unit
+end;;
+module type Comparable = sig
+  type t
+  val compare : t -> t -> int
+end;;
+module type PrintableComparable = sig
+  include Printable
+  include Comparable with type t = t
+end;; (* Fails *)
+module type PrintableComparable = sig
+  type t
+  include Printable with type t := t
+  include Comparable with type t := t
+end;;
+module type PrintableComparable = sig
+  include Printable
+  include Comparable with type t := t
+end;;
+module type ComparableInt = Comparable with type t := int;;
+module type S = sig type t val f : t -> t end;;
+module type S' = S with type t := int;;
+
+module type S = sig type 'a t val map : ('a -> 'b) -> 'a t -> 'b t end;;
+module type S1 = S with type 'a t := 'a list;;
+module type S2 = sig
+  type 'a dict = (string * 'a) list
+  include S with type 'a t := 'a dict
+end;;
+
+
+module type S =
+  sig module T : sig type exp type arg end val f : T.exp -> T.arg end;;
+module M = struct type exp = string type arg = int end;;
+module type S' = S with module T := M;;
+
+
+module type S = sig type 'a t end with type 'a t := unit;; (* Fails *)
diff -Nru ocaml-3.12.1/testsuite/tests/typing-sigsubst/sigsubst.ml.reference ocaml-4.01.0/testsuite/tests/typing-sigsubst/sigsubst.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-sigsubst/sigsubst.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-sigsubst/sigsubst.ml.reference	2012-07-30 18:04:46.000000000 +0000
@@ -0,0 +1,40 @@
+
+#       module type Printable =
+  sig type t val print : Format.formatter -> t -> unit end
+#       module type Comparable = sig type t val compare : t -> t -> int end
+#       Characters 60-94:
+    include Comparable with type t = t
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Multiple definition of the type name t.
+       Names must be unique in a given structure or signature.
+#         module type PrintableComparable =
+  sig
+    type t
+    val print : Format.formatter -> t -> unit
+    val compare : t -> t -> int
+  end
+#       module type PrintableComparable =
+  sig
+    type t
+    val print : Format.formatter -> t -> unit
+    val compare : t -> t -> int
+  end
+# module type ComparableInt = sig val compare : int -> int -> int end
+# module type S = sig type t val f : t -> t end
+# module type S' = sig val f : int -> int end
+#   module type S = sig type 'a t val map : ('a -> 'b) -> 'a t -> 'b t end
+# module type S1 = sig val map : ('a -> 'b) -> 'a list -> 'b list end
+#       module type S2 =
+  sig
+    type 'a dict = (string * 'a) list
+    val map : ('a -> 'b) -> 'a dict -> 'b dict
+  end
+#       module type S =
+  sig module T : sig type exp type arg end val f : T.exp -> T.arg end
+# module M : sig type exp = string type arg = int end
+# module type S' = sig val f : M.exp -> M.arg end
+#     Characters 41-58:
+  module type S = sig type 'a t end with type 'a t := unit;; (* Fails *)
+                                         ^^^^^^^^^^^^^^^^^
+Error: Only type constructors with identical parameters can be substituted.
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-typeparam/.svnignore ocaml-4.01.0/testsuite/tests/typing-typeparam/.svnignore
--- ocaml-3.12.1/testsuite/tests/typing-typeparam/.svnignore	2011-05-17 12:08:13.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-typeparam/.svnignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,10 +0,0 @@
-#!/bin/sh
-
-svn propset svn:ignore -F - . < M.E x), (function M.E x -> Some x | _ -> None)
+;;
 
 let () =
   let (int_inj, int_proj) = property () in
@@ -13,15 +14,19 @@
   Printf.printf "%b\n%!" (int_proj s = None);
   Printf.printf "%b\n%!" (string_proj i = None);
   Printf.printf "%b\n%!" (string_proj s = None)
-
-
-
+;;
 
 let sort_uniq (type s) cmp l =
   let module S = Set.Make(struct type t = s let compare = cmp end) in
   S.elements (List.fold_right S.add l S.empty)
+;;
 
 let () =
   print_endline (String.concat "," (sort_uniq compare [ "abc"; "xyz"; "abc" ]))
+;;
 
-
+let f x (type a) (y : a) = (x = y);; (* Fails *)
+class ['a] c = object (self)
+  method m : 'a -> 'a = fun x -> x
+  method n : 'a -> 'a = fun (type g) (x:g) -> self#m x
+end;; (* Fails *)
diff -Nru ocaml-3.12.1/testsuite/tests/typing-typeparam/newtype.ml.reference ocaml-4.01.0/testsuite/tests/typing-typeparam/newtype.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-typeparam/newtype.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-typeparam/newtype.ml.reference	2012-07-30 18:04:46.000000000 +0000
@@ -0,0 +1,19 @@
+
+#       val property : unit -> ('a -> exn) * (exn -> 'a option) = 
+#                         false
+true
+true
+false
+#         val sort_uniq : ('a -> 'a -> int) -> 'a list -> 'a list = 
+#       abc,xyz
+#   Characters 33-34:
+  let f x (type a) (y : a) = (x = y);; (* Fails *)
+                                  ^
+Error: This expression has type a but an expression was expected of type a
+       The type constructor a would escape its scope
+#       Characters 117-118:
+    method n : 'a -> 'a = fun (type g) (x:g) -> self#m x
+                                                       ^
+Error: This expression has type g but an expression was expected of type g
+       The type constructor g would escape its scope
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-typeparam/newtype.reference ocaml-4.01.0/testsuite/tests/typing-typeparam/newtype.reference
--- ocaml-3.12.1/testsuite/tests/typing-typeparam/newtype.reference	2010-04-07 13:01:29.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-typeparam/newtype.reference	1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-false
-true
-true
-false
-abc,xyz
diff -Nru ocaml-3.12.1/testsuite/tests/typing-warnings/Makefile ocaml-4.01.0/testsuite/tests/typing-warnings/Makefile
--- ocaml-3.12.1/testsuite/tests/typing-warnings/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-warnings/Makefile	2012-12-06 09:41:21.000000000 +0000
@@ -0,0 +1,16 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.toplevel
+include $(BASEDIR)/makefiles/Makefile.common
+TOPFLAGS = -w A
diff -Nru ocaml-3.12.1/testsuite/tests/typing-warnings/pr5892.ml ocaml-4.01.0/testsuite/tests/typing-warnings/pr5892.ml
--- ocaml-3.12.1/testsuite/tests/typing-warnings/pr5892.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-warnings/pr5892.ml	2013-01-16 17:28:23.000000000 +0000
@@ -0,0 +1,3 @@
+open CamlinternalOO;;
+type _ choice = Left : label choice | Right : tag choice;;
+let f : label choice -> bool = function Left -> true;; (* warn *)
diff -Nru ocaml-3.12.1/testsuite/tests/typing-warnings/pr5892.ml.reference ocaml-4.01.0/testsuite/tests/typing-warnings/pr5892.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-warnings/pr5892.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-warnings/pr5892.ml.reference	2013-01-16 17:28:23.000000000 +0000
@@ -0,0 +1,12 @@
+
+# # type _ choice =
+    Left : CamlinternalOO.label choice
+  | Right : CamlinternalOO.tag choice
+# Characters 31-52:
+  let f : label choice -> bool = function Left -> true;; (* warn *)
+                                 ^^^^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+Right
+val f : CamlinternalOO.label choice -> bool = 
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-warnings/records.ml ocaml-4.01.0/testsuite/tests/typing-warnings/records.ml
--- ocaml-3.12.1/testsuite/tests/typing-warnings/records.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-warnings/records.ml	2013-06-18 07:59:30.000000000 +0000
@@ -0,0 +1,160 @@
+(* Use type information *)
+module M1 = struct
+  type t = {x: int; y: int}
+  type u = {x: bool; y: bool}
+end;;
+
+module OK = struct
+  open M1
+  let f1 (r:t) = r.x (* ok *)
+  let f2 r = ignore (r:t); r.x (* non principal *)
+
+  let f3 (r: t) =
+    match r with {x; y} -> y + y (* ok *)
+end;;
+
+module F1 = struct
+  open M1
+  let f r = match r with {x; y} -> y + y
+end;; (* fails *)
+
+module F2 = struct
+  open M1
+  let f r =
+    ignore (r: t);
+    match r with
+       {x; y} -> y + y
+end;; (* fails for -principal *)
+
+(* Use type information with modules*)
+module M = struct
+  type t = {x:int}
+  type u = {x:bool}
+end;;
+let f (r:M.t) = r.M.x;; (* ok *)
+let f (r:M.t) = r.x;; (* warning *)
+let f ({x}:M.t) = x;; (* warning *)
+
+module M = struct
+  type t = {x: int; y: int}
+end;;
+module N = struct
+  type u = {x: bool; y: bool}
+end;;
+module OK = struct
+  open M
+  open N
+  let f (r:M.t) = r.x
+end;; 
+
+module M = struct
+  type t = {x:int}
+  module N = struct type s = t = {x:int} end
+  type u = {x:bool}
+end;;
+module OK = struct
+  open M.N
+  let f (r:M.t) = r.x
+end;;
+
+(* Use field information *)
+module M = struct
+  type u = {x:bool;y:int;z:char}
+  type t = {x:int;y:bool}
+end;;
+module OK = struct
+  open M
+  let f {x;z} = x,z
+end;; (* ok *)
+module F3 = struct
+  open M
+  let r = {x=true;z='z'}
+end;; (* fail for missing label *)
+
+module OK = struct
+  type u = {x:int;y:bool}
+  type t = {x:bool;y:int;z:char}
+  let r = {x=3; y=true}
+end;; (* ok *)
+
+(* Corner cases *)
+
+module F4 = struct
+  type foo = {x:int; y:int}
+  type bar = {x:int}
+  let b : bar = {x=3; y=4}
+end;; (* fail but don't warn *)
+
+module M = struct type foo = {x:int;y:int} end;;
+module N = struct type bar = {x:int;y:int} end;;
+let r = { M.x = 3; N.y = 4; };; (* error: different definitions *)
+
+module MN = struct include M include N end
+module NM = struct include N include M end;;
+let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
+
+(* Lpw25 *)
+
+module M = struct
+  type foo = { x: int; y: int }
+  type bar = { x:int; y: int; z: int}
+end;;
+module F5 = struct
+  open M
+  let f r = ignore (r: foo); {r with x = 2; z = 3}
+end;;
+module M = struct
+  include M
+  type other = { a: int; b: int }
+end;;
+module F6 = struct
+  open M
+  let f r = ignore (r: foo); { r with x = 3; a = 4 }
+end;;
+module F7 = struct
+  open M
+  let r = {x=1; y=2}
+  let r: other = {x=1; y=2}
+end;;
+
+module A = struct type t = {x: int} end
+module B = struct type t = {x: int} end;;
+let f (r : B.t) = r.A.x;; (* fail *)
+
+(* Spellchecking *)
+
+module F8 = struct
+  type t = {x:int; yyy:int}
+  let a : t = {x=1;yyz=2}
+end;;
+
+(* PR#6004 *)
+
+type t = A
+type s = A
+
+class f (_ : t) = object end;;
+class g = f A;; (* ok *)
+
+class f (_ : 'a) (_ : 'a) = object end;;
+class g = f (A : t) A;; (* warn with -principal *)
+
+
+(* PR#5980 *)
+
+module Shadow1 = struct
+  type t = {x: int}
+  module M = struct
+    type s = {x: string}
+  end
+  open M  (* this open is unused, it isn't reported as shadowing 'x' *)
+  let y : t = {x = 0}
+end;;
+module Shadow2 = struct
+  type t = {x: int}
+  module M = struct
+    type s = {x: string}
+  end
+  open M  (* this open shadows label 'x' *)
+  let y = {x = ""}
+end;;
diff -Nru ocaml-3.12.1/testsuite/tests/typing-warnings/records.ml.principal.reference ocaml-4.01.0/testsuite/tests/typing-warnings/records.ml.principal.reference
--- ocaml-3.12.1/testsuite/tests/typing-warnings/records.ml.principal.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-warnings/records.ml.principal.reference	2013-06-18 07:59:30.000000000 +0000
@@ -0,0 +1,279 @@
+
+#         module M1 :
+  sig type t = { x : int; y : int; } type u = { x : bool; y : bool; } end
+#                 Characters 49-50:
+    let f1 (r:t) = r.x (* ok *)
+                     ^
+Warning 42: this use of x required disambiguation.
+Characters 89-90:
+    let f2 r = ignore (r:t); r.x (* non principal *)
+                               ^
+Warning 18: this type-based field disambiguation is not principal.
+Characters 89-90:
+    let f2 r = ignore (r:t); r.x (* non principal *)
+                               ^
+Warning 42: this use of x required disambiguation.
+Characters 148-149:
+      match r with {x; y} -> y + y (* ok *)
+                    ^
+Warning 42: this use of x required disambiguation.
+Characters 151-152:
+      match r with {x; y} -> y + y (* ok *)
+                       ^
+Warning 42: this use of y required disambiguation.
+Characters 81-103:
+    let f2 r = ignore (r:t); r.x (* non principal *)
+                       ^^^^^^^^^^^^^^^^^^^^^^
+Warning 34: unused type u.
+Characters 148-149:
+      match r with {x; y} -> y + y (* ok *)
+                    ^
+Warning 27: unused variable x.
+module OK :
+  sig val f1 : M1.t -> int val f2 : M1.t -> int val f3 : M1.t -> int end
+#         Characters 55-61:
+    let f r = match r with {x; y} -> y + y
+                           ^^^^^^
+Warning 41: these field labels belong to several types: M1.u M1.t
+The first one was selected. Please disambiguate if this is wrong.
+Characters 65-66:
+    let f r = match r with {x; y} -> y + y
+                                     ^
+Error: This expression has type bool but an expression was expected of type
+         int
+#               Characters 85-91:
+         {x; y} -> y + y
+         ^^^^^^
+Warning 41: these field labels belong to several types: M1.u M1.t
+The first one was selected. Please disambiguate if this is wrong.
+Characters 85-91:
+         {x; y} -> y + y
+         ^^^^^^
+Error: This pattern matches values of type M1.u
+       but a pattern was expected which matches values of type M1.t
+#           module M : sig type t = { x : int; } type u = { x : bool; } end
+# Characters 18-21:
+  let f (r:M.t) = r.M.x;; (* ok *)
+                    ^^^
+Warning 42: this use of x required disambiguation.
+val f : M.t -> int = 
+# Characters 18-19:
+  let f (r:M.t) = r.x;; (* warning *)
+                    ^
+Warning 40: x was selected from type M.t.
+It is not visible in the current scope, and will not 
+be selected if the type becomes unknown.
+Characters 18-19:
+  let f (r:M.t) = r.x;; (* warning *)
+                    ^
+Warning 42: this use of x required disambiguation.
+val f : M.t -> int = 
+# Characters 8-9:
+  let f ({x}:M.t) = x;; (* warning *)
+          ^
+Warning 42: this use of x required disambiguation.
+Characters 7-10:
+  let f ({x}:M.t) = x;; (* warning *)
+         ^^^
+Warning 40: this record of type M.t contains fields that are 
+not visible in the current scope: x.
+They will not be selected if the type becomes unknown.
+val f : M.t -> int = 
+#       module M : sig type t = { x : int; y : int; } end
+#     module N : sig type u = { x : bool; y : bool; } end
+#         Characters 57-58:
+    let f (r:M.t) = r.x
+                      ^
+Warning 42: this use of x required disambiguation.
+Characters 30-36:
+    open N
+    ^^^^^^
+Warning 33: unused open N.
+Characters 25-47:
+  ...... M
+    open N
+    let f (r...........
+Warning 34: unused type u.
+module OK : sig val f : M.t -> int end
+#           module M :
+  sig
+    type t = { x : int; }
+    module N : sig type s = t = { x : int; } end
+    type u = { x : bool; }
+  end
+#       module OK : sig val f : M.t -> int end
+#           module M :
+  sig
+    type u = { x : bool; y : int; z : char; }
+    type t = { x : int; y : bool; }
+  end
+#       Characters 37-38:
+    let f {x;z} = x,z
+           ^
+Warning 42: this use of x required disambiguation.
+Characters 36-41:
+    let f {x;z} = x,z
+          ^^^^^
+Warning 9: the following labels are not bound in this record pattern:
+y
+Either bind these labels explicitly or add '; _' to the pattern.
+Characters 87-105:
+  Warning 34: unused type t.
+module OK : sig val f : M.u -> bool * char end
+#       Characters 38-52:
+    let r = {x=true;z='z'}
+            ^^^^^^^^^^^^^^
+Error: Some record fields are undefined: y
+#           Characters 90-91:
+    let r = {x=3; y=true}
+             ^
+Warning 42: this use of x required disambiguation.
+Characters 95-96:
+    let r = {x=3; y=true}
+                  ^
+Warning 42: this use of y required disambiguation.
+module OK :
+  sig
+    type u = { x : int; y : bool; }
+    type t = { x : bool; y : int; z : char; }
+    val r : u
+  end
+#               Characters 111-112:
+    let b : bar = {x=3; y=4}
+                        ^
+Error: The record type bar has no field y
+#   module M : sig type foo = { x : int; y : int; } end
+# module N : sig type bar = { x : int; y : int; } end
+# Characters 19-22:
+  let r = { M.x = 3; N.y = 4; };; (* error: different definitions *)
+                     ^^^
+Error: The record field N.y belongs to the type N.bar
+       but is mixed here with fields of type M.foo
+#     module MN :
+  sig
+    type foo = M.foo = { x : int; y : int; }
+    type bar = N.bar = { x : int; y : int; }
+  end
+module NM :
+  sig
+    type bar = N.bar = { x : int; y : int; }
+    type foo = M.foo = { x : int; y : int; }
+  end
+# Characters 8-28:
+  let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
+          ^^^^^^^^^^^^^^^^^^^^
+Warning 41: x belongs to several types: MN.bar MN.foo
+The first one was selected. Please disambiguate if this is wrong.
+Characters 8-28:
+  let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
+          ^^^^^^^^^^^^^^^^^^^^
+Warning 41: y belongs to several types: NM.foo NM.bar
+The first one was selected. Please disambiguate if this is wrong.
+Characters 19-23:
+  let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
+                     ^^^^
+Error: The record field NM.y belongs to the type NM.foo = M.foo
+       but is mixed here with fields of type MN.bar = N.bar
+#             module M :
+  sig
+    type foo = { x : int; y : int; }
+    type bar = { x : int; y : int; z : int; }
+  end
+#       Characters 65-66:
+    let f r = ignore (r: foo); {r with x = 2; z = 3}
+                                       ^
+Warning 42: this use of x required disambiguation.
+Characters 72-73:
+    let f r = ignore (r: foo); {r with x = 2; z = 3}
+                                              ^
+Error: The record type M.foo has no field z
+#       module M :
+  sig
+    type foo = M.foo = { x : int; y : int; }
+    type bar = M.bar = { x : int; y : int; z : int; }
+    type other = { a : int; b : int; }
+  end
+#       Characters 66-67:
+    let f r = ignore (r: foo); { r with x = 3; a = 4 }
+                                        ^
+Warning 42: this use of x required disambiguation.
+Characters 73-74:
+    let f r = ignore (r: foo); { r with x = 3; a = 4 }
+                                               ^
+Error: The record type M.foo has no field a
+#         Characters 39-40:
+    let r = {x=1; y=2}
+             ^
+Warning 42: this use of x required disambiguation.
+Characters 44-45:
+    let r = {x=1; y=2}
+                  ^
+Warning 42: this use of y required disambiguation.
+Characters 67-68:
+    let r: other = {x=1; y=2}
+                    ^
+Error: The record type M.other has no field x
+#     module A : sig type t = { x : int; } end
+module B : sig type t = { x : int; } end
+# Characters 20-23:
+  let f (r : B.t) = r.A.x;; (* fail *)
+                      ^^^
+Error: The field A.x belongs to the record type A.t
+       but a field was expected belonging to the record type B.t
+#             Characters 88-91:
+    let a : t = {x=1;yyz=2}
+                     ^^^
+Error: The record type t has no field yyz
+Did you mean yyy?
+#             type t = A
+type s = A
+class f : t -> object  end
+# Characters 12-13:
+  class g = f A;; (* ok *)
+              ^
+Warning 42: this use of A required disambiguation.
+class g : f
+#   class f : 'a -> 'a -> object  end
+# Characters 13-14:
+  class g = f (A : t) A;; (* warn with -principal *)
+               ^
+Warning 42: this use of A required disambiguation.
+Characters 20-21:
+  class g = f (A : t) A;; (* warn with -principal *)
+                      ^
+Warning 18: this type-based constructor disambiguation is not principal.
+Characters 20-21:
+  class g = f (A : t) A;; (* warn with -principal *)
+                      ^
+Warning 42: this use of A required disambiguation.
+class g : f
+#                       Characters 199-200:
+    let y : t = {x = 0}
+                 ^
+Warning 42: this use of x required disambiguation.
+Characters 114-120:
+    open M  (* this open is unused, it isn't reported as shadowing 'x' *)
+    ^^^^^^
+Warning 33: unused open M.
+module Shadow1 :
+  sig
+    type t = { x : int; }
+    module M : sig type s = { x : string; } end
+    val y : t
+  end
+#               Characters 97-103:
+    open M  (* this open shadows label 'x' *)
+    ^^^^^^
+Warning 45: this open statement shadows the label x (which is later used)
+Characters 149-157:
+    let y = {x = ""}
+            ^^^^^^^^
+Warning 41: these field labels belong to several types: M.s t
+The first one was selected. Please disambiguate if this is wrong.
+module Shadow2 :
+  sig
+    type t = { x : int; }
+    module M : sig type s = { x : string; } end
+    val y : M.s
+  end
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/typing-warnings/records.ml.reference ocaml-4.01.0/testsuite/tests/typing-warnings/records.ml.reference
--- ocaml-3.12.1/testsuite/tests/typing-warnings/records.ml.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/typing-warnings/records.ml.reference	2013-06-18 07:59:30.000000000 +0000
@@ -0,0 +1,278 @@
+
+#         module M1 :
+  sig type t = { x : int; y : int; } type u = { x : bool; y : bool; } end
+#                 Characters 49-50:
+    let f1 (r:t) = r.x (* ok *)
+                     ^
+Warning 42: this use of x required disambiguation.
+Characters 89-90:
+    let f2 r = ignore (r:t); r.x (* non principal *)
+                               ^
+Warning 42: this use of x required disambiguation.
+Characters 148-149:
+      match r with {x; y} -> y + y (* ok *)
+                    ^
+Warning 42: this use of x required disambiguation.
+Characters 151-152:
+      match r with {x; y} -> y + y (* ok *)
+                       ^
+Warning 42: this use of y required disambiguation.
+Characters 81-103:
+    let f2 r = ignore (r:t); r.x (* non principal *)
+                       ^^^^^^^^^^^^^^^^^^^^^^
+Warning 34: unused type u.
+Characters 148-149:
+      match r with {x; y} -> y + y (* ok *)
+                    ^
+Warning 27: unused variable x.
+module OK :
+  sig val f1 : M1.t -> int val f2 : M1.t -> int val f3 : M1.t -> int end
+#         Characters 55-61:
+    let f r = match r with {x; y} -> y + y
+                           ^^^^^^
+Warning 41: these field labels belong to several types: M1.u M1.t
+The first one was selected. Please disambiguate if this is wrong.
+Characters 65-66:
+    let f r = match r with {x; y} -> y + y
+                                     ^
+Error: This expression has type bool but an expression was expected of type
+         int
+#               Characters 86-87:
+         {x; y} -> y + y
+          ^
+Warning 42: this use of x required disambiguation.
+Characters 89-90:
+         {x; y} -> y + y
+             ^
+Warning 42: this use of y required disambiguation.
+Characters 81-103:
+  ...    {x; y} -> y + y
+  en..............................
+Warning 34: unused type u.
+Characters 86-87:
+         {x; y} -> y + y
+          ^
+Warning 27: unused variable x.
+module F2 : sig val f : M1.t -> int end
+#           module M : sig type t = { x : int; } type u = { x : bool; } end
+# Characters 18-21:
+  let f (r:M.t) = r.M.x;; (* ok *)
+                    ^^^
+Warning 42: this use of x required disambiguation.
+val f : M.t -> int = 
+# Characters 18-19:
+  let f (r:M.t) = r.x;; (* warning *)
+                    ^
+Warning 40: x was selected from type M.t.
+It is not visible in the current scope, and will not 
+be selected if the type becomes unknown.
+Characters 18-19:
+  let f (r:M.t) = r.x;; (* warning *)
+                    ^
+Warning 42: this use of x required disambiguation.
+val f : M.t -> int = 
+# Characters 8-9:
+  let f ({x}:M.t) = x;; (* warning *)
+          ^
+Warning 42: this use of x required disambiguation.
+Characters 7-10:
+  let f ({x}:M.t) = x;; (* warning *)
+         ^^^
+Warning 40: this record of type M.t contains fields that are 
+not visible in the current scope: x.
+They will not be selected if the type becomes unknown.
+val f : M.t -> int = 
+#       module M : sig type t = { x : int; y : int; } end
+#     module N : sig type u = { x : bool; y : bool; } end
+#         Characters 57-58:
+    let f (r:M.t) = r.x
+                      ^
+Warning 42: this use of x required disambiguation.
+Characters 30-36:
+    open N
+    ^^^^^^
+Warning 33: unused open N.
+Characters 25-47:
+  ...... M
+    open N
+    let f (r...........
+Warning 34: unused type u.
+module OK : sig val f : M.t -> int end
+#           module M :
+  sig
+    type t = { x : int; }
+    module N : sig type s = t = { x : int; } end
+    type u = { x : bool; }
+  end
+#       module OK : sig val f : M.t -> int end
+#           module M :
+  sig
+    type u = { x : bool; y : int; z : char; }
+    type t = { x : int; y : bool; }
+  end
+#       Characters 37-38:
+    let f {x;z} = x,z
+           ^
+Warning 42: this use of x required disambiguation.
+Characters 36-41:
+    let f {x;z} = x,z
+          ^^^^^
+Warning 9: the following labels are not bound in this record pattern:
+y
+Either bind these labels explicitly or add '; _' to the pattern.
+Characters 87-105:
+  Warning 34: unused type t.
+module OK : sig val f : M.u -> bool * char end
+#       Characters 38-52:
+    let r = {x=true;z='z'}
+            ^^^^^^^^^^^^^^
+Error: Some record fields are undefined: y
+#           Characters 90-91:
+    let r = {x=3; y=true}
+             ^
+Warning 42: this use of x required disambiguation.
+Characters 95-96:
+    let r = {x=3; y=true}
+                  ^
+Warning 42: this use of y required disambiguation.
+module OK :
+  sig
+    type u = { x : int; y : bool; }
+    type t = { x : bool; y : int; z : char; }
+    val r : u
+  end
+#               Characters 111-112:
+    let b : bar = {x=3; y=4}
+                        ^
+Error: The record type bar has no field y
+#   module M : sig type foo = { x : int; y : int; } end
+# module N : sig type bar = { x : int; y : int; } end
+# Characters 19-22:
+  let r = { M.x = 3; N.y = 4; };; (* error: different definitions *)
+                     ^^^
+Error: The record field N.y belongs to the type N.bar
+       but is mixed here with fields of type M.foo
+#     module MN :
+  sig
+    type foo = M.foo = { x : int; y : int; }
+    type bar = N.bar = { x : int; y : int; }
+  end
+module NM :
+  sig
+    type bar = N.bar = { x : int; y : int; }
+    type foo = M.foo = { x : int; y : int; }
+  end
+# Characters 8-28:
+  let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
+          ^^^^^^^^^^^^^^^^^^^^
+Warning 41: x belongs to several types: MN.bar MN.foo
+The first one was selected. Please disambiguate if this is wrong.
+Characters 8-28:
+  let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
+          ^^^^^^^^^^^^^^^^^^^^
+Warning 41: y belongs to several types: NM.foo NM.bar
+The first one was selected. Please disambiguate if this is wrong.
+Characters 19-23:
+  let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
+                     ^^^^
+Error: The record field NM.y belongs to the type NM.foo = M.foo
+       but is mixed here with fields of type MN.bar = N.bar
+#             module M :
+  sig
+    type foo = { x : int; y : int; }
+    type bar = { x : int; y : int; z : int; }
+  end
+#       Characters 65-66:
+    let f r = ignore (r: foo); {r with x = 2; z = 3}
+                                       ^
+Warning 42: this use of x required disambiguation.
+Characters 72-73:
+    let f r = ignore (r: foo); {r with x = 2; z = 3}
+                                              ^
+Error: The record type M.foo has no field z
+#       module M :
+  sig
+    type foo = M.foo = { x : int; y : int; }
+    type bar = M.bar = { x : int; y : int; z : int; }
+    type other = { a : int; b : int; }
+  end
+#       Characters 66-67:
+    let f r = ignore (r: foo); { r with x = 3; a = 4 }
+                                        ^
+Warning 42: this use of x required disambiguation.
+Characters 73-74:
+    let f r = ignore (r: foo); { r with x = 3; a = 4 }
+                                               ^
+Error: The record type M.foo has no field a
+#         Characters 39-40:
+    let r = {x=1; y=2}
+             ^
+Warning 42: this use of x required disambiguation.
+Characters 44-45:
+    let r = {x=1; y=2}
+                  ^
+Warning 42: this use of y required disambiguation.
+Characters 67-68:
+    let r: other = {x=1; y=2}
+                    ^
+Error: The record type M.other has no field x
+#     module A : sig type t = { x : int; } end
+module B : sig type t = { x : int; } end
+# Characters 20-23:
+  let f (r : B.t) = r.A.x;; (* fail *)
+                      ^^^
+Error: The field A.x belongs to the record type A.t
+       but a field was expected belonging to the record type B.t
+#             Characters 88-91:
+    let a : t = {x=1;yyz=2}
+                     ^^^
+Error: The record type t has no field yyz
+Did you mean yyy?
+#             type t = A
+type s = A
+class f : t -> object  end
+# Characters 12-13:
+  class g = f A;; (* ok *)
+              ^
+Warning 42: this use of A required disambiguation.
+class g : f
+#   class f : 'a -> 'a -> object  end
+# Characters 13-14:
+  class g = f (A : t) A;; (* warn with -principal *)
+               ^
+Warning 42: this use of A required disambiguation.
+Characters 20-21:
+  class g = f (A : t) A;; (* warn with -principal *)
+                      ^
+Warning 42: this use of A required disambiguation.
+class g : f
+#                       Characters 199-200:
+    let y : t = {x = 0}
+                 ^
+Warning 42: this use of x required disambiguation.
+Characters 114-120:
+    open M  (* this open is unused, it isn't reported as shadowing 'x' *)
+    ^^^^^^
+Warning 33: unused open M.
+module Shadow1 :
+  sig
+    type t = { x : int; }
+    module M : sig type s = { x : string; } end
+    val y : t
+  end
+#               Characters 97-103:
+    open M  (* this open shadows label 'x' *)
+    ^^^^^^
+Warning 45: this open statement shadows the label x (which is later used)
+Characters 149-157:
+    let y = {x = ""}
+            ^^^^^^^^
+Warning 41: these field labels belong to several types: M.s t
+The first one was selected. Please disambiguate if this is wrong.
+module Shadow2 :
+  sig
+    type t = { x : int; }
+    module M : sig type s = { x : string; } end
+    val y : M.s
+  end
+# 
diff -Nru ocaml-3.12.1/testsuite/tests/utils/Makefile ocaml-4.01.0/testsuite/tests/utils/Makefile
--- ocaml-3.12.1/testsuite/tests/utils/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/utils/Makefile	2013-07-23 14:48:47.000000000 +0000
@@ -0,0 +1,20 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                         Alain Frisch, LexiFi                          #
+#                                                                       #
+#   Copyright 2012 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+MODULES=testing misc
+INCLUDES= -I $(OTOPDIR)/utils
+ADD_COMPFLAGS=$(INCLUDES)
+CMO_FILES+="misc.cmo"
+
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/utils/edit_distance.ml ocaml-4.01.0/testsuite/tests/utils/edit_distance.ml
--- ocaml-3.12.1/testsuite/tests/utils/edit_distance.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/utils/edit_distance.ml	2013-04-13 20:24:06.000000000 +0000
@@ -0,0 +1,49 @@
+let edit_distance = Misc.edit_distance
+
+let show_cutoff n =
+  if n = max_int then "max_int" else Printf.sprintf "%d" n
+;;
+
+let test =
+  let counter = ref 0 in
+  fun a b cutoff expected ->
+    let show_result = function
+      | None -> "None"
+      | Some d -> "Some " ^ string_of_int d in
+    incr counter;
+    Printf.printf "[%02d] (edit_distance %S %S %s), expected %s\n"
+      !counter a b (show_cutoff cutoff) (show_result expected);
+    let result = edit_distance a b cutoff in
+    if result = expected
+    then print_endline "OK"
+    else Printf.printf "FAIL: got %s\n%!" (show_result result)
+
+let () =
+  test "a" "a" 1 (Some 0);
+  test "a" "a" 0 (Some 0);
+  test "a" "b" 1 (Some 1);
+  test "a" "b" 0 None;
+  test "add" "adad" 3 (Some 1);
+  test "delete" "delte" 3 (Some 1);
+  test "subst" "sabst" 3 (Some 1);
+  test "swap" "sawp" 3 (Some 1);
+  test "abbb" "bbba" 3 (Some 2);
+  test "abbb" "bbba" 1 None;
+
+  (* check for bugs where a small common suffix, or common prefix, is
+     enough to make the distance goes down *)
+  test "xyzwabc" "mnpqrabc" 10 (Some 5);
+  test "abcxyzw" "abcmnpqr" 10 (Some 5);
+
+  (* check that using "max_int" as cutoff works *)
+  test "a" "a" max_int (Some 0);
+  test "a" "b" max_int (Some 1);
+  test "abc" "ade" max_int (Some 2);
+
+  (* check empty strings*)
+  test "" "" 3 (Some 0);
+  test "" "abc" 3 (Some 3);
+  test "abcd" "" 3 None;
+  
+  ()
+
diff -Nru ocaml-3.12.1/testsuite/tests/utils/edit_distance.reference ocaml-4.01.0/testsuite/tests/utils/edit_distance.reference
--- ocaml-3.12.1/testsuite/tests/utils/edit_distance.reference	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/utils/edit_distance.reference	2013-04-13 20:24:06.000000000 +0000
@@ -0,0 +1,38 @@
+[01] (edit_distance "a" "a" 1), expected Some 0
+OK
+[02] (edit_distance "a" "a" 0), expected Some 0
+OK
+[03] (edit_distance "a" "b" 1), expected Some 1
+OK
+[04] (edit_distance "a" "b" 0), expected None
+OK
+[05] (edit_distance "add" "adad" 3), expected Some 1
+OK
+[06] (edit_distance "delete" "delte" 3), expected Some 1
+OK
+[07] (edit_distance "subst" "sabst" 3), expected Some 1
+OK
+[08] (edit_distance "swap" "sawp" 3), expected Some 1
+OK
+[09] (edit_distance "abbb" "bbba" 3), expected Some 2
+OK
+[10] (edit_distance "abbb" "bbba" 1), expected None
+OK
+[11] (edit_distance "xyzwabc" "mnpqrabc" 10), expected Some 5
+OK
+[12] (edit_distance "abcxyzw" "abcmnpqr" 10), expected Some 5
+OK
+[13] (edit_distance "a" "a" max_int), expected Some 0
+OK
+[14] (edit_distance "a" "b" max_int), expected Some 1
+OK
+[15] (edit_distance "abc" "ade" max_int), expected Some 2
+OK
+[16] (edit_distance "" "" 3), expected Some 0
+OK
+[17] (edit_distance "" "abc" 3), expected Some 3
+OK
+[18] (edit_distance "abcd" "" 3), expected None
+OK
+
+All tests succeeded.
diff -Nru ocaml-3.12.1/testsuite/tests/warnings/Makefile ocaml-4.01.0/testsuite/tests/warnings/Makefile
--- ocaml-3.12.1/testsuite/tests/warnings/Makefile	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/warnings/Makefile	2013-05-03 15:52:56.000000000 +0000
@@ -1,14 +1,31 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
 FLAGS=-w A
 EXECNAME=./program
 
 run-all:
 	@for file in *.ml; do \
 	  printf " ... testing '$$file':"; \
-	  $(OCAMLC) $(FLAGS) -o $(EXECNAME) $$file 2> `basename $$file ml`result; \
-	  diff -q `basename $$file ml`reference `basename $$file ml`result > /dev/null && echo " => passed" || echo " => failed"; \
+	  F="`basename $$file .ml`"; \
+	  $(OCAMLC) $(FLAGS) -o $(EXECNAME) $$file 2>$$F.result; \
+	  $(DIFF) $$F.reference $$F.result >/dev/null \
+	  && echo " => passed" || echo " => failed"; \
 	done;
 
+promote: defaultpromote
+
 clean: defaultclean
 	@rm -f *.result $(EXECNAME)
 
-include ../../makefiles/Makefile.common
+include $(BASEDIR)/makefiles/Makefile.common
diff -Nru ocaml-3.12.1/testsuite/tests/warnings/w01.ml ocaml-4.01.0/testsuite/tests/warnings/w01.ml
--- ocaml-3.12.1/testsuite/tests/warnings/w01.ml	2010-10-08 11:53:19.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/warnings/w01.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,3 +1,14 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Damien Doligez, projet Moscova, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2000 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
 
 (* C *)
 
diff -Nru ocaml-3.12.1/testsuite/tests/warnings/w01.reference ocaml-4.01.0/testsuite/tests/warnings/w01.reference
--- ocaml-3.12.1/testsuite/tests/warnings/w01.reference	2010-01-25 14:24:27.000000000 +0000
+++ ocaml-4.01.0/testsuite/tests/warnings/w01.reference	2013-07-23 15:28:58.000000000 +0000
@@ -1,15 +1,15 @@
-File "w01.ml", line 4, characters 12-14:
+File "w01.ml", line 15, characters 12-14:
 Warning 2: this is not the end of a comment.
-File "w01.ml", line 9, characters 8-9:
-Warning 27: unused variable y.
-File "w01.ml", line 10, characters 0-3:
+File "w01.ml", line 21, characters 0-3:
 Warning 5: this function application is partial,
 maybe some arguments are missing.
-File "w01.ml", line 20, characters 4-5:
+File "w01.ml", line 31, characters 4-5:
 Warning 8: this pattern-matching is not exhaustive.
 Here is an example of a value that is not matched:
 0
-File "w01.ml", line 25, characters 0-1:
+File "w01.ml", line 36, characters 0-1:
 Warning 10: this expression should have type unit.
-File "w01.ml", line 32, characters 2-3:
+File "w01.ml", line 20, characters 8-9:
+Warning 27: unused variable y.
+File "w01.ml", line 43, characters 2-3:
 Warning 11: this match case is unused.
diff -Nru ocaml-3.12.1/testsuite/typing ocaml-4.01.0/testsuite/typing
--- ocaml-3.12.1/testsuite/typing	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/testsuite/typing	2013-06-22 07:57:35.000000000 +0000
@@ -0,0 +1,22 @@
+tests/typing-fstclassmod
+tests/typing-gadts
+tests/typing-implicit_unpack
+tests/typing-labels
+tests/typing-misc
+tests/typing-modules
+tests/typing-modules-bugs
+tests/typing-objects
+tests/typing-objects-bugs
+tests/typing-poly
+tests/typing-poly-bugs
+tests/typing-polyvariants-bugs
+tests/typing-polyvariants-bugs-2
+tests/typing-private
+tests/typing-private-bugs
+tests/typing-recmod
+tests/typing-rectypes-bugs
+tests/typing-short-paths
+tests/typing-signatures
+tests/typing-sigsubst
+tests/typing-typeparam
+tests/typing-warnings
diff -Nru ocaml-3.12.1/tools/.cvsignore ocaml-4.01.0/tools/.cvsignore
--- ocaml-3.12.1/tools/.cvsignore	2010-06-16 11:21:39.000000000 +0000
+++ ocaml-4.01.0/tools/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1,25 +0,0 @@
-ocamldep
-ocamldep.opt
-ocamldep.bak
-ocamlprof
-opnames.ml
-dumpobj
-dumpapprox
-objinfo
-cvt_emit
-cvt_emit.bak
-cvt_emit.ml
-ocamlcp
-ocamlmktop
-primreq
-ocamldumpobj
-keywords
-lexer299.ml
-ocaml299to3
-ocamlmklib
-ocamlmklib.ml
-lexer301.ml
-scrapelabels
-addlabels
-myocamlbuild_config.ml
-objinfo_helper
diff -Nru ocaml-3.12.1/tools/.depend ocaml-4.01.0/tools/.depend
--- ocaml-3.12.1/tools/.depend	2010-07-23 15:30:37.000000000 +0000
+++ ocaml-4.01.0/tools/.depend	2013-08-15 16:13:16.000000000 +0000
@@ -1,62 +1,97 @@
-depend.cmi: ../parsing/parsetree.cmi
-profiling.cmi:
-addlabels.cmo: ../parsing/parsetree.cmi ../parsing/parse.cmi \
+depend.cmi : ../parsing/parsetree.cmi
+profiling.cmi :
+tast_iter.cmi : ../typing/typedtree.cmi ../parsing/asttypes.cmi
+untypeast.cmi : ../typing/typedtree.cmi ../typing/path.cmi \
+    ../parsing/parsetree.cmi ../parsing/longident.cmi
+addlabels.cmo : ../parsing/parsetree.cmi ../parsing/parse.cmi \
     ../parsing/longident.cmi ../parsing/location.cmi ../parsing/asttypes.cmi
-addlabels.cmx: ../parsing/parsetree.cmi ../parsing/parse.cmx \
+addlabels.cmx : ../parsing/parsetree.cmi ../parsing/parse.cmx \
     ../parsing/longident.cmx ../parsing/location.cmx ../parsing/asttypes.cmi
-cvt_emit.cmo:
-cvt_emit.cmx:
-depend.cmo: ../parsing/parsetree.cmi ../parsing/longident.cmi \
-    ../parsing/location.cmi depend.cmi
-depend.cmx: ../parsing/parsetree.cmi ../parsing/longident.cmx \
-    ../parsing/location.cmx depend.cmi
-dumpobj.cmo: ../utils/tbl.cmi opnames.cmo ../bytecomp/opcodes.cmo \
-    ../parsing/location.cmi ../bytecomp/lambda.cmi ../bytecomp/instruct.cmi \
-    ../typing/ident.cmi ../bytecomp/emitcode.cmi ../utils/config.cmi \
+cmt2annot.cmo : untypeast.cmi ../typing/types.cmi ../typing/typedtree.cmi \
+    tast_iter.cmi ../typing/stypes.cmi ../parsing/pprintast.cmi \
+    ../typing/path.cmi ../typing/oprint.cmi ../parsing/location.cmi \
+    ../typing/ident.cmi ../typing/envaux.cmi ../typing/env.cmi \
+    ../utils/config.cmi ../typing/cmt_format.cmi ../parsing/asttypes.cmi \
+    ../typing/annot.cmi
+cmt2annot.cmx : untypeast.cmx ../typing/types.cmx ../typing/typedtree.cmx \
+    tast_iter.cmx ../typing/stypes.cmx ../parsing/pprintast.cmx \
+    ../typing/path.cmx ../typing/oprint.cmx ../parsing/location.cmx \
+    ../typing/ident.cmx ../typing/envaux.cmx ../typing/env.cmx \
+    ../utils/config.cmx ../typing/cmt_format.cmx ../parsing/asttypes.cmi \
+    ../typing/annot.cmi
+cvt_emit.cmo :
+cvt_emit.cmx :
+depend.cmo : ../parsing/parsetree.cmi ../utils/misc.cmi \
+    ../parsing/longident.cmi ../parsing/location.cmi ../parsing/asttypes.cmi \
+    depend.cmi
+depend.cmx : ../parsing/parsetree.cmi ../utils/misc.cmx \
+    ../parsing/longident.cmx ../parsing/location.cmx ../parsing/asttypes.cmi \
+    depend.cmi
+dumpobj.cmo : ../utils/tbl.cmi opnames.cmo ../bytecomp/opcodes.cmo \
+    ../utils/misc.cmi ../parsing/location.cmi ../bytecomp/lambda.cmi \
+    ../bytecomp/instruct.cmi ../typing/ident.cmi ../utils/config.cmi \
     ../bytecomp/cmo_format.cmi ../bytecomp/bytesections.cmi \
     ../parsing/asttypes.cmi
-dumpobj.cmx: ../utils/tbl.cmx opnames.cmx ../bytecomp/opcodes.cmx \
-    ../parsing/location.cmx ../bytecomp/lambda.cmx ../bytecomp/instruct.cmx \
-    ../typing/ident.cmx ../bytecomp/emitcode.cmx ../utils/config.cmx \
+dumpobj.cmx : ../utils/tbl.cmx opnames.cmx ../bytecomp/opcodes.cmx \
+    ../utils/misc.cmx ../parsing/location.cmx ../bytecomp/lambda.cmx \
+    ../bytecomp/instruct.cmx ../typing/ident.cmx ../utils/config.cmx \
     ../bytecomp/cmo_format.cmi ../bytecomp/bytesections.cmx \
     ../parsing/asttypes.cmi
-myocamlbuild_config.cmo:
-myocamlbuild_config.cmx:
-objinfo.cmo: ../utils/misc.cmi ../utils/config.cmi ../asmcomp/cmx_format.cmi \
-    ../bytecomp/cmo_format.cmi ../asmcomp/clambda.cmi \
+eqparsetree.cmo : ../parsing/parsetree.cmi ../parsing/longident.cmi \
+    ../parsing/location.cmi ../parsing/asttypes.cmi
+eqparsetree.cmx : ../parsing/parsetree.cmi ../parsing/longident.cmx \
+    ../parsing/location.cmx ../parsing/asttypes.cmi
+myocamlbuild_config.cmo :
+myocamlbuild_config.cmx :
+objinfo.cmo : ../utils/misc.cmi ../utils/config.cmi \
+    ../asmcomp/cmx_format.cmi ../bytecomp/cmo_format.cmi \
+    ../typing/cmi_format.cmi ../asmcomp/clambda.cmi \
     ../bytecomp/bytesections.cmi
-objinfo.cmx: ../utils/misc.cmx ../utils/config.cmx ../asmcomp/cmx_format.cmi \
-    ../bytecomp/cmo_format.cmi ../asmcomp/clambda.cmx \
+objinfo.cmx : ../utils/misc.cmx ../utils/config.cmx \
+    ../asmcomp/cmx_format.cmi ../bytecomp/cmo_format.cmi \
+    ../typing/cmi_format.cmx ../asmcomp/clambda.cmx \
     ../bytecomp/bytesections.cmx
-ocaml299to3.cmo:
-ocaml299to3.cmx:
-ocamlcp.cmo: ../driver/main_args.cmi
-ocamlcp.cmx: ../driver/main_args.cmx
-ocamldep.cmo: ../parsing/syntaxerr.cmi ../parsing/parsetree.cmi \
-    ../parsing/parse.cmi ../utils/misc.cmi ../parsing/longident.cmi \
-    ../parsing/location.cmi ../parsing/lexer.cmi depend.cmi \
-    ../utils/config.cmi ../utils/clflags.cmi
-ocamldep.cmx: ../parsing/syntaxerr.cmx ../parsing/parsetree.cmi \
-    ../parsing/parse.cmx ../utils/misc.cmx ../parsing/longident.cmx \
-    ../parsing/location.cmx ../parsing/lexer.cmx depend.cmx \
-    ../utils/config.cmx ../utils/clflags.cmx
-ocamlmklib.cmo: myocamlbuild_config.cmo
-ocamlmklib.cmx: myocamlbuild_config.cmx
-ocamlmktop.cmo: ../utils/ccomp.cmi
-ocamlmktop.cmx: ../utils/ccomp.cmx
-ocamlprof.cmo: ../utils/warnings.cmi ../parsing/syntaxerr.cmi \
+ocaml299to3.cmo :
+ocaml299to3.cmx :
+ocamlcp.cmo : ../driver/main_args.cmi
+ocamlcp.cmx : ../driver/main_args.cmx
+ocamldep.cmo : ../parsing/syntaxerr.cmi ../driver/pparse.cmi \
     ../parsing/parsetree.cmi ../parsing/parse.cmi ../utils/misc.cmi \
-    ../parsing/location.cmi ../parsing/lexer.cmi ../utils/config.cmi \
-    ../utils/clflags.cmi
-ocamlprof.cmx: ../utils/warnings.cmx ../parsing/syntaxerr.cmx \
+    ../parsing/location.cmi ../parsing/lexer.cmi depend.cmi \
+    ../utils/config.cmi ../driver/compenv.cmi ../utils/clflags.cmi
+ocamldep.cmx : ../parsing/syntaxerr.cmx ../driver/pparse.cmx \
     ../parsing/parsetree.cmi ../parsing/parse.cmx ../utils/misc.cmx \
-    ../parsing/location.cmx ../parsing/lexer.cmx ../utils/config.cmx \
-    ../utils/clflags.cmx
-opnames.cmo:
-opnames.cmx:
-primreq.cmo: ../utils/config.cmi ../bytecomp/cmo_format.cmi
-primreq.cmx: ../utils/config.cmx ../bytecomp/cmo_format.cmi
-profiling.cmo: profiling.cmi
-profiling.cmx: profiling.cmi
-scrapelabels.cmo:
-scrapelabels.cmx:
+    ../parsing/location.cmx ../parsing/lexer.cmx depend.cmx \
+    ../utils/config.cmx ../driver/compenv.cmx ../utils/clflags.cmx
+ocamlmklib.cmo : myocamlbuild_config.cmo
+ocamlmklib.cmx : myocamlbuild_config.cmx
+ocamlmktop.cmo : ../utils/ccomp.cmi
+ocamlmktop.cmx : ../utils/ccomp.cmx
+ocamloptp.cmo : ../driver/main_args.cmi
+ocamloptp.cmx : ../driver/main_args.cmx
+ocamlprof.cmo : ../utils/warnings.cmi ../parsing/syntaxerr.cmi \
+    ../parsing/parsetree.cmi ../parsing/parse.cmi ../parsing/location.cmi \
+    ../parsing/lexer.cmi
+ocamlprof.cmx : ../utils/warnings.cmx ../parsing/syntaxerr.cmx \
+    ../parsing/parsetree.cmi ../parsing/parse.cmx ../parsing/location.cmx \
+    ../parsing/lexer.cmx
+opnames.cmo :
+opnames.cmx :
+primreq.cmo : ../utils/config.cmi ../bytecomp/cmo_format.cmi
+primreq.cmx : ../utils/config.cmx ../bytecomp/cmo_format.cmi
+profiling.cmo : profiling.cmi
+profiling.cmx : profiling.cmi
+read_cmt.cmo : ../typing/cmt_format.cmi cmt2annot.cmo ../utils/clflags.cmi
+read_cmt.cmx : ../typing/cmt_format.cmx cmt2annot.cmx ../utils/clflags.cmx
+scrapelabels.cmo :
+scrapelabels.cmx :
+tast_iter.cmo : ../typing/typedtree.cmi ../parsing/asttypes.cmi \
+    tast_iter.cmi
+tast_iter.cmx : ../typing/typedtree.cmx ../parsing/asttypes.cmi \
+    tast_iter.cmi
+untypeast.cmo : ../typing/typedtree.cmi ../typing/path.cmi \
+    ../parsing/parsetree.cmi ../parsing/longident.cmi ../typing/ident.cmi \
+    ../parsing/asttypes.cmi untypeast.cmi
+untypeast.cmx : ../typing/typedtree.cmx ../typing/path.cmx \
+    ../parsing/parsetree.cmi ../parsing/longident.cmx ../typing/ident.cmx \
+    ../parsing/asttypes.cmi untypeast.cmi
diff -Nru ocaml-3.12.1/tools/.ignore ocaml-4.01.0/tools/.ignore
--- ocaml-3.12.1/tools/.ignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/tools/.ignore	2012-12-06 15:40:24.000000000 +0000
@@ -0,0 +1,28 @@
+ocamldep
+ocamldep.opt
+ocamldep.bak
+ocamlprof
+opnames.ml
+dumpobj
+dumpapprox
+objinfo
+cvt_emit
+cvt_emit.bak
+cvt_emit.ml
+ocamlcp
+ocamloptp
+ocamlmktop
+primreq
+ocamldumpobj
+keywords
+lexer299.ml
+ocaml299to3
+ocamlmklib
+ocamlmklib.ml
+lexer301.ml
+scrapelabels
+addlabels
+myocamlbuild_config.ml
+objinfo_helper
+read_cmt
+read_cmt.opt
diff -Nru ocaml-3.12.1/tools/Characters ocaml-4.01.0/tools/Characters
--- ocaml-3.12.1/tools/Characters	1999-11-29 19:04:21.000000000 +0000
+++ ocaml-4.01.0/tools/Characters	1970-01-01 00:00:00.000000000 +0000
@@ -1,16 +0,0 @@
-# Characters
-
-# $Id: Characters 2629 1999-11-29 19:04:21Z doligez $
-
-# Usage:
-#    Characters n1 to n2
-#
-# Select the characters in the given interval, counting from the first
-# character of the current line, in the active window.
-#
-# Typical use is an error message of the form:
-#    File fff; Line lll; Characters yyy to zzz
-
-exit 1 if {#} ­ 3
-
-Find Ƥ!{1}:¤!`evaluate {3} - {1}` "{active}"
diff -Nru ocaml-3.12.1/tools/DoMake ocaml-4.01.0/tools/DoMake
--- ocaml-3.12.1/tools/DoMake	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/tools/DoMake	1970-01-01 00:00:00.000000000 +0000
@@ -1,61 +0,0 @@
-# DoMake
-
-# $Id: DoMake 9547 2010-01-22 12:48:24Z doligez $
-
-# Execute the output of "Make -f Makefile.Mac -f Makefile.Mac.depend"
-# or "Make -f Makefile -f Makefile.depend" if "Makefile.Mac" does not exist
-# or "Make -f " if the "-f" option is given.
-
-# usage: domake [-quiet] [-f ]É 
-
-set echo 0
-
-set domake_quiet 0
-set domake_files ""
-
-loop
-  if "{1}" == "-quiet"
-    set domake_quiet 1
-    shift
-  else if "{1}" == "-f"
-    set domake_files "{domake_files} -f `quote "{2}"`"
-    shift 2
-  else
-    break
-  end
-end
-
-set tempfile "{TempFolder}temp-domake-`Date -n`"
-if "`exists "{tempfile}"`"
-  set i 0
-  loop
-    break if ! "`exists "{tempfile}.{i}"`"
-    evaluate i += 1
-  end
-  set tempfile "{tempfile}.{i}"
-end
-
-if "{domake_files}" == ""
-  if "`exists Makefile.Mac`" != ""
-    set domake_main "Makefile.Mac"
-  else
-    set domake_main "Makefile"
-  end
-
-  if "`exists "{domake_main}".depend`" != ""
-    set domake_files "-f {domake_main} -f {domake_main}.depend"
-  else
-    set domake_files "-f {domake_main}"
-  end
-end
-
-if {domake_quiet}
-  echo >"{tempfile}"
-else
-  echo 'set echo 1' >"{tempfile}"
-end
-make {domake_files} {"Parameters"} >>"{tempfile}"
-
-"{tempfile}"
-
-Delete -i "{tempfile}"
diff -Nru ocaml-3.12.1/tools/MakeDepend ocaml-4.01.0/tools/MakeDepend
--- ocaml-3.12.1/tools/MakeDepend	1999-11-29 19:04:25.000000000 +0000
+++ ocaml-4.01.0/tools/MakeDepend	1970-01-01 00:00:00.000000000 +0000
@@ -1,17 +0,0 @@
-# MakeDepend
-
-# $Id: MakeDepend 2631 1999-11-29 19:04:25Z doligez $
-
-
-# Usage: MakeDepend fileÉ
-
-# Generate the Make dependency rules for a set of C files.
-# The rules are printed on standard output.
-
-set echo 0
-set exit 0
-
-for i in {"parameters"}
-  mrc -c -w off -make dev:stdout "{i}" ³ dev:null ¶
-  | streamedit -e '/¶"(Å)¨0.c.o¶"/ replace // "¶""¨0".c.o¶" ¶""¨0".c.x¶""'
-end
diff -Nru ocaml-3.12.1/tools/Makefile ocaml-4.01.0/tools/Makefile
--- ocaml-3.12.1/tools/Makefile	2007-11-22 22:14:43.000000000 +0000
+++ ocaml-4.01.0/tools/Makefile	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -10,8 +10,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile 8616 2007-11-22 22:14:43Z doligez $
-
 include Makefile.shared
 
 # To make custom toplevels
@@ -19,3 +17,9 @@
 ocamlmktop: ocamlmktop.tpl ../config/Makefile
 	sed -e 's|%%BINDIR%%|$(BINDIR)|' ocamlmktop.tpl > ocamlmktop
 	chmod +x ocamlmktop
+
+install::
+	cp ocamlmktop $(BINDIR)
+
+clean::
+	rm -f ocamlmktop
diff -Nru ocaml-3.12.1/tools/Makefile.nt ocaml-4.01.0/tools/Makefile.nt
--- ocaml-3.12.1/tools/Makefile.nt	2007-11-07 10:14:21.000000000 +0000
+++ ocaml-4.01.0/tools/Makefile.nt	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -10,8 +10,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile.nt 8485 2007-11-07 10:14:21Z frisch $
-
 include Makefile.shared
 
 # To make custom toplevels
@@ -21,3 +19,9 @@
 
 ocamlmktop: $(OCAMLMKTOP)
 	$(CAMLC) $(LINKFLAGS) -o ocamlmktop $(OCAMLMKTOP_IMPORTS) $(OCAMLMKTOP)
+
+install::
+	cp ocamlmktop $(BINDIR)/ocamlmktop$(EXE)
+
+clean::
+	rm -f ocamlmktop$(EXE)
diff -Nru ocaml-3.12.1/tools/Makefile.shared ocaml-4.01.0/tools/Makefile.shared
--- ocaml-3.12.1/tools/Makefile.shared	2010-10-15 15:36:55.000000000 +0000
+++ ocaml-4.01.0/tools/Makefile.shared	2013-06-05 16:34:40.000000000 +0000
@@ -1,6 +1,6 @@
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
 #                                                                       #
@@ -10,8 +10,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile.shared 10718 2010-10-15 15:36:55Z doligez $
-
 include ../config/Makefile
 
 CAMLRUN=../boot/ocamlrun
@@ -20,26 +18,31 @@
 CAMLLEX=$(CAMLRUN) ../boot/ocamllex
 INCLUDES=-I ../utils -I ../parsing -I ../typing -I ../bytecomp -I ../asmcomp \
 	 -I ../driver
-COMPFLAGS= -warn-error A $(INCLUDES)
+COMPFLAGS= -w +32..39 -warn-error A $(INCLUDES)
 LINKFLAGS=$(INCLUDES)
 
-all: ocamldep ocamlprof ocamlcp ocamlmktop ocamlmklib dumpobj objinfo
+all: ocamldep ocamlprof ocamlcp ocamloptp ocamlmktop ocamlmklib dumpobj \
+     objinfo read_cmt
+
+all: tast_iter.cmo
+
 # scrapelabels addlabels
 
 .PHONY: all
 
-opt.opt: ocamldep.opt
+opt.opt: ocamldep.opt read_cmt.opt
 .PHONY: opt.opt
 
 # The dependency generator
 
 CAMLDEP_OBJ=depend.cmo ocamldep.cmo
 CAMLDEP_IMPORTS=misc.cmo config.cmo clflags.cmo terminfo.cmo \
-  linenum.cmo warnings.cmo location.cmo longident.cmo \
-  syntaxerr.cmo parser.cmo lexer.cmo parse.cmo
+  warnings.cmo location.cmo longident.cmo \
+  syntaxerr.cmo parser.cmo lexer.cmo parse.cmo \
+  ccomp.cmo pparse.cmo compenv.cmo
 
 ocamldep: depend.cmi $(CAMLDEP_OBJ)
-	$(CAMLC) $(LINKFLAGS) -o ocamldep $(CAMLDEP_IMPORTS) $(CAMLDEP_OBJ)
+	$(CAMLC) $(LINKFLAGS) -compat-32 -o ocamldep $(CAMLDEP_IMPORTS) $(CAMLDEP_OBJ)
 
 ocamldep.opt: depend.cmi $(CAMLDEP_OBJ:.cmo=.cmx)
 	$(CAMLOPT) $(LINKFLAGS) -o ocamldep.opt $(CAMLDEP_IMPORTS:.cmo=.cmx) \
@@ -60,7 +63,7 @@
 
 CSLPROF=ocamlprof.cmo
 CSLPROF_IMPORTS=misc.cmo config.cmo clflags.cmo terminfo.cmo \
-  linenum.cmo warnings.cmo location.cmo longident.cmo \
+  warnings.cmo location.cmo longident.cmo \
   syntaxerr.cmo parser.cmo lexer.cmo parse.cmo
 
 ocamlprof: $(CSLPROF) profiling.cmo
@@ -69,16 +72,26 @@
 ocamlcp: ocamlcp.cmo
 	$(CAMLC) $(LINKFLAGS) -o ocamlcp warnings.cmo main_args.cmo ocamlcp.cmo
 
+ocamloptp: ocamloptp.cmo
+	$(CAMLC) $(LINKFLAGS) -o ocamloptp warnings.cmo main_args.cmo \
+	         ocamloptp.cmo
+
+opt:: profiling.cmx
+
 install::
 	cp ocamlprof $(BINDIR)/ocamlprof$(EXE)
 	cp ocamlcp $(BINDIR)/ocamlcp$(EXE)
+	cp ocamloptp $(BINDIR)/ocamloptp$(EXE)
 	cp profiling.cmi profiling.cmo $(LIBDIR)
 
+installopt::
+	cp profiling.cmx profiling.o $(LIBDIR)
+
 clean::
-	rm -f ocamlprof ocamlcp
+	rm -f ocamlprof ocamlcp ocamloptp
 
 
-# To help building mixed-mode libraries (Caml + C)
+# To help building mixed-mode libraries (OCaml + C)
 
 ocamlmklib: myocamlbuild_config.cmo ocamlmklib.cmo
 	$(CAMLC) $(LINKFLAGS) -o ocamlmklib myocamlbuild_config.cmo \
@@ -114,19 +127,11 @@
 clean::
 	rm -f ocamlmklib.ml
 
-# To make custom toplevels (see Makefile/Makefile.nt)
-
-install::
-	cp ocamlmktop $(BINDIR)/   # no $(EXE) here, ocamlmktop is a script
-
-clean::
-	rm -f ocamlmktop
-
 
 # Converter olabl/ocaml 2.99 to ocaml 3
 
 OCAML299TO3= lexer299.cmo ocaml299to3.cmo
-LIBRARY3= misc.cmo warnings.cmo linenum.cmo location.cmo
+LIBRARY3= misc.cmo warnings.cmo location.cmo
 
 ocaml299to3: $(OCAML299TO3)
 	$(CAMLC) $(LINKFLAGS) -o ocaml299to3 $(LIBRARY3) $(OCAML299TO3)
@@ -159,7 +164,7 @@
 # Insert labels following an interface file (upgrade 3.02 to 3.03)
 
 ADDLABELS_IMPORTS=misc.cmo config.cmo clflags.cmo terminfo.cmo \
-  linenum.cmo warnings.cmo location.cmo longident.cmo \
+  warnings.cmo location.cmo longident.cmo \
   syntaxerr.cmo parser.cmo lexer.cmo parse.cmo
 
 addlabels: addlabels.cmo
@@ -192,6 +197,56 @@
 
 beforedepend:: cvt_emit.ml
 
+
+# Reading cmt files
+
+READ_CMT= \
+          ../utils/misc.cmo \
+          ../utils/warnings.cmo \
+          ../utils/tbl.cmo \
+          ../utils/consistbl.cmo \
+          ../utils/config.cmo \
+          ../utils/clflags.cmo \
+          ../parsing/location.cmo \
+          ../parsing/longident.cmo \
+          ../parsing/lexer.cmo \
+          ../parsing/pprintast.cmo \
+          ../typing/ident.cmo \
+          ../typing/path.cmo \
+          ../typing/types.cmo \
+          ../typing/typedtree.cmo \
+          ../typing/btype.cmo \
+          ../typing/subst.cmo \
+          ../typing/predef.cmo \
+          ../typing/datarepr.cmo \
+          ../typing/cmi_format.cmo \
+          ../typing/env.cmo \
+          ../typing/ctype.cmo \
+          ../typing/oprint.cmo \
+          ../typing/primitive.cmo \
+          ../typing/printtyp.cmo \
+          ../typing/mtype.cmo \
+          ../typing/envaux.cmo \
+          ../typing/typedtreeMap.cmo \
+          ../typing/typedtreeIter.cmo \
+          ../typing/cmt_format.cmo \
+          ../typing/stypes.cmo \
+          \
+          untypeast.cmo \
+          tast_iter.cmo \
+          cmt2annot.cmo read_cmt.cmo
+
+read_cmt: $(READ_CMT)
+	$(CAMLC) $(LINKFLAGS) -o read_cmt $(READ_CMT)
+
+read_cmt.opt: $(READ_CMT:.cmo=.cmx)
+	$(CAMLOPT) $(LINKFLAGS) -o read_cmt.opt $(READ_CMT:.cmo=.cmx)
+
+clean::
+	rm -f read_cmt read_cmt.opt
+
+beforedepend::
+
 # The bytecode disassembler
 
 DUMPOBJ=opnames.cmo dumpobj.cmo
@@ -227,7 +282,9 @@
 	$(BYTECC) -o objinfo_helper$(EXE) $(BYTECCCOMPOPTS) \
           objinfo_helper.c $(LIBBFD_LINK)
 
-OBJINFO=../utils/misc.cmo ../utils/config.cmo ../bytecomp/bytesections.cmo \
+OBJINFO=../utils/misc.cmo ../utils/config.cmo \
+        ../utils/warnings.cmo ../parsing/location.cmo \
+        ../typing/cmi_format.cmo ../bytecomp/bytesections.cmo \
         objinfo.cmo
 
 objinfo: objinfo_helper$(EXE) $(OBJINFO)
diff -Nru ocaml-3.12.1/tools/OCamlc-custom ocaml-4.01.0/tools/OCamlc-custom
--- ocaml-3.12.1/tools/OCamlc-custom	1996-11-02 18:05:24.000000000 +0000
+++ ocaml-4.01.0/tools/OCamlc-custom	1970-01-01 00:00:00.000000000 +0000
@@ -1,10 +0,0 @@
-# OCamlc with option -custom
-# Macintosh version
-
-set echo 0
-set -e ocamlcommands "{tempfolder}"OCaml.temp."`date -n`"
-echo >"{ocamlcommands}"
-ocamlc -custom {"parameters"}
-execute "{ocamlcommands}"
-
-delete -y "{ocamlcommands}"
diff -Nru ocaml-3.12.1/tools/Time ocaml-4.01.0/tools/Time
--- ocaml-3.12.1/tools/Time	1998-07-04 17:32:15.000000000 +0000
+++ ocaml-4.01.0/tools/Time	1970-01-01 00:00:00.000000000 +0000
@@ -1,10 +0,0 @@
-# Time       # Measure execution time
-# Usage: Time command argumentsÉ
-
-set echo 0
-
-set startdate `date -n`
-{parameters}
-set enddate `date -n`
-
-echo "# Time: `evaluate {enddate} - {startdate}` s" > dev:stderr
diff -Nru ocaml-3.12.1/tools/addlabels.ml ocaml-4.01.0/tools/addlabels.ml
--- ocaml-3.12.1/tools/addlabels.ml	2010-04-08 03:58:41.000000000 +0000
+++ ocaml-4.01.0/tools/addlabels.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,4 +1,15 @@
-(* $Id: addlabels.ml 10250 2010-04-08 03:58:41Z garrigue $ *)
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Jacques Garrigue, Kyoto University RIMS                  *)
+(*                                                                     *)
+(*  Copyright 2001 Institut National de Recherche en Informatique et   *)
+(*  en Automatique and Kyoto University.  All rights reserved.         *)
+(*  This file is distributed under the terms of the Q Public License   *)
+(*  version 1.0.                                                       *)
+(*                                                                     *)
+(***********************************************************************)
 
 open StdLabels
 open Asttypes
@@ -36,11 +47,11 @@
     Pcty_fun (lab, _, rem) ->
       let (labs, meths) = labels_of_cty rem in
       (lab :: labs, meths)
-  | Pcty_signature (_, fields) ->
+  | Pcty_signature { pcsig_fields = fields } ->
       ([],
        List.fold_left fields ~init:[] ~f:
           begin fun meths -> function
-              Pctf_meth (s, _, sty, _) -> (s, labels_of_sty sty)::meths
+          { pctf_desc = Pctf_meth (s, _, sty) } -> (s, labels_of_sty sty)::meths
             | _ -> meths
           end)
   |  _ ->
@@ -48,9 +59,9 @@
 
 let rec pattern_vars pat =
   match pat.ppat_desc with
-    Ppat_var s -> [s]
+    Ppat_var s -> [s.txt]
   | Ppat_alias (pat, s) ->
-      s :: pattern_vars pat
+      s.txt :: pattern_vars pat
   | Ppat_tuple l
   | Ppat_array l ->
       List.concat (List.map pattern_vars l)
@@ -64,7 +75,7 @@
       pattern_vars pat1 @ pattern_vars pat2
   | Ppat_lazy pat -> pattern_vars pat
   | Ppat_any | Ppat_constant _ | Ppat_construct _ | Ppat_variant _
-  | Ppat_type _ ->
+  | Ppat_type _ | Ppat_unpack _ ->
       []
 
 let pattern_name pat =
@@ -111,7 +122,7 @@
         let start_c = pat.ppat_loc.Location.loc_start.Lexing.pos_cnum in
         let pos = insertion_point start_c ~text in
         match pattern_name pat with
-        | Some name when l = name -> add_insertion pos "~"
+        | Some name when l = name.txt -> add_insertion pos "~"
         | _ -> add_insertion pos ("~" ^ l ^ ":")
       end;
       insert_labels ~labels ~text rem
@@ -151,7 +162,7 @@
         let start_c = pat.ppat_loc.Location.loc_start.Lexing.pos_cnum in
         let pos = insertion_point start_c ~text in
         match pattern_name pat with
-        | Some name when l = name -> add_insertion pos "~"
+        | Some name when l = name.txt -> add_insertion pos "~"
         | _ -> add_insertion pos ("~" ^ l ^ ":")
       end;
       insert_labels_class ~labels ~text rem
@@ -179,7 +190,8 @@
         let pos0 = arg.pexp_loc.Location.loc_start.Lexing.pos_cnum in
         let pos = insertion_point pos0 ~text in
         match arg.pexp_desc with
-        | Pexp_ident(Longident.Lident name) when l = name && pos = pos0 ->
+        | Pexp_ident({ txt = Longident.Lident name })
+          when l = name && pos = pos0 ->
             add_insertion pos "~"
         | _ -> add_insertion pos ("~" ^ l ^ ":")
       end;
@@ -205,7 +217,7 @@
   let add_labels_rec ?(values=values) expr =
     add_labels_expr ~text ~values ~classes expr in
   match expr.pexp_desc with
-    Pexp_apply ({pexp_desc=Pexp_ident(Longident.Lident s)}, args) ->
+    Pexp_apply ({pexp_desc=Pexp_ident({ txt = Longident.Lident s })}, args) ->
       begin try
         let labels = SMap.find s values in
         insert_labels_app ~labels ~text args
@@ -213,14 +225,16 @@
       end;
       List.iter args ~f:(fun (_,e) -> add_labels_rec e)
   | Pexp_apply ({pexp_desc=Pexp_send
-                   ({pexp_desc=Pexp_ident(Longident.Lident s)},meth)}, args) ->
+                   ({pexp_desc=Pexp_ident({ txt = Longident.Lident s })},
+                    meth)},
+                args) ->
       begin try
         if SMap.find s values = [""] then
           let labels = SMap.find (s ^ "#" ^ meth) values in
           insert_labels_app ~labels ~text args
       with Not_found -> ()
       end
-  | Pexp_apply ({pexp_desc=Pexp_new (Longident.Lident s)}, args) ->
+  | Pexp_apply ({pexp_desc=Pexp_new ({ txt = Longident.Lident s })}, args) ->
       begin try
         let labels = SMap.find s classes in
         insert_labels_app ~labels ~text args
@@ -275,7 +289,7 @@
       add_labels_rec e1; add_labels_rec e2; add_labels_rec e3
   | Pexp_for (s, e1, e2, _, e3) ->
       add_labels_rec e1; add_labels_rec e2;
-      add_labels_rec e3 ~values:(SMap.removes [s] values)
+      add_labels_rec e3 ~values:(SMap.removes [s.txt] values)
   | Pexp_override lst ->
       List.iter lst ~f:(fun (_,e) -> add_labels_rec e)
   | Pexp_ident _ | Pexp_constant _ | Pexp_construct _ | Pexp_variant _
@@ -285,23 +299,23 @@
 let rec add_labels_class ~text ~classes ~values ~methods cl =
   match cl.pcl_desc with
     Pcl_constr _ -> ()
-  | Pcl_structure (p, l) ->
+  | Pcl_structure { pcstr_pat = p; pcstr_fields = l } ->
       let values = SMap.removes (pattern_vars p) values in
       let values =
         match pattern_name p with None -> values
         | Some s ->
             List.fold_left methods
-              ~init:(SMap.add s [""] values)
-              ~f:(fun m (k,l) -> SMap.add (s^"#"^k) l m)
+              ~init:(SMap.add s.txt [""] values)
+              ~f:(fun m (k,l) -> SMap.add (s.txt^"#"^k) l m)
       in
       ignore (List.fold_left l ~init:values ~f:
-        begin fun values -> function
-          | Pcf_val (s, _, _, e, _) ->
+        begin fun values -> function e -> match e.pcf_desc with
+          | Pcf_val (s, _, _, e) ->
               add_labels_expr ~text ~classes ~values e;
-              SMap.removes [s] values
-          | Pcf_meth (s, _, _, e, _) ->
+              SMap.removes [s.txt] values
+          | Pcf_meth (s, _, _, e) ->
               begin try
-                let labels = List.assoc s methods in
+                let labels = List.assoc s.txt methods in
                 insert_labels ~labels ~text e
               with Not_found -> ()
               end;
@@ -310,8 +324,7 @@
           | Pcf_init e ->
               add_labels_expr ~text ~classes ~values e;
               values
-          | Pcf_inher _ | Pcf_valvirt _ | Pcf_virt _ | Pcf_cstr _ -> values
-          | Pcf_let _ -> values (* not in the grammar *)
+          | Pcf_inher _ | Pcf_valvirt _ | Pcf_virt _ | Pcf_constr _ -> values
         end)
   | Pcl_fun (_, opt, pat, cl) ->
       begin match opt with None -> ()
@@ -341,12 +354,12 @@
       begin fun (values, classes as acc) item ->
         match item.psig_desc with
           Psig_value (name, {pval_type = sty}) ->
-            (SMap.add name (labels_of_sty sty) values, classes)
+            (SMap.add name.txt (labels_of_sty sty) values, classes)
         | Psig_class l ->
           (values,
            List.fold_left l ~init:classes ~f:
              begin fun classes {pci_name=name; pci_expr=cty} ->
-               SMap.add name (labels_of_cty cty) classes
+               SMap.add name.txt (labels_of_cty cty) classes
              end)
         | _ ->
             acc
@@ -364,7 +377,7 @@
               begin match pattern_name pat with
               | Some s ->
                   begin try
-                    let labels = SMap.find s values in
+                    let labels = SMap.find s.txt values in
                     insert_labels ~labels ~text expr;
                     if !norec then () else
                     let values =
@@ -381,17 +394,17 @@
           (SMap.removes names values, classes)
       | Pstr_primitive (s, {pval_type=sty}) ->
           begin try
-            let labels = SMap.find s values in
+            let labels = SMap.find s.txt values in
             insert_labels_type ~labels ~text sty;
-            (SMap.removes [s] values, classes)
+            (SMap.removes [s.txt] values, classes)
           with Not_found -> acc
           end
       | Pstr_class l ->
-          let names = List.map l ~f:(fun pci -> pci.pci_name) in
+          let names = List.map l ~f:(fun pci -> pci.pci_name.txt) in
           List.iter l ~f:
             begin fun {pci_name=name; pci_expr=expr} ->
               try
-                let (labels, methods) = SMap.find name classes in
+                let (labels, methods) = SMap.find name.txt classes in
                 insert_labels_class ~labels ~text expr;
                 if !norec then () else
                 let classes =
diff -Nru ocaml-3.12.1/tools/check-typo ocaml-4.01.0/tools/check-typo
--- ocaml-3.12.1/tools/check-typo	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/tools/check-typo	2013-07-09 13:43:03.000000000 +0000
@@ -0,0 +1,232 @@
+#!/bin/sh
+
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#           Damien Doligez, projet Gallium, INRIA Rocquencourt          #
+#                                                                       #
+#   Copyright 2012 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+# check-typo - Check typographic conventions on OCaml sources.
+
+# This program will check files for the following rules:
+
+# - absence of TAB characters (tab)
+# - absence of non-ASCII characters (non-ascii)
+# - absence of non-printing ASCII characters (non-printing)
+# - absence of white space at end of line (white-at-eol)
+# - absence of empty lines at end of file (white-at-eof)
+# - presence of a LF character at the end of the file (missing-lf)
+# - maximum line length of 80 characters (long-line)
+# - presence of a copyright header (missing-header)
+# - absence of a leftover "$Id" string (svn-keyword)
+
+# Exceptions are handled with a SVN property: "ocaml:typo".
+# Its value for a given file is a comma-separated list of rule names,
+# which lists the rules that should be disabled for this file.
+# The rule names are the ones shown above in parentheses.
+
+# Built-in exceptions:
+# - Any binary file (i.e. with svn:mime-type = application/octet-stream)
+#   is automatically exempt from all the rules.
+# - Any file whose name begins with "Makefile" is automatically exempt
+#   from the "tabs" rule.
+# - Any file whose name matches one of the following patterns is
+#   automatically exempt from the "missing-header" rule.
+#     */.depend*
+#     */.ignore
+#     *.mlpack
+#     *.mllib
+#     *.mltop
+#     *.odocl
+#     *.clib
+#     *.reference
+#     */reference
+# - Any file whose name matches one of the following patterns is
+#   automatically exempt from the "long-line" rule.
+#     *.reference
+
+# ASCII characters are bytes from 0 to 127.  Any other byte is
+# flagged as a non-ASCII character.
+
+# For the purpose of this tool, printing ASCII characters are:
+# - the non-white printable ASCII characters (33 to 126)
+# - TAB (09)
+# - LF (10)
+# - SPC (32)
+# Anything else is flagged as a non-printing ASCII character.
+
+# This program will recursively explore the files and directories given
+# on the command line (or by default the current directory), and check
+# every file therein for compliance to the rules.
+
+# Directories named .svn and _build (and their contents) are always ignored.
+# This program ignores any file that is not under svn control, unless
+# explicitly given on the command line.
+
+# If a directory has the SVN property "ocaml:typo" set to "prune",
+# then it and its contents are ignored.
+
+# You can ignore a rule by giving the option - on the command
+# line (before any file names).
+
+# Special case for recursive call from the find command (see IGNORE_DIRS).
+case "$1" in
+  --check-prune)
+    case `svn propget ocaml:typo "$2" 2>/dev/null` in
+      prune) echo "INFO: pruned directory $2 (ocaml:typo=prune)" >&2; exit 0;;
+      *) exit 3;;
+    esac;;
+esac
+
+usage () {
+  echo "usage: check-typo {-} [--] {}" >&2
+  exit 2
+}
+
+userrules=''
+
+while : ; do
+  case "$1" in
+    -help|--help) usage;;
+    -*) userrules="${1#-},$userrules"; shift;;
+    --) shift; break;;
+    *) break;;
+  esac
+done
+
+IGNORE_DIRS="
+  -name .svn -prune -o
+  -name _build -prune -o
+  -type d -exec $0 --check-prune {} ; -prune -o
+"
+
+( case $# in
+    0) find . $IGNORE_DIRS -type f -print;;
+    *) for i in "$@"; do find "$i" $IGNORE_DIRS -type f -print; done;;
+  esac
+) | (
+  while read f; do
+    case `svn status "$f" 2>&1` in
+      '?'*) is_svn=false;;
+      I*) is_svn=false;;
+      svn:*"is not a working copy") is_svn=false;;
+      *) is_svn=true;;
+    esac
+    case "$*" in
+      *$f*) is_cmd_line=true;;
+      *) is_cmd_line=false;;
+    esac
+    if $is_svn || $is_cmd_line; then :; else continue; fi
+    svnrules=''
+    if $is_svn; then
+      case `svn propget svn:mime-type "$f"` in
+        application/octet-stream) continue;;
+      esac
+      svnrules=`svn propget ocaml:typo "$f"`
+    fi
+    rules="$userrules"
+    case "$f" in
+      Makefile*|*/Makefile*) rules="tab,$rules";;
+    esac
+    h(){ rules="missing-header,$rules"; }
+    case "$f" in
+      */.depend*|*/.ignore) h;;
+      *.mlpack|*.mllib|*.mltop|*.odocl|*.itarget|*.clib) h;;
+      *.reference|*/reference) h;;
+    esac
+    case "$f" in
+      *.reference) rules="long-line,$rules";;
+    esac
+
+    (cat "$f"; echo) \
+    | awk -v rules="$rules" -v svnrules="$svnrules" -v file="$f" \
+      '
+        function err(name, msg) {
+          ++ counts[name];
+          if (("," rules svnrules ",") !~ ("[, ]" name "[, ]") \
+              && counts[name] <= 10){
+            printf ("%s:%d.%d:", file, NR, RSTART + RLENGTH);
+            printf (" [%s] %s\n", name, msg);
+            if (counts[name] == 10){
+              printf ("WARNING: too many [%s] in this file.", name);
+              printf ("  Others will not be reported.\n");
+            }
+          }
+        }
+
+        match($0, /\t/) {
+          err("tab", "TAB character(s)");
+        }
+
+        match($0, /[\200-\377]/) {
+          err("non-ascii", "non-ASCII character(s)");
+        }
+
+        match($0, /[^\t\200-\377 -~]/) {
+          err("non-printing", "non-printing ASCII character(s)");
+        }
+
+        match($0, /[ \t]+$/) {
+          err("white-at-eol", "whitespace at end of line");
+        }
+
+        match($0, /\$Id(: .*)?\$/) {
+          err("svn-keyword", "SVN keyword marker");
+        }
+
+        length($0) > 80 {
+          RSTART = 81;
+          RLENGTH = 0;
+          err("long-line", "line is over 80 characters");
+        }
+
+        3 <= NR && NR <= 5 \
+        && (/ OCaml / || / ocamlbuild / || / OCamldoc /) {
+          header_ocaml = NR;
+        }
+
+        header_ocaml && header_ocaml + 4 <= NR && NR <= header_ocaml + 6 \
+        && / Copyright / {
+          header_copyright = 1;
+        }
+
+        {
+          prev_line = last_line;
+          last_line = $0;
+        }
+
+        END {
+          if (match(last_line, /.+/)){
+            err("missing-lf", "missing linefeed at EOF");
+            prev_line = last_line;
+            ++ NR;
+            empty_file = 0;
+          }else{
+            empty_file = NR == 1;
+          }
+          if (!empty_file && match(prev_line, /^$/)){
+            err("white-at-eof", "empty line(s) at EOF");
+          }
+          NR = 1;
+          RSTART = 1;
+          RLENGTH = 0;
+          if (!(header_ocaml && header_copyright)){
+            err("missing-header", "missing copyright header");
+          }
+          split(svnrules, r, "[, ]");
+          for (i in r){
+            name = r[i];
+            if (name != "" && !counts[name]){
+              err("unused-prop", sprintf("unused [%s] in ocaml:typo", name));
+            }
+          }
+        }
+      '
+  done
+)
diff -Nru ocaml-3.12.1/tools/checkstack.c ocaml-4.01.0/tools/checkstack.c
--- ocaml-3.12.1/tools/checkstack.c	2010-02-09 14:48:28.000000000 +0000
+++ ocaml-4.01.0/tools/checkstack.c	2012-10-15 17:50:56.000000000 +0000
@@ -1,18 +1,15 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*          Damien Doligez, projet Moscova, INRIA Rocquencourt         */
 /*                                                                     */
 /*  Copyright 2002 Institut National de Recherche en Informatique et   */
 /*  en Automatique.  All rights reserved.  This file is distributed    */
-/*  under the terms of the GNU Library General Public License, with    */
-/*  the special exception on linking described in file ../../LICENSE.  */
+/*  under the terms of the Q Public License version 1.0.               */
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: checkstack.c 9625 2010-02-09 14:48:28Z weis $ */
-
 #include 
 #include 
 #include 
diff -Nru ocaml-3.12.1/tools/cleanup-header ocaml-4.01.0/tools/cleanup-header
--- ocaml-3.12.1/tools/cleanup-header	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/tools/cleanup-header	2012-07-17 15:31:12.000000000 +0000
@@ -1,4 +1,17 @@
 #!/bin/sed -f
+
+#######################################################################
+#                                                                     #
+#                                OCaml                                #
+#                                                                     #
+#            Xavier Leroy, projet Cristal, INRIA Rocquencourt         #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique.  All rights reserved.  This file is distributed    #
+#  under the terms of the Q Public License version 1.0.               #
+#                                                                     #
+#######################################################################
+
 # Remove private parts from runtime include files, before installation
 # in /usr/local/lib/ocaml/caml
 
diff -Nru ocaml-3.12.1/tools/cmt2annot.ml ocaml-4.01.0/tools/cmt2annot.ml
--- ocaml-3.12.1/tools/cmt2annot.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/tools/cmt2annot.ml	2013-07-23 14:48:47.000000000 +0000
@@ -0,0 +1,195 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                  Fabrice Le Fessant, INRIA Saclay                   *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* Generate an .annot file from a .cmt file. *)
+
+open Asttypes
+open Typedtree
+
+let bind_variables scope =
+  object
+    inherit Tast_iter.iter as super
+
+    method! pattern pat =
+      super # pattern pat;
+      match pat.pat_desc with
+      | Tpat_var (id, _) | Tpat_alias (_, id, _) ->
+          Stypes.record (Stypes.An_ident (pat.pat_loc,
+                                          Ident.name id,
+                                          Annot.Idef scope))
+      | _ -> ()
+  end
+
+let bind_bindings scope bindings =
+  let o = bind_variables scope in
+  List.iter (fun (p, _) -> o # pattern p) bindings
+
+let bind_cases l =
+  List.iter (fun (p, e) -> (bind_variables e.exp_loc) # pattern p) l
+
+let iterator rebuild_env =
+  object(this)
+    val scope = Location.none  (* scope of the surrounding structure *)
+
+    inherit Tast_iter.iter as super
+
+    method! class_expr node =
+      Stypes.record (Stypes.Ti_class node);
+      super # class_expr node
+
+    method! module_expr node =
+      Stypes.record (Stypes.Ti_mod node);
+      Tast_iter.module_expr {< scope = node.mod_loc >} node
+
+    method! expression exp =
+      begin match exp.exp_desc with
+      | Texp_ident (path, _, _) ->
+          let full_name = Path.name ~paren:Oprint.parenthesized_ident path in
+          let env =
+            if rebuild_env then
+              try
+                Env.env_of_only_summary Envaux.env_from_summary exp.exp_env
+              with Envaux.Error err ->
+                Format.eprintf "%a@." Envaux.report_error err;
+                exit 2
+            else
+              exp.exp_env
+          in
+          let annot =
+            try
+              let desc = Env.find_value path env in
+              let dloc = desc.Types.val_loc in
+              if dloc.Location.loc_ghost then Annot.Iref_external
+              else Annot.Iref_internal dloc
+            with Not_found ->
+              Annot.Iref_external
+          in
+          Stypes.record
+            (Stypes.An_ident (exp.exp_loc, full_name , annot))
+      | Texp_let (Recursive, bindings, _) ->
+          bind_bindings exp.exp_loc bindings
+      | Texp_let (Nonrecursive, bindings, body) ->
+          bind_bindings body.exp_loc bindings
+      | Texp_function (_, f, _)
+      | Texp_match (_, f, _)
+      | Texp_try (_, f) ->
+          bind_cases f
+      | _ -> ()
+      end;
+      Stypes.record (Stypes.Ti_expr exp);
+      super # expression exp
+
+    method! pattern pat =
+      super # pattern pat;
+      Stypes.record (Stypes.Ti_pat pat)
+
+    method private structure_item_rem s rem =
+      begin match s with
+      | {str_desc = Tstr_value (rec_flag, bindings); str_loc = loc} ->
+          let open Location in
+          let doit loc_start = bind_bindings {scope with loc_start} bindings in
+          begin match rec_flag, rem with
+          | Default, _ -> ()
+          | Recursive, _ -> doit loc.loc_start
+          | Nonrecursive, [] -> doit loc.loc_end
+          | Nonrecursive,  {str_loc = loc2} :: _ -> doit loc2.loc_start
+          end
+      | _ ->
+          ()
+      end;
+      Stypes.record_phrase s.str_loc;
+      super # structure_item s
+
+    method! structure_item s =
+      (* This will be used for Partial_structure_item.
+         We don't have here the location of the "next" item,
+         this will give a slightly different scope for the non-recursive
+         binding case. *)
+      this # structure_item_rem s []
+
+    method! structure l =
+      let rec loop = function
+        | str :: rem -> this # structure_item_rem str rem; loop rem
+        | [] -> ()
+      in
+      loop l.str_items
+
+(* TODO: support binding for Tcl_fun, Tcl_let, etc *)
+  end
+
+let binary_part iter x =
+  let open Cmt_format in
+  match x with
+  | Partial_structure x -> iter # structure x
+  | Partial_structure_item x -> iter # structure_item x
+  | Partial_expression x -> iter # expression x
+  | Partial_pattern x -> iter # pattern x
+  | Partial_class_expr x -> iter # class_expr x
+  | Partial_signature x -> iter # signature x
+  | Partial_signature_item x -> iter # signature_item x
+  | Partial_module_type x -> iter # module_type x
+
+let gen_annot target_filename filename
+              {Cmt_format.cmt_loadpath; cmt_annots; cmt_use_summaries; _} =
+  let open Cmt_format in
+  Envaux.reset_cache ();
+  Config.load_path := cmt_loadpath;
+  let target_filename =
+    match target_filename with
+    | None -> Some (filename ^ ".annot")
+    | Some "-" -> None
+    | Some filename -> target_filename
+  in
+  let iterator = iterator cmt_use_summaries in
+  match cmt_annots with
+  | Implementation typedtree ->
+      iterator # structure typedtree;
+      Stypes.dump target_filename
+  | Interface _ ->
+      Printf.eprintf "Cannot generate annotations for interface file\n%!";
+      exit 2
+  | Partial_implementation parts ->
+      Array.iter (binary_part iterator) parts;
+      Stypes.dump target_filename
+  | _ ->
+      Printf.fprintf stderr "File was generated with an error\n%!";
+      exit 2
+
+
+
+let gen_ml target_filename filename cmt =
+  let (printer, ext) =
+    match cmt.Cmt_format.cmt_annots with
+      | Cmt_format.Implementation typedtree ->
+        (fun ppf -> Pprintast.structure ppf (Untypeast.untype_structure typedtree)), ".ml"
+      | Cmt_format.Interface typedtree ->
+        (fun ppf -> Pprintast.signature ppf (Untypeast.untype_signature typedtree)), ".mli"
+      | _ ->
+        Printf.fprintf stderr "File was generated with an error\n%!";
+        exit 2
+  in
+  let target_filename = match target_filename with
+      None -> Some (filename ^ ext)
+    | Some "-" -> None
+    | Some filename -> target_filename
+  in
+  let oc = match target_filename with
+      None -> None
+    | Some filename -> Some (open_out filename) in
+  let ppf = match oc with
+      None -> Format.std_formatter
+    | Some oc -> Format.formatter_of_out_channel oc in
+  printer ppf;
+  Format.pp_print_flush ppf ();
+  match oc with
+      None -> flush stdout
+    | Some oc -> close_out oc
diff -Nru ocaml-3.12.1/tools/cvt_emit.mll ocaml-4.01.0/tools/cvt_emit.mll
--- ocaml-3.12.1/tools/cvt_emit.mll	2000-10-02 14:18:05.000000000 +0000
+++ ocaml-4.01.0/tools/cvt_emit.mll	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: cvt_emit.mll 3304 2000-10-02 14:18:05Z maranget $ *)
-
 {
 let first_item = ref false
 let command_beginning = ref 0
@@ -59,7 +57,8 @@
           command lexbuf }
   | ( [^ '`' '{' '\\'] |
       '\\' ['\\' '"' 'n' 't' 'b' 'r' '`' '{' ] |
-      '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] ) +
+      '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] |
+      '\\' ('\n' | "\r\n")) +
         { let s = Lexing.lexeme lexbuf in
           add_semicolon();
           (* Optimise one-character strings *)
diff -Nru ocaml-3.12.1/tools/depend.ml ocaml-4.01.0/tools/depend.ml
--- ocaml-3.12.1/tools/depend.ml	2010-04-17 14:45:12.000000000 +0000
+++ ocaml-4.01.0/tools/depend.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,9 +10,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: depend.ml 10263 2010-04-17 14:45:12Z garrigue $ *)
-
-open Format
+open Asttypes
 open Location
 open Longident
 open Parsetree
@@ -32,10 +30,12 @@
   | Lapply(l1, l2) -> addmodule bv l1; addmodule bv l2
 
 let add bv lid =
-  match lid with
+  match lid.txt with
     Ldot(l, s) -> addmodule bv l
   | _ -> ()
 
+let addmodule bv lid = addmodule bv lid.txt
+
 let rec add_type bv ty =
   match ty.ptyp_desc with
     Ptyp_any -> ()
@@ -56,7 +56,7 @@
 
 and add_package_type bv (lid, l) =
   add bv lid;
-  List.iter (add_type bv) (List.map snd l)
+  List.iter (add_type bv) (List.map (fun (_, e) -> e) l)
 
 and add_field_type bv ft =
   match ft.pfield_desc with
@@ -72,10 +72,13 @@
     (fun (ty1, ty2, _) -> add_type bv ty1; add_type bv ty2)
     td.ptype_cstrs;
   add_opt add_type bv td.ptype_manifest;
-  let rec add_tkind = function
+  let add_tkind = function
     Ptype_abstract -> ()
   | Ptype_variant cstrs ->
-      List.iter (fun (c, args, _) -> List.iter (add_type bv) args) cstrs
+      List.iter (fun (c, args, rty, _) ->
+                   List.iter (add_type bv) args;
+                   Misc.may (add_type bv) rty)
+                cstrs
   | Ptype_record lbls ->
       List.iter (fun (l, mut, ty, _) -> add_type bv ty) lbls in
   add_tkind td.ptype_kind
@@ -84,24 +87,27 @@
   match cty.pcty_desc with
     Pcty_constr(l, tyl) ->
       add bv l; List.iter (add_type bv) tyl
-  | Pcty_signature (ty, fieldl) ->
+  | Pcty_signature { pcsig_self = ty; pcsig_fields = fieldl } ->
       add_type bv ty;
       List.iter (add_class_type_field bv) fieldl
   | Pcty_fun(_, ty1, cty2) ->
       add_type bv ty1; add_class_type bv cty2
 
-and add_class_type_field bv = function
+and add_class_type_field bv pctf =
+  match pctf.pctf_desc with
     Pctf_inher cty -> add_class_type bv cty
-  | Pctf_val(_, _, _, ty, _) -> add_type bv ty
-  | Pctf_virt(_, _, ty, _) -> add_type bv ty
-  | Pctf_meth(_, _, ty, _) -> add_type bv ty
-  | Pctf_cstr(ty1, ty2, _) -> add_type bv ty1; add_type bv ty2
+  | Pctf_val(_, _, _, ty) -> add_type bv ty
+  | Pctf_virt(_, _, ty) -> add_type bv ty
+  | Pctf_meth(_, _, ty) -> add_type bv ty
+  | Pctf_cstr(ty1, ty2) -> add_type bv ty1; add_type bv ty2
 
 let add_class_description bv infos =
   add_class_type bv infos.pci_expr
 
 let add_class_type_declaration = add_class_description
 
+let pattern_bv = ref StringSet.empty
+
 let rec add_pattern bv pat =
   match pat.ppat_desc with
     Ppat_any -> ()
@@ -116,14 +122,21 @@
   | Ppat_or(p1, p2) -> add_pattern bv p1; add_pattern bv p2
   | Ppat_constraint(p, ty) -> add_pattern bv p; add_type bv ty
   | Ppat_variant(_, op) -> add_opt add_pattern bv op
-  | Ppat_type (li) -> add bv li
+  | Ppat_type li -> add bv li
   | Ppat_lazy p -> add_pattern bv p
+  | Ppat_unpack id -> pattern_bv := StringSet.add id.txt !pattern_bv
+
+let add_pattern bv pat =
+  pattern_bv := bv;
+  add_pattern bv pat;
+  !pattern_bv
 
 let rec add_expr bv exp =
   match exp.pexp_desc with
     Pexp_ident l -> add bv l
   | Pexp_constant _ -> ()
-  | Pexp_let(_, pel, e) -> add_pat_expr_list bv pel; add_expr bv e
+  | Pexp_let(rf, pel, e) ->
+      let bv = add_bindings rf bv pel in add_expr bv e
   | Pexp_function (_, opte, pel) ->
       add_opt add_expr bv opte; add_pat_expr_list bv pel
   | Pexp_apply(e, el) ->
@@ -143,7 +156,7 @@
       add_expr bv e1; add_expr bv e2; add_opt add_expr bv opte3
   | Pexp_sequence(e1, e2) -> add_expr bv e1; add_expr bv e2
   | Pexp_while(e1, e2) -> add_expr bv e1; add_expr bv e2
-  | Pexp_for(_, e1, e2, _, e3) ->
+  | Pexp_for( _, e1, e2, _, e3) ->
       add_expr bv e1; add_expr bv e2; add_expr bv e3
   | Pexp_constraint(e1, oty2, oty3) ->
       add_expr bv e1;
@@ -151,36 +164,43 @@
       add_opt add_type bv oty3
   | Pexp_when(e1, e2) -> add_expr bv e1; add_expr bv e2
   | Pexp_send(e, m) -> add_expr bv e
-  | Pexp_new l -> add bv l
+  | Pexp_new li -> add bv li
   | Pexp_setinstvar(v, e) -> add_expr bv e
   | Pexp_override sel -> List.iter (fun (s, e) -> add_expr bv e) sel
   | Pexp_letmodule(id, m, e) ->
-      add_module bv m; add_expr (StringSet.add id bv) e
+      add_module bv m; add_expr (StringSet.add id.txt bv) e
   | Pexp_assert (e) -> add_expr bv e
   | Pexp_assertfalse -> ()
   | Pexp_lazy (e) -> add_expr bv e
   | Pexp_poly (e, t) -> add_expr bv e; add_opt add_type bv t
-  | Pexp_object (pat, fieldl) ->
-      add_pattern bv pat; List.iter (add_class_field bv) fieldl
+  | Pexp_object { pcstr_pat = pat; pcstr_fields = fieldl } ->
+      let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl
   | Pexp_newtype (_, e) -> add_expr bv e
-  | Pexp_pack (m, pt) -> add_package_type bv pt; add_module bv m
-  | Pexp_open (m, e) -> addmodule bv m; add_expr bv e
+  | Pexp_pack m -> add_module bv m
+  | Pexp_open (_ovf, m, e) -> addmodule bv m; add_expr bv e
+
 and add_pat_expr_list bv pel =
-  List.iter (fun (p, e) -> add_pattern bv p; add_expr bv e) pel
+  List.iter (fun (p, e) -> let bv = add_pattern bv p in add_expr bv e) pel
+
+and add_bindings recf bv pel =
+  let bv' = List.fold_left (fun bv (p, _) -> add_pattern bv p) bv pel in
+  let bv = if recf = Recursive then bv' else bv in
+  List.iter (fun (_, e) -> add_expr bv e) pel;
+  bv'
 
 and add_modtype bv mty =
   match mty.pmty_desc with
     Pmty_ident l -> add bv l
   | Pmty_signature s -> add_signature bv s
   | Pmty_functor(id, mty1, mty2) ->
-      add_modtype bv mty1; add_modtype (StringSet.add id bv) mty2
+      add_modtype bv mty1; add_modtype (StringSet.add id.txt bv) mty2
   | Pmty_with(mty, cstrl) ->
       add_modtype bv mty;
       List.iter
         (function (_, Pwith_type td) -> add_type_declaration bv td
-                | (_, Pwith_module lid) -> addmodule bv lid
+                | (_, Pwith_module (lid)) -> addmodule bv lid
                 | (_, Pwith_typesubst td) -> add_type_declaration bv td
-                | (_, Pwith_modsubst lid) -> addmodule bv lid)
+                | (_, Pwith_modsubst (lid)) -> addmodule bv lid)
         cstrl
   | Pmty_typeof m -> add_module bv m
 
@@ -197,18 +217,20 @@
   | Psig_exception(id, args) ->
       List.iter (add_type bv) args; bv
   | Psig_module(id, mty) ->
-      add_modtype bv mty; StringSet.add id bv
+      add_modtype bv mty; StringSet.add id.txt bv
   | Psig_recmodule decls ->
-      let bv' = List.fold_right StringSet.add (List.map fst decls) bv in
+      let bv' =
+         List.fold_right StringSet.add (List.map (fun (x,_) -> x.txt) decls) bv
+      in
       List.iter (fun (id, mty) -> add_modtype bv' mty) decls;
       bv'
-  | Psig_modtype(id, mtyd) ->
+  | Psig_modtype(id,mtyd) ->
       begin match mtyd with
         Pmodtype_abstract -> ()
       | Pmodtype_manifest mty -> add_modtype bv mty
       end;
       bv
-  | Psig_open lid ->
+  | Psig_open (_ovf, lid) ->
       addmodule bv lid; bv
   | Psig_include mty ->
       add_modtype bv mty; bv
@@ -223,13 +245,12 @@
   | Pmod_structure s -> ignore (add_structure bv s)
   | Pmod_functor(id, mty, modl) ->
       add_modtype bv mty;
-      add_module (StringSet.add id bv) modl
+      add_module (StringSet.add id.txt bv) modl
   | Pmod_apply(mod1, mod2) ->
       add_module bv mod1; add_module bv mod2
   | Pmod_constraint(modl, mty) ->
       add_module bv modl; add_modtype bv mty
-  | Pmod_unpack(e, pt) ->
-      add_package_type bv pt;
+  | Pmod_unpack(e) ->
       add_expr bv e
 
 and add_structure bv item_list =
@@ -239,8 +260,8 @@
   match item.pstr_desc with
     Pstr_eval e ->
       add_expr bv e; bv
-  | Pstr_value(id, pel) ->
-      add_pat_expr_list bv pel; bv
+  | Pstr_value(rf, pel) ->
+      let bv = add_bindings rf bv pel in bv
   | Pstr_primitive(id, vd) ->
       add_type bv vd.pval_type; bv
   | Pstr_type dcls ->
@@ -250,18 +271,18 @@
   | Pstr_exn_rebind(id, l) ->
       add bv l; bv
   | Pstr_module(id, modl) ->
-      add_module bv modl; StringSet.add id bv
+      add_module bv modl; StringSet.add id.txt bv
   | Pstr_recmodule bindings ->
       let bv' =
         List.fold_right StringSet.add
-          (List.map (fun (id,_,_) -> id) bindings) bv in
+          (List.map (fun (id,_,_) -> id.txt) bindings) bv in
       List.iter
         (fun (id, mty, modl) -> add_modtype bv' mty; add_module bv' modl)
         bindings;
       bv'
   | Pstr_modtype(id, mty) ->
       add_modtype bv mty; bv
-  | Pstr_open l ->
+  | Pstr_open (_ovf, l) ->
       addmodule bv l; bv
   | Pstr_class cdl ->
       List.iter (add_class_declaration bv) cdl; bv
@@ -273,6 +294,9 @@
 and add_use_file bv top_phrs =
   ignore (List.fold_left add_top_phrase bv top_phrs)
 
+and add_implementation bv l =
+  ignore (add_structure bv l)
+
 and add_top_phrase bv = function
   | Ptop_def str -> add_structure bv str
   | Ptop_dir (_, _) -> bv
@@ -281,25 +305,26 @@
   match ce.pcl_desc with
     Pcl_constr(l, tyl) ->
       add bv l; List.iter (add_type bv) tyl
-  | Pcl_structure(pat, fieldl) ->
-      add_pattern bv pat; List.iter (add_class_field bv) fieldl
+  | Pcl_structure { pcstr_pat = pat; pcstr_fields = fieldl } ->
+      let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl
   | Pcl_fun(_, opte, pat, ce) ->
-      add_opt add_expr bv opte; add_pattern bv pat; add_class_expr bv ce
+      add_opt add_expr bv opte;
+      let bv = add_pattern bv pat in add_class_expr bv ce
   | Pcl_apply(ce, exprl) ->
       add_class_expr bv ce; List.iter (fun (_,e) -> add_expr bv e) exprl
-  | Pcl_let(_, pel, ce) ->
-      add_pat_expr_list bv pel; add_class_expr bv ce
+  | Pcl_let(rf, pel, ce) ->
+      let bv = add_bindings rf bv pel in add_class_expr bv ce
   | Pcl_constraint(ce, ct) ->
       add_class_expr bv ce; add_class_type bv ct
 
-and add_class_field bv = function
+and add_class_field bv pcf =
+  match pcf.pcf_desc with
     Pcf_inher(_, ce, _) -> add_class_expr bv ce
-  | Pcf_val(_, _, _, e, _) -> add_expr bv e
-  | Pcf_valvirt(_, _, ty, _)
-  | Pcf_virt(_, _, ty, _) -> add_type bv ty
-  | Pcf_meth(_, _, _, e, _) -> add_expr bv e
-  | Pcf_cstr(ty1, ty2, _) -> add_type bv ty1; add_type bv ty2
-  | Pcf_let(_, pel, _) -> add_pat_expr_list bv pel
+  | Pcf_val(_, _, _, e) -> add_expr bv e
+  | Pcf_valvirt(_, _, ty)
+  | Pcf_virt(_, _, ty) -> add_type bv ty
+  | Pcf_meth(_, _, _, e) -> add_expr bv e
+  | Pcf_constr(ty1, ty2) -> add_type bv ty1; add_type bv ty2
   | Pcf_init e -> add_expr bv e
 
 and add_class_declaration bv decl =
diff -Nru ocaml-3.12.1/tools/depend.mli ocaml-4.01.0/tools/depend.mli
--- ocaml-3.12.1/tools/depend.mli	2002-04-18 07:27:47.000000000 +0000
+++ ocaml-4.01.0/tools/depend.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: depend.mli 4694 2002-04-18 07:27:47Z garrigue $ *)
-
 (** Module dependencies. *)
 
 module StringSet : Set.S with type elt = string
@@ -21,3 +19,5 @@
 val add_use_file : StringSet.t -> Parsetree.toplevel_phrase list -> unit
 
 val add_signature : StringSet.t -> Parsetree.signature -> unit
+
+val add_implementation : StringSet.t -> Parsetree.structure -> unit
diff -Nru ocaml-3.12.1/tools/dumpobj.ml ocaml-4.01.0/tools/dumpobj.ml
--- ocaml-3.12.1/tools/dumpobj.ml	2008-09-10 12:53:05.000000000 +0000
+++ ocaml-4.01.0/tools/dumpobj.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,22 +10,20 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: dumpobj.ml 9015 2008-09-10 12:53:05Z doligez $ *)
-
 (* Disassembler for executable and .cmo object files *)
 
 open Asttypes
 open Config
-open Emitcode
 open Instruct
 open Lambda
 open Location
-open Obj
 open Opcodes
 open Opnames
 open Cmo_format
 open Printf
 
+let print_locations = ref true
+
 (* Read signed and unsigned integers *)
 
 let inputu ic =
@@ -399,11 +397,12 @@
 ];;
 
 let print_event ev =
-  let ls = ev.ev_loc.loc_start in
-  let le = ev.ev_loc.loc_end in
-  printf "File \"%s\", line %d, characters %d-%d:\n" ls.Lexing.pos_fname
-         ls.Lexing.pos_lnum (ls.Lexing.pos_cnum - ls.Lexing.pos_bol)
-         (le.Lexing.pos_cnum - ls.Lexing.pos_bol)
+  if !print_locations then
+    let ls = ev.ev_loc.loc_start in
+    let le = ev.ev_loc.loc_end in
+    printf "File \"%s\", line %d, characters %d-%d:\n" ls.Lexing.pos_fname
+      ls.Lexing.pos_lnum (ls.Lexing.pos_cnum - ls.Lexing.pos_bol)
+      (le.Lexing.pos_cnum - ls.Lexing.pos_bol)
 
 let print_instr ic =
   let pos = currpos ic in
@@ -449,7 +448,7 @@
         let nvars = inputu ic in
         let orig = currpc ic in
         print_int nvars;
-        for i = 0 to nfuncs - 1 do
+        for _i = 0 to nfuncs - 1 do
           print_string ", ";
           print_int (orig + inputs ic);
         done;
@@ -483,8 +482,7 @@
 (* Print a .cmo file *)
 
 let dump_obj filename ic =
-  let buffer = String.create (String.length cmo_magic_number) in
-  really_input ic buffer 0 (String.length cmo_magic_number);
+  let buffer = Misc.input_bytes ic (String.length cmo_magic_number) in
   if buffer <> cmo_magic_number then begin
     prerr_endline "Not an object file"; exit 2
   end;
@@ -503,8 +501,7 @@
 (* Read the primitive table from an executable *)
 
 let read_primitive_table ic len =
-  let p = String.create len in
-  really_input ic p 0 len;
+  let p = Misc.input_bytes ic len in
   let rec split beg cur =
     if cur >= len then []
     else if p.[cur] = '\000' then
@@ -531,7 +528,7 @@
   begin try
     ignore (Bytesections.seek_section ic "DBUG");
     let num_eventlists = input_binary_int ic in
-    for i = 1 to num_eventlists do
+    for _i = 1 to num_eventlists do
       let orig = input_binary_int ic in
       let evl = (input_value ic : debug_event list) in
       record_events orig evl
@@ -541,20 +538,30 @@
   let code_size = Bytesections.seek_section ic "CODE" in
   print_code ic code_size
 
-let main() =
-  for i = 1 to Array.length Sys.argv - 1 do
-    let filnam = Sys.argv.(i) in
-    let ic = open_in_bin filnam in
-    if i>1 then print_newline ();
-    printf "## start of ocaml dump of %S\n%!" filnam;
-    begin try
-      objfile := false; dump_exe ic
+let arg_list = [
+  "-noloc", Arg.Clear print_locations, " : don't print source information";
+]
+let arg_usage =
+  Printf.sprintf "%s [OPTIONS] FILES : dump content of bytecode files"
+                 Sys.argv.(0)
+
+let first_file = ref true
+
+let arg_fun filename =
+  let ic = open_in_bin filename in
+  if not !first_file then print_newline ();
+  first_file := false;
+  printf "## start of ocaml dump of %S\n%!" filename;
+  begin try
+          objfile := false; dump_exe ic
     with Bytesections.Bad_magic_number ->
-      objfile := true; seek_in ic 0; dump_obj (Sys.argv.(i)) ic
-    end;
-    close_in ic;
-    printf "## end of ocaml dump of %S\n%!" filnam;
-  done;
-  exit 0
+      objfile := true; seek_in ic 0; dump_obj filename ic
+  end;
+  close_in ic;
+  printf "## end of ocaml dump of %S\n%!" filename
+
+let main() =
+  Arg.parse arg_list arg_fun arg_usage;
+    exit 0
 
 let _ = main ()
diff -Nru ocaml-3.12.1/tools/eqparsetree.ml ocaml-4.01.0/tools/eqparsetree.ml
--- ocaml-3.12.1/tools/eqparsetree.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/tools/eqparsetree.ml	2013-07-23 14:48:47.000000000 +0000
@@ -0,0 +1,779 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                OCaml                                   *)
+(*                                                                        *)
+(*    Hongbo Zhang (University of Pennsylvania)                           *)
+(*                                                                        *)
+(*   Copyright 2007 Institut National de Recherche en Informatique et     *)
+(*   en Automatique.  All rights reserved.  This file is distributed      *)
+(*   under the terms of the Q Public License version 1.0.                 *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(*
+  This module is mainly used to diff two parsetree, it helps to automate the
+  test for parsing/pprintast.ml
+ *)
+
+
+open Parsetree
+let curry f (g, h) = f g h
+let eq_int : (int*int)->bool = curry (=)
+let eq_char : (char*char)->bool=curry (=)
+let eq_string : (string*string)->bool = curry (=)
+let eq_int32 : (int32*int32)->bool=curry (=)
+let eq_int64 : (int64*int64)->bool =curry (=)
+let eq_nativeint : (nativeint*nativeint)->bool= curry (=)
+let eq_bool :(bool*bool) -> bool = curry (=)
+let eq_list mf_a (xs, ys) =
+  let rec loop =
+    function
+      | ([], []) -> true
+        | (x :: xs, y :: ys) -> (mf_a (x, y)) && (loop (xs, ys))
+        | (_, _) -> false
+  in loop (xs, ys)
+let eq_option mf_a (x, y) =
+  match (x, y) with
+  | (None, None) -> true
+  | (Some x, Some y) -> mf_a (x, y)
+  | (_, _) -> false
+
+module Location =struct
+  include Location
+  let eq_t : (t*t) -> bool = fun (_,_) -> true
+end
+module Longident = struct
+  include Longident
+  let rec eq_t : (t * t) -> 'result =
+    function
+    | (Lident a0, Lident b0) -> eq_string (a0, b0)
+    | (Ldot (a0, a1), Ldot (b0, b1)) ->
+      (eq_t (a0, b0)) && (eq_string (a1, b1))
+    | (Lapply (a0, a1), Lapply (b0, b1)) ->
+      (eq_t (a0, b0)) && (eq_t (a1, b1))
+    | (_, _) -> false
+end
+module Asttypes = struct
+  open Asttypes
+  let eq_constant : (constant * constant) -> 'result =
+    function
+    | (Const_int a0, Const_int b0) -> eq_int (a0, b0)
+    | (Const_char a0, Const_char b0) -> eq_char (a0, b0)
+    | (Const_string a0, Const_string b0) -> eq_string (a0, b0)
+    | (Const_float a0, Const_float b0) -> eq_string (a0, b0)
+    | (Const_int32 a0, Const_int32 b0) -> eq_int32 (a0, b0)
+    | (Const_int64 a0, Const_int64 b0) -> eq_int64 (a0, b0)
+    | (Const_nativeint a0, Const_nativeint b0) -> eq_nativeint (a0, b0)
+    | (_, _) -> false
+
+  let eq_rec_flag : (rec_flag * rec_flag) -> 'result =
+    function
+    | (Nonrecursive, Nonrecursive) -> true
+    | (Recursive, Recursive) -> true
+    | (Default, Default) -> true
+    | (_, _) -> false
+
+  let eq_direction_flag :
+    (direction_flag * direction_flag) -> 'result =
+    function
+    | (Upto, Upto) -> true
+    | (Downto, Downto) -> true
+    | (_, _) -> false
+
+  let eq_private_flag : (private_flag * private_flag) -> 'result =
+    function
+    | (Private, Private) -> true
+    | (Public, Public) -> true
+    | (_, _) -> false
+
+  let eq_mutable_flag : (mutable_flag * mutable_flag) -> 'result =
+    function
+    | (Immutable, Immutable) -> true
+    | (Mutable, Mutable) -> true
+    | (_, _) -> false
+
+  let eq_virtual_flag : (virtual_flag * virtual_flag) -> 'result =
+    function
+    | (Virtual, Virtual) -> true
+    | (Concrete, Concrete) -> true
+    | (_, _) -> false
+
+  let eq_override_flag : (override_flag * override_flag) -> 'result =
+    function
+    | (Override, Override) -> true
+    | (Fresh, Fresh) -> true
+    | (_, _) -> false
+
+  let eq_closed_flag : (closed_flag * closed_flag) -> 'result =
+    function
+    | (Closed, Closed) -> true
+    | (Open, Open) -> true
+    | (_, _) -> false
+
+  let eq_label : (label * label) -> 'result =
+    fun (a0, a1) -> eq_string (a0, a1)
+
+  let  eq_loc :
+    'all_a0.
+      (('all_a0 * 'all_a0) -> 'result) ->
+        (('all_a0 loc) * ('all_a0 loc)) -> 'result =
+    fun mf_a ({ txt = a0; loc = a1 }, { txt = b0; loc = b1 }) ->
+      (mf_a (a0, b0)) && (Location.eq_t (a1, b1))
+    
+end
+
+let rec eq_row_field : (row_field * row_field) -> 'result =
+  function
+  | (Rtag (a0, a1, a2), Rtag (b0, b1, b2)) ->
+      ((Asttypes.eq_label (a0, b0)) && (eq_bool (a1, b1))) &&
+        (eq_list eq_core_type (a2, b2))
+  | (Rinherit a0, Rinherit b0) -> eq_core_type (a0, b0)
+  | (_, _) -> false
+and eq_core_field_desc :
+  (core_field_desc * core_field_desc) -> 'result =
+  function
+  | (Pfield (a0, a1), Pfield (b0, b1)) ->
+      (eq_string (a0, b0)) && (eq_core_type (a1, b1))
+  | (Pfield_var, Pfield_var) -> true
+  | (_, _) -> false
+and eq_core_field_type :
+  (core_field_type * core_field_type) -> 'result =
+  fun
+    ({ pfield_desc = a0; pfield_loc = a1 },
+     { pfield_desc = b0; pfield_loc = b1 })
+    -> (eq_core_field_desc (a0, b0)) && (Location.eq_t (a1, b1))
+and eq_package_type : (package_type * package_type) -> 'result =
+  fun (a0, a1) ->
+    (fun ((a0, a1), (b0, b1)) ->
+       (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+         (eq_list
+            (fun ((a0, a1), (b0, b1)) ->
+               (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+                 (eq_core_type (a1, b1)))
+            (a1, b1)))
+      (a0, a1)
+and eq_core_type_desc :
+  (core_type_desc * core_type_desc) -> 'result =
+  function
+  | (Ptyp_any, Ptyp_any) -> true
+  | (Ptyp_var a0, Ptyp_var b0) -> eq_string (a0, b0)
+  | (Ptyp_arrow (a0, a1, a2), Ptyp_arrow (b0, b1, b2)) ->
+      ((Asttypes.eq_label (a0, b0)) && (eq_core_type (a1, b1))) &&
+        (eq_core_type (a2, b2))
+  | (Ptyp_tuple a0, Ptyp_tuple b0) -> eq_list eq_core_type (a0, b0)
+  | (Ptyp_constr (a0, a1), Ptyp_constr (b0, b1)) ->
+      (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+        (eq_list eq_core_type (a1, b1))
+  | (Ptyp_object a0, Ptyp_object b0) ->
+      eq_list eq_core_field_type (a0, b0)
+  | (Ptyp_class (a0, a1, a2), Ptyp_class (b0, b1, b2)) ->
+      ((Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+         (eq_list eq_core_type (a1, b1)))
+        && (eq_list Asttypes.eq_label (a2, b2))
+  | (Ptyp_alias (a0, a1), Ptyp_alias (b0, b1)) ->
+      (eq_core_type (a0, b0)) && (eq_string (a1, b1))
+  | (Ptyp_variant (a0, a1, a2), Ptyp_variant (b0, b1, b2)) ->
+      ((eq_list eq_row_field (a0, b0)) && (eq_bool (a1, b1))) &&
+        (eq_option (eq_list Asttypes.eq_label) (a2, b2))
+  | (Ptyp_poly (a0, a1), Ptyp_poly (b0, b1)) ->
+      (eq_list eq_string (a0, b0)) && (eq_core_type (a1, b1))
+  | (Ptyp_package a0, Ptyp_package b0) -> eq_package_type (a0, b0)
+  | (_, _) -> false
+and eq_core_type : (core_type * core_type) -> 'result =
+  fun
+    ({ ptyp_desc = a0; ptyp_loc = a1 },
+     { ptyp_desc = b0; ptyp_loc = b1 })
+    -> (eq_core_type_desc (a0, b0)) && (Location.eq_t (a1, b1))
+  
+let eq_class_infos :
+  'all_a0.
+    (('all_a0 * 'all_a0) -> 'result) ->
+      (('all_a0 class_infos) * ('all_a0 class_infos)) -> 'result =
+  fun mf_a
+    ({
+       pci_virt = a0;
+       pci_params = a1;
+       pci_name = a2;
+       pci_expr = a3;
+       pci_variance = a4;
+       pci_loc = a5
+     },
+     {
+       pci_virt = b0;
+       pci_params = b1;
+       pci_name = b2;
+       pci_expr = b3;
+       pci_variance = b4;
+       pci_loc = b5
+     })
+    ->
+    (((((Asttypes.eq_virtual_flag (a0, b0)) &&
+          ((fun ((a0, a1), (b0, b1)) ->
+              (eq_list (Asttypes.eq_loc eq_string) (a0, b0)) &&
+                (Location.eq_t (a1, b1)))
+             (a1, b1)))
+         && (Asttypes.eq_loc eq_string (a2, b2)))
+        && (mf_a (a3, b3)))
+       &&
+       (eq_list
+          (fun ((a0, a1), (b0, b1)) ->
+             (eq_bool (a0, b0)) && (eq_bool (a1, b1)))
+          (a4, b4)))
+      && (Location.eq_t (a5, b5))
+  
+let rec eq_pattern_desc : (pattern_desc * pattern_desc) -> 'result =
+  function
+  | (Ppat_any, Ppat_any) -> true
+  | (Ppat_var a0, Ppat_var b0) -> Asttypes.eq_loc eq_string (a0, b0)
+  | (Ppat_alias (a0, a1), Ppat_alias (b0, b1)) ->
+      (eq_pattern (a0, b0)) && (Asttypes.eq_loc eq_string (a1, b1))
+  | (Ppat_constant a0, Ppat_constant b0) ->
+      Asttypes.eq_constant (a0, b0)
+  | (Ppat_tuple a0, Ppat_tuple b0) -> eq_list eq_pattern (a0, b0)
+  | (Ppat_construct (a0, a1, a2), Ppat_construct (b0, b1, b2)) ->
+      ((Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+         (eq_option eq_pattern (a1, b1)))
+        && (eq_bool (a2, b2))
+  | (Ppat_variant (a0, a1), Ppat_variant (b0, b1)) ->
+      (Asttypes.eq_label (a0, b0)) && (eq_option eq_pattern (a1, b1))
+  | (Ppat_record (a0, a1), Ppat_record (b0, b1)) ->
+      (eq_list
+         (fun ((a0, a1), (b0, b1)) ->
+            (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+              (eq_pattern (a1, b1)))
+         (a0, b0))
+        && (Asttypes.eq_closed_flag (a1, b1))
+  | (Ppat_array a0, Ppat_array b0) -> eq_list eq_pattern (a0, b0)
+  | (Ppat_or (a0, a1), Ppat_or (b0, b1)) ->
+      (eq_pattern (a0, b0)) && (eq_pattern (a1, b1))
+  | (Ppat_constraint (a0, a1), Ppat_constraint (b0, b1)) ->
+      (eq_pattern (a0, b0)) && (eq_core_type (a1, b1))
+  | (Ppat_type a0, Ppat_type b0) ->
+      Asttypes.eq_loc Longident.eq_t (a0, b0)
+  | (Ppat_lazy a0, Ppat_lazy b0) -> eq_pattern (a0, b0)
+  | (Ppat_unpack a0, Ppat_unpack b0) ->
+      Asttypes.eq_loc eq_string (a0, b0)
+  | (_, _) -> false
+and eq_pattern : (pattern * pattern) -> 'result =
+  fun
+    ({ ppat_desc = a0; ppat_loc = a1 },
+     { ppat_desc = b0; ppat_loc = b1 })
+    -> (eq_pattern_desc (a0, b0)) && (Location.eq_t (a1, b1))
+  
+let rec eq_structure_item_desc :
+  (structure_item_desc * structure_item_desc) -> 'result =
+  function
+  | (Pstr_eval a0, Pstr_eval b0) -> eq_expression (a0, b0)
+  | (Pstr_value (a0, a1), Pstr_value (b0, b1)) ->
+      (Asttypes.eq_rec_flag (a0, b0)) &&
+        (eq_list
+           (fun ((a0, a1), (b0, b1)) ->
+              (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
+           (a1, b1))
+  | (Pstr_primitive (a0, a1), Pstr_primitive (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (eq_value_description (a1, b1))
+  | (Pstr_type a0, Pstr_type b0) ->
+      eq_list
+        (fun ((a0, a1), (b0, b1)) ->
+           (Asttypes.eq_loc eq_string (a0, b0)) &&
+             (eq_type_declaration (a1, b1)))
+        (a0, b0)
+  | (Pstr_exception (a0, a1), Pstr_exception (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (eq_exception_declaration (a1, b1))
+  | (Pstr_exn_rebind (a0, a1), Pstr_exn_rebind (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (Asttypes.eq_loc Longident.eq_t (a1, b1))
+  | (Pstr_module (a0, a1), Pstr_module (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (eq_module_expr (a1, b1))
+  | (Pstr_recmodule a0, Pstr_recmodule b0) ->
+      eq_list
+        (fun ((a0, a1, a2), (b0, b1, b2)) ->
+           ((Asttypes.eq_loc eq_string (a0, b0)) &&
+              (eq_module_type (a1, b1)))
+             && (eq_module_expr (a2, b2)))
+        (a0, b0)
+  | (Pstr_modtype (a0, a1), Pstr_modtype (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (eq_module_type (a1, b1))
+  | (Pstr_open a0, Pstr_open b0) ->
+      Asttypes.eq_loc Longident.eq_t (a0, b0)
+  | (Pstr_class a0, Pstr_class b0) ->
+      eq_list eq_class_declaration (a0, b0)
+  | (Pstr_class_type a0, Pstr_class_type b0) ->
+      eq_list eq_class_type_declaration (a0, b0)
+  | (Pstr_include a0, Pstr_include b0) -> eq_module_expr (a0, b0)
+  | (_, _) -> false
+and eq_structure_item :
+  (structure_item * structure_item) -> 'result =
+  fun
+    ({ pstr_desc = a0; pstr_loc = a1 },
+     { pstr_desc = b0; pstr_loc = b1 })
+    -> (eq_structure_item_desc (a0, b0)) && (Location.eq_t (a1, b1))
+and eq_structure : (structure * structure) -> 'result =
+  fun (a0, a1) -> eq_list eq_structure_item (a0, a1)
+and eq_module_expr_desc :
+  (module_expr_desc * module_expr_desc) -> 'result =
+  function
+  | (Pmod_ident a0, Pmod_ident b0) ->
+      Asttypes.eq_loc Longident.eq_t (a0, b0)
+  | (Pmod_structure a0, Pmod_structure b0) -> eq_structure (a0, b0)
+  | (Pmod_functor (a0, a1, a2), Pmod_functor (b0, b1, b2)) ->
+      ((Asttypes.eq_loc eq_string (a0, b0)) &&
+         (eq_module_type (a1, b1)))
+        && (eq_module_expr (a2, b2))
+  | (Pmod_apply (a0, a1), Pmod_apply (b0, b1)) ->
+      (eq_module_expr (a0, b0)) && (eq_module_expr (a1, b1))
+  | (Pmod_constraint (a0, a1), Pmod_constraint (b0, b1)) ->
+      (eq_module_expr (a0, b0)) && (eq_module_type (a1, b1))
+  | (Pmod_unpack a0, Pmod_unpack b0) -> eq_expression (a0, b0)
+  | (_, _) -> false
+and eq_module_expr : (module_expr * module_expr) -> 'result =
+  fun
+    ({ pmod_desc = a0; pmod_loc = a1 },
+     { pmod_desc = b0; pmod_loc = b1 })
+    -> (eq_module_expr_desc (a0, b0)) && (Location.eq_t (a1, b1))
+and eq_with_constraint :
+  (with_constraint * with_constraint) -> 'result =
+  function
+  | (Pwith_type a0, Pwith_type b0) -> eq_type_declaration (a0, b0)
+  | (Pwith_module a0, Pwith_module b0) ->
+      Asttypes.eq_loc Longident.eq_t (a0, b0)
+  | (Pwith_typesubst a0, Pwith_typesubst b0) ->
+      eq_type_declaration (a0, b0)
+  | (Pwith_modsubst a0, Pwith_modsubst b0) ->
+      Asttypes.eq_loc Longident.eq_t (a0, b0)
+  | (_, _) -> false
+and eq_modtype_declaration :
+  (modtype_declaration * modtype_declaration) -> 'result =
+  function
+  | (Pmodtype_abstract, Pmodtype_abstract) -> true
+  | (Pmodtype_manifest a0, Pmodtype_manifest b0) ->
+      eq_module_type (a0, b0)
+  | (_, _) -> false
+and eq_signature_item_desc :
+  (signature_item_desc * signature_item_desc) -> 'result =
+  function
+  | (Psig_value (a0, a1), Psig_value (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (eq_value_description (a1, b1))
+  | (Psig_type a0, Psig_type b0) ->
+      eq_list
+        (fun ((a0, a1), (b0, b1)) ->
+           (Asttypes.eq_loc eq_string (a0, b0)) &&
+             (eq_type_declaration (a1, b1)))
+        (a0, b0)
+  | (Psig_exception (a0, a1), Psig_exception (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (eq_exception_declaration (a1, b1))
+  | (Psig_module (a0, a1), Psig_module (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (eq_module_type (a1, b1))
+  | (Psig_recmodule a0, Psig_recmodule b0) ->
+      eq_list
+        (fun ((a0, a1), (b0, b1)) ->
+           (Asttypes.eq_loc eq_string (a0, b0)) &&
+             (eq_module_type (a1, b1)))
+        (a0, b0)
+  | (Psig_modtype (a0, a1), Psig_modtype (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (eq_modtype_declaration (a1, b1))
+  | (Psig_open a0, Psig_open b0) ->
+      Asttypes.eq_loc Longident.eq_t (a0, b0)
+  | (Psig_include a0, Psig_include b0) -> eq_module_type (a0, b0)
+  | (Psig_class a0, Psig_class b0) ->
+      eq_list eq_class_description (a0, b0)
+  | (Psig_class_type a0, Psig_class_type b0) ->
+      eq_list eq_class_type_declaration (a0, b0)
+  | (_, _) -> false
+and eq_signature_item :
+  (signature_item * signature_item) -> 'result =
+  fun
+    ({ psig_desc = a0; psig_loc = a1 },
+     { psig_desc = b0; psig_loc = b1 })
+    -> (eq_signature_item_desc (a0, b0)) && (Location.eq_t (a1, b1))
+and eq_signature : (signature * signature) -> 'result =
+  fun (a0, a1) -> eq_list eq_signature_item (a0, a1)
+and eq_module_type_desc :
+  (module_type_desc * module_type_desc) -> 'result =
+  function
+  | (Pmty_ident a0, Pmty_ident b0) ->
+      Asttypes.eq_loc Longident.eq_t (a0, b0)
+  | (Pmty_signature a0, Pmty_signature b0) -> eq_signature (a0, b0)
+  | (Pmty_functor (a0, a1, a2), Pmty_functor (b0, b1, b2)) ->
+      ((Asttypes.eq_loc eq_string (a0, b0)) &&
+         (eq_module_type (a1, b1)))
+        && (eq_module_type (a2, b2))
+  | (Pmty_with (a0, a1), Pmty_with (b0, b1)) ->
+      (eq_module_type (a0, b0)) &&
+        (eq_list
+           (fun ((a0, a1), (b0, b1)) ->
+              (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+                (eq_with_constraint (a1, b1)))
+           (a1, b1))
+  | (Pmty_typeof a0, Pmty_typeof b0) -> eq_module_expr (a0, b0)
+  | (_, _) -> false
+and eq_module_type : (module_type * module_type) -> 'result =
+  fun
+    ({ pmty_desc = a0; pmty_loc = a1 },
+     { pmty_desc = b0; pmty_loc = b1 })
+    -> (eq_module_type_desc (a0, b0)) && (Location.eq_t (a1, b1))
+and eq_class_declaration :
+  (class_declaration * class_declaration) -> 'result =
+  fun (a0, a1) -> eq_class_infos eq_class_expr (a0, a1)
+and eq_class_field_desc :
+  (class_field_desc * class_field_desc) -> 'result =
+  function
+  | (Pcf_inher (a0, a1, a2), Pcf_inher (b0, b1, b2)) ->
+      ((Asttypes.eq_override_flag (a0, b0)) &&
+         (eq_class_expr (a1, b1)))
+        && (eq_option eq_string (a2, b2))
+  | (Pcf_valvirt a0, Pcf_valvirt b0) ->
+      (fun ((a0, a1, a2), (b0, b1, b2)) ->
+         ((Asttypes.eq_loc eq_string (a0, b0)) &&
+            (Asttypes.eq_mutable_flag (a1, b1)))
+           && (eq_core_type (a2, b2)))
+        (a0, b0)
+  | (Pcf_val a0, Pcf_val b0) ->
+      (fun ((a0, a1, a2, a3), (b0, b1, b2, b3)) ->
+         (((Asttypes.eq_loc eq_string (a0, b0)) &&
+             (Asttypes.eq_mutable_flag (a1, b1)))
+            && (Asttypes.eq_override_flag (a2, b2)))
+           && (eq_expression (a3, b3)))
+        (a0, b0)
+  | (Pcf_virt a0, Pcf_virt b0) ->
+      (fun ((a0, a1, a2), (b0, b1, b2)) ->
+         ((Asttypes.eq_loc eq_string (a0, b0)) &&
+            (Asttypes.eq_private_flag (a1, b1)))
+           && (eq_core_type (a2, b2)))
+        (a0, b0)
+  | (Pcf_meth a0, Pcf_meth b0) ->
+      (fun ((a0, a1, a2, a3), (b0, b1, b2, b3)) ->
+         (((Asttypes.eq_loc eq_string (a0, b0)) &&
+             (Asttypes.eq_private_flag (a1, b1)))
+            && (Asttypes.eq_override_flag (a2, b2)))
+           && (eq_expression (a3, b3)))
+        (a0, b0)
+  | (Pcf_constr a0, Pcf_constr b0) ->
+      (fun ((a0, a1), (b0, b1)) ->
+         (eq_core_type (a0, b0)) && (eq_core_type (a1, b1)))
+        (a0, b0)
+  | (Pcf_init a0, Pcf_init b0) -> eq_expression (a0, b0)
+  | (_, _) -> false
+and eq_class_field : (class_field * class_field) -> 'result =
+  fun
+    ({ pcf_desc = a0; pcf_loc = a1 }, { pcf_desc = b0; pcf_loc = b1
+     })
+    -> (eq_class_field_desc (a0, b0)) && (Location.eq_t (a1, b1))
+and eq_class_structure :
+  (class_structure * class_structure) -> 'result =
+  fun
+    ({ pcstr_pat = a0; pcstr_fields = a1 },
+     { pcstr_pat = b0; pcstr_fields = b1 })
+    -> (eq_pattern (a0, b0)) && (eq_list eq_class_field (a1, b1))
+and eq_class_expr_desc :
+  (class_expr_desc * class_expr_desc) -> 'result =
+  function
+  | (Pcl_constr (a0, a1), Pcl_constr (b0, b1)) ->
+      (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+        (eq_list eq_core_type (a1, b1))
+  | (Pcl_structure a0, Pcl_structure b0) ->
+      eq_class_structure (a0, b0)
+  | (Pcl_fun (a0, a1, a2, a3), Pcl_fun (b0, b1, b2, b3)) ->
+      (((Asttypes.eq_label (a0, b0)) &&
+          (eq_option eq_expression (a1, b1)))
+         && (eq_pattern (a2, b2)))
+        && (eq_class_expr (a3, b3))
+  | (Pcl_apply (a0, a1), Pcl_apply (b0, b1)) ->
+      (eq_class_expr (a0, b0)) &&
+        (eq_list
+           (fun ((a0, a1), (b0, b1)) ->
+              (Asttypes.eq_label (a0, b0)) &&
+                (eq_expression (a1, b1)))
+           (a1, b1))
+  | (Pcl_let (a0, a1, a2), Pcl_let (b0, b1, b2)) ->
+      ((Asttypes.eq_rec_flag (a0, b0)) &&
+         (eq_list
+            (fun ((a0, a1), (b0, b1)) ->
+               (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
+            (a1, b1)))
+        && (eq_class_expr (a2, b2))
+  | (Pcl_constraint (a0, a1), Pcl_constraint (b0, b1)) ->
+      (eq_class_expr (a0, b0)) && (eq_class_type (a1, b1))
+  | (_, _) -> false
+and eq_class_expr : (class_expr * class_expr) -> 'result =
+  fun
+    ({ pcl_desc = a0; pcl_loc = a1 }, { pcl_desc = b0; pcl_loc = b1
+     })
+    -> (eq_class_expr_desc (a0, b0)) && (Location.eq_t (a1, b1))
+and eq_class_type_declaration :
+  (class_type_declaration * class_type_declaration) -> 'result =
+  fun (a0, a1) -> eq_class_infos eq_class_type (a0, a1)
+and eq_class_description :
+  (class_description * class_description) -> 'result =
+  fun (a0, a1) -> eq_class_infos eq_class_type (a0, a1)
+and eq_class_type_field_desc :
+  (class_type_field_desc * class_type_field_desc) -> 'result =
+  function
+  | (Pctf_inher a0, Pctf_inher b0) -> eq_class_type (a0, b0)
+  | (Pctf_val a0, Pctf_val b0) ->
+      (fun ((a0, a1, a2, a3), (b0, b1, b2, b3)) ->
+         (((eq_string (a0, b0)) &&
+             (Asttypes.eq_mutable_flag (a1, b1)))
+            && (Asttypes.eq_virtual_flag (a2, b2)))
+           && (eq_core_type (a3, b3)))
+        (a0, b0)
+  | (Pctf_virt a0, Pctf_virt b0) ->
+      (fun ((a0, a1, a2), (b0, b1, b2)) ->
+         ((eq_string (a0, b0)) && (Asttypes.eq_private_flag (a1, b1)))
+           && (eq_core_type (a2, b2)))
+        (a0, b0)
+  | (Pctf_meth a0, Pctf_meth b0) ->
+      (fun ((a0, a1, a2), (b0, b1, b2)) ->
+         ((eq_string (a0, b0)) && (Asttypes.eq_private_flag (a1, b1)))
+           && (eq_core_type (a2, b2)))
+        (a0, b0)
+  | (Pctf_cstr a0, Pctf_cstr b0) ->
+      (fun ((a0, a1), (b0, b1)) ->
+         (eq_core_type (a0, b0)) && (eq_core_type (a1, b1)))
+        (a0, b0)
+  | (_, _) -> false
+and eq_class_type_field :
+  (class_type_field * class_type_field) -> 'result =
+  fun
+    ({ pctf_desc = a0; pctf_loc = a1 },
+     { pctf_desc = b0; pctf_loc = b1 })
+    ->
+    (eq_class_type_field_desc (a0, b0)) && (Location.eq_t (a1, b1))
+and eq_class_signature :
+  (class_signature * class_signature) -> 'result =
+  fun
+    ({ pcsig_self = a0; pcsig_fields = a1; pcsig_loc = a2 },
+     { pcsig_self = b0; pcsig_fields = b1; pcsig_loc = b2 })
+    ->
+    ((eq_core_type (a0, b0)) &&
+       (eq_list eq_class_type_field (a1, b1)))
+      && (Location.eq_t (a2, b2))
+and eq_class_type_desc :
+  (class_type_desc * class_type_desc) -> 'result =
+  function
+  | (Pcty_constr (a0, a1), Pcty_constr (b0, b1)) ->
+      (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+        (eq_list eq_core_type (a1, b1))
+  | (Pcty_signature a0, Pcty_signature b0) ->
+      eq_class_signature (a0, b0)
+  | (Pcty_fun (a0, a1, a2), Pcty_fun (b0, b1, b2)) ->
+      ((Asttypes.eq_label (a0, b0)) && (eq_core_type (a1, b1))) &&
+        (eq_class_type (a2, b2))
+  | (_, _) -> false
+and eq_class_type : (class_type * class_type) -> 'result =
+  fun
+    ({ pcty_desc = a0; pcty_loc = a1 },
+     { pcty_desc = b0; pcty_loc = b1 })
+    -> (eq_class_type_desc (a0, b0)) && (Location.eq_t (a1, b1))
+and eq_exception_declaration :
+  (exception_declaration * exception_declaration) -> 'result =
+  fun (a0, a1) -> eq_list eq_core_type (a0, a1)
+and eq_type_kind : (type_kind * type_kind) -> 'result =
+  function
+  | (Ptype_abstract, Ptype_abstract) -> true
+  | (Ptype_variant a0, Ptype_variant b0) ->
+      eq_list
+        (fun ((a0, a1, a2, a3), (b0, b1, b2, b3)) ->
+           (((Asttypes.eq_loc eq_string (a0, b0)) &&
+               (eq_list eq_core_type (a1, b1)))
+              && (eq_option eq_core_type (a2, b2)))
+             && (Location.eq_t (a3, b3)))
+        (a0, b0)
+  | (Ptype_record a0, Ptype_record b0) ->
+      eq_list
+        (fun ((a0, a1, a2, a3), (b0, b1, b2, b3)) ->
+           (((Asttypes.eq_loc eq_string (a0, b0)) &&
+               (Asttypes.eq_mutable_flag (a1, b1)))
+              && (eq_core_type (a2, b2)))
+             && (Location.eq_t (a3, b3)))
+        (a0, b0)
+  | (_, _) -> false
+and eq_type_declaration :
+  (type_declaration * type_declaration) -> 'result =
+  fun
+    ({
+       ptype_params = a0;
+       ptype_cstrs = a1;
+       ptype_kind = a2;
+       ptype_private = a3;
+       ptype_manifest = a4;
+       ptype_variance = a5;
+       ptype_loc = a6
+     },
+     {
+       ptype_params = b0;
+       ptype_cstrs = b1;
+       ptype_kind = b2;
+       ptype_private = b3;
+       ptype_manifest = b4;
+       ptype_variance = b5;
+       ptype_loc = b6
+     })
+    ->
+    ((((((eq_list (eq_option (Asttypes.eq_loc eq_string)) (a0, b0))
+           &&
+           (eq_list
+              (fun ((a0, a1, a2), (b0, b1, b2)) ->
+                 ((eq_core_type (a0, b0)) && (eq_core_type (a1, b1)))
+                   && (Location.eq_t (a2, b2)))
+              (a1, b1)))
+          && (eq_type_kind (a2, b2)))
+         && (Asttypes.eq_private_flag (a3, b3)))
+        && (eq_option eq_core_type (a4, b4)))
+       &&
+       (eq_list
+          (fun ((a0, a1), (b0, b1)) ->
+             (eq_bool (a0, b0)) && (eq_bool (a1, b1)))
+          (a5, b5)))
+      && (Location.eq_t (a6, b6))
+and eq_value_description :
+  (value_description * value_description) -> 'result =
+  fun
+    ({ pval_type = a0; pval_prim = a1; pval_loc = a2 },
+     { pval_type = b0; pval_prim = b1; pval_loc = b2 })
+    ->
+    ((eq_core_type (a0, b0)) && (eq_list eq_string (a1, b1))) &&
+      (Location.eq_t (a2, b2))
+and eq_expression_desc :
+  (expression_desc * expression_desc) -> 'result =
+  function
+  | (Pexp_ident a0, Pexp_ident b0) ->
+      Asttypes.eq_loc Longident.eq_t (a0, b0)
+  | (Pexp_constant a0, Pexp_constant b0) ->
+      Asttypes.eq_constant (a0, b0)
+  | (Pexp_let (a0, a1, a2), Pexp_let (b0, b1, b2)) ->
+      ((Asttypes.eq_rec_flag (a0, b0)) &&
+         (eq_list
+            (fun ((a0, a1), (b0, b1)) ->
+               (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
+            (a1, b1)))
+        && (eq_expression (a2, b2))
+  | (Pexp_function (a0, a1, a2), Pexp_function (b0, b1, b2)) ->
+      ((Asttypes.eq_label (a0, b0)) &&
+         (eq_option eq_expression (a1, b1)))
+        &&
+        (eq_list
+           (fun ((a0, a1), (b0, b1)) ->
+              (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
+           (a2, b2))
+  | (Pexp_apply (a0, a1), Pexp_apply (b0, b1)) ->
+      (eq_expression (a0, b0)) &&
+        (eq_list
+           (fun ((a0, a1), (b0, b1)) ->
+              (Asttypes.eq_label (a0, b0)) &&
+                (eq_expression (a1, b1)))
+           (a1, b1))
+  | (Pexp_match (a0, a1), Pexp_match (b0, b1)) ->
+      (eq_expression (a0, b0)) &&
+        (eq_list
+           (fun ((a0, a1), (b0, b1)) ->
+              (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
+           (a1, b1))
+  | (Pexp_try (a0, a1), Pexp_try (b0, b1)) ->
+      (eq_expression (a0, b0)) &&
+        (eq_list
+           (fun ((a0, a1), (b0, b1)) ->
+              (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
+           (a1, b1))
+  | (Pexp_tuple a0, Pexp_tuple b0) -> eq_list eq_expression (a0, b0)
+  | (Pexp_construct (a0, a1, a2), Pexp_construct (b0, b1, b2)) ->
+      ((Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+         (eq_option eq_expression (a1, b1)))
+        && (eq_bool (a2, b2))
+  | (Pexp_variant (a0, a1), Pexp_variant (b0, b1)) ->
+      (Asttypes.eq_label (a0, b0)) &&
+        (eq_option eq_expression (a1, b1))
+  | (Pexp_record (a0, a1), Pexp_record (b0, b1)) ->
+      (eq_list
+         (fun ((a0, a1), (b0, b1)) ->
+            (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+              (eq_expression (a1, b1)))
+         (a0, b0))
+        && (eq_option eq_expression (a1, b1))
+  | (Pexp_field (a0, a1), Pexp_field (b0, b1)) ->
+      (eq_expression (a0, b0)) &&
+        (Asttypes.eq_loc Longident.eq_t (a1, b1))
+  | (Pexp_setfield (a0, a1, a2), Pexp_setfield (b0, b1, b2)) ->
+      ((eq_expression (a0, b0)) &&
+         (Asttypes.eq_loc Longident.eq_t (a1, b1)))
+        && (eq_expression (a2, b2))
+  | (Pexp_array a0, Pexp_array b0) -> eq_list eq_expression (a0, b0)
+  | (Pexp_ifthenelse (a0, a1, a2), Pexp_ifthenelse (b0, b1, b2)) ->
+      ((eq_expression (a0, b0)) && (eq_expression (a1, b1))) &&
+        (eq_option eq_expression (a2, b2))
+  | (Pexp_sequence (a0, a1), Pexp_sequence (b0, b1)) ->
+      (eq_expression (a0, b0)) && (eq_expression (a1, b1))
+  | (Pexp_while (a0, a1), Pexp_while (b0, b1)) ->
+      (eq_expression (a0, b0)) && (eq_expression (a1, b1))
+  | (Pexp_for (a0, a1, a2, a3, a4), Pexp_for (b0, b1, b2, b3, b4)) ->
+      ((((Asttypes.eq_loc eq_string (a0, b0)) &&
+           (eq_expression (a1, b1)))
+          && (eq_expression (a2, b2)))
+         && (Asttypes.eq_direction_flag (a3, b3)))
+        && (eq_expression (a4, b4))
+  | (Pexp_constraint (a0, a1, a2), Pexp_constraint (b0, b1, b2)) ->
+      ((eq_expression (a0, b0)) && (eq_option eq_core_type (a1, b1)))
+        && (eq_option eq_core_type (a2, b2))
+  | (Pexp_when (a0, a1), Pexp_when (b0, b1)) ->
+      (eq_expression (a0, b0)) && (eq_expression (a1, b1))
+  | (Pexp_send (a0, a1), Pexp_send (b0, b1)) ->
+      (eq_expression (a0, b0)) && (eq_string (a1, b1))
+  | (Pexp_new a0, Pexp_new b0) ->
+      Asttypes.eq_loc Longident.eq_t (a0, b0)
+  | (Pexp_setinstvar (a0, a1), Pexp_setinstvar (b0, b1)) ->
+      (Asttypes.eq_loc eq_string (a0, b0)) &&
+        (eq_expression (a1, b1))
+  | (Pexp_override a0, Pexp_override b0) ->
+      eq_list
+        (fun ((a0, a1), (b0, b1)) ->
+           (Asttypes.eq_loc eq_string (a0, b0)) &&
+             (eq_expression (a1, b1)))
+        (a0, b0)
+  | (Pexp_letmodule (a0, a1, a2), Pexp_letmodule (b0, b1, b2)) ->
+      ((Asttypes.eq_loc eq_string (a0, b0)) &&
+         (eq_module_expr (a1, b1)))
+        && (eq_expression (a2, b2))
+  | (Pexp_assert a0, Pexp_assert b0) -> eq_expression (a0, b0)
+  | (Pexp_assertfalse, Pexp_assertfalse) -> true
+  | (Pexp_lazy a0, Pexp_lazy b0) -> eq_expression (a0, b0)
+  | (Pexp_poly (a0, a1), Pexp_poly (b0, b1)) ->
+      (eq_expression (a0, b0)) && (eq_option eq_core_type (a1, b1))
+  | (Pexp_object a0, Pexp_object b0) -> eq_class_structure (a0, b0)
+  | (Pexp_newtype (a0, a1), Pexp_newtype (b0, b1)) ->
+      (eq_string (a0, b0)) && (eq_expression (a1, b1))
+  | (Pexp_pack a0, Pexp_pack b0) -> eq_module_expr (a0, b0)
+  | (Pexp_open (a0, a1), Pexp_open (b0, b1)) ->
+      (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
+        (eq_expression (a1, b1))
+  | (_, _) -> false
+and eq_expression : (expression * expression) -> 'result =
+  fun
+    ({ pexp_desc = a0; pexp_loc = a1 },
+     { pexp_desc = b0; pexp_loc = b1 })
+    -> (eq_expression_desc (a0, b0)) && (Location.eq_t (a1, b1))
+  
+let rec eq_directive_argument :
+  (directive_argument * directive_argument) -> 'result =
+  function
+  | (Pdir_none, Pdir_none) -> true
+  | (Pdir_string a0, Pdir_string b0) -> eq_string (a0, b0)
+  | (Pdir_int a0, Pdir_int b0) -> eq_int (a0, b0)
+  | (Pdir_ident a0, Pdir_ident b0) -> Longident.eq_t (a0, b0)
+  | (Pdir_bool a0, Pdir_bool b0) -> eq_bool (a0, b0)
+  | (_, _) -> false
+and eq_toplevel_phrase :
+  (toplevel_phrase * toplevel_phrase) -> 'result =
+  function
+  | (Ptop_def a0, Ptop_def b0) -> eq_structure (a0, b0)
+  | (Ptop_dir (a0, a1), Ptop_dir (b0, b1)) ->
+      (eq_string (a0, b0)) && (eq_directive_argument (a1, b1))
+  | (_, _) -> false
diff -Nru ocaml-3.12.1/tools/lexer299.mll ocaml-4.01.0/tools/lexer299.mll
--- ocaml-3.12.1/tools/lexer299.mll	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/tools/lexer299.mll	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: lexer299.mll 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* The lexer definition *)
 
 {
diff -Nru ocaml-3.12.1/tools/lexer301.mll ocaml-4.01.0/tools/lexer301.mll
--- ocaml-3.12.1/tools/lexer301.mll	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/tools/lexer301.mll	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: lexer301.mll 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* The lexer definition *)
 
 {
diff -Nru ocaml-3.12.1/tools/magic ocaml-4.01.0/tools/magic
--- ocaml-3.12.1/tools/magic	2001-11-27 13:39:36.000000000 +0000
+++ ocaml-4.01.0/tools/magic	2012-08-02 08:17:59.000000000 +0000
@@ -1,7 +1,7 @@
 # Here are some definitions that can be added to the /usr/share/magic
 # database so that the file(1) command recognizes OCaml compiled files.
 # Contributed by Sven Luther.
-0       string  Caml1999        Objective Caml
+0       string  Caml1999        OCaml
 >8      string  X               bytecode executable
 >8      string  I               interface data (.cmi)
 >8      string  O               bytecode object data (.cmo)
diff -Nru ocaml-3.12.1/tools/make-opcodes ocaml-4.01.0/tools/make-opcodes
--- ocaml-3.12.1/tools/make-opcodes	1995-05-04 10:15:53.000000000 +0000
+++ ocaml-4.01.0/tools/make-opcodes	2012-08-02 08:17:59.000000000 +0000
@@ -1,2 +1,14 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
+#                                                                       #
+#   Copyright 1995 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
 $1=="enum" {n=0; next; }
            {for (i = 1; i <= NF; i++) {printf("let op%s = %d\n", $i, n++);}}
diff -Nru ocaml-3.12.1/tools/make-package-macosx ocaml-4.01.0/tools/make-package-macosx
--- ocaml-3.12.1/tools/make-package-macosx	2010-05-21 11:28:21.000000000 +0000
+++ ocaml-4.01.0/tools/make-package-macosx	2013-08-15 16:13:16.000000000 +0000
@@ -2,7 +2,7 @@
 
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #          Damien Doligez, projet Moscova, INRIA Rocquencourt           #
 #                                                                       #
@@ -12,8 +12,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: make-package-macosx 10448 2010-05-21 11:28:21Z doligez $
-
 cd package-macosx
 rm -rf ocaml.pkg ocaml-rw.dmg
 
@@ -30,9 +28,9 @@
           IFPkgDescriptionDeleteWarning
           
           IFPkgDescriptionDescription
-          The Objective Caml compiler and tools
+          The OCaml compiler and tools
           IFPkgDescriptionTitle
-          Objective Caml
+          OCaml
           IFPkgDescriptionVersion
           ${VERSION}
   
@@ -46,11 +44,11 @@
 
 
         CFBundleGetInfoString
-        Objective Caml ${VERSION}
+        OCaml ${VERSION}
         CFBundleIdentifier
         fr.inria.ocaml
         CFBundleName
-        Objective Caml
+        OCaml
         CFBundleShortVersionString
         ${VERSION}
         IFMajorVersion
@@ -85,22 +83,29 @@
 
 #                                         stop here -> |
 cat >resources/ReadMe.txt < printf "no\n"
     | l  ->
         printf "YES\n";
         printf "Primitives declared in this module:\n";
-        List.iter print_line l
+        List.iter print_line l);
+  printf "Force link: %s\n" (if cu.cu_force_link then "YES" else "no")
 
 let rec print_approx_infos ppf = function
     Value_closure(fundesc, approx) ->
@@ -97,7 +95,7 @@
   printf "\n";
   List.iter print_cmo_infos lib.lib_units
 
-let print_cmi_infos name sign comps crcs =
+let print_cmi_infos name sign crcs =
   printf "Unit name: %s\n" name;
   printf "Interfaces imported:\n";
   List.iter print_name_crc crcs
@@ -122,7 +120,17 @@
   let pr_funs _ fns =
     List.iter (fun arity -> printf " %d" arity) fns in
   printf "Currying functions:%a\n" pr_funs ui.ui_curry_fun;
-  printf "Apply functions:%a\n" pr_funs ui.ui_apply_fun
+  printf "Apply functions:%a\n" pr_funs ui.ui_apply_fun;
+  printf "Send functions:%a\n" pr_funs ui.ui_send_fun;
+  printf "Force link: %s\n" (if ui.ui_force_link then "YES" else "no")
+
+let print_cmxa_infos (lib : Cmx_format.library_infos) =
+  printf "Extra C object files:";
+  List.iter print_spaced_string (List.rev lib.lib_ccobjs);
+  printf "\nExtra C options:";
+  List.iter print_spaced_string lib.lib_ccopts;
+  printf "\n";
+  List.iter print_cmx_infos lib.lib_units
 
 let print_cmxs_infos header =
   List.iter
@@ -207,8 +215,7 @@
   printf "File %s\n" filename;
   let ic = open_in_bin filename in
   let len_magic_number = String.length cmo_magic_number in
-  let magic_number = String.create len_magic_number in
-  really_input ic magic_number 0 len_magic_number;
+  let magic_number = Misc.input_bytes ic len_magic_number in
   if magic_number = cmo_magic_number then begin
     let cu_pos = input_binary_int ic in
     seek_in ic cu_pos;
@@ -222,10 +229,10 @@
     close_in ic;
     print_cma_infos toc
   end else if magic_number = cmi_magic_number then begin
-    let (name, sign, comps) = input_value ic in
-    let crcs = input_value ic in
+    let cmi = Cmi_format.input_cmi ic in
     close_in ic;
-    print_cmi_infos name sign comps crcs
+    print_cmi_infos cmi.Cmi_format.cmi_name cmi.Cmi_format.cmi_sign
+      cmi.Cmi_format.cmi_crcs
   end else if magic_number = cmx_magic_number then begin
     let ui = (input_value ic : unit_infos) in
     let crc = Digest.input ic in
@@ -234,7 +241,7 @@
   end else if magic_number = cmxa_magic_number then begin
     let li = (input_value ic : library_infos) in
     close_in ic;
-    List.iter print_cmx_infos li.lib_units
+    print_cmxa_infos li
   end else begin
     let pos_trailer = in_channel_length ic - len_magic_number in
     let _ = seek_in ic pos_trailer in
@@ -260,10 +267,12 @@
     end
   end
 
+let arg_list = []
+let arg_usage =
+   Printf.sprintf "%s [OPTIONS] FILES : give information on files" Sys.argv.(0)
+
 let main() =
-  for i = 1 to Array.length Sys.argv - 1 do
-    dump_obj Sys.argv.(i)
-  done;
+  Arg.parse arg_list dump_obj arg_usage;
   exit 0
 
 let _ = main ()
diff -Nru ocaml-3.12.1/tools/objinfo_helper.c ocaml-4.01.0/tools/objinfo_helper.c
--- ocaml-3.12.1/tools/objinfo_helper.c	2010-05-24 14:27:50.000000000 +0000
+++ ocaml-4.01.0/tools/objinfo_helper.c	2013-07-23 14:48:47.000000000 +0000
@@ -1,11 +1,11 @@
 /***********************************************************************/
 /*                                                                     */
-/*                           Objective Caml                            */
+/*                                OCaml                                */
 /*                                                                     */
 /*        Mehdi Dogguy, PPS laboratory, University Paris Diderot       */
 /*                                                                     */
 /*  Copyright 2010 Mehdi Dogguy.  Used and distributed as part of      */
-/*  Objective Caml by permission from the author.   This file is       */
+/*  OCaml by permission from the author.   This file is                */
 /*  distributed under the terms of the Q Public License version 1.0.   */
 /***********************************************************************/
 
@@ -85,7 +85,7 @@
 
 int main(int argc, char ** argv)
 {
-  fprintf(stderr, "BFD library unavailable, cannot print info on .cmxs files\n");
+  fprintf(stderr,"BFD library unavailable, cannot print info on .cmxs files\n");
   return 2;
 }
 
diff -Nru ocaml-3.12.1/tools/ocaml-objcopy-macosx ocaml-4.01.0/tools/ocaml-objcopy-macosx
--- ocaml-3.12.1/tools/ocaml-objcopy-macosx	2006-01-04 16:55:50.000000000 +0000
+++ ocaml-4.01.0/tools/ocaml-objcopy-macosx	2012-10-15 17:50:56.000000000 +0000
@@ -2,7 +2,7 @@
 
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #           Damien Doligez, projet Cristal, INRIA Rocquencourt          #
 #                                                                       #
@@ -12,9 +12,6 @@
 #                                                                       #
 #########################################################################
 
-# $Id: ocaml-objcopy-macosx 7307 2006-01-04 16:55:50Z doligez $
-
-
 TMP="${TMPDIR=/tmp}"
 TEMP="${TMP}"/ocaml-objcopy-$$.o
 UNDEF="${TMP}"/ocaml-objcopy-$$.sym
diff -Nru ocaml-3.12.1/tools/ocaml299to3.ml ocaml-4.01.0/tools/ocaml299to3.ml
--- ocaml-3.12.1/tools/ocaml299to3.ml	2001-10-03 01:34:05.000000000 +0000
+++ ocaml-4.01.0/tools/ocaml299to3.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*              Jacques Garrigue, Kyoto University RIMS                *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: ocaml299to3.ml 3838 2001-10-03 01:34:05Z garrigue $ *)
-
 open Lexer299
 
 let input_buffer = Buffer.create 16383
@@ -124,9 +122,10 @@
     print_endline "Usage: ocaml299to3  ...";
     print_endline "Description:";
     print_endline
-      "Convert Objective Caml 2.99 O'Labl-style labels in implementation files to";
+      "Convert OCaml 2.99 O'Labl-style labels in implementation files to";
     print_endline
-      "a syntax compatible with version 3. Also `fun:' labels are replaced by `f:'.";
+      "a syntax compatible with version 3. Also `fun:' labels are replaced \
+       by `f:'.";
     print_endline "Other syntactic changes are not handled.";
     print_endline "Old files are renamed to .bak.";
     print_endline "Interface files do not need label syntax conversion.";
diff -Nru ocaml-3.12.1/tools/ocamlcp.ml ocaml-4.01.0/tools/ocamlcp.ml
--- ocaml-3.12.1/tools/ocamlcp.ml	2010-05-20 14:06:29.000000000 +0000
+++ ocaml-4.01.0/tools/ocamlcp.ml	2013-08-20 15:32:13.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: ocamlcp.ml 10444 2010-05-20 14:06:29Z doligez $ *)
-
 open Printf
 
 let compargs = ref ([] : string list)
@@ -43,12 +41,15 @@
 
 module Options = Main_args.Make_bytecomp_options (struct
   let _a () = make_archive := true; option "-a" ()
+  let _absname = option "-absname"
   let _annot = option "-annot"
+  let _binannot = option "-bin-annot"
   let _c = option "-c"
   let _cc s = option_with_arg "-cc" s
   let _cclib s = option_with_arg "-cclib" s
   let _ccopt s = option_with_arg "-ccopt" s
   let _config = option "-config"
+  let _compat_32 = option "-compat-32"
   let _custom = option "-custom"
   let _dllib = option_with_arg "-dllib"
   let _dllpath = option_with_arg "-dllpath"
@@ -71,8 +72,11 @@
   let _output_obj = option "-output-obj"
   let _pack = option "-pack"
   let _pp s = incompatible "-pp"
+  let _ppx s = incompatible "-ppx"
   let _principal = option "-principal"
   let _rectypes = option "-rectypes"
+  let _runtime_variant s = option_with_arg "-runtime-variant" s
+  let _short_paths = option "-short-paths"
   let _strict_sequence = option "-strict-sequence"
   let _thread () = option "-thread" ()
   let _vmthread () = option "-vmthread" ()
@@ -88,7 +92,9 @@
   let _warn_help = option "-warn-help"
   let _where = option "-where"
   let _nopervasives = option "-nopervasives"
+  let _dsource = option "-dsource"
   let _dparsetree = option "-dparsetree"
+  let _dtypedtree = option "-dtypedtree"
   let _drawlambda = option "-drawlambda"
   let _dlambda = option "-dlambda"
   let _dinstr = option "-dinstr"
@@ -100,7 +106,7 @@
 ;;
 
 let optlist =
-    ("-p", Arg.String add_profarg,
+    ("-P", Arg.String add_profarg,
            "[afilmt]  Profile constructs specified by argument (default fm):\n\
         \032     a  Everything\n\
         \032     f  Function calls and method calls\n\
@@ -108,6 +114,7 @@
         \032     l  while and for loops\n\
         \032     m  match ... with\n\
         \032     t  try ... with")
+    :: ("-p", Arg.String add_profarg, "[afilmt]  Same as option -P")
     :: Options.list
 in
 Arg.parse optlist process_file usage;
diff -Nru ocaml-3.12.1/tools/ocamldep.ml ocaml-4.01.0/tools/ocamldep.ml
--- ocaml-3.12.1/tools/ocamldep.ml	2011-01-04 10:33:49.000000000 +0000
+++ ocaml-4.01.0/tools/ocamldep.ml	2013-08-20 15:32:13.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,23 +10,25 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: ocamldep.ml 10914 2011-01-04 10:33:49Z xclerc $ *)
-
-open Format
-open Location
-open Longident
+open Compenv
 open Parsetree
 
-
+let ppf = Format.err_formatter
 (* Print the dependencies *)
 
+type file_kind = ML | MLI;;
+
+let include_dirs = ref []
 let load_path = ref ([] : (string * string array) list)
 let ml_synonyms = ref [".ml"]
 let mli_synonyms = ref [".mli"]
 let native_only = ref false
-let force_slash = ref false
 let error_occurred = ref false
 let raw_dependencies = ref false
+let sort_files = ref false
+let all_dependencies = ref false
+let one_line = ref false
+let files = ref []
 
 (* Fix path to use '/' as directory separator instead of '\'.
    Only under Windows. *)
@@ -40,23 +42,43 @@
     r
   end
 
+(* Since we reinitialize load_path after reading OCAMLCOMP,
+  we must use a cache instead of calling Sys.readdir too often. *)
+module StringMap = Map.Make(String)
+let dirs = ref StringMap.empty
+let readdir dir =
+  try
+    StringMap.find dir !dirs
+  with Not_found ->
+    let contents =
+      try
+        Sys.readdir dir
+      with Sys_error msg ->
+        Format.fprintf Format.err_formatter "@[Bad -I option: %s@]@." msg;
+        error_occurred := true;
+        [||]
+    in
+    dirs := StringMap.add dir contents !dirs;
+    contents
+
 let add_to_load_path dir =
   try
     let dir = Misc.expand_directory Config.standard_library dir in
-    let contents = Sys.readdir dir in
-    load_path := !load_path @ [dir, contents]
+    let contents = readdir dir in
+    load_path := (dir, contents) :: !load_path
   with Sys_error msg ->
-    fprintf Format.err_formatter "@[Bad -I option: %s@]@." msg;
+    Format.fprintf Format.err_formatter "@[Bad -I option: %s@]@." msg;
     error_occurred := true
 
 let add_to_synonym_list synonyms suffix =
   if (String.length suffix) > 1 && suffix.[0] = '.' then
     synonyms := suffix :: !synonyms
   else begin
-    fprintf Format.err_formatter "@[Bad suffix: '%s'@]@." suffix;
+    Format.fprintf Format.err_formatter "@[Bad suffix: '%s'@]@." suffix;
     error_occurred := true
   end
 
+(* Find file 'name' (capitalized) in search path *)
 let find_file name =
   let uname = String.uncapitalize name in
   let rec find_in_array a pos =
@@ -77,31 +99,58 @@
   [] -> raise Not_found
 | x :: rem -> try find_file x with Not_found -> find_file_in_list rem
 
-let find_dependency modname (byt_deps, opt_deps) =
+
+let find_dependency target_kind modname (byt_deps, opt_deps) =
   try
     let candidates = List.map ((^) modname) !mli_synonyms in
     let filename = find_file_in_list candidates in
     let basename = Filename.chop_extension filename in
-    let optname =
-      if List.exists (fun ext -> Sys.file_exists (basename ^ ext)) !ml_synonyms
-      then basename ^ ".cmx"
-      else basename ^ ".cmi" in
-    ((basename ^ ".cmi") :: byt_deps, optname :: opt_deps)
+    let cmi_file = basename ^ ".cmi" in
+    let ml_exists =
+      List.exists (fun ext -> Sys.file_exists (basename ^ ext)) !ml_synonyms in
+    let new_opt_dep =
+      if !all_dependencies then
+        match target_kind with
+        | MLI -> [ cmi_file ]
+        | ML  ->
+          cmi_file :: (if ml_exists then [ basename ^ ".cmx"] else [])
+      else
+        (* this is a make-specific hack that makes .cmx to be a 'proxy'
+           target that would force the dependency on .cmi via transitivity *)
+        if ml_exists
+        then [ basename ^ ".cmx" ]
+        else [ cmi_file ]
+    in
+    ( cmi_file :: byt_deps, new_opt_dep @ opt_deps)
   with Not_found ->
   try
+    (* "just .ml" case *)
     let candidates = List.map ((^) modname) !ml_synonyms in
     let filename = find_file_in_list candidates in
     let basename = Filename.chop_extension filename in
-    let bytename =
-      basename ^ (if !native_only then ".cmx" else ".cmo") in
-    (bytename :: byt_deps, (basename ^ ".cmx") :: opt_deps)
+    let bytenames =
+      if !all_dependencies then
+        match target_kind with
+        | MLI -> [basename ^ ".cmi"]
+        | ML  -> [basename ^ ".cmi";]
+      else
+        (* again, make-specific hack *)
+        [basename ^ (if !native_only then ".cmx" else ".cmo")] in
+    let optnames =
+      if !all_dependencies
+      then match target_kind with
+        | MLI -> [basename ^ ".cmi"]
+        | ML  -> [basename ^ ".cmi"; basename ^ ".cmx"]
+      else [ basename ^ ".cmx" ]
+    in
+    (bytenames @ byt_deps, optnames @  opt_deps)
   with Not_found ->
     (byt_deps, opt_deps)
 
 let (depends_on, escaped_eol) = (":", " \\\n    ")
 
 let print_filename s =
-  let s = if !force_slash then fix_slash s else s in
+  let s = if !Clflags.force_slash then fix_slash s else s in
   if not (String.contains s ' ') then begin
     print_string s;
   end else begin
@@ -128,22 +177,21 @@
   end
 ;;
 
-let print_dependencies target_file deps =
-  print_filename target_file; print_string depends_on;
+let print_dependencies target_files deps =
   let rec print_items pos = function
     [] -> print_string "\n"
   | dep :: rem ->
-      if pos + 1 + String.length dep <= 77 then begin
-        print_string " "; print_filename dep;
+    if !one_line || (pos + 1 + String.length dep <= 77) then begin
+        if pos <> 0 then print_string " "; print_filename dep;
         print_items (pos + String.length dep + 1) rem
       end else begin
         print_string escaped_eol; print_filename dep;
         print_items (String.length dep + 4) rem
       end in
-  print_items (String.length target_file + 1) deps
+  print_items 0 (target_files @ [depends_on] @ deps)
 
 let print_raw_dependencies source_file deps =
-  print_filename source_file; print_string ":";
+  print_filename source_file; print_string depends_on;
   Depend.StringSet.iter
     (fun dep ->
       if (String.length dep > 0)
@@ -154,112 +202,112 @@
     deps;
   print_char '\n'
 
-(* Optionally preprocess a source file *)
-
-let preprocessor = ref None
-
-exception Preprocessing_error
 
-let preprocess sourcefile =
-  match !preprocessor with
-    None -> sourcefile
-  | Some pp ->
-      flush Pervasives.stdout;
-      let tmpfile = Filename.temp_file "camlpp" "" in
-      let comm = Printf.sprintf "%s %s > %s" pp sourcefile tmpfile in
-      if Sys.command comm <> 0 then begin
-        Misc.remove_file tmpfile;
-        raise Preprocessing_error
-      end;
-      tmpfile
-
-let remove_preprocessed inputfile =
-  match !preprocessor with
-    None -> ()
-  | Some _ -> Misc.remove_file inputfile
+(* Process one file *)
 
-(* Parse a file or get a dumped syntax tree in it *)
+let report_err source_file exn =
+  error_occurred := true;
+  match exn with
+    | Lexer.Error(err, range) ->
+        Format.fprintf Format.err_formatter "@[%a%a@]@."
+        Location.print_error range  Lexer.report_error err
+    | Syntaxerr.Error err ->
+        Format.fprintf Format.err_formatter "@[%a@]@."
+        Syntaxerr.report_error err
+    | Sys_error msg ->
+        Format.fprintf Format.err_formatter "@[I/O error:@ %s@]@." msg
+    | Pparse.Error err ->
+        Format.fprintf Format.err_formatter
+                       "@[Preprocessing error on file %s@]@.@[%a@]@."
+          source_file
+          Pparse.report_error err
+    | x -> raise x
 
-let is_ast_file ic ast_magic =
+let read_parse_and_extract parse_function extract_function magic source_file =
+  Depend.free_structure_names := Depend.StringSet.empty;
   try
-    let buffer = String.create (String.length ast_magic) in
-    really_input ic buffer 0 (String.length ast_magic);
-    if buffer = ast_magic then true
-    else if String.sub buffer 0 9 = String.sub ast_magic 0 9 then
-      failwith "Ocaml and preprocessor have incompatible versions"
-    else false
-  with End_of_file -> false
-
-let parse_use_file ic =
-  if is_ast_file ic Config.ast_impl_magic_number then
-    let _source_file = input_value ic in
-    [Ptop_def (input_value ic : Parsetree.structure)]
-  else begin
-    seek_in ic 0;
-    let lb = Lexing.from_channel ic in
-    Parse.use_file lb
-  end
-
-let parse_interface ic =
-  if is_ast_file ic Config.ast_intf_magic_number then
-    let _source_file = input_value ic in
-    (input_value ic : Parsetree.signature)
-  else begin
-    seek_in ic 0;
-    let lb = Lexing.from_channel ic in
-    Parse.interface lb
-  end
-
-(* Process one file *)
+    let input_file = Pparse.preprocess source_file in
+    begin try
+      let ast =
+        Pparse.file Format.err_formatter input_file parse_function magic in
+      extract_function Depend.StringSet.empty ast;
+      Pparse.remove_preprocessed input_file;
+      !Depend.free_structure_names
+    with x ->
+      Pparse.remove_preprocessed input_file;
+      raise x
+    end
+  with x ->
+    report_err source_file x;
+    Depend.StringSet.empty
 
 let ml_file_dependencies source_file =
-  Depend.free_structure_names := Depend.StringSet.empty;
-  let input_file = preprocess source_file in
-  let ic = open_in_bin input_file in
-  try
-    let ast = parse_use_file ic in
-    Depend.add_use_file Depend.StringSet.empty ast;
+  let parse_use_file_as_impl lexbuf =
+    let f x =
+      match x with
+      | Ptop_def s -> s
+      | Ptop_dir _ -> []
+    in
+    List.flatten (List.map f (Parse.use_file lexbuf))
+  in
+  let extracted_deps =
+    read_parse_and_extract parse_use_file_as_impl Depend.add_implementation
+                           Config.ast_impl_magic_number source_file
+  in
+  if !sort_files then
+    files := (source_file, ML, !Depend.free_structure_names) :: !files
+  else
     if !raw_dependencies then begin
-      print_raw_dependencies source_file !Depend.free_structure_names
+      print_raw_dependencies source_file extracted_deps
     end else begin
       let basename = Filename.chop_extension source_file in
-      let init_deps =
-        if List.exists (fun ext -> Sys.file_exists (basename ^ ext)) !mli_synonyms
-        then let cmi_name = basename ^ ".cmi" in ([cmi_name], [cmi_name])
-        else ([], []) in
-      let (byt_deps, opt_deps) =
-        Depend.StringSet.fold find_dependency
-                              !Depend.free_structure_names init_deps in
-      print_dependencies (basename ^ ".cmo") byt_deps;
-      print_dependencies (basename ^ ".cmx") opt_deps
-    end;
-    close_in ic; remove_preprocessed input_file
-  with x ->
-    close_in ic; remove_preprocessed input_file; raise x
+      let byte_targets = [ basename ^ ".cmo" ] in
+      let native_targets =
+        if !all_dependencies
+        then [ basename ^ ".cmx"; basename ^ ".o" ]
+        else [ basename ^ ".cmx" ] in
+      let init_deps = if !all_dependencies then [source_file] else [] in
+      let cmi_name = basename ^ ".cmi" in
+      let init_deps, extra_targets =
+        if List.exists (fun ext -> Sys.file_exists (basename ^ ext))
+                       !mli_synonyms
+        then (cmi_name :: init_deps, cmi_name :: init_deps), []
+        else (init_deps, init_deps),
+             (if !all_dependencies then [cmi_name] else [])
+      in
+      let (byt_deps, native_deps) =
+        Depend.StringSet.fold (find_dependency ML)
+          extracted_deps init_deps in
+      print_dependencies (byte_targets @ extra_targets) byt_deps;
+      print_dependencies (native_targets @ extra_targets) native_deps;
+    end
 
 let mli_file_dependencies source_file =
-  Depend.free_structure_names := Depend.StringSet.empty;
-  let input_file = preprocess source_file in
-  let ic = open_in_bin input_file in
-  try
-    let ast = parse_interface ic in
-    Depend.add_signature Depend.StringSet.empty ast;
+  let extracted_deps =
+    read_parse_and_extract Parse.interface Depend.add_signature
+                           Config.ast_intf_magic_number source_file
+  in
+  if !sort_files then
+    files := (source_file, MLI, extracted_deps) :: !files
+  else
     if !raw_dependencies then begin
-      print_raw_dependencies source_file !Depend.free_structure_names
+      print_raw_dependencies source_file extracted_deps
     end else begin
       let basename = Filename.chop_extension source_file in
       let (byt_deps, opt_deps) =
-        Depend.StringSet.fold find_dependency
-                              !Depend.free_structure_names ([], []) in
-      print_dependencies (basename ^ ".cmi") byt_deps
-    end;
-    close_in ic; remove_preprocessed input_file
-  with x ->
-    close_in ic; remove_preprocessed input_file; raise x
-
-type file_kind = ML | MLI;;
+        Depend.StringSet.fold (find_dependency MLI)
+          extracted_deps ([], []) in
+      print_dependencies [basename ^ ".cmi"] byt_deps
+    end
 
 let file_dependencies_as kind source_file =
+  Compenv.readenv ppf Before_compile;
+  load_path := [];
+  List.iter add_to_load_path (
+      (!Compenv.last_include_dirs @
+       !include_dirs @
+       !Compenv.first_include_dirs
+      ));
   Location.input_name := source_file;
   try
     if Sys.file_exists source_file then begin
@@ -267,22 +315,7 @@
       | ML -> ml_file_dependencies source_file
       | MLI -> mli_file_dependencies source_file
     end
-  with x ->
-    let report_err = function
-    | Lexer.Error(err, range) ->
-        fprintf Format.err_formatter "@[%a%a@]@."
-        Location.print_error range  Lexer.report_error err
-    | Syntaxerr.Error err ->
-        fprintf Format.err_formatter "@[%a@]@."
-        Syntaxerr.report_error err
-    | Sys_error msg ->
-        fprintf Format.err_formatter "@[I/O error:@ %s@]@." msg
-    | Preprocessing_error ->
-        fprintf Format.err_formatter "@[Preprocessing error on file %s@]@."
-            source_file
-    | x -> raise x in
-    error_occurred := true;
-    report_err x
+  with x -> report_err source_file x
 
 let file_dependencies source_file =
   if List.exists (Filename.check_suffix source_file) !ml_synonyms then
@@ -291,45 +324,131 @@
     file_dependencies_as MLI source_file
   else ()
 
+let sort_files_by_dependencies files =
+  let h = Hashtbl.create 31 in
+  let worklist = ref [] in
+
+(* Init Hashtbl with all defined modules *)
+  let files = List.map (fun (file, file_kind, deps) ->
+    let modname = Filename.chop_extension (Filename.basename file) in
+    modname.[0] <- Char.uppercase modname.[0];
+    let key = (modname, file_kind) in
+    let new_deps = ref [] in
+    Hashtbl.add h key (file, new_deps);
+    worklist := key :: !worklist;
+    (modname, file_kind, deps, new_deps)
+  ) files in
+
+(* Keep only dependencies to defined modules *)
+  List.iter (fun (modname, file_kind, deps, new_deps) ->
+    let add_dep modname kind =
+      new_deps := (modname, kind) :: !new_deps;
+    in
+    Depend.StringSet.iter (fun modname ->
+      match file_kind with
+          ML -> (* ML depends both on ML and MLI *)
+            if Hashtbl.mem h (modname, MLI) then add_dep modname MLI;
+            if Hashtbl.mem h (modname, ML) then add_dep modname ML
+        | MLI -> (* MLI depends on MLI if exists, or ML otherwise *)
+          if Hashtbl.mem h (modname, MLI) then add_dep modname MLI
+          else if Hashtbl.mem h (modname, ML) then add_dep modname ML
+    ) deps;
+    if file_kind = ML then (* add dep from .ml to .mli *)
+      if Hashtbl.mem h (modname, MLI) then add_dep modname MLI
+  ) files;
+
+(* Print and remove all files with no remaining dependency. Iterate
+   until all files have been removed (worklist is empty) or
+   no file was removed during a turn (cycle). *)
+  let printed = ref true in
+  while !printed && !worklist <> [] do
+    let files = !worklist in
+    worklist := [];
+    printed := false;
+    List.iter (fun key ->
+      let (file, deps) = Hashtbl.find h key in
+      let set = !deps in
+      deps := [];
+      List.iter (fun key ->
+        if Hashtbl.mem h key then deps := key :: !deps
+      ) set;
+      if !deps = [] then begin
+        printed := true;
+        Printf.printf "%s " file;
+        Hashtbl.remove h key;
+      end else
+        worklist := key :: !worklist
+    ) files
+  done;
+
+  if !worklist <> [] then begin
+    Format.fprintf Format.err_formatter
+      "@[Warning: cycle in dependencies. End of list is not sorted.@]@.";
+    Hashtbl.iter (fun _ (file, deps) ->
+      Format.fprintf Format.err_formatter "\t@[%s: " file;
+      List.iter (fun (modname, kind) ->
+        Format.fprintf Format.err_formatter "%s.%s " modname
+          (if kind=ML then "ml" else "mli");
+      ) !deps;
+      Format.fprintf Format.err_formatter "@]@.";
+      Printf.printf "%s " file) h;
+  end;
+  Printf.printf "\n%!";
+  ()
+
+
 (* Entry point *)
 
 let usage = "Usage: ocamldep [options] \nOptions are:"
 
 let print_version () =
-  printf "ocamldep, version %s@." Sys.ocaml_version;
+  Format.printf "ocamldep, version %s@." Sys.ocaml_version;
   exit 0;
 ;;
 
 let print_version_num () =
-  printf "%s@." Sys.ocaml_version;
+  Format.printf "%s@." Sys.ocaml_version;
   exit 0;
 ;;
 
 let _ =
   Clflags.classic := false;
-  add_to_load_path Filename.current_dir_name;
+  first_include_dirs := Filename.current_dir_name :: !first_include_dirs;
+  Compenv.readenv ppf Before_args;
   Arg.parse [
-     "-I", Arg.String add_to_load_path,
-       "  Add  to the list of include directories";
+     "-absname", Arg.Set Location.absname,
+        " Show absolute filenames in error messages";
+     "-all", Arg.Set all_dependencies,
+        " Generate dependencies on all files";
+     "-I", Arg.String (fun s -> include_dirs := s :: !include_dirs),
+        "  Add  to the list of include directories";
      "-impl", Arg.String (file_dependencies_as ML),
-       " Process  as a .ml file";
+        "  Process  as a .ml file";
      "-intf", Arg.String (file_dependencies_as MLI),
-       " Process  as a .mli file";
+        "  Process  as a .mli file";
      "-ml-synonym", Arg.String(add_to_synonym_list ml_synonyms),
-       " Consider  as a synonym of the .ml extension";
+        "  Consider  as a synonym of the .ml extension";
      "-mli-synonym", Arg.String(add_to_synonym_list mli_synonyms),
-       " Consider  as a synonym of the .mli extension";
+        "  Consider  as a synonym of the .mli extension";
      "-modules", Arg.Set raw_dependencies,
-       " Print module dependencies in raw form (not suitable for make)";
+        " Print module dependencies in raw form (not suitable for make)";
      "-native", Arg.Set native_only,
-       "  Generate dependencies for a pure native-code project (no .cmo files)";
-     "-pp", Arg.String(fun s -> preprocessor := Some s),
-       " Pipe sources through preprocessor ";
-     "-slash", Arg.Set force_slash,
-       "   (Windows) Use forward slash / instead of backslash \\ in file paths";
+        " Generate dependencies for native-code only (no .cmo files)";
+     "-one-line", Arg.Set one_line,
+        " Output one line per file, regardless of the length";
+     "-pp", Arg.String(fun s -> Clflags.preprocessor := Some s),
+         "  Pipe sources through preprocessor ";
+     "-ppx", Arg.String(fun s -> first_ppx := s :: !first_ppx),
+         "  Pipe abstract syntax trees through preprocessor ";
+     "-slash", Arg.Set Clflags.force_slash,
+         " (Windows) Use forward slash / instead of backslash \\ in file paths";
+     "-sort", Arg.Set sort_files,
+        " Sort files according to their dependencies";
      "-version", Arg.Unit print_version,
-      " Print version and exit";
+         " Print version and exit";
      "-vnum", Arg.Unit print_version_num,
-      " Print version number and exit";
+         " Print version number and exit";
     ] file_dependencies usage;
+  Compenv.readenv ppf Before_link;
+  if !sort_files then sort_files_by_dependencies !files;
   exit (if !error_occurred then 2 else 0)
diff -Nru ocaml-3.12.1/tools/ocamlmklib.mlp ocaml-4.01.0/tools/ocamlmklib.mlp
--- ocaml-3.12.1/tools/ocamlmklib.mlp	2010-09-29 16:46:54.000000000 +0000
+++ ocaml-4.01.0/tools/ocamlmklib.mlp	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: ocamlmklib.mlp 10695 2010-09-29 16:46:54Z doligez $ *)
-
 open Printf
 open Myocamlbuild_config
 
@@ -22,17 +20,19 @@
 
 let bytecode_objs = ref []  (* .cmo,.cma,.ml,.mli files to pass to ocamlc *)
 and native_objs = ref []    (* .cmx,.cmxa,.ml,.mli files to pass to ocamlopt *)
-and c_objs = ref []         (* .o, .a, .obj, .lib, .dll files to pass to mksharedlib and ar *)
+and c_objs = ref []         (* .o, .a, .obj, .lib, .dll files to pass
+                               to mksharedlib and ar *)
 and caml_libs = ref []      (* -cclib to pass to ocamlc, ocamlopt *)
 and caml_opts = ref []      (* -ccopt to pass to ocamlc, ocamlopt *)
 and dynlink = ref supports_shared_libraries
 and failsafe = ref false    (* whether to fall back on static build only *)
 and c_libs = ref []         (* libs to pass to mksharedlib and ocamlc -cclib *)
+and c_Lopts = ref []      (* options to pass to mksharedlib and ocamlc -cclib *)
 and c_opts = ref []      (* options to pass to mksharedlib and ocamlc -ccopt *)
 and ld_opts = ref []        (* options to pass only to the linker *)
 and ocamlc = ref (compiler_path "ocamlc")
 and ocamlopt = ref (compiler_path "ocamlopt")
-and output = ref "a"        (* Output name for Caml part of library *)
+and output = ref "a"        (* Output name for OCaml part of library *)
 and output_c = ref ""       (* Output name for C part of library *)
 and rpath = ref []          (* rpath options *)
 and verbose = ref false
@@ -93,7 +93,7 @@
     else if starts_with s "-l" then
       c_libs := s :: !c_libs
     else if starts_with s "-L" then
-     (c_opts := s :: !c_opts;
+     (c_Lopts := s :: !c_Lopts;
       let l = chop_prefix s "-L" in
       if not (Filename.is_relative l) then rpath := l :: !rpath)
     else if s = "-ocamlc" then
@@ -137,11 +137,14 @@
     (fun r -> r := List.rev !r)
     [ bytecode_objs; native_objs; caml_libs; caml_opts;
       c_libs; c_objs; c_opts; ld_opts; rpath ];
+(* Put -L options in front of -l options in -cclib to mimic -ccopt behavior *)
+  c_libs := !c_Lopts @ !c_libs;
 
   if !output_c = "" then output_c := !output
 
 let usage = "\
-Usage: ocamlmklib [options] <.cmo|.cma|.cmx|.cmxa|.ml|.mli|.o|.a|.obj|.lib|.dll files>\
+Usage: ocamlmklib [options] <.cmo|.cma|.cmx|.cmxa|.ml|.mli|.o|.a|.obj|.lib|\
+                             .dll files>\
 \nOptions are:\
 \n  -cclib    C library passed to ocamlc -a or ocamlopt -a only\
 \n  -ccopt    C option passed to ocamlc -a or ocamlopt -a only\
@@ -152,15 +155,15 @@
 \n  -help          Print this help message and exit\
 \n  --help         Same as -help\
 \n  -h             Same as -help\
-\n  -I        Add  to the path searched for Caml object files\
+\n  -I        Add  to the path searched for OCaml object files\
 \n  -failsafe      fall back to static linking if DLL construction failed\
 \n  -ldopt    C option passed to the shared linker only\
-\n  -linkall       Build Caml archive with link-all behavior\
+\n  -linkall       Build OCaml archive with link-all behavior\
 \n  -l        Specify a dependent C library\
 \n  -L        Add  to the path searched for C libraries\
 \n  -ocamlc   Use  in place of \"ocamlc\"\
 \n  -ocamlopt  Use  in place of \"ocamlopt\"\
-\n  -o       Generated Caml library is named .cma or .cmxa\
+\n  -o       Generated OCaml library is named .cma or .cmxa\
 \n  -oc      Generated C library is named dll.so or lib.a\
 \n  -rpath    Same as -dllpath \
 \n  -R        Same as -rpath\
diff -Nru ocaml-3.12.1/tools/ocamlmktop.ml ocaml-4.01.0/tools/ocamlmktop.ml
--- ocaml-3.12.1/tools/ocamlmktop.ml	2003-03-24 15:27:01.000000000 +0000
+++ ocaml-4.01.0/tools/ocamlmktop.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,8 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: ocamlmktop.ml 5454 2003-03-24 15:27:01Z xleroy $ *)
-
 let _ =
   let args = Ccomp.quote_files (List.tl (Array.to_list Sys.argv)) in
-  exit(Sys.command("ocamlc -linkall toplevellib.cma " ^ args ^ " topstart.cmo"))
+  exit(Sys.command("ocamlc -I +compiler-libs -linkall ocamlcommon.cma \
+                    ocamlbytecomp.cma ocamltoplevel.cma "
+                   ^ args ^ " topstart.cmo"))
diff -Nru ocaml-3.12.1/tools/ocamlmktop.tpl ocaml-4.01.0/tools/ocamlmktop.tpl
--- ocaml-3.12.1/tools/ocamlmktop.tpl	2010-05-20 09:44:25.000000000 +0000
+++ ocaml-4.01.0/tools/ocamlmktop.tpl	2013-07-23 14:48:47.000000000 +0000
@@ -1,7 +1,7 @@
 #!/bin/sh
 #########################################################################
 #                                                                       #
-#                            Objective Caml                             #
+#                                 OCaml                                 #
 #                                                                       #
 #            Damien Doligez, projet Para, INRIA Rocquencourt            #
 #                                                                       #
@@ -11,6 +11,5 @@
 #                                                                       #
 #########################################################################
 
-# $Id: ocamlmktop.tpl 10443 2010-05-20 09:44:25Z doligez $
-
-exec %%BINDIR%%/ocamlc -linkall toplevellib.cma "$@" topstart.cmo
+exec %%BINDIR%%/ocamlc -I +compiler-libs -linkall ocamlcommon.cma \
+                       ocamlbytecomp.cma ocamltoplevel.cma "$@" topstart.cmo
diff -Nru ocaml-3.12.1/tools/ocamloptp.ml ocaml-4.01.0/tools/ocamloptp.ml
--- ocaml-3.12.1/tools/ocamloptp.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/tools/ocamloptp.ml	2013-08-20 15:32:13.000000000 +0000
@@ -0,0 +1,159 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Damien Doligez, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+open Printf
+
+let compargs = ref ([] : string list)
+let profargs = ref ([] : string list)
+let toremove = ref ([] : string list)
+
+let option opt () = compargs := opt :: !compargs
+let option_with_arg opt arg =
+  compargs := (Filename.quote arg) :: opt :: !compargs
+;;
+let option_with_int opt arg =
+  compargs := (string_of_int arg) :: opt :: !compargs
+;;
+
+let make_archive = ref false;;
+let with_impl = ref false;;
+let with_intf = ref false;;
+let with_mli = ref false;;
+let with_ml = ref false;;
+
+let process_file filename =
+  if Filename.check_suffix filename ".ml" then with_ml := true;
+  if Filename.check_suffix filename ".mli" then with_mli := true;
+  compargs := (Filename.quote filename) :: !compargs
+;;
+
+let usage = "Usage: ocamloptp  \noptions are:"
+
+let incompatible o =
+  fprintf stderr "ocamloptp: profiling is incompatible with the %s option\n" o;
+  exit 2
+
+module Options = Main_args.Make_optcomp_options (struct
+  let _a () = make_archive := true; option "-a" ()
+  let _absname = option "-absname"
+  let _annot = option "-annot"
+  let _binannot = option "-bin-annot"
+  let _c = option "-c"
+  let _cc s = option_with_arg "-cc" s
+  let _cclib s = option_with_arg "-cclib" s
+  let _ccopt s = option_with_arg "-ccopt" s
+  let _compact = option "-compact"
+  let _config = option "-config"
+  let _for_pack s = option_with_arg "-for-pack" s
+  let _g = option "-g"
+  let _i = option "-i"
+  let _I s = option_with_arg "-I" s
+  let _impl s = with_impl := true; option_with_arg "-impl" s
+  let _inline n = option_with_int "-inline" n
+  let _intf s = with_intf := true; option_with_arg "-intf" s
+  let _intf_suffix s = option_with_arg "-intf-suffix" s
+  let _labels = option "-labels"
+  let _linkall = option "-linkall"
+  let _no_app_funct = option "-no-app-funct"
+  let _noassert = option "-noassert"
+  let _noautolink = option "-noautolink"
+  let _nodynlink = option "-nodynlink"
+  let _nolabels = option "-nolabels"
+  let _nostdlib = option "-nostdlib"
+  let _o s = option_with_arg "-o" s
+  let _output_obj = option "-output-obj"
+  let _p = option "-p"
+  let _pack = option "-pack"
+  let _pp s = incompatible "-pp"
+  let _ppx s = incompatible "-ppx"
+  let _principal = option "-principal"
+  let _rectypes = option "-rectypes"
+  let _runtime_variant s = option_with_arg "-runtime-variant" s
+  let _S = option "-S"
+  let _short_paths = option "-short-paths"
+  let _strict_sequence = option "-strict-sequence"
+  let _shared = option "-shared"
+  let _thread = option "-thread"
+  let _unsafe = option "-unsafe"
+  let _v = option "-v"
+  let _version = option "-version"
+  let _vnum = option "-vnum"
+  let _verbose = option "-verbose"
+  let _w = option_with_arg "-w"
+  let _warn_error = option_with_arg "-warn-error"
+  let _warn_help = option "-warn-help"
+  let _where = option "-where"
+
+  let _nopervasives = option "-nopervasives"
+  let _dsource = option "-dsource"
+  let _dparsetree = option "-dparsetree"
+  let _dtypedtree = option "-dtypedtree"
+  let _drawlambda = option "-drawlambda"
+  let _dlambda = option "-dlambda"
+  let _dclambda = option "-dclambda"
+  let _dcmm = option "-dcmm"
+  let _dsel = option "-dsel"
+  let _dcombine = option "-dcombine"
+  let _dlive = option "-dlive"
+  let _dspill = option "-dspill"
+  let _dsplit = option "-dsplit"
+  let _dinterf = option "-dinterf"
+  let _dprefer = option "-dprefer"
+  let _dalloc = option "-dalloc"
+  let _dreload = option "-dreload"
+  let _dscheduling = option "-dscheduling"
+  let _dlinear = option "-dlinear"
+  let _dstartup = option "-dstartup"
+
+  let anonymous = process_file
+end);;
+
+let add_profarg s =
+  profargs := (Filename.quote s) :: "-m" :: !profargs
+;;
+
+let optlist =
+    ("-P", Arg.String add_profarg,
+           "[afilmt]  Profile constructs specified by argument (default fm):\n\
+        \032     a  Everything\n\
+        \032     f  Function calls and method calls\n\
+        \032     i  if ... then ... else\n\
+        \032     l  while and for loops\n\
+        \032     m  match ... with\n\
+        \032     t  try ... with")
+    :: Options.list
+in
+Arg.parse optlist process_file usage;
+if !with_impl && !with_intf then begin
+  fprintf stderr "ocamloptp cannot deal with both \"-impl\" and \"-intf\"\n";
+  fprintf stderr "please compile interfaces and implementations separately\n";
+  exit 2;
+end else if !with_impl && !with_mli then begin
+  fprintf stderr "ocamloptp cannot deal with both \"-impl\" and .mli files\n";
+  fprintf stderr "please compile interfaces and implementations separately\n";
+  exit 2;
+end else if !with_intf && !with_ml then begin
+  fprintf stderr "ocamloptp cannot deal with both \"-intf\" and .ml files\n";
+  fprintf stderr "please compile interfaces and implementations separately\n";
+  exit 2;
+end;
+if !with_impl then profargs := "-impl" :: !profargs;
+if !with_intf then profargs := "-intf" :: !profargs;
+let status =
+  Sys.command
+    (Printf.sprintf "ocamlopt -pp \"ocamlprof -instrument %s\" %s %s"
+        (String.concat " " (List.rev !profargs))
+        (if !make_archive then "" else "profiling.cmx")
+        (String.concat " " (List.rev !compargs)))
+in
+exit status
+;;
diff -Nru ocaml-3.12.1/tools/ocamlprof.ml ocaml-4.01.0/tools/ocamlprof.ml
--- ocaml-3.12.1/tools/ocamlprof.ml	2010-05-20 14:06:29.000000000 +0000
+++ ocaml-4.01.0/tools/ocamlprof.ml	2013-05-16 13:34:53.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*      Damien Doligez and Francois Rouaix, INRIA Rocquencourt         *)
 (*          Ported to Caml Special Light by John Malecki               *)
@@ -11,14 +11,9 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: ocamlprof.ml 10444 2010-05-20 14:06:29Z doligez $ *)
-
 open Printf
 
-open Clflags
-open Config
 open Location
-open Misc
 open Parsetree
 
 (* User programs must not use identifiers that start with these prefixes. *)
@@ -52,7 +47,7 @@
   done
 
 let copy_chars_win32 nchars =
-  for i = 1 to nchars do
+  for _i = 1 to nchars do
     let c = input_char !inchan in
     if c <> '\r' then output_char !outchan c
   done
@@ -282,12 +277,12 @@
 
   | Pexp_poly (sexp, _) -> rewrite_exp iflag sexp
 
-  | Pexp_object (_, fieldl) ->
-      List.iter (rewrite_class_field iflag) fieldl
+  | Pexp_object cl ->
+      List.iter (rewrite_class_field iflag) cl.pcstr_fields
 
   | Pexp_newtype (_, sexp) -> rewrite_exp iflag sexp
-  | Pexp_open (_, e) -> rewrite_exp iflag e
-  | Pexp_pack (smod, _) -> rewrite_mod iflag smod
+  | Pexp_open (_ovf, _, e) -> rewrite_exp iflag e
+  | Pexp_pack (smod) -> rewrite_mod iflag smod
 
 and rewrite_ifbody iflag ghost sifbody =
   if !instr_if && not ghost then
@@ -319,26 +314,25 @@
 
 (* Rewrite a class definition *)
 
-and rewrite_class_field iflag =
-  function
+and rewrite_class_field iflag cf =
+  match cf.pcf_desc with
     Pcf_inher (_, cexpr, _)     -> rewrite_class_expr iflag cexpr
-  | Pcf_val (_, _, _, sexp, _)  -> rewrite_exp iflag sexp
-  | Pcf_meth (_, _, _, ({pexp_desc = Pexp_function _} as sexp), _) ->
+  | Pcf_val (_, _, _, sexp)  -> rewrite_exp iflag sexp
+  | Pcf_meth (_, _, _, ({pexp_desc = Pexp_function _} as sexp)) ->
       rewrite_exp iflag sexp
-  | Pcf_meth (_, _, _, sexp, loc) ->
+  | Pcf_meth (_, _, _, sexp) ->
+      let loc = cf.pcf_loc in
       if !instr_fun && not loc.loc_ghost then insert_profile rw_exp sexp
       else rewrite_exp iflag sexp
-  | Pcf_let(_, spat_sexp_list, _) ->
-      rewrite_patexp_list iflag spat_sexp_list
   | Pcf_init sexp ->
       rewrite_exp iflag sexp
-  | Pcf_valvirt _ | Pcf_virt _ | Pcf_cstr _  -> ()
+  | Pcf_valvirt _ | Pcf_virt _ | Pcf_constr _  -> ()
 
 and rewrite_class_expr iflag cexpr =
   match cexpr.pcl_desc with
     Pcl_constr _ -> ()
-  | Pcl_structure (_, fields) ->
-      List.iter (rewrite_class_field iflag) fields
+  | Pcl_structure st ->
+      List.iter (rewrite_class_field iflag) st.pcstr_fields
   | Pcl_fun (_, _, _, cexpr) ->
       rewrite_class_expr iflag cexpr
   | Pcl_apply (cexpr, exprs) ->
@@ -362,7 +356,7 @@
   | Pmod_functor(param, smty, sbody) -> rewrite_mod iflag sbody
   | Pmod_apply(smod1, smod2) -> rewrite_mod iflag smod1; rewrite_mod iflag smod2
   | Pmod_constraint(smod, smty) -> rewrite_mod iflag smod
-  | Pmod_unpack(sexp, _) -> rewrite_exp iflag sexp
+  | Pmod_unpack(sexp) -> rewrite_exp iflag sexp
 
 and rewrite_str_item iflag item =
   match item.pstr_desc with
diff -Nru ocaml-3.12.1/tools/ocamlsize ocaml-4.01.0/tools/ocamlsize
--- ocaml-3.12.1/tools/ocamlsize	2003-08-21 13:52:25.000000000 +0000
+++ ocaml-4.01.0/tools/ocamlsize	2012-07-17 15:31:12.000000000 +0000
@@ -1,5 +1,17 @@
 #!/usr/bin/perl
 
+#######################################################################
+#                                                                     #
+#                                OCaml                                #
+#                                                                     #
+#            Xavier Leroy, projet Cristal, INRIA Rocquencourt         #
+#                                                                     #
+#  Copyright 2002 Institut National de Recherche en Informatique et   #
+#  en Automatique.  All rights reserved.  This file is distributed    #
+#  under the terms of the Q Public License version 1.0.               #
+#                                                                     #
+#######################################################################
+
 foreach $f (@ARGV) {
     open(FILE, $f) || die("Cannot open $f");
     seek(FILE, -16, 2);
diff -Nru ocaml-3.12.1/tools/primreq.ml ocaml-4.01.0/tools/primreq.ml
--- ocaml-3.12.1/tools/primreq.ml	2006-07-05 12:09:18.000000000 +0000
+++ ocaml-4.01.0/tools/primreq.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: primreq.ml 7469 2006-07-05 12:09:18Z pouillar $ *)
-
 (* Determine the set of C primitives required by the given .cmo and .cma
    files *)
 
diff -Nru ocaml-3.12.1/tools/profiling.ml ocaml-4.01.0/tools/profiling.ml
--- ocaml-3.12.1/tools/profiling.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/tools/profiling.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*      Damien Doligez and Francois Rouaix, INRIA Rocquencourt         *)
 (*   Ported to Caml Special Light by John Malecki and Xavier Leroy     *)
@@ -12,8 +12,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: profiling.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* Run-time library for profiled programs *)
 
 type profiling_counters = (string * (string * int array)) list
diff -Nru ocaml-3.12.1/tools/profiling.mli ocaml-4.01.0/tools/profiling.mli
--- ocaml-3.12.1/tools/profiling.mli	2005-03-24 17:20:54.000000000 +0000
+++ ocaml-4.01.0/tools/profiling.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,9 +1,9 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*      Damien Doligez and Francois Rouaix, INRIA Rocquencourt         *)
-(*   Ported to Objective Caml by John Malecki and Xavier Leroy         *)
+(*   Ported to OCaml by John Malecki and Xavier Leroy                  *)
 (*                                                                     *)
 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
 (*  en Automatique.  All rights reserved.  This file is distributed    *)
@@ -12,8 +12,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: profiling.mli 6824 2005-03-24 17:20:54Z doligez $ *)
-
 (* Run-time library for profiled programs *)
 
 val counters: (string * (string * int array)) list ref;;
diff -Nru ocaml-3.12.1/tools/read_cmt.ml ocaml-4.01.0/tools/read_cmt.ml
--- ocaml-3.12.1/tools/read_cmt.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/tools/read_cmt.ml	2012-08-01 12:38:51.000000000 +0000
@@ -0,0 +1,80 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                  Fabrice Le Fessant, INRIA Saclay                   *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+let gen_annot = ref false
+let gen_ml = ref false
+let print_info_arg = ref false
+let target_filename = ref None
+
+let arg_list = [
+  "-o", Arg.String (fun s ->
+    target_filename := Some s
+  ), " FILE (or -) : dump to file FILE (or stdout)";
+  "-annot", Arg.Set gen_annot, " : generate the corresponding .annot file";
+  "-src", Arg.Set gen_ml, " : generate an equivalent of the original source file (without comments) from a .cmt or a .cmti file";
+  "-info", Arg.Set print_info_arg, " : print information on the file";
+  ]
+
+let arg_usage = "read_cmt [OPTIONS] FILE.cmt : read FILE.cmt and print related information"
+
+let print_info cmt =
+  let open Cmt_format in
+      Printf.printf "module name: %s\n" cmt.cmt_modname;
+      begin match cmt.cmt_annots with
+          Packed (_, list) -> Printf.printf "pack: %s\n" (String.concat " " list)
+        | Implementation _ -> Printf.printf "kind: implementation\n"
+        | Interface _ -> Printf.printf "kind: interface\n"
+        | Partial_implementation _ -> Printf.printf "kind: implementation with errors\n"
+        | Partial_interface _ -> Printf.printf "kind: interface with errors\n"
+      end;
+      Printf.printf "command: %s\n" (String.concat " " (Array.to_list cmt.cmt_args));
+      begin match cmt.cmt_sourcefile with
+          None -> ()
+        | Some name ->
+          Printf.printf "sourcefile: %s\n" name;
+      end;
+      Printf.printf "build directory: %s\n" cmt.cmt_builddir;
+      List.iter (fun dir -> Printf.printf "load path: %s\n%!" dir) cmt.cmt_loadpath;
+      begin
+      match cmt.cmt_source_digest with
+          None -> ()
+        | Some digest -> Printf.printf "source digest: %s\n" (Digest.to_hex digest);
+      end;
+      begin
+      match cmt.cmt_interface_digest with
+          None -> ()
+        | Some digest -> Printf.printf "interface digest: %s\n" (Digest.to_hex digest);
+      end;
+      List.iter (fun (name, digest) ->
+        Printf.printf "import: %s %s\n" name (Digest.to_hex digest);
+      ) (List.sort compare cmt.cmt_imports);
+      Printf.printf "%!";
+      ()
+
+let _ =
+  Clflags.annotations := true;
+
+  Arg.parse arg_list  (fun filename ->
+    if
+      Filename.check_suffix filename ".cmt" ||
+        Filename.check_suffix filename ".cmti"
+    then begin
+      (*      init_path(); *)
+      let cmt = Cmt_format.read_cmt filename in
+      if !gen_annot then Cmt2annot.gen_annot !target_filename filename cmt;
+      if !gen_ml then Cmt2annot.gen_ml !target_filename filename cmt;
+      if !print_info_arg || not (!gen_ml || !gen_annot) then print_info cmt;
+    end else begin
+      Printf.fprintf stderr "Error: the file must have an extension in .cmt or .cmti.\n%!";
+      Arg.usage arg_list arg_usage
+    end
+  ) arg_usage
diff -Nru ocaml-3.12.1/tools/scrapelabels.ml ocaml-4.01.0/tools/scrapelabels.ml
--- ocaml-3.12.1/tools/scrapelabels.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/tools/scrapelabels.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*              Jacques Garrigue, Kyoto University RIMS                *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: scrapelabels.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 open StdLabels
 open Lexer301
 
diff -Nru ocaml-3.12.1/tools/setignore ocaml-4.01.0/tools/setignore
--- ocaml-3.12.1/tools/setignore	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/tools/setignore	2013-05-07 11:26:57.000000000 +0000
@@ -0,0 +1,44 @@
+#!/bin/sh
+
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#          Damien Doligez, projet Gallium, INRIA Rocquencourt           #
+#                                                                       #
+#   Copyright 2011 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+(
+  cat < () | Some x -> f x
+
+let structure sub str =
+  List.iter (sub # structure_item) str.str_items
+
+let structure_item sub x =
+  match x.str_desc with
+  | Tstr_eval exp -> sub # expression exp
+  | Tstr_value (rec_flag, list) -> sub # bindings (rec_flag, list)
+  | Tstr_primitive (_id, _, v) -> sub # value_description v
+  | Tstr_type list ->
+      List.iter (fun (_id, _, decl) -> sub # type_declaration decl) list
+  | Tstr_exception (_id, _, decl) -> sub # exception_declaration decl
+  | Tstr_exn_rebind (_id, _, _p, _) -> ()
+  | Tstr_module (_id, _, mexpr) -> sub # module_expr mexpr
+  | Tstr_recmodule list ->
+      List.iter
+        (fun (_id, _, mtype, mexpr) ->
+          sub # module_type mtype;
+          sub # module_expr mexpr
+        )
+        list
+  | Tstr_modtype (_id, _, mtype) -> sub # module_type mtype
+  | Tstr_open _ -> ()
+  | Tstr_class list ->
+      List.iter (fun (ci, _, _) -> sub # class_expr ci.ci_expr) list
+  | Tstr_class_type list ->
+      List.iter (fun (_id, _, ct) -> sub # class_type ct.ci_expr) list
+  | Tstr_include (mexpr, _) -> sub # module_expr mexpr
+
+let value_description sub x =
+  sub # core_type x.val_desc
+
+let type_declaration sub decl =
+  List.iter
+    (fun (ct1, ct2, _loc) -> sub # core_type ct1; sub # core_type ct2)
+    decl.typ_cstrs;
+  begin match decl.typ_kind with
+  | Ttype_abstract -> ()
+  | Ttype_variant list ->
+      List.iter (fun (_s, _, cts, _loc) -> List.iter (sub # core_type) cts) list
+  | Ttype_record list ->
+      List.iter (fun (_s, _, _mut, ct, _loc) -> sub # core_type ct) list
+  end;
+  opt (sub # core_type) decl.typ_manifest
+
+let exception_declaration sub decl =
+  List.iter (sub # core_type) decl.exn_params
+
+let pattern sub pat =
+  let extra = function
+    | Tpat_type _
+    | Tpat_unpack -> ()
+    | Tpat_constraint ct -> sub # core_type ct
+  in
+  List.iter (fun (c, _) -> extra c) pat.pat_extra;
+  match pat.pat_desc with
+  | Tpat_any
+  | Tpat_var _
+  | Tpat_constant _ -> ()
+  | Tpat_tuple l
+  | Tpat_construct (_, _, l, _) -> List.iter (sub # pattern) l
+  | Tpat_variant (_, po, _) -> opt (sub # pattern) po
+  | Tpat_record (l, _) -> List.iter (fun (_, _, pat) -> sub # pattern pat) l
+  | Tpat_array l -> List.iter (sub # pattern) l
+  | Tpat_or (p1, p2, _) -> sub # pattern p1; sub # pattern p2
+  | Tpat_alias (p, _, _)
+  | Tpat_lazy p -> sub # pattern p
+
+let expression sub exp =
+  let extra = function
+    | Texp_constraint (cty1, cty2) ->
+        opt (sub # core_type) cty1; opt (sub # core_type) cty2
+    | Texp_open _
+    | Texp_newtype _ -> ()
+    | Texp_poly cto -> opt (sub # core_type) cto
+  in
+  List.iter (function (c, _) -> extra c) exp.exp_extra;
+  match exp.exp_desc with
+  | Texp_ident _
+  | Texp_constant _ -> ()
+  | Texp_let (rec_flag, list, exp) ->
+      sub # bindings (rec_flag, list);
+      sub # expression exp
+  | Texp_function (_, cases, _) ->
+      sub # bindings (Nonrecursive, cases)
+  | Texp_apply (exp, list) ->
+      sub # expression exp;
+      List.iter (fun (_, expo, _) -> opt (sub # expression) expo) list
+  | Texp_match (exp, list, _) ->
+      sub # expression exp;
+      sub # bindings (Nonrecursive, list)
+  | Texp_try (exp, list) ->
+      sub # expression exp;
+      sub # bindings (Nonrecursive, list)
+  | Texp_tuple list ->
+      List.iter (sub # expression) list
+  | Texp_construct (_, _, args, _) ->
+      List.iter (sub # expression) args
+  | Texp_variant (_, expo) ->
+      opt (sub # expression) expo
+  | Texp_record (list, expo) ->
+      List.iter (fun (_, _, exp) -> sub # expression exp) list;
+      opt (sub # expression) expo
+  | Texp_field (exp, _, _label) ->
+      sub # expression exp
+  | Texp_setfield (exp1, _, _label, exp2) ->
+      sub # expression exp1;
+      sub # expression exp2
+  | Texp_array list ->
+      List.iter (sub # expression) list
+  | Texp_ifthenelse (exp1, exp2, expo) ->
+      sub # expression exp1;
+      sub # expression exp2;
+      opt (sub # expression) expo
+  | Texp_sequence (exp1, exp2) ->
+      sub # expression exp1;
+      sub # expression exp2
+  | Texp_while (exp1, exp2) ->
+      sub # expression exp1;
+      sub # expression exp2
+  | Texp_for (_id, _, exp1, exp2, _dir, exp3) ->
+      sub # expression exp1;
+      sub # expression exp2;
+      sub # expression exp3
+  | Texp_when (exp1, exp2) ->
+      sub # expression exp1;
+      sub # expression exp2
+  | Texp_send (exp, _meth, expo) ->
+      sub # expression exp;
+      opt (sub # expression) expo
+  | Texp_new (_path, _, _) -> ()
+  | Texp_instvar (_, _path, _) -> ()
+  | Texp_setinstvar (_, _, _, exp) ->
+      sub # expression exp
+  | Texp_override (_, list) ->
+      List.iter (fun (_path, _, exp) -> sub # expression exp) list
+  | Texp_letmodule (_id, _, mexpr, exp) ->
+      sub # module_expr mexpr;
+      sub # expression exp
+  | Texp_assert exp -> sub # expression exp
+  | Texp_assertfalse -> ()
+  | Texp_lazy exp -> sub # expression exp
+  | Texp_object (cl, _) ->
+      sub # class_structure cl
+  | Texp_pack (mexpr) ->
+      sub # module_expr mexpr
+
+
+let package_type sub pack =
+  List.iter (fun (_s, ct) -> sub # core_type ct) pack.pack_fields
+
+let signature sub sg =
+  List.iter (sub # signature_item) sg.sig_items
+
+let signature_item sub item =
+  match item.sig_desc with
+  | Tsig_value (_id, _, v) ->
+      sub # value_description v
+  | Tsig_type list ->
+      List.iter (fun (_id, _, decl) -> sub # type_declaration decl) list
+  | Tsig_exception (_id, _, decl) ->
+      sub # exception_declaration decl
+  | Tsig_module (_id, _, mtype) ->
+      sub # module_type mtype
+  | Tsig_recmodule list ->
+      List.iter (fun (_id, _, mtype) -> sub # module_type mtype) list
+  | Tsig_modtype (_id, _, mdecl) ->
+      sub # modtype_declaration mdecl
+  | Tsig_open _ -> ()
+  | Tsig_include (mty,_) -> sub # module_type mty
+  | Tsig_class list ->
+      List.iter (sub # class_description) list
+  | Tsig_class_type list ->
+      List.iter (sub # class_type_declaration) list
+
+let modtype_declaration sub mdecl =
+  match mdecl with
+  | Tmodtype_abstract -> ()
+  | Tmodtype_manifest mtype -> sub # module_type mtype
+
+let class_description sub cd =
+  sub # class_type cd.ci_expr
+
+let class_type_declaration sub cd =
+  sub # class_type cd.ci_expr
+
+let module_type sub mty =
+  match mty.mty_desc with
+  | Tmty_ident (_path, _) -> ()
+  | Tmty_signature sg -> sub # signature sg
+  | Tmty_functor (_id, _, mtype1, mtype2) ->
+      sub # module_type mtype1; sub # module_type mtype2
+  | Tmty_with (mtype, list) ->
+      sub # module_type mtype;
+      List.iter (fun (_, _, withc) -> sub # with_constraint withc) list
+  | Tmty_typeof mexpr ->
+      sub # module_expr mexpr
+
+let with_constraint sub cstr =
+  match cstr with
+  | Twith_type decl -> sub # type_declaration decl
+  | Twith_module _ -> ()
+  | Twith_typesubst decl -> sub # type_declaration decl
+  | Twith_modsubst _ -> ()
+
+let module_expr sub mexpr =
+  match mexpr.mod_desc with
+  | Tmod_ident (_p, _) -> ()
+  | Tmod_structure st -> sub # structure st
+  | Tmod_functor (_id, _, mtype, mexpr) ->
+      sub # module_type mtype;
+      sub # module_expr mexpr
+  | Tmod_apply (mexp1, mexp2, _) ->
+      sub # module_expr mexp1;
+      sub # module_expr mexp2
+  | Tmod_constraint (mexpr, _, Tmodtype_implicit, _ ) ->
+      sub # module_expr mexpr
+  | Tmod_constraint (mexpr, _, Tmodtype_explicit mtype, _) ->
+      sub # module_expr mexpr;
+      sub # module_type mtype
+  | Tmod_unpack (exp, _mty) ->
+      sub # expression exp
+(*          sub # module_type mty *)
+
+let class_expr sub cexpr =
+  match cexpr.cl_desc with
+  | Tcl_constraint (cl, None, _, _, _ ) ->
+      sub # class_expr cl;
+  | Tcl_structure clstr -> sub # class_structure clstr
+  | Tcl_fun (_label, pat, priv, cl, _partial) ->
+      sub # pattern pat;
+      List.iter (fun (_id, _, exp) -> sub # expression exp) priv;
+      sub # class_expr cl
+  | Tcl_apply (cl, args) ->
+      sub # class_expr cl;
+      List.iter (fun (_label, expo, _) -> opt (sub # expression) expo) args
+  | Tcl_let (rec_flat, bindings, ivars, cl) ->
+      sub # bindings (rec_flat, bindings);
+      List.iter (fun (_id, _, exp) -> sub # expression exp) ivars;
+      sub # class_expr cl
+  | Tcl_constraint (cl, Some clty, _vals, _meths, _concrs) ->
+      sub # class_expr cl;
+      sub # class_type clty
+  | Tcl_ident (_, _, tyl) ->
+      List.iter (sub # core_type) tyl
+
+let class_type sub ct =
+  match ct.cltyp_desc with
+  | Tcty_signature csg -> sub # class_signature csg
+  | Tcty_constr (_path, _, list) -> List.iter (sub # core_type) list
+  | Tcty_fun (_label, ct, cl) ->
+      sub # core_type ct;
+      sub # class_type cl
+
+let class_signature sub cs =
+  sub # core_type cs.csig_self;
+  List.iter (sub # class_type_field) cs.csig_fields
+
+let class_type_field sub ctf =
+  match ctf.ctf_desc with
+  | Tctf_inher ct -> sub # class_type ct
+  | Tctf_val (_s, _mut, _virt, ct) ->
+      sub # core_type ct
+  | Tctf_virt  (_s, _priv, ct) ->
+      sub # core_type ct
+  | Tctf_meth  (_s, _priv, ct) ->
+      sub # core_type ct
+  | Tctf_cstr  (ct1, ct2) ->
+      sub # core_type ct1;
+      sub # core_type ct2
+
+let core_type sub ct =
+  match ct.ctyp_desc with
+  | Ttyp_any -> ()
+  | Ttyp_var _s -> ()
+  | Ttyp_arrow (_label, ct1, ct2) ->
+      sub # core_type ct1;
+      sub # core_type ct2
+  | Ttyp_tuple list -> List.iter (sub # core_type) list
+  | Ttyp_constr (_path, _, list) ->
+      List.iter (sub # core_type) list
+  | Ttyp_object list ->
+      List.iter (sub # core_field_type) list
+  | Ttyp_class (_path, _, list, _labels) ->
+      List.iter (sub # core_type) list
+  | Ttyp_alias (ct, _s) ->
+      sub # core_type ct
+  | Ttyp_variant (list, _bool, _labels) ->
+      List.iter (sub # row_field) list
+  | Ttyp_poly (_list, ct) -> sub # core_type ct
+  | Ttyp_package pack -> sub # package_type pack
+
+let core_field_type sub cft =
+  match cft.field_desc with
+  | Tcfield_var -> ()
+  | Tcfield (_s, ct) -> sub # core_type ct
+
+let class_structure sub cs =
+  sub # pattern cs.cstr_pat;
+  List.iter (sub # class_field) cs.cstr_fields
+
+let row_field sub rf =
+  match rf with
+  | Ttag (_label, _bool, list) -> List.iter (sub # core_type) list
+  | Tinherit ct -> sub # core_type ct
+
+let class_field sub cf =
+  match cf.cf_desc with
+  | Tcf_inher (_ovf, cl, _super, _vals, _meths) ->
+      sub # class_expr cl
+  | Tcf_constr (cty, cty') ->
+      sub # core_type cty;
+      sub # core_type cty'
+  | Tcf_val (_lab, _, _, _mut, Tcfk_virtual cty, _override) ->
+      sub # core_type cty
+  | Tcf_val (_lab, _, _, _mut, Tcfk_concrete exp, _override) ->
+      sub # expression exp
+  | Tcf_meth (_lab, _, _priv, Tcfk_virtual cty, _override) ->
+      sub # core_type cty
+  | Tcf_meth (_lab, _, _priv, Tcfk_concrete exp, _override) ->
+      sub # expression exp
+  | Tcf_init exp ->
+      sub # expression exp
+
+let bindings sub (_rec_flag, list) =
+  List.iter (sub # binding) list
+
+let binding sub (pat, exp) =
+  sub # pattern pat;
+  sub # expression exp
+
+class iter = object(this)
+  method binding = binding this
+  method bindings = bindings this
+  method class_description = class_description this
+  method class_expr = class_expr this
+  method class_field = class_field this
+  method class_signature = class_signature this
+  method class_structure = class_structure this
+  method class_type = class_type this
+  method class_type_declaration = class_type_declaration this
+  method class_type_field = class_type_field this
+  method core_field_type = core_field_type this
+  method core_type = core_type this
+  method exception_declaration = exception_declaration this
+  method expression = expression this
+  method modtype_declaration = modtype_declaration this
+  method module_expr = module_expr this
+  method module_type = module_type this
+  method package_type = package_type this
+  method pattern = pattern this
+  method row_field = row_field this
+  method signature = signature this
+  method signature_item = signature_item this
+  method structure = structure this
+  method structure_item = structure_item this
+  method type_declaration = type_declaration this
+  method value_description = value_description this
+  method with_constraint = with_constraint this
+end
diff -Nru ocaml-3.12.1/tools/tast_iter.mli ocaml-4.01.0/tools/tast_iter.mli
--- ocaml-3.12.1/tools/tast_iter.mli	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/tools/tast_iter.mli	2012-11-08 17:21:27.000000000 +0000
@@ -0,0 +1,80 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+open Asttypes
+open Typedtree
+
+class iter: object
+  method binding: (pattern * expression) -> unit
+  method bindings: (rec_flag * (pattern * expression) list) -> unit
+  method class_description: class_description -> unit
+  method class_expr: class_expr -> unit
+  method class_field: class_field -> unit
+  method class_signature: class_signature -> unit
+  method class_structure: class_structure -> unit
+  method class_type: class_type -> unit
+  method class_type_declaration: class_type_declaration -> unit
+  method class_type_field: class_type_field -> unit
+  method core_field_type: core_field_type -> unit
+  method core_type: core_type -> unit
+  method exception_declaration: exception_declaration -> unit
+  method expression: expression -> unit
+  method modtype_declaration: modtype_declaration -> unit
+  method module_expr: module_expr -> unit
+  method module_type: module_type -> unit
+  method package_type: package_type -> unit
+  method pattern: pattern -> unit
+  method row_field: row_field -> unit
+  method signature: signature -> unit
+  method signature_item: signature_item -> unit
+  method structure: structure -> unit
+  method structure_item: structure_item -> unit
+  method type_declaration: type_declaration -> unit
+  method value_description: value_description -> unit
+  method with_constraint: with_constraint -> unit
+end
+(** Recursive iterator class. By inheriting from it and
+    overriding selected methods, it is possible to implement
+    custom behavior for specific kinds of nodes. *)
+
+(** {2 One-level iterators} *)
+
+(** The following functions apply the provided iterator to each
+    sub-component of the argument. *)
+
+val binding: iter -> (pattern * expression) -> unit
+val bindings: iter -> (rec_flag * (pattern * expression) list) -> unit
+val class_description: iter -> class_description -> unit
+val class_expr: iter -> class_expr -> unit
+val class_field: iter -> class_field -> unit
+val class_signature: iter -> class_signature -> unit
+val class_structure: iter -> class_structure -> unit
+val class_type: iter -> class_type -> unit
+val class_type_declaration: iter -> class_type_declaration -> unit
+val class_type_field: iter -> class_type_field -> unit
+val core_field_type: iter -> core_field_type -> unit
+val core_type: iter -> core_type -> unit
+val exception_declaration: iter -> exception_declaration -> unit
+val expression: iter -> expression -> unit
+val modtype_declaration: iter -> modtype_declaration -> unit
+val module_expr: iter -> module_expr -> unit
+val module_type: iter -> module_type -> unit
+val package_type: iter -> package_type -> unit
+val pattern: iter -> pattern -> unit
+val row_field: iter -> row_field -> unit
+val signature: iter -> signature -> unit
+val signature_item: iter -> signature_item -> unit
+val structure: iter -> structure -> unit
+val structure_item: iter -> structure_item -> unit
+val type_declaration: iter -> type_declaration -> unit
+val value_description: iter -> value_description -> unit
+val with_constraint: iter -> with_constraint -> unit
diff -Nru ocaml-3.12.1/tools/untypeast.ml ocaml-4.01.0/tools/untypeast.ml
--- ocaml-3.12.1/tools/untypeast.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/tools/untypeast.ml	2013-07-23 14:48:47.000000000 +0000
@@ -0,0 +1,549 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                OCaml                                   *)
+(*                                                                        *)
+(*    Thomas Gazagnaire (OCamlPro), Fabrice Le Fessant (INRIA Saclay)     *)
+(*                                                                        *)
+(*   Copyright 2007 Institut National de Recherche en Informatique et     *)
+(*   en Automatique.  All rights reserved.  This file is distributed      *)
+(*   under the terms of the Q Public License version 1.0.                 *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Asttypes
+open Typedtree
+open Parsetree
+
+(*
+Some notes:
+
+   * For Pexp_function, we cannot go back to the exact original version
+   when there is a default argument, because the default argument is
+   translated in the typer. The code, if printed, will not be parsable because
+   new generated identifiers are not correct.
+
+   * For Pexp_apply, it is unclear whether arguments are reordered, especially
+    when there are optional arguments.
+
+  * TODO: check Ttype_variant -> Ptype_variant (stub None)
+
+*)
+
+
+let rec lident_of_path path =
+  match path with
+      Path.Pident id -> Longident.Lident (Ident.name id)
+    | Path.Pdot (p, s, _) -> Longident.Ldot (lident_of_path p, s)
+    | Path.Papply (p1, p2) ->
+        Longident.Lapply (lident_of_path p1, lident_of_path p2)
+
+let rec untype_structure str =
+  List.map untype_structure_item str.str_items
+
+and untype_structure_item item =
+  let desc =
+    match item.str_desc with
+      Tstr_eval exp -> Pstr_eval (untype_expression exp)
+    | Tstr_value (rec_flag, list) ->
+        Pstr_value (rec_flag, List.map (fun (pat, exp) ->
+              untype_pattern pat, untype_expression exp) list)
+    | Tstr_primitive (_id, name, v) ->
+        Pstr_primitive (name, untype_value_description v)
+    | Tstr_type list ->
+        Pstr_type (List.map (fun (_id, name, decl) ->
+              name, untype_type_declaration decl) list)
+    | Tstr_exception (_id, name, decl) ->
+        Pstr_exception (name, untype_exception_declaration decl)
+    | Tstr_exn_rebind (_id, name, _p, lid) ->
+        Pstr_exn_rebind (name, lid)
+    | Tstr_module (_id, name, mexpr) ->
+        Pstr_module (name, untype_module_expr mexpr)
+    | Tstr_recmodule list ->
+        Pstr_recmodule (List.map (fun (_id, name, mtype, mexpr) ->
+              name, untype_module_type mtype,
+              untype_module_expr mexpr) list)
+    | Tstr_modtype (_id, name, mtype) ->
+        Pstr_modtype (name, untype_module_type mtype)
+    | Tstr_open (ovf, _path, lid) -> Pstr_open (ovf, lid)
+    | Tstr_class list ->
+        Pstr_class (List.map (fun (ci, _, _) ->
+              { pci_virt = ci.ci_virt;
+                pci_params = ci.ci_params;
+                pci_name = ci.ci_id_name;
+                pci_expr = untype_class_expr ci.ci_expr;
+                pci_variance = ci.ci_variance;
+                pci_loc = ci.ci_loc;
+              }
+          ) list)
+    | Tstr_class_type list ->
+        Pstr_class_type (List.map (fun (_id, _name, ct) ->
+              {
+                pci_virt = ct.ci_virt;
+                pci_params = ct.ci_params;
+                pci_name = ct.ci_id_name;
+                pci_expr = untype_class_type ct.ci_expr;
+                pci_variance = ct.ci_variance;
+                pci_loc = ct.ci_loc;
+              }
+          ) list)
+    | Tstr_include (mexpr, _) ->
+        Pstr_include (untype_module_expr mexpr)
+  in
+  { pstr_desc = desc; pstr_loc = item.str_loc; }
+
+and untype_value_description v =
+  {
+    pval_prim = v.val_prim;
+    pval_type = untype_core_type v.val_desc;
+    pval_loc = v.val_loc }
+
+and untype_type_declaration decl =
+  {
+    ptype_params = decl.typ_params;
+    ptype_cstrs = List.map (fun (ct1, ct2, loc) ->
+        (untype_core_type ct1,
+          untype_core_type ct2, loc)
+    ) decl.typ_cstrs;
+    ptype_kind = (match decl.typ_kind with
+        Ttype_abstract -> Ptype_abstract
+      | Ttype_variant list ->
+          Ptype_variant (List.map (fun (_s, name, cts, loc) ->
+                (name, List.map untype_core_type cts, None, loc)
+            ) list)
+      | Ttype_record list ->
+          Ptype_record (List.map (fun (_s, name, mut, ct, loc) ->
+                (name, mut, untype_core_type ct, loc)
+            ) list)
+    );
+    ptype_private = decl.typ_private;
+    ptype_manifest = (match decl.typ_manifest with
+        None -> None
+      | Some ct -> Some (untype_core_type ct));
+    ptype_variance = decl.typ_variance;
+    ptype_loc = decl.typ_loc;
+  }
+
+and untype_exception_declaration decl =
+  List.map untype_core_type decl.exn_params
+
+and untype_pattern pat =
+  let desc =
+  match pat with
+      { pat_extra=[Tpat_unpack, _]; pat_desc = Tpat_var (_,name); _ } ->
+        Ppat_unpack name
+    | { pat_extra=[Tpat_type (_path, lid), _]; _ } -> Ppat_type lid
+    | { pat_extra= (Tpat_constraint ct, _) :: rem; _ } ->
+        Ppat_constraint (untype_pattern { pat with pat_extra=rem },
+                         untype_core_type ct)
+    | _ ->
+    match pat.pat_desc with
+      Tpat_any -> Ppat_any
+    | Tpat_var (id, name) ->
+        begin
+          match (Ident.name id).[0] with
+            'A'..'Z' ->
+              Ppat_unpack name
+          | _ ->
+              Ppat_var name
+        end
+    | Tpat_alias (pat, _id, name) ->
+        Ppat_alias (untype_pattern pat, name)
+    | Tpat_constant cst -> Ppat_constant cst
+    | Tpat_tuple list ->
+        Ppat_tuple (List.map untype_pattern list)
+    | Tpat_construct (lid, _, args, explicit_arity) ->
+        Ppat_construct (lid,
+          (match args with
+              [] -> None
+            | [arg] -> Some (untype_pattern arg)
+            | args -> Some
+                  { ppat_desc = Ppat_tuple (List.map untype_pattern args);
+                  ppat_loc = pat.pat_loc; }
+          ), explicit_arity)
+    | Tpat_variant (label, pato, _) ->
+        Ppat_variant (label, match pato with
+            None -> None
+          | Some pat -> Some (untype_pattern pat))
+    | Tpat_record (list, closed) ->
+        Ppat_record (List.map (fun (lid, _, pat) ->
+              lid, untype_pattern pat) list, closed)
+    | Tpat_array list -> Ppat_array (List.map untype_pattern list)
+    | Tpat_or (p1, p2, _) -> Ppat_or (untype_pattern p1, untype_pattern p2)
+    | Tpat_lazy p -> Ppat_lazy (untype_pattern p)
+  in
+  {
+    ppat_desc = desc;
+    ppat_loc = pat.pat_loc;
+  }
+
+and option f x = match x with None -> None | Some e -> Some (f e)
+
+and untype_extra (extra, loc) sexp =
+  let desc =
+    match extra with
+      Texp_constraint (cty1, cty2) ->
+        Pexp_constraint (sexp,
+                         option untype_core_type cty1,
+                         option untype_core_type cty2)
+    | Texp_open (ovf, _path, lid, _) -> Pexp_open (ovf, lid, sexp)
+    | Texp_poly cto -> Pexp_poly (sexp, option untype_core_type cto)
+    | Texp_newtype s -> Pexp_newtype (s, sexp)
+  in
+  { pexp_desc = desc;
+    pexp_loc = loc }
+
+and untype_expression exp =
+  let desc =
+    match exp.exp_desc with
+      Texp_ident (_path, lid, _) -> Pexp_ident (lid)
+    | Texp_constant cst -> Pexp_constant cst
+    | Texp_let (rec_flag, list, exp) ->
+        Pexp_let (rec_flag,
+          List.map (fun (pat, exp) ->
+              untype_pattern pat, untype_expression exp) list,
+          untype_expression exp)
+    | Texp_function (label, cases, _) ->
+        Pexp_function (label, None,
+          List.map (fun (pat, exp) ->
+              (untype_pattern pat, untype_expression exp)) cases)
+    | Texp_apply (exp, list) ->
+        Pexp_apply (untype_expression exp,
+          List.fold_right (fun (label, expo, _) list ->
+              match expo with
+                None -> list
+              | Some exp -> (label, untype_expression exp) :: list
+          ) list [])
+    | Texp_match (exp, list, _) ->
+        Pexp_match (untype_expression exp,
+          List.map (fun (pat, exp) ->
+              untype_pattern pat, untype_expression exp) list)
+    | Texp_try (exp, list) ->
+        Pexp_try (untype_expression exp,
+          List.map (fun (pat, exp) ->
+              untype_pattern pat, untype_expression exp) list)
+    | Texp_tuple list ->
+        Pexp_tuple (List.map untype_expression list)
+    | Texp_construct (lid, _, args, explicit_arity) ->
+        Pexp_construct (lid,
+          (match args with
+              [] -> None
+          | [ arg ] -> Some (untype_expression arg)
+          | args -> Some
+            { pexp_desc = Pexp_tuple (List.map untype_expression args);
+              pexp_loc = exp.exp_loc; }
+          ), explicit_arity)
+    | Texp_variant (label, expo) ->
+        Pexp_variant (label, match expo with
+            None -> None
+          | Some exp -> Some (untype_expression exp))
+    | Texp_record (list, expo) ->
+        Pexp_record (List.map (fun (lid, _, exp) ->
+              lid, untype_expression exp
+          ) list,
+          match expo with
+            None -> None
+          | Some exp -> Some (untype_expression exp))
+    | Texp_field (exp, lid, _label) ->
+        Pexp_field (untype_expression exp, lid)
+    | Texp_setfield (exp1, lid, _label, exp2) ->
+        Pexp_setfield (untype_expression exp1, lid,
+          untype_expression exp2)
+    | Texp_array list ->
+        Pexp_array (List.map untype_expression list)
+    | Texp_ifthenelse (exp1, exp2, expo) ->
+        Pexp_ifthenelse (untype_expression exp1,
+          untype_expression exp2,
+          match expo with
+            None -> None
+          | Some exp -> Some (untype_expression exp))
+    | Texp_sequence (exp1, exp2) ->
+        Pexp_sequence (untype_expression exp1, untype_expression exp2)
+    | Texp_while (exp1, exp2) ->
+        Pexp_while (untype_expression exp1, untype_expression exp2)
+    | Texp_for (_id, name, exp1, exp2, dir, exp3) ->
+        Pexp_for (name,
+          untype_expression exp1, untype_expression exp2,
+          dir, untype_expression exp3)
+    | Texp_when (exp1, exp2) ->
+        Pexp_when (untype_expression exp1, untype_expression exp2)
+    | Texp_send (exp, meth, _) ->
+        Pexp_send (untype_expression exp, match meth with
+            Tmeth_name name -> name
+          | Tmeth_val id -> Ident.name id)
+    | Texp_new (_path, lid, _) -> Pexp_new (lid)
+    | Texp_instvar (_, path, name) ->
+      Pexp_ident ({name with txt = lident_of_path path})
+    | Texp_setinstvar (_, _path, lid, exp) ->
+        Pexp_setinstvar (lid, untype_expression exp)
+    | Texp_override (_, list) ->
+        Pexp_override (List.map (fun (_path, lid, exp) ->
+              lid, untype_expression exp
+          ) list)
+    | Texp_letmodule (_id, name, mexpr, exp) ->
+        Pexp_letmodule (name, untype_module_expr mexpr,
+          untype_expression exp)
+    | Texp_assert exp -> Pexp_assert (untype_expression exp)
+    | Texp_assertfalse -> Pexp_assertfalse
+    | Texp_lazy exp -> Pexp_lazy (untype_expression exp)
+    | Texp_object (cl, _) ->
+        Pexp_object (untype_class_structure cl)
+    | Texp_pack (mexpr) ->
+        Pexp_pack (untype_module_expr mexpr)
+  in
+  List.fold_right untype_extra exp.exp_extra
+    { pexp_loc = exp.exp_loc;
+      pexp_desc = desc }
+
+and untype_package_type pack =
+  (pack.pack_txt,
+    List.map (fun (s, ct) ->
+        (s, untype_core_type ct)) pack.pack_fields)
+
+and untype_signature sg =
+  List.map untype_signature_item sg.sig_items
+
+and untype_signature_item item =
+  let desc =
+    match item.sig_desc with
+      Tsig_value (_id, name, v) ->
+        Psig_value (name, untype_value_description v)
+    | Tsig_type list ->
+        Psig_type (List.map (fun (_id, name, decl) ->
+              name, untype_type_declaration decl
+          ) list)
+    | Tsig_exception (_id, name, decl) ->
+        Psig_exception (name, untype_exception_declaration decl)
+    | Tsig_module (_id, name, mtype) ->
+        Psig_module (name, untype_module_type mtype)
+    | Tsig_recmodule list ->
+        Psig_recmodule (List.map (fun (_id, name, mtype) ->
+              name, untype_module_type mtype) list)
+    | Tsig_modtype (_id, name, mdecl) ->
+        Psig_modtype (name, untype_modtype_declaration mdecl)
+    | Tsig_open (ovf, _path, lid) -> Psig_open (ovf, lid)
+    | Tsig_include (mty, _) -> Psig_include (untype_module_type mty)
+    | Tsig_class list ->
+        Psig_class (List.map untype_class_description list)
+    | Tsig_class_type list ->
+        Psig_class_type (List.map untype_class_type_declaration list)
+  in
+  { psig_desc = desc;
+    psig_loc = item.sig_loc;
+  }
+
+and untype_modtype_declaration mdecl =
+  match mdecl with
+    Tmodtype_abstract -> Pmodtype_abstract
+  | Tmodtype_manifest mtype -> Pmodtype_manifest (untype_module_type mtype)
+
+and untype_class_description cd =
+  {
+    pci_virt = cd.ci_virt;
+    pci_params = cd.ci_params;
+    pci_name = cd.ci_id_name;
+    pci_expr = untype_class_type cd.ci_expr;
+    pci_variance = cd.ci_variance;
+    pci_loc = cd.ci_loc;
+  }
+
+and untype_class_type_declaration cd =
+  {
+    pci_virt = cd.ci_virt;
+    pci_params = cd.ci_params;
+    pci_name = cd.ci_id_name;
+    pci_expr = untype_class_type cd.ci_expr;
+    pci_variance = cd.ci_variance;
+    pci_loc = cd.ci_loc;
+  }
+
+and untype_module_type mty =
+  let desc = match mty.mty_desc with
+      Tmty_ident (_path, lid) -> Pmty_ident (lid)
+    | Tmty_signature sg -> Pmty_signature (untype_signature sg)
+    | Tmty_functor (_id, name, mtype1, mtype2) ->
+        Pmty_functor (name, untype_module_type mtype1,
+          untype_module_type mtype2)
+    | Tmty_with (mtype, list) ->
+        Pmty_with (untype_module_type mtype,
+          List.map (fun (_path, lid, withc) ->
+              lid, untype_with_constraint withc
+          ) list)
+    | Tmty_typeof mexpr ->
+        Pmty_typeof (untype_module_expr mexpr)
+  in
+  {
+    pmty_desc = desc;
+    pmty_loc = mty.mty_loc;
+  }
+
+and untype_with_constraint cstr =
+  match cstr with
+    Twith_type decl -> Pwith_type (untype_type_declaration decl)
+  | Twith_module (_path, lid) -> Pwith_module (lid)
+  | Twith_typesubst decl -> Pwith_typesubst (untype_type_declaration decl)
+  | Twith_modsubst (_path, lid) -> Pwith_modsubst (lid)
+
+and untype_module_expr mexpr =
+  match mexpr.mod_desc with
+    Tmod_constraint (m, _, Tmodtype_implicit, _ ) ->
+      untype_module_expr m
+  | _ ->
+      let desc = match mexpr.mod_desc with
+          Tmod_ident (_p, lid) -> Pmod_ident (lid)
+        | Tmod_structure st -> Pmod_structure (untype_structure st)
+        | Tmod_functor (_id, name, mtype, mexpr) ->
+            Pmod_functor (name, untype_module_type mtype,
+              untype_module_expr mexpr)
+        | Tmod_apply (mexp1, mexp2, _) ->
+            Pmod_apply (untype_module_expr mexp1, untype_module_expr mexp2)
+        | Tmod_constraint (mexpr, _, Tmodtype_explicit mtype, _) ->
+            Pmod_constraint (untype_module_expr mexpr,
+              untype_module_type mtype)
+        | Tmod_constraint (_mexpr, _, Tmodtype_implicit, _) ->
+            assert false
+        | Tmod_unpack (exp, _pack) ->
+        Pmod_unpack (untype_expression exp)
+        (* TODO , untype_package_type pack) *)
+
+  in
+  {
+    pmod_desc = desc;
+    pmod_loc = mexpr.mod_loc;
+  }
+
+and untype_class_expr cexpr =
+  let desc = match cexpr.cl_desc with
+    | Tcl_constraint ( { cl_desc = Tcl_ident (_path, lid, tyl); _ },
+                       None, _, _, _ ) ->
+        Pcl_constr (lid,
+          List.map untype_core_type tyl)
+    | Tcl_structure clstr -> Pcl_structure (untype_class_structure clstr)
+
+    | Tcl_fun (label, pat, _pv, cl, _partial) ->
+        Pcl_fun (label, None, untype_pattern pat, untype_class_expr cl)
+
+    | Tcl_apply (cl, args) ->
+        Pcl_apply (untype_class_expr cl,
+          List.fold_right (fun (label, expo, _) list ->
+              match expo with
+                None -> list
+              | Some exp -> (label, untype_expression exp) :: list
+          ) args [])
+
+    | Tcl_let (rec_flat, bindings, _ivars, cl) ->
+        Pcl_let (rec_flat,
+          List.map (fun (pat, exp) ->
+              (untype_pattern pat, untype_expression exp)) bindings,
+          untype_class_expr cl)
+
+    | Tcl_constraint (cl, Some clty, _vals, _meths, _concrs) ->
+        Pcl_constraint (untype_class_expr cl,  untype_class_type clty)
+
+    | Tcl_ident _ -> assert false
+    | Tcl_constraint (_, None, _, _, _) -> assert false
+  in
+  { pcl_desc = desc;
+    pcl_loc = cexpr.cl_loc;
+  }
+
+and untype_class_type ct =
+  let desc = match ct.cltyp_desc with
+      Tcty_signature csg -> Pcty_signature (untype_class_signature csg)
+    | Tcty_constr (_path, lid, list) ->
+        Pcty_constr (lid, List.map untype_core_type list)
+    | Tcty_fun (label, ct, cl) ->
+        Pcty_fun (label, untype_core_type ct, untype_class_type cl)
+  in
+  { pcty_desc = desc;
+    pcty_loc = ct.cltyp_loc }
+
+and untype_class_signature cs =
+  {
+    pcsig_self = untype_core_type cs.csig_self;
+    pcsig_fields = List.map untype_class_type_field cs.csig_fields;
+    pcsig_loc = cs.csig_loc;
+  }
+
+and untype_class_type_field ctf =
+  let desc = match ctf.ctf_desc with
+      Tctf_inher ct -> Pctf_inher (untype_class_type ct)
+    | Tctf_val (s, mut, virt, ct) ->
+        Pctf_val (s, mut, virt, untype_core_type ct)
+    | Tctf_virt  (s, priv, ct) ->
+        Pctf_virt (s, priv, untype_core_type ct)
+    | Tctf_meth  (s, priv, ct) ->
+        Pctf_meth  (s, priv, untype_core_type ct)
+    | Tctf_cstr  (ct1, ct2) ->
+        Pctf_cstr (untype_core_type ct1, untype_core_type ct2)
+  in
+  {
+    pctf_desc = desc;
+    pctf_loc = ctf.ctf_loc;
+  }
+
+and untype_core_type ct =
+  let desc = match ct.ctyp_desc with
+      Ttyp_any -> Ptyp_any
+    | Ttyp_var s -> Ptyp_var s
+    | Ttyp_arrow (label, ct1, ct2) ->
+        Ptyp_arrow (label, untype_core_type ct1, untype_core_type ct2)
+  | Ttyp_tuple list -> Ptyp_tuple (List.map untype_core_type list)
+    | Ttyp_constr (_path, lid, list) ->
+        Ptyp_constr (lid,
+          List.map untype_core_type list)
+    | Ttyp_object list ->
+        Ptyp_object (List.map untype_core_field_type list)
+    | Ttyp_class (_path, lid, list, labels) ->
+        Ptyp_class (lid,
+          List.map untype_core_type list, labels)
+    | Ttyp_alias (ct, s) ->
+        Ptyp_alias (untype_core_type ct, s)
+    | Ttyp_variant (list, bool, labels) ->
+        Ptyp_variant (List.map untype_row_field list, bool, labels)
+    | Ttyp_poly (list, ct) -> Ptyp_poly (list, untype_core_type ct)
+    | Ttyp_package pack -> Ptyp_package (untype_package_type pack)
+  in
+  { ptyp_desc = desc; ptyp_loc = ct.ctyp_loc }
+
+and untype_core_field_type cft =
+  { pfield_desc = (match cft.field_desc with
+        Tcfield_var -> Pfield_var
+      | Tcfield (s, ct) -> Pfield (s, untype_core_type ct));
+    pfield_loc = cft.field_loc; }
+
+and untype_class_structure cs =
+  { pcstr_pat = untype_pattern cs.cstr_pat;
+    pcstr_fields = List.map untype_class_field cs.cstr_fields;
+  }
+
+and untype_row_field rf =
+  match rf with
+    Ttag (label, bool, list) ->
+      Rtag (label, bool, List.map untype_core_type list)
+  | Tinherit ct -> Rinherit (untype_core_type ct)
+
+and untype_class_field cf =
+  let desc = match cf.cf_desc with
+      Tcf_inher (ovf, cl, super, _vals, _meths) ->
+        Pcf_inher (ovf, untype_class_expr cl, super)
+    | Tcf_constr (cty, cty') ->
+        Pcf_constr (untype_core_type cty, untype_core_type cty')
+    | Tcf_val (_lab, name, mut, _, Tcfk_virtual cty, _override) ->
+        Pcf_valvirt (name, mut, untype_core_type cty)
+    | Tcf_val (_lab, name, mut, _, Tcfk_concrete exp, override) ->
+        Pcf_val (name, mut,
+          (if override then Override else Fresh),
+          untype_expression exp)
+    | Tcf_meth (_lab, name, priv, Tcfk_virtual cty, _override) ->
+        Pcf_virt (name, priv, untype_core_type cty)
+    | Tcf_meth (_lab, name, priv, Tcfk_concrete exp, override) ->
+        Pcf_meth (name, priv,
+          (if override then Override else Fresh),
+          untype_expression exp)
+(*    | Tcf_let (rec_flag, bindings, _) ->
+        Pcf_let (rec_flag, List.map (fun (pat, exp) ->
+              untype_pattern pat, untype_expression exp) bindings)
+*)
+  | Tcf_init exp -> Pcf_init (untype_expression exp)
+  in
+  { pcf_desc = desc; pcf_loc = cf.cf_loc }
diff -Nru ocaml-3.12.1/tools/untypeast.mli ocaml-4.01.0/tools/untypeast.mli
--- ocaml-3.12.1/tools/untypeast.mli	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/tools/untypeast.mli	2012-12-19 09:25:21.000000000 +0000
@@ -0,0 +1,17 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                OCaml                                   *)
+(*                                                                        *)
+(*      Thomas Gazagnaire (OCamlPro), Fabrice Le Fessant (INRIA Saclay)   *)
+(*                                                                        *)
+(*   Copyright 2007 Institut National de Recherche en Informatique et     *)
+(*   en Automatique.  All rights reserved.  This file is distributed      *)
+(*   under the terms of the Q Public License version 1.0.                 *)
+(*                                                                        *)
+(**************************************************************************)
+
+val untype_structure : Typedtree.structure -> Parsetree.structure
+val untype_signature : Typedtree.signature -> Parsetree.signature
+val untype_expression : Typedtree.expression -> Parsetree.expression
+
+val lident_of_path : Path.t -> Longident.t
diff -Nru ocaml-3.12.1/toplevel/expunge.ml ocaml-4.01.0/toplevel/expunge.ml
--- ocaml-3.12.1/toplevel/expunge.ml	2004-01-16 15:24:03.000000000 +0000
+++ ocaml-4.01.0/toplevel/expunge.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,12 +10,9 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: expunge.ml 6074 2004-01-16 15:24:03Z doligez $ *)
-
 (* "Expunge" a toplevel by removing compiler modules from the global List.map.
    Usage: expunge    *)
 
-open Sys
 open Misc
 
 module StringSet =
@@ -24,23 +21,29 @@
     let compare = compare
   end)
 
+let is_exn =
+  let h = Hashtbl.create 64 in
+  Array.iter (fun n -> Hashtbl.add h n ()) Runtimedef.builtin_exceptions;
+  Hashtbl.mem h
+
 let to_keep = ref StringSet.empty
 
+let negate = Sys.argv.(3) = "-v"
+
+let keep =
+  if negate then fun name -> is_exn name || not (StringSet.mem name !to_keep)
+  else fun name -> is_exn name || (StringSet.mem name !to_keep)
+
 let expunge_map tbl =
-  Symtable.filter_global_map
-    (fun id -> StringSet.mem (Ident.name id) !to_keep)
-    tbl
+  Symtable.filter_global_map (fun id -> keep (Ident.name id)) tbl
 
 let expunge_crcs tbl =
-  List.filter (fun (unit, crc) -> StringSet.mem unit !to_keep) tbl
+  List.filter (fun (unit, crc) -> keep unit) tbl
 
 let main () =
   let input_name = Sys.argv.(1) in
   let output_name = Sys.argv.(2) in
-  Array.iter
-    (fun exn -> to_keep := StringSet.add exn !to_keep)
-    Runtimedef.builtin_exceptions;
-  for i = 3 to Array.length Sys.argv - 1 do
+  for i = (if negate then 4 else 3) to Array.length Sys.argv - 1 do
     to_keep := StringSet.add (String.capitalize Sys.argv.(i)) !to_keep
   done;
   let ic = open_in_bin input_name in
diff -Nru ocaml-3.12.1/toplevel/genprintval.ml ocaml-4.01.0/toplevel/genprintval.ml
--- ocaml-3.12.1/toplevel/genprintval.ml	2009-10-26 10:53:16.000000000 +0000
+++ ocaml-4.01.0/toplevel/genprintval.ml	2012-10-24 12:03:00.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (* Xavier Leroy and Jerome Vouillon, projet Cristal, INRIA Rocquencourt*)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: genprintval.ml 9397 2009-10-26 10:53:16Z frisch $ *)
-
 (* To print values *)
 
 open Misc
@@ -33,10 +31,10 @@
 
 module type EVALPATH =
   sig
-    type value
-    val eval_path: Path.t -> value
+    type valu
+    val eval_path: Path.t -> valu
     exception Error
-    val same_value: value -> value -> bool
+    val same_value: valu -> valu -> bool
   end
 
 module type S =
@@ -52,7 +50,7 @@
           Env.t -> t -> type_expr -> Outcometree.out_value
   end
 
-module Make(O : OBJ)(EVP : EVALPATH with type value = O.t) = struct
+module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
 
     type t = O.t
 
@@ -180,7 +178,7 @@
           find_printer env ty obj
         with Not_found ->
           match (Ctype.repr ty).desc with
-          | Tvar ->
+          | Tvar _ | Tunivar _ ->
               Oval_stuff ""
           | Tarrow(_, ty1, ty2, _) ->
               Oval_stuff ""
@@ -247,16 +245,25 @@
                       if O.is_block obj
                       then Cstr_block(O.tag obj)
                       else Cstr_constant(O.obj obj) in
-                    let (constr_name, constr_args) =
+                    let (constr_name, constr_args,ret_type) =
                       Datarepr.find_constr_by_tag tag constr_list in
+                    let type_params =
+                      match ret_type with
+                        Some t ->
+                          begin match (Ctype.repr t).desc with
+                            Tconstr (_,params,_) ->
+                              params
+                          | _ -> assert false end
+                      | None -> decl.type_params
+                    in
                     let ty_args =
                       List.map
                         (function ty ->
-                           try Ctype.apply env decl.type_params ty ty_list with
+                           try Ctype.apply env type_params ty ty_list with
                              Ctype.Cannot_apply -> abstract_type)
                         constr_args in
                     tree_of_constr_with_args (tree_of_constr env path)
-                                           constr_name 0 depth obj ty_args
+                                 (Ident.name constr_name) 0 depth obj ty_args
                 | {type_kind = Type_record(lbl_list, rep)} ->
                     begin match check_depth depth obj ty with
                       Some x -> x
@@ -270,8 +277,13 @@
                                     ty_list
                                 with
                                   Ctype.Cannot_apply -> abstract_type in
-                              let lid = tree_of_label env path lbl_name in
-                              let v =
+                              let name = Ident.name lbl_name in
+                              (* PR#5722: print full module path only
+                                 for first record field *)
+                              let lid =
+                                if pos = 0 then tree_of_label env path name
+                                else Oide_ident name
+                              and v =
                                 tree_of_val (depth - 1) (O.field obj pos)
                                   ty_arg
                               in
@@ -318,8 +330,6 @@
               fatal_error "Printval.outval_of_value"
           | Tpoly (ty, _) ->
               tree_of_val (depth - 1) obj ty
-          | Tunivar ->
-              Oval_stuff ""
           | Tpackage _ ->
               Oval_stuff ""
         end
@@ -347,7 +357,7 @@
         let cstr = Env.lookup_constructor lid env in
         let path =
           match cstr.cstr_tag with
-            Cstr_exception p -> p | _ -> raise Not_found in
+            Cstr_exception (p, _) -> p | _ -> raise Not_found in
         (* Make sure this is the right exception and not an homonym,
            by evaluating the exception found and comparing with the
            identifier contained in the exception bucket *)
diff -Nru ocaml-3.12.1/toplevel/genprintval.mli ocaml-4.01.0/toplevel/genprintval.mli
--- ocaml-3.12.1/toplevel/genprintval.mli	2002-04-18 07:27:47.000000000 +0000
+++ ocaml-4.01.0/toplevel/genprintval.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*          Jerome Vouillon, projet Cristal, INRIA Rocquencourt        *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: genprintval.mli 4694 2002-04-18 07:27:47Z garrigue $ *)
-
 (* Printing of values *)
 
 open Types
@@ -29,10 +27,10 @@
 
 module type EVALPATH =
   sig
-    type value
-    val eval_path: Path.t -> value
+    type valu
+    val eval_path: Path.t -> valu
     exception Error
-    val same_value: value -> value -> bool
+    val same_value: valu -> valu -> bool
   end
 
 module type S =
@@ -48,5 +46,5 @@
           Env.t -> t -> type_expr -> Outcometree.out_value
   end
 
-module Make(O : OBJ)(EVP : EVALPATH with type value = O.t) :
+module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) :
          (S with type t = O.t)
diff -Nru ocaml-3.12.1/toplevel/opttopdirs.ml ocaml-4.01.0/toplevel/opttopdirs.ml
--- ocaml-3.12.1/toplevel/opttopdirs.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/toplevel/opttopdirs.ml	2012-12-18 17:19:53.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,14 +10,11 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: opttopdirs.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* Toplevel directives *)
 
 open Format
 open Misc
 open Longident
-open Path
 open Types
 open Opttoploop
 
@@ -112,7 +109,7 @@
   let ty_arg = Ctype.newvar() in
   Ctype.unify !toplevel_env
     (Ctype.newconstr printer_type [ty_arg])
-    (Ctype.instance desc.val_type);
+    (Ctype.instance_def desc.val_type);
   Ctype.end_def();
   Ctype.generalize ty_arg;
   ty_arg
diff -Nru ocaml-3.12.1/toplevel/opttopdirs.mli ocaml-4.01.0/toplevel/opttopdirs.mli
--- ocaml-3.12.1/toplevel/opttopdirs.mli	2007-11-06 15:16:56.000000000 +0000
+++ ocaml-4.01.0/toplevel/opttopdirs.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: opttopdirs.mli 8477 2007-11-06 15:16:56Z frisch $ *)
-
 (* The toplevel directives. *)
 
 open Format
diff -Nru ocaml-3.12.1/toplevel/opttoploop.ml ocaml-4.01.0/toplevel/opttoploop.ml
--- ocaml-3.12.1/toplevel/opttoploop.ml	2010-04-13 10:44:25.000000000 +0000
+++ ocaml-4.01.0/toplevel/opttoploop.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,12 +10,9 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: opttoploop.ml 10260 2010-04-13 10:44:25Z doligez $ *)
-
 (* The interactive toplevel loop *)
 
 open Path
-open Lexing
 open Format
 open Config
 open Misc
@@ -23,11 +20,12 @@
 open Types
 open Typedtree
 open Outcometree
-open Lambda
 
 type res = Ok of Obj.t | Err of string
 type evaluation_outcome = Result of Obj.t | Exception of exn
 
+let _dummy = (Ok (Obj.magic 0), Err "")
+
 external ndl_run_toplevel: string -> string -> res
   = "caml_natdynlink_run_toplevel"
 external ndl_loadsym: string -> Obj.t = "caml_natdynlink_loadsym"
@@ -42,7 +40,9 @@
   with _ -> true
 
 let dll_run dll entry =
-  match (try Result (Obj.magic (ndl_run_toplevel dll entry)) with exn -> Exception exn) with
+  match (try Result (Obj.magic (ndl_run_toplevel dll entry))
+         with exn -> Exception exn)
+  with
     | Exception _ as r -> r
     | Result r ->
         match Obj.magic r with
@@ -77,7 +77,7 @@
 (* To print values *)
 
 module EvalPath = struct
-  type value = Obj.t
+  type valu = Obj.t
   exception Error
   let eval_path p = try eval_path p with _ -> raise Error
   let same_value v1 v2 = (v1 == v2)
@@ -125,8 +125,6 @@
 let phrase_seqid = ref 0
 let phrase_name = ref "TOP"
 
-open Lambda
-
 let load_lambda ppf (size, lam) =
   if !Clflags.dump_rawlambda then fprintf ppf "%a@." Printlambda.lambda lam;
   let slam = Simplif.simplify_lambda lam in
@@ -155,7 +153,7 @@
 (* Print the outcome of an evaluation *)
 
 let rec pr_item env = function
-  | Tsig_value(id, decl) :: rem ->
+  | Sig_value(id, decl) :: rem ->
       let tree = Printtyp.tree_of_value_description id decl in
       let valopt =
         match decl.val_kind with
@@ -168,24 +166,24 @@
             Some v
       in
       Some (tree, valopt, rem)
-  | Tsig_type(id, _, _) :: rem when Btype.is_row_name (Ident.name id) ->
+  | Sig_type(id, _, _) :: rem when Btype.is_row_name (Ident.name id) ->
       pr_item env rem
-  | Tsig_type(id, decl, rs) :: rem ->
+  | Sig_type(id, decl, rs) :: rem ->
       let tree = Printtyp.tree_of_type_declaration id decl rs in
       Some (tree, None, rem)
-  | Tsig_exception(id, decl) :: rem ->
+  | Sig_exception(id, decl) :: rem ->
       let tree = Printtyp.tree_of_exception_declaration id decl in
       Some (tree, None, rem)
-  | Tsig_module(id, mty, rs) :: rem ->
+  | Sig_module(id, mty, rs) :: rem ->
       let tree = Printtyp.tree_of_module id mty rs in
       Some (tree, None, rem)
-  | Tsig_modtype(id, decl) :: rem ->
+  | Sig_modtype(id, decl) :: rem ->
       let tree = Printtyp.tree_of_modtype_declaration id decl in
       Some (tree, None, rem)
-  | Tsig_class(id, decl, rs) :: cltydecl :: tydecl1 :: tydecl2 :: rem ->
+  | Sig_class(id, decl, rs) :: cltydecl :: tydecl1 :: tydecl2 :: rem ->
       let tree = Printtyp.tree_of_class_declaration id decl rs in
       Some (tree, None, rem)
-  | Tsig_cltype(id, decl, rs) :: tydecl1 :: tydecl2 :: rem ->
+  | Sig_class_type(id, decl, rs) :: tydecl1 :: tydecl2 :: rem ->
       let tree = Printtyp.tree_of_cltype_declaration id decl rs in
       Some (tree, None, rem)
   | _ -> None
@@ -225,10 +223,10 @@
       incr phrase_seqid;
       phrase_name := Printf.sprintf "TOP%i" !phrase_seqid;
       Compilenv.reset ?packname:None !phrase_name;
-      let _ = Unused_var.warn ppf sstr in
       Typecore.reset_delayed_checks ();
       let (str, sg, newenv) = Typemod.type_structure oldenv sstr Location.none
       in
+      if !Clflags.dump_typedtree then Printtyped.implementation ppf str;
       Typecore.force_delayed_checks ();
       let res = Translmod.transl_store_phrases !phrase_name str in
       Warnings.check_fatal ();
@@ -240,8 +238,8 @@
           | Result v ->
               Compilenv.record_global_approx_toplevel ();
               if print_outcome then
-                match str with
-                | [Tstr_eval exp] ->
+                match str.str_items with
+                | [ {str_desc = Tstr_eval exp} ] ->
                     let outv = outval_of_value newenv v exp.exp_type in
                     let ty = Printtyp.tree_of_type_scheme exp.exp_type in
                     Ophr_eval (outv, ty)
@@ -301,8 +299,15 @@
 
 let use_file ppf name =
   try
-    let filename = find_in_path !Config.load_path name in
-    let ic = open_in_bin filename in
+    let (filename, ic, must_close) =
+      if name = "" then
+        ("(stdin)", stdin, false)
+      else begin
+        let filename = find_in_path !Config.load_path name in
+        let ic = open_in_bin filename in
+        (filename, ic, true)
+      end
+    in
     let lb = Lexing.from_channel ic in
     Location.init lb filename;
     (* Skip initial #! line if any *)
@@ -313,6 +318,7 @@
           List.iter
             (fun ph ->
               if !Clflags.dump_parsetree then Printast.top_phrase ppf ph;
+              if !Clflags.dump_source then Pprintast.top_phrase ppf ph;
               if not (execute_phrase !use_print_results ppf ph) then raise Exit)
             (!parse_use_file lb);
           true
@@ -320,7 +326,7 @@
         | Exit -> false
         | Sys.Break -> fprintf ppf "Interrupted.@."; false
         | x -> Opterrors.report_error ppf x; false) in
-    close_in ic;
+    if must_close then close_in ic;
     success
   with Not_found -> fprintf ppf "Cannot find file %s.@." name; false
 
@@ -357,6 +363,7 @@
     let prompt =
       if !Clflags.noprompt then ""
       else if !first_line then "# "
+      else if !Clflags.nopromptcont then ""
       else if Lexer.in_comment () then "* "
       else "  "
     in
@@ -377,7 +384,7 @@
 let _ =
   Sys.interactive := true;
   Dynlink.init ();
-  Optcompile.init_path();
+  Compmisc.init_path true;
   Clflags.dlcode := true;
   ()
 
@@ -402,17 +409,18 @@
   ()
 
 let initialize_toplevel_env () =
-  toplevel_env := Optcompile.initial_env()
+  toplevel_env := Compmisc.initial_env()
 
 (* The interactive loop *)
 
 exception PPerror
 
 let loop ppf =
-  fprintf ppf "        Objective Caml version %s - native toplevel@.@." Config.version;
+  fprintf ppf "        OCaml version %s - native toplevel@.@." Config.version;
   initialize_toplevel_env ();
   let lb = Lexing.from_function refill_lexbuf in
-  Location.input_name := "";
+  Location.init lb "//toplevel//";
+  Location.input_name := "//toplevel//";
   Location.input_lexbuf := Some lb;
   Sys.catch_break true;
   load_ocamlinit ppf;
@@ -424,6 +432,7 @@
       first_line := true;
       let phr = try !parse_toplevel_phrase lb with Exit -> raise PPerror in
       if !Clflags.dump_parsetree then Printast.top_phrase ppf phr;
+      if !Clflags.dump_source then Pprintast.top_phrase ppf phr;
       ignore(execute_phrase true ppf phr)
     with
     | End_of_file -> exit 0
@@ -440,7 +449,7 @@
   Array.blit args 0 Sys.argv 0 len;
   Obj.truncate (Obj.repr Sys.argv) len;
   Arg.current := 0;
-  Optcompile.init_path();
-  toplevel_env := Optcompile.initial_env();
+  Compmisc.init_path true;
+  toplevel_env := Compmisc.initial_env();
   Sys.interactive := false;
   use_silently ppf name
diff -Nru ocaml-3.12.1/toplevel/opttoploop.mli ocaml-4.01.0/toplevel/opttoploop.mli
--- ocaml-3.12.1/toplevel/opttoploop.mli	2007-12-04 13:38:58.000000000 +0000
+++ ocaml-4.01.0/toplevel/opttoploop.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: opttoploop.mli 8705 2007-12-04 13:38:58Z doligez $ *)
-
 open Format
 
 (* Set the load paths, before running anything *)
diff -Nru ocaml-3.12.1/toplevel/opttopmain.ml ocaml-4.01.0/toplevel/opttopmain.ml
--- ocaml-3.12.1/toplevel/opttopmain.ml	2010-05-20 14:06:29.000000000 +0000
+++ ocaml-4.01.0/toplevel/opttopmain.ml	2013-08-20 15:32:13.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,11 +10,10 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: opttopmain.ml 10444 2010-05-20 14:06:29Z doligez $ *)
-
 open Clflags
 
-let usage = "Usage: ocamlnat   [script-file]\noptions are:"
+let usage =
+   "Usage: ocamlnat   [script-file]\noptions are:"
 
 let preload_objects = ref []
 
@@ -49,7 +48,7 @@
     end
 
 let print_version () =
-  Printf.printf "The Objective Caml toplevel, version %s\n" Sys.ocaml_version;
+  Printf.printf "The OCaml toplevel, version %s\n" Sys.ocaml_version;
   exit 0;
 ;;
 
@@ -62,6 +61,7 @@
   let set r () = r := true
   let clear r () = r := false
 
+  let _absname = set Location.absname
   let _compact = clear optimize_for_speed
   let _I dir =
     let dir = Misc.expand_directory Config.standard_library dir in
@@ -73,11 +73,16 @@
   let _noassert = set noassert
   let _nolabels = set classic
   let _noprompt = set noprompt
+  let _nopromptcont = set nopromptcont
   let _nostdlib = set no_std_include
+  let _ppx s = Compenv.first_ppx := s :: !Compenv.first_ppx
   let _principal = set principal
+  let _real_paths = set real_paths
   let _rectypes = set recursive_types
   let _strict_sequence = set strict_sequence
   let _S = set keep_asm_file
+  let _short_paths = clear real_paths
+  let _stdin () = file_argument ""
   let _unsafe = set fast
   let _version () = print_version ()
   let _vnum () = print_version_num ()
@@ -85,9 +90,12 @@
   let _warn_error s = Warnings.parse_options true s
   let _warn_help = Warnings.help_warnings
 
+  let _dsource = set dump_source
   let _dparsetree = set dump_parsetree
+  let _dtypedtree = set dump_typedtree
   let _drawlambda = set dump_rawlambda
   let _dlambda = set dump_lambda
+  let _dclambda = set dump_clambda
   let _dcmm = set dump_cmm
   let _dsel = set dump_selection
   let _dcombine = set dump_combine
diff -Nru ocaml-3.12.1/toplevel/opttopmain.mli ocaml-4.01.0/toplevel/opttopmain.mli
--- ocaml-3.12.1/toplevel/opttopmain.mli	2007-11-06 15:16:56.000000000 +0000
+++ ocaml-4.01.0/toplevel/opttopmain.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: opttopmain.mli 8477 2007-11-06 15:16:56Z frisch $ *)
-
 (* Start the [ocaml] toplevel loop *)
 
 val main: unit -> unit
diff -Nru ocaml-3.12.1/toplevel/opttopstart.ml ocaml-4.01.0/toplevel/opttopstart.ml
--- ocaml-3.12.1/toplevel/opttopstart.ml	2007-11-06 15:16:56.000000000 +0000
+++ ocaml-4.01.0/toplevel/opttopstart.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,6 +10,4 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: opttopstart.ml 8477 2007-11-06 15:16:56Z frisch $ *)
-
 let _ = Opttopmain.main()
diff -Nru ocaml-3.12.1/toplevel/topdirs.ml ocaml-4.01.0/toplevel/topdirs.ml
--- ocaml-3.12.1/toplevel/topdirs.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/toplevel/topdirs.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,14 +10,11 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: topdirs.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* Toplevel directives *)
 
 open Format
 open Misc
 open Longident
-open Path
 open Types
 open Cmo_format
 open Trace
@@ -41,6 +38,16 @@
 
 let _ = Hashtbl.add directive_table "directory" (Directive_string dir_directory)
 
+(* To remove a directory from the load path *)
+let dir_remove_directory s =
+  let d = expand_directory Config.standard_library s in
+  Config.load_path := List.filter (fun d' -> d' <> d) !Config.load_path;
+  Dll.remove_path [d]
+
+let _ =
+  Hashtbl.add directive_table "remove_directory"
+    (Directive_string dir_remove_directory)
+
 (* To change the current directory *)
 
 let dir_cd s = Sys.chdir s
@@ -85,19 +92,50 @@
     raise Load_failed
   end
 
-let load_file ppf name =
+let rec load_file recursive ppf name =
+  let filename =
+    try Some (find_in_path !Config.load_path name) with Not_found -> None
+  in
+  match filename with
+  | None -> fprintf ppf "Cannot find file %s.@." name; false
+  | Some filename ->
+      let ic = open_in_bin filename in
+      try
+        let success = really_load_file recursive ppf name filename ic in
+        close_in ic;
+        success
+      with exn ->
+        close_in ic;
+        raise exn
+
+and really_load_file recursive ppf name filename ic =
+  let ic = open_in_bin filename in
+  let buffer = Misc.input_bytes ic (String.length Config.cmo_magic_number) in
   try
-    let filename = find_in_path !Config.load_path name in
-    let ic = open_in_bin filename in
-    let buffer = String.create (String.length Config.cmo_magic_number) in
-    really_input ic buffer 0 (String.length Config.cmo_magic_number);
-    let success = try
-      if buffer = Config.cmo_magic_number then begin
-        let compunit_pos = input_binary_int ic in  (* Go to descriptor *)
-        seek_in ic compunit_pos;
-        load_compunit ic filename ppf (input_value ic : compilation_unit);
-        true
-      end else
+    if buffer = Config.cmo_magic_number then begin
+      let compunit_pos = input_binary_int ic in  (* Go to descriptor *)
+      seek_in ic compunit_pos;
+      let cu : compilation_unit = input_value ic in
+      if recursive then
+        List.iter
+          (function
+            | (Reloc_getglobal id, _)
+              when not (Symtable.is_global_defined id) ->
+                let file = Ident.name id ^ ".cmo" in
+                begin match try Some (Misc.find_in_path_uncap !Config.load_path
+                                        file)
+                      with Not_found -> None
+                with
+                | None -> ()
+                | Some file ->
+                    if not (load_file recursive ppf file) then raise Load_failed
+                end
+            | _ -> ()
+          )
+          cu.cu_reloc;
+      load_compunit ic filename ppf cu;
+      true
+    end else
       if buffer = Config.cma_magic_number then begin
         let toc_pos = input_binary_int ic in  (* Go to table of contents *)
         seek_in ic toc_pos;
@@ -118,20 +156,27 @@
         fprintf ppf "File %s is not a bytecode object file.@." name;
         false
       end
-    with Load_failed -> false in
-    close_in ic;
-    success
-  with Not_found -> fprintf ppf "Cannot find file %s.@." name; false
+  with Load_failed -> false
 
-let dir_load ppf name = ignore (load_file ppf name)
+let dir_load ppf name = ignore (load_file false ppf name)
 
 let _ = Hashtbl.add directive_table "load" (Directive_string (dir_load std_out))
 
+let dir_load_rec ppf name = ignore (load_file true ppf name)
+
+let _ = Hashtbl.add directive_table "load_rec"
+                    (Directive_string (dir_load_rec std_out))
+
+let load_file = load_file false
+
 (* Load commands from a file *)
 
 let dir_use ppf name = ignore(Toploop.use_file ppf name)
+let dir_mod_use ppf name = ignore(Toploop.mod_use_file ppf name)
 
 let _ = Hashtbl.add directive_table "use" (Directive_string (dir_use std_out))
+let _ = Hashtbl.add directive_table "mod_use"
+                    (Directive_string (dir_mod_use std_out))
 
 (* Install, remove a printer *)
 
@@ -150,7 +195,7 @@
   let ty_arg = Ctype.newvar() in
   Ctype.unify !toplevel_env
     (Ctype.newconstr printer_type [ty_arg])
-    (Ctype.instance desc.val_type);
+    (Ctype.instance_def desc.val_type);
   Ctype.end_def();
   Ctype.generalize ty_arg;
   ty_arg
diff -Nru ocaml-3.12.1/toplevel/topdirs.mli ocaml-4.01.0/toplevel/topdirs.mli
--- ocaml-3.12.1/toplevel/topdirs.mli	2002-04-18 07:27:47.000000000 +0000
+++ ocaml-4.01.0/toplevel/topdirs.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,14 +10,13 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: topdirs.mli 4694 2002-04-18 07:27:47Z garrigue $ *)
-
 (* The toplevel directives. *)
 
 open Format
 
 val dir_quit : unit -> unit
 val dir_directory : string -> unit
+val dir_remove_directory : string -> unit
 val dir_cd : string -> unit
 val dir_load : formatter -> string -> unit
 val dir_use : formatter -> string -> unit
diff -Nru ocaml-3.12.1/toplevel/toplevellib.mllib ocaml-4.01.0/toplevel/toplevellib.mllib
--- ocaml-3.12.1/toplevel/toplevellib.mllib	2010-04-22 15:41:16.000000000 +0000
+++ ocaml-4.01.0/toplevel/toplevellib.mllib	2012-07-17 15:31:12.000000000 +0000
@@ -1,12 +1,14 @@
 Myocamlbuild_config
 Misc Tbl Config Clflags Terminfo Ccomp Warnings Consistbl
 
-Linenum Location Longident Syntaxerr Parser
+Location Longident Syntaxerr Parser
 Lexer Parse Printast
 
-Unused_var Ident Path Primitive Types
-Btype Oprint Subst Predef Datarepr Env
-Typedtree Ctype Printtyp Includeclass Mtype Includecore
+Ident Path Primitive Types
+Btype Oprint Subst Predef Datarepr
+Cmi_format Env
+Typedtree
+Cmt_format Ctype Printtyp Includeclass Mtype Includecore
 Includemod Parmatch Typetexp Stypes Typecore
 Typedecl Typeclass Typemod
 
diff -Nru ocaml-3.12.1/toplevel/toploop.ml ocaml-4.01.0/toplevel/toploop.ml
--- ocaml-3.12.1/toplevel/toploop.ml	2009-01-25 22:46:15.000000000 +0000
+++ ocaml-4.01.0/toplevel/toploop.ml	2013-06-05 16:34:40.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,12 +10,9 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: toploop.ml 9166 2009-01-25 22:46:15Z weis $ *)
-
 (* The interactive toplevel loop *)
 
 open Path
-open Lexing
 open Format
 open Config
 open Misc
@@ -66,7 +63,7 @@
 (* To print values *)
 
 module EvalPath = struct
-  type value = Obj.t
+  type valu = Obj.t
   exception Error
   let eval_path p = try eval_path p with Symtable.Error _ -> raise Error
   let same_value v1 v2 = (v1 == v2)
@@ -105,6 +102,23 @@
 let print_warning = Location.print_warning
 let input_name = Location.input_name
 
+let parse_mod_use_file name lb =
+  let modname =
+    String.capitalize (Filename.chop_extension (Filename.basename name))
+  in
+  let items =
+    List.concat
+      (List.map
+         (function Ptop_def s -> s | Ptop_dir _ -> [])
+         (!parse_use_file lb))
+  in
+  [ Ptop_def
+      [ { pstr_desc =
+            Pstr_module ( Location.mknoloc modname ,
+                          { pmod_desc = Pmod_structure items;
+                            pmod_loc = Location.none } );
+          pstr_loc = Location.none } ] ]
+
 (* Hooks for initialization *)
 
 let toplevel_startup_hook = ref (fun () -> ())
@@ -149,8 +163,10 @@
 
 (* Print the outcome of an evaluation *)
 
-let rec pr_item env = function
-  | Tsig_value(id, decl) :: rem ->
+let rec pr_item env items =
+  Printtyp.hide_rec_items items;
+  match items with
+  | Sig_value(id, decl) :: rem ->
       let tree = Printtyp.tree_of_value_description id decl in
       let valopt =
         match decl.val_kind with
@@ -163,24 +179,24 @@
             Some v
       in
       Some (tree, valopt, rem)
-  | Tsig_type(id, _, _) :: rem when Btype.is_row_name (Ident.name id) ->
+  | Sig_type(id, _, _) :: rem when Btype.is_row_name (Ident.name id) ->
       pr_item env rem
-  | Tsig_type(id, decl, rs) :: rem ->
+  | Sig_type(id, decl, rs) :: rem ->
       let tree = Printtyp.tree_of_type_declaration id decl rs in
       Some (tree, None, rem)
-  | Tsig_exception(id, decl) :: rem ->
+  | Sig_exception(id, decl) :: rem ->
       let tree = Printtyp.tree_of_exception_declaration id decl in
       Some (tree, None, rem)
-  | Tsig_module(id, mty, rs) :: rem ->
+  | Sig_module(id, mty, rs) :: rem ->
       let tree = Printtyp.tree_of_module id mty rs in
       Some (tree, None, rem)
-  | Tsig_modtype(id, decl) :: rem ->
+  | Sig_modtype(id, decl) :: rem ->
       let tree = Printtyp.tree_of_modtype_declaration id decl in
       Some (tree, None, rem)
-  | Tsig_class(id, decl, rs) :: cltydecl :: tydecl1 :: tydecl2 :: rem ->
+  | Sig_class(id, decl, rs) :: cltydecl :: tydecl1 :: tydecl2 :: rem ->
       let tree = Printtyp.tree_of_class_declaration id decl rs in
       Some (tree, None, rem)
-  | Tsig_cltype(id, decl, rs) :: tydecl1 :: tydecl2 :: rem ->
+  | Sig_class_type(id, decl, rs) :: tydecl1 :: tydecl2 :: rem ->
       let tree = Printtyp.tree_of_cltype_declaration id decl rs in
       Some (tree, None, rem)
   | _ -> None
@@ -217,10 +233,11 @@
   match phr with
   | Ptop_def sstr ->
       let oldenv = !toplevel_env in
-      let _ = Unused_var.warn ppf sstr in
       Typecore.reset_delayed_checks ();
-      let (str, sg, newenv) = Typemod.type_structure oldenv sstr Location.none
-      in
+      let (str, sg, newenv) = Typemod.type_toplevel_phrase oldenv sstr in
+      if !Clflags.dump_typedtree then Printtyped.implementation ppf str;
+      let sg' = Typemod.simplify_signature sg in
+      ignore (Includemod.signatures oldenv sg sg');
       Typecore.force_delayed_checks ();
       let lam = Translmod.transl_toplevel_definition str in
       Warnings.check_fatal ();
@@ -231,14 +248,14 @@
           match res with
           | Result v ->
               if print_outcome then
-                match str with
-                | [Tstr_eval exp] ->
-                    let outv = outval_of_value newenv v exp.exp_type in
-                    let ty = Printtyp.tree_of_type_scheme exp.exp_type in
-                    Ophr_eval (outv, ty)
-                | [] -> Ophr_signature []
-                | _ -> Ophr_signature (item_list newenv
-                                             (Typemod.simplify_signature sg))
+                Printtyp.wrap_printing_env oldenv (fun () ->
+                  match str.str_items with
+                  | [ { str_desc = Tstr_eval exp }] ->
+                      let outv = outval_of_value newenv v exp.exp_type in
+                      let ty = Printtyp.tree_of_type_scheme exp.exp_type in
+                      Ophr_eval (outv, ty)
+                  | [] -> Ophr_signature []
+                  | _ -> Ophr_signature (item_list newenv sg'))
               else Ophr_signature []
           | Exception exn ->
               toplevel_env := oldenv;
@@ -284,14 +301,32 @@
     r := oldval;
     raise x
 
-(* Read and execute commands from a file *)
+(* Read and execute commands from a file, or from stdin if [name] is "". *)
 
 let use_print_results = ref true
 
-let use_file ppf name =
+let phrase ppf phr =
+  let phr =
+    match phr with
+    | Ptop_def str ->
+        Ptop_def (Pparse.apply_rewriters ast_impl_magic_number str)
+    | phr -> phr
+  in
+  if !Clflags.dump_parsetree then Printast.top_phrase ppf phr;
+  if !Clflags.dump_source then Pprintast.top_phrase ppf phr;
+  phr
+
+let use_file ppf wrap_mod name =
   try
-    let filename = find_in_path !Config.load_path name in
-    let ic = open_in_bin filename in
+    let (filename, ic, must_close) =
+      if name = "" then
+        ("(stdin)", stdin, false)
+      else begin
+        let filename = find_in_path !Config.load_path name in
+        let ic = open_in_bin filename in
+        (filename, ic, true)
+      end
+    in
     let lb = Lexing.from_channel ic in
     Location.init lb filename;
     (* Skip initial #! line if any *)
@@ -301,18 +336,24 @@
         try
           List.iter
             (fun ph ->
-              if !Clflags.dump_parsetree then Printast.top_phrase ppf ph;
+              let ph = phrase ppf ph in
               if not (execute_phrase !use_print_results ppf ph) then raise Exit)
-            (!parse_use_file lb);
+            (if wrap_mod then
+               parse_mod_use_file name lb
+             else
+               !parse_use_file lb);
           true
         with
         | Exit -> false
         | Sys.Break -> fprintf ppf "Interrupted.@."; false
         | x -> Errors.report_error ppf x; false) in
-    close_in ic;
+    if must_close then close_in ic;
     success
   with Not_found -> fprintf ppf "Cannot find file %s.@." name; false
 
+let mod_use_file ppf name = use_file ppf true name
+let use_file ppf name = use_file ppf false name
+
 let use_silently ppf name =
   protect use_print_results false (fun () -> use_file ppf name)
 
@@ -346,6 +387,7 @@
     let prompt =
       if !Clflags.noprompt then ""
       else if !first_line then "# "
+      else if !Clflags.nopromptcont then ""
       else if Lexer.in_comment () then "* "
       else "  "
     in
@@ -366,7 +408,7 @@
 let _ =
   Sys.interactive := true;
   let crc_intfs = Symtable.init_toplevel() in
-  Compile.init_path();
+  Compmisc.init_path false;
   List.iter
     (fun (name, crc) ->
       Consistbl.set Env.crc_units name crc Sys.executable_name)
@@ -393,17 +435,18 @@
   Dll.add_path !load_path
 
 let initialize_toplevel_env () =
-  toplevel_env := Compile.initial_env()
+  toplevel_env := Compmisc.initial_env()
 
 (* The interactive loop *)
 
 exception PPerror
 
 let loop ppf =
-  fprintf ppf "        Objective Caml version %s@.@." Config.version;
+  fprintf ppf "        OCaml version %s@.@." Config.version;
   initialize_toplevel_env ();
   let lb = Lexing.from_function refill_lexbuf in
-  Location.input_name := "";
+  Location.init lb "//toplevel//";
+  Location.input_name := "//toplevel//";
   Location.input_lexbuf := Some lb;
   Sys.catch_break true;
   load_ocamlinit ppf;
@@ -414,7 +457,8 @@
       Location.reset();
       first_line := true;
       let phr = try !parse_toplevel_phrase lb with Exit -> raise PPerror in
-      if !Clflags.dump_parsetree then Printast.top_phrase ppf phr;
+      let phr = phrase ppf phr  in
+      Env.reset_cache_toplevel ();
       ignore(execute_phrase true ppf phr)
     with
     | End_of_file -> exit 0
@@ -423,7 +467,7 @@
     | x -> Errors.report_error ppf x; Btype.backtrack snap
   done
 
-(* Execute a script *)
+(* Execute a script.  If [name] is "", read the script from stdin. *)
 
 let run_script ppf name args =
   let len = Array.length args in
@@ -431,7 +475,7 @@
   Array.blit args 0 Sys.argv 0 len;
   Obj.truncate (Obj.repr Sys.argv) len;
   Arg.current := 0;
-  Compile.init_path();
-  toplevel_env := Compile.initial_env();
+  Compmisc.init_path false;
+  toplevel_env := Compmisc.initial_env();
   Sys.interactive := false;
   use_silently ppf name
diff -Nru ocaml-3.12.1/toplevel/toploop.mli ocaml-4.01.0/toplevel/toploop.mli
--- ocaml-3.12.1/toplevel/toploop.mli	2007-12-04 13:38:58.000000000 +0000
+++ ocaml-4.01.0/toplevel/toploop.mli	2012-11-18 16:16:50.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: toploop.mli 8705 2007-12-04 13:38:58Z doligez $ *)
-
 open Format
 
 (* Accessors for the table of toplevel value bindings.  These functions
@@ -57,9 +55,11 @@
            should be printed. Uncaught exceptions are always printed. *)
 val use_file : formatter -> string -> bool
 val use_silently : formatter -> string -> bool
+val mod_use_file : formatter -> string -> bool
         (* Read and execute commands from a file.
            [use_file] prints the types and values of the results.
-           [use_silently] does not print them. *)
+           [use_silently] does not print them.
+           [mod_use_file] wrap the file contents into a module. *)
 val eval_path: Path.t -> Obj.t
         (* Return the toplevel object referred to by the given path *)
 
diff -Nru ocaml-3.12.1/toplevel/topmain.ml ocaml-4.01.0/toplevel/topmain.ml
--- ocaml-3.12.1/toplevel/topmain.ml	2010-05-20 14:06:29.000000000 +0000
+++ ocaml-4.01.0/toplevel/topmain.ml	2013-08-20 15:32:13.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,11 +10,11 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: topmain.ml 10444 2010-05-20 14:06:29Z doligez $ *)
-
 open Clflags
+open Compenv
 
-let usage = "Usage: ocaml   [script-file]\noptions are:"
+let usage = "Usage: ocaml   [script-file [arguments]]\n\
+             options are:"
 
 let preload_objects = ref []
 
@@ -31,6 +31,7 @@
       Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x);
       false
 
+(* If [name] is "", then the "file" is stdin treated as a script file. *)
 let file_argument name =
   let ppf = Format.err_formatter in
   if Filename.check_suffix name ".cmo" || Filename.check_suffix name ".cma"
@@ -46,7 +47,7 @@
     end
 
 let print_version () =
-  Printf.printf "The Objective Caml toplevel, version %s\n" Sys.ocaml_version;
+  Printf.printf "The OCaml toplevel, version %s\n" Sys.ocaml_version;
   exit 0;
 ;;
 
@@ -59,6 +60,7 @@
   let set r () = r := true
   let clear r () = r := false
 
+  let _absname = set Location.absname
   let _I dir =
     let dir = Misc.expand_directory Config.standard_library dir in
     include_dirs := dir :: !include_dirs
@@ -68,9 +70,13 @@
   let _noassert = set noassert
   let _nolabels = set classic
   let _noprompt = set noprompt
+  let _nopromptcont = set nopromptcont
   let _nostdlib = set no_std_include
+  let _ppx s = first_ppx := s :: !first_ppx
   let _principal = set principal
   let _rectypes = set recursive_types
+  let _short_paths = clear real_paths
+  let _stdin () = file_argument ""
   let _strict_sequence = set strict_sequence
   let _unsafe = set fast
   let _version () = print_version ()
@@ -79,6 +85,8 @@
   let _warn_error s = Warnings.parse_options true s
   let _warn_help = Warnings.help_warnings
   let _dparsetree = set dump_parsetree
+  let _dtypedtree = set dump_typedtree
+  let _dsource = set dump_source
   let _drawlambda = set dump_rawlambda
   let _dlambda = set dump_lambda
   let _dinstr = set dump_instr
@@ -88,6 +96,9 @@
 
 
 let main () =
+  let ppf = Format.err_formatter in
+  Compenv.readenv ppf Before_args;
   Arg.parse Options.list file_argument usage;
-  if not (prepare Format.err_formatter) then exit 2;
+  Compenv.readenv ppf Before_link;
+  if not (prepare ppf) then exit 2;
   Toploop.loop Format.std_formatter
diff -Nru ocaml-3.12.1/toplevel/topmain.mli ocaml-4.01.0/toplevel/topmain.mli
--- ocaml-3.12.1/toplevel/topmain.mli	2002-04-24 08:02:51.000000000 +0000
+++ ocaml-4.01.0/toplevel/topmain.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: topmain.mli 4731 2002-04-24 08:02:51Z xleroy $ *)
-
 (* Start the [ocaml] toplevel loop *)
 
 val main: unit -> unit
diff -Nru ocaml-3.12.1/toplevel/topstart.ml ocaml-4.01.0/toplevel/topstart.ml
--- ocaml-3.12.1/toplevel/topstart.ml	2002-04-24 08:02:51.000000000 +0000
+++ ocaml-4.01.0/toplevel/topstart.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,6 +10,4 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: topstart.ml 4731 2002-04-24 08:02:51Z xleroy $ *)
-
 let _ = Topmain.main()
diff -Nru ocaml-3.12.1/toplevel/trace.ml ocaml-4.01.0/toplevel/trace.ml
--- ocaml-3.12.1/toplevel/trace.ml	2001-04-19 08:34:21.000000000 +0000
+++ ocaml-4.01.0/toplevel/trace.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: trace.ml 3490 2001-04-19 08:34:21Z garrigue $ *)
-
 (* The "trace" facility *)
 
 open Format
diff -Nru ocaml-3.12.1/toplevel/trace.mli ocaml-4.01.0/toplevel/trace.mli
--- ocaml-3.12.1/toplevel/trace.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/toplevel/trace.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: trace.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* The "trace" facility *)
 
 open Format
diff -Nru ocaml-3.12.1/typing/annot.mli ocaml-4.01.0/typing/annot.mli
--- ocaml-3.12.1/typing/annot.mli	2008-07-29 15:42:44.000000000 +0000
+++ ocaml-4.01.0/typing/annot.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*          Damien Doligez, projet Gallium, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: annot.mli 8958 2008-07-29 15:42:44Z doligez $ *)
-
 (* Data types for annotations (Stypes.ml) *)
 
 type call = Tail | Stack | Inline;;
diff -Nru ocaml-3.12.1/typing/btype.ml ocaml-4.01.0/typing/btype.ml
--- ocaml-3.12.1/typing/btype.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/typing/btype.ml	2013-02-09 08:42:11.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (* Xavier Leroy and Jerome Vouillon, projet Cristal, INRIA Rocquencourt*)
 (*                                                                     *)
@@ -10,12 +10,21 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: btype.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* Basic operations on core types *)
 
 open Types
 
+(**** Sets, maps and hashtables of types ****)
+
+module TypeSet = Set.Make(TypeOps)
+module TypeMap = Map.Make (TypeOps)
+module TypeHash = Hashtbl.Make(TypeOps)
+
+(**** Forward declarations ****)
+
+let print_raw =
+  ref (fun _ -> assert false : Format.formatter -> type_expr -> unit)
+
 (**** Type level management ****)
 
 let generic_level = 100000000
@@ -30,9 +39,9 @@
 let new_id = ref (-1)
 
 let newty2 level desc  =
-  incr new_id; { desc = desc; level = level; id = !new_id }
+  incr new_id; { desc; level; id = !new_id }
 let newgenty desc      = newty2 generic_level desc
-let newgenvar ()       = newgenty Tvar
+let newgenvar ?name () = newgenty (Tvar name)
 (*
 let newmarkedvar level =
   incr new_id; { desc = Tvar; level = pivot_level - level; id = !new_id }
@@ -41,6 +50,13 @@
   { desc = Tvar; level = pivot_level - generic_level; id = !new_id }
 *)
 
+(**** Check some types ****)
+
+let is_Tvar = function {desc=Tvar _} -> true | _ -> false
+let is_Tunivar = function {desc=Tunivar _} -> true | _ -> false
+
+let dummy_method = "*dummy method*"
+
 (**** Representative of a type ****)
 
 let rec field_kind_repr =
@@ -108,6 +124,14 @@
   | {desc=Tvariant row'} -> row_more row'
   | ty -> ty
 
+let row_fixed row =
+  let row = row_repr row in
+  row.row_fixed ||
+  match (repr row.row_more).desc with
+    Tvar _ | Tnil -> false
+  | Tunivar _ | Tconstr _ -> true
+  | _ -> assert false
+
 let static_row row =
   let row = row_repr row in
   row.row_closed &&
@@ -134,7 +158,7 @@
       let rec proxy_obj ty =
         match ty.desc with
           Tfield (_, _, _, ty) | Tlink ty -> proxy_obj ty
-        | Tvar | Tunivar | Tconstr _ -> ty
+        | Tvar _ | Tunivar _ | Tconstr _ -> ty
         | Tnil -> ty0
         | _ -> assert false
       in proxy_obj ty
@@ -160,6 +184,12 @@
   let l = String.length s in
   if l < 4 then false else String.sub s (l-4) 4 = "#row"
 
+let is_constr_row t =
+  match t.desc with
+    Tconstr (Path.Pident id, _, _) -> is_row_name (Ident.name id)
+  | Tconstr (Path.Pdot (_, s, _), _, _) -> is_row_name s
+  | _ -> false
+
 
                   (**********************************)
                   (*  Utilities for type traversal  *)
@@ -175,13 +205,13 @@
     row.row_fields;
   match (repr row.row_more).desc with
     Tvariant row -> iter_row f row
-  | Tvar | Tunivar | Tsubst _ | Tconstr _ ->
+  | Tvar _ | Tunivar _ | Tsubst _ | Tconstr _ | Tnil ->
       Misc.may (fun (_,l) -> List.iter f l) row.row_name
   | _ -> assert false
 
 let iter_type_expr f ty =
   match ty.desc with
-    Tvar                -> ()
+    Tvar _              -> ()
   | Tarrow (_, ty1, ty2, _) -> f ty1; f ty2
   | Ttuple l            -> List.iter f l
   | Tconstr (_, l, _)   -> List.iter f l
@@ -193,7 +223,7 @@
   | Tnil                -> ()
   | Tlink ty            -> f ty
   | Tsubst ty           -> f ty
-  | Tunivar             -> ()
+  | Tunivar _           -> ()
   | Tpoly (ty, tyl)     -> f ty; List.iter f tyl
   | Tpackage (_, _, l)  -> List.iter f l
 
@@ -234,13 +264,13 @@
    encoding during substitution *)
 let rec norm_univar ty =
   match ty.desc with
-    Tunivar | Tsubst _ -> ty
+    Tunivar _ | Tsubst _ -> ty
   | Tlink ty           -> norm_univar ty
   | Ttuple (ty :: _)   -> norm_univar ty
   | _                  -> assert false
 
-let rec copy_type_desc f = function
-    Tvar                -> Tvar
+let rec copy_type_desc ?(keep_names=false) f = function
+    Tvar _ as ty        -> if keep_names then ty else Tvar None
   | Tarrow (p, ty1, ty2, c)-> Tarrow (p, f ty1, f ty2, copy_commu c)
   | Ttuple l            -> Ttuple (List.map f l)
   | Tconstr (p, l, _)   -> Tconstr (p, List.map f l, ref Mnil)
@@ -253,7 +283,7 @@
   | Tnil                -> Tnil
   | Tlink ty            -> copy_type_desc f ty.desc
   | Tsubst ty           -> assert false
-  | Tunivar             -> Tunivar
+  | Tunivar _ as ty     -> ty (* always keep the name *)
   | Tpoly (ty, tyl)     ->
       let tyl = List.map (fun x -> norm_univar (f x)) tyl in
       Tpoly (f ty, tyl)
@@ -314,7 +344,11 @@
   begin match decl.type_kind with
     Type_abstract -> ()
   | Type_variant cstrs ->
-      List.iter (fun (c, tl) -> List.iter unmark_type tl) cstrs
+      List.iter
+        (fun (c, tl, ret_type_opt) ->
+          List.iter unmark_type tl;
+          Misc.may unmark_type ret_type_opt)
+        cstrs
   | Type_record(lbls, rep) ->
       List.iter (fun (c, mut, t) -> unmark_type t) lbls
   end;
@@ -329,11 +363,11 @@
 
 let rec unmark_class_type =
   function
-    Tcty_constr (p, tyl, cty) ->
+    Cty_constr (p, tyl, cty) ->
       List.iter unmark_type tyl; unmark_class_type cty
-  | Tcty_signature sign ->
+  | Cty_signature sign ->
       unmark_class_signature sign
-  | Tcty_fun (_, ty, cty) ->
+  | Cty_fun (_, ty, cty) ->
       unmark_type ty; unmark_class_type cty
 
 
@@ -436,15 +470,17 @@
   | Ckind of field_kind option ref * field_kind option
   | Ccommu of commutable ref * commutable
   | Cuniv of type_expr option ref * type_expr option
+  | Ctypeset of TypeSet.t ref * TypeSet.t
 
 let undo_change = function
-    Ctype  (ty, desc)  -> ty.desc <- desc
+    Ctype  (ty, desc) -> ty.desc <- desc
   | Clevel (ty, level) -> ty.level <- level
   | Cname  (r, v) -> r := v
   | Crow   (r, v) -> r := v
   | Ckind  (r, v) -> r := v
   | Ccommu (r, v) -> r := v
   | Cuniv  (r, v) -> r := v
+  | Ctypeset (r, v) -> r := v
 
 type changes =
     Change of change * changes ref
@@ -465,7 +501,22 @@
 
 let log_type ty =
   if ty.id <= !last_snapshot then log_change (Ctype (ty, ty.desc))
-let link_type ty ty' = log_type ty; ty.desc <- Tlink ty'
+let link_type ty ty' =
+  log_type ty;
+  let desc = ty.desc in
+  ty.desc <- Tlink ty';
+  (* Name is a user-supplied name for this unification variable (obtained
+   * through a type annotation for instance). *)
+  match desc, ty'.desc with
+    Tvar name, Tvar name' ->
+      begin match name, name' with
+      | Some _, None ->  log_type ty'; ty'.desc <- Tvar name
+      | None, Some _ ->  ()
+      | Some _, Some _ ->
+          if ty.level < ty'.level then (log_type ty'; ty'.desc <- Tvar name)
+      | None, None   ->  ()
+      end
+  | _ -> ()
   (* ; assert (check_memorized_abbrevs ()) *)
   (*  ; check_expans [] ty' *)
 let set_level ty level =
@@ -481,6 +532,8 @@
   log_change (Ckind (rk, !rk)); rk := Some k
 let set_commu rc c =
   log_change (Ccommu (rc, !rc)); rc := c
+let set_typeset rs s =
+  log_change (Ctypeset (rs, !rs)); rs := s
 
 let snapshot () =
   let old = !last_snapshot in
diff -Nru ocaml-3.12.1/typing/btype.mli ocaml-4.01.0/typing/btype.mli
--- ocaml-3.12.1/typing/btype.mli	2008-07-19 02:13:09.000000000 +0000
+++ ocaml-4.01.0/typing/btype.mli	2013-02-09 08:42:11.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,20 +10,26 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: btype.mli 8922 2008-07-19 02:13:09Z garrigue $ *)
-
 (* Basic operations on core types *)
 
 open Asttypes
 open Types
 
+(**** Sets, maps and hashtables of types ****)
+
+module TypeSet  : Set.S with type elt = type_expr
+module TypeMap  : Map.S with type key = type_expr
+module TypeHash : Hashtbl.S with type key = type_expr
+
+(**** Levels ****)
+
 val generic_level: int
 
 val newty2: int -> type_desc -> type_expr
         (* Create a type *)
 val newgenty: type_desc -> type_expr
         (* Create a generic type *)
-val newgenvar: unit -> type_expr
+val newgenvar: ?name:string -> unit -> type_expr
         (* Return a fresh generic variable *)
 
 (* Use Tsubst instead
@@ -33,6 +39,10 @@
         (* Return a fresh marked generic variable *)
 *)
 
+val is_Tvar: type_expr -> bool
+val is_Tunivar: type_expr -> bool
+val dummy_method: label
+
 val repr: type_expr -> type_expr
         (* Return the canonical representative of a type. *)
 
@@ -43,6 +53,8 @@
 val commu_repr: commutable -> commutable
         (* Return the canonical representative of a commutation lock *)
 
+(**** polymorphic variants ****)
+
 val row_repr: row_desc -> row_desc
         (* Return the canonical representative of a row description *)
 val row_field_repr: row_field -> row_field
@@ -50,6 +62,8 @@
         (* Return the canonical representative of a row field *)
 val row_more: row_desc -> type_expr
         (* Return the extension variable of the row *)
+val row_fixed: row_desc -> bool
+        (* Return whether the row should be treated as fixed or not *)
 val static_row: row_desc -> bool
         (* Return whether the row is static or not *)
 val hash_variant: label -> int
@@ -62,6 +76,7 @@
 (**** Utilities for private abbreviations with fixed rows ****)
 val has_constr_row: type_expr -> bool
 val is_row_name: string -> bool
+val is_constr_row: type_expr -> bool
 
 (**** Utilities for type traversal ****)
 
@@ -72,7 +87,8 @@
 val iter_abbrev: (type_expr -> unit) -> abbrev_memo -> unit
         (* Iteration on types in an abbreviation list *)
 
-val copy_type_desc: (type_expr -> type_expr) -> type_desc -> type_desc
+val copy_type_desc:
+    ?keep_names:bool -> (type_expr -> type_expr) -> type_desc -> type_desc
         (* Copy on types *)
 val copy_row:
     (type_expr -> type_expr) ->
@@ -150,6 +166,10 @@
 val set_univar: type_expr option ref -> type_expr -> unit
 val set_kind: field_kind option ref -> field_kind -> unit
 val set_commu: commutable ref -> commutable -> unit
+val set_typeset: TypeSet.t ref -> TypeSet.t -> unit
         (* Set references, logging the old value *)
 val log_type: type_expr -> unit
         (* Log the old value of a type, before modifying it by hand *)
+
+(**** Forward declarations ****)
+val print_raw: (Format.formatter -> type_expr -> unit) ref
diff -Nru ocaml-3.12.1/typing/cmi_format.ml ocaml-4.01.0/typing/cmi_format.ml
--- ocaml-3.12.1/typing/cmi_format.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/typing/cmi_format.ml	2012-05-31 08:07:31.000000000 +0000
@@ -0,0 +1,93 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                  Fabrice Le Fessant, INRIA Saclay                   *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+type pers_flags = Rectypes
+
+type error =
+    Not_an_interface of string
+  | Wrong_version_interface of string * string
+  | Corrupted_interface of string
+
+exception Error of error
+
+type cmi_infos = {
+    cmi_name : string;
+    cmi_sign : Types.signature_item list;
+    cmi_crcs : (string * Digest.t) list;
+    cmi_flags : pers_flags list;
+}
+
+let input_cmi ic =
+  let (name, sign) = input_value ic in
+  let crcs = input_value ic in
+  let flags = input_value ic in
+  {
+      cmi_name = name;
+      cmi_sign = sign;
+      cmi_crcs = crcs;
+      cmi_flags = flags;
+    }
+
+let read_cmi filename =
+  let ic = open_in_bin filename in
+  try
+    let buffer = Misc.input_bytes ic (String.length Config.cmi_magic_number) in
+    if buffer <> Config.cmi_magic_number then begin
+      close_in ic;
+      let pre_len = String.length Config.cmi_magic_number - 3 in
+      if String.sub buffer 0 pre_len
+          = String.sub Config.cmi_magic_number 0 pre_len then
+      begin
+        let msg =
+          if buffer < Config.cmi_magic_number then "an older" else "a newer" in
+        raise (Error (Wrong_version_interface (filename, msg)))
+      end else begin
+        raise(Error(Not_an_interface filename))
+      end
+    end;
+    let cmi = input_cmi ic in
+    close_in ic;
+    cmi
+  with End_of_file | Failure _ ->
+      close_in ic;
+      raise(Error(Corrupted_interface(filename)))
+    | Error e ->
+      close_in ic;
+      raise (Error e)
+
+let output_cmi filename oc cmi =
+(* beware: the provided signature must have been substituted for saving *)
+  output_string oc Config.cmi_magic_number;
+  output_value oc (cmi.cmi_name, cmi.cmi_sign);
+  flush oc;
+  let crc = Digest.file filename in
+  let crcs = (cmi.cmi_name, crc) :: cmi.cmi_crcs in
+  output_value oc crcs;
+  output_value oc cmi.cmi_flags;
+  crc
+
+(* Error report *)
+
+open Format
+
+let report_error ppf = function
+  | Not_an_interface filename ->
+      fprintf ppf "%a@ is not a compiled interface"
+        Location.print_filename filename
+  | Wrong_version_interface (filename, older_newer) ->
+      fprintf ppf
+        "%a@ is not a compiled interface for this version of OCaml.@.\
+         It seems to be for %s version of OCaml."
+        Location.print_filename filename older_newer
+  | Corrupted_interface filename ->
+      fprintf ppf "Corrupted compiled interface@ %a"
+        Location.print_filename filename
diff -Nru ocaml-3.12.1/typing/cmi_format.mli ocaml-4.01.0/typing/cmi_format.mli
--- ocaml-3.12.1/typing/cmi_format.mli	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/typing/cmi_format.mli	2012-05-30 15:25:49.000000000 +0000
@@ -0,0 +1,42 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                  Fabrice Le Fessant, INRIA Saclay                   *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+type pers_flags = Rectypes
+
+type cmi_infos = {
+    cmi_name : string;
+    cmi_sign : Types.signature_item list;
+    cmi_crcs : (string * Digest.t) list;
+    cmi_flags : pers_flags list;
+}
+
+(* write the magic + the cmi information *)
+val output_cmi : string -> out_channel -> cmi_infos -> Digest.t
+
+(* read the cmi information (the magic is supposed to have already been read) *)
+val input_cmi : in_channel -> cmi_infos
+
+(* read a cmi from a filename, checking the magic *)
+val read_cmi : string -> cmi_infos
+
+(* Error report *)
+
+type error =
+    Not_an_interface of string
+  | Wrong_version_interface of string * string
+  | Corrupted_interface of string
+
+exception Error of error
+
+open Format
+
+val report_error: formatter -> error -> unit
diff -Nru ocaml-3.12.1/typing/cmt_format.ml ocaml-4.01.0/typing/cmt_format.ml
--- ocaml-3.12.1/typing/cmt_format.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/typing/cmt_format.ml	2013-05-16 13:34:53.000000000 +0000
@@ -0,0 +1,230 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                  Fabrice Le Fessant, INRIA Saclay                   *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+open Cmi_format
+open Typedtree
+
+(* Note that in Typerex, there is an awful hack to save a cmt file
+   together with the interface file that was generated by ocaml (this
+   is because the installed version of ocaml might differ from the one
+   integrated in Typerex).
+*)
+
+
+
+let read_magic_number ic =
+  let len_magic_number = String.length Config.cmt_magic_number in
+  let magic_number = String.create len_magic_number in
+  really_input ic magic_number 0 len_magic_number;
+  magic_number
+
+type binary_annots =
+  | Packed of Types.signature * string list
+  | Implementation of structure
+  | Interface of signature
+  | Partial_implementation of binary_part array
+  | Partial_interface of binary_part array
+
+and binary_part =
+| Partial_structure of structure
+| Partial_structure_item of structure_item
+| Partial_expression of expression
+| Partial_pattern of pattern
+| Partial_class_expr of class_expr
+| Partial_signature of signature
+| Partial_signature_item of signature_item
+| Partial_module_type of module_type
+
+type cmt_infos = {
+  cmt_modname : string;
+  cmt_annots : binary_annots;
+  cmt_comments : (string * Location.t) list;
+  cmt_args : string array;
+  cmt_sourcefile : string option;
+  cmt_builddir : string;
+  cmt_loadpath : string list;
+  cmt_source_digest : Digest.t option;
+  cmt_initial_env : Env.t;
+  cmt_imports : (string * Digest.t) list;
+  cmt_interface_digest : Digest.t option;
+  cmt_use_summaries : bool;
+}
+
+type error =
+    Not_a_typedtree of string
+
+let need_to_clear_env =
+  try ignore (Sys.getenv "OCAML_BINANNOT_WITHENV"); false
+  with Not_found -> true
+
+let keep_only_summary = Env.keep_only_summary
+
+module ClearEnv  = TypedtreeMap.MakeMap (struct
+  open TypedtreeMap
+  include DefaultMapArgument
+
+  let leave_pattern p = { p with pat_env = keep_only_summary p.pat_env }
+  let leave_expression e =
+    let exp_extra = List.map (function
+        (Texp_open (ovf, path, lloc, env), loc) ->
+          (Texp_open (ovf, path, lloc, keep_only_summary env), loc)
+      | exp_extra -> exp_extra) e.exp_extra in
+    { e with
+      exp_env = keep_only_summary e.exp_env;
+      exp_extra = exp_extra }
+  let leave_class_expr c =
+    { c with cl_env = keep_only_summary c.cl_env }
+  let leave_module_expr m =
+    { m with mod_env = keep_only_summary m.mod_env }
+  let leave_structure s =
+    { s with str_final_env = keep_only_summary s.str_final_env }
+  let leave_structure_item str =
+    { str with str_env = keep_only_summary str.str_env }
+  let leave_module_type m =
+    { m with mty_env = keep_only_summary m.mty_env }
+  let leave_signature s =
+    { s with sig_final_env = keep_only_summary s.sig_final_env }
+  let leave_signature_item s =
+    { s with sig_env = keep_only_summary s.sig_env }
+  let leave_core_type c =
+    { c with ctyp_env = keep_only_summary c.ctyp_env }
+  let leave_class_type c =
+    { c with cltyp_env = keep_only_summary c.cltyp_env }
+
+end)
+
+let clear_part p = match p with
+  | Partial_structure s -> Partial_structure (ClearEnv.map_structure s)
+  | Partial_structure_item s ->
+    Partial_structure_item (ClearEnv.map_structure_item s)
+  | Partial_expression e -> Partial_expression (ClearEnv.map_expression e)
+  | Partial_pattern p -> Partial_pattern (ClearEnv.map_pattern p)
+  | Partial_class_expr ce -> Partial_class_expr (ClearEnv.map_class_expr ce)
+  | Partial_signature s -> Partial_signature (ClearEnv.map_signature s)
+  | Partial_signature_item s ->
+    Partial_signature_item (ClearEnv.map_signature_item s)
+  | Partial_module_type s -> Partial_module_type (ClearEnv.map_module_type s)
+
+let clear_env binary_annots =
+  if need_to_clear_env then
+    match binary_annots with
+      | Implementation s -> Implementation (ClearEnv.map_structure s)
+      | Interface s -> Interface (ClearEnv.map_signature s)
+      | Packed _ -> binary_annots
+      | Partial_implementation array ->
+        Partial_implementation (Array.map clear_part array)
+      | Partial_interface array ->
+        Partial_interface (Array.map clear_part array)
+
+  else binary_annots
+
+
+
+
+exception Error of error
+
+let input_cmt ic = (input_value ic : cmt_infos)
+
+let output_cmt oc cmt =
+  output_string oc Config.cmt_magic_number;
+  output_value oc (cmt : cmt_infos)
+
+let read filename =
+(*  Printf.fprintf stderr "Cmt_format.read %s\n%!" filename; *)
+  let ic = open_in_bin filename in
+  try
+    let magic_number = read_magic_number ic in
+    let cmi, cmt =
+      if magic_number = Config.cmt_magic_number then
+        None, Some (input_cmt ic)
+      else if magic_number = Config.cmi_magic_number then
+        let cmi = Cmi_format.input_cmi ic in
+        let cmt = try
+                    let magic_number = read_magic_number ic in
+                    if magic_number = Config.cmt_magic_number then
+                      let cmt = input_cmt ic in
+                      Some cmt
+                    else None
+          with _ -> None
+        in
+        Some cmi, cmt
+      else
+        raise(Cmi_format.Error(Cmi_format.Not_an_interface filename))
+    in
+    close_in ic;
+(*    Printf.fprintf stderr "Cmt_format.read done\n%!"; *)
+    cmi, cmt
+  with e ->
+    close_in ic;
+    raise e
+
+let string_of_file filename =
+  let ic = open_in filename in
+  let s = Misc.string_of_file ic in
+  close_in ic;
+  s
+
+let read_cmt filename =
+  match read filename with
+      _, None -> raise (Error (Not_a_typedtree filename))
+    | _, Some cmt -> cmt
+
+let read_cmi filename =
+  match read filename with
+      None, _ ->
+        raise (Cmi_format.Error (Cmi_format.Not_an_interface filename))
+    | Some cmi, _ -> cmi
+
+let saved_types = ref []
+
+let add_saved_type b = saved_types := b :: !saved_types
+let get_saved_types () = !saved_types
+let set_saved_types l = saved_types := l
+
+let save_cmt filename modname binary_annots sourcefile initial_env sg =
+  if !Clflags.binary_annotations && not !Clflags.print_types then begin
+    let imports = Env.imported_units () in
+    let oc = open_out_bin filename in
+    let this_crc =
+      match sg with
+          None -> None
+        | Some (sg) ->
+          let cmi = {
+            cmi_name = modname;
+            cmi_sign = sg;
+            cmi_flags =
+            if !Clflags.recursive_types then [Cmi_format.Rectypes] else [];
+            cmi_crcs = imports;
+          } in
+          Some (output_cmi filename oc cmi)
+    in
+    let source_digest = Misc.may_map Digest.file sourcefile in
+    let cmt = {
+      cmt_modname = modname;
+      cmt_annots = clear_env binary_annots;
+      cmt_comments = Lexer.comments ();
+      cmt_args = Sys.argv;
+      cmt_sourcefile = sourcefile;
+      cmt_builddir =  Sys.getcwd ();
+      cmt_loadpath = !Config.load_path;
+      cmt_source_digest = source_digest;
+      cmt_initial_env = if need_to_clear_env then
+          keep_only_summary initial_env else initial_env;
+      cmt_imports = List.sort compare imports;
+      cmt_interface_digest = this_crc;
+      cmt_use_summaries = need_to_clear_env;
+    } in
+    output_cmt oc cmt;
+    close_out oc;
+    set_saved_types [];
+  end;
+  set_saved_types  []
diff -Nru ocaml-3.12.1/typing/cmt_format.mli ocaml-4.01.0/typing/cmt_format.mli
--- ocaml-3.12.1/typing/cmt_format.mli	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/typing/cmt_format.mli	2012-07-12 11:02:18.000000000 +0000
@@ -0,0 +1,112 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                  Fabrice Le Fessant, INRIA Saclay                   *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(** cmt and cmti files format. *)
+
+(** The layout of a cmt file is as follows:
+       := \{\}  \{cmt infos\} \{\}
+    where  is the cmi file format:
+       :=  .
+    More precisely, the optional  part must be present if and only if
+    the file is:
+    - a cmti, or
+    - a cmt, for a ml file which has no corresponding mli (hence no
+    corresponding cmti).
+
+    Thus, we provide a common reading function for cmi and cmt(i)
+    files which returns an option for each of the three parts: cmi
+    info, cmt info, source info. *)
+
+open Typedtree
+
+type binary_annots =
+  | Packed of Types.signature * string list
+  | Implementation of structure
+  | Interface of signature
+  | Partial_implementation of binary_part array
+  | Partial_interface of binary_part array
+
+and binary_part =
+  | Partial_structure of structure
+  | Partial_structure_item of structure_item
+  | Partial_expression of expression
+  | Partial_pattern of pattern
+  | Partial_class_expr of class_expr
+  | Partial_signature of signature
+  | Partial_signature_item of signature_item
+  | Partial_module_type of module_type
+
+type cmt_infos = {
+  cmt_modname : string;
+  cmt_annots : binary_annots;
+  cmt_comments : (string * Location.t) list;
+  cmt_args : string array;
+  cmt_sourcefile : string option;
+  cmt_builddir : string;
+  cmt_loadpath : string list;
+  cmt_source_digest : string option;
+  cmt_initial_env : Env.t;
+  cmt_imports : (string * Digest.t) list;
+  cmt_interface_digest : Digest.t option;
+  cmt_use_summaries : bool;
+}
+
+type error =
+    Not_a_typedtree of string
+
+exception Error of error
+
+(** [read filename] opens filename, and extract both the cmi_infos, if
+    it exists, and the cmt_infos, if it exists. Thus, it can be used
+    with .cmi, .cmt and .cmti files.
+
+    .cmti files always contain a cmi_infos at the beginning. .cmt files
+    only contain a cmi_infos at the beginning if there is no associated
+    .cmti file.
+*)
+val read : string -> Cmi_format.cmi_infos option * cmt_infos option
+
+val read_cmt : string -> cmt_infos
+val read_cmi : string -> Cmi_format.cmi_infos
+
+(** [save_cmt modname filename binary_annots sourcefile initial_env sg]
+    writes a cmt(i) file.  *)
+val save_cmt :
+  string ->  (* filename.cmt to generate *)
+  string ->  (* module name *)
+  binary_annots ->
+  string option ->  (* source file *)
+  Env.t -> (* initial env *)
+  Types.signature option -> (* if a .cmi was generated,
+                               the signature saved there *)
+  unit
+
+(* Miscellaneous functions *)
+
+val read_magic_number : in_channel -> string
+
+val add_saved_type : binary_part -> unit
+val get_saved_types : unit -> binary_part list
+val set_saved_types : binary_part list -> unit
+
+
+(*
+
+  val is_magic_number : string -> bool
+  val read : in_channel -> Env.cmi_infos option * t
+  val write_magic_number : out_channel -> unit
+  val write : out_channel -> t -> unit
+
+  val find : string list -> string -> string
+  val read_signature : 'a -> string -> Types.signature * 'b list * 'c list
+
+*)
diff -Nru ocaml-3.12.1/typing/ctype.ml ocaml-4.01.0/typing/ctype.ml
--- ocaml-3.12.1/typing/ctype.ml	2010-10-02 08:56:39.000000000 +0000
+++ ocaml-4.01.0/typing/ctype.ml	2013-09-06 05:48:29.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (* Xavier Leroy and Jerome Vouillon, projet Cristal, INRIA Rocquencourt*)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: ctype.ml 10702 2010-10-02 08:56:39Z garrigue $ *)
-
 (* Operations on core types *)
 
 open Misc
@@ -95,6 +93,9 @@
 
 exception Recursive_abbrev
 
+(* GADT: recursive abbrevs can appear as a result of local constraints *)
+exception Unification_recursive_abbrev of (type_expr * type_expr) list
+
 (**** Type level management ****)
 
 let current_level = ref 0
@@ -102,6 +103,7 @@
 let global_level = ref 1
 let saved_level = ref []
 
+let get_current_level () = !current_level
 let init_def level = current_level := level; nongen_level := level
 let begin_def () =
   saved_level := (!current_level, !nongen_level) :: !saved_level;
@@ -136,9 +138,18 @@
 
 (**** Abbreviations without parameters ****)
 (* Shall reset after generalizing *)
+
+let trace_gadt_instances = ref false
+let check_trace_gadt_instances env =
+  not !trace_gadt_instances && Env.has_local_constraints env &&
+  (trace_gadt_instances := true; cleanup_abbrev (); true)
+
 let simple_abbrevs = ref Mnil
+
 let proper_abbrevs path tl abbrev =
-  if !Clflags.principal || tl <> [] || is_object_type path then abbrev
+  if tl <> [] || !trace_gadt_instances || !Clflags.principal ||
+     is_object_type path
+  then abbrev
   else simple_abbrevs
 
 (**** Some type creators ****)
@@ -149,9 +160,9 @@
 let newty desc         = newty2 !current_level desc
 let new_global_ty desc = newty2 !global_level desc
 
-let newvar ()          = newty2 !current_level Tvar
-let newvar2 level      = newty2 level Tvar
-let new_global_var ()  = newty2 !global_level Tvar
+let newvar ?name ()         = newty2 !current_level (Tvar name)
+let newvar2 ?name level     = newty2 level (Tvar name)
+let new_global_var ?name () = newty2 !global_level (Tvar name)
 
 let newobj fields      = newty (Tobject (fields, ref None))
 
@@ -173,6 +184,49 @@
     let hash (t, t') = t.id + 93 * t'.id
  end)
 
+
+(**** unification mode ****)
+
+type unification_mode =
+  | Expression (* unification in expression *)
+  | Pattern (* unification in pattern which may add local constraints *)
+
+let umode = ref Expression
+let generate_equations = ref false
+
+let set_mode mode ?(generate = (mode = Pattern)) f =
+  let old_unification_mode = !umode
+  and old_gen = !generate_equations in
+  try
+    umode := mode;
+    generate_equations := generate;
+    let ret = f () in
+    umode := old_unification_mode;
+    generate_equations := old_gen;
+    ret
+  with e ->
+    umode := old_unification_mode;
+    generate_equations := old_gen;
+    raise e
+
+
+(*** Checks for type definitions ***)
+
+let in_current_module = function
+  | Path.Pident _ -> true
+  | Path.Pdot _ | Path.Papply _ -> false
+
+let in_pervasives p =
+  in_current_module p &&
+  try ignore (Env.find_type p Env.initial); true
+  with Not_found -> false
+
+let is_datatype decl=
+  match decl.type_kind with
+    Type_record _ | Type_variant _ -> true
+  | Type_abstract -> false
+
+
                   (**********************************************)
                   (*  Miscellaneous operations on object types  *)
                   (**********************************************)
@@ -185,8 +239,6 @@
 
 (**** Object field manipulation. ****)
 
-let dummy_method = "*dummy method*"
-
 let object_fields ty =
   match (repr ty).desc with
     Tobject (fields, _) -> fields
@@ -236,10 +288,13 @@
 
 let opened_object ty =
   match (object_row ty).desc with
-  | Tvar               -> true
-  | Tunivar            -> true
-  | Tconstr _          -> true
-  | _                  -> false
+  | Tvar _  | Tunivar _ | Tconstr _ -> true
+  | _                               -> false
+
+let concrete_object ty =
+  match (object_row ty).desc with
+  | Tvar _             -> false
+  | _                  -> true
 
 (**** Close an object ****)
 
@@ -247,7 +302,7 @@
   let rec close ty =
     let ty = repr ty in
     match ty.desc with
-      Tvar ->
+      Tvar _ ->
         link_type ty (newty2 ty.level Tnil)
     | Tfield(_, _, _, ty') -> close ty'
     | _                    -> assert false
@@ -263,7 +318,7 @@
     let ty = repr ty in
     match ty.desc with
       Tfield (_, _, _, ty) -> find ty
-    | Tvar                 -> ty
+    | Tvar _               -> ty
     | _                    -> assert false
   in
   match (repr ty).desc with
@@ -310,18 +365,18 @@
 
 let rec signature_of_class_type =
   function
-    Tcty_constr (_, _, cty) -> signature_of_class_type cty
-  | Tcty_signature sign     -> sign
-  | Tcty_fun (_, ty, cty)   -> signature_of_class_type cty
+    Cty_constr (_, _, cty) -> signature_of_class_type cty
+  | Cty_signature sign     -> sign
+  | Cty_fun (_, ty, cty)   -> signature_of_class_type cty
 
 let self_type cty =
   repr (signature_of_class_type cty).cty_self
 
 let rec class_type_arity =
   function
-    Tcty_constr (_, _, cty) ->  class_type_arity cty
-  | Tcty_signature _        ->  0
-  | Tcty_fun (_, _, cty)    ->  1 + class_type_arity cty
+    Cty_constr (_, _, cty) ->  class_type_arity cty
+  | Cty_signature _        ->  0
+  | Cty_fun (_, _, cty)    ->  1 + class_type_arity cty
 
 
                   (*******************************************)
@@ -368,7 +423,7 @@
     let level = ty.level in
     ty.level <- pivot_level - level;
     match ty.desc with
-      Tvar when level <> generic_level ->
+      Tvar _ when level <> generic_level ->
         raise Non_closed
     | Tfield(_, kind, t1, t2) ->
         if field_kind_repr kind = Fpresent then
@@ -402,11 +457,11 @@
   if ty.level >= lowest_level then begin
     ty.level <- pivot_level - ty.level;
     begin match ty.desc, !really_closed with
-      Tvar, _ ->
+      Tvar _, _ ->
         free_variables := (ty, real) :: !free_variables
     | Tconstr (path, tl, _), Some env ->
         begin try
-          let (_, body) = Env.find_type_expansion path env in
+          let (_, body, _) = Env.find_type_expansion path env in
           if (repr body).level <> generic_level then
             free_variables := (ty, real) :: !free_variables
         with Not_found -> ()
@@ -443,7 +498,7 @@
   unmark_type ty;
   tl
 
-let rec closed_type ty =
+let closed_type ty =
   match free_vars ty with
       []           -> ()
   | (v, real) :: _ -> raise (Non_closed (v, real))
@@ -463,7 +518,13 @@
       Type_abstract ->
         ()
     | Type_variant v ->
-        List.iter (fun (_, tyl) -> List.iter closed_type tyl) v
+        List.iter
+          (fun (_, tyl,ret_type_opt) ->
+            match ret_type_opt with
+            | Some _ -> ()
+            | None ->
+                List.iter closed_type tyl)
+          v
     | Type_record(r, rep) ->
         List.iter (fun (_, _, ty) -> closed_type ty) r
     end;
@@ -567,14 +628,16 @@
 let rec generalize_structure var_level ty =
   let ty = repr ty in
   if ty.level <> generic_level then begin
-    if ty.desc = Tvar && ty.level > var_level then
+    if is_Tvar ty && ty.level > var_level then
       set_level ty var_level
-    else if ty.level > !current_level then begin
+    else if
+      ty.level > !current_level &&
+      match ty.desc with
+        Tconstr (p, _, abbrev) ->
+          not (is_object_type p) && (abbrev := Mnil; true)
+      | _ -> true
+    then begin
       set_level ty generic_level;
-      begin match ty.desc with
-        Tconstr (_, _, abbrev) -> abbrev := Mnil
-      | _ -> ()
-      end;
       iter_type_expr (generalize_structure var_level) ty
     end
   end
@@ -583,19 +646,27 @@
   simple_abbrevs := Mnil;
   generalize_structure var_level ty
 
-(* let generalize_expansive ty = generalize_structure !nongen_level ty *)
-let generalize_global ty = generalize_structure !global_level ty
-let generalize_structure ty = generalize_structure !current_level ty
-
 (* Generalize the spine of a function, if the level >= !current_level *)
 
 let rec generalize_spine ty =
   let ty = repr ty in
   if ty.level < !current_level || ty.level = generic_level then () else
   match ty.desc with
-    Tarrow (_, _, ty', _) | Tpoly (ty', _) ->
+    Tarrow (_, ty1, ty2, _) ->
+      set_level ty generic_level;
+      generalize_spine ty1;
+      generalize_spine ty2;
+  | Tpoly (ty', _) ->
       set_level ty generic_level;
       generalize_spine ty'
+  | Ttuple tyl
+  | Tpackage (_, _, tyl) ->
+      set_level ty generic_level;
+      List.iter generalize_spine tyl
+  | Tconstr (p, tyl, memo) when not (is_object_type p) ->
+      set_level ty generic_level;
+      memo := Mnil;
+      List.iter generalize_spine tyl
   | _ -> ()
 
 let forward_try_expand_once = (* Forward declaration *)
@@ -613,46 +684,66 @@
       module M = struct type t let _ = (x : t list ref) end
     (without this constraint, the type system would actually be unsound.)
 *)
+let get_level env p =
+  try
+    match (Env.find_type p env).type_newtype_level with
+      | None -> Path.binding_time p
+      | Some (x, _) -> x
+  with
+    | Not_found ->
+      (* no newtypes in predef *)
+      Path.binding_time p
+
 let rec update_level env level ty =
   let ty = repr ty in
   if ty.level > level then begin
-    begin match ty.desc with
-      Tconstr(p, tl, abbrev)  when level < Path.binding_time p ->
+    begin match Env.gadt_instance_level env ty with
+      Some lv -> if level < lv then raise (Unify [(ty, newvar2 level)])
+    | None -> ()
+    end;
+    match ty.desc with
+      Tconstr(p, tl, abbrev) when level < get_level env p ->
         (* Try first to replace an abbreviation by its expansion. *)
         begin try
+          (* if is_newtype env p then raise Cannot_expand; *)
           link_type ty (!forward_try_expand_once env ty);
           update_level env level ty
         with Cannot_expand ->
           (* +++ Levels should be restored... *)
-          raise (Unify [(ty, newvar2 level)])
+          (* Format.printf "update_level: %i < %i@." level (get_level env p); *)
+          if level < get_level env p then raise (Unify [(ty, newvar2 level)]);
+          iter_type_expr (update_level env level) ty
         end
-    | Tpackage (p, _, _) when level < Path.binding_time p ->
+    | Tpackage (p, _, _) when level < get_level env p ->
         raise (Unify [(ty, newvar2 level)])
     | Tobject(_, ({contents=Some(p, tl)} as nm))
-      when level < Path.binding_time p ->
+      when level < get_level env p ->
         set_name nm None;
         update_level env level ty
     | Tvariant row ->
         let row = row_repr row in
         begin match row.row_name with
-        | Some (p, tl) when level < Path.binding_time p ->
+        | Some (p, tl) when level < get_level env p ->
             log_type ty;
             ty.desc <- Tvariant {row with row_name = None}
         | _ -> ()
         end;
         set_level ty level;
         iter_type_expr (update_level env level) ty
-    | Tfield(lab, _, _, _) when lab = dummy_method ->
-        raise (Unify [(ty, newvar2 level)])
+    | Tfield(lab, _, ty1, _)
+      when lab = dummy_method && (repr ty1).level > level ->
+        raise (Unify [(ty1, newvar2 level)])
     | _ ->
         set_level ty level;
         (* XXX what about abbreviations in Tconstr ? *)
         iter_type_expr (update_level env level) ty
-    end
   end
 
 (* Generalize and lower levels of contravariant branches simultaneously *)
 
+let generalize_contravariant env =
+  if !Clflags.principal then generalize_structure else update_level env
+
 let rec generalize_expansive env var_level ty =
   let ty = repr ty in
   if ty.level <> generic_level then begin
@@ -662,17 +753,18 @@
         Tconstr (path, tyl, abbrev) ->
           let variance =
             try (Env.find_type path env).type_variance
-            with Not_found -> List.map (fun _ -> (true,true,true)) tyl in
+            with Not_found -> List.map (fun _ -> Variance.may_inv) tyl in
           abbrev := Mnil;
           List.iter2
-            (fun (co,cn,ct) t ->
-              if ct then update_level env var_level t
+            (fun v t ->
+              if Variance.(mem May_weak v)
+              then generalize_contravariant env var_level t
               else generalize_expansive env var_level t)
             variance tyl
       | Tpackage (_, _, tyl) ->
-          List.iter (update_level env var_level) tyl
+          List.iter (generalize_contravariant env var_level) tyl
       | Tarrow (_, t1, t2, _) ->
-          update_level env var_level t1;
+          generalize_contravariant env var_level t1;
           generalize_expansive env var_level t2
       | _ ->
           iter_type_expr (generalize_expansive env var_level) ty
@@ -683,8 +775,11 @@
   simple_abbrevs := Mnil;
   try
     generalize_expansive env !nongen_level ty
-  with Unify [_, ty'] ->
-    raise (Unify [ty, ty'])
+  with Unify ([_, ty'] as tr) ->
+    raise (Unify ((ty, ty') :: tr))
+
+let generalize_global ty = generalize_structure !global_level ty
+let generalize_structure ty = generalize_structure !current_level ty
 
 (* Correct the levels of type [ty]. *)
 let correct_levels ty =
@@ -738,6 +833,47 @@
     graph
 
 
+(* Compute statically the free univars of all nodes in a type *)
+(* This avoids doing it repeatedly during instantiation *)
+
+type inv_type_expr =
+    { inv_type : type_expr;
+      mutable inv_parents : inv_type_expr list }
+
+let rec inv_type hash pty ty =
+  let ty = repr ty in
+  try
+    let inv = TypeHash.find hash ty in
+    inv.inv_parents <- pty @ inv.inv_parents
+  with Not_found ->
+    let inv = { inv_type = ty; inv_parents = pty } in
+    TypeHash.add hash ty inv;
+    iter_type_expr (inv_type hash [inv]) ty
+
+let compute_univars ty =
+  let inverted = TypeHash.create 17 in
+  inv_type inverted [] ty;
+  let node_univars = TypeHash.create 17 in
+  let rec add_univar univ inv =
+    match inv.inv_type.desc with
+      Tpoly (ty, tl) when List.memq univ (List.map repr tl) -> ()
+    | _ ->
+        try
+          let univs = TypeHash.find node_univars inv.inv_type in
+          if not (TypeSet.mem univ !univs) then begin
+            univs := TypeSet.add univ !univs;
+            List.iter (add_univar univ) inv.inv_parents
+          end
+        with Not_found ->
+          TypeHash.add node_univars inv.inv_type (ref(TypeSet.singleton univ));
+          List.iter (add_univar univ) inv.inv_parents
+  in
+  TypeHash.iter (fun ty inv -> if is_Tunivar ty then add_univar ty inv)
+    inverted;
+  fun ty ->
+    try !(TypeHash.find node_univars ty) with Not_found -> TypeSet.empty
+
+
                               (*******************)
                               (*  Instantiation  *)
                               (*******************)
@@ -767,15 +903,38 @@
 let abbreviations = ref (ref Mnil)
   (* Abbreviation memorized. *)
 
-let rec copy ty =
+(* partial: we may not wish to copy the non generic types
+   before we call type_pat *)
+let rec copy ?env ?partial ?keep_names ty =
+  let copy = copy ?env ?partial ?keep_names in
   let ty = repr ty in
   match ty.desc with
     Tsubst ty -> ty
   | _ ->
-    if ty.level <> generic_level then ty else
+    if ty.level <> generic_level && partial = None then ty else
+    (* We only forget types that are non generic and do not contain
+       free univars *)
+    let forget =
+      if ty.level = generic_level then generic_level else
+      match partial with
+        None -> assert false
+      | Some (free_univars, keep) ->
+          if TypeSet.is_empty (free_univars ty) then
+            if keep then ty.level else !current_level
+          else generic_level
+    in
+    if forget <> generic_level then newty2 forget (Tvar None) else
     let desc = ty.desc in
     save_desc ty desc;
     let t = newvar() in          (* Stub *)
+    begin match env with
+      Some env when Env.has_local_constraints env ->
+        begin match Env.gadt_instance_level env ty with
+          Some lv -> Env.add_gadt_instances env lv [t]
+        | None -> ()
+        end
+    | _ -> ()
+    end;
     ty.desc <- Tsubst t;
     t.desc <-
       begin match desc with
@@ -815,14 +974,39 @@
               let more' =
                 match more.desc with
                   Tsubst ty -> ty
-                | Tconstr _ ->
+                | Tconstr _ | Tnil ->
                     if keep then save_desc more more.desc;
                     copy more
-                | Tvar | Tunivar ->
+                | Tvar _ | Tunivar _ ->
                     save_desc more more.desc;
                     if keep then more else newty more.desc
                 |  _ -> assert false
               in
+              let row =
+                match repr more' with (* PR#6163 *)
+                  {desc=Tconstr _} when not row.row_fixed ->
+                    {row with row_fixed = true}
+                | _ -> row
+              in
+              (* Open row if partial for pattern and contains Reither *)
+              let more', row =
+                match partial with
+                  Some (free_univars, false) when row.row_closed
+                  && not row.row_fixed && TypeSet.is_empty (free_univars ty) ->
+                    let not_reither (_, f) =
+                      match row_field_repr f with
+                        Reither _ -> false
+                      | _ -> true
+                    in
+                    if List.for_all not_reither row.row_fields
+                    then (more', row) else
+                    (newty2 (if keep then more.level else !current_level)
+                       (Tvar None),
+                     {row_fields = List.filter not_reither row.row_fields;
+                      row_more = more; row_bound = ();
+                      row_closed = false; row_fixed = false; row_name = None})
+                | _ -> (more', row)
+              in
               (* Register new type first for recursion *)
               more.desc <- Tsubst(newgenty(Ttuple[more';t]));
               (* Return a new copy *)
@@ -836,30 +1020,93 @@
               dup_kind r;
               copy_type_desc copy desc
           end
-      | _ -> copy_type_desc copy desc
+      | Tobject (ty1, _) when partial <> None ->
+          Tobject (copy ty1, ref None)
+      | _ -> copy_type_desc ?keep_names copy desc
       end;
     t
 
 (**** Variants of instantiations ****)
 
-let instance sch =
+let gadt_env env =
+  if Env.has_local_constraints env
+  then Some env
+  else None
+
+let instance ?partial env sch =
+  let env = gadt_env env in
+  let partial =
+    match partial with
+      None -> None
+    | Some keep -> Some (compute_univars sch, keep)
+  in
+  let ty = copy ?env ?partial sch in
+  cleanup_types ();
+  ty
+
+let instance_def sch =
   let ty = copy sch in
   cleanup_types ();
   ty
 
-let instance_list schl =
-  let tyl = List.map copy schl in
+let instance_list env schl =
+  let env = gadt_env env in
+  let tyl = List.map (copy ?env) schl in
   cleanup_types ();
   tyl
 
-let instance_constructor cstr =
+let reified_var_counter = ref Vars.empty
+
+(* names given to new type constructors.
+   Used for existential types and
+   local constraints *)
+let get_new_abstract_name s =
+  let index =
+    try Vars.find s !reified_var_counter + 1
+    with Not_found -> 0 in
+  reified_var_counter := Vars.add s index !reified_var_counter;
+  Printf.sprintf "%s#%d" s index
+
+let new_declaration newtype manifest =
+  {
+    type_params = [];
+    type_arity = 0;
+    type_kind = Type_abstract;
+    type_private = Public;
+    type_manifest = manifest;
+    type_variance = [];
+    type_newtype_level = newtype;
+    type_loc = Location.none;
+  }
+
+let instance_constructor ?in_pattern cstr =
+  begin match in_pattern with
+  | None -> ()
+  | Some (env, newtype_lev) ->
+      let process existential =
+        let decl = new_declaration (Some (newtype_lev, newtype_lev)) None in
+        let name =
+          match repr existential with
+            {desc = Tvar (Some name)} -> name
+          | _ -> "ex"
+        in
+        let (id, new_env) =
+          Env.enter_type (get_new_abstract_name name) decl !env in
+        env := new_env;
+        let to_unify = newty (Tconstr (Path.Pident id,[],ref Mnil)) in
+        let tv = copy existential in
+        assert (is_Tvar tv);
+        link_type tv to_unify
+      in
+      List.iter process cstr.cstr_existentials
+  end;
   let ty_res = copy cstr.cstr_res in
   let ty_args = List.map copy cstr.cstr_args in
   cleanup_types ();
   (ty_args, ty_res)
 
-let instance_parameterized_type sch_args sch =
-  let ty_args = List.map copy sch_args in
+let instance_parameterized_type ?keep_names sch_args sch =
+  let ty_args = List.map (copy ?keep_names) sch_args in
   let ty = copy sch in
   cleanup_types ();
   (ty_args, ty)
@@ -878,7 +1125,9 @@
      type_kind = match decl.type_kind with
      | Type_abstract -> Type_abstract
      | Type_variant cl ->
-         Type_variant (List.map (fun (s,tl) -> (s, List.map copy tl)) cl)
+         Type_variant (
+         List.map (fun (s,tl,ot) -> (s, List.map copy tl, may_map copy ot))
+           cl)
      | Type_record (fl, rr) ->
          Type_record (List.map (fun (s,m,ty) -> (s, m, copy ty)) fl, rr)}
   in
@@ -888,18 +1137,18 @@
 let instance_class params cty =
   let rec copy_class_type =
     function
-      Tcty_constr (path, tyl, cty) ->
-        Tcty_constr (path, List.map copy tyl, copy_class_type cty)
-    | Tcty_signature sign ->
-        Tcty_signature
+      Cty_constr (path, tyl, cty) ->
+        Cty_constr (path, List.map copy tyl, copy_class_type cty)
+    | Cty_signature sign ->
+        Cty_signature
           {cty_self = copy sign.cty_self;
            cty_vars =
              Vars.map (function (m, v, ty) -> (m, v, copy ty)) sign.cty_vars;
            cty_concr = sign.cty_concr;
            cty_inher =
              List.map (fun (p,tl) -> (p, List.map copy tl)) sign.cty_inher}
-    | Tcty_fun (l, ty, cty) ->
-        Tcty_fun (l, copy ty, copy_class_type cty)
+    | Cty_fun (l, ty, cty) ->
+        Cty_fun (l, copy ty, copy_class_type cty)
   in
   let params' = List.map copy params in
   let cty' = copy_class_type cty in
@@ -908,46 +1157,6 @@
 
 (**** Instanciation for types with free universal variables ****)
 
-module TypeHash = Hashtbl.Make(TypeOps)
-module TypeSet = Set.Make(TypeOps)
-
-type inv_type_expr =
-    { inv_type : type_expr;
-      mutable inv_parents : inv_type_expr list }
-
-let rec inv_type hash pty ty =
-  let ty = repr ty in
-  try
-    let inv = TypeHash.find hash ty in
-    inv.inv_parents <- pty @ inv.inv_parents
-  with Not_found ->
-    let inv = { inv_type = ty; inv_parents = pty } in
-    TypeHash.add hash ty inv;
-    iter_type_expr (inv_type hash [inv]) ty
-
-let compute_univars ty =
-  let inverted = TypeHash.create 17 in
-  inv_type inverted [] ty;
-  let node_univars = TypeHash.create 17 in
-  let rec add_univar univ inv =
-    match inv.inv_type.desc with
-      Tpoly (ty, tl) when List.memq univ (List.map repr tl) -> ()
-    | _ ->
-        try
-          let univs = TypeHash.find node_univars inv.inv_type in
-          if not (TypeSet.mem univ !univs) then begin
-            univs := TypeSet.add univ !univs;
-            List.iter (add_univar univ) inv.inv_parents
-          end
-        with Not_found ->
-          TypeHash.add node_univars inv.inv_type (ref(TypeSet.singleton univ));
-          List.iter (add_univar univ) inv.inv_parents
-  in
-  TypeHash.iter (fun ty inv -> if ty.desc = Tunivar then add_univar ty inv)
-    inverted;
-  fun ty ->
-    try !(TypeHash.find node_univars ty) with Not_found -> TypeSet.empty
-
 let rec diff_list l1 l2 =
   if l1 == l2 then [] else
   match l1 with [] -> invalid_arg "Ctype.diff_list"
@@ -974,7 +1183,7 @@
     t
   else try
     let t, bound_t = List.assq ty visited in
-    let dl = if ty.desc = Tunivar then [] else diff_list bound bound_t in
+    let dl = if is_Tunivar ty then [] else diff_list bound bound_t in
     if dl <> [] && conflicts univars dl then raise Not_found;
     t
   with Not_found -> begin
@@ -991,14 +1200,14 @@
           let row = row_repr row0 in
           let more = repr row.row_more in
           (* We shall really check the level on the row variable *)
-          let keep = more.desc = Tvar && more.level <> generic_level in
+          let keep = is_Tvar more && more.level <> generic_level in
           let more' = copy_rec more in
-          let fixed' = fixed && (repr more').desc = Tvar in
+          let fixed' = fixed && is_Tvar (repr more') in
           let row = copy_row copy_rec fixed' row keep more' in
           Tvariant row
       | Tpoly (t1, tl) ->
           let tl = List.map repr tl in
-          let tl' = List.map (fun t -> newty Tunivar) tl in
+          let tl' = List.map (fun t -> newty t.desc) tl in
           let bound = tl @ bound in
           let visited =
             List.map2 (fun ty t -> ty,(t,bound)) tl tl' @ visited in
@@ -1008,9 +1217,15 @@
     t
   end
 
-let instance_poly fixed univars sch =
-  let vars = List.map (fun _ -> newvar ()) univars in
-  let pairs = List.map2 (fun u v -> repr u, (v, [])) univars vars in
+let instance_poly ?(keep_names=false) fixed univars sch =
+  let univars = List.map repr univars in
+  let copy_var ty =
+    match ty.desc with
+      Tunivar name -> if keep_names then newty (Tvar name) else newvar ()
+    | _ -> assert false
+  in
+  let vars = List.map copy_var univars in
+  let pairs = List.map2 (fun u v -> u, (v, [])) univars vars in
   delayed_copy := [];
   let ty = copy_sep fixed (compute_univars sch) [] pairs sch in
   List.iter Lazy.force !delayed_copy;
@@ -1035,7 +1250,7 @@
 let unify' = (* Forward declaration *)
   ref (fun env ty1 ty2 -> raise (Unify []))
 
-let rec subst env level priv abbrev ty params args body =
+let subst env level priv abbrev ty params args body =
   if List.length params <> List.length args then raise (Unify []);
   let old_level = !current_level in
   current_level := level;
@@ -1092,6 +1307,7 @@
     previous_env := env
   end
 
+
 (* Expand an abbreviation. The expansion is memorized. *)
 (*
    Assume the level is greater than the path binding time of the
@@ -1130,8 +1346,8 @@
             end;
           ty
       | None ->
-          let (params, body) =
-            try find_type_expansion path env with Not_found ->
+          let (params, body, lv) =
+            try find_type_expansion level path env with Not_found ->
               raise Cannot_expand
           in
           (* prerr_endline
@@ -1143,13 +1359,30 @@
               ty.desc <- Tvariant { row with row_name = Some (path, args) }
           | _ -> ()
           end;
+          (* For gadts, remember type as non exportable *)
+          (* The ambiguous level registered for ty' should be the highest *)
+          if !trace_gadt_instances then begin
+            match max lv (Env.gadt_instance_level env ty) with
+              None -> ()
+            | Some lv ->
+                if level < lv then raise (Unify [(ty, newvar2 level)]);
+                Env.add_gadt_instances env lv [ty; ty']
+          end;
           ty'
       end
   | _ ->
       assert false
 
-let expand_abbrev = expand_abbrev_gen Public Env.find_type_expansion
+(* inside objects and variants we do not want to
+   use local constraints *)
+let expand_abbrev ty =
+  expand_abbrev_gen Public (fun level -> Env.find_type_expansion ~level) ty
 
+(* Expand once the head of a type *)
+let expand_head_once env ty =
+  try expand_abbrev env (repr ty) with Cannot_expand -> assert false
+
+(* Check whether a type can be expanded *)
 let safe_abbrev env ty =
   let snap = Btype.snapshot () in
   try ignore (expand_abbrev env ty); true
@@ -1157,39 +1390,61 @@
     Btype.backtrack snap;
     false
 
+(* Expand the head of a type once.
+   Raise Cannot_expand if the type cannot be expanded.
+   May raise Unify, if a recursion was hidden in the type. *)
 let try_expand_once env ty =
   let ty = repr ty in
   match ty.desc with
-    Tconstr _ -> repr (expand_abbrev env ty)
+    Tconstr (p, _, _) -> repr (expand_abbrev env ty)
   | _ -> raise Cannot_expand
 
-let _ = forward_try_expand_once := try_expand_once
-
-(* Fully expand the head of a type.
-   Raise Cannot_expand if the type cannot be expanded.
-   May raise Unify, if a recursion was hidden in the type. *)
-let rec try_expand_head env ty =
-  let ty' = try_expand_once env ty in
-  begin try
-    try_expand_head env ty'
-  with Cannot_expand ->
-    ty'
-  end
-
-(* Expand once the head of a type *)
-let expand_head_once env ty =
-  try expand_abbrev env (repr ty) with Cannot_expand -> assert false
+(* This one only raises Cannot_expand *)
+let try_expand_safe env ty =
+  let snap = Btype.snapshot () in
+  try try_expand_once env ty
+  with Unify _ ->
+    Btype.backtrack snap; raise Cannot_expand
 
 (* Fully expand the head of a type. *)
+let rec try_expand_head try_once env ty =
+  let ty' = try_once env ty in
+  try try_expand_head try_once env ty'
+  with Cannot_expand -> ty'
+
+let try_expand_head try_once env ty =
+  let ty' = try_expand_head try_once env ty in
+  begin match Env.gadt_instance_level env ty' with
+    None -> ()
+  | Some lv -> Env.add_gadt_instance_chain env lv ty
+  end;
+  ty'
+
+(* Unsafe full expansion, may raise Unify. *)
 let expand_head_unif env ty =
-  try try_expand_head env ty with Cannot_expand -> repr ty
+  try try_expand_head try_expand_once env ty with Cannot_expand -> repr ty
 
+(* Safe version of expand_head, never fails *)
 let expand_head env ty =
-  let snap = Btype.snapshot () in
-  try try_expand_head env ty
-  with Cannot_expand | Unify _ -> (* expand_head shall never fail *)
-    Btype.backtrack snap;
-    repr ty
+  try try_expand_head try_expand_safe env ty with Cannot_expand -> repr ty
+
+let _ = forward_try_expand_once := try_expand_safe
+
+
+(* Expand until we find a non-abstract type declaration *)
+
+let rec extract_concrete_typedecl env ty =
+  let ty = repr ty in
+  match ty.desc with
+    Tconstr (p, _, _) ->
+      let decl = Env.find_type p env in
+      if decl.type_kind <> Type_abstract then (p, p, decl) else
+      let ty =
+        try try_expand_once env ty with Cannot_expand -> raise Not_found
+      in
+      let (_, p', decl) = extract_concrete_typedecl env ty in
+        (p, p', decl)
+  | _ -> raise Not_found
 
 (* Implementing function [expand_head_opt], the compiler's own version of
    [expand_head] used for type-based optimisations.
@@ -1198,7 +1453,8 @@
    normally hidden to the type-checker out of the implementation module of
    the private abbreviation. *)
 
-let expand_abbrev_opt = expand_abbrev_gen Private Env.find_type_expansion_opt
+let expand_abbrev_opt =
+  expand_abbrev_gen Private (fun level -> Env.find_type_expansion_opt)
 
 let try_expand_once_opt env ty =
   let ty = repr ty in
@@ -1226,19 +1482,22 @@
 let enforce_constraints env ty =
   match ty with
     {desc = Tconstr (path, args, abbrev); level = level} ->
-      let decl = Env.find_type path env in
-      ignore
-        (subst env level Public (ref Mnil) None decl.type_params args
-           (newvar2 level))
+      begin try
+        let decl = Env.find_type path env in
+        ignore
+          (subst env level Public (ref Mnil) None decl.type_params args
+             (newvar2 level))
+      with Not_found -> ()
+      end
   | _ ->
       assert false
 
 (* Recursively expand the head of a type.
    Also expand #-types. *)
-let rec full_expand env ty =
+let full_expand env ty =
   let ty = repr (expand_head env ty) in
   match ty.desc with
-    Tobject (fi, {contents = Some (_, v::_)}) when (repr v).desc = Tvar ->
+    Tobject (fi, {contents = Some (_, v::_)}) when is_Tvar (repr v) ->
       newty2 ty.level (Tobject (fi, ref None))
   | _ ->
       ty
@@ -1250,12 +1509,21 @@
 *)
 let generic_abbrev env path =
   try
-    let (_, body) = Env.find_type_expansion path env in
+    let (_, body, _) = Env.find_type_expansion path env in
     (repr body).level = generic_level
   with
     Not_found ->
       false
 
+let generic_private_abbrev env path =
+  try
+    match Env.find_type path env with
+      {type_kind = Type_abstract;
+       type_private = Private;
+       type_manifest = Some body} ->
+         (repr body).level = generic_level
+    | _ -> false
+  with Not_found -> false
 
                               (*****************)
                               (*  Occur check  *)
@@ -1277,8 +1545,11 @@
         begin try
           non_recursive_abbrev env ty0 (try_expand_once_opt env ty)
         with Cannot_expand ->
-          if !Clflags.recursive_types then () else
-          iter_type_expr (non_recursive_abbrev env ty0) ty
+          if !Clflags.recursive_types &&
+            (in_pervasives p ||
+             try is_datatype (Env.find_type p env) with Not_found -> false)
+          then ()
+          else iter_type_expr (non_recursive_abbrev env ty0) ty
         end
     | Tobject _ | Tvariant _ ->
         ()
@@ -1311,7 +1582,7 @@
         if List.memq ty visited || !Clflags.recursive_types then raise Occur;
         iter_type_expr (occur_rec env (ty::visited) ty0) ty
       with Occur -> try
-        let ty' = try_expand_head env ty in
+        let ty' = try_expand_head try_expand_once env ty in
         (* Maybe we could simply make a recursive call here,
            but it seems it could make the occur check loop
            (see change in rev. 1.58) *)
@@ -1344,6 +1615,31 @@
     merge type_changed old;
     raise (match exn with Occur -> Unify [] | _ -> exn)
 
+let occur_in env ty0 t =
+  try occur env ty0 t; false with Unify _ -> true
+
+(* checks that a local constraint is non recursive *)
+let rec local_non_recursive_abbrev visited env p ty =
+  let ty = repr ty in
+  if not (List.memq ty !visited) then begin
+    visited := ty :: !visited;
+    match ty.desc with
+      Tconstr(p', args, abbrev) ->
+        if Path.same p p' then raise Recursive_abbrev;
+        begin try
+          local_non_recursive_abbrev visited env p (try_expand_once_opt env ty)
+        with Cannot_expand ->
+          if !Clflags.recursive_types then () else
+          iter_type_expr (local_non_recursive_abbrev visited env p) ty
+        end
+    | Tobject _ | Tvariant _ ->
+        ()
+    | _ ->
+        if !Clflags.recursive_types then () else
+        iter_type_expr (local_non_recursive_abbrev visited env p) ty
+  end
+
+let local_non_recursive_abbrev = local_non_recursive_abbrev (ref [])
 
                    (*****************************)
                    (*  Polymorphic Unification  *)
@@ -1371,8 +1667,6 @@
       end
   | [] -> raise (Unify [])
 
-module TypeMap = Map.Make (TypeOps)
-
 (* Test the occurence of free univars in a type *)
 (* that's way too expansive. Must do some kind of cacheing *)
 let occur_univar env ty =
@@ -1393,8 +1687,8 @@
         true
     then
       match ty.desc with
-        Tunivar ->
-          if not (TypeSet.mem ty bound) then raise (Unify [ty, newgenvar()])
+        Tunivar _ ->
+          if not (TypeSet.mem ty bound) then raise (Unify [ty, newgenvar ()])
       | Tpoly (ty, tyl) ->
           let bound = List.fold_right TypeSet.add (List.map repr tyl) bound in
           occur_rec bound  ty
@@ -1403,7 +1697,9 @@
           begin try
             let td = Env.find_type p env in
             List.iter2
-              (fun t (pos,neg,_) -> if pos || neg then occur_rec bound t)
+              (fun t v ->
+                if Variance.(mem May_pos v || mem May_neg v)
+                then occur_rec bound t)
               tl td.type_variance
           with Not_found ->
             List.iter (occur_rec bound) tl
@@ -1421,7 +1717,7 @@
 
 let get_univar_family univar_pairs univars =
   if univars = [] then TypeSet.empty else
-  let rec insert s = function
+  let insert s = function
       cl1, (_::_ as cl2) ->
         if List.exists (fun (t1,_) -> TypeSet.mem (repr t1) s) cl1 then
           add_univars s cl2
@@ -1443,13 +1739,15 @@
         Tpoly (t, tl) ->
           if List.exists (fun t -> TypeSet.mem (repr t) family) tl then ()
           else occur t
-      | Tunivar ->
+      | Tunivar _ ->
           if TypeSet.mem t family then raise Occur
       | Tconstr (_, [], _) -> ()
       | Tconstr (p, tl, _) ->
           begin try
             let td = Env.find_type p env in
-            List.iter2 (fun t (pos,neg,_) -> if pos || neg then occur t)
+            List.iter2
+              (fun t v ->
+                if Variance.(mem May_pos v || mem May_neg v) then occur t)
               tl td.type_variance
           with Not_found ->
             List.iter occur tl
@@ -1553,60 +1851,391 @@
       abbreviated.  It would be possible to check whether some
       information is indeed lost, but it probably does not worth it.
 *)
-let rec unify env t1 t2 =
-  (* First step: special cases (optimizations) *)
+
+let newtype_level = ref None
+
+let get_newtype_level () =
+  match !newtype_level with
+  | None -> assert false
+  | Some x -> x
+
+(* a local constraint can be added only if the rhs
+   of the constraint does not contain any Tvars.
+   They need to be removed using this function *)
+let reify env t =
+  let newtype_level = get_newtype_level () in
+  let create_fresh_constr lev name =
+    let decl = new_declaration (Some (newtype_level, newtype_level)) None in
+    let name = get_new_abstract_name name in
+    let (id, new_env) = Env.enter_type name decl !env in
+    let t = newty2 lev (Tconstr (Path.Pident id,[],ref Mnil))  in
+    env := new_env;
+    t
+  in
+  let visited = ref TypeSet.empty in
+  let rec iterator ty =
+    let ty = repr ty in
+    if TypeSet.mem ty !visited then () else begin
+      visited := TypeSet.add ty !visited;
+      match ty.desc with
+        Tvar o ->
+          let name = match o with Some s -> s | _ -> "ex" in
+          let t = create_fresh_constr ty.level name in
+          link_type ty t
+      | Tvariant r ->
+          let r = row_repr r in
+          if not (static_row r) then begin
+            if r.row_fixed then iterator (row_more r) else
+            let m = r.row_more in
+            match m.desc with
+              Tvar o ->
+                let name = match o with Some s -> s | _ -> "ex" in
+                let t = create_fresh_constr m.level name in
+                let row =
+                  {r with row_fields=[]; row_fixed=true; row_more = t} in
+                link_type m (newty2 m.level (Tvariant row))
+            | _ -> assert false
+          end;
+          iter_row iterator r
+      | Tconstr (p, _, _) when is_object_type p ->
+          iter_type_expr iterator (full_expand !env ty)
+      | _ ->
+          iter_type_expr iterator ty
+    end
+  in
+  iterator t
+
+let is_newtype env p =
+  try
+    let decl = Env.find_type p env in
+    decl.type_newtype_level <> None &&
+    decl.type_kind = Type_abstract &&
+    decl.type_private = Public
+  with Not_found -> false
+
+let non_aliasable p decl =
+  (* in_pervasives p ||  (subsumed by in_current_module) *)
+  in_current_module p && decl.type_newtype_level = None
+
+(* mcomp type_pairs subst env t1 t2 does not raise an
+   exception if it is possible that t1 and t2 are actually
+   equal, assuming the types in type_pairs are equal and
+   that the mapping subst holds.
+   Assumes that both t1 and t2 do not contain any tvars
+   and that both their objects and variants are closed
+ *)
+
+let rec mcomp type_pairs env t1 t2 =
   if t1 == t2 then () else
   let t1 = repr t1 in
   let t2 = repr t2 in
   if t1 == t2 then () else
+  match (t1.desc, t2.desc) with
+  | (Tvar _, _)
+  | (_, Tvar _)  ->
+      ()
+  | (Tconstr (p1, [], _), Tconstr (p2, [], _)) when Path.same p1 p2 ->
+      ()
+  | _ ->
+      let t1' = expand_head_opt env t1 in
+      let t2' = expand_head_opt env t2 in
+      (* Expansion may have changed the representative of the types... *)
+      let t1' = repr t1' and t2' = repr t2' in
+      if t1' == t2' then () else
+      begin try TypePairs.find type_pairs (t1', t2')
+      with Not_found ->
+        TypePairs.add type_pairs (t1', t2') ();
+        match (t1'.desc, t2'.desc) with
+          (Tvar _, Tvar _) -> assert false
+        | (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _))
+          when l1 = l2 || not (is_optional l1 || is_optional l2) ->
+            mcomp type_pairs env t1 t2;
+            mcomp type_pairs env u1 u2;
+        | (Ttuple tl1, Ttuple tl2) ->
+            mcomp_list type_pairs env tl1 tl2
+        | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _)) ->
+            mcomp_type_decl type_pairs env p1 p2 tl1 tl2
+        | (Tconstr (p, _, _), _) | (_, Tconstr (p, _, _)) ->
+            let decl = Env.find_type p env in
+            if non_aliasable p decl then raise (Unify [])
+        | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2))
+          when Path.same p1 p2 && n1 = n2 ->
+            mcomp_list type_pairs env tl1 tl2
+        | (Tvariant row1, Tvariant row2) ->
+            mcomp_row type_pairs env row1 row2
+        | (Tobject (fi1, _), Tobject (fi2, _)) ->
+            mcomp_fields type_pairs env fi1 fi2
+        | (Tfield _, Tfield _) ->       (* Actually unused *)
+            mcomp_fields type_pairs env t1' t2'
+        | (Tnil, Tnil) ->
+            ()
+        | (Tpoly (t1, []), Tpoly (t2, [])) ->
+            mcomp type_pairs env t1 t2
+        | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
+            enter_poly env univar_pairs t1 tl1 t2 tl2
+              (mcomp type_pairs env)
+        | (Tunivar _, Tunivar _) ->
+            unify_univar t1' t2' !univar_pairs
+        | (_, _) ->
+            raise (Unify [])
+      end
+
+and mcomp_list type_pairs env tl1 tl2 =
+  if List.length tl1 <> List.length tl2 then
+    raise (Unify []);
+  List.iter2 (mcomp type_pairs env) tl1 tl2
+
+and mcomp_fields type_pairs env ty1 ty2 =
+  if not (concrete_object ty1 && concrete_object ty2) then assert false;
+  let (fields2, rest2) = flatten_fields ty2 in
+  let (fields1, rest1) = flatten_fields ty1 in
+  let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
+  mcomp type_pairs env rest1 rest2;
+  if miss1 <> []  && (object_row ty1).desc = Tnil
+  || miss2 <> []  && (object_row ty2).desc = Tnil then raise (Unify []);
+  List.iter
+    (function (n, k1, t1, k2, t2) ->
+       mcomp_kind k1 k2;
+       mcomp type_pairs env t1 t2)
+    pairs
+
+and mcomp_kind k1 k2 =
+  let k1 = field_kind_repr k1 in
+  let k2 = field_kind_repr k2 in
+  match k1, k2 with
+    (Fvar _, Fvar _)
+  | (Fpresent, Fpresent) -> ()
+  | _                    -> raise (Unify [])
+
+and mcomp_row type_pairs env row1 row2 =
+  let row1 = row_repr row1 and row2 = row_repr row2 in
+  let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
+  let cannot_erase (_,f) =
+    match row_field_repr f with
+      Rpresent _ -> true
+    | Rabsent | Reither _ -> false
+  in
+  if row1.row_closed && List.exists cannot_erase r2
+  || row2.row_closed && List.exists cannot_erase r1 then raise (Unify []);
+  List.iter
+    (fun (_,f1,f2) ->
+      match row_field_repr f1, row_field_repr f2 with
+      | Rpresent None, (Rpresent (Some _) | Reither (_, _::_, _, _) | Rabsent)
+      | Rpresent (Some _), (Rpresent None | Reither (true, _, _, _) | Rabsent)
+      | (Reither (_, _::_, _, _) | Rabsent), Rpresent None
+      | (Reither (true, _, _, _) | Rabsent), Rpresent (Some _) ->
+          raise (Unify [])
+      | Rpresent(Some t1), Rpresent(Some t2) ->
+          mcomp type_pairs env t1 t2
+      | Rpresent(Some t1), Reither(false, tl2, _, _) ->
+          List.iter (mcomp type_pairs env t1) tl2
+      | Reither(false, tl1, _, _), Rpresent(Some t2) ->
+          List.iter (mcomp type_pairs env t2) tl1
+      | _ -> ())
+    pairs
+
+and mcomp_type_decl type_pairs env p1 p2 tl1 tl2 =
+  try
+    let decl = Env.find_type p1 env in
+    let decl' = Env.find_type p2 env in
+    if Path.same p1 p2 then begin
+      (* Format.eprintf "@[%a@ %a@]@."
+        !print_raw (newconstr p1 tl2) !print_raw (newconstr p2 tl2);
+      if non_aliasable p1 decl then Format.eprintf "non_aliasable@."
+      else Format.eprintf "aliasable@."; *)
+      let inj =
+        try List.map Variance.(mem Inj) (Env.find_type p1 env).type_variance
+        with Not_found -> List.map (fun _ -> false) tl1
+      in
+      List.iter2
+        (fun i (t1,t2) -> if i then mcomp type_pairs env t1 t2)
+        inj (List.combine tl1 tl2)
+    end
+    else match decl.type_kind, decl'.type_kind with
+    | Type_record (lst,r), Type_record (lst',r') when r = r' ->
+        mcomp_list type_pairs env tl1 tl2;
+        mcomp_record_description type_pairs env lst lst'
+    | Type_variant v1, Type_variant v2 ->
+        mcomp_list type_pairs env tl1 tl2;
+        mcomp_variant_description type_pairs env v1 v2
+    | Type_variant _, Type_record _
+    | Type_record _, Type_variant _ -> raise (Unify [])
+    | _ ->
+        if non_aliasable p1 decl && (non_aliasable p2 decl'||is_datatype decl')
+        || is_datatype decl && non_aliasable p2 decl' then raise (Unify [])
+  with Not_found -> ()
+
+and mcomp_type_option type_pairs env t t' =
+  match t, t' with
+    None, None -> ()
+  | Some t, Some t' -> mcomp type_pairs env t t'
+  | _ -> raise (Unify [])
+
+and mcomp_variant_description type_pairs env xs ys =
+  let rec iter = fun x y ->
+    match x, y with
+    (id, tl, t) :: xs, (id', tl', t') :: ys   ->
+      mcomp_type_option type_pairs env t t';
+      mcomp_list type_pairs env tl tl';
+      if Ident.name id = Ident.name id'
+      then iter xs ys
+      else raise (Unify [])
+    | [],[] -> ()
+    | _ -> raise (Unify [])
+  in
+  iter xs ys
+
+and mcomp_record_description type_pairs env =
+  let rec iter = fun x y ->
+    match x, y with
+      (id, mutable_flag, t) :: xs, (id', mutable_flag', t') :: ys ->
+        mcomp type_pairs env t t';
+        if Ident.name id = Ident.name id' && mutable_flag = mutable_flag'
+        then iter xs ys
+        else raise (Unify [])
+    | [], [] -> ()
+    | _ -> raise (Unify [])
+  in
+  iter
+
+let mcomp env t1 t2 =
+  mcomp (TypePairs.create 4) env t1 t2
+
+(* Real unification *)
+
+let find_lowest_level ty =
+  let lowest = ref generic_level in
+  let rec find ty =
+    let ty = repr ty in
+    if ty.level >= lowest_level then begin
+      if ty.level < !lowest then lowest := ty.level;
+      ty.level <- pivot_level - ty.level;
+      iter_type_expr find ty
+    end
+  in find ty; unmark_type ty; !lowest
+
+let find_newtype_level env path =
+  try match (Env.find_type path env).type_newtype_level with
+    Some x -> x
+  | None -> assert false
+  with Not_found -> assert false
+
+let add_gadt_equation env source destination =
+  let destination = duplicate_type destination in
+  let source_lev = find_newtype_level !env (Path.Pident source) in
+  let decl = new_declaration (Some source_lev) (Some destination) in
+  let newtype_level = get_newtype_level () in
+  env := Env.add_local_constraint source decl newtype_level !env;
+  cleanup_abbrev ()
+
+let unify_eq_set = TypePairs.create 11
+
+let order_type_pair t1 t2 =
+  if t1.id <= t2.id then (t1, t2) else (t2, t1)
+
+let add_type_equality t1 t2 =
+  TypePairs.add unify_eq_set (order_type_pair t1 t2) ()
+
+let unify_eq env t1 t2 =
+  t1 == t2 ||
+  match !umode with
+  | Expression -> false
+  | Pattern ->
+      try TypePairs.find unify_eq_set (order_type_pair t1 t2); true
+      with Not_found -> false
+
+let rec unify (env:Env.t ref) t1 t2 =
+  (* First step: special cases (optimizations) *)
+  if t1 == t2 then () else
+  let t1 = repr t1 in
+  let t2 = repr t2 in
+  if unify_eq !env t1 t2 then () else
+  let reset_tracing = check_trace_gadt_instances !env in
 
   try
     type_changed := true;
-    match (t1.desc, t2.desc) with
-      (Tvar, Tconstr _) when deep_occur t1 t2 ->
+    begin match (t1.desc, t2.desc) with
+      (Tvar _, Tconstr _) when deep_occur t1 t2 ->
         unify2 env t1 t2
-    | (Tconstr _, Tvar) when deep_occur t2 t1 ->
+    | (Tconstr _, Tvar _) when deep_occur t2 t1 ->
         unify2 env t1 t2
-    | (Tvar, _) ->
-        occur env t1 t2; occur_univar env t2;
-        update_level env t1.level t2;
-        link_type t1 t2
-    | (_, Tvar) ->
-        occur env t2 t1; occur_univar env t1;
-        update_level env t2.level t1;
-        link_type t2 t1
-    | (Tunivar, Tunivar) ->
+    | (Tvar _, _) ->
+        occur !env t1 t2;
+        occur_univar !env t2;
+        link_type t1 t2;
+        update_level !env t1.level t2
+    | (_, Tvar _) ->
+        occur !env t2 t1;
+        occur_univar !env t1;
+        link_type t2 t1;
+        update_level !env t2.level t1
+    | (Tunivar _, Tunivar _) ->
         unify_univar t1 t2 !univar_pairs;
-        update_level env t1.level t2;
+        update_level !env t1.level t2;
         link_type t1 t2
     | (Tconstr (p1, [], a1), Tconstr (p2, [], a2))
-          when Path.same p1 p2
+          when Path.same p1 p2 (* && actual_mode !env = Old *)
             (* This optimization assumes that t1 does not expand to t2
                (and conversely), so we fall back to the general case
                when any of the types has a cached expansion. *)
             && not (has_cached_expansion p1 !a1
                  || has_cached_expansion p2 !a2) ->
-        update_level env t1.level t2;
+        update_level !env t1.level t2;
         link_type t1 t2
+    | (Tconstr (p1, [], _), Tconstr (p2, [], _))
+      when Env.has_local_constraints !env
+      && is_newtype !env p1 && is_newtype !env p2 ->
+        (* Do not use local constraints more than necessary *)
+        begin try
+          if find_newtype_level !env p1 < find_newtype_level !env p2 then
+            unify env t1 (try_expand_once !env t2)
+          else
+            unify env (try_expand_once !env t1) t2
+        with Cannot_expand ->
+          unify2 env t1 t2
+        end
     | _ ->
         unify2 env t1 t2
+    end;
+    if reset_tracing then trace_gadt_instances := false;
   with Unify trace ->
+    if reset_tracing then trace_gadt_instances := false;
     raise (Unify ((t1, t2)::trace))
 
 and unify2 env t1 t2 =
   (* Second step: expansion of abbreviations *)
   let rec expand_both t1'' t2'' =
-    let t1' = expand_head_unif env t1 in
-    let t2' = expand_head_unif env t2 in
+    let t1' = expand_head_unif !env t1 in
+    let t2' = expand_head_unif !env t2 in
     (* Expansion may have changed the representative of the types... *)
-    if t1' == t1'' && t2' == t2'' then (t1',t2') else
+    if unify_eq !env t1' t1'' && unify_eq !env t2' t2'' then (t1',t2') else
     expand_both t1' t2'
   in
   let t1', t2' = expand_both t1 t2 in
-  if t1' == t2' then () else
+  let lv = min t1'.level t2'.level in
+  update_level !env lv t2;
+  update_level !env lv t1;
+  if unify_eq !env t1' t2' then () else
 
   let t1 = repr t1 and t2 = repr t2 in
-  if (t1 == t1') || (t2 != t2') then
+  if !trace_gadt_instances then begin
+    (* All types in chains already have the same ambiguity levels *)
+    let ilevel t =
+      match Env.gadt_instance_level !env t with None -> 0 | Some lv -> lv in
+    let lv1 = ilevel t1 and lv2 = ilevel t2 in
+    if lv1 > lv2 then Env.add_gadt_instance_chain !env lv1 t2 else
+    if lv2 > lv1 then Env.add_gadt_instance_chain !env lv2 t1
+  end;
+  let t1, t2 =
+    if !Clflags.principal
+    && (find_lowest_level t1' < lv || find_lowest_level t2' < lv) then
+      (* Expand abbreviations hiding a lower level *)
+      (* Should also do it for parameterized types, after unification... *)
+      (match t1.desc with Tconstr (_, [], _) -> t1' | _ -> t1),
+      (match t2.desc with Tconstr (_, [], _) -> t2' | _ -> t2)
+    else (t1, t2)
+  in
+  if unify_eq !env t1 t1' || not (unify_eq !env t2 t2') then
     unify3 env t1 t1' t2 t2'
   else
     try unify3 env t2 t2' t1 t1' with Unify trace ->
@@ -1616,132 +2245,177 @@
   (* Third step: truly unification *)
   (* Assumes either [t1 == t1'] or [t2 != t2'] *)
   let d1 = t1'.desc and d2 = t2'.desc in
-
   let create_recursion = (t2 != t2') && (deep_occur t1' t2) in
-  occur env t1' t2;
-  update_level env t1'.level t2;
-  link_type t1' t2;
-
-  try
-    begin match (d1, d2) with
-      (Tvar, _) ->
-        occur_univar env t2
-    | (_, Tvar) ->
-        let td1 = newgenty d1 in
-        occur env t2' td1;
-        occur_univar env td1;
-        if t1 == t1' then begin
-          (* The variable must be instantiated... *)
-          let ty = newty2 t1'.level d1 in
-          update_level env t2'.level ty;
-          link_type t2' ty
-        end else begin
-          log_type t1';
-          t1'.desc <- d1;
-          update_level env t2'.level t1;
-          link_type t2' t1
-        end
-    | (Tarrow (l1, t1, u1, c1), Tarrow (l2, t2, u2, c2)) when l1 = l2
-      || !Clflags.classic && not (is_optional l1 || is_optional l2) ->
-        unify env t1 t2; unify env u1 u2;
-        begin match commu_repr c1, commu_repr c2 with
-          Clink r, c2 -> set_commu r c2
-        | c1, Clink r -> set_commu r c1
-        | _ -> ()
-        end
-    | (Ttuple tl1, Ttuple tl2) ->
-        unify_list env tl1 tl2
-    | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _)) when Path.same p1 p2 ->
-        unify_list env tl1 tl2
-    | (Tobject (fi1, nm1), Tobject (fi2, _)) ->
-        unify_fields env fi1 fi2;
-        (* Type [t2'] may have been instantiated by [unify_fields] *)
-        (* XXX One should do some kind of unification... *)
-        begin match (repr t2').desc with
-          Tobject (_, {contents = Some (_, va::_)})
-          when let va = repr va in List.mem va.desc [Tvar; Tunivar; Tnil] ->
-            ()
-        | Tobject (_, nm2) ->
-            set_name nm2 !nm1
-        | _ ->
-            ()
-        end
-    | (Tvariant row1, Tvariant row2) ->
-        unify_row env row1 row2
-    | (Tfield _, Tfield _) ->           (* Actually unused *)
-        unify_fields env t1' t2'
-    | (Tfield(f,kind,_,rem), Tnil) | (Tnil, Tfield(f,kind,_,rem)) ->
-        begin match field_kind_repr kind with
-          Fvar r when f <> dummy_method -> set_kind r Fabsent
-        | _      -> raise (Unify [])
-        end
-    | (Tnil, Tnil) ->
-        ()
-    | (Tpoly (t1, []), Tpoly (t2, [])) ->
-        unify env t1 t2
-    | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
-        enter_poly env univar_pairs t1 tl1 t2 tl2 (unify env)
-    | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2)) when Path.same p1 p2 && n1 = n2 ->
-        unify_list env tl1 tl2
-    | (_, _) ->
-        raise (Unify [])
-    end;
-
-(* XXX Commentaires + changer "create_recursion" *)
-    if create_recursion then begin
-      match t2.desc with
-        Tconstr (p, tl, abbrev) ->
-          forget_abbrev abbrev p;
-          let t2'' = expand_head_unif env t2 in
-          if not (closed_parameterized_type tl t2'') then
-            link_type (repr t2) (repr t2')
-      | _ ->
-          () (* t2 has already been expanded by update_level *)
-    end
 
-(*
-    (*
-       Can only be done afterwards, once the row variable has
-       (possibly) been instantiated.
-    *)
-    if t1 != t1' (* && t2 != t2' *) then begin
-      match (t1.desc, t2.desc) with
-        (Tconstr (p, ty::_, _), _)
-            when ((repr ty).desc <> Tvar)
-              && weak_abbrev p
-              && not (deep_occur t1 t2) ->
-          update_level env t1.level t2;
-          link_type t1 t2
-      | (_, Tconstr (p, ty::_, _))
-            when ((repr ty).desc <> Tvar)
-              && weak_abbrev p
-              && not (deep_occur t2 t1) ->
-          update_level env t2.level t1;
-          link_type t2 t1;
-          link_type t1' t2'
-      | _ ->
+  begin match (d1, d2) with (* handle vars and univars specially *)
+    (Tunivar _, Tunivar _) ->
+      unify_univar t1' t2' !univar_pairs;
+      link_type t1' t2'
+  | (Tvar _, _) ->
+      occur !env t1' t2;
+      occur_univar !env t2;
+      link_type t1' t2;
+  | (_, Tvar _) ->
+      occur !env t2' t1;
+      occur_univar !env t1;
+      link_type t2' t1;
+  | (Tfield _, Tfield _) -> (* special case for GADTs *)
+      unify_fields env t1' t2'
+  | _ ->
+    begin match !umode with
+    | Expression ->
+        occur !env t1' t2';
+        link_type t1' t2
+    | Pattern ->
+        add_type_equality t1' t2'
+    end;
+    try
+      begin match (d1, d2) with
+        (Tarrow (l1, t1, u1, c1), Tarrow (l2, t2, u2, c2)) when l1 = l2 ||
+        !Clflags.classic && not (is_optional l1 || is_optional l2) ->
+          unify  env t1 t2; unify env  u1 u2;
+          begin match commu_repr c1, commu_repr c2 with
+            Clink r, c2 -> set_commu r c2
+          | c1, Clink r -> set_commu r c1
+          | _ -> ()
+          end
+      | (Ttuple tl1, Ttuple tl2) ->
+          unify_list env tl1 tl2
+      | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _)) when Path.same p1 p2 ->
+          if !umode = Expression || not !generate_equations
+          || in_current_module p1 (* || in_pervasives p1 *)
+          || try is_datatype (Env.find_type p1 !env) with Not_found -> false
+          then
+            unify_list env tl1 tl2
+          else
+            let inj =
+              try List.map Variance.(mem Inj)
+                    (Env.find_type p1 !env).type_variance
+              with Not_found -> List.map (fun _ -> false) tl1
+            in
+            List.iter2
+              (fun i (t1, t2) ->
+                if i then unify env t1 t2 else
+                set_mode Pattern ~generate:false
+                  begin fun () ->
+                    let snap = snapshot () in
+                    try unify env t1 t2 with Unify _ ->
+                      backtrack snap;
+                      reify env t1; reify env t2
+                  end)
+              inj (List.combine tl1 tl2)
+      | (Tconstr ((Path.Pident p) as path,[],_),
+         Tconstr ((Path.Pident p') as path',[],_))
+        when is_newtype !env path && is_newtype !env path'
+        && !generate_equations ->
+          let source,destination =
+            if find_newtype_level !env path > find_newtype_level !env path'
+            then  p,t2'
+            else  p',t1'
+          in add_gadt_equation env source destination
+      | (Tconstr ((Path.Pident p) as path,[],_), _)
+        when is_newtype !env path && !generate_equations ->
+          reify env t2';
+          local_non_recursive_abbrev !env (Path.Pident p) t2';
+          add_gadt_equation env p t2'
+      | (_, Tconstr ((Path.Pident p) as path,[],_))
+        when is_newtype !env path && !generate_equations ->
+          reify env t1' ;
+          local_non_recursive_abbrev !env (Path.Pident p) t1';
+          add_gadt_equation env p t1'
+      | (Tconstr (_,_,_), _) | (_, Tconstr (_,_,_)) when !umode = Pattern ->
+          reify env t1';
+          reify env t2';
+          if !generate_equations then mcomp !env t1' t2'
+      | (Tobject (fi1, nm1), Tobject (fi2, _)) ->
+          unify_fields env fi1 fi2;
+          (* Type [t2'] may have been instantiated by [unify_fields] *)
+          (* XXX One should do some kind of unification... *)
+          begin match (repr t2').desc with
+            Tobject (_, {contents = Some (_, va::_)}) when
+              (match (repr va).desc with
+                Tvar _|Tunivar _|Tnil -> true | _ -> false) -> ()
+          | Tobject (_, nm2) -> set_name nm2 !nm1
+          | _ -> ()
+          end
+      | (Tvariant row1, Tvariant row2) ->
+          if !umode = Expression then
+            unify_row env row1 row2
+          else begin
+            let snap = snapshot () in
+            try unify_row env row1 row2
+            with Unify _ ->
+              backtrack snap;
+              reify env t1';
+              reify env t2';
+              if !generate_equations then mcomp !env t1' t2'
+          end
+      | (Tfield(f,kind,_,rem), Tnil) | (Tnil, Tfield(f,kind,_,rem)) ->
+          begin match field_kind_repr kind with
+            Fvar r when f <> dummy_method ->
+              set_kind r Fabsent;
+              if d2 = Tnil then unify env rem t2'
+              else unify env (newty2 rem.level Tnil) rem
+          | _      -> raise (Unify [])
+          end
+      | (Tnil, Tnil) ->
           ()
-    end
-*)
-  with Unify trace ->
-    t1'.desc <- d1;
-    raise (Unify trace)
+      | (Tpoly (t1, []), Tpoly (t2, [])) ->
+          unify env t1 t2
+      | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
+          enter_poly !env univar_pairs t1 tl1 t2 tl2 (unify env)
+      | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2))
+        when Path.same p1 p2 && n1 = n2 ->
+          unify_list env tl1 tl2
+      | (_, _) ->
+          raise (Unify [])
+      end;
+      (* XXX Commentaires + changer "create_recursion" *)
+      if create_recursion then
+        match t2.desc with
+          Tconstr (p, tl, abbrev) ->
+            forget_abbrev abbrev p;
+            let t2'' = expand_head_unif !env t2 in
+            if not (closed_parameterized_type tl t2'') then
+              link_type (repr t2) (repr t2')
+        | _ ->
+            () (* t2 has already been expanded by update_level *)
+    with Unify trace ->
+      t1'.desc <- d1;
+      raise (Unify trace)
+  end
 
 and unify_list env tl1 tl2 =
   if List.length tl1 <> List.length tl2 then
     raise (Unify []);
   List.iter2 (unify env) tl1 tl2
 
+(* Build a fresh row variable for unification *)
+and make_rowvar level use1 rest1 use2 rest2  =
+  let set_name ty name =
+    match ty.desc with
+      Tvar None -> log_type ty; ty.desc <- Tvar name
+    | _ -> ()
+  in
+  let name =
+    match rest1.desc, rest2.desc with
+      Tvar (Some _ as name1), Tvar (Some _ as name2) ->
+        if rest1.level <= rest2.level then name1 else name2
+    | Tvar (Some _ as name), _ ->
+        if use2 then set_name rest2 name; name
+    | _, Tvar (Some _ as name) ->
+        if use1 then set_name rest2 name; name
+    | _ -> None
+  in
+  if use1 then rest1 else
+  if use2 then rest2 else newvar2 ?name level
+
 and unify_fields env ty1 ty2 =          (* Optimization *)
   let (fields1, rest1) = flatten_fields ty1
   and (fields2, rest2) = flatten_fields ty2 in
   let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
   let l1 = (repr ty1).level and l2 = (repr ty2).level in
-  let va =
-    if miss1 = [] then rest2
-    else if miss2 = [] then rest1
-    else newty2 (min l1 l2) Tvar
-  in
+  let va = make_rowvar (min l1 l2) (miss2=[]) rest1 (miss1=[]) rest2 in
   let d1 = rest1.desc and d2 = rest2.desc in
   try
     unify env (build_fields l1 miss1 va) rest2;
@@ -1749,9 +2423,12 @@
     List.iter
       (fun (n, k1, t1, k2, t2) ->
         unify_kind k1 k2;
-        try unify env t1 t2 with Unify trace ->
-          raise (Unify ((newty (Tfield(n, k1, t1, va)),
-                         newty (Tfield(n, k2, t2, va)))::trace)))
+        try
+          if !trace_gadt_instances then update_level !env va.level t1;
+          unify env t1 t2
+        with Unify trace ->
+          raise (Unify ((newty (Tfield(n, k1, t1, newty Tnil)),
+                         newty (Tfield(n, k2, t2, newty Tnil)))::trace)))
       pairs
   with exn ->
     log_type rest1; rest1.desc <- d1;
@@ -1768,13 +2445,13 @@
   | (Fpresent, Fpresent)          -> ()
   | _                             -> assert false
 
-and unify_pairs env tpl =
+and unify_pairs mode env tpl =
   List.iter (fun (t1, t2) -> unify env t1 t2) tpl
 
 and unify_row env row1 row2 =
   let row1 = row_repr row1 and row2 = row_repr row2 in
   let rm1 = row_more row1 and rm2 = row_more row2 in
-  if rm1 == rm2 then () else
+  if unify_eq !env rm1 rm2 then () else
   let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
   if r1 <> [] && r2 <> [] then begin
     let ht = Hashtbl.create (List.length r1) in
@@ -1785,12 +2462,12 @@
         with Not_found -> ())
       r2
   end;
+  let fixed1 = row_fixed row1 and fixed2 = row_fixed row2 in
   let more =
-    if row1.row_fixed then rm1 else
-    if row2.row_fixed then rm2 else
-    newgenvar ()
-  in update_level env (min rm1.level rm2.level) more;
-  let fixed = row1.row_fixed || row2.row_fixed
+    if fixed1 then rm1 else
+    if fixed2 then rm2 else
+    newty2 (min rm1.level rm2.level) (Tvar None) in
+  let fixed = fixed1 || fixed2
   and closed = row1.row_closed || row2.row_closed in
   let keep switch =
     List.for_all
@@ -1824,19 +2501,22 @@
       if closed then
         filter_row_fields row.row_closed rest
       else rest in
-    if rest <> [] && (row.row_closed || row.row_fixed)
-    || closed && row.row_fixed && not row.row_closed then begin
+    if rest <> [] && (row.row_closed || row_fixed row)
+    || closed && row_fixed row && not row.row_closed then begin
       let t1 = mkvariant [] true and t2 = mkvariant rest false in
       raise (Unify [if row == row1 then (t1,t2) else (t2,t1)])
     end;
+    (* The following test is not principal... should rather use Tnil *)
     let rm = row_more row in
-    if row.row_fixed then
-      if row0.row_more == rm then () else
-      if rm.desc = Tvar then link_type rm row0.row_more else
-      unify env rm row0.row_more
+    if !trace_gadt_instances && rm.desc = Tnil then () else
+    if !trace_gadt_instances then
+      update_level !env rm.level (newgenty (Tvariant row));
+    if row_fixed row then
+      if more == rm then () else
+      if is_Tvar rm then link_type rm more else unify env rm more
     else
-      let ty = newty2 generic_level (Tvariant {row0 with row_fields = rest}) in
-      update_level env rm.level ty;
+      let ty = newgenty (Tvariant {row0 with row_fields = rest}) in
+      update_level !env rm.level ty;
       link_type rm ty
   in
   let md1 = rm1.desc and md2 = rm2.desc in
@@ -1845,7 +2525,7 @@
     set_more row1 r2;
     List.iter
       (fun (l,f1,f2) ->
-        try unify_row_field env row1.row_fixed row2.row_fixed more l f1 f2
+        try unify_row_field env fixed1 fixed2 more l f1 f2
         with Unify trace ->
           raise (Unify ((mkvariant [l,f1] true,
                          mkvariant [l,f2] true) :: trace)))
@@ -1863,7 +2543,7 @@
   | Reither(c1, tl1, m1, e1), Reither(c2, tl2, m2, e2) ->
       if e1 == e2 then () else
       let redo =
-        (m1 || m2 ||
+        (m1 || m2 || fixed1 || fixed2 ||
          !rigid_variants && (List.length tl1 = 1 || List.length tl2 = 1)) &&
         begin match tl1 @ tl2 with [] -> false
         | t1 :: tl ->
@@ -1879,20 +2559,22 @@
       in
       let tl2' = remq tl2 tl1 and tl1' = remq tl1 tl2 in
       (* Is this handling of levels really principal? *)
-      List.iter (update_level env (repr more).level) (tl1' @ tl2');
+      List.iter (update_level !env (repr more).level) (tl1' @ tl2');
       let e = ref None in
       let f1' = Reither(c1 || c2, tl1', m1 || m2, e)
       and f2' = Reither(c1 || c2, tl2', m1 || m2, e) in
       set_row_field e1 f1'; set_row_field e2 f2';
-  | Reither(_, _, false, e1), Rabsent -> set_row_field e1 f2
-  | Rabsent, Reither(_, _, false, e2) -> set_row_field e2 f1
+  | Reither(_, _, false, e1), Rabsent when not fixed1 -> set_row_field e1 f2
+  | Rabsent, Reither(_, _, false, e2) when not fixed2 -> set_row_field e2 f1
   | Rabsent, Rabsent -> ()
   | Reither(false, tl, _, e1), Rpresent(Some t2) when not fixed1 ->
       set_row_field e1 f2;
+      update_level !env (repr more).level t2;
       (try List.iter (fun t1 -> unify env t1 t2) tl
       with exn -> e1 := None; raise exn)
   | Rpresent(Some t1), Reither(false, tl, _, e2) when not fixed2 ->
       set_row_field e2 f1;
+      update_level !env (repr more).level t1;
       (try List.iter (unify env t1) tl
       with exn -> e2 := None; raise exn)
   | Reither(true, [], _, e1), Rpresent None when not fixed1 ->
@@ -1905,23 +2587,43 @@
 let unify env ty1 ty2 =
   try
     unify env ty1 ty2
-  with Unify trace ->
-    raise (Unify (expand_trace env trace))
+  with
+    Unify trace ->
+      raise (Unify (expand_trace !env trace))
+  | Recursive_abbrev ->
+      raise (Unification_recursive_abbrev (expand_trace !env [(ty1,ty2)]))
+
+let unify_gadt ~newtype_level:lev (env:Env.t ref) ty1 ty2 =
+  try
+    univar_pairs := [];
+    newtype_level := Some lev;
+    set_mode Pattern (fun () -> unify env ty1 ty2);
+    newtype_level := None;
+    TypePairs.clear unify_eq_set;
+  with e ->
+    TypePairs.clear unify_eq_set;
+    match e with
+      Unify e -> raise (Unify e)
+    | e -> newtype_level := None; raise e
 
 let unify_var env t1 t2 =
   let t1 = repr t1 and t2 = repr t2 in
   if t1 == t2 then () else
   match t1.desc with
-    Tvar ->
+    Tvar _ ->
+      let reset_tracing = check_trace_gadt_instances env in
       begin try
         occur env t1 t2;
         update_level env t1.level t2;
-        link_type t1 t2
+        link_type t1 t2;
+        if reset_tracing then trace_gadt_instances := false;
       with Unify trace ->
-        raise (Unify (expand_trace env ((t1,t2)::trace)))
+        if reset_tracing then trace_gadt_instances := false;
+        let expanded_trace = expand_trace env ((t1,t2)::trace) in
+        raise (Unify expanded_trace)
       end
   | _ ->
-      unify env t1 t2
+      unify (ref env) t1 t2
 
 let _ = unify' := unify_var
 
@@ -1930,25 +2632,32 @@
   unify env ty1 ty2
 
 let unify env ty1 ty2 =
-  univar_pairs := [];
-  unify env ty1 ty2
+  unify_pairs (ref env) ty1 ty2 []
+
 
 
 (**** Special cases of unification ****)
 
+let expand_head_trace env t =
+  let reset_tracing = check_trace_gadt_instances env in
+  let t = expand_head_unif env t in
+  if reset_tracing then trace_gadt_instances := false;
+  t
+
 (*
    Unify [t] and [l:'a -> 'b]. Return ['a] and ['b].
    In label mode, label mismatch is accepted when
    (1) the requested label is ""
    (2) the original label is not optional
 *)
-let rec filter_arrow env t l =
-  let t = expand_head_unif env t in
+
+let filter_arrow env t l =
+  let t = expand_head_trace env t in
   match t.desc with
-    Tvar ->
-      let t1 = newvar () and t2 = newvar () in
-      let t' = newty (Tarrow (l, t1, t2, Cok)) in
-      update_level env t.level t';
+    Tvar _ ->
+      let lv = t.level in
+      let t1 = newvar2 lv and t2 = newvar2 lv in
+      let t' = newty2 lv (Tarrow (l, t1, t2, Cok)) in
       link_type t t';
       (t1, t2)
   | Tarrow(l', t1, t2, _)
@@ -1959,9 +2668,9 @@
 
 (* Used by [filter_method]. *)
 let rec filter_method_field env name priv ty =
-  let ty = repr ty in
+  let ty = expand_head_trace env ty in
   match ty.desc with
-    Tvar ->
+    Tvar _ ->
       let level = ty.level in
       let ty1 = newvar2 level and ty2 = newvar2 level in
       let ty' = newty2 level (Tfield (name,
@@ -1985,10 +2694,10 @@
       raise (Unify [])
 
 (* Unify [ty] and [< name : 'a; .. >]. Return ['a]. *)
-let rec filter_method env name priv ty =
-  let ty = expand_head_unif env ty in
+let filter_method env name priv ty =
+  let ty = expand_head_trace env ty in
   match ty.desc with
-    Tvar ->
+    Tvar _ ->
       let ty1 = newvar () in
       let ty' = newobj ty1 in
       update_level env ty.level ty';
@@ -2024,7 +2733,7 @@
   let rec occur ty =
     let ty = repr ty in
     if ty.level > level then begin
-      if ty.desc = Tvar && ty.level >= generic_level - 1 then raise Occur;
+      if is_Tvar ty && ty.level >= generic_level - 1 then raise Occur;
       ty.level <- pivot_level - ty.level;
       match ty.desc with
         Tvariant row when static_row row ->
@@ -2054,17 +2763,15 @@
 
   try
     match (t1.desc, t2.desc) with
-      (Tunivar, Tunivar) ->
-        unify_univar t1 t2 !univar_pairs
-    | (Tvar, _) when may_instantiate inst_nongen t1 ->
+      (Tvar _, _) when may_instantiate inst_nongen t1 ->
         moregen_occur env t1.level t2;
         occur env t1 t2;
         link_type t1 t2
     | (Tconstr (p1, [], _), Tconstr (p2, [], _)) when Path.same p1 p2 ->
         ()
     | _ ->
-        let t1' = expand_head_unif env t1 in
-        let t2' = expand_head_unif env t2 in
+        let t1' = expand_head env t1 in
+        let t2' = expand_head env t2 in
         (* Expansion may have changed the representative of the types... *)
         let t1' = repr t1' and t2' = repr t2' in
         if t1' == t2' then () else
@@ -2073,7 +2780,7 @@
         with Not_found ->
           TypePairs.add type_pairs (t1', t2') ();
           match (t1'.desc, t2'.desc) with
-            (Tvar, _) when may_instantiate inst_nongen t1' ->
+            (Tvar _, _) when may_instantiate inst_nongen t1' ->
               moregen_occur env t1'.level t2;
               link_type t1' t2
           | (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _)) when l1 = l2
@@ -2085,7 +2792,8 @@
           | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _))
                 when Path.same p1 p2 ->
               moregen_list inst_nongen type_pairs env tl1 tl2
-          | Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2) when Path.same p1 p2 && n1 = n2 ->
+          | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2))
+            when Path.same p1 p2 && n1 = n2 ->
               moregen_list inst_nongen type_pairs env tl1 tl2
           | (Tvariant row1, Tvariant row2) ->
               moregen_row inst_nongen type_pairs env row1 row2
@@ -2100,6 +2808,8 @@
           | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
               enter_poly env univar_pairs t1 tl1 t2 tl2
                 (moregen inst_nongen type_pairs env)
+          | (Tunivar _, Tunivar _) ->
+              unify_univar t1' t2' !univar_pairs
           | (_, _) ->
               raise (Unify [])
         end
@@ -2139,7 +2849,8 @@
   let row1 = row_repr row1 and row2 = row_repr row2 in
   let rm1 = repr row1.row_more and rm2 = repr row2.row_more in
   if rm1 == rm2 then () else
-  let may_inst = rm1.desc = Tvar && may_instantiate inst_nongen rm1 in
+  let may_inst =
+    is_Tvar rm1 && may_instantiate inst_nongen rm1 || rm1.desc = Tnil in
   let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
   let r1, r2 =
     if row2.row_closed then
@@ -2149,19 +2860,14 @@
   if r1 <> [] || row1.row_closed && (not row2.row_closed || r2 <> [])
   then raise (Unify []);
   begin match rm1.desc, rm2.desc with
-    Tunivar, Tunivar ->
+    Tunivar _, Tunivar _ ->
       unify_univar rm1 rm2 !univar_pairs
-  | Tunivar, _ | _, Tunivar ->
+  | Tunivar _, _ | _, Tunivar _ ->
       raise (Unify [])
   | _ when static_row row1 -> ()
   | _ when may_inst ->
-      if not (static_row row2) then moregen_occur env rm1.level rm2;
-      let ext =
-        if r2 = [] then rm2 else
-        let row_ext = {row2 with row_fields = r2} in
-        iter_row (moregen_occur env rm1.level) row_ext;
-        newty2 rm1.level (Tvariant row_ext)
-      in
+      let ext = newgenty (Tvariant {row2 with row_fields = r2}) in
+      moregen_occur env rm1.level ext;
       link_type rm1 ext
   | Tconstr _, Tconstr _ ->
       moregen inst_nongen type_pairs env rm1 rm2
@@ -2221,10 +2927,10 @@
      then copied with [duplicate_type].  That way, its levels won't be
      changed.
   *)
-  let subj = duplicate_type (instance subj_sch) in
+  let subj = duplicate_type (instance env subj_sch) in
   current_level := generic_level;
   (* Duplicate generic variables *)
-  let patt = instance pat_sch in
+  let patt = instance env pat_sch in
   let res =
     try moregen inst_nongen (TypePairs.create 13) env patt subj; true with
       Unify _ -> false
@@ -2242,13 +2948,13 @@
   if ty.level >= lowest_level then begin
     ty.level <- pivot_level - ty.level;
     match ty.desc with
-    | Tvar ->
+    | Tvar _ ->
         if not (List.memq ty !vars) then vars := ty :: !vars
     | Tvariant row ->
         let row = row_repr row in
         let more = repr row.row_more in
-        if more.desc = Tvar && not row.row_fixed then begin
-          let more' = newty2 more.level Tvar in
+        if is_Tvar more && not (row_fixed row) then begin
+          let more' = newty2 more.level more.desc in
           let row' = {row with row_fixed=true; row_fields=[]; row_more=more'}
           in link_type more (newty2 ty.level (Tvariant row'))
         end;
@@ -2271,7 +2977,7 @@
     (fun ty ->
       let ty = expand_head env ty in
       if List.memq ty !tyl then false else
-      (tyl := ty :: !tyl; ty.desc = Tvar))
+      (tyl := ty :: !tyl; is_Tvar ty))
     vars
 
 let matches env ty ty' =
@@ -2290,10 +2996,15 @@
                  (*  Equivalence between parameterized types  *)
                  (*********************************************)
 
+let rec get_object_row ty =
+  match repr ty with
+  | {desc=Tfield (_, _, _, tl)} -> get_object_row tl
+  | ty -> ty
+
 let expand_head_rigid env ty =
   let old = !rigid_variants in
   rigid_variants := true;
-  let ty' = expand_head_unif env ty in
+  let ty' = expand_head env ty in
   rigid_variants := old; ty'
 
 let normalize_subst subst =
@@ -2310,7 +3021,7 @@
 
   try
     match (t1.desc, t2.desc) with
-      (Tvar, Tvar) when rename ->
+      (Tvar _, Tvar _) when rename ->
         begin try
           normalize_subst subst;
           if List.assq t1 !subst != t2 then raise (Unify [])
@@ -2331,12 +3042,13 @@
         with Not_found ->
           TypePairs.add type_pairs (t1', t2') ();
           match (t1'.desc, t2'.desc) with
-            (Tvar, Tvar) when rename ->
+            (Tvar _, Tvar _) when rename ->
               begin try
                 normalize_subst subst;
                 if List.assq t1' !subst != t2' then raise (Unify [])
               with Not_found ->
-                if List.exists (fun (_, t) -> t == t2') !subst then raise (Unify []);
+                if List.exists (fun (_, t) -> t == t2') !subst
+                then raise (Unify []);
                 subst := (t1', t2') :: !subst
               end
           | (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _)) when l1 = l2
@@ -2348,7 +3060,8 @@
           | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _))
                 when Path.same p1 p2 ->
               eqtype_list rename type_pairs subst env tl1 tl2
-          | Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2) when Path.same p1 p2 && n1 = n2 ->
+          | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2))
+            when Path.same p1 p2 && n1 = n2 ->
               eqtype_list rename type_pairs subst env tl1 tl2
           | (Tvariant row1, Tvariant row2) ->
               eqtype_row rename type_pairs subst env row1 row2
@@ -2363,7 +3076,7 @@
           | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
               enter_poly env univar_pairs t1 tl1 t2 tl2
                 (eqtype rename type_pairs subst env)
-          | (Tunivar, Tunivar) ->
+          | (Tunivar _, Tunivar _) ->
               unify_univar t1' t2' !univar_pairs
           | (_, _) ->
               raise (Unify [])
@@ -2377,12 +3090,18 @@
   List.iter2 (eqtype rename type_pairs subst env) tl1 tl2
 
 and eqtype_fields rename type_pairs subst env ty1 ty2 =
+  let (fields1, rest1) = flatten_fields ty1 in
   let (fields2, rest2) = flatten_fields ty2 in
+  (* First check if same row => already equal *)
+  let same_row =
+    rest1 == rest2 || TypePairs.mem type_pairs (rest1,rest2) ||
+    (rename && List.mem (rest1, rest2) !subst)
+  in
+  if same_row then () else
   (* Try expansion, needed when called from Includecore.type_manifest *)
   match expand_head_rigid env rest2 with
     {desc=Tobject(ty2,_)} -> eqtype_fields rename type_pairs subst env ty1 ty2
   | _ ->
-  let (fields1, rest1) = flatten_fields ty1 in
   let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
   eqtype rename type_pairs subst env rest1 rest2;
   if (miss1 <> []) || (miss2 <> []) then raise (Unify []);
@@ -2459,11 +3178,11 @@
 type class_match_failure =
     CM_Virtual_class
   | CM_Parameter_arity_mismatch of int * int
-  | CM_Type_parameter_mismatch of (type_expr * type_expr) list
-  | CM_Class_type_mismatch of class_type * class_type
-  | CM_Parameter_mismatch of (type_expr * type_expr) list
-  | CM_Val_type_mismatch of string * (type_expr * type_expr) list
-  | CM_Meth_type_mismatch of string * (type_expr * type_expr) list
+  | CM_Type_parameter_mismatch of Env.t * (type_expr * type_expr) list
+  | CM_Class_type_mismatch of Env.t * class_type * class_type
+  | CM_Parameter_mismatch of Env.t * (type_expr * type_expr) list
+  | CM_Val_type_mismatch of string * Env.t * (type_expr * type_expr) list
+  | CM_Meth_type_mismatch of string * Env.t * (type_expr * type_expr) list
   | CM_Non_mutable_value of string
   | CM_Non_concrete_value of string
   | CM_Missing_value of string
@@ -2479,16 +3198,16 @@
 let rec moregen_clty trace type_pairs env cty1 cty2 =
   try
     match cty1, cty2 with
-      Tcty_constr (_, _, cty1), _ ->
+      Cty_constr (_, _, cty1), _ ->
         moregen_clty true type_pairs env cty1 cty2
-    | _, Tcty_constr (_, _, cty2) ->
+    | _, Cty_constr (_, _, cty2) ->
         moregen_clty true type_pairs env cty1 cty2
-    | Tcty_fun (l1, ty1, cty1'), Tcty_fun (l2, ty2, cty2') when l1 = l2 ->
+    | Cty_fun (l1, ty1, cty1'), Cty_fun (l2, ty2, cty2') when l1 = l2 ->
         begin try moregen true type_pairs env ty1 ty2 with Unify trace ->
-          raise (Failure [CM_Parameter_mismatch (expand_trace env trace)])
+          raise (Failure [CM_Parameter_mismatch (env, expand_trace env trace)])
         end;
         moregen_clty false type_pairs env cty1' cty2'
-    | Tcty_signature sign1, Tcty_signature sign2 ->
+    | Cty_signature sign1, Cty_signature sign2 ->
         let ty1 = object_fields (repr sign1.cty_self) in
         let ty2 = object_fields (repr sign2.cty_self) in
         let (fields1, rest1) = flatten_fields ty1
@@ -2498,7 +3217,7 @@
           (fun (lab, k1, t1, k2, t2) ->
             begin try moregen true type_pairs env t1 t2 with Unify trace ->
               raise (Failure [CM_Meth_type_mismatch
-                                 (lab, expand_trace env trace)])
+                                 (lab, env, expand_trace env trace)])
            end)
         pairs;
       Vars.iter
@@ -2506,13 +3225,13 @@
            let (mut', v', ty') = Vars.find lab sign1.cty_vars in
            try moregen true type_pairs env ty' ty with Unify trace ->
              raise (Failure [CM_Val_type_mismatch
-                                (lab, expand_trace env trace)]))
+                                (lab, env, expand_trace env trace)]))
         sign2.cty_vars
   | _ ->
       raise (Failure [])
   with
     Failure error when trace || error = [] ->
-      raise (Failure (CM_Class_type_mismatch (cty1, cty2)::error))
+      raise (Failure (CM_Class_type_mismatch (env, cty1, cty2)::error))
 
 let match_class_types ?(trace=true) env pat_sch subj_sch =
   let type_pairs = TypePairs.create 53 in
@@ -2604,7 +3323,7 @@
           Failure r -> r
         end
     | error ->
-        CM_Class_type_mismatch (patt, subj)::error
+        CM_Class_type_mismatch (env, patt, subj)::error
   in
   current_level := old_level;
   res
@@ -2612,18 +3331,18 @@
 let rec equal_clty trace type_pairs subst env cty1 cty2 =
   try
     match cty1, cty2 with
-      Tcty_constr (_, _, cty1), Tcty_constr (_, _, cty2) ->
+      Cty_constr (_, _, cty1), Cty_constr (_, _, cty2) ->
         equal_clty true type_pairs subst env cty1 cty2
-    | Tcty_constr (_, _, cty1), _ ->
+    | Cty_constr (_, _, cty1), _ ->
         equal_clty true type_pairs subst env cty1 cty2
-    | _, Tcty_constr (_, _, cty2) ->
+    | _, Cty_constr (_, _, cty2) ->
         equal_clty true type_pairs subst env cty1 cty2
-    | Tcty_fun (l1, ty1, cty1'), Tcty_fun (l2, ty2, cty2') when l1 = l2 ->
+    | Cty_fun (l1, ty1, cty1'), Cty_fun (l2, ty2, cty2') when l1 = l2 ->
         begin try eqtype true type_pairs subst env ty1 ty2 with Unify trace ->
-          raise (Failure [CM_Parameter_mismatch (expand_trace env trace)])
+          raise (Failure [CM_Parameter_mismatch (env, expand_trace env trace)])
         end;
         equal_clty false type_pairs subst env cty1' cty2'
-    | Tcty_signature sign1, Tcty_signature sign2 ->
+    | Cty_signature sign1, Cty_signature sign2 ->
         let ty1 = object_fields (repr sign1.cty_self) in
         let ty2 = object_fields (repr sign2.cty_self) in
         let (fields1, rest1) = flatten_fields ty1
@@ -2634,7 +3353,7 @@
              begin try eqtype true type_pairs subst env t1 t2 with
                Unify trace ->
                  raise (Failure [CM_Meth_type_mismatch
-                                    (lab, expand_trace env trace)])
+                                    (lab, env, expand_trace env trace)])
              end)
           pairs;
         Vars.iter
@@ -2642,15 +3361,15 @@
              let (_, _, ty') = Vars.find lab sign1.cty_vars in
              try eqtype true type_pairs subst env ty' ty with Unify trace ->
                raise (Failure [CM_Val_type_mismatch
-                                  (lab, expand_trace env trace)]))
+                                  (lab, env, expand_trace env trace)]))
           sign2.cty_vars
     | _ ->
         raise
           (Failure (if trace then []
-                    else [CM_Class_type_mismatch (cty1, cty2)]))
+                    else [CM_Class_type_mismatch (env, cty1, cty2)]))
   with
     Failure error when trace ->
-      raise (Failure (CM_Class_type_mismatch (cty1, cty2)::error))
+      raise (Failure (CM_Class_type_mismatch (env, cty1, cty2)::error))
 
 let match_class_declarations env patt_params patt_type subj_params subj_type =
   let type_pairs = TypePairs.create 53 in
@@ -2736,16 +3455,18 @@
         List.iter2 (fun p s ->
           try eqtype true type_pairs subst env p s with Unify trace ->
             raise (Failure [CM_Type_parameter_mismatch
-                               (expand_trace env trace)]))
+                               (env, expand_trace env trace)]))
           patt_params subj_params;
-        (* old code: equal_clty false type_pairs subst env patt_type subj_type; *)
+     (* old code: equal_clty false type_pairs subst env patt_type subj_type; *)
         equal_clty false type_pairs subst env
-          (Tcty_signature sign1) (Tcty_signature sign2);
+          (Cty_signature sign1) (Cty_signature sign2);
         (* Use moregeneral for class parameters, need to recheck everything to
            keeps relationships (PR#4824) *)
-        let clty_params = List.fold_right (fun ty cty -> Tcty_fun ("*",ty,cty)) in
+        let clty_params =
+          List.fold_right (fun ty cty -> Cty_fun ("*",ty,cty)) in
         match_class_types ~trace:false env
-          (clty_params patt_params patt_type) (clty_params subj_params subj_type)
+          (clty_params patt_params patt_type)
+          (clty_params subj_params subj_type)
       with
         Failure r -> r
       end
@@ -2782,16 +3503,16 @@
 let memq_warn t visited =
   if List.memq t visited then (warn := true; true) else false
 
-let rec lid_of_path sharp = function
+let rec lid_of_path ?(sharp="") = function
     Path.Pident id ->
       Longident.Lident (sharp ^ Ident.name id)
   | Path.Pdot (p1, s, _) ->
-      Longident.Ldot (lid_of_path "" p1, sharp ^ s)
+      Longident.Ldot (lid_of_path p1, sharp ^ s)
   | Path.Papply (p1, p2) ->
-      Longident.Lapply (lid_of_path sharp p1, lid_of_path "" p2)
+      Longident.Lapply (lid_of_path ~sharp p1, lid_of_path p2)
 
 let find_cltype_for_path env p =
-  let path, cl_abbr = Env.lookup_type (lid_of_path "#" p) env in
+  let path, cl_abbr = Env.lookup_type (lid_of_path ~sharp:"#" p) env in
   match cl_abbr.type_manifest with
     Some ty ->
       begin match (repr ty).desc with
@@ -2806,7 +3527,7 @@
 let rec build_subtype env visited loops posi level t =
   let t = repr t in
   match t.desc with
-    Tvar ->
+    Tvar _ ->
       if posi then
         try
           let t' = List.assq t loops in
@@ -2855,13 +3576,13 @@
              as this occurence might break the occur check.
              XXX not clear whether this correct anyway... *)
           if List.exists (deep_occur ty) tl1 then raise Not_found;
-          ty.desc <- Tvar;
+          ty.desc <- Tvar None;
           let t'' = newvar () in
           let loops = (ty, t'') :: loops in
           (* May discard [visited] as level is going down *)
           let (ty1', c) =
             build_subtype env [t'] loops posi (pred_enlarge level') ty1 in
-          assert (t''.desc = Tvar);
+          assert (is_Tvar t'');
           let nm =
             if c > Equiv || deep_occur ty ty1' then None else Some(p,tl1) in
           t''.desc <- Tobject (ty1', ref nm);
@@ -2885,7 +3606,8 @@
         then warn := true;
         let tl' =
           List.map2
-            (fun (co,cn,_) t ->
+            (fun v t ->
+              let (co,cn) = Variance.get_upper v in
               if cn then
                 if co then (t, Unchanged)
                 else build_subtype env visited loops (not posi) level t
@@ -2960,7 +3682,7 @@
       let (t1', c) = build_subtype env visited loops posi level t1 in
       if c > Unchanged then (newty (Tpoly(t1', tl)), c)
       else (t, Unchanged)
-  | Tunivar | Tpackage _ ->
+  | Tunivar _ | Tpackage _ ->
       (t, Unchanged)
 
 let enlarge_type env ty =
@@ -2990,11 +3712,22 @@
 let subtype_error env trace =
   raise (Subtype (expand_trace env (List.rev trace), []))
 
-let private_abbrev env path =
-  try
-    let decl = Env.find_type path env in
-    decl.type_private = Private && decl.type_manifest <> None
-  with Not_found -> false
+(* check list inclusion, assuming lists are ordered *)
+let rec included nl1 nl2 =
+  match nl1, nl2 with
+    (a::nl1', b::nl2') ->
+      if a = b then included nl1' nl2' else
+      a > b && included nl1 nl2'
+  | ([], _) -> true
+  | (_, []) -> false
+
+let rec extract_assoc nl1 nl2 tl2 =
+  match (nl1, nl2, tl2) with
+    (a::nl1', b::nl2, t::tl2) ->
+      if a = b then t :: extract_assoc nl1' nl2 tl2
+      else extract_assoc nl1 nl2 tl2
+  | ([], _, _) -> []
+  | _ -> assert false
 
 let rec subtype_rec env trace t1 t2 cstrs =
   let t1 = repr t1 in
@@ -3007,7 +3740,7 @@
   with Not_found ->
     TypePairs.add subtypes (t1, t2) ();
     match (t1.desc, t2.desc) with
-      (Tvar, _) | (_, Tvar) ->
+      (Tvar _, _) | (_, Tvar _) ->
         (trace, t1, t2, !univar_pairs)::cstrs
     | (Tarrow(l1, t1, u1, _), Tarrow(l2, t2, u2, _)) when l1 = l2
       || !Clflags.classic && not (is_optional l1 || is_optional l2) ->
@@ -3027,7 +3760,8 @@
         begin try
           let decl = Env.find_type p1 env in
           List.fold_left2
-            (fun cstrs (co, cn, _) (t1, t2) ->
+            (fun cstrs v (t1, t2) ->
+              let (co, cn) = Variance.get_upper v in
               if co then
                 if cn then
                   (trace, newty2 t1.level (Ttuple[t1]),
@@ -3040,10 +3774,12 @@
         with Not_found ->
           (trace, t1, t2, !univar_pairs)::cstrs
         end
-    | (Tconstr(p1, tl1, _), _) when private_abbrev env p1 ->
+    | (Tconstr(p1, _, _), _) when generic_private_abbrev env p1 ->
         subtype_rec env trace (expand_abbrev_opt env t1) t2 cstrs
+(*  | (_, Tconstr(p2, _, _)) when generic_private_abbrev false env p2 ->
+        subtype_rec env trace t1 (expand_abbrev_opt env t2) cstrs *)
     | (Tobject (f1, _), Tobject (f2, _))
-      when (object_row f1).desc = Tvar && (object_row f2).desc = Tvar ->
+      when is_Tvar (object_row f1) && is_Tvar (object_row f2) ->
         (* Same row variable implies same object. *)
         (trace, t1, t2, !univar_pairs)::cstrs
     | (Tobject (f1, _), Tobject (f2, _)) ->
@@ -3066,6 +3802,11 @@
         with Unify _ ->
           (trace, t1, t2, !univar_pairs)::cstrs
         end
+    | (Tpackage (p1, nl1, tl1), Tpackage (p2, nl2, tl2))
+      when Path.same p1 p2 && included nl2 nl1 ->
+        List.map2 (fun t1 t2 -> (trace, t1, t2, !univar_pairs))
+          (extract_assoc nl2 nl1 tl1) tl2
+        @ cstrs
     | (_, _) ->
         (trace, t1, t2, !univar_pairs)::cstrs
   end
@@ -3110,7 +3851,7 @@
   match more1.desc, more2.desc with
     Tconstr(p1,_,_), Tconstr(p2,_,_) when Path.same p1 p2 ->
       subtype_rec env ((more1,more2)::trace) more1 more2 cstrs
-  | (Tvar|Tconstr _), (Tvar|Tconstr _)
+  | (Tvar _|Tconstr _|Tnil), (Tvar _|Tconstr _|Tnil)
     when row1.row_closed && r1 = [] ->
       List.fold_left
         (fun cstrs (_,f1,f2) ->
@@ -3124,7 +3865,7 @@
           | Rabsent, _ -> cstrs
           | _ -> raise Exit)
         cstrs pairs
-  | Tunivar, Tunivar
+  | Tunivar _, Tunivar _
     when row1.row_closed = row2.row_closed && r1 = [] && r2 = [] ->
       let cstrs =
         subtype_rec env ((more1,more2)::trace) more1 more2 cstrs in
@@ -3153,7 +3894,7 @@
   function () ->
     List.iter
       (function (trace0, t1, t2, pairs) ->
-         try unify_pairs env t1 t2 pairs with Unify trace ->
+         try unify_pairs (ref env) t1 t2 pairs with Unify trace ->
            raise (Subtype (expand_trace env (List.rev trace0),
                            List.tl (List.tl trace))))
       (List.rev cstrs)
@@ -3168,19 +3909,19 @@
   match ty.desc with
     Tfield (s, k, t1, t2) ->
       newty2 ty.level (Tfield (s, k, t1, unalias_object t2))
-  | Tvar | Tnil ->
+  | Tvar _ | Tnil ->
       newty2 ty.level ty.desc
-  | Tunivar ->
+  | Tunivar _ ->
       ty
   | Tconstr _ ->
-      newty2 ty.level Tvar
+      newvar2 ty.level
   | _ ->
       assert false
 
 let unalias ty =
   let ty = repr ty in
   match ty.desc with
-    Tvar | Tunivar ->
+    Tvar _ | Tunivar _ ->
       ty
   | Tvariant row ->
       let row = row_repr row in
@@ -3254,7 +3995,7 @@
               set_name nm None
             else let v' = repr v in
             begin match v'.desc with
-            | Tvar|Tunivar ->
+            | Tvar _ | Tunivar _ ->
                 if v' != v then set_name nm (Some (n, v' :: l))
             | Tnil ->
                 log_type ty; ty.desc <- Tconstr (n, l, ref Mnil)
@@ -3296,7 +4037,7 @@
 
 let rec nondep_type_rec env id ty =
   match ty.desc with
-    Tvar | Tunivar -> ty
+    Tvar _ | Tunivar _ -> ty
   | Tlink ty -> nondep_type_rec env id ty
   | _ -> try TypeHash.find nondep_hash ty
   with Not_found ->
@@ -3342,7 +4083,7 @@
             (* Register new type first for recursion *)
             TypeHash.add nondep_variants more ty';
             let static = static_row row in
-            let more' = if static then newgenvar () else more in
+            let more' = if static then newgenty Tnil else more in
             (* Return a new copy *)
             let row =
               copy_row (nondep_type_rec env id) true row true more' in
@@ -3366,7 +4107,7 @@
 
 let unroll_abbrev id tl ty =
   let ty = repr ty and path = Path.Pident id in
-  if (ty.desc = Tvar) || (List.exists (deep_occur ty) tl)
+  if is_Tvar ty || (List.exists (deep_occur ty) tl)
   || is_object_type path then
     ty
   else
@@ -3385,7 +4126,11 @@
       | Type_variant cstrs ->
           Type_variant
             (List.map
-               (fun (c, tl) -> (c, List.map (nondep_type_rec env mid) tl))
+               (fun (c, tl,ret_type_opt) ->
+                 let ret_type_opt =
+                   may_map (nondep_type_rec env mid) ret_type_opt
+                 in
+                 (c, List.map (nondep_type_rec env mid) tl,ret_type_opt))
                cstrs)
       | Type_record(lbls, rep) ->
           Type_record
@@ -3414,6 +4159,8 @@
       type_manifest = tm;
       type_private = priv;
       type_variance = decl.type_variance;
+      type_newtype_level = None;
+      type_loc = decl.type_loc;
     }
   with Not_found ->
     clear_hash ();
@@ -3432,15 +4179,15 @@
 
 let rec nondep_class_type env id =
   function
-    Tcty_constr (p, _, cty) when Path.isfree id p ->
+    Cty_constr (p, _, cty) when Path.isfree id p ->
       nondep_class_type env id cty
-  | Tcty_constr (p, tyl, cty) ->
-      Tcty_constr (p, List.map (nondep_type_rec env id) tyl,
+  | Cty_constr (p, tyl, cty) ->
+      Cty_constr (p, List.map (nondep_type_rec env id) tyl,
                    nondep_class_type env id cty)
-  | Tcty_signature sign ->
-      Tcty_signature (nondep_class_signature env id sign)
-  | Tcty_fun (l, ty, cty) ->
-      Tcty_fun (l, nondep_type_rec env id ty, nondep_class_type env id cty)
+  | Cty_signature sign ->
+      Cty_signature (nondep_class_signature env id sign)
+  | Cty_fun (l, ty, cty) ->
+      Cty_fun (l, nondep_type_rec env id ty, nondep_class_type env id cty)
 
 let nondep_class_declaration env id decl =
   assert (not (Path.isfree id decl.cty_path));
diff -Nru ocaml-3.12.1/typing/ctype.mli ocaml-4.01.0/typing/ctype.mli
--- ocaml-3.12.1/typing/ctype.mli	2010-09-06 06:34:13.000000000 +0000
+++ ocaml-4.01.0/typing/ctype.mli	2013-02-09 08:42:11.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: ctype.mli 10669 2010-09-06 06:34:13Z garrigue $ *)
-
 (* Operations on core types *)
 
 open Asttypes
@@ -24,6 +22,7 @@
 exception Cannot_expand
 exception Cannot_apply
 exception Recursive_abbrev
+exception Unification_recursive_abbrev of (type_expr * type_expr) list
 
 val init_def: int -> unit
         (* Set the initial variable level *)
@@ -40,9 +39,10 @@
         (* This pair of functions is only used in Typetexp *)
 
 val newty: type_desc -> type_expr
-val newvar: unit -> type_expr
+val newvar: ?name:string -> unit -> type_expr
+val newvar2: ?name:string -> int -> type_expr
         (* Return a fresh variable *)
-val new_global_var: unit -> type_expr
+val new_global_var: ?name:string -> unit -> type_expr
         (* Return a fresh variable, bound at toplevel
            (as type variables ['a] in type constraints). *)
 val newobj: type_expr -> type_expr
@@ -53,7 +53,6 @@
 val repr: type_expr -> type_expr
         (* Return the canonical representative of a type. *)
 
-val dummy_method: label
 val object_fields: type_expr -> type_expr
 val flatten_fields:
         type_expr -> (string * field_kind * type_expr) list * type_expr
@@ -74,6 +73,7 @@
 val remove_object_name: type_expr -> unit
 val hide_private_methods: type_expr -> unit
 val find_cltype_for_path: Env.t -> Path.t -> type_declaration * type_expr
+val lid_of_path: ?sharp:string -> Path.t -> Longident.t
 
 val sort_row_fields: (label * row_field) list -> (label * row_field) list
 val merge_row_fields:
@@ -103,14 +103,21 @@
         (* Only generalize some part of the type
            Make the remaining of the type non-generalizable *)
 
-val instance: type_expr -> type_expr
+val instance: ?partial:bool -> Env.t -> type_expr -> type_expr
         (* Take an instance of a type scheme *)
-val instance_list: type_expr list -> type_expr list
+        (* partial=None  -> normal
+           partial=false -> newvar() for non generic subterms
+           partial=true  -> newty2 ty.level Tvar for non generic subterms *)
+val instance_def: type_expr -> type_expr
+        (* use defaults *)
+val instance_list: Env.t -> type_expr list -> type_expr list
         (* Take an instance of a list of type schemes *)
 val instance_constructor:
+        ?in_pattern:Env.t ref * int ->
         constructor_description -> type_expr list * type_expr
         (* Same, for a constructor *)
 val instance_parameterized_type:
+        ?keep_names:bool ->
         type_expr list -> type_expr -> type_expr list * type_expr
 val instance_parameterized_type_2:
         type_expr list -> type_expr list -> type_expr ->
@@ -119,6 +126,7 @@
 val instance_class:
         type_expr list -> class_type -> type_expr list * class_type
 val instance_poly:
+        ?keep_names:bool ->
         bool -> type_expr list -> type_expr -> type_expr list * type_expr
         (* Take an instance of a type scheme containing free univars *)
 val instance_label:
@@ -137,11 +145,19 @@
 (** The compiler's own version of [expand_head] necessary for type-based
     optimisations. *)
 val full_expand: Env.t -> type_expr -> type_expr
+val extract_concrete_typedecl:
+        Env.t -> type_expr -> Path.t * Path.t * type_declaration
+        (* Return the original path of the types, and the first concrete
+           type declaration found expanding it.
+           Raise [Not_found] if none appears or not a type constructor. *)
 
 val enforce_constraints: Env.t -> type_expr -> unit
 
 val unify: Env.t -> type_expr -> type_expr -> unit
         (* Unify the two types given. Raise [Unify] if not possible. *)
+val unify_gadt: newtype_level:int -> Env.t ref -> type_expr -> type_expr -> unit
+        (* Unify the two types given and update the environment with the
+           local constraints. Raise [Unify] if not possible. *)
 val unify_var: Env.t -> type_expr -> type_expr -> unit
         (* Same as [unify], but allow free univars when first type
            is a variable. *)
@@ -151,6 +167,7 @@
         (* A special case of unification (with {m : 'a; 'b}). *)
 val check_filter_method: Env.t -> string -> private_flag -> type_expr -> unit
         (* A special case of unification (with {m : 'a; 'b}), returning unit. *)
+val occur_in: Env.t -> type_expr -> type_expr -> bool
 val deep_occur: type_expr -> type_expr -> bool
 val filter_self_method:
         Env.t -> string -> private_flag -> (Ident.t * type_expr) Meths.t ref ->
@@ -162,18 +179,18 @@
         (* "Rigidify" a type and return its type variable *)
 val all_distinct_vars: Env.t -> type_expr list -> bool
         (* Check those types are all distinct type variables *)
-val matches : Env.t -> type_expr -> type_expr -> bool
+val matches: Env.t -> type_expr -> type_expr -> bool
         (* Same as [moregeneral false], implemented using the two above
            functions and backtracking. Ignore levels *)
 
 type class_match_failure =
     CM_Virtual_class
   | CM_Parameter_arity_mismatch of int * int
-  | CM_Type_parameter_mismatch of (type_expr * type_expr) list
-  | CM_Class_type_mismatch of class_type * class_type
-  | CM_Parameter_mismatch of (type_expr * type_expr) list
-  | CM_Val_type_mismatch of string * (type_expr * type_expr) list
-  | CM_Meth_type_mismatch of string * (type_expr * type_expr) list
+  | CM_Type_parameter_mismatch of Env.t * (type_expr * type_expr) list
+  | CM_Class_type_mismatch of Env.t * class_type * class_type
+  | CM_Parameter_mismatch of Env.t * (type_expr * type_expr) list
+  | CM_Val_type_mismatch of string * Env.t * (type_expr * type_expr) list
+  | CM_Meth_type_mismatch of string * Env.t * (type_expr * type_expr) list
   | CM_Non_mutable_value of string
   | CM_Non_concrete_value of string
   | CM_Missing_value of string
@@ -184,7 +201,7 @@
   | CM_Private_method of string
   | CM_Virtual_method of string
 val match_class_types:
-        ?trace:bool -> Env.t -> class_type -> class_type -> class_match_failure list
+    ?trace:bool -> Env.t -> class_type -> class_type -> class_match_failure list
         (* Check if the first class type is more general than the second. *)
 val equal: Env.t -> bool -> type_expr list -> type_expr list -> bool
         (* [equal env [x1...xn] tau [y1...yn] sigma]
@@ -215,7 +232,7 @@
         Env.t -> Ident.t -> class_declaration -> class_declaration
         (* Same for class declarations. *)
 val nondep_cltype_declaration:
-        Env.t -> Ident.t -> cltype_declaration -> cltype_declaration
+        Env.t -> Ident.t -> class_type_declaration -> class_type_declaration
         (* Same for class type declarations. *)
 val correct_abbrev: Env.t -> Path.t -> type_expr list -> type_expr -> unit
 val cyclic_abbrev: Env.t -> Ident.t -> type_expr -> bool
@@ -244,3 +261,5 @@
 
 val collapse_conj_params: Env.t -> type_expr list -> unit
         (* Collapse conjunctive types in class parameters *)
+
+val get_current_level: unit -> int
diff -Nru ocaml-3.12.1/typing/datarepr.ml ocaml-4.01.0/typing/datarepr.ml
--- ocaml-3.12.1/typing/datarepr.ml	2009-09-12 12:41:07.000000000 +0000
+++ ocaml-4.01.0/typing/datarepr.ml	2012-10-24 12:03:00.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,49 +10,92 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: datarepr.ml 9331 2009-09-12 12:41:07Z xleroy $ *)
-
 (* Compute constructor and label descriptions from type declarations,
    determining their representation. *)
 
-open Misc
 open Asttypes
 open Types
+open Btype
+
+(* Simplified version of Ctype.free_vars *)
+let free_vars ty =
+  let ret = ref TypeSet.empty in
+  let rec loop ty =
+    let ty = repr ty in
+    if ty.level >= lowest_level then begin
+      ty.level <- pivot_level - ty.level;
+      match ty.desc with
+      | Tvar _ ->
+          ret := TypeSet.add ty !ret
+      | Tvariant row ->
+          let row = row_repr row in
+          iter_row loop row;
+          if not (static_row row) then loop row.row_more
+      | _ ->
+          iter_type_expr loop ty
+    end
+  in
+  loop ty;
+  unmark_type ty;
+  !ret
 
 let constructor_descrs ty_res cstrs priv =
-  let num_consts = ref 0 and num_nonconsts = ref 0 in
+  let num_consts = ref 0 and num_nonconsts = ref 0  and num_normal = ref 0 in
   List.iter
-    (function (name, []) -> incr num_consts
-            | (name, _)  -> incr num_nonconsts)
+    (fun (name, args, ret) ->
+      if args = [] then incr num_consts else incr num_nonconsts;
+      if ret = None then incr num_normal)
     cstrs;
   let rec describe_constructors idx_const idx_nonconst = function
       [] -> []
-    | (name, ty_args) :: rem ->
+    | (id, ty_args, ty_res_opt) :: rem ->
+        let ty_res =
+          match ty_res_opt with
+          | Some ty_res' -> ty_res'
+          | None -> ty_res
+        in
         let (tag, descr_rem) =
           match ty_args with
             [] -> (Cstr_constant idx_const,
                    describe_constructors (idx_const+1) idx_nonconst rem)
           | _  -> (Cstr_block idx_nonconst,
                    describe_constructors idx_const (idx_nonconst+1) rem) in
+        let existentials =
+          match ty_res_opt with
+          | None -> []
+          | Some type_ret ->
+              let res_vars = free_vars type_ret in
+              let arg_vars = free_vars (newgenty (Ttuple ty_args)) in
+              TypeSet.elements (TypeSet.diff arg_vars res_vars)
+        in
         let cstr =
-          { cstr_res = ty_res;
+          { cstr_name = Ident.name id;
+            cstr_res = ty_res;
+            cstr_existentials = existentials;
             cstr_args = ty_args;
             cstr_arity = List.length ty_args;
             cstr_tag = tag;
             cstr_consts = !num_consts;
             cstr_nonconsts = !num_nonconsts;
-            cstr_private = priv } in
-        (name, cstr) :: descr_rem in
+            cstr_normal = !num_normal;
+            cstr_private = priv;
+            cstr_generalized = ty_res_opt <> None
+          } in
+        (id, cstr) :: descr_rem in
   describe_constructors 0 0 cstrs
 
 let exception_descr path_exc decl =
-  { cstr_res = Predef.type_exn;
-    cstr_args = decl;
-    cstr_arity = List.length decl;
-    cstr_tag = Cstr_exception path_exc;
+  { cstr_name = Path.last path_exc;
+    cstr_res = Predef.type_exn;
+    cstr_existentials = [];
+    cstr_args = decl.exn_args;
+    cstr_arity = List.length decl.exn_args;
+    cstr_tag = Cstr_exception (path_exc, decl.exn_loc);
     cstr_consts = -1;
     cstr_nonconsts = -1;
-    cstr_private = Public }
+    cstr_private = Public;
+    cstr_normal = -1;
+    cstr_generalized = false }
 
 let none = {desc = Ttuple []; level = -1; id = -1}
                                         (* Clearly ill-formed type *)
@@ -65,9 +108,9 @@
   let all_labels = Array.create (List.length lbls) dummy_label in
   let rec describe_labels num = function
       [] -> []
-    | (name, mut_flag, ty_arg) :: rest ->
+    | (id, mut_flag, ty_arg) :: rest ->
         let lbl =
-          { lbl_name = name;
+          { lbl_name = Ident.name id;
             lbl_res = ty_res;
             lbl_arg = ty_arg;
             lbl_mut = mut_flag;
@@ -76,7 +119,7 @@
             lbl_repres = repres;
             lbl_private = priv } in
         all_labels.(num) <- lbl;
-        (name, lbl) :: describe_labels (num+1) rest in
+        (id, lbl) :: describe_labels (num+1) rest in
   describe_labels 0 lbls
 
 exception Constr_not_found
@@ -84,13 +127,13 @@
 let rec find_constr tag num_const num_nonconst = function
     [] ->
       raise Constr_not_found
-  | (name, [] as cstr) :: rem ->
+  | (name, ([] as cstr),(_ as ret_type_opt)) :: rem ->
       if tag = Cstr_constant num_const
-      then cstr
+      then (name,cstr,ret_type_opt)
       else find_constr tag (num_const + 1) num_nonconst rem
-  | (name, _ as cstr) :: rem ->
+  | (name, (_ as cstr),(_ as ret_type_opt)) :: rem ->
       if tag = Cstr_block num_nonconst
-      then cstr
+      then (name,cstr,ret_type_opt)
       else find_constr tag num_const (num_nonconst + 1) rem
 
 let find_constr_by_tag tag cstrlist =
diff -Nru ocaml-3.12.1/typing/datarepr.mli ocaml-4.01.0/typing/datarepr.mli
--- ocaml-3.12.1/typing/datarepr.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/typing/datarepr.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: datarepr.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* Compute constructor and label descriptions from type declarations,
    determining their representation. *)
 
@@ -19,16 +17,17 @@
 open Types
 
 val constructor_descrs:
-  type_expr -> (string * type_expr list) list -> private_flag ->
-    (string * constructor_description) list
+  type_expr -> (Ident.t * type_expr list * type_expr option) list ->
+  private_flag -> (Ident.t * constructor_description) list
 val exception_descr:
-  Path.t -> type_expr list -> constructor_description
+  Path.t -> exception_declaration -> constructor_description
 val label_descrs:
-  type_expr -> (string * mutable_flag * type_expr) list ->
+  type_expr -> (Ident.t * mutable_flag * type_expr) list ->
     record_representation -> private_flag ->
-    (string * label_description) list
+    (Ident.t * label_description) list
 
 exception Constr_not_found
 
 val find_constr_by_tag:
-  constructor_tag -> (string * type_expr list) list -> string * type_expr list
+  constructor_tag -> (Ident.t * type_expr list * type_expr option) list ->
+    Ident.t * type_expr list * type_expr option
diff -Nru ocaml-3.12.1/typing/env.ml ocaml-4.01.0/typing/env.ml
--- ocaml-3.12.1/typing/env.ml	2011-06-01 22:23:56.000000000 +0000
+++ ocaml-4.01.0/typing/env.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,27 +10,95 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: env.ml 11062 2011-06-01 22:23:56Z doligez $ *)
-
 (* Environment handling *)
 
+open Cmi_format
 open Config
 open Misc
 open Asttypes
 open Longident
 open Path
 open Types
+open Btype
+
+let add_delayed_check_forward = ref (fun _ -> assert false)
+
+let value_declarations : ((string * Location.t), (unit -> unit)) Hashtbl.t =
+  Hashtbl.create 16
+    (* This table is used to usage of value declarations.  A declaration is
+       identified with its name and location.  The callback attached to a
+       declaration is called whenever the value is used explicitly
+       (lookup_value) or implicitly (inclusion test between signatures,
+       cf Includemod.value_descriptions). *)
+
+let type_declarations = Hashtbl.create 16
+
+type constructor_usage = Positive | Pattern | Privatize
+type constructor_usages =
+    {
+     mutable cu_positive: bool;
+     mutable cu_pattern: bool;
+     mutable cu_privatize: bool;
+    }
+let add_constructor_usage cu = function
+  | Positive -> cu.cu_positive <- true
+  | Pattern -> cu.cu_pattern <- true
+  | Privatize -> cu.cu_privatize <- true
+let constructor_usages () =
+  {cu_positive = false; cu_pattern = false; cu_privatize = false}
+
+let used_constructors :
+    (string * Location.t * string, (constructor_usage -> unit)) Hashtbl.t
+  = Hashtbl.create 16
 
+let prefixed_sg = Hashtbl.create 113
 
 type error =
-    Not_an_interface of string
-  | Corrupted_interface of string
-  | Illegal_renaming of string * string
+  | Illegal_renaming of string * string * string
   | Inconsistent_import of string * string * string
   | Need_recursive_types of string * string
 
 exception Error of error
 
+module EnvLazy : sig
+  type ('a,'b) t
+
+  val force : ('a -> 'b) -> ('a,'b) t -> 'b
+  val create : 'a -> ('a,'b) t
+  val is_val : ('a,'b) t -> bool
+
+end  = struct
+
+  type ('a,'b) t = ('a,'b) eval ref
+
+  and ('a,'b) eval =
+      Done of 'b
+    | Raise of exn
+    | Thunk of 'a
+
+  let force f x =
+    match !x with
+        Done x -> x
+      | Raise e -> raise e
+      | Thunk e ->
+          try
+            let y = f e in
+            x := Done y;
+            y
+          with e ->
+            x := Raise e;
+            raise e
+
+  let is_val x =
+    match !x with Done _ -> true | _ -> false
+
+  let create x =
+    let x = ref (Thunk x) in
+    x
+
+end
+
+
 type summary =
     Env_empty
   | Env_value of summary * Ident.t * value_description
@@ -39,24 +107,77 @@
   | Env_module of summary * Ident.t * module_type
   | Env_modtype of summary * Ident.t * modtype_declaration
   | Env_class of summary * Ident.t * class_declaration
-  | Env_cltype of summary * Ident.t * cltype_declaration
+  | Env_cltype of summary * Ident.t * class_type_declaration
   | Env_open of summary * Path.t
 
+module EnvTbl =
+  struct
+    (* A table indexed by identifier, with an extra slot to record usage. *)
+    type 'a t = ('a * (unit -> unit)) Ident.tbl
+
+    let empty = Ident.empty
+    let nothing = fun () -> ()
+
+    let already_defined s tbl =
+      try ignore (Ident.find_name s tbl); true
+      with Not_found -> false
+
+    let add kind slot id x tbl ref_tbl =
+      let slot =
+        match slot with
+        | None -> nothing
+        | Some f ->
+          (fun () ->
+             let s = Ident.name id in
+             f kind s (already_defined s ref_tbl)
+          )
+      in
+      Ident.add id (x, slot) tbl
+
+    let add_dont_track id x tbl =
+      Ident.add id (x, nothing) tbl
+
+    let find_same_not_using id tbl =
+      fst (Ident.find_same id tbl)
+
+    let find_same id tbl =
+      let (x, slot) = Ident.find_same id tbl in
+      slot ();
+      x
+
+    let find_name s tbl =
+      let (x, slot) = Ident.find_name s tbl in
+      slot ();
+      x
+
+    let find_all s tbl =
+      Ident.find_all s tbl
+
+    let fold_name f = Ident.fold_name (fun k (d,_) -> f k d)
+    let keys tbl = Ident.fold_all (fun k _ accu -> k::accu) tbl []
+  end
+
+type type_descriptions =
+    constructor_description list * label_description list
+
 type t = {
-  values: (Path.t * value_description) Ident.tbl;
-  annotations: (Path.t * Annot.ident) Ident.tbl;
-  constrs: constructor_description Ident.tbl;
-  labels: label_description Ident.tbl;
-  types: (Path.t * type_declaration) Ident.tbl;
-  modules: (Path.t * module_type) Ident.tbl;
-  modtypes: (Path.t * modtype_declaration) Ident.tbl;
-  components: (Path.t * module_components) Ident.tbl;
-  classes: (Path.t * class_declaration) Ident.tbl;
-  cltypes: (Path.t * cltype_declaration) Ident.tbl;
-  summary: summary
+  values: (Path.t * value_description) EnvTbl.t;
+  constrs: constructor_description EnvTbl.t;
+  labels: label_description EnvTbl.t;
+  types: (Path.t * (type_declaration * type_descriptions)) EnvTbl.t;
+  modules: (Path.t * module_type) EnvTbl.t;
+  modtypes: (Path.t * modtype_declaration) EnvTbl.t;
+  components: (Path.t * module_components) EnvTbl.t;
+  classes: (Path.t * class_declaration) EnvTbl.t;
+  cltypes: (Path.t * class_type_declaration) EnvTbl.t;
+  summary: summary;
+  local_constraints: bool;
+  gadt_instances: (int * TypeSet.t ref) list;
+  in_signature: bool;
 }
 
-and module_components = module_components_repr Lazy.t
+and module_components =
+  (t * Subst.t * Path.t * Types.module_type, module_components_repr) EnvLazy.t
 
 and module_components_repr =
     Structure_comps of structure_components
@@ -64,15 +185,16 @@
 
 and structure_components = {
   mutable comp_values: (string, (value_description * int)) Tbl.t;
-  mutable comp_annotations: (string, (Annot.ident * int)) Tbl.t;
-  mutable comp_constrs: (string, (constructor_description * int)) Tbl.t;
-  mutable comp_labels: (string, (label_description * int)) Tbl.t;
-  mutable comp_types: (string, (type_declaration * int)) Tbl.t;
-  mutable comp_modules: (string, (module_type Lazy.t * int)) Tbl.t;
+  mutable comp_constrs: (string, (constructor_description * int) list) Tbl.t;
+  mutable comp_labels: (string, (label_description * int) list) Tbl.t;
+  mutable comp_types:
+   (string, ((type_declaration * type_descriptions) * int)) Tbl.t;
+  mutable comp_modules:
+   (string, ((Subst.t * Types.module_type,module_type) EnvLazy.t * int)) Tbl.t;
   mutable comp_modtypes: (string, (modtype_declaration * int)) Tbl.t;
   mutable comp_components: (string, (module_components * int)) Tbl.t;
   mutable comp_classes: (string, (class_declaration * int)) Tbl.t;
-  mutable comp_cltypes: (string, (cltype_declaration * int)) Tbl.t
+  mutable comp_cltypes: (string, (class_type_declaration * int)) Tbl.t
 }
 
 and functor_components = {
@@ -84,20 +206,27 @@
   fcomp_cache: (Path.t, module_components) Hashtbl.t  (* For memoization *)
 }
 
+let subst_modtype_maker (subst, mty) = Subst.modtype subst mty
+
 let empty = {
-  values = Ident.empty; annotations = Ident.empty; constrs = Ident.empty;
-  labels = Ident.empty; types = Ident.empty;
-  modules = Ident.empty; modtypes = Ident.empty;
-  components = Ident.empty; classes = Ident.empty;
-  cltypes = Ident.empty;
-  summary = Env_empty }
+  values = EnvTbl.empty; constrs = EnvTbl.empty;
+  labels = EnvTbl.empty; types = EnvTbl.empty;
+  modules = EnvTbl.empty; modtypes = EnvTbl.empty;
+  components = EnvTbl.empty; classes = EnvTbl.empty;
+  cltypes = EnvTbl.empty;
+  summary = Env_empty; local_constraints = false; gadt_instances = [];
+  in_signature = false;
+ }
+
+let in_signature env = {env with in_signature = true}
 
 let diff_keys is_local tbl1 tbl2 =
-  let keys2 = Ident.keys tbl2 in
+  let keys2 = EnvTbl.keys tbl2 in
   List.filter
     (fun id ->
-      is_local (Ident.find_same id tbl2) &&
-      try ignore (Ident.find_same id tbl1); false with Not_found -> true)
+      is_local (EnvTbl.find_same_not_using id tbl2) &&
+      try ignore (EnvTbl.find_same_not_using id tbl1); false
+      with Not_found -> true)
     keys2
 
 let is_ident = function
@@ -107,7 +236,7 @@
 let is_local (p, _) = is_ident p
 
 let is_local_exn = function
-    {cstr_tag = Cstr_exception p} -> is_ident p
+  | {cstr_tag = Cstr_exception (p, _)} -> is_ident p
   | _ -> false
 
 let diff env1 env2 =
@@ -121,6 +250,9 @@
 let components_of_module' =
   ref ((fun env sub path mty -> assert false) :
           t -> Subst.t -> Path.t -> module_type -> module_components)
+let components_of_module_maker' =
+  ref ((fun (env, sub, path, mty) -> assert false) :
+          t * Subst.t * Path.t * module_type -> module_components_repr)
 let components_of_functor_appl' =
   ref ((fun f p1 p2 -> assert false) :
           functor_components -> Path.t -> Path.t -> module_components)
@@ -136,8 +268,6 @@
 
 (* Persistent structure descriptions *)
 
-type pers_flags = Rectypes
-
 type pers_struct =
   { ps_name: string;
     ps_sig: signature;
@@ -147,7 +277,7 @@
     ps_flags: pers_flags list }
 
 let persistent_structures =
-  (Hashtbl.create 17 : (string, pers_struct) Hashtbl.t)
+  (Hashtbl.create 17 : (string, pers_struct option) Hashtbl.t)
 
 (* Consistency between persistent structures *)
 
@@ -163,23 +293,16 @@
 
 (* Reading persistent structures from .cmi files *)
 
-let read_pers_struct modname filename =
-  let ic = open_in_bin filename in
-  try
-    let buffer = String.create (String.length cmi_magic_number) in
-    really_input ic buffer 0 (String.length cmi_magic_number);
-    if buffer <> cmi_magic_number then begin
-      close_in ic;
-      raise(Error(Not_an_interface filename))
-    end;
-    let (name, sign) = input_value ic in
-    let crcs = input_value ic in
-    let flags = input_value ic in
-    close_in ic;
-    let comps =
+let read_pers_struct modname filename = (
+  let cmi = read_cmi filename in
+  let name = cmi.cmi_name in
+  let sign = cmi.cmi_sign in
+  let crcs = cmi.cmi_crcs in
+  let flags = cmi.cmi_flags in
+  let comps =
       !components_of_module' empty Subst.identity
                              (Pident(Ident.create_persistent name))
-                             (Tmty_signature sign) in
+                             (Mty_signature sign) in
     let ps = { ps_name = name;
                ps_sig = sign;
                ps_comps = comps;
@@ -187,29 +310,57 @@
                ps_filename = filename;
                ps_flags = flags } in
     if ps.ps_name <> modname then
-      raise(Error(Illegal_renaming(ps.ps_name, filename)));
+      raise(Error(Illegal_renaming(modname, ps.ps_name, filename)));
     check_consistency filename ps.ps_crcs;
     List.iter
       (function Rectypes ->
         if not !Clflags.recursive_types then
           raise(Error(Need_recursive_types(ps.ps_name, !current_unit))))
       ps.ps_flags;
-    Hashtbl.add persistent_structures modname ps;
+    Hashtbl.add persistent_structures modname (Some ps);
     ps
-  with End_of_file | Failure _ ->
-    close_in ic;
-    raise(Error(Corrupted_interface(filename)))
+)
 
 let find_pers_struct name =
-  try
-    Hashtbl.find persistent_structures name
-  with Not_found ->
-    read_pers_struct name (find_in_path_uncap !load_path (name ^ ".cmi"))
+  if name = "*predef*" then raise Not_found;
+  let r =
+    try Some (Hashtbl.find persistent_structures name)
+    with Not_found -> None
+  in
+  match r with
+  | Some None -> raise Not_found
+  | Some (Some sg) -> sg
+  | None ->
+      let filename =
+        try find_in_path_uncap !load_path (name ^ ".cmi")
+        with Not_found ->
+          Hashtbl.add persistent_structures name None;
+          raise Not_found
+      in
+      read_pers_struct name filename
 
 let reset_cache () =
   current_unit := "";
   Hashtbl.clear persistent_structures;
-  Consistbl.clear crc_units
+  Consistbl.clear crc_units;
+  Hashtbl.clear value_declarations;
+  Hashtbl.clear type_declarations;
+  Hashtbl.clear used_constructors;
+  Hashtbl.clear prefixed_sg
+
+let reset_cache_toplevel () =
+  (* Delete 'missing cmi' entries from the cache. *)
+  let l =
+    Hashtbl.fold
+      (fun name r acc -> if r = None then name :: acc else acc)
+      persistent_structures []
+  in
+  List.iter (Hashtbl.remove persistent_structures) l;
+  Hashtbl.clear value_declarations;
+  Hashtbl.clear type_declarations;
+  Hashtbl.clear used_constructors;
+  Hashtbl.clear prefixed_sg
+
 
 let set_unit_name name =
   current_unit := name
@@ -220,7 +371,7 @@
   match path with
     Pident id ->
       begin try
-        let (p, desc) = Ident.find_same id env.components
+        let (p, desc) = EnvTbl.find_same id env.components
         in desc
       with Not_found ->
         if Ident.persistent id
@@ -228,7 +379,9 @@
         else raise Not_found
       end
   | Pdot(p, s, pos) ->
-      begin match Lazy.force(find_module_descr p env) with
+      begin match
+        EnvLazy.force !components_of_module_maker' (find_module_descr p env)
+      with
         Structure_comps c ->
           let (descr, pos) = Tbl.find s c.comp_components in
           descr
@@ -236,7 +389,9 @@
          raise Not_found
       end
   | Papply(p1, p2) ->
-      begin match Lazy.force(find_module_descr p1 env) with
+      begin match
+        EnvLazy.force !components_of_module_maker' (find_module_descr p1 env)
+      with
         Functor_comps f ->
           !components_of_functor_appl' f p1 p2
       | Structure_comps c ->
@@ -246,10 +401,12 @@
 let find proj1 proj2 path env =
   match path with
     Pident id ->
-      let (p, data) = Ident.find_same id (proj1 env)
+      let (p, data) = EnvTbl.find_same id (proj1 env)
       in data
   | Pdot(p, s, pos) ->
-      begin match Lazy.force(find_module_descr p env) with
+      begin match
+        EnvLazy.force !components_of_module_maker' (find_module_descr p env)
+      with
         Structure_comps c ->
           let (data, pos) = Tbl.find s (proj2 c) in data
       | Functor_comps f ->
@@ -260,7 +417,7 @@
 
 let find_value =
   find (fun env -> env.values) (fun sc -> sc.comp_values)
-and find_type =
+and find_type_full =
   find (fun env -> env.types) (fun sc -> sc.comp_types)
 and find_modtype =
   find (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes)
@@ -269,15 +426,21 @@
 and find_cltype =
   find (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes)
 
+let find_type p env =
+  fst (find_type_full p env)
+let find_type_descrs p env =
+  snd (find_type_full p env)
+
 (* Find the manifest type associated to a type when appropriate:
    - the type should be public or should have a private row,
    - the type should have an associated manifest type. *)
-let find_type_expansion path env =
+let find_type_expansion ?level path env =
   let decl = find_type path env in
   match decl.type_manifest with
   | Some body when decl.type_private = Public
               || decl.type_kind <> Type_abstract
-              || Btype.has_constr_row body -> (decl.type_params, body)
+              || Btype.has_constr_row body ->
+                  (decl.type_params, body, may_map snd decl.type_newtype_level)
   (* The manifest type of Private abstract data types without
      private row are still considered unknown to the type system.
      Hence, this case is caught by the following clause that also handles
@@ -293,30 +456,33 @@
   match decl.type_manifest with
   (* The manifest type of Private abstract data types can still get
      an approximation using their manifest type. *)
-  | Some body -> (decl.type_params, body)
+  | Some body -> (decl.type_params, body, may_map snd decl.type_newtype_level)
   | _ -> raise Not_found
 
 let find_modtype_expansion path env =
   match find_modtype path env with
-    Tmodtype_abstract     -> raise Not_found
-  | Tmodtype_manifest mty -> mty
+    Modtype_abstract     -> raise Not_found
+  | Modtype_manifest mty -> mty
 
 let find_module path env =
   match path with
     Pident id ->
       begin try
-        let (p, data) = Ident.find_same id env.modules
+        let (p, data) = EnvTbl.find_same id env.modules
         in data
       with Not_found ->
         if Ident.persistent id then
           let ps = find_pers_struct (Ident.name id) in
-          Tmty_signature(ps.ps_sig)
+          Mty_signature(ps.ps_sig)
         else raise Not_found
       end
   | Pdot(p, s, pos) ->
-      begin match Lazy.force (find_module_descr p env) with
+      begin match
+        EnvLazy.force !components_of_module_maker' (find_module_descr p env)
+      with
         Structure_comps c ->
-          let (data, pos) = Tbl.find s c.comp_modules in Lazy.force data
+          let (data, pos) = Tbl.find s c.comp_modules in
+          EnvLazy.force subst_modtype_maker data
       | Functor_comps f ->
           raise Not_found
       end
@@ -325,11 +491,13 @@
 
 (* Lookup by name *)
 
+exception Recmodule
+
 let rec lookup_module_descr lid env =
   match lid with
     Lident s ->
       begin try
-        Ident.find_name s env.components
+        EnvTbl.find_name s env.components
       with Not_found ->
         if s = !current_unit then raise Not_found;
         let ps = find_pers_struct s in
@@ -337,7 +505,7 @@
       end
   | Ldot(l, s) ->
       let (p, descr) = lookup_module_descr l env in
-      begin match Lazy.force descr with
+      begin match EnvLazy.force !components_of_module_maker' descr with
         Structure_comps c ->
           let (descr, pos) = Tbl.find s c.comp_components in
           (Pdot(p, s, pos), descr)
@@ -347,7 +515,7 @@
   | Lapply(l1, l2) ->
       let (p1, desc1) = lookup_module_descr l1 env in
       let (p2, mty2) = lookup_module l2 env in
-      begin match Lazy.force desc1 with
+      begin match EnvLazy.force !components_of_module_maker' desc1 with
         Functor_comps f ->
           !check_modtype_inclusion env mty2 p2 f.fcomp_arg;
           (Papply(p1, p2), !components_of_functor_appl' f p1 p2)
@@ -359,18 +527,25 @@
   match lid with
     Lident s ->
       begin try
-        Ident.find_name s env.modules
+        let (_, ty) as r = EnvTbl.find_name s env.modules in
+        begin match ty with
+        | Mty_ident (Path.Pident id) when Ident.name id = "#recmod#" ->
+          (* see #5965 *)
+          raise Recmodule
+        | _ -> ()
+        end;
+        r
       with Not_found ->
         if s = !current_unit then raise Not_found;
         let ps = find_pers_struct s in
-        (Pident(Ident.create_persistent s), Tmty_signature ps.ps_sig)
+        (Pident(Ident.create_persistent s), Mty_signature ps.ps_sig)
       end
   | Ldot(l, s) ->
       let (p, descr) = lookup_module_descr l env in
-      begin match Lazy.force descr with
+      begin match EnvLazy.force !components_of_module_maker' descr with
         Structure_comps c ->
           let (data, pos) = Tbl.find s c.comp_modules in
-          (Pdot(p, s, pos), Lazy.force data)
+          (Pdot(p, s, pos), EnvLazy.force subst_modtype_maker data)
       | Functor_comps f ->
           raise Not_found
       end
@@ -378,7 +553,7 @@
       let (p1, desc1) = lookup_module_descr l1 env in
       let (p2, mty2) = lookup_module l2 env in
       let p = Papply(p1, p2) in
-      begin match Lazy.force desc1 with
+      begin match EnvLazy.force !components_of_module_maker' desc1 with
         Functor_comps f ->
           !check_modtype_inclusion env mty2 p2 f.fcomp_arg;
           (p, Subst.modtype (Subst.add_module f.fcomp_param p2 f.fcomp_subst)
@@ -390,10 +565,10 @@
 let lookup proj1 proj2 lid env =
   match lid with
     Lident s ->
-      Ident.find_name s (proj1 env)
+      EnvTbl.find_name s (proj1 env)
   | Ldot(l, s) ->
       let (p, desc) = lookup_module_descr l env in
-      begin match Lazy.force desc with
+      begin match EnvLazy.force !components_of_module_maker' desc with
         Structure_comps c ->
           let (data, pos) = Tbl.find s (proj2 c) in
           (Pdot(p, s, pos), data)
@@ -406,10 +581,10 @@
 let lookup_simple proj1 proj2 lid env =
   match lid with
     Lident s ->
-      Ident.find_name s (proj1 env)
+      EnvTbl.find_name s (proj1 env)
   | Ldot(l, s) ->
       let (p, desc) = lookup_module_descr l env in
-      begin match Lazy.force desc with
+      begin match EnvLazy.force !components_of_module_maker' desc with
         Structure_comps c ->
           let (data, pos) = Tbl.find s (proj2 c) in
           data
@@ -419,14 +594,51 @@
   | Lapply(l1, l2) ->
       raise Not_found
 
+let lookup_all_simple proj1 proj2 shadow lid env =
+  match lid with
+    Lident s ->
+      let xl = EnvTbl.find_all s (proj1 env) in
+      let rec do_shadow =
+        function
+        | [] -> []
+        | ((x, f) :: xs) ->
+            (x, f) ::
+              (do_shadow (List.filter (fun (y, g) -> not (shadow x y)) xs))
+      in
+        do_shadow xl
+  | Ldot(l, s) ->
+      let (p, desc) = lookup_module_descr l env in
+      begin match EnvLazy.force !components_of_module_maker' desc with
+        Structure_comps c ->
+          let comps =
+            try Tbl.find s (proj2 c) with Not_found -> []
+          in
+          List.map
+            (fun (data, pos) -> (data, (fun () -> ())))
+            comps
+      | Functor_comps f ->
+          raise Not_found
+      end
+  | Lapply(l1, l2) ->
+      raise Not_found
+
+let has_local_constraints env = env.local_constraints
+
+let cstr_shadow cstr1 cstr2 =
+  match cstr1.cstr_tag, cstr2.cstr_tag with
+    Cstr_exception _, Cstr_exception _ -> true
+  | _ -> false
+
+let lbl_shadow lbl1 lbl2 = false
+
 let lookup_value =
   lookup (fun env -> env.values) (fun sc -> sc.comp_values)
-let lookup_annot id e =
-  lookup (fun env -> env.annotations) (fun sc -> sc.comp_annotations) id e
-and lookup_constructor =
-  lookup_simple (fun env -> env.constrs) (fun sc -> sc.comp_constrs)
-and lookup_label =
-  lookup_simple (fun env -> env.labels) (fun sc -> sc.comp_labels)
+and lookup_all_constructors =
+  lookup_all_simple (fun env -> env.constrs) (fun sc -> sc.comp_constrs)
+    cstr_shadow
+and lookup_all_labels =
+  lookup_all_simple (fun env -> env.labels) (fun sc -> sc.comp_labels)
+    lbl_shadow
 and lookup_type =
   lookup (fun env -> env.types) (fun sc -> sc.comp_types)
 and lookup_modtype =
@@ -436,11 +648,267 @@
 and lookup_cltype =
   lookup (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes)
 
+let mark_value_used name vd =
+  try Hashtbl.find value_declarations (name, vd.val_loc) ()
+  with Not_found -> ()
+
+let mark_type_used name vd =
+  try Hashtbl.find type_declarations (name, vd.type_loc) ()
+  with Not_found -> ()
+
+let mark_constructor_used usage name vd constr =
+  try Hashtbl.find used_constructors (name, vd.type_loc, constr) usage
+  with Not_found -> ()
+
+let mark_exception_used usage ed constr =
+  try Hashtbl.find used_constructors ("exn", ed.exn_loc, constr) usage
+  with Not_found -> ()
+
+let set_value_used_callback name vd callback =
+  let key = (name, vd.val_loc) in
+  try
+    let old = Hashtbl.find value_declarations key in
+    Hashtbl.replace value_declarations key (fun () -> old (); callback ())
+      (* this is to support cases like:
+               let x = let x = 1 in x in x
+         where the two declarations have the same location
+         (e.g. resulting from Camlp4 expansion of grammar entries) *)
+  with Not_found ->
+    Hashtbl.add value_declarations key callback
+
+let set_type_used_callback name td callback =
+  let loc = td.type_loc in
+  if loc.Location.loc_ghost then ()
+  else let key = (name, loc) in
+  let old =
+    try Hashtbl.find type_declarations key
+    with Not_found -> assert false
+  in
+  Hashtbl.replace type_declarations key (fun () -> callback old)
+
+let lookup_value lid env =
+  let (_, desc) as r = lookup_value lid env in
+  mark_value_used (Longident.last lid) desc;
+  r
+
+let lookup_type lid env =
+  let (path, (decl, _)) = lookup_type lid env in
+  mark_type_used (Longident.last lid) decl;
+  (path, decl)
+
+(* [path] must be the path to a type, not to a module ! *)
+let path_subst_last path id =
+  match path with
+    Pident _ -> Pident id
+  | Pdot (p, name, pos) -> Pdot(p, Ident.name id, pos)
+  | Papply (p1, p2) -> assert false
+
+let mark_type_path env path =
+  try
+    let decl = find_type path env in
+    mark_type_used (Path.last path) decl
+  with Not_found -> ()
+
+let ty_path t =
+  match repr t with
+  | {desc=Tconstr(path, _, _)} -> path
+  | _ -> assert false
+
+let lookup_constructor lid env =
+  match lookup_all_constructors lid env with
+    [] -> raise Not_found
+  | (desc, use) :: _ ->
+      mark_type_path env (ty_path desc.cstr_res);
+      use ();
+      desc
+
+let is_lident = function
+    Lident _ -> true
+  | _ -> false
+
+let lookup_all_constructors lid env =
+  try
+    let cstrs = lookup_all_constructors lid env in
+    let wrap_use desc use () =
+      mark_type_path env (ty_path desc.cstr_res);
+      use ()
+    in
+    List.map (fun (cstr, use) -> (cstr, wrap_use cstr use)) cstrs
+  with
+    Not_found when is_lident lid -> []
+
+let mark_constructor usage env name desc =
+  match desc.cstr_tag with
+  | Cstr_exception (_, loc) ->
+      begin
+        try Hashtbl.find used_constructors ("exn", loc, name) usage
+        with Not_found -> ()
+      end
+  | _ ->
+      let ty_path = ty_path desc.cstr_res in
+      let ty_decl = try find_type ty_path env with Not_found -> assert false in
+      let ty_name = Path.last ty_path in
+      mark_constructor_used usage ty_name ty_decl name
+
+let lookup_label lid env =
+  match lookup_all_labels lid env with
+    [] -> raise Not_found
+  | (desc, use) :: _ ->
+      mark_type_path env (ty_path desc.lbl_res);
+      use ();
+      desc
+
+let lookup_all_labels lid env =
+  try
+    let lbls = lookup_all_labels lid env in
+    let wrap_use desc use () =
+      mark_type_path env (ty_path desc.lbl_res);
+      use ()
+    in
+    List.map (fun (lbl, use) -> (lbl, wrap_use lbl use)) lbls
+  with
+    Not_found when is_lident lid -> []
+
+let lookup_class lid env =
+  let (_, desc) as r = lookup_class lid env in
+  (* special support for Typeclass.unbound_class *)
+  if Path.name desc.cty_path = "" then ignore (lookup_type lid env)
+  else mark_type_path env desc.cty_path;
+  r
+
+let lookup_cltype lid env =
+  let (_, desc) as r = lookup_cltype lid env in
+  if Path.name desc.clty_path = "" then ignore (lookup_type lid env)
+  else mark_type_path env desc.clty_path;
+  mark_type_path env desc.clty_path;
+  r
+
+(* Iter on an environment (ignoring the body of functors and
+   not yet evaluated structures) *)
+
+let iter_env proj1 proj2 f env =
+  Ident.iter (fun id (x,_) -> f (Pident id) x) (proj1 env);
+  let rec iter_components path path' mcomps =
+    (* if EnvLazy.is_val mcomps then *)
+    match EnvLazy.force !components_of_module_maker' mcomps with
+      Structure_comps comps ->
+        Tbl.iter
+          (fun s (d, n) -> f (Pdot (path, s, n)) (Pdot (path', s, n), d))
+          (proj2 comps);
+        Tbl.iter
+          (fun s (c, n) ->
+            iter_components (Pdot (path, s, n)) (Pdot (path', s, n)) c)
+          comps.comp_components
+    | Functor_comps _ -> ()
+  in
+  Hashtbl.iter
+    (fun s pso ->
+      match pso with None -> ()
+      | Some ps ->
+          let id = Pident (Ident.create_persistent s) in
+          iter_components id id ps.ps_comps)
+    persistent_structures;
+  Ident.iter
+    (fun id ((path, comps), _) -> iter_components (Pident id) path comps)
+    env.components
+
+let iter_types f = iter_env (fun env -> env.types) (fun sc -> sc.comp_types) f
+
+let same_types env1 env2 =
+  env1.types == env2.types && env1.components == env2.components
+
+let used_persistent () =
+  let r = ref Concr.empty in
+  Hashtbl.iter (fun s pso -> if pso != None then r := Concr.add s !r)
+    persistent_structures;
+  !r
+
+let find_all_comps proj s (p,mcomps) =
+  match EnvLazy.force !components_of_module_maker' mcomps with
+    Functor_comps _ -> []
+  | Structure_comps comps ->
+      try let (c,n) = Tbl.find s (proj comps) in [Pdot(p,s,n), c]
+      with Not_found -> []
+
+let rec find_shadowed_comps path env =
+  match path with
+    Pident id ->
+      List.map fst (Ident.find_all (Ident.name id) env.components)
+  | Pdot (p, s, _) ->
+      let l = find_shadowed_comps p env in
+      let l' =
+        List.map (find_all_comps (fun comps -> comps.comp_components) s) l in
+      List.flatten l'
+  | Papply _ -> []
+
+let find_shadowed proj1 proj2 path env =
+  match path with
+    Pident id ->
+      List.map fst (Ident.find_all (Ident.name id) (proj1 env))
+  | Pdot (p, s, _) ->
+      let l = find_shadowed_comps p env in
+      let l' = List.map (find_all_comps proj2 s) l in
+      List.flatten l'
+  | Papply _ -> []
+
+let find_shadowed_types path env =
+  let l =
+    find_shadowed
+      (fun env -> env.types) (fun comps -> comps.comp_types) path env
+  in
+  List.map fst l
+
+
+(* GADT instance tracking *)
+
+let add_gadt_instance_level lv env =
+  {env with
+   gadt_instances = (lv, ref TypeSet.empty) :: env.gadt_instances}
+
+let is_Tlink = function {desc = Tlink _} -> true | _ -> false
+
+let gadt_instance_level env t =
+  let rec find_instance = function
+      [] -> None
+    | (lv, r) :: rem ->
+        if TypeSet.exists is_Tlink !r then
+          (* Should we use set_typeset ? *)
+          r := TypeSet.fold (fun ty -> TypeSet.add (repr ty)) !r TypeSet.empty;
+        if TypeSet.mem t !r then Some lv else find_instance rem
+  in find_instance env.gadt_instances
+
+let add_gadt_instances env lv tl =
+  let r =
+    try List.assoc lv env.gadt_instances with Not_found -> assert false in
+  (* Format.eprintf "Added";
+  List.iter (fun ty -> Format.eprintf "@ %a" !Btype.print_raw ty) tl;
+  Format.eprintf "@."; *)
+  set_typeset r (List.fold_right TypeSet.add tl !r)
+
+(* Only use this after expand_head! *)
+let add_gadt_instance_chain env lv t =
+  let r =
+    try List.assoc lv env.gadt_instances with Not_found -> assert false in
+  let rec add_instance t =
+    let t = repr t in
+    if not (TypeSet.mem t !r) then begin
+      (* Format.eprintf "@ %a" !Btype.print_raw t; *)
+      set_typeset r (TypeSet.add t !r);
+      match t.desc with
+        Tconstr (p, _, memo) ->
+          may add_instance (find_expans Private p !memo)
+      | _ -> ()
+    end
+  in
+  (* Format.eprintf "Added chain"; *)
+  add_instance t
+  (* Format.eprintf "@." *)
+
 (* Expand manifest module type names at the top of the given module type *)
 
 let rec scrape_modtype mty env =
   match mty with
-    Tmty_ident path ->
+    Mty_ident path ->
       begin try
         scrape_modtype (find_modtype_expansion path env) env
       with Not_found ->
@@ -451,11 +919,13 @@
 (* Compute constructor descriptions *)
 
 let constructors_of_type ty_path decl =
+  let handle_variants cstrs =
+    Datarepr.constructor_descrs
+      (newgenty (Tconstr(ty_path, decl.type_params, ref Mnil)))
+      cstrs decl.type_private
+  in
   match decl.type_kind with
-    Type_variant cstrs ->
-      Datarepr.constructor_descrs
-        (Btype.newgenty (Tconstr(ty_path, decl.type_params, ref Mnil)))
-        cstrs decl.type_private
+  | Type_variant cstrs -> handle_variants cstrs
   | Type_record _ | Type_abstract -> []
 
 (* Compute label descriptions *)
@@ -464,7 +934,7 @@
   match decl.type_kind with
     Type_record(labels, rep) ->
       Datarepr.label_descrs
-        (Btype.newgenty (Tconstr(ty_path, decl.type_params, ref Mnil)))
+        (newgenty (Tconstr(ty_path, decl.type_params, ref Mnil)))
         labels rep decl.type_private
   | Type_variant _ | Type_abstract -> []
 
@@ -473,114 +943,169 @@
 
 let rec prefix_idents root pos sub = function
     [] -> ([], sub)
-  | Tsig_value(id, decl) :: rem ->
+  | Sig_value(id, decl) :: rem ->
       let p = Pdot(root, Ident.name id, pos) in
       let nextpos = match decl.val_kind with Val_prim _ -> pos | _ -> pos+1 in
       let (pl, final_sub) = prefix_idents root nextpos sub rem in
       (p::pl, final_sub)
-  | Tsig_type(id, decl, _) :: rem ->
+  | Sig_type(id, decl, _) :: rem ->
       let p = Pdot(root, Ident.name id, nopos) in
       let (pl, final_sub) =
         prefix_idents root pos (Subst.add_type id p sub) rem in
       (p::pl, final_sub)
-  | Tsig_exception(id, decl) :: rem ->
+  | Sig_exception(id, decl) :: rem ->
       let p = Pdot(root, Ident.name id, pos) in
       let (pl, final_sub) = prefix_idents root (pos+1) sub rem in
       (p::pl, final_sub)
-  | Tsig_module(id, mty, _) :: rem ->
+  | Sig_module(id, mty, _) :: rem ->
       let p = Pdot(root, Ident.name id, pos) in
       let (pl, final_sub) =
         prefix_idents root (pos+1) (Subst.add_module id p sub) rem in
       (p::pl, final_sub)
-  | Tsig_modtype(id, decl) :: rem ->
+  | Sig_modtype(id, decl) :: rem ->
       let p = Pdot(root, Ident.name id, nopos) in
       let (pl, final_sub) =
         prefix_idents root pos
-                      (Subst.add_modtype id (Tmty_ident p) sub) rem in
+                      (Subst.add_modtype id (Mty_ident p) sub) rem in
       (p::pl, final_sub)
-  | Tsig_class(id, decl, _) :: rem ->
+  | Sig_class(id, decl, _) :: rem ->
       let p = Pdot(root, Ident.name id, pos) in
       let (pl, final_sub) = prefix_idents root (pos + 1) sub rem in
       (p::pl, final_sub)
-  | Tsig_cltype(id, decl, _) :: rem ->
+  | Sig_class_type(id, decl, _) :: rem ->
       let p = Pdot(root, Ident.name id, nopos) in
       let (pl, final_sub) = prefix_idents root pos sub rem in
       (p::pl, final_sub)
 
+let subst_signature sub sg =
+  List.map
+    (fun item ->
+      match item with
+      | Sig_value(id, decl) ->
+          Sig_value (id, Subst.value_description sub decl)
+      | Sig_type(id, decl, x) ->
+          Sig_type(id, Subst.type_declaration sub decl, x)
+      | Sig_exception(id, decl) ->
+          Sig_exception (id, Subst.exception_declaration sub decl)
+      | Sig_module(id, mty, x) ->
+          Sig_module(id, Subst.modtype sub mty,x)
+      | Sig_modtype(id, decl) ->
+          Sig_modtype(id, Subst.modtype_declaration sub decl)
+      | Sig_class(id, decl, x) ->
+          Sig_class(id, Subst.class_declaration sub decl, x)
+      | Sig_class_type(id, decl, x) ->
+          Sig_class_type(id, Subst.cltype_declaration sub decl, x)
+    )
+    sg
+
+
+let prefix_idents_and_subst root sub sg =
+  let (pl, sub) = prefix_idents root 0 sub sg in
+  pl, sub, lazy (subst_signature sub sg)
+
+let prefix_idents_and_subst root sub sg =
+  if sub = Subst.identity then
+    let sgs =
+      try
+        Hashtbl.find prefixed_sg root
+      with Not_found ->
+        let sgs = ref [] in
+        Hashtbl.add prefixed_sg root sgs;
+        sgs
+    in
+    try
+      List.assq sg !sgs
+    with Not_found ->
+      let r = prefix_idents_and_subst root sub sg in
+      sgs := (sg, r) :: !sgs;
+      r
+  else
+    prefix_idents_and_subst root sub sg
+
 (* Compute structure descriptions *)
 
+let add_to_tbl id decl tbl =
+  let decls =
+    try Tbl.find id tbl with Not_found -> [] in
+  Tbl.add id (decl :: decls) tbl
+
 let rec components_of_module env sub path mty =
-  lazy(match scrape_modtype mty env with
-    Tmty_signature sg ->
+  EnvLazy.create (env, sub, path, mty)
+
+and components_of_module_maker (env, sub, path, mty) =
+  (match scrape_modtype mty env with
+    Mty_signature sg ->
       let c =
-        { comp_values = Tbl.empty; comp_annotations = Tbl.empty;
+        { comp_values = Tbl.empty;
           comp_constrs = Tbl.empty;
           comp_labels = Tbl.empty; comp_types = Tbl.empty;
           comp_modules = Tbl.empty; comp_modtypes = Tbl.empty;
           comp_components = Tbl.empty; comp_classes = Tbl.empty;
           comp_cltypes = Tbl.empty } in
-      let (pl, sub) = prefix_idents path 0 sub sg in
+      let pl, sub, _ = prefix_idents_and_subst path sub sg in
       let env = ref env in
       let pos = ref 0 in
       List.iter2 (fun item path ->
         match item with
-          Tsig_value(id, decl) ->
+          Sig_value(id, decl) ->
             let decl' = Subst.value_description sub decl in
             c.comp_values <-
               Tbl.add (Ident.name id) (decl', !pos) c.comp_values;
-            if !Clflags.annotations then begin
-              c.comp_annotations <-
-                Tbl.add (Ident.name id) (Annot.Iref_external, !pos)
-                        c.comp_annotations;
-            end;
             begin match decl.val_kind with
               Val_prim _ -> () | _ -> incr pos
             end
-        | Tsig_type(id, decl, _) ->
+        | Sig_type(id, decl, _) ->
             let decl' = Subst.type_declaration sub decl in
+            let constructors = List.map snd (constructors_of_type path decl') in
+            let labels = List.map snd (labels_of_type path decl') in
             c.comp_types <-
-              Tbl.add (Ident.name id) (decl', nopos) c.comp_types;
+              Tbl.add (Ident.name id)
+                ((decl', (constructors, labels)), nopos)
+                  c.comp_types;
             List.iter
-              (fun (name, descr) ->
-                c.comp_constrs <- Tbl.add name (descr, nopos) c.comp_constrs)
-              (constructors_of_type path decl');
+              (fun descr ->
+                c.comp_constrs <-
+                  add_to_tbl descr.cstr_name (descr, nopos) c.comp_constrs)
+              constructors;
             List.iter
-              (fun (name, descr) ->
-                c.comp_labels <- Tbl.add name (descr, nopos) c.comp_labels)
-              (labels_of_type path decl');
-            env := store_type_infos id path decl !env
-        | Tsig_exception(id, decl) ->
+              (fun descr ->
+                c.comp_labels <-
+                  add_to_tbl descr.lbl_name (descr, nopos) c.comp_labels)
+              labels;
+            env := store_type_infos None id path decl !env !env
+        | Sig_exception(id, decl) ->
             let decl' = Subst.exception_declaration sub decl in
             let cstr = Datarepr.exception_descr path decl' in
+            let s = Ident.name id in
             c.comp_constrs <-
-              Tbl.add (Ident.name id) (cstr, !pos) c.comp_constrs;
+              add_to_tbl s (cstr, !pos) c.comp_constrs;
             incr pos
-        | Tsig_module(id, mty, _) ->
-            let mty' = lazy (Subst.modtype sub mty) in
+        | Sig_module(id, mty, _) ->
+            let mty' = EnvLazy.create (sub, mty) in
             c.comp_modules <-
               Tbl.add (Ident.name id) (mty', !pos) c.comp_modules;
             let comps = components_of_module !env sub path mty in
             c.comp_components <-
               Tbl.add (Ident.name id) (comps, !pos) c.comp_components;
-            env := store_module id path mty !env;
+            env := store_module None id path mty !env !env;
             incr pos
-        | Tsig_modtype(id, decl) ->
+        | Sig_modtype(id, decl) ->
             let decl' = Subst.modtype_declaration sub decl in
             c.comp_modtypes <-
               Tbl.add (Ident.name id) (decl', nopos) c.comp_modtypes;
-            env := store_modtype id path decl !env
-        | Tsig_class(id, decl, _) ->
+            env := store_modtype None id path decl !env !env
+        | Sig_class(id, decl, _) ->
             let decl' = Subst.class_declaration sub decl in
             c.comp_classes <-
               Tbl.add (Ident.name id) (decl', !pos) c.comp_classes;
             incr pos
-        | Tsig_cltype(id, decl, _) ->
+        | Sig_class_type(id, decl, _) ->
             let decl' = Subst.cltype_declaration sub decl in
             c.comp_cltypes <-
               Tbl.add (Ident.name id) (decl', !pos) c.comp_cltypes)
         sg pl;
         Structure_comps c
-  | Tmty_functor(param, ty_arg, ty_res) ->
+  | Mty_functor(param, ty_arg, ty_res) ->
         Functor_comps {
           fcomp_param = param;
           (* fcomp_arg must be prefixed eagerly, because it is interpreted
@@ -591,81 +1116,144 @@
           fcomp_env = env;
           fcomp_subst = sub;
           fcomp_cache = Hashtbl.create 17 }
-  | Tmty_ident p ->
+  | Mty_ident p ->
         Structure_comps {
-          comp_values = Tbl.empty; comp_annotations = Tbl.empty;
+          comp_values = Tbl.empty;
           comp_constrs = Tbl.empty;
-          comp_labels = Tbl.empty; comp_types = Tbl.empty;
+          comp_labels = Tbl.empty;
+          comp_types = Tbl.empty;
           comp_modules = Tbl.empty; comp_modtypes = Tbl.empty;
           comp_components = Tbl.empty; comp_classes = Tbl.empty;
           comp_cltypes = Tbl.empty })
 
 (* Insertion of bindings by identifier + path *)
 
-and store_value id path decl env =
+and check_usage loc id warn tbl =
+  if not loc.Location.loc_ghost && Warnings.is_active (warn "") then begin
+    let name = Ident.name id in
+    let key = (name, loc) in
+    if Hashtbl.mem tbl key then ()
+    else let used = ref false in
+    Hashtbl.add tbl key (fun () -> used := true);
+    if not (name = "" || name.[0] = '_' || name.[0] = '#')
+    then
+      !add_delayed_check_forward
+        (fun () -> if not !used then Location.prerr_warning loc (warn name))
+  end;
+
+and store_value ?check slot id path decl env renv =
+  may (fun f -> check_usage decl.val_loc id f value_declarations) check;
   { env with
-    values = Ident.add id (path, decl) env.values;
+    values = EnvTbl.add "value" slot id (path, decl) env.values renv.values;
     summary = Env_value(env.summary, id, decl) }
 
-and store_annot id path annot env =
-  if !Clflags.annotations then
-    { env with
-      annotations = Ident.add id (path, annot) env.annotations }
-  else env
-
-and store_type id path info env =
+and store_type slot id path info env renv =
+  let loc = info.type_loc in
+  check_usage loc id (fun s -> Warnings.Unused_type_declaration s)
+    type_declarations;
+  let constructors = constructors_of_type path info in
+  let labels = labels_of_type path info in
+  let descrs = (List.map snd constructors, List.map snd labels) in
+
+  if not loc.Location.loc_ghost &&
+    Warnings.is_active (Warnings.Unused_constructor ("", false, false))
+  then begin
+    let ty = Ident.name id in
+    List.iter
+      begin fun (_, {cstr_name = c; _}) ->
+        let k = (ty, loc, c) in
+        if not (Hashtbl.mem used_constructors k) then
+          let used = constructor_usages () in
+          Hashtbl.add used_constructors k (add_constructor_usage used);
+          if not (ty = "" || ty.[0] = '_')
+          then !add_delayed_check_forward
+              (fun () ->
+                if not env.in_signature && not used.cu_positive then
+                  Location.prerr_warning loc
+                    (Warnings.Unused_constructor
+                       (c, used.cu_pattern, used.cu_privatize)))
+      end
+      constructors
+  end;
   { env with
     constrs =
       List.fold_right
-        (fun (name, descr) constrs ->
-          Ident.add (Ident.create name) descr constrs)
-        (constructors_of_type path info)
+        (fun (id, descr) constrs ->
+          EnvTbl.add "constructor" slot id descr constrs renv.constrs)
+        constructors
         env.constrs;
     labels =
       List.fold_right
-        (fun (name, descr) labels ->
-          Ident.add (Ident.create name) descr labels)
-        (labels_of_type path info)
+        (fun (id, descr) labels ->
+          EnvTbl.add "label" slot id descr labels renv.labels)
+        labels
         env.labels;
-    types = Ident.add id (path, info) env.types;
+    types = EnvTbl.add "type" slot id (path, (info, descrs)) env.types
+                       renv.types;
     summary = Env_type(env.summary, id, info) }
 
-and store_type_infos id path info env =
+and store_type_infos slot id path info env renv =
   (* Simplified version of store_type that doesn't compute and store
      constructor and label infos, but simply record the arity and
      manifest-ness of the type.  Used in components_of_module to
      keep track of type abbreviations (e.g. type t = float) in the
      computation of label representations. *)
   { env with
-    types = Ident.add id (path, info) env.types;
+    types = EnvTbl.add "type" slot id (path, (info,([],[]))) env.types
+                       renv.types;
     summary = Env_type(env.summary, id, info) }
 
-and store_exception id path decl env =
+and store_exception slot id path decl env renv =
+  let loc = decl.exn_loc in
+  if not loc.Location.loc_ghost &&
+    Warnings.is_active (Warnings.Unused_exception ("", false))
+  then begin
+    let ty = "exn" in
+    let c = Ident.name id in
+    let k = (ty, loc, c) in
+    if not (Hashtbl.mem used_constructors k) then begin
+      let used = constructor_usages () in
+      Hashtbl.add used_constructors k (add_constructor_usage used);
+      !add_delayed_check_forward
+        (fun () ->
+          if not env.in_signature && not used.cu_positive then
+            Location.prerr_warning loc
+              (Warnings.Unused_exception
+                 (c, used.cu_pattern)
+              )
+        )
+    end;
+  end;
   { env with
-    constrs = Ident.add id (Datarepr.exception_descr path decl) env.constrs;
+    constrs = EnvTbl.add "constructor" slot id
+                         (Datarepr.exception_descr path decl) env.constrs
+                         renv.constrs;
     summary = Env_exception(env.summary, id, decl) }
 
-and store_module id path mty env =
+and store_module slot id path mty env renv =
   { env with
-    modules = Ident.add id (path, mty) env.modules;
+    modules = EnvTbl.add "module" slot id (path, mty) env.modules renv.modules;
     components =
-      Ident.add id (path, components_of_module env Subst.identity path mty)
-                   env.components;
+      EnvTbl.add "module" slot id
+                 (path, components_of_module env Subst.identity path mty)
+                   env.components renv.components;
     summary = Env_module(env.summary, id, mty) }
 
-and store_modtype id path info env =
+and store_modtype slot id path info env renv =
   { env with
-    modtypes = Ident.add id (path, info) env.modtypes;
+    modtypes = EnvTbl.add "module type" slot id (path, info) env.modtypes
+                          renv.modtypes;
     summary = Env_modtype(env.summary, id, info) }
 
-and store_class id path desc env =
+and store_class slot id path desc env renv =
   { env with
-    classes = Ident.add id (path, desc) env.classes;
+    classes = EnvTbl.add "class" slot id (path, desc) env.classes renv.classes;
     summary = Env_class(env.summary, id, desc) }
 
-and store_cltype id path desc env =
+and store_cltype slot id path desc env renv =
   { env with
-    cltypes = Ident.add id (path, desc) env.cltypes;
+    cltypes = EnvTbl.add "class type" slot id (path, desc) env.cltypes
+                         renv.cltypes;
     summary = Env_cltype(env.summary, id, desc) }
 
 (* Compute the components of a functor application in a path. *)
@@ -686,40 +1274,47 @@
 
 let _ =
   components_of_module' := components_of_module;
-  components_of_functor_appl' := components_of_functor_appl
+  components_of_functor_appl' := components_of_functor_appl;
+  components_of_module_maker' := components_of_module_maker
 
 (* Insertion of bindings by identifier *)
 
-let add_value id desc env =
-  store_value id (Pident id) desc env
+let add_value ?check id desc env =
+  store_value None ?check id (Pident id) desc env env
 
-let add_annot id annot env =
-  store_annot id (Pident id) annot env
-
-and add_type id info env =
-  store_type id (Pident id) info env
+let add_type id info env =
+  store_type None id (Pident id) info env env
 
 and add_exception id decl env =
-  store_exception id (Pident id) decl env
+  store_exception None id (Pident id) decl env env
 
 and add_module id mty env =
-  store_module id (Pident id) mty env
+  store_module None id (Pident id) mty env env
 
 and add_modtype id info env =
-  store_modtype id (Pident id) info env
+  store_modtype None id (Pident id) info env env
 
 and add_class id ty env =
-  store_class id (Pident id) ty env
+  store_class None id (Pident id) ty env env
 
 and add_cltype id ty env =
-  store_cltype id (Pident id) ty env
+  store_cltype None id (Pident id) ty env env
+
+let add_local_constraint id info elv env =
+  match info with
+    {type_manifest = Some ty; type_newtype_level = Some (lv, _)} ->
+      (* elv is the expansion level, lv is the definition level *)
+      let env =
+        add_type id {info with type_newtype_level = Some (lv, elv)} env in
+      { env with local_constraints = true }
+  | _ -> assert false
 
 (* Insertion of bindings by name *)
 
 let enter store_fun name data env =
-  let id = Ident.create name in (id, store_fun id (Pident id) data env)
+  let id = Ident.create name in (id, store_fun None id (Pident id) data env env)
 
-let enter_value = enter store_value
+let enter_value ?check = enter (store_value ?check)
 and enter_type = enter store_type
 and enter_exception = enter store_exception
 and enter_module = enter store_module
@@ -731,13 +1326,13 @@
 
 let add_item comp env =
   match comp with
-    Tsig_value(id, decl)     -> add_value id decl env
-  | Tsig_type(id, decl, _)   -> add_type id decl env
-  | Tsig_exception(id, decl) -> add_exception id decl env
-  | Tsig_module(id, mty, _)  -> add_module id mty env
-  | Tsig_modtype(id, decl)   -> add_modtype id decl env
-  | Tsig_class(id, decl, _)  -> add_class id decl env
-  | Tsig_cltype(id, decl, _) -> add_cltype id decl env
+    Sig_value(id, decl)     -> add_value id decl env
+  | Sig_type(id, decl, _)   -> add_type id decl env
+  | Sig_exception(id, decl) -> add_exception id decl env
+  | Sig_module(id, mty, _)  -> add_module id mty env
+  | Sig_modtype(id, decl)   -> add_modtype id decl env
+  | Sig_class(id, decl, _)  -> add_class id decl env
+  | Sig_class_type(id, decl, _) -> add_cltype id decl env
 
 let rec add_signature sg env =
   match sg with
@@ -746,43 +1341,70 @@
 
 (* Open a signature path *)
 
-let open_signature root sg env =
+let open_signature slot root sg env0 =
   (* First build the paths and substitution *)
-  let (pl, sub) = prefix_idents root 0 Subst.identity sg in
+  let (pl, sub, sg) = prefix_idents_and_subst root Subst.identity sg in
+  let sg = Lazy.force sg in
+
   (* Then enter the components in the environment after substitution *)
+
   let newenv =
     List.fold_left2
       (fun env item p ->
         match item with
-          Tsig_value(id, decl) ->
-            let e1 = store_value (Ident.hide id) p
-                        (Subst.value_description sub decl) env
-            in store_annot (Ident.hide id) p (Annot.Iref_external) e1
-        | Tsig_type(id, decl, _) ->
-            store_type (Ident.hide id) p
-                       (Subst.type_declaration sub decl) env
-        | Tsig_exception(id, decl) ->
-            store_exception (Ident.hide id) p
-                            (Subst.exception_declaration sub decl) env
-        | Tsig_module(id, mty, _) ->
-            store_module (Ident.hide id) p (Subst.modtype sub mty) env
-        | Tsig_modtype(id, decl) ->
-            store_modtype (Ident.hide id) p
-                          (Subst.modtype_declaration sub decl) env
-        | Tsig_class(id, decl, _) ->
-            store_class (Ident.hide id) p
-                        (Subst.class_declaration sub decl) env
-        | Tsig_cltype(id, decl, _) ->
-            store_cltype (Ident.hide id) p
-                         (Subst.cltype_declaration sub decl) env)
-      env sg pl in
-  { newenv with summary = Env_open(env.summary, root) }
+          Sig_value(id, decl) ->
+            store_value slot (Ident.hide id) p decl env env0
+        | Sig_type(id, decl, _) ->
+            store_type slot (Ident.hide id) p decl env env0
+        | Sig_exception(id, decl) ->
+            store_exception slot (Ident.hide id) p decl env env0
+        | Sig_module(id, mty, _) ->
+            store_module slot (Ident.hide id) p mty env env0
+        | Sig_modtype(id, decl) ->
+            store_modtype slot (Ident.hide id) p decl env env0
+        | Sig_class(id, decl, _) ->
+            store_class slot (Ident.hide id) p decl env env0
+        | Sig_class_type(id, decl, _) ->
+            store_cltype slot (Ident.hide id) p decl env env0
+      )
+      env0 sg pl in
+  { newenv with summary = Env_open(env0.summary, root) }
 
 (* Open a signature from a file *)
 
 let open_pers_signature name env =
   let ps = find_pers_struct name in
-  open_signature (Pident(Ident.create_persistent name)) ps.ps_sig env
+  open_signature None (Pident(Ident.create_persistent name)) ps.ps_sig env
+
+let open_signature ?(loc = Location.none) ?(toplevel = false) ovf root sg env =
+  if not toplevel && ovf = Asttypes.Fresh && not loc.Location.loc_ghost
+     && (Warnings.is_active (Warnings.Unused_open "")
+         || Warnings.is_active (Warnings.Open_shadow_identifier ("", ""))
+         || Warnings.is_active (Warnings.Open_shadow_label_constructor ("","")))
+  then begin
+    let used = ref false in
+    !add_delayed_check_forward
+      (fun () ->
+        if not !used then
+          Location.prerr_warning loc (Warnings.Unused_open (Path.name root))
+      );
+    let shadowed = ref [] in
+    let slot kind s b =
+      if b && not (List.mem (kind, s) !shadowed) then begin
+        shadowed := (kind, s) :: !shadowed;
+        let w =
+          match kind with
+          | "label" | "constructor" ->
+              Warnings.Open_shadow_label_constructor (kind, s)
+          | _ -> Warnings.Open_shadow_identifier (kind, s)
+        in
+        Location.prerr_warning loc w
+      end;
+      used := true
+    in
+    open_signature (Some slot) root sg env
+  end
+  else open_signature None root sg env
 
 (* Read a signature from a file *)
 
@@ -811,29 +1433,29 @@
   let sg = Subst.signature (Subst.for_saving Subst.identity) sg in
   let oc = open_out_bin filename in
   try
-    output_string oc cmi_magic_number;
-    output_value oc (modname, sg);
-    flush oc;
-    let crc = Digest.file filename in
-    let crcs = (modname, crc) :: imports in
-    output_value oc crcs;
-    let flags = if !Clflags.recursive_types then [Rectypes] else [] in
-    output_value oc flags;
+    let cmi = {
+      cmi_name = modname;
+      cmi_sign = sg;
+      cmi_crcs = imports;
+      cmi_flags = if !Clflags.recursive_types then [Rectypes] else [];
+    } in
+    let crc = output_cmi filename oc cmi in
     close_out oc;
     (* Enter signature in persistent table so that imported_unit()
        will also return its crc *)
     let comps =
       components_of_module empty Subst.identity
-        (Pident(Ident.create_persistent modname)) (Tmty_signature sg) in
+        (Pident(Ident.create_persistent modname)) (Mty_signature sg) in
     let ps =
       { ps_name = modname;
         ps_sig = sg;
         ps_comps = comps;
-        ps_crcs = crcs;
+        ps_crcs = (cmi.cmi_name, crc) :: imports;
         ps_filename = filename;
-        ps_flags = flags } in
-    Hashtbl.add persistent_structures modname ps;
-    Consistbl.set crc_units modname crc filename
+        ps_flags = cmi.cmi_flags } in
+    Hashtbl.add persistent_structures modname (Some ps);
+    Consistbl.set crc_units modname crc filename;
+    sg
   with exn ->
     close_out oc;
     remove_file filename;
@@ -842,6 +1464,94 @@
 let save_signature sg modname filename =
   save_signature_with_imports sg modname filename (imported_units())
 
+(* Folding on environments *)
+
+let find_all proj1 proj2 f lid env acc =
+  match lid with
+    | None ->
+      EnvTbl.fold_name
+        (fun id (p, data) acc -> f (Ident.name id) p data acc)
+        (proj1 env) acc
+    | Some l ->
+      let p, desc = lookup_module_descr l env in
+      begin match EnvLazy.force components_of_module_maker desc with
+          Structure_comps c ->
+            Tbl.fold
+              (fun s (data, pos) acc -> f s (Pdot (p, s, pos)) data acc)
+              (proj2 c) acc
+        | Functor_comps _ ->
+            acc
+      end
+
+let find_all_simple_list proj1 proj2 f lid env acc =
+  match lid with
+    | None ->
+      EnvTbl.fold_name
+        (fun id data acc -> f data acc)
+        (proj1 env) acc
+    | Some l ->
+      let p, desc = lookup_module_descr l env in
+      begin match EnvLazy.force components_of_module_maker desc with
+          Structure_comps c ->
+            Tbl.fold
+              (fun s comps acc ->
+                match comps with
+                  [] -> acc
+                | (data, pos) :: _ ->
+                  f data acc)
+              (proj2 c) acc
+        | Functor_comps _ ->
+            acc
+      end
+
+let fold_modules f lid env acc =
+  match lid with
+    | None ->
+      let acc =
+        EnvTbl.fold_name
+          (fun id (p, data) acc -> f (Ident.name id) p data acc)
+          env.modules
+          acc
+      in
+      Hashtbl.fold
+        (fun name ps acc ->
+          match ps with
+              None -> acc
+            | Some ps ->
+              f name (Pident(Ident.create_persistent name))
+                     (Mty_signature ps.ps_sig) acc)
+        persistent_structures
+        acc
+    | Some l ->
+      let p, desc = lookup_module_descr l env in
+      begin match EnvLazy.force components_of_module_maker desc with
+          Structure_comps c ->
+            Tbl.fold
+              (fun s (data, pos) acc ->
+                f s (Pdot (p, s, pos))
+                    (EnvLazy.force subst_modtype_maker data) acc)
+              c.comp_modules
+              acc
+        | Functor_comps _ ->
+            acc
+      end
+
+let fold_values f =
+  find_all (fun env -> env.values) (fun sc -> sc.comp_values) f
+and fold_constructors f =
+  find_all_simple_list (fun env -> env.constrs) (fun sc -> sc.comp_constrs) f
+and fold_labels f =
+  find_all_simple_list (fun env -> env.labels) (fun sc -> sc.comp_labels) f
+and fold_types f =
+  find_all (fun env -> env.types) (fun sc -> sc.comp_types) f
+and fold_modtypes f =
+  find_all (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes) f
+and fold_classs f =
+  find_all (fun env -> env.classes) (fun sc -> sc.comp_classes) f
+and fold_cltypes f =
+  find_all (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes) f
+
+
 (* Make the initial environment *)
 
 let initial = Predef.build_initial_env add_type add_exception empty
@@ -850,22 +1560,45 @@
 
 let summary env = env.summary
 
+let last_env = ref empty
+let last_reduced_env = ref empty
+
+let keep_only_summary env =
+  if !last_env == env then !last_reduced_env
+  else begin
+    let new_env =
+      {
+       empty with
+       summary = env.summary;
+       local_constraints = env.local_constraints;
+       in_signature = env.in_signature;
+      }
+    in
+    last_env := env;
+    last_reduced_env := new_env;
+    new_env
+  end
+
+
+let env_of_only_summary env_from_summary env =
+  let new_env = env_from_summary env.summary Subst.identity in
+  { new_env with
+    local_constraints = env.local_constraints;
+    in_signature = env.in_signature;
+  }
+
 (* Error report *)
 
 open Format
 
 let report_error ppf = function
-  | Not_an_interface filename -> fprintf ppf
-      "%s@ is not a compiled interface" filename
-  | Corrupted_interface filename -> fprintf ppf
-      "Corrupted compiled interface@ %s" filename
-  | Illegal_renaming(modname, filename) -> fprintf ppf
-      "Wrong file naming: %s@ contains the compiled interface for@ %s"
-      filename modname
+  | Illegal_renaming(name, modname, filename) -> fprintf ppf
+      "Wrong file naming: %a@ contains the compiled interface for @ %s when %s was expected"
+      Location.print_filename filename name modname
   | Inconsistent_import(name, source1, source2) -> fprintf ppf
-      "@[The files %s@ and %s@ \
+      "@[The files %a@ and %a@ \
               make inconsistent assumptions@ over interface %s@]"
-      source1 source2 name
+      Location.print_filename source1 Location.print_filename source2 name
   | Need_recursive_types(import, export) ->
       fprintf ppf
         "@[Unit %s imports from %s, which uses recursive types.@ %s@]"
diff -Nru ocaml-3.12.1/typing/env.mli ocaml-4.01.0/typing/env.mli
--- ocaml-3.12.1/typing/env.mli	2008-10-06 13:53:54.000000000 +0000
+++ ocaml-4.01.0/typing/env.mli	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,55 +10,93 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: env.mli 9074 2008-10-06 13:53:54Z doligez $ *)
-
 (* Environment handling *)
 
 open Types
 
+type summary =
+    Env_empty
+  | Env_value of summary * Ident.t * value_description
+  | Env_type of summary * Ident.t * type_declaration
+  | Env_exception of summary * Ident.t * exception_declaration
+  | Env_module of summary * Ident.t * module_type
+  | Env_modtype of summary * Ident.t * modtype_declaration
+  | Env_class of summary * Ident.t * class_declaration
+  | Env_cltype of summary * Ident.t * class_type_declaration
+  | Env_open of summary * Path.t
+
 type t
 
 val empty: t
 val initial: t
 val diff: t -> t -> Ident.t list
 
+type type_descriptions =
+    constructor_description list * label_description list
+
+(* For short-paths *)
+val iter_types:
+    (Path.t -> Path.t * (type_declaration * type_descriptions) -> unit) ->
+    t -> unit
+val same_types: t -> t -> bool
+val used_persistent: unit -> Concr.t
+val find_shadowed_types: Path.t -> t -> Path.t list
+
 (* Lookup by paths *)
 
 val find_value: Path.t -> t -> value_description
 val find_type: Path.t -> t -> type_declaration
+val find_type_descrs: Path.t -> t -> type_descriptions
 val find_module: Path.t -> t -> module_type
 val find_modtype: Path.t -> t -> modtype_declaration
 val find_class: Path.t -> t -> class_declaration
-val find_cltype: Path.t -> t -> cltype_declaration
+val find_cltype: Path.t -> t -> class_type_declaration
 
-val find_type_expansion: Path.t -> t -> type_expr list * type_expr
-val find_type_expansion_opt: Path.t -> t -> type_expr list * type_expr
+val find_type_expansion:
+    ?level:int -> Path.t -> t -> type_expr list * type_expr * int option
+val find_type_expansion_opt:
+    Path.t -> t -> type_expr list * type_expr * int option
 (* Find the manifest type information associated to a type for the sake
    of the compiler's type-based optimisations. *)
-val find_modtype_expansion: Path.t -> t -> Types.module_type
+val find_modtype_expansion: Path.t -> t -> module_type
+
+val has_local_constraints: t -> bool
+val add_gadt_instance_level: int -> t -> t
+val gadt_instance_level: t -> type_expr -> int option
+val add_gadt_instances: t -> int -> type_expr list -> unit
+val add_gadt_instance_chain: t -> int -> type_expr -> unit
 
 (* Lookup by long identifiers *)
 
 val lookup_value: Longident.t -> t -> Path.t * value_description
-val lookup_annot: Longident.t -> t -> Path.t * Annot.ident
 val lookup_constructor: Longident.t -> t -> constructor_description
+val lookup_all_constructors:
+  Longident.t -> t -> (constructor_description * (unit -> unit)) list
 val lookup_label: Longident.t -> t -> label_description
+val lookup_all_labels:
+  Longident.t -> t -> (label_description * (unit -> unit)) list
 val lookup_type: Longident.t -> t -> Path.t * type_declaration
 val lookup_module: Longident.t -> t -> Path.t * module_type
 val lookup_modtype: Longident.t -> t -> Path.t * modtype_declaration
 val lookup_class: Longident.t -> t -> Path.t * class_declaration
-val lookup_cltype: Longident.t -> t -> Path.t * cltype_declaration
+val lookup_cltype: Longident.t -> t -> Path.t * class_type_declaration
+
+exception Recmodule
+  (* Raise by lookup_module when the identifier refers
+     to one of the modules of a recursive definition
+     during the computation of its approximation (see #5965). *)
 
 (* Insertion by identifier *)
 
-val add_value: Ident.t -> value_description -> t -> t
-val add_annot: Ident.t -> Annot.ident -> t -> t
+val add_value:
+    ?check:(string -> Warnings.t) -> Ident.t -> value_description -> t -> t
 val add_type: Ident.t -> type_declaration -> t -> t
 val add_exception: Ident.t -> exception_declaration -> t -> t
 val add_module: Ident.t -> module_type -> t -> t
 val add_modtype: Ident.t -> modtype_declaration -> t -> t
 val add_class: Ident.t -> class_declaration -> t -> t
-val add_cltype: Ident.t -> cltype_declaration -> t -> t
+val add_cltype: Ident.t -> class_type_declaration -> t -> t
+val add_local_constraint: Ident.t -> type_declaration -> int -> t -> t
 
 (* Insertion of all fields of a signature. *)
 
@@ -68,22 +106,29 @@
 (* Insertion of all fields of a signature, relative to the given path.
    Used to implement open. *)
 
-val open_signature: Path.t -> signature -> t -> t
+val open_signature:
+    ?loc:Location.t -> ?toplevel:bool -> Asttypes.override_flag -> Path.t ->
+      signature -> t -> t
 val open_pers_signature: string -> t -> t
 
 (* Insertion by name *)
 
-val enter_value: string -> value_description -> t -> Ident.t * t
+val enter_value:
+    ?check:(string -> Warnings.t) ->
+    string -> value_description -> t -> Ident.t * t
 val enter_type: string -> type_declaration -> t -> Ident.t * t
 val enter_exception: string -> exception_declaration -> t -> Ident.t * t
 val enter_module: string -> module_type -> t -> Ident.t * t
 val enter_modtype: string -> modtype_declaration -> t -> Ident.t * t
 val enter_class: string -> class_declaration -> t -> Ident.t * t
-val enter_cltype: string -> cltype_declaration -> t -> Ident.t * t
+val enter_cltype: string -> class_type_declaration -> t -> Ident.t * t
 
 (* Initialize the cache of in-core module interfaces. *)
 val reset_cache: unit -> unit
 
+(* To be called before each toplevel phrase. *)
+val reset_cache_toplevel: unit -> unit
+
 (* Remember the name of the current compilation unit. *)
 val set_unit_name: string -> unit
 
@@ -91,10 +136,10 @@
 
 val read_signature: string -> string -> signature
         (* Arguments: module name, file name. Results: signature. *)
-val save_signature: signature -> string -> string -> unit
+val save_signature: signature -> string -> string -> signature
         (* Arguments: signature, module name, file name. *)
 val save_signature_with_imports:
-            signature -> string -> string -> (string * Digest.t) list -> unit
+    signature -> string -> string -> (string * Digest.t) list -> signature
         (* Arguments: signature, module name, file name,
            imported units with their CRCs. *)
 
@@ -113,25 +158,19 @@
 (* Summaries -- compact representation of an environment, to be
    exported in debugging information. *)
 
-type summary =
-    Env_empty
-  | Env_value of summary * Ident.t * value_description
-  | Env_type of summary * Ident.t * type_declaration
-  | Env_exception of summary * Ident.t * exception_declaration
-  | Env_module of summary * Ident.t * module_type
-  | Env_modtype of summary * Ident.t * modtype_declaration
-  | Env_class of summary * Ident.t * class_declaration
-  | Env_cltype of summary * Ident.t * cltype_declaration
-  | Env_open of summary * Path.t
-
 val summary: t -> summary
 
+(* Return an equivalent environment where all fields have been reset,
+   except the summary. The initial environment can be rebuilt from the
+   summary, using Envaux.env_of_only_summary. *)
+
+val keep_only_summary : t -> t
+val env_of_only_summary : (summary -> Subst.t -> t) -> t -> t
+
 (* Error report *)
 
 type error =
-    Not_an_interface of string
-  | Corrupted_interface of string
-  | Illegal_renaming of string * string
+  | Illegal_renaming of string * string * string
   | Inconsistent_import of string * string * string
   | Need_recursive_types of string * string
 
@@ -141,6 +180,57 @@
 
 val report_error: formatter -> error -> unit
 
+
+val mark_value_used: string -> value_description -> unit
+val mark_type_used: string -> type_declaration -> unit
+
+type constructor_usage = Positive | Pattern | Privatize
+val mark_constructor_used:
+    constructor_usage -> string -> type_declaration -> string -> unit
+val mark_constructor:
+    constructor_usage -> t -> string -> constructor_description -> unit
+val mark_exception_used:
+    constructor_usage -> exception_declaration -> string -> unit
+
+val in_signature: t -> t
+
+val set_value_used_callback:
+    string -> value_description -> (unit -> unit) -> unit
+val set_type_used_callback:
+    string -> type_declaration -> ((unit -> unit) -> unit) -> unit
+
 (* Forward declaration to break mutual recursion with Includemod. *)
 val check_modtype_inclusion:
       (t -> module_type -> Path.t -> module_type -> unit) ref
+(* Forward declaration to break mutual recursion with Typecore. *)
+val add_delayed_check_forward: ((unit -> unit) -> unit) ref
+
+(** Folding over all identifiers (for analysis purpose) *)
+
+val fold_values:
+  (string -> Path.t -> value_description -> 'a -> 'a) ->
+  Longident.t option -> t -> 'a -> 'a
+val fold_types:
+  (string -> Path.t -> type_declaration * type_descriptions -> 'a -> 'a) ->
+  Longident.t option -> t -> 'a -> 'a
+val fold_constructors:
+  (constructor_description -> 'a -> 'a) ->
+  Longident.t option -> t -> 'a -> 'a
+val fold_labels:
+  (label_description -> 'a -> 'a) ->
+  Longident.t option -> t -> 'a -> 'a
+
+(** Persistent structures are only traversed if they are already loaded. *)
+val fold_modules:
+  (string -> Path.t -> module_type -> 'a -> 'a) ->
+  Longident.t option -> t -> 'a -> 'a
+
+val fold_modtypes:
+  (string -> Path.t -> modtype_declaration -> 'a -> 'a) ->
+  Longident.t option -> t -> 'a -> 'a
+val fold_classs:
+  (string -> Path.t -> class_declaration -> 'a -> 'a) ->
+  Longident.t option -> t -> 'a -> 'a
+val fold_cltypes:
+  (string -> Path.t -> class_type_declaration -> 'a -> 'a) ->
+  Longident.t option -> t -> 'a -> 'a
diff -Nru ocaml-3.12.1/typing/envaux.ml ocaml-4.01.0/typing/envaux.ml
--- ocaml-3.12.1/typing/envaux.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/typing/envaux.ml	2013-07-23 14:48:47.000000000 +0000
@@ -0,0 +1,87 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Jerome Vouillon, projet Cristal, INRIA Rocquencourt        *)
+(*          OCaml port by John Malecki and Xavier Leroy                *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+open Misc
+open Types
+open Env
+
+type error =
+    Module_not_found of Path.t
+
+exception Error of error
+
+let env_cache =
+  (Hashtbl.create 59 : ((Env.summary * Subst.t), Env.t) Hashtbl.t)
+
+let reset_cache () =
+  Hashtbl.clear env_cache;
+  Env.reset_cache()
+
+let extract_sig env mty =
+  match Mtype.scrape env mty with
+    Mty_signature sg -> sg
+  | _ -> fatal_error "Envaux.extract_sig"
+
+let rec env_from_summary sum subst =
+  try
+    Hashtbl.find env_cache (sum, subst)
+  with Not_found ->
+    let env =
+      match sum with
+        Env_empty ->
+          Env.empty
+      | Env_value(s, id, desc) ->
+          Env.add_value id (Subst.value_description subst desc)
+                        (env_from_summary s subst)
+      | Env_type(s, id, desc) ->
+          Env.add_type id (Subst.type_declaration subst desc)
+                       (env_from_summary s subst)
+      | Env_exception(s, id, desc) ->
+          Env.add_exception id (Subst.exception_declaration subst desc)
+                            (env_from_summary s subst)
+      | Env_module(s, id, desc) ->
+          Env.add_module id (Subst.modtype subst desc)
+                         (env_from_summary s subst)
+      | Env_modtype(s, id, desc) ->
+          Env.add_modtype id (Subst.modtype_declaration subst desc)
+                          (env_from_summary s subst)
+      | Env_class(s, id, desc) ->
+          Env.add_class id (Subst.class_declaration subst desc)
+                        (env_from_summary s subst)
+      | Env_cltype (s, id, desc) ->
+          Env.add_cltype id (Subst.cltype_declaration subst desc)
+                         (env_from_summary s subst)
+      | Env_open(s, path) ->
+          let env = env_from_summary s subst in
+          let path' = Subst.module_path subst path in
+          let mty =
+            try
+              Env.find_module path' env
+            with Not_found ->
+              raise (Error (Module_not_found path'))
+          in
+          Env.open_signature Asttypes.Override path' (extract_sig env mty) env
+    in
+      Hashtbl.add env_cache (sum, subst) env;
+      env
+
+let env_of_only_summary env =
+  Env.env_of_only_summary env_from_summary env
+
+(* Error report *)
+
+open Format
+
+let report_error ppf = function
+  | Module_not_found p ->
+      fprintf ppf "@[Cannot find module %a@].@." Printtyp.path p
diff -Nru ocaml-3.12.1/typing/envaux.mli ocaml-4.01.0/typing/envaux.mli
--- ocaml-3.12.1/typing/envaux.mli	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/typing/envaux.mli	2012-10-15 17:50:56.000000000 +0000
@@ -0,0 +1,33 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*          Jerome Vouillon, projet Cristal, INRIA Rocquencourt        *)
+(*          OCaml port by John Malecki and Xavier Leroy                *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+open Format
+
+(* Convert environment summaries to environments *)
+
+val env_from_summary : Env.summary -> Subst.t -> Env.t
+
+(* Empty the environment caches. To be called when load_path changes. *)
+
+val reset_cache: unit -> unit
+
+val env_of_only_summary : Env.t -> Env.t
+
+(* Error report *)
+
+type error =
+    Module_not_found of Path.t
+
+exception Error of error
+
+val report_error: formatter -> error -> unit
diff -Nru ocaml-3.12.1/typing/ident.ml ocaml-4.01.0/typing/ident.ml
--- ocaml-3.12.1/typing/ident.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/typing/ident.ml	2013-02-09 08:42:11.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: ident.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 open Format
 
 type t = { stamp: int; name: string; mutable flags: int }
@@ -172,13 +170,42 @@
       else
         find_name name (if c < 0 then l else r)
 
-let rec keys_aux stack accu = function
+let rec get_all = function
+  | None -> []
+  | Some k -> k.data :: get_all k.previous
+
+let rec find_all name = function
+    Empty ->
+      []
+  | Node(l, k, r, _) ->
+      let c = compare name k.ident.name in
+      if c = 0 then
+        k.data :: get_all k.previous
+      else
+        find_all name (if c < 0 then l else r)
+
+let rec fold_aux f stack accu = function
     Empty ->
       begin match stack with
         [] -> accu
-      | a :: l -> keys_aux l accu a
+      | a :: l -> fold_aux f l accu a
       end
   | Node(l, k, r, _) ->
-      keys_aux (l :: stack) (k.ident :: accu) r
+      fold_aux f (l :: stack) (f k accu) r
+
+let fold_name f tbl accu = fold_aux (fun k -> f k.ident k.data) [] accu tbl
+
+let rec fold_data f d accu =
+  match d with
+    None -> accu
+  | Some k -> f k.ident k.data (fold_data f k.previous accu)
 
-let keys tbl = keys_aux [] [] tbl
+let fold_all f tbl accu =
+  fold_aux (fun k -> fold_data f (Some k)) [] accu tbl
+
+(* let keys tbl = fold_name (fun k _ accu -> k::accu) tbl [] *)
+
+let rec iter f = function
+    Empty -> ()
+  | Node(l, k, r, _) ->
+      iter f l; f k.ident k.data; iter f r
diff -Nru ocaml-3.12.1/typing/ident.mli ocaml-4.01.0/typing/ident.mli
--- ocaml-3.12.1/typing/ident.mli	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/typing/ident.mli	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,11 +10,9 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: ident.mli 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* Identifiers (unique names) *)
 
-type t
+type t = { stamp: int; name: string; mutable flags: int }
 
 val create: string -> t
 val create_persistent: string -> t
@@ -56,4 +54,7 @@
 val add: t -> 'a -> 'a tbl -> 'a tbl
 val find_same: t -> 'a tbl -> 'a
 val find_name: string -> 'a tbl -> 'a
-val keys: 'a tbl -> t list
+val find_all: string -> 'a tbl -> 'a list
+val fold_name: (t -> 'a -> 'b -> 'b) -> 'a tbl -> 'b -> 'b
+val fold_all: (t -> 'a -> 'b -> 'b) -> 'a tbl -> 'b -> 'b
+val iter: (t -> 'a -> unit) -> 'a tbl -> unit
diff -Nru ocaml-3.12.1/typing/includeclass.ml ocaml-4.01.0/typing/includeclass.ml
--- ocaml-3.12.1/typing/includeclass.ml	2010-06-08 08:43:38.000000000 +0000
+++ ocaml-4.01.0/typing/includeclass.ml	2013-02-09 08:42:11.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*          Jerome Vouillon, projet Cristal, INRIA Rocquencourt        *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: includeclass.ml 10541 2010-06-08 08:43:38Z garrigue $ *)
-
 (* Inclusion checks for the class language *)
 
 open Types
@@ -49,36 +47,35 @@
   | CM_Parameter_arity_mismatch (ls, lp) ->
       fprintf ppf
         "The classes do not have the same number of type parameters"
-  | CM_Type_parameter_mismatch trace ->
-      fprintf ppf "@[%a@]"
-      (Printtyp.unification_error false trace
+  | CM_Type_parameter_mismatch (env, trace) ->
+      Printtyp.report_unification_error ppf env ~unif:false trace
         (function ppf ->
-          fprintf ppf "A type parameter has type"))
+          fprintf ppf "A type parameter has type")
         (function ppf ->
           fprintf ppf "but is expected to have type")
-  | CM_Class_type_mismatch (cty1, cty2) ->
-      fprintf ppf
-       "@[The class type@;<1 2>%a@ is not matched by the class type@;<1 2>%a@]"
-       Printtyp.class_type cty1 Printtyp.class_type cty2
-  | CM_Parameter_mismatch trace ->
-      fprintf ppf "@[%a@]"
-      (Printtyp.unification_error false trace
+  | CM_Class_type_mismatch (env, cty1, cty2) ->
+      Printtyp.wrap_printing_env env (fun () ->
+        fprintf ppf
+          "@[The class type@;<1 2>%a@ %s@;<1 2>%a@]"
+          Printtyp.class_type cty1
+          "is not matched by the class type"
+          Printtyp.class_type cty2)
+  | CM_Parameter_mismatch (env, trace) ->
+      Printtyp.report_unification_error ppf env ~unif:false trace
         (function ppf ->
-          fprintf ppf "A parameter has type"))
+          fprintf ppf "A parameter has type")
         (function ppf ->
           fprintf ppf "but is expected to have type")
-  | CM_Val_type_mismatch (lab, trace) ->
-      fprintf ppf "@[%a@]"
-      (Printtyp.unification_error false trace
+  | CM_Val_type_mismatch (lab, env, trace) ->
+      Printtyp.report_unification_error ppf env ~unif:false trace
         (function ppf ->
-          fprintf ppf "The instance variable %s@ has type" lab))
+          fprintf ppf "The instance variable %s@ has type" lab)
         (function ppf ->
           fprintf ppf "but is expected to have type")
-  | CM_Meth_type_mismatch (lab, trace) ->
-      fprintf ppf "@[%a@]"
-      (Printtyp.unification_error false trace
+  | CM_Meth_type_mismatch (lab, env, trace) ->
+      Printtyp.report_unification_error ppf env ~unif:false trace
         (function ppf ->
-          fprintf ppf "The method %s@ has type" lab))
+          fprintf ppf "The method %s@ has type" lab)
         (function ppf ->
           fprintf ppf "but is expected to have type")
   | CM_Non_mutable_value lab ->
diff -Nru ocaml-3.12.1/typing/includeclass.mli ocaml-4.01.0/typing/includeclass.mli
--- ocaml-3.12.1/typing/includeclass.mli	2000-03-06 22:12:09.000000000 +0000
+++ ocaml-4.01.0/typing/includeclass.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*          Jerome Vouillon, projet Cristal, INRIA Rocquencourt        *)
 (*                                                                     *)
@@ -10,19 +10,16 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: includeclass.mli 2908 2000-03-06 22:12:09Z weis $ *)
-
 (* Inclusion checks for the class language *)
 
 open Types
-open Typedtree
 open Ctype
 open Format
 
 val class_types:
         Env.t -> class_type -> class_type -> class_match_failure list
 val class_type_declarations:
-        Env.t -> cltype_declaration -> cltype_declaration ->
+        Env.t -> class_type_declaration -> class_type_declaration ->
         class_match_failure list
 val class_declarations:
         Env.t -> class_declaration -> class_declaration ->
diff -Nru ocaml-3.12.1/typing/includecore.ml ocaml-4.01.0/typing/includecore.ml
--- ocaml-3.12.1/typing/includecore.ml	2010-05-24 06:52:16.000000000 +0000
+++ ocaml-4.01.0/typing/includecore.ml	2013-07-09 11:17:33.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,11 +10,8 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: includecore.ml 10458 2010-05-24 06:52:16Z garrigue $ *)
-
 (* Inclusion checks for the core language *)
 
-open Misc
 open Asttypes
 open Path
 open Types
@@ -61,7 +58,10 @@
     Tvariant row1, Tvariant row2 when is_absrow env (Btype.row_more row2) ->
       let row1 = Btype.row_repr row1 and row2 = Btype.row_repr row2 in
       Ctype.equal env true (ty1::params1) (row2.row_more::params2) &&
-      (match row1.row_more with {desc=Tvar|Tconstr _} -> true | _ -> false) &&
+      begin match row1.row_more with
+        {desc=Tvar _|Tconstr _|Tnil} -> true
+      | _ -> false
+      end &&
       let r1, r2, pairs =
         Ctype.merge_row_fields row1.row_fields row2.row_fields in
       (not row2.row_closed ||
@@ -91,7 +91,7 @@
       let (fields2,rest2) = Ctype.flatten_fields fi2 in
       Ctype.equal env true (ty1::params1) (rest2::params2) &&
       let (fields1,rest1) = Ctype.flatten_fields fi1 in
-      (match rest1 with {desc=Tnil|Tvar|Tconstr _} -> true | _ -> false) &&
+      (match rest1 with {desc=Tnil|Tvar _|Tconstr _} -> true | _ -> false) &&
       let pairs, miss1, miss2 = Ctype.associate_fields fields1 fields2 in
       miss2 = [] &&
       let tl1, tl2 =
@@ -115,19 +115,13 @@
   | Constraint
   | Manifest
   | Variance
-  | Field_type of string
-  | Field_mutable of string
-  | Field_arity of string
-  | Field_names of int * string * string
-  | Field_missing of bool * string
+  | Field_type of Ident.t
+  | Field_mutable of Ident.t
+  | Field_arity of Ident.t
+  | Field_names of int * Ident.t * Ident.t
+  | Field_missing of bool * Ident.t
   | Record_representation of bool
 
-let nth n =
-  if n = 1 then "first" else
-  if n = 2 then "2nd" else
-  if n = 3 then "3rd" else
-  string_of_int n ^ "th"
-
 let report_type_mismatch0 first second decl ppf err =
   let pr fmt = Format.fprintf ppf fmt in
   match err with
@@ -138,17 +132,17 @@
   | Manifest -> ()
   | Variance -> pr "Their variances do not agree"
   | Field_type s ->
-      pr "The types for field %s are not equal" s
+      pr "The types for field %s are not equal" (Ident.name s)
   | Field_mutable s ->
-      pr "The mutability of field %s is different" s
+      pr "The mutability of field %s is different" (Ident.name s)
   | Field_arity s ->
-      pr "The arities for field %s differ" s
+      pr "The arities for field %s differ" (Ident.name s)
   | Field_names (n, name1, name2) ->
-      pr "Their %s fields have different names, %s and %s"
-        (nth n) name1 name2
+      pr "Fields number %i have different names, %s and %s"
+        n (Ident.name name1) (Ident.name name2)
   | Field_missing (b, s) ->
       pr "The field %s is only present in %s %s"
-        s (if b then second else first) decl
+        (Ident.name s) (if b then second else first) decl
   | Record_representation b ->
       pr "Their internal representations differ:@ %s %s %s"
         (if b then second else first) decl
@@ -163,18 +157,28 @@
 let rec compare_variants env decl1 decl2 n cstrs1 cstrs2 =
   match cstrs1, cstrs2 with
     [], []           -> []
-  | [], (cstr2,_)::_ -> [Field_missing (true, cstr2)]
-  | (cstr1,_)::_, [] -> [Field_missing (false, cstr1)]
-  | (cstr1, arg1)::rem1, (cstr2, arg2)::rem2 ->
-      if cstr1 <> cstr2 then [Field_names (n, cstr1, cstr2)] else
-      if List.length arg1 <> List.length arg2 then [Field_arity cstr1] else
-      if Misc.for_all2
-          (fun ty1 ty2 ->
-            Ctype.equal env true (ty1::decl1.type_params)
-                                 (ty2::decl2.type_params))
-          arg1 arg2
-      then compare_variants env decl1 decl2 (n+1) rem1 rem2
-      else [Field_type cstr1]
+  | [], (cstr2,_,_)::_ -> [Field_missing (true, cstr2)]
+  | (cstr1,_,_)::_, [] -> [Field_missing (false, cstr1)]
+  | (cstr1, arg1, ret1)::rem1, (cstr2, arg2,ret2)::rem2 ->
+      if Ident.name cstr1 <> Ident.name cstr2 then
+        [Field_names (n, cstr1, cstr2)]
+      else if List.length arg1 <> List.length arg2 then
+        [Field_arity cstr1]
+      else match ret1, ret2 with
+      | Some r1, Some r2 when not (Ctype.equal env true [r1] [r2]) ->
+          [Field_type cstr1]
+      | Some _, None | None, Some _ ->
+          [Field_type cstr1]
+      | _ ->
+          if Misc.for_all2
+              (fun ty1 ty2 ->
+                Ctype.equal env true (ty1::decl1.type_params)
+                  (ty2::decl2.type_params))
+              (arg1) (arg2)
+          then
+            compare_variants env decl1 decl2 (n+1) rem1 rem2
+          else [Field_type cstr1]
+
 
 let rec compare_records env decl1 decl2 n labels1 labels2 =
   match labels1, labels2 with
@@ -182,19 +186,32 @@
   | [], (lab2,_,_)::_ -> [Field_missing (true, lab2)]
   | (lab1,_,_)::_, [] -> [Field_missing (false, lab1)]
   | (lab1, mut1, arg1)::rem1, (lab2, mut2, arg2)::rem2 ->
-      if lab1 <> lab2 then [Field_names (n, lab1, lab2)] else
-      if mut1 <> mut2 then [Field_mutable lab1] else
+      if Ident.name lab1 <> Ident.name lab2
+      then [Field_names (n, lab1, lab2)]
+      else if mut1 <> mut2 then [Field_mutable lab1] else
       if Ctype.equal env true (arg1::decl1.type_params)
                               (arg2::decl2.type_params)
       then compare_records env decl1 decl2 (n+1) rem1 rem2
       else [Field_type lab1]
 
-let type_declarations env id decl1 decl2 =
+let type_declarations ?(equality = false) env name decl1 id decl2 =
   if decl1.type_arity <> decl2.type_arity then [Arity] else
   if not (private_flags decl1 decl2) then [Privacy] else
   let err = match (decl1.type_kind, decl2.type_kind) with
       (_, Type_abstract) -> []
     | (Type_variant cstrs1, Type_variant cstrs2) ->
+        let mark cstrs usage name decl =
+          List.iter
+            (fun (c, _, _) ->
+              Env.mark_constructor_used usage name decl (Ident.name c))
+            cstrs
+        in
+        let usage =
+          if decl1.type_private = Private || decl2.type_private = Public
+          then Env.Positive else Env.Privatize
+        in
+        mark cstrs1 usage name decl1;
+        if equality then mark cstrs2 Env.Positive (Ident.name id) decl2;
         compare_variants env decl1 decl2 1 cstrs1 cstrs2
     | (Type_record(labels1,rep1), Type_record(labels2,rep2)) ->
         let err = compare_records env decl1 decl2 1 labels1 labels2 in
@@ -221,29 +238,32 @@
         else [Constraint]
   in
   if err <> [] then err else
-  if match decl2.type_kind with
-  | Type_record (_,_) | Type_variant _ -> decl2.type_private = Private
-  | Type_abstract ->
-      match decl2.type_manifest with
-      | None -> true
-      | Some ty -> Btype.has_constr_row (Ctype.expand_head env ty)
-  then
-    if List.for_all2
-        (fun (co1,cn1,ct1) (co2,cn2,ct2) -> (not co1 || co2)&&(not cn1 || cn2))
-        decl1.type_variance decl2.type_variance
-    then [] else [Variance]
-  else []
+  let abstr =
+    decl2.type_private = Private ||
+    decl2.type_kind = Type_abstract && decl2.type_manifest = None in
+  if List.for_all2
+      (fun ty (v1,v2) ->
+        let open Variance in
+        let imp a b = not a || b in
+        let (co1,cn1) = get_upper v1 and (co2,cn2) = get_upper v2 in
+        imp abstr (imp co1 co2 && imp cn1 cn2) &&
+        (abstr || Btype.(is_Tvar (repr ty)) || co1 = co2 && cn1 = cn2) &&
+        let (p1,n1,i1,j1) = get_lower v1 and (p2,n2,i2,j2) = get_lower v2 in
+        imp abstr (imp p2 p1 && imp n2 n1 && imp i2 i1 && imp j2 j1))
+      decl2.type_params (List.combine decl1.type_variance decl2.type_variance)
+  then [] else [Variance]
 
 (* Inclusion between exception declarations *)
 
 let exception_declarations env ed1 ed2 =
-  Misc.for_all2 (fun ty1 ty2 -> Ctype.equal env false [ty1] [ty2]) ed1 ed2
+  Misc.for_all2 (fun ty1 ty2 -> Ctype.equal env false [ty1] [ty2])
+    ed1.exn_args ed2.exn_args
 
 (* Inclusion between class types *)
 let encode_val (mut, ty) rem =
   begin match mut with
     Asttypes.Mutable   -> Predef.type_unit
-  | Asttypes.Immutable -> Btype.newgenty Tvar
+  | Asttypes.Immutable -> Btype.newgenvar ()
   end
   ::ty::rem
 
diff -Nru ocaml-3.12.1/typing/includecore.mli ocaml-4.01.0/typing/includecore.mli
--- ocaml-3.12.1/typing/includecore.mli	2010-05-21 15:13:47.000000000 +0000
+++ ocaml-4.01.0/typing/includecore.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,12 +10,10 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: includecore.mli 10455 2010-05-21 15:13:47Z garrigue $ *)
-
 (* Inclusion checks for the core language *)
 
-open Types
 open Typedtree
+open Types
 
 exception Dont_match
 
@@ -26,18 +24,19 @@
   | Constraint
   | Manifest
   | Variance
-  | Field_type of string
-  | Field_mutable of string
-  | Field_arity of string
-  | Field_names of int * string * string
-  | Field_missing of bool * string
+  | Field_type of Ident.t
+  | Field_mutable of Ident.t
+  | Field_arity of Ident.t
+  | Field_names of int * Ident.t * Ident.t
+  | Field_missing of bool * Ident.t
   | Record_representation of bool
 
 val value_descriptions:
     Env.t -> value_description -> value_description -> module_coercion
 val type_declarations:
-    Env.t -> Ident.t ->
-    type_declaration -> type_declaration -> type_mismatch list
+    ?equality:bool ->
+      Env.t -> string ->
+        type_declaration -> Ident.t -> type_declaration -> type_mismatch list
 val exception_declarations:
     Env.t -> exception_declaration -> exception_declaration -> bool
 (*
diff -Nru ocaml-3.12.1/typing/includemod.ml ocaml-4.01.0/typing/includemod.ml
--- ocaml-3.12.1/typing/includemod.ml	2010-05-24 06:52:16.000000000 +0000
+++ ocaml-4.01.0/typing/includemod.ml	2013-06-03 14:46:04.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,16 +10,14 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: includemod.ml 10458 2010-05-24 06:52:16Z garrigue $ *)
-
 (* Inclusion checks for the module language *)
 
 open Misc
 open Path
-open Types
 open Typedtree
+open Types
 
-type error =
+type symptom =
     Missing_field of Ident.t
   | Value_descriptions of Ident.t * value_description * value_description
   | Type_declarations of Ident.t * type_declaration
@@ -31,13 +29,17 @@
   | Modtype_permutation
   | Interface_mismatch of string * string
   | Class_type_declarations of
-      Ident.t * cltype_declaration * cltype_declaration *
+      Ident.t * class_type_declaration * class_type_declaration *
       Ctype.class_match_failure list
   | Class_declarations of
       Ident.t * class_declaration * class_declaration *
       Ctype.class_match_failure list
   | Unbound_modtype_path of Path.t
 
+type pos =
+    Module of Ident.t | Modtype of Ident.t | Arg of Ident.t | Body of Ident.t
+type error = pos list * Env.t * symptom
+
 exception Error of error list
 
 (* All functions "blah env x1 x2" check that x1 is included in x2,
@@ -46,51 +48,57 @@
 
 (* Inclusion between value descriptions *)
 
-let value_descriptions env subst id vd1 vd2 =
+let value_descriptions env cxt subst id vd1 vd2 =
+  Env.mark_value_used (Ident.name id) vd1;
   let vd2 = Subst.value_description subst vd2 in
   try
     Includecore.value_descriptions env vd1 vd2
   with Includecore.Dont_match ->
-    raise(Error[Value_descriptions(id, vd1, vd2)])
+    raise(Error[cxt, env, Value_descriptions(id, vd1, vd2)])
 
 (* Inclusion between type declarations *)
 
-let type_declarations env subst id decl1 decl2 =
+let type_declarations env cxt subst id decl1 decl2 =
+  Env.mark_type_used (Ident.name id) decl1;
   let decl2 = Subst.type_declaration subst decl2 in
-  let err = Includecore.type_declarations env id decl1 decl2 in
-  if err <> [] then raise(Error[Type_declarations(id, decl1, decl2, err)])
+  let err = Includecore.type_declarations env (Ident.name id) decl1 id decl2 in
+  if err <> [] then
+    raise(Error[cxt, env, Type_declarations(id, decl1, decl2, err)])
 
 (* Inclusion between exception declarations *)
 
-let exception_declarations env subst id decl1 decl2 =
+let exception_declarations env cxt subst id decl1 decl2 =
+  Env.mark_exception_used Env.Positive decl1 (Ident.name id);
   let decl2 = Subst.exception_declaration subst decl2 in
   if Includecore.exception_declarations env decl1 decl2
   then ()
-  else raise(Error[Exception_declarations(id, decl1, decl2)])
+  else raise(Error[cxt, env, Exception_declarations(id, decl1, decl2)])
 
 (* Inclusion between class declarations *)
 
-let class_type_declarations env subst id decl1 decl2 =
+let class_type_declarations env cxt subst id decl1 decl2 =
   let decl2 = Subst.cltype_declaration subst decl2 in
   match Includeclass.class_type_declarations env decl1 decl2 with
     []     -> ()
-  | reason -> raise(Error[Class_type_declarations(id, decl1, decl2, reason)])
+  | reason ->
+      raise(Error[cxt, env, Class_type_declarations(id, decl1, decl2, reason)])
 
-let class_declarations env subst id decl1 decl2 =
+let class_declarations env cxt subst id decl1 decl2 =
   let decl2 = Subst.class_declaration subst decl2 in
   match Includeclass.class_declarations env decl1 decl2 with
     []     -> ()
-  | reason -> raise(Error[Class_declarations(id, decl1, decl2, reason)])
+  | reason ->
+      raise(Error[cxt, env, Class_declarations(id, decl1, decl2, reason)])
 
 (* Expand a module type identifier when possible *)
 
 exception Dont_match
 
-let expand_module_path env path =
+let expand_module_path env cxt path =
   try
     Env.find_modtype_expansion path env
   with Not_found ->
-    raise(Error[Unbound_modtype_path path])
+    raise(Error[cxt, env, Unbound_modtype_path path])
 
 (* Extract name, kind and ident from a signature item *)
 
@@ -104,13 +112,23 @@
   | Field_classtype of string
 
 let item_ident_name = function
-    Tsig_value(id, _) -> (id, Field_value(Ident.name id))
-  | Tsig_type(id, _, _) -> (id, Field_type(Ident.name id))
-  | Tsig_exception(id, _) -> (id, Field_exception(Ident.name id))
-  | Tsig_module(id, _, _) -> (id, Field_module(Ident.name id))
-  | Tsig_modtype(id, _) -> (id, Field_modtype(Ident.name id))
-  | Tsig_class(id, _, _) -> (id, Field_class(Ident.name id))
-  | Tsig_cltype(id, _, _) -> (id, Field_classtype(Ident.name id))
+    Sig_value(id, _) -> (id, Field_value(Ident.name id))
+  | Sig_type(id, _, _) -> (id, Field_type(Ident.name id))
+  | Sig_exception(id, _) -> (id, Field_exception(Ident.name id))
+  | Sig_module(id, _, _) -> (id, Field_module(Ident.name id))
+  | Sig_modtype(id, _) -> (id, Field_modtype(Ident.name id))
+  | Sig_class(id, _, _) -> (id, Field_class(Ident.name id))
+  | Sig_class_type(id, _, _) -> (id, Field_classtype(Ident.name id))
+
+let is_runtime_component = function
+  | Sig_value(_,{val_kind = Val_prim _})
+  | Sig_type(_,_,_)
+  | Sig_modtype(_,_)
+  | Sig_class_type(_,_,_) -> false
+  | Sig_value(_,_)
+  | Sig_exception(_,_)
+  | Sig_module(_,_,_)
+  | Sig_class(_, _,_) -> true
 
 (* Simplify a structure coercion *)
 
@@ -128,28 +146,29 @@
    Return the restriction that transforms a value of the smaller type
    into a value of the bigger type. *)
 
-let rec modtypes env subst mty1 mty2 =
+let rec modtypes env cxt subst mty1 mty2 =
   try
-    try_modtypes env subst mty1 mty2
+    try_modtypes env cxt subst mty1 mty2
   with
     Dont_match ->
-      raise(Error[Module_types(mty1, Subst.modtype subst mty2)])
+      raise(Error[cxt, env, Module_types(mty1, Subst.modtype subst mty2)])
   | Error reasons ->
-      raise(Error(Module_types(mty1, Subst.modtype subst mty2) :: reasons))
+      raise(Error((cxt, env, Module_types(mty1, Subst.modtype subst mty2))
+                  :: reasons))
 
-and try_modtypes env subst mty1 mty2 =
+and try_modtypes env cxt subst mty1 mty2 =
   match (mty1, mty2) with
-    (_, Tmty_ident p2) ->
-      try_modtypes2 env mty1 (Subst.modtype subst mty2)
-  | (Tmty_ident p1, _) ->
-      try_modtypes env subst (expand_module_path env p1) mty2
-  | (Tmty_signature sig1, Tmty_signature sig2) ->
-      signatures env subst sig1 sig2
-  | (Tmty_functor(param1, arg1, res1), Tmty_functor(param2, arg2, res2)) ->
+    (_, Mty_ident p2) ->
+      try_modtypes2 env cxt mty1 (Subst.modtype subst mty2)
+  | (Mty_ident p1, _) ->
+      try_modtypes env cxt subst (expand_module_path env cxt p1) mty2
+  | (Mty_signature sig1, Mty_signature sig2) ->
+      signatures env cxt subst sig1 sig2
+  | (Mty_functor(param1, arg1, res1), Mty_functor(param2, arg2, res2)) ->
       let arg2' = Subst.modtype subst arg2 in
-      let cc_arg = modtypes env Subst.identity arg2' arg1 in
+      let cc_arg = modtypes env (Arg param1::cxt) Subst.identity arg2' arg1 in
       let cc_res =
-        modtypes (Env.add_module param1 arg2' env)
+        modtypes (Env.add_module param1 arg2' env) (Body param1::cxt)
           (Subst.add_module param2 (Pident param1) subst) res1 res2 in
       begin match (cc_arg, cc_res) with
           (Tcoerce_none, Tcoerce_none) -> Tcoerce_none
@@ -158,42 +177,39 @@
   | (_, _) ->
       raise Dont_match
 
-and try_modtypes2 env mty1 mty2 =
+and try_modtypes2 env cxt mty1 mty2 =
   (* mty2 is an identifier *)
   match (mty1, mty2) with
-    (Tmty_ident p1, Tmty_ident p2) when Path.same p1 p2 ->
+    (Mty_ident p1, Mty_ident p2) when Path.same p1 p2 ->
       Tcoerce_none
-  | (_, Tmty_ident p2) ->
-      try_modtypes env Subst.identity mty1 (expand_module_path env p2)
+  | (_, Mty_ident p2) ->
+      try_modtypes env cxt Subst.identity mty1 (expand_module_path env cxt p2)
   | (_, _) ->
       assert false
 
 (* Inclusion between signatures *)
 
-and signatures env subst sig1 sig2 =
+and signatures env cxt subst sig1 sig2 =
   (* Environment used to check inclusion of components *)
   let new_env =
-    Env.add_signature sig1 env in
+    Env.add_signature sig1 (Env.in_signature env) in
   (* Build a table of the components of sig1, along with their positions.
      The table is indexed by kind and name of component *)
   let rec build_component_table pos tbl = function
-      [] -> tbl
+      [] -> pos, tbl
     | item :: rem ->
         let (id, name) = item_ident_name item in
-        let nextpos =
-          match item with
-            Tsig_value(_,{val_kind = Val_prim _})
-          | Tsig_type(_,_,_)
-          | Tsig_modtype(_,_)
-          | Tsig_cltype(_,_,_) -> pos
-          | Tsig_value(_,_)
-          | Tsig_exception(_,_)
-          | Tsig_module(_,_,_)
-          | Tsig_class(_, _,_) -> pos+1 in
+        let nextpos = if is_runtime_component item then pos + 1 else pos in
         build_component_table nextpos
                               (Tbl.add name (id, item, pos) tbl) rem in
-  let comps1 =
+  let len1, comps1 =
     build_component_table 0 Tbl.empty sig1 in
+  let len2 =
+    List.fold_left
+      (fun n i -> if is_runtime_component i then n + 1 else n)
+      0
+      sig2
+  in
   (* Pair each component of sig2 with a component of sig1,
      identifying the names along the way.
      Return a coercion list indicating, for all run-time components
@@ -202,14 +218,21 @@
   let rec pair_components subst paired unpaired = function
       [] ->
         begin match unpaired with
-            [] -> signature_components new_env subst (List.rev paired)
+            [] ->
+              let cc =
+                signature_components new_env cxt subst (List.rev paired)
+              in
+              if len1 = len2 then (* see PR#5098 *)
+                simplify_structure_coercion cc
+              else
+                Tcoerce_structure cc
           | _  -> raise(Error unpaired)
         end
     | item2 :: rem ->
         let (id2, name2) = item_ident_name item2 in
         let name2, report =
           match item2, name2 with
-            Tsig_type (_, {type_manifest=None}, _), Field_type s
+            Sig_type (_, {type_manifest=None}, _), Field_type s
             when let l = String.length s in
             l >= 4 && String.sub s (l-4) 4 = "#row" ->
               (* Do not report in case of failure,
@@ -221,86 +244,90 @@
           let (id1, item1, pos1) = Tbl.find name2 comps1 in
           let new_subst =
             match item2 with
-              Tsig_type _ ->
+              Sig_type _ ->
                 Subst.add_type id2 (Pident id1) subst
-            | Tsig_module _ ->
+            | Sig_module _ ->
                 Subst.add_module id2 (Pident id1) subst
-            | Tsig_modtype _ ->
-                Subst.add_modtype id2 (Tmty_ident (Pident id1)) subst
-            | Tsig_value _ | Tsig_exception _ | Tsig_class _ | Tsig_cltype _ ->
+            | Sig_modtype _ ->
+                Subst.add_modtype id2 (Mty_ident (Pident id1)) subst
+            | Sig_value _ | Sig_exception _ | Sig_class _ | Sig_class_type _ ->
                 subst
           in
           pair_components new_subst
             ((item1, item2, pos1) :: paired) unpaired rem
         with Not_found ->
           let unpaired =
-            if report then Missing_field id2 :: unpaired else unpaired in
+            if report then (cxt, env, Missing_field id2) :: unpaired
+            else unpaired in
           pair_components subst paired unpaired rem
         end in
   (* Do the pairing and checking, and return the final coercion *)
-  simplify_structure_coercion (pair_components subst [] [] sig2)
+  pair_components subst [] [] sig2
 
 (* Inclusion between signature components *)
 
-and signature_components env subst = function
+and signature_components env cxt subst = function
     [] -> []
-  | (Tsig_value(id1, valdecl1), Tsig_value(id2, valdecl2), pos) :: rem ->
-      let cc = value_descriptions env subst id1 valdecl1 valdecl2 in
+  | (Sig_value(id1, valdecl1), Sig_value(id2, valdecl2), pos) :: rem ->
+      let cc = value_descriptions env cxt subst id1 valdecl1 valdecl2 in
       begin match valdecl2.val_kind with
-        Val_prim p -> signature_components env subst rem
-      | _ -> (pos, cc) :: signature_components env subst rem
+        Val_prim p -> signature_components env cxt subst rem
+      | _ -> (pos, cc) :: signature_components env cxt subst rem
       end
-  | (Tsig_type(id1, tydecl1, _), Tsig_type(id2, tydecl2, _), pos) :: rem ->
-      type_declarations env subst id1 tydecl1 tydecl2;
-      signature_components env subst rem
-  | (Tsig_exception(id1, excdecl1), Tsig_exception(id2, excdecl2), pos)
+  | (Sig_type(id1, tydecl1, _), Sig_type(id2, tydecl2, _), pos) :: rem ->
+      type_declarations env cxt subst id1 tydecl1 tydecl2;
+      signature_components env cxt subst rem
+  | (Sig_exception(id1, excdecl1), Sig_exception(id2, excdecl2), pos)
     :: rem ->
-      exception_declarations env subst id1 excdecl1 excdecl2;
-      (pos, Tcoerce_none) :: signature_components env subst rem
-  | (Tsig_module(id1, mty1, _), Tsig_module(id2, mty2, _), pos) :: rem ->
+      exception_declarations env cxt subst id1 excdecl1 excdecl2;
+      (pos, Tcoerce_none) :: signature_components env cxt subst rem
+  | (Sig_module(id1, mty1, _), Sig_module(id2, mty2, _), pos) :: rem ->
       let cc =
-        modtypes env subst (Mtype.strengthen env mty1 (Pident id1)) mty2 in
-      (pos, cc) :: signature_components env subst rem
-  | (Tsig_modtype(id1, info1), Tsig_modtype(id2, info2), pos) :: rem ->
-      modtype_infos env subst id1 info1 info2;
-      signature_components env subst rem
-  | (Tsig_class(id1, decl1, _), Tsig_class(id2, decl2, _), pos) :: rem ->
-      class_declarations env subst id1 decl1 decl2;
-      (pos, Tcoerce_none) :: signature_components env subst rem
-  | (Tsig_cltype(id1, info1, _), Tsig_cltype(id2, info2, _), pos) :: rem ->
-      class_type_declarations env subst id1 info1 info2;
-      signature_components env subst rem
+        modtypes env (Module id1::cxt) subst
+          (Mtype.strengthen env mty1 (Pident id1)) mty2 in
+      (pos, cc) :: signature_components env cxt subst rem
+  | (Sig_modtype(id1, info1), Sig_modtype(id2, info2), pos) :: rem ->
+      modtype_infos env cxt subst id1 info1 info2;
+      signature_components env cxt subst rem
+  | (Sig_class(id1, decl1, _), Sig_class(id2, decl2, _), pos) :: rem ->
+      class_declarations env cxt subst id1 decl1 decl2;
+      (pos, Tcoerce_none) :: signature_components env cxt subst rem
+  | (Sig_class_type(id1, info1, _),
+     Sig_class_type(id2, info2, _), pos) :: rem ->
+      class_type_declarations env cxt subst id1 info1 info2;
+      signature_components env cxt subst rem
   | _ ->
       assert false
 
 (* Inclusion between module type specifications *)
 
-and modtype_infos env subst id info1 info2 =
+and modtype_infos env cxt subst id info1 info2 =
   let info2 = Subst.modtype_declaration subst info2 in
+  let cxt' = Modtype id :: cxt in
   try
     match (info1, info2) with
-      (Tmodtype_abstract, Tmodtype_abstract) -> ()
-    | (Tmodtype_manifest mty1, Tmodtype_abstract) -> ()
-    | (Tmodtype_manifest mty1, Tmodtype_manifest mty2) ->
-        check_modtype_equiv env mty1 mty2
-    | (Tmodtype_abstract, Tmodtype_manifest mty2) ->
-        check_modtype_equiv env (Tmty_ident(Pident id)) mty2
+      (Modtype_abstract, Modtype_abstract) -> ()
+    | (Modtype_manifest mty1, Modtype_abstract) -> ()
+    | (Modtype_manifest mty1, Modtype_manifest mty2) ->
+        check_modtype_equiv env cxt' mty1 mty2
+    | (Modtype_abstract, Modtype_manifest mty2) ->
+        check_modtype_equiv env cxt' (Mty_ident(Pident id)) mty2
   with Error reasons ->
-    raise(Error(Modtype_infos(id, info1, info2) :: reasons))
+    raise(Error((cxt, env, Modtype_infos(id, info1, info2)) :: reasons))
 
-and check_modtype_equiv env mty1 mty2 =
+and check_modtype_equiv env cxt mty1 mty2 =
   match
-    (modtypes env Subst.identity mty1 mty2,
-     modtypes env Subst.identity mty2 mty1)
+    (modtypes env cxt Subst.identity mty1 mty2,
+     modtypes env cxt Subst.identity mty2 mty1)
   with
     (Tcoerce_none, Tcoerce_none) -> ()
-  | (_, _) -> raise(Error [Modtype_permutation])
+  | (_, _) -> raise(Error [cxt, env, Modtype_permutation])
 
 (* Simplified inclusion check between module types (for Env) *)
 
 let check_modtype_inclusion env mty1 path1 mty2 =
   try
-    ignore(modtypes env Subst.identity
+    ignore(modtypes env [] Subst.identity
                     (Mtype.strengthen env mty1 path1) mty2)
   with Error reasons ->
     raise Not_found
@@ -312,44 +339,56 @@
 
 let compunit impl_name impl_sig intf_name intf_sig =
   try
-    signatures Env.initial Subst.identity impl_sig intf_sig
+    signatures Env.initial [] Subst.identity impl_sig intf_sig
   with Error reasons ->
-    raise(Error(Interface_mismatch(impl_name, intf_name) :: reasons))
+    raise(Error(([], Env.empty,Interface_mismatch(impl_name, intf_name))
+                :: reasons))
 
-(* Hide the substitution parameter to the outside world *)
+(* Hide the context and substitution parameters to the outside world *)
 
-let modtypes env mty1 mty2 = modtypes env Subst.identity mty1 mty2
-let signatures env sig1 sig2 = signatures env Subst.identity sig1 sig2
+let modtypes env mty1 mty2 = modtypes env [] Subst.identity mty1 mty2
+let signatures env sig1 sig2 = signatures env [] Subst.identity sig1 sig2
 let type_declarations env id decl1 decl2 =
-  type_declarations env Subst.identity id decl1 decl2
+  type_declarations env [] Subst.identity id decl1 decl2
 
 (* Error report *)
 
 open Format
 open Printtyp
 
+let show_loc msg ppf loc =
+  let pos = loc.Location.loc_start in
+  if List.mem pos.Lexing.pos_fname [""; "_none_"; "//toplevel//"] then ()
+  else fprintf ppf "@\n@[<2>%a:@ %s@]" Location.print_loc loc msg
+
+let show_locs ppf (loc1, loc2) =
+  show_loc "Expected declaration" ppf loc2;
+  show_loc "Actual declaration" ppf loc1
+
 let include_err ppf = function
   | Missing_field id ->
       fprintf ppf "The field `%a' is required but not provided" ident id
   | Value_descriptions(id, d1, d2) ->
       fprintf ppf
-       "@[Values do not match:@ \
-        %a@;<1 -2>is not included in@ %a@]"
-       (value_description id) d1 (value_description id) d2
+        "@[Values do not match:@ %a@;<1 -2>is not included in@ %a@]"
+        (value_description id) d1 (value_description id) d2;
+      show_locs ppf (d1.val_loc, d2.val_loc);
   | Type_declarations(id, d1, d2, errs) ->
-      fprintf ppf "@[@[%s:@;<1 2>%a@ %s@;<1 2>%a@]%a@]"
+      fprintf ppf "@[@[%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a@]"
         "Type declarations do not match"
         (type_declaration id) d1
         "is not included in"
         (type_declaration id) d2
+        show_locs (d1.type_loc, d2.type_loc)
         (Includecore.report_type_mismatch
            "the first" "the second" "declaration") errs
   | Exception_declarations(id, d1, d2) ->
       fprintf ppf
        "@[Exception declarations do not match:@ \
         %a@;<1 -2>is not included in@ %a@]"
-      (exception_declaration id) d1
-      (exception_declaration id) d2
+        (exception_declaration id) d1
+        (exception_declaration id) d2;
+      show_locs ppf (d1.exn_loc, d2.exn_loc)
   | Module_types(mty1, mty2)->
       fprintf ppf
        "@[Modules do not match:@ \
@@ -384,9 +423,66 @@
   | Unbound_modtype_path path ->
       fprintf ppf "Unbound module type %a" Printtyp.path path
 
-let report_error ppf = function
-  |  [] -> ()
-  | err :: errs ->
-      let print_errs ppf errs =
-         List.iter (fun err -> fprintf ppf "@ %a" include_err err) errs in
-      fprintf ppf "@[%a%a@]" include_err err print_errs errs
+let rec context ppf = function
+    Module id :: rem ->
+      fprintf ppf "@[<2>module %a%a@]" ident id args rem
+  | Modtype id :: rem ->
+      fprintf ppf "@[<2>module type %a =@ %a@]" ident id context_mty rem
+  | Body x :: rem ->
+      fprintf ppf "functor (%a) ->@ %a" ident x context_mty rem
+  | Arg x :: rem ->
+      fprintf ppf "functor (%a : %a) -> ..." ident x context_mty rem
+  | [] ->
+      fprintf ppf ""
+and context_mty ppf = function
+    (Module _ | Modtype _) :: _ as rem ->
+      fprintf ppf "@[<2>sig@ %a@;<1 -2>end@]" context rem
+  | cxt -> context ppf cxt
+and args ppf = function
+    Body x :: rem ->
+      fprintf ppf "(%a)%a" ident x args rem
+  | Arg x :: rem ->
+      fprintf ppf "(%a :@ %a) : ..." ident x context_mty rem
+  | cxt ->
+      fprintf ppf " :@ %a" context_mty cxt
+
+let path_of_context = function
+    Module id :: rem ->
+      let rec subm path = function
+          [] -> path
+        | Module id :: rem -> subm (Pdot (path, Ident.name id, -1)) rem
+        | _ -> assert false
+      in subm (Pident id) rem
+  | _ -> assert false
+
+let context ppf cxt =
+  if cxt = [] then () else
+  if List.for_all (function Module _ -> true | _ -> false) cxt then
+    fprintf ppf "In module %a:@ " path (path_of_context cxt)
+  else
+    fprintf ppf "@[At position@ %a@]@ " context cxt
+
+let include_err ppf (cxt, env, err) =
+  Printtyp.wrap_printing_env env (fun () ->
+    fprintf ppf "@[%a%a@]" context (List.rev cxt) include_err err)
+
+let buffer = ref ""
+let is_big obj =
+  let size = !Clflags.error_size in
+  size > 0 &&
+  begin
+    if String.length !buffer < size then buffer := String.create size;
+    try ignore (Marshal.to_buffer !buffer 0 size obj []); false
+    with _ -> true
+  end
+
+let report_error ppf errs =
+  if errs = [] then () else
+  let (errs , err) = split_last errs in
+  let pe = ref true in
+  let include_err' ppf (_,_,obj as err) =
+    if not (is_big obj) then fprintf ppf "%a@ " include_err err
+    else if !pe then (fprintf ppf "...@ "; pe := false)
+  in
+  let print_errs ppf = List.iter (include_err' ppf) in
+  fprintf ppf "@[%a%a@]" print_errs errs include_err err
diff -Nru ocaml-3.12.1/typing/includemod.mli ocaml-4.01.0/typing/includemod.mli
--- ocaml-3.12.1/typing/includemod.mli	2010-05-21 03:36:52.000000000 +0000
+++ ocaml-4.01.0/typing/includemod.mli	2013-02-09 08:42:11.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,12 +10,10 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: includemod.mli 10447 2010-05-21 03:36:52Z garrigue $ *)
-
 (* Inclusion checks for the module language *)
 
-open Types
 open Typedtree
+open Types
 open Format
 
 val modtypes: Env.t -> module_type -> module_type -> module_coercion
@@ -24,7 +22,7 @@
 val type_declarations:
       Env.t -> Ident.t -> type_declaration -> type_declaration -> unit
 
-type error =
+type symptom =
     Missing_field of Ident.t
   | Value_descriptions of Ident.t * value_description * value_description
   | Type_declarations of Ident.t * type_declaration
@@ -36,13 +34,17 @@
   | Modtype_permutation
   | Interface_mismatch of string * string
   | Class_type_declarations of
-      Ident.t * cltype_declaration * cltype_declaration *
+      Ident.t * class_type_declaration * class_type_declaration *
       Ctype.class_match_failure list
   | Class_declarations of
       Ident.t * class_declaration * class_declaration *
       Ctype.class_match_failure list
   | Unbound_modtype_path of Path.t
 
+type pos =
+    Module of Ident.t | Modtype of Ident.t | Arg of Ident.t | Body of Ident.t
+type error = pos list * Env.t * symptom
+
 exception Error of error list
 
 val report_error: formatter -> error list -> unit
diff -Nru ocaml-3.12.1/typing/mtype.ml ocaml-4.01.0/typing/mtype.ml
--- ocaml-3.12.1/typing/mtype.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/typing/mtype.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: mtype.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* Operations on module types *)
 
 open Asttypes
@@ -21,7 +19,7 @@
 
 let rec scrape env mty =
   match mty with
-    Tmty_ident p ->
+    Mty_ident p ->
       begin try
         scrape env (Env.find_modtype_expansion p env)
       with Not_found ->
@@ -34,22 +32,23 @@
 
 let rec strengthen env mty p =
   match scrape env mty with
-    Tmty_signature sg ->
-      Tmty_signature(strengthen_sig env sg p)
-  | Tmty_functor(param, arg, res) when !Clflags.applicative_functors ->
-      Tmty_functor(param, arg, strengthen env res (Papply(p, Pident param)))
+    Mty_signature sg ->
+      Mty_signature(strengthen_sig env sg p)
+  | Mty_functor(param, arg, res) when !Clflags.applicative_functors ->
+      Mty_functor(param, arg, strengthen env res (Papply(p, Pident param)))
   | mty ->
       mty
 
 and strengthen_sig env sg p =
   match sg with
     [] -> []
-  | (Tsig_value(id, desc) as sigelt) :: rem ->
+  | (Sig_value(id, desc) as sigelt) :: rem ->
       sigelt :: strengthen_sig env rem p
-  | Tsig_type(id, decl, rs) :: rem ->
+  | Sig_type(id, decl, rs) :: rem ->
       let newdecl =
-        match decl.type_manifest with
-          Some ty when decl.type_private = Public -> decl
+        match decl.type_manifest, decl.type_private, decl.type_kind with
+          Some _, Public, _ -> decl
+        | Some _, Private, (Type_record _ | Type_variant _) -> decl
         | _ ->
             let manif =
               Some(Btype.newgenty(Tconstr(Pdot(p, Ident.name id, nopos),
@@ -59,26 +58,26 @@
             else
               { decl with type_manifest = manif }
       in
-      Tsig_type(id, newdecl, rs) :: strengthen_sig env rem p
-  | (Tsig_exception(id, d) as sigelt) :: rem ->
+      Sig_type(id, newdecl, rs) :: strengthen_sig env rem p
+  | (Sig_exception(id, d) as sigelt) :: rem ->
       sigelt :: strengthen_sig env rem p
-  | Tsig_module(id, mty, rs) :: rem ->
-      Tsig_module(id, strengthen env mty (Pdot(p, Ident.name id, nopos)), rs)
+  | Sig_module(id, mty, rs) :: rem ->
+      Sig_module(id, strengthen env mty (Pdot(p, Ident.name id, nopos)), rs)
       :: strengthen_sig (Env.add_module id mty env) rem p
       (* Need to add the module in case it defines manifest module types *)
-  | Tsig_modtype(id, decl) :: rem ->
+  | Sig_modtype(id, decl) :: rem ->
       let newdecl =
         match decl with
-          Tmodtype_abstract ->
-            Tmodtype_manifest(Tmty_ident(Pdot(p, Ident.name id, nopos)))
-        | Tmodtype_manifest _ ->
+          Modtype_abstract ->
+            Modtype_manifest(Mty_ident(Pdot(p, Ident.name id, nopos)))
+        | Modtype_manifest _ ->
             decl in
-      Tsig_modtype(id, newdecl) ::
+      Sig_modtype(id, newdecl) ::
       strengthen_sig (Env.add_modtype id decl env) rem p
       (* Need to add the module type in case it is manifest *)
-  | (Tsig_class(id, decl, rs) as sigelt) :: rem ->
+  | (Sig_class(id, decl, rs) as sigelt) :: rem ->
       sigelt :: strengthen_sig env rem p
-  | (Tsig_cltype(id, decl, rs) as sigelt) :: rem ->
+  | (Sig_class_type(id, decl, rs) as sigelt) :: rem ->
       sigelt :: strengthen_sig env rem p
 
 (* In nondep_supertype, env is only used for the type it assigns to id.
@@ -91,16 +90,16 @@
 
   let rec nondep_mty env va mty =
     match mty with
-      Tmty_ident p ->
+      Mty_ident p ->
         if Path.isfree mid p then
           nondep_mty env va (Env.find_modtype_expansion p env)
         else mty
-    | Tmty_signature sg ->
-        Tmty_signature(nondep_sig env va sg)
-    | Tmty_functor(param, arg, res) ->
+    | Mty_signature sg ->
+        Mty_signature(nondep_sig env va sg)
+    | Mty_functor(param, arg, res) ->
         let var_inv =
           match va with Co -> Contra | Contra -> Co | Strict -> Strict in
-        Tmty_functor(param, nondep_mty env var_inv arg,
+        Mty_functor(param, nondep_mty env var_inv arg,
                      nondep_mty (Env.add_module param arg env) va res)
 
   and nondep_sig env va = function
@@ -108,34 +107,38 @@
   | item :: rem ->
       let rem' = nondep_sig env va rem in
       match item with
-        Tsig_value(id, d) ->
-          Tsig_value(id, {val_type = Ctype.nondep_type env mid d.val_type;
-                          val_kind = d.val_kind}) :: rem'
-      | Tsig_type(id, d, rs) ->
-          Tsig_type(id, Ctype.nondep_type_decl env mid id (va = Co) d, rs)
+        Sig_value(id, d) ->
+          Sig_value(id, {val_type = Ctype.nondep_type env mid d.val_type;
+                          val_kind = d.val_kind;
+                          val_loc = d.val_loc;
+                        }) :: rem'
+      | Sig_type(id, d, rs) ->
+          Sig_type(id, Ctype.nondep_type_decl env mid id (va = Co) d, rs)
           :: rem'
-      | Tsig_exception(id, d) ->
-          Tsig_exception(id, List.map (Ctype.nondep_type env mid) d) :: rem'
-      | Tsig_module(id, mty, rs) ->
-          Tsig_module(id, nondep_mty env va mty, rs) :: rem'
-      | Tsig_modtype(id, d) ->
+      | Sig_exception(id, d) ->
+          let d = {exn_args = List.map (Ctype.nondep_type env mid) d.exn_args;
+                   exn_loc = d.exn_loc} in
+          Sig_exception(id, d) :: rem'
+      | Sig_module(id, mty, rs) ->
+          Sig_module(id, nondep_mty env va mty, rs) :: rem'
+      | Sig_modtype(id, d) ->
           begin try
-            Tsig_modtype(id, nondep_modtype_decl env d) :: rem'
+            Sig_modtype(id, nondep_modtype_decl env d) :: rem'
           with Not_found ->
             match va with
-              Co -> Tsig_modtype(id, Tmodtype_abstract) :: rem'
+              Co -> Sig_modtype(id, Modtype_abstract) :: rem'
             | _  -> raise Not_found
           end
-      | Tsig_class(id, d, rs) ->
-          Tsig_class(id, Ctype.nondep_class_declaration env mid d, rs)
+      | Sig_class(id, d, rs) ->
+          Sig_class(id, Ctype.nondep_class_declaration env mid d, rs)
           :: rem'
-      | Tsig_cltype(id, d, rs) ->
-          Tsig_cltype(id, Ctype.nondep_cltype_declaration env mid d, rs)
+      | Sig_class_type(id, d, rs) ->
+          Sig_class_type(id, Ctype.nondep_cltype_declaration env mid d, rs)
           :: rem'
 
   and nondep_modtype_decl env = function
-      Tmodtype_abstract -> Tmodtype_abstract
-    | Tmodtype_manifest mty -> Tmodtype_manifest(nondep_mty env Strict mty)
+      Modtype_abstract -> Modtype_abstract
+    | Modtype_manifest mty -> Modtype_manifest(nondep_mty env Strict mty)
 
   in
     nondep_mty env Co mty
@@ -155,62 +158,62 @@
 
 let rec enrich_modtype env p mty =
   match mty with
-    Tmty_signature sg ->
-      Tmty_signature(List.map (enrich_item env p) sg)
+    Mty_signature sg ->
+      Mty_signature(List.map (enrich_item env p) sg)
   | _ ->
       mty
 
 and enrich_item env p = function
-    Tsig_type(id, decl, rs) ->
-      Tsig_type(id,
+    Sig_type(id, decl, rs) ->
+      Sig_type(id,
                 enrich_typedecl env (Pdot(p, Ident.name id, nopos)) decl, rs)
-  | Tsig_module(id, mty, rs) ->
-      Tsig_module(id,
+  | Sig_module(id, mty, rs) ->
+      Sig_module(id,
                   enrich_modtype env (Pdot(p, Ident.name id, nopos)) mty, rs)
   | item -> item
 
 let rec type_paths env p mty =
   match scrape env mty with
-    Tmty_ident p -> []
-  | Tmty_signature sg -> type_paths_sig env p 0 sg
-  | Tmty_functor(param, arg, res) -> []
+    Mty_ident p -> []
+  | Mty_signature sg -> type_paths_sig env p 0 sg
+  | Mty_functor(param, arg, res) -> []
 
 and type_paths_sig env p pos sg =
   match sg with
     [] -> []
-  | Tsig_value(id, decl) :: rem ->
+  | Sig_value(id, decl) :: rem ->
       let pos' = match decl.val_kind with Val_prim _ -> pos | _ -> pos + 1 in
       type_paths_sig env p pos' rem
-  | Tsig_type(id, decl, _) :: rem ->
+  | Sig_type(id, decl, _) :: rem ->
       Pdot(p, Ident.name id, nopos) :: type_paths_sig env p pos rem
-  | Tsig_module(id, mty, _) :: rem ->
+  | Sig_module(id, mty, _) :: rem ->
       type_paths env (Pdot(p, Ident.name id, pos)) mty @
       type_paths_sig (Env.add_module id mty env) p (pos+1) rem
-  | Tsig_modtype(id, decl) :: rem ->
+  | Sig_modtype(id, decl) :: rem ->
       type_paths_sig (Env.add_modtype id decl env) p pos rem
-  | (Tsig_exception _ | Tsig_class _) :: rem ->
+  | (Sig_exception _ | Sig_class _) :: rem ->
       type_paths_sig env p (pos+1) rem
-  | (Tsig_cltype _) :: rem ->
+  | (Sig_class_type _) :: rem ->
       type_paths_sig env p pos rem
 
 let rec no_code_needed env mty =
   match scrape env mty with
-    Tmty_ident p -> false
-  | Tmty_signature sg -> no_code_needed_sig env sg
-  | Tmty_functor(_, _, _) -> false
+    Mty_ident p -> false
+  | Mty_signature sg -> no_code_needed_sig env sg
+  | Mty_functor(_, _, _) -> false
 
 and no_code_needed_sig env sg =
   match sg with
     [] -> true
-  | Tsig_value(id, decl) :: rem ->
+  | Sig_value(id, decl) :: rem ->
       begin match decl.val_kind with
       | Val_prim _ -> no_code_needed_sig env rem
       | _ -> false
       end
-  | Tsig_module(id, mty, _) :: rem ->
+  | Sig_module(id, mty, _) :: rem ->
       no_code_needed env mty &&
       no_code_needed_sig (Env.add_module id mty env) rem
-  | (Tsig_type _ | Tsig_modtype _ | Tsig_cltype _) :: rem ->
+  | (Sig_type _ | Sig_modtype _ | Sig_class_type _) :: rem ->
       no_code_needed_sig env rem
-  | (Tsig_exception _ | Tsig_class _) :: rem ->
+  | (Sig_exception _ | Sig_class _) :: rem ->
       false
diff -Nru ocaml-3.12.1/typing/mtype.mli ocaml-4.01.0/typing/mtype.mli
--- ocaml-3.12.1/typing/mtype.mli	2004-04-09 13:32:28.000000000 +0000
+++ ocaml-4.01.0/typing/mtype.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: mtype.mli 6196 2004-04-09 13:32:28Z xleroy $ *)
-
 (* Operations on module types *)
 
 open Types
diff -Nru ocaml-3.12.1/typing/oprint.ml ocaml-4.01.0/typing/oprint.ml
--- ocaml-3.12.1/typing/oprint.ml	2011-05-18 15:01:07.000000000 +0000
+++ ocaml-4.01.0/typing/oprint.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*                  Projet Cristal, INRIA Rocquencourt                 *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: oprint.ml 11051 2011-05-18 15:01:07Z xclerc $ *)
-
 open Format
 open Outcometree
 
@@ -23,8 +21,9 @@
 
 let rec print_ident ppf =
   function
-    Oide_ident s -> fprintf ppf "%s" s
-  | Oide_dot (id, s) -> fprintf ppf "%a.%s" print_ident id s
+    Oide_ident s -> pp_print_string ppf s
+  | Oide_dot (id, s) ->
+      print_ident ppf id; pp_print_char ppf '.'; pp_print_string ppf s
   | Oide_apply (id1, id2) ->
       fprintf ppf "%a(%a)" print_ident id1 print_ident id2
 
@@ -40,7 +39,7 @@
   if parenthesized_ident name then
     fprintf ppf "( %s )" name
   else
-    fprintf ppf "%s" name
+    pp_print_string ppf name
 
 (* Values *)
 
@@ -96,7 +95,7 @@
     | Oval_int32 i -> fprintf ppf "%lil" i
     | Oval_int64 i -> fprintf ppf "%LiL" i
     | Oval_nativeint i -> fprintf ppf "%nin" i
-    | Oval_float f -> fprintf ppf "%s" (float_repres f)
+    | Oval_float f -> pp_print_string ppf (float_repres f)
     | Oval_char c -> fprintf ppf "%C" c
     | Oval_string s ->
         begin try fprintf ppf "%S" s with
@@ -108,7 +107,7 @@
         fprintf ppf "@[<2>[|%a|]@]" (print_tree_list print_tree_1 ";") tl
     | Oval_constr (name, []) -> print_ident ppf name
     | Oval_variant (name, None) -> fprintf ppf "`%s" name
-    | Oval_stuff s -> fprintf ppf "%s" s
+    | Oval_stuff s -> pp_print_string ppf s
     | Oval_record fel ->
         fprintf ppf "@[<1>{%a}@]" (cautious (print_fields true)) fel
     | Oval_ellipsis -> raise Ellipsis
@@ -172,8 +171,13 @@
 and print_out_type_1 ppf =
   function
     Otyp_arrow (lab, ty1, ty2) ->
-      fprintf ppf "@[%s%a ->@ %a@]" (if lab <> "" then lab ^ ":" else "")
-        print_out_type_2 ty1 print_out_type_1 ty2
+      pp_open_box ppf 0;
+      if lab <> "" then (pp_print_string ppf lab; pp_print_char ppf ':');
+      print_out_type_2 ppf ty1;
+      pp_print_string ppf " ->";
+      pp_print_space ppf ();
+      print_out_type_1 ppf ty2;
+      pp_close_box ppf ()
   | ty -> print_out_type_2 ppf ty
 and print_out_type_2 ppf =
   function
@@ -186,10 +190,13 @@
       fprintf ppf "@[%a%s#%a@]" print_typargs tyl (if ng then "_" else "")
         print_ident id
   | Otyp_constr (id, tyl) ->
-      fprintf ppf "@[%a%a@]" print_typargs tyl print_ident id
+      pp_open_box ppf 0;
+      print_typargs ppf tyl;
+      print_ident ppf id;
+      pp_close_box ppf ()
   | Otyp_object (fields, rest) ->
       fprintf ppf "@[<2>< %a >@]" (print_fields rest) fields
-  | Otyp_stuff s -> fprintf ppf "%s" s
+  | Otyp_stuff s -> pp_print_string ppf s
   | Otyp_var (ng, s) -> fprintf ppf "'%s%s" (if ng then "_" else "") s
   | Otyp_variant (non_gen, row_fields, closed, tags) ->
       let print_present ppf =
@@ -211,7 +218,11 @@
         print_fields row_fields
         print_present tags
   | Otyp_alias _ | Otyp_poly _ | Otyp_arrow _ | Otyp_tuple _ as ty ->
-      fprintf ppf "@[<1>(%a)@]" print_out_type ty
+      pp_open_box ppf 1;
+      pp_print_char ppf '(';
+      print_out_type ppf ty;
+      pp_print_char ppf ')';
+      pp_close_box ppf ()
   | Otyp_abstract | Otyp_sum _ | Otyp_record _ | Otyp_manifest (_, _) -> ()
   | Otyp_module (p, n, tyl) ->
       fprintf ppf "@[<1>(module %s" p;
@@ -252,22 +263,30 @@
     [] -> ()
   | [ty] -> print_elem ppf ty
   | ty :: tyl ->
-      fprintf ppf "%a%s@ %a" print_elem ty sep (print_typlist print_elem sep)
-        tyl
+      print_elem ppf ty;
+      pp_print_string ppf sep;
+      pp_print_space ppf ();
+      print_typlist print_elem sep ppf tyl
 and print_typargs ppf =
   function
     [] -> ()
-  | [ty1] -> fprintf ppf "%a@ " print_simple_out_type ty1
-  | tyl -> fprintf ppf "@[<1>(%a)@]@ " (print_typlist print_out_type ",") tyl
+  | [ty1] -> print_simple_out_type ppf ty1; pp_print_space ppf ()
+  | tyl ->
+      pp_open_box ppf 1;
+      pp_print_char ppf '(';
+      print_typlist print_out_type "," ppf tyl;
+      pp_print_char ppf ')';
+      pp_close_box ppf ();
+      pp_print_space ppf ()
 
 let out_type = ref print_out_type
 
 (* Class types *)
 
 let type_parameter ppf (ty, (co, cn)) =
-  fprintf ppf "%s'%s" (if not cn then "+" else if not co then "-" else "")
-    (*if co then if cn then "!" else "+" else if cn then "-" else "?"*)
-    ty
+  fprintf ppf "%s%s"
+    (if not cn then "+" else if not co then "-" else "")
+    (if ty = "_" then ty else "'"^ty)
 
 let print_out_class_params ppf =
   function
@@ -350,7 +369,7 @@
         (if vir_flag then " virtual" else "") print_out_class_params params
         name !out_class_type clt
   | Osig_exception (id, tyl) ->
-      fprintf ppf "@[<2>exception %a@]" print_out_constr (id, tyl)
+      fprintf ppf "@[<2>exception %a@]" print_out_constr (id, tyl,None)
   | Osig_modtype (name, Omty_abstract) ->
       fprintf ppf "@[<2>module type %s@]" name
   | Osig_modtype (name, mty) ->
@@ -387,7 +406,7 @@
   in
   let type_defined ppf =
     match args with
-      [] -> fprintf ppf "%s" name
+      [] -> pp_print_string ppf name
     | [arg] -> fprintf ppf "@[%a@ %s@]" type_parameter arg name
     | _ ->
         fprintf ppf "@[(@[%a)@]@ %s@]"
@@ -409,7 +428,7 @@
   let print_private ppf = function
     Asttypes.Private -> fprintf ppf " private"
   | Asttypes.Public -> () in
-  let rec print_out_tkind ppf = function
+  let print_out_tkind ppf = function
   | Otyp_abstract -> ()
   | Otyp_record lbls ->
       fprintf ppf " =%a {%a@;<1 -2>}"
@@ -428,12 +447,27 @@
     print_name_args
     print_out_tkind ty
     print_constraints constraints
-and print_out_constr ppf (name, tyl) =
-  match tyl with
-    [] -> fprintf ppf "%s" name
-  | _ ->
-      fprintf ppf "@[<2>%s of@ %a@]" name
-        (print_typlist print_simple_out_type " *") tyl
+and print_out_constr ppf (name, tyl,ret_type_opt) =
+  match ret_type_opt with
+  | None ->
+      begin match tyl with
+      | [] ->
+          pp_print_string ppf name
+      | _ ->
+          fprintf ppf "@[<2>%s of@ %a@]" name
+            (print_typlist print_simple_out_type " *") tyl
+      end
+  | Some ret_type ->
+      begin match tyl with
+      | [] ->
+          fprintf ppf "@[<2>%s :@ %a@]" name print_simple_out_type  ret_type
+      | _ ->
+          fprintf ppf "@[<2>%s :@ %a -> %a@]" name
+            (print_typlist print_simple_out_type " *")
+            tyl print_simple_out_type ret_type
+      end
+
+
 and print_out_label ppf (name, mut, arg) =
   fprintf ppf "@[<2>%s%s :@ %a@];" (if mut then "mutable " else "") name
     !out_type arg
diff -Nru ocaml-3.12.1/typing/oprint.mli ocaml-4.01.0/typing/oprint.mli
--- ocaml-3.12.1/typing/oprint.mli	2010-05-31 13:18:11.000000000 +0000
+++ ocaml-4.01.0/typing/oprint.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*                  Projet Cristal, INRIA Rocquencourt                 *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: oprint.mli 10486 2010-05-31 13:18:11Z xclerc $ *)
-
 open Format
 open Outcometree
 
diff -Nru ocaml-3.12.1/typing/outcometree.mli ocaml-4.01.0/typing/outcometree.mli
--- ocaml-3.12.1/typing/outcometree.mli	2009-10-26 10:53:16.000000000 +0000
+++ ocaml-4.01.0/typing/outcometree.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*     Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt        *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: outcometree.mli 9397 2009-10-26 10:53:16Z frisch $ *)
-
 (* Module [Outcometree]: results displayed by the toplevel *)
 
 (* These types represent messages that the toplevel displays as normal
@@ -54,7 +52,7 @@
   | Otyp_object of (string * out_type) list * bool option
   | Otyp_record of (string * bool * out_type) list
   | Otyp_stuff of string
-  | Otyp_sum of (string * out_type list) list
+  | Otyp_sum of (string * out_type list * out_type option) list
   | Otyp_tuple of out_type list
   | Otyp_var of bool * string
   | Otyp_variant of
diff -Nru ocaml-3.12.1/typing/parmatch.ml ocaml-4.01.0/typing/parmatch.ml
--- ocaml-3.12.1/typing/parmatch.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/typing/parmatch.ml	2013-04-25 13:32:17.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: parmatch.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 (* Detection of partial matches and unused match cases. *)
 
 open Misc
@@ -24,13 +22,15 @@
 (*************************************)
 
 let make_pat desc ty tenv =
-  {pat_desc = desc; pat_loc = Location.none;
+  {pat_desc = desc; pat_loc = Location.none; pat_extra = [];
    pat_type = ty ; pat_env = tenv }
 
 let omega = make_pat Tpat_any Ctype.none Env.empty
 
 let extra_pat =
-  make_pat (Tpat_var (Ident.create "+")) Ctype.none Env.empty
+  make_pat
+    (Tpat_var (Ident.create "+", mknoloc "+"))
+    Ctype.none Env.empty
 
 let rec omegas i =
   if i <= 0 then [] else omega :: omegas (i-1)
@@ -51,19 +51,19 @@
 | Tpat_variant (tag, _, row) -> is_absent tag row
 | _ -> false
 
-let sort_fields args =
-  Sort.list
-    (fun (lbl1,_) (lbl2,_) -> lbl1.lbl_pos <= lbl2.lbl_pos)
-    args
+let const_compare x y =
+  match x,y with
+  | Const_float f1, Const_float f2 ->
+      Pervasives.compare (float_of_string f1) (float_of_string f2)
+  | _, _ -> Pervasives.compare x y
 
 let records_args l1 l2 =
-  let l1 = sort_fields l1
-  and l2 = sort_fields l2 in
+  (* Invariant: fields are already sorted by Typecore.type_label_a_list *)
   let rec combine r1 r2 l1 l2 = match l1,l2 with
-  | [],[] -> r1,r2
-  | [],(_,p2)::rem2 -> combine (omega::r1) (p2::r2) [] rem2
-  | (_,p1)::rem1,[] -> combine (p1::r1) (omega::r2) rem1 []
-  | (lbl1,p1)::rem1, (lbl2,p2)::rem2 ->
+  | [],[] -> List.rev r1, List.rev r2
+  | [],(_,_,p2)::rem2 -> combine (omega::r1) (p2::r2) [] rem2
+  | (_,_,p1)::rem1,[] -> combine (p1::r1) (omega::r2) rem1 []
+  | (_,lbl1,p1)::rem1, ( _,lbl2,p2)::rem2 ->
       if lbl1.lbl_pos < lbl2.lbl_pos then
         combine (p1::r1) (omega::r2) rem1 l2
       else if lbl1.lbl_pos > lbl2.lbl_pos then
@@ -75,16 +75,16 @@
 
 let rec compat p q =
   match p.pat_desc,q.pat_desc with
-  | Tpat_alias (p,_),_      -> compat p q
-  | _,Tpat_alias (q,_)      -> compat p q
+  | Tpat_alias (p,_,_),_      -> compat p q
+  | _,Tpat_alias (q,_,_)      -> compat p q
   | (Tpat_any|Tpat_var _),_ -> true
   | _,(Tpat_any|Tpat_var _) -> true
   | Tpat_or (p1,p2,_),_     -> compat p1 q || compat p2 q
   | _,Tpat_or (q1,q2,_)     -> compat p q1 || compat p q2
-  | Tpat_constant c1, Tpat_constant c2 -> c1=c2
+  | Tpat_constant c1, Tpat_constant c2 -> const_compare c1 c2 = 0
   | Tpat_tuple ps, Tpat_tuple qs -> compats ps qs
   | Tpat_lazy p, Tpat_lazy q -> compat p q
-  | Tpat_construct (c1,ps1), Tpat_construct (c2,ps2) ->
+  | Tpat_construct (_, c1,ps1, _), Tpat_construct (_, c2,ps2, _) ->
       c1.cstr_tag = c2.cstr_tag && compats ps1 ps2
   | Tpat_variant(l1,Some p1, r1), Tpat_variant(l2,Some p2,_) ->
       l1=l2 && compat p1 p2
@@ -92,7 +92,7 @@
       l1 = l2
   | Tpat_variant (_, None, _), Tpat_variant (_,Some _, _) -> false
   | Tpat_variant (_, Some _, _), Tpat_variant (_, None, _) -> false
-  | Tpat_record l1,Tpat_record l2 ->
+  | Tpat_record (l1,_),Tpat_record (l2,_) ->
       let ps,qs = records_args l1 l2 in
       compats ps qs
   | Tpat_array ps, Tpat_array qs ->
@@ -124,7 +124,7 @@
   | Tconstr (path,_,_) -> path
   | _ -> fatal_error "Parmatch.get_type_path"
 
-let rec get_type_descr ty tenv =
+let get_type_descr ty tenv =
   match (Ctype.repr ty).desc with
   | Tconstr (path,_,_) -> Env.find_type path tenv
   | _ -> fatal_error "Parmatch.get_type_descr"
@@ -141,7 +141,7 @@
   try
     let name,_,_ = List.nth lbls lbl.lbl_pos in
     name
-  with Failure "nth" -> "*Unkown label*"
+  with Failure "nth" -> Ident.create "*Unknown label*"
 
 let rec get_record_labels ty tenv =
   match get_type_descr ty tenv with
@@ -159,10 +159,10 @@
 ;;
 
 let get_constr_name tag ty tenv  = match tag with
-| Cstr_exception path -> Path.name path
+| Cstr_exception (path, _) -> Path.name path
 | _ ->
   try
-    let name,_ = get_constr tag ty tenv in name
+    let name,_,_ = get_constr tag ty tenv in Ident.name name
   with
   | Datarepr.Constr_not_found -> "*Unknown constructor*"
 
@@ -170,26 +170,40 @@
 | "::" -> true
 | _ -> false
 
-
-let rec pretty_val ppf v = match v.pat_desc with
+let pretty_const c = match c with
+| Const_int i -> Printf.sprintf "%d" i
+| Const_char c -> Printf.sprintf "%C" c
+| Const_string s -> Printf.sprintf "%S" s
+| Const_float f -> Printf.sprintf "%s" f
+| Const_int32 i -> Printf.sprintf "%ldl" i
+| Const_int64 i -> Printf.sprintf "%LdL" i
+| Const_nativeint i -> Printf.sprintf "%ndn" i
+
+let rec pretty_val ppf v =
+  match v.pat_extra with
+      (cstr,_) :: rem ->
+        begin match cstr with
+          | Tpat_unpack ->
+            fprintf ppf "@[(module %a)@]" pretty_val { v with pat_extra = rem }
+          | Tpat_constraint ctyp ->
+            fprintf ppf "@[(%a : _)@]" pretty_val { v with pat_extra = rem }
+          | Tpat_type _ ->
+            fprintf ppf "@[(# %a)@]" pretty_val { v with pat_extra = rem }
+        end
+    | [] ->
+  match v.pat_desc with
   | Tpat_any -> fprintf ppf "_"
-  | Tpat_var x -> Ident.print ppf x
-  | Tpat_constant (Const_int i) -> fprintf ppf "%d" i
-  | Tpat_constant (Const_char c) -> fprintf ppf "%C" c
-  | Tpat_constant (Const_string s) -> fprintf ppf "%S" s
-  | Tpat_constant (Const_float f) -> fprintf ppf "%s" f
-  | Tpat_constant (Const_int32 i) -> fprintf ppf "%ldl" i
-  | Tpat_constant (Const_int64 i) -> fprintf ppf "%LdL" i
-  | Tpat_constant (Const_nativeint i) -> fprintf ppf "%ndn" i
+  | Tpat_var (x,_) -> Ident.print ppf x
+  | Tpat_constant c -> fprintf ppf "%s" (pretty_const c)
   | Tpat_tuple vs ->
       fprintf ppf "@[(%a)@]" (pretty_vals ",") vs
-  | Tpat_construct ({cstr_tag=tag},[]) ->
+  | Tpat_construct (_, {cstr_tag=tag},[], _) ->
       let name = get_constr_name tag v.pat_type v.pat_env in
       fprintf ppf "%s" name
-  | Tpat_construct ({cstr_tag=tag},[w]) ->
+  | Tpat_construct (_, {cstr_tag=tag},[w], _) ->
       let name = get_constr_name tag v.pat_type v.pat_env in
       fprintf ppf "@[<2>%s@ %a@]" name pretty_arg w
-  | Tpat_construct ({cstr_tag=tag},vs) ->
+  | Tpat_construct (_, {cstr_tag=tag},vs, _) ->
       let name = get_constr_name tag v.pat_type v.pat_env in
       begin match (name, vs) with
         ("::", [v1;v2]) ->
@@ -201,36 +215,36 @@
       fprintf ppf "`%s" l
   | Tpat_variant (l, Some w, _) ->
       fprintf ppf "@[<2>`%s@ %a@]" l pretty_arg w
-  | Tpat_record lvs ->
+  | Tpat_record (lvs,_) ->
       fprintf ppf "@[{%a}@]"
         (pretty_lvals (get_record_labels v.pat_type v.pat_env))
         (List.filter
            (function
-             | (_,{pat_desc=Tpat_any}) -> false (* do not show lbl=_ *)
+             | (_,_,{pat_desc=Tpat_any}) -> false (* do not show lbl=_ *)
              | _ -> true) lvs)
   | Tpat_array vs ->
       fprintf ppf "@[[| %a |]@]" (pretty_vals " ;") vs
   | Tpat_lazy v ->
       fprintf ppf "@[<2>lazy@ %a@]" pretty_arg v
-  | Tpat_alias (v,x) ->
+  | Tpat_alias (v, x,_) ->
       fprintf ppf "@[(%a@ as %a)@]" pretty_val v Ident.print x
   | Tpat_or (v,w,_)    ->
       fprintf ppf "@[(%a|@,%a)@]" pretty_or v pretty_or w
 
 and pretty_car ppf v = match v.pat_desc with
-| Tpat_construct ({cstr_tag=tag}, [_ ; _])
+| Tpat_construct (_,{cstr_tag=tag}, [_ ; _], _)
     when is_cons tag v ->
       fprintf ppf "(%a)" pretty_val v
 | _ -> pretty_val ppf v
 
 and pretty_cdr ppf v = match v.pat_desc with
-| Tpat_construct ({cstr_tag=tag}, [v1 ; v2])
+| Tpat_construct (_,{cstr_tag=tag}, [v1 ; v2], _)
     when is_cons tag v ->
       fprintf ppf "%a::@,%a" pretty_car v1 pretty_cdr v2
 | _ -> pretty_val ppf v
 
 and pretty_arg ppf v = match v.pat_desc with
-| Tpat_construct (_,_::_) -> fprintf ppf "(%a)" pretty_val v
+| Tpat_construct (_,_,_::_, _) -> fprintf ppf "(%a)" pretty_val v
 |  _ -> pretty_val ppf v
 
 and pretty_or ppf v = match v.pat_desc with
@@ -246,20 +260,41 @@
 
 and pretty_lvals lbls ppf = function
   | [] -> ()
-  | [lbl,v] ->
+  | [_,lbl,v] ->
       let name = find_label lbl lbls in
-      fprintf ppf "%s=%a" name pretty_val v
-  | (lbl,v)::rest ->
+      fprintf ppf "%s=%a" (Ident.name name) pretty_val v
+  | (_, lbl,v)::rest ->
       let name = find_label lbl lbls in
-      fprintf ppf "%s=%a;@ %a" name pretty_val v (pretty_lvals lbls) rest
+      fprintf ppf "%s=%a;@ %a"
+        (Ident.name name) pretty_val v (pretty_lvals lbls) rest
 
 let top_pretty ppf v =
   fprintf ppf "@[%a@]@?" pretty_val v
 
 
-let prerr_pat v =
-  top_pretty str_formatter v ;
-  prerr_string (flush_str_formatter ())
+let pretty_pat p =
+  top_pretty Format.str_formatter p ;
+  prerr_string (Format.flush_str_formatter ())
+
+type matrix = pattern list list
+
+let pretty_line ps =
+  List.iter
+    (fun p ->
+      top_pretty Format.str_formatter p ;
+      prerr_string " <" ;
+      prerr_string (Format.flush_str_formatter ()) ;
+      prerr_string ">")
+    ps
+
+let pretty_matrix (pss : matrix) =
+  prerr_endline "begin matrix" ;
+  List.iter
+    (fun ps ->
+      pretty_line ps ;
+      prerr_endline "")
+    pss ;
+  prerr_endline "end matrix"
 
 
 (****************************)
@@ -269,13 +304,11 @@
 (* Check top matching *)
 let simple_match p1 p2 =
   match p1.pat_desc, p2.pat_desc with
-  | Tpat_construct(c1, _), Tpat_construct(c2, _) ->
+  | Tpat_construct(_, c1, _, _), Tpat_construct(_, c2, _, _) ->
       c1.cstr_tag = c2.cstr_tag
   | Tpat_variant(l1, _, _), Tpat_variant(l2, _, _) ->
       l1 = l2
-  | Tpat_constant(Const_float s1), Tpat_constant(Const_float s2) ->
-      float_of_string s1 = float_of_string s2
-  | Tpat_constant(c1), Tpat_constant(c2) -> c1 = c2
+  | Tpat_constant(c1), Tpat_constant(c2) -> const_compare c1 c2 = 0
   | Tpat_tuple _, Tpat_tuple _ -> true
   | Tpat_lazy _, Tpat_lazy _ -> true
   | Tpat_record _ , Tpat_record _ -> true
@@ -289,42 +322,31 @@
 (* extract record fields as a whole *)
 let record_arg p = match p.pat_desc with
 | Tpat_any -> []
-| Tpat_record args -> args
+| Tpat_record (args,_) -> args
 | _ -> fatal_error "Parmatch.as_record"
 
 
 (* Raise Not_found when pos is not present in arg *)
-
-
 let get_field pos arg =
-  let _,p = List.find (fun (lbl,_) -> pos = lbl.lbl_pos) arg in
+  let _,_, p = List.find (fun (_,lbl,_) -> pos = lbl.lbl_pos) arg in
   p
 
-
 let extract_fields omegas arg =
   List.map
-    (fun (lbl,_) ->
+    (fun (_,lbl,_) ->
       try
         get_field lbl.lbl_pos arg
       with Not_found -> omega)
     omegas
 
-
-
-let sort_record p = match p.pat_desc with
-| Tpat_record args ->
-    make_pat
-      (Tpat_record (sort_fields args))
-      p.pat_type p.pat_env
-| _ -> p
-
 let all_record_args lbls = match lbls with
-| ({lbl_all=lbl_all},_)::_ ->
+| (_,{lbl_all=lbl_all},_)::_ ->
     let t =
       Array.map
-        (fun lbl -> lbl,omega) lbl_all in
+        (fun lbl -> mknoloc (Longident.Lident "?temp?"), lbl,omega)
+        lbl_all in
     List.iter
-      (fun ((lbl,_) as x) ->  t.(lbl.lbl_pos) <- x)
+      (fun ((_, lbl,_) as x) ->  t.(lbl.lbl_pos) <- x)
       lbls ;
     Array.to_list t
 |  _ -> fatal_error "Parmatch.all_record_args"
@@ -332,19 +354,19 @@
 
 (* Build argument list when p2 >= p1, where p1 is a simple pattern *)
 let rec simple_match_args p1 p2 = match p2.pat_desc with
-| Tpat_alias (p2,_) -> simple_match_args p1 p2
-| Tpat_construct(cstr, args) -> args
+| Tpat_alias (p2,_,_) -> simple_match_args p1 p2
+| Tpat_construct(_, cstr, args, _) -> args
 | Tpat_variant(lab, Some arg, _) -> [arg]
 | Tpat_tuple(args)  -> args
-| Tpat_record(args) ->  extract_fields (record_arg p1) args
+| Tpat_record(args,_) ->  extract_fields (record_arg p1) args
 | Tpat_array(args) -> args
 | Tpat_lazy arg -> [arg]
 | (Tpat_any | Tpat_var(_)) ->
     begin match p1.pat_desc with
-      Tpat_construct(_, args) -> omega_list args
+      Tpat_construct(_, _,args, _) -> omega_list args
     | Tpat_variant(_, Some _, _) -> [omega]
     | Tpat_tuple(args) -> omega_list args
-    | Tpat_record(args) ->  omega_list args
+    | Tpat_record(args,_) ->  omega_list args
     | Tpat_array(args) ->  omega_list args
     | Tpat_lazy _ -> [omega]
     | _ -> []
@@ -359,24 +381,27 @@
 let rec normalize_pat q = match q.pat_desc with
   | Tpat_any | Tpat_constant _ -> q
   | Tpat_var _ -> make_pat Tpat_any q.pat_type q.pat_env
-  | Tpat_alias (p,_) -> normalize_pat p
+  | Tpat_alias (p,_,_) -> normalize_pat p
   | Tpat_tuple (args) ->
       make_pat (Tpat_tuple (omega_list args)) q.pat_type q.pat_env
-  | Tpat_construct  (c,args) ->
-      make_pat (Tpat_construct (c,omega_list args)) q.pat_type q.pat_env
+  | Tpat_construct  (lid, c,args,explicit_arity) ->
+      make_pat
+        (Tpat_construct (lid, c,omega_list args, explicit_arity))
+        q.pat_type q.pat_env
   | Tpat_variant (l, arg, row) ->
       make_pat (Tpat_variant (l, may_map (fun _ -> omega) arg, row))
         q.pat_type q.pat_env
   | Tpat_array (args) ->
       make_pat (Tpat_array (omega_list args))  q.pat_type q.pat_env
-  | Tpat_record (largs) ->
-      make_pat (Tpat_record (List.map (fun (lbl,_) -> lbl,omega) largs))
+  | Tpat_record (largs, closed) ->
+      make_pat
+        (Tpat_record (List.map (fun (lid,lbl,_) ->
+                                 lid, lbl,omega) largs, closed))
         q.pat_type q.pat_env
   | Tpat_lazy _ ->
       make_pat (Tpat_lazy omega) q.pat_type q.pat_env
   | Tpat_or _ -> fatal_error "Parmatch.normalize_pat"
 
-
 (*
   Build normalized (cf. supra) discriminating pattern,
   in the non-data type case
@@ -385,7 +410,7 @@
 let discr_pat q pss =
 
   let rec acc_pat acc pss = match pss with
-    ({pat_desc = Tpat_alias (p,_)}::ps)::pss ->
+    ({pat_desc = Tpat_alias (p,_,_)}::ps)::pss ->
         acc_pat acc ((p::ps)::pss)
   | ({pat_desc = Tpat_or (p1,p2,_)}::ps)::pss ->
         acc_pat acc ((p1::ps)::(p2::ps)::pss)
@@ -393,25 +418,24 @@
         acc_pat acc pss
   | (({pat_desc = Tpat_tuple _} as p)::_)::_ -> normalize_pat p
   | (({pat_desc = Tpat_lazy _} as p)::_)::_ -> normalize_pat p
-  | (({pat_desc = Tpat_record largs} as p)::_)::pss ->
+  | (({pat_desc = Tpat_record (largs,closed)} as p)::_)::pss ->
       let new_omegas =
-        List.fold_left
-          (fun r (lbl,_) ->
+        List.fold_right
+          (fun (lid, lbl,_) r ->
             try
               let _ = get_field lbl.lbl_pos r in
               r
             with Not_found ->
-              (lbl,omega)::r)
-          (record_arg acc)
-          largs in
+              (lid, lbl,omega)::r)
+          largs (record_arg acc)
+      in
       acc_pat
-        (make_pat (Tpat_record new_omegas) p.pat_type p.pat_env)
+        (make_pat (Tpat_record (new_omegas, closed)) p.pat_type p.pat_env)
         pss
   | _ -> acc in
 
   match normalize_pat q with
-  | {pat_desc= (Tpat_any | Tpat_record _)} as q ->
-      sort_record (acc_pat q pss)
+  | {pat_desc= (Tpat_any | Tpat_record _)} as q -> acc_pat q pss
   | q -> q
 
 (*
@@ -431,26 +455,27 @@
 | {pat_desc = Tpat_tuple omegas} ->
     let args,rest = read_args omegas r in
     make_pat (Tpat_tuple args) q.pat_type q.pat_env::rest
-| {pat_desc = Tpat_record omegas} ->
+| {pat_desc = Tpat_record (omegas,closed)} ->
     let args,rest = read_args omegas r in
     make_pat
       (Tpat_record
-         (List.map2 (fun (lbl,_) arg ->
+         (List.map2 (fun (lid, lbl,_) arg ->
            if
              erase_mutable &&
              (match lbl.lbl_mut with
              | Mutable -> true | Immutable -> false)
            then
-             lbl, omega
+             lid, lbl, omega
            else
-             lbl,arg)
-            omegas args))
+             lid, lbl, arg)
+            omegas args, closed))
       q.pat_type q.pat_env::
     rest
-| {pat_desc = Tpat_construct (c,omegas)} ->
+| {pat_desc = Tpat_construct (lid, c,omegas, explicit_arity)} ->
     let args,rest = read_args omegas r in
     make_pat
-      (Tpat_construct (c,args)) q.pat_type q.pat_env::
+      (Tpat_construct (lid, c,args, explicit_arity))
+      q.pat_type q.pat_env::
     rest
 | {pat_desc = Tpat_variant (l, omega, row)} ->
     let arg, rest =
@@ -483,7 +508,7 @@
 (* filter pss acording to pattern q *)
 let filter_one q pss =
   let rec filter_rec = function
-      ({pat_desc = Tpat_alias(p,_)}::ps)::pss ->
+      ({pat_desc = Tpat_alias(p,_,_)}::ps)::pss ->
         filter_rec ((p::ps)::pss)
     | ({pat_desc = Tpat_or(p1,p2,_)}::ps)::pss ->
         filter_rec ((p1::ps)::(p2::ps)::pss)
@@ -501,7 +526,7 @@
 *)
 let filter_extra pss =
   let rec filter_rec = function
-      ({pat_desc = Tpat_alias(p,_)}::ps)::pss ->
+      ({pat_desc = Tpat_alias(p,_,_)}::ps)::pss ->
         filter_rec ((p::ps)::pss)
     | ({pat_desc = Tpat_or(p1,p2,_)}::ps)::pss ->
         filter_rec ((p1::ps)::(p2::ps)::pss)
@@ -536,7 +561,7 @@
         else c :: insert q qs env in
 
   let rec filter_rec env = function
-    ({pat_desc = Tpat_alias(p,_)}::ps)::pss ->
+    ({pat_desc = Tpat_alias(p,_,_)}::ps)::pss ->
       filter_rec env ((p::ps)::pss)
   | ({pat_desc = Tpat_or(p1,p2,_)}::ps)::pss ->
       filter_rec env ((p1::ps)::(p2::ps)::pss)
@@ -547,13 +572,14 @@
   | _ -> env
 
   and filter_omega env = function
-    ({pat_desc = Tpat_alias(p,_)}::ps)::pss ->
+    ({pat_desc = Tpat_alias(p,_,_)}::ps)::pss ->
       filter_omega env ((p::ps)::pss)
   | ({pat_desc = Tpat_or(p1,p2,_)}::ps)::pss ->
       filter_omega env ((p1::ps)::(p2::ps)::pss)
   | ({pat_desc = (Tpat_any | Tpat_var(_))}::ps)::pss ->
       filter_omega
-        (List.map (fun (q,qss) -> (q,(simple_match_args q omega @ ps) :: qss)) env)
+        (List.map (fun (q,qss) -> (q,(simple_match_args q omega @ ps) :: qss))
+           env)
         pss
   | _::pss -> filter_omega env pss
   | [] -> env in
@@ -575,7 +601,7 @@
 
 (* mark constructor lines for failure when they are incomplete *)
 let rec mark_partial = function
-    ({pat_desc = Tpat_alias(p,_)}::ps)::pss ->
+    ({pat_desc = Tpat_alias(p,_,_)}::ps)::pss ->
       mark_partial ((p::ps)::pss)
   | ({pat_desc = Tpat_or(p1,p2,_)}::ps)::pss ->
       mark_partial ((p1::ps)::(p2::ps)::pss)
@@ -615,11 +641,33 @@
   not.
 *)
 
-let full_match closing env =  match env with
-| ({pat_desc = Tpat_construct ({cstr_tag=Cstr_exception _},_)},_)::_ ->
+let generalized_constructor x =
+  match x with
+    ({pat_desc = Tpat_construct(_,c,_, _);pat_env=env},_) ->
+      c.cstr_generalized
+  | _ -> assert false
+
+let clean_env env =
+  let rec loop =
+    function
+      | [] -> []
+      | x :: xs ->
+          if generalized_constructor x then loop xs else x :: loop xs
+  in
+  loop env
+
+let full_match ignore_generalized closing env =  match env with
+| ({pat_desc = Tpat_construct (_,{cstr_tag=Cstr_exception _},_,_)},_)::_ ->
     false
-| ({pat_desc = Tpat_construct(c,_)},_) :: _ ->
-    List.length env = c.cstr_consts + c.cstr_nonconsts
+| ({pat_desc = Tpat_construct(_,c,_,_);pat_type=typ},_) :: _ ->
+    if ignore_generalized then
+      (* remove generalized constructors;
+         those cases will be handled separately *)
+      let env = clean_env env in
+      List.length env = c.cstr_normal
+    else
+      List.length env = c.cstr_consts + c.cstr_nonconsts
+
 | ({pat_desc = Tpat_variant _} as p,_) :: _ ->
     let fields =
       List.map
@@ -628,7 +676,7 @@
         env
     in
     let row = row_of_pat p in
-    if closing && not row.row_fixed then
+    if closing && not (Btype.row_fixed row) then
       (* closing=true, we are considering the variant as closed *)
       List.for_all
         (fun (tag,f) ->
@@ -653,8 +701,14 @@
 | ({pat_desc = Tpat_lazy(_)},_) :: _ -> true
 | _ -> fatal_error "Parmatch.full_match"
 
+let full_match_gadt env = match env with
+  | ({pat_desc = Tpat_construct(_,c,_,_);pat_type=typ},_) :: _ ->
+    List.length env = c.cstr_consts + c.cstr_nonconsts
+  | _ -> true
+
 let extendable_match env = match env with
-| ({pat_desc = Tpat_construct({cstr_tag=(Cstr_constant _|Cstr_block _)},_)} as p,_) :: _ ->
+| ({pat_desc=Tpat_construct(_,{cstr_tag=(Cstr_constant _|Cstr_block _)},_,_)}
+     as p,_) :: _ ->
     let path = get_type_path p.pat_type p.pat_env in
     not
       (Path.same path Predef.path_bool ||
@@ -667,8 +721,8 @@
 | None -> false
 | Some ext -> match env with
   | ({pat_desc =
-       Tpat_construct({cstr_tag=(Cstr_constant _|Cstr_block _)},_)} as p,_)
-    :: _ ->
+      Tpat_construct(_, {cstr_tag=(Cstr_constant _|Cstr_block _)},_,_)}
+     as p, _) :: _ ->
       let path = get_type_path p.pat_type p.pat_env in
       Path.same path ext
   | _ -> false
@@ -696,7 +750,9 @@
 
 (* build a pattern from a constructor list *)
 let pat_of_constr ex_pat cstr =
- {ex_pat with pat_desc = Tpat_construct (cstr,omegas cstr.cstr_arity)}
+ {ex_pat with pat_desc =
+  Tpat_construct (mknoloc (Longident.Lident "?pat_of_constr?"),
+                  cstr,omegas cstr.cstr_arity,false)}
 
 let rec pat_of_constrs ex_pat = function
 | [] -> raise Empty
@@ -708,24 +764,45 @@
         (pat_of_constr ex_pat cstr,
          pat_of_constrs ex_pat rem, None)}
 
+exception Not_an_adt
+
+let rec adt_path env ty =
+  match get_type_descr ty env with
+  | {type_kind=Type_variant constr_list} ->
+      begin match (Ctype.repr ty).desc with
+      | Tconstr (path,_,_) ->
+          path
+      | _ -> assert false end
+  | {type_manifest = Some _} ->
+      adt_path env (Ctype.expand_head_once env (clean_copy ty))
+  | _ -> raise Not_an_adt
+;;
+
+let rec map_filter f  =
+  function
+      [] -> []
+    | x :: xs ->
+        match f x with
+        | None -> map_filter f xs
+        | Some y -> y :: map_filter f xs
+
 (* Sends back a pattern that complements constructor tags all_tag *)
-let complete_constrs p all_tags = match p.pat_desc with
-| Tpat_construct (c,_) ->
-    begin try
-      let not_tags = complete_tags  c.cstr_consts c.cstr_nonconsts all_tags in
-      List.map
-        (fun tag ->
-          let _,targs = get_constr tag p.pat_type p.pat_env in
-          {c with
-      cstr_tag = tag ;
-      cstr_args = targs ;
-      cstr_arity = List.length targs})
-        not_tags
-with
-| Datarepr.Constr_not_found ->
-    fatal_error "Parmatch.complete_constr: constr_not_found"
-    end
-| _ -> fatal_error "Parmatch.complete_constr"
+let complete_constrs p all_tags =
+  match p.pat_desc with
+  | Tpat_construct (_,c,_,_) ->
+      begin try
+        let not_tags = complete_tags c.cstr_consts c.cstr_nonconsts all_tags in
+        let (constrs, _) =
+          Env.find_type_descrs (adt_path p.pat_env p.pat_type) p.pat_env in
+        map_filter
+          (fun cnstr ->
+            if List.mem cnstr.cstr_tag not_tags then Some cnstr else None)
+          constrs
+      with
+      | Datarepr.Constr_not_found ->
+          fatal_error "Parmatch.complete_constr: constr_not_found"
+      end
+  | _ -> fatal_error "Parmatch.complete_constr"
 
 
 (* Auxiliary for build_other *)
@@ -744,22 +821,23 @@
 *)
 
 let build_other ext env =  match env with
-| ({pat_desc = Tpat_construct ({cstr_tag=Cstr_exception _} as c,_)},_)
+| ({pat_desc =
+    Tpat_construct (lid, ({cstr_tag=Cstr_exception _} as c),_,_)},_)
   ::_ ->
     make_pat
       (Tpat_construct
-         ({c with
+         (lid, {c with
            cstr_tag=(Cstr_exception
-            (Path.Pident (Ident.create "*exception*")))},
-          []))
+            (Path.Pident (Ident.create "*exception*"), Location.none))},
+          [], false))
       Ctype.none Env.empty
-| ({pat_desc = Tpat_construct (_,_)} as p,_) :: _ ->
+| ({pat_desc = Tpat_construct (_, _,_,_)} as p,_) :: _ ->
     begin match ext with
     | Some ext when Path.same ext (get_type_path p.pat_type p.pat_env) ->
         extra_pat
     | _ ->
         let get_tag = function
-          | {pat_desc = Tpat_construct (c,_)} -> c.cstr_tag
+          | {pat_desc = Tpat_construct (_,c,_,_)} -> c.cstr_tag
           | _ -> fatal_error "Parmatch.get_tag" in
         let all_tags =  List.map (fun (p,_) -> get_tag p) env in
         pat_of_constrs p (complete_constrs p all_tags)
@@ -872,6 +950,20 @@
 | [] -> omega
 | _ -> omega
 
+let build_other_gadt ext env =
+  match env with
+    | ({pat_desc = Tpat_construct _} as p,_) :: _ ->
+        let get_tag = function
+          | {pat_desc = Tpat_construct (_,c,_,_)} -> c.cstr_tag
+          | _ -> fatal_error "Parmatch.get_tag" in
+        let all_tags =  List.map (fun (p,_) -> get_tag p) env in
+        let cnstrs  = complete_constrs p all_tags in
+        let pats = List.map (pat_of_constr p) cnstrs in
+        (* List.iter (Format.eprintf "%a@." top_pretty) pats;
+           Format.eprintf "@.@."; *)
+        pats
+    | _ -> assert false
+
 (*
   Core function :
   Is the last row of pattern matrix pss + qs satisfiable ?
@@ -884,11 +976,14 @@
 let rec has_instance p = match p.pat_desc with
   | Tpat_variant (l,_,r) when is_absent l r -> false
   | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_variant (_,None,_) -> true
-  | Tpat_alias (p,_) | Tpat_variant (_,Some p,_) -> has_instance p
+  | Tpat_alias (p,_,_) | Tpat_variant (_,Some p,_) -> has_instance p
   | Tpat_or (p1,p2,_) -> has_instance p1 || has_instance p2
-  | Tpat_construct (_,ps) | Tpat_tuple ps | Tpat_array ps -> has_instances ps
-  | Tpat_record lps -> has_instances (List.map snd lps)
-  | Tpat_lazy p -> has_instance p
+  | Tpat_construct (_,_,ps,_) | Tpat_tuple ps | Tpat_array ps ->
+      has_instances ps
+  | Tpat_record (lps,_) -> has_instances (List.map (fun (_,_,x) -> x) lps)
+  | Tpat_lazy p
+    -> has_instance p
+
 
 and has_instances = function
   | [] -> true
@@ -901,7 +996,7 @@
     | [] -> false
     | {pat_desc = Tpat_or(q1,q2,_)}::qs ->
         satisfiable pss (q1::qs) || satisfiable pss (q2::qs)
-    | {pat_desc = Tpat_alias(q,_)}::qs ->
+    | {pat_desc = Tpat_alias(q,_,_)}::qs ->
           satisfiable pss (q::qs)
     | {pat_desc = (Tpat_any | Tpat_var(_))}::qs ->
         let q0 = discr_pat omega pss in
@@ -909,7 +1004,7 @@
           (* first column of pss is made of variables only *)
         | [] -> satisfiable (filter_extra pss) qs
         | constrs  ->
-            if full_match false constrs then
+            if full_match false false constrs then
               List.exists
                 (fun (p,pss) ->
                   not (is_absent_pat p) &&
@@ -934,13 +1029,32 @@
   | Rnone           (* No matching value *)
   | Rsome of 'a     (* This matching value *)
 
-let rec try_many f = function
+let rec orify_many =
+  let orify x y =
+    make_pat (Tpat_or (x, y, None)) x.pat_type x.pat_env
+  in
+  function
+    | [] -> assert false
+    | [x] -> x
+    | x :: xs -> orify x (orify_many xs)
+
+let rec try_many  f = function
   | [] -> Rnone
-  | x::rest ->
-      begin match f x with
-      | Rnone -> try_many f rest
+  | (p,pss)::rest ->
+      match f (p,pss) with
+      | Rnone -> try_many  f rest
       | r -> r
-      end
+
+let rappend r1 r2 =
+  match r1, r2 with
+  | Rnone, _ -> r2
+  | _, Rnone -> r1
+  | Rsome l1, Rsome l2 -> Rsome (l1 @ l2)
+
+let rec try_many_gadt  f = function
+  | [] -> Rnone
+  | (p,pss)::rest ->
+      rappend (f (p, pss)) (try_many_gadt f rest)
 
 let rec exhaust ext pss n = match pss with
 | []    ->  Rsome (omegas n)
@@ -966,7 +1080,7 @@
             | Rsome r -> Rsome (set_args p r)
             | r       -> r in
         if
-          full_match false constrs && not (should_extend ext constrs)
+          full_match true false constrs && not (should_extend ext constrs)
         then
           try_many try_non_omega constrs
         else
@@ -989,6 +1103,118 @@
               | Empty -> fatal_error "Parmatch.exhaust"
     end
 
+let combinations f lst lst' =
+  let rec iter2 x =
+    function
+        [] -> []
+      | y :: ys ->
+          f x y :: iter2 x ys
+  in
+  let rec iter =
+    function
+        [] -> []
+      | x :: xs -> iter2 x lst' @ iter xs
+  in
+  iter lst
+
+(*
+let print_pat pat =
+  let rec string_of_pat pat =
+    match pat.pat_desc with
+        Tpat_var _ -> "v"
+      | Tpat_any -> "_"
+      | Tpat_alias (p, x) -> Printf.sprintf "(%s) as ?"  (string_of_pat p)
+      | Tpat_constant n -> "0"
+      | Tpat_construct (_, lid, _, _) ->
+        Printf.sprintf "%s" (String.concat "." (Longident.flatten lid.txt))
+      | Tpat_lazy p ->
+        Printf.sprintf "(lazy %s)" (string_of_pat p)
+      | Tpat_or (p1,p2,_) ->
+        Printf.sprintf "(%s | %s)" (string_of_pat p1) (string_of_pat p2)
+      | Tpat_tuple list ->
+        Printf.sprintf "(%s)" (String.concat "," (List.map string_of_pat list))
+      | Tpat_variant (_, _, _) -> "variant"
+      | Tpat_record (_, _) -> "record"
+      | Tpat_array _ -> "array"
+  in
+  Printf.fprintf stderr "PAT[%s]\n%!" (string_of_pat pat)
+*)
+
+(* strictly more powerful than exhaust; however, exhaust
+   was kept for backwards compatibility *)
+let rec exhaust_gadt (ext:Path.t option) pss n = match pss with
+| []    ->  Rsome [omegas n]
+| []::_ ->  Rnone
+| pss   ->
+    let q0 = discr_pat omega pss in
+    begin match filter_all q0 pss with
+          (* first column of pss is made of variables only *)
+    | [] ->
+        begin match exhaust_gadt ext (filter_extra pss) (n-1) with
+        | Rsome r -> Rsome (List.map (fun row -> q0::row) r)
+        | r -> r
+      end
+    | constrs ->
+        let try_non_omega (p,pss) =
+          if is_absent_pat p then
+            Rnone
+          else
+            match
+              exhaust_gadt
+                ext pss (List.length (simple_match_args p omega) + n - 1)
+            with
+            | Rsome r -> Rsome (List.map (fun row ->  (set_args p row)) r)
+            | r       -> r in
+        let before = try_many_gadt try_non_omega constrs in
+        if
+          full_match_gadt constrs && not (should_extend ext constrs)
+        then
+          before
+        else
+          (*
+            D = filter_extra pss is the default matrix
+            as it is included in pss, one can avoid
+            recursive calls on specialized matrices,
+            Essentially :
+           * D exhaustive => pss exhaustive
+           * D non-exhaustive => we have a non-filtered value
+           *)
+          let r =  exhaust_gadt ext (filter_extra pss) (n-1) in
+          match r with
+          | Rnone -> before
+          | Rsome r ->
+              try
+                let missing_trailing = build_other_gadt ext constrs in
+                let dug =
+                  combinations
+                    (fun head tail -> head :: tail)
+                    missing_trailing
+                    r
+                in
+                match before with
+                | Rnone -> Rsome dug
+                | Rsome x -> Rsome (x @ dug)
+              with
+      (* cannot occur, since constructors don't make a full signature *)
+              | Empty -> fatal_error "Parmatch.exhaust"
+    end
+
+let exhaust_gadt ext pss n =
+  let ret = exhaust_gadt ext pss n in
+  match ret with
+    Rnone -> Rnone
+  | Rsome lst ->
+      (* The following line is needed to compile stdlib/printf.ml *)
+      if lst = [] then Rsome (omegas n) else
+      let singletons =
+        List.map
+          (function
+              [x] -> x
+            | _ -> assert false)
+          lst
+      in
+      Rsome [orify_many singletons]
+
 (*
    Another exhaustiveness check, enforcing variant typing.
    Note that it does not check exact exhaustiveness, but whether a
@@ -1015,12 +1241,12 @@
                 try_non_omega rem && ok
             | [] -> true
           in
-          if full_match (tdefs=None) constrs then
+          if full_match true (tdefs=None) constrs then
             try_non_omega constrs
           else if tdefs = None then
             pressure_variants None (filter_extra pss)
           else
-            let full = full_match true constrs in
+            let full = full_match true true constrs in
             let ok =
               if full then try_non_omega constrs
               else try_non_omega (filter_all q0 (mark_partial pss))
@@ -1028,7 +1254,7 @@
             begin match constrs, tdefs with
               ({pat_desc=Tpat_variant _} as p,_):: _, Some env ->
                 let row = row_of_pat p in
-                if row.row_fixed
+                if Btype.row_fixed row
                 || pressure_variants None (filter_extra pss) then ()
                 else close_variant env row
             | _ -> ()
@@ -1048,32 +1274,9 @@
 type answer =
   | Used                                (* Useful pattern *)
   | Unused                              (* Useless pattern *)
-  | Upartial of Typedtree.pattern list  (* Neither, with list of useless pattern *)
-
-
-let pretty_pat p =
-  top_pretty Format.str_formatter p ;
-  prerr_string (Format.flush_str_formatter ())
+  | Upartial of Typedtree.pattern list  (* Mixed, with list of useless ones *)
 
-type matrix = pattern list list
 
-let pretty_line ps =
-  List.iter
-    (fun p ->
-      top_pretty Format.str_formatter p ;
-      prerr_string " <" ;
-      prerr_string (Format.flush_str_formatter ()) ;
-      prerr_string ">")
-    ps
-
-let pretty_matrix pss =
-  prerr_endline "begin matrix" ;
-  List.iter
-    (fun ps ->
-      pretty_line ps ;
-      prerr_endline "")
-    pss ;
-  prerr_endline "end matrix"
 
 (* this row type enable column processing inside the matrix
     - left  ->  elements not to be processed,
@@ -1104,7 +1307,7 @@
 
 (* Useful to detect and expand  or pats inside as pats *)
 let rec unalias p = match p.pat_desc with
-| Tpat_alias (p,_) -> unalias p
+| Tpat_alias (p,_,_) -> unalias p
 | _ -> p
 
 
@@ -1122,7 +1325,7 @@
 (* Standard or-args for left-to-right matching *)
 let rec or_args p = match p.pat_desc with
 | Tpat_or (p1,p2,_) -> p1,p2
-| Tpat_alias (p,_)  -> or_args p
+| Tpat_alias (p,_,_)  -> or_args p
 | _                 -> assert false
 
 (* Just remove current column *)
@@ -1157,7 +1360,7 @@
   | r::rem ->
       match r.active with
       | [] -> assert false
-      | {pat_desc = Tpat_alias(p,_)}::ps ->
+      | {pat_desc = Tpat_alias(p,_,_)}::ps ->
           filter_rec ({r with active = p::ps}::rem)
       | {pat_desc = Tpat_or(p1,p2,_)}::ps ->
           filter_rec
@@ -1310,10 +1513,10 @@
 let rec le_pat p q =
   match (p.pat_desc, q.pat_desc) with
   | (Tpat_var _|Tpat_any),_ -> true
-  | Tpat_alias(p,_), _ -> le_pat p q
-  | _, Tpat_alias(q,_) -> le_pat p q
-  | Tpat_constant(c1), Tpat_constant(c2) -> c1 = c2
-  | Tpat_construct(c1,ps), Tpat_construct(c2,qs) ->
+  | Tpat_alias(p,_,_), _ -> le_pat p q
+  | _, Tpat_alias(q,_,_) -> le_pat p q
+  | Tpat_constant(c1), Tpat_constant(c2) -> const_compare c1 c2 = 0
+  | Tpat_construct(_,c1,ps,_), Tpat_construct(_,c2,qs,_) ->
       c1.cstr_tag = c2.cstr_tag && le_pats ps qs
   | Tpat_variant(l1,Some p1,_), Tpat_variant(l2,Some p2,_) ->
       (l1 = l2 && le_pat p1 p2)
@@ -1322,7 +1525,7 @@
   | Tpat_variant(_,_,_), Tpat_variant(_,_,_) -> false
   | Tpat_tuple(ps), Tpat_tuple(qs) -> le_pats ps qs
   | Tpat_lazy p, Tpat_lazy q -> le_pat p q
-  | Tpat_record l1, Tpat_record l2 ->
+  | Tpat_record (l1,_), Tpat_record (l2,_) ->
       let ps,qs = records_args l1 l2 in
       le_pats ps qs
   | Tpat_array(ps), Tpat_array(qs) ->
@@ -1350,32 +1553,33 @@
 *)
 
 let rec lub p q = match p.pat_desc,q.pat_desc with
-| Tpat_alias (p,_),_      -> lub p q
-| _,Tpat_alias (q,_)      -> lub p q
+| Tpat_alias (p,_,_),_      -> lub p q
+| _,Tpat_alias (q,_,_)      -> lub p q
 | (Tpat_any|Tpat_var _),_ -> q
 | _,(Tpat_any|Tpat_var _) -> p
 | Tpat_or (p1,p2,_),_     -> orlub p1 p2 q
 | _,Tpat_or (q1,q2,_)     -> orlub q1 q2 p (* Thanks god, lub is commutative *)
-| Tpat_constant c1, Tpat_constant c2 when c1=c2 -> p
+| Tpat_constant c1, Tpat_constant c2 when const_compare c1 c2 = 0 -> p
 | Tpat_tuple ps, Tpat_tuple qs ->
     let rs = lubs ps qs in
     make_pat (Tpat_tuple rs) p.pat_type p.pat_env
 | Tpat_lazy p, Tpat_lazy q ->
     let r = lub p q in
     make_pat (Tpat_lazy r) p.pat_type p.pat_env
-| Tpat_construct (c1,ps1), Tpat_construct (c2,ps2)
+| Tpat_construct (lid, c1,ps1,_), Tpat_construct (_,c2,ps2,_)
       when  c1.cstr_tag = c2.cstr_tag  ->
         let rs = lubs ps1 ps2 in
-        make_pat (Tpat_construct (c1,rs)) p.pat_type p.pat_env
+        make_pat (Tpat_construct (lid, c1,rs, false))
+          p.pat_type p.pat_env
 | Tpat_variant(l1,Some p1,row), Tpat_variant(l2,Some p2,_)
           when  l1=l2 ->
             let r=lub p1 p2 in
             make_pat (Tpat_variant (l1,Some r,row)) p.pat_type p.pat_env
 | Tpat_variant (l1,None,row), Tpat_variant(l2,None,_)
               when l1 = l2 -> p
-| Tpat_record l1,Tpat_record l2 ->
+| Tpat_record (l1,closed),Tpat_record (l2,_) ->
     let rs = record_lubs l1 l2 in
-    make_pat (Tpat_record rs) p.pat_type p.pat_env
+    make_pat (Tpat_record (rs, closed)) p.pat_type p.pat_env
 | Tpat_array ps, Tpat_array qs
       when List.length ps = List.length qs ->
         let rs = lubs ps qs in
@@ -1394,17 +1598,16 @@
 | Empty -> lub p2 q
 
 and record_lubs l1 l2 =
-  let l1 = sort_fields l1 and l2 = sort_fields l2 in
   let rec lub_rec l1 l2 = match l1,l2 with
   | [],_ -> l2
   | _,[] -> l1
-  | (lbl1,p1)::rem1, (lbl2,p2)::rem2 ->
+  | (lid1, lbl1,p1)::rem1, (lid2, lbl2,p2)::rem2 ->
       if lbl1.lbl_pos < lbl2.lbl_pos then
-        (lbl1,p1)::lub_rec rem1 l2
+        (lid1, lbl1,p1)::lub_rec rem1 l2
       else if lbl2.lbl_pos < lbl1.lbl_pos  then
-        (lbl2,p2)::lub_rec l1 rem2
+        (lid2, lbl2,p2)::lub_rec l1 rem2
       else
-        (lbl1,lub p1 p2)::lub_rec rem1 rem2 in
+        (lid1, lbl1,lub p1 p2)::lub_rec rem1 rem2 in
   lub_rec l1 l2
 
 and lubs ps qs = match ps,qs with
@@ -1475,7 +1678,7 @@
 
 let do_filter_one q pss =
   let rec filter_rec = function
-    | ({pat_desc = Tpat_alias(p,_)}::ps,loc)::pss ->
+    | ({pat_desc = Tpat_alias(p,_,_)}::ps,loc)::pss ->
         filter_rec ((p::ps,loc)::pss)
     | ({pat_desc = Tpat_or(p1,p2,_)}::ps,loc)::pss ->
         filter_rec ((p1::ps,loc)::(p2::ps,loc)::pss)
@@ -1516,7 +1719,123 @@
 (* Exhaustiveness check *)
 (************************)
 
-let do_check_partial loc casel pss = match pss with
+
+  let rec get_first f =
+    function
+      | [] -> None
+      | x :: xs ->
+          match f x with
+          | None -> get_first f xs
+          | x -> x
+
+
+(* conversion from Typedtree.pattern to Parsetree.pattern list *)
+module Conv = struct
+  open Parsetree
+  let mkpat desc =
+    {ppat_desc = desc;
+     ppat_loc = Location.none}
+
+  let rec select : 'a list list -> 'a list list =
+    function
+      | xs :: [] -> List.map (fun y -> [y]) xs
+      | (x::xs)::ys ->
+          List.map
+            (fun lst -> x :: lst)
+            (select ys)
+          @
+            select (xs::ys)
+      | _ -> []
+
+  let name_counter = ref 0
+  let fresh name =
+    let current = !name_counter in
+    name_counter := !name_counter + 1;
+    "#$" ^ name ^ string_of_int current
+
+  let conv (typed: Typedtree.pattern) :
+      Parsetree.pattern list *
+      (string, Types.constructor_description) Hashtbl.t *
+      (string, Types.label_description) Hashtbl.t
+      =
+    let constrs = Hashtbl.create 0 in
+    let labels = Hashtbl.create 0 in
+    let rec loop pat =
+      match pat.pat_desc with
+        Tpat_or (a,b,_) ->
+          loop a @ loop b
+      | Tpat_any | Tpat_constant _ | Tpat_var _ ->
+          [mkpat Ppat_any]
+      | Tpat_alias (p,_,_) -> loop p
+      | Tpat_tuple lst ->
+          let results = select (List.map loop lst) in
+          List.map
+            (fun lst -> mkpat (Ppat_tuple lst))
+            results
+      | Tpat_construct (cstr_lid, cstr,lst,_) ->
+          let id = fresh cstr.cstr_name in
+          let lid = { cstr_lid with txt = Longident.Lident id } in
+          Hashtbl.add constrs id cstr;
+          let results = select (List.map loop lst) in
+          begin match lst with
+            [] ->
+              [mkpat (Ppat_construct(lid, None, false))]
+          | _ ->
+              List.map
+                (fun lst ->
+                  let arg =
+                    match lst with
+                      [] -> assert false
+                    | [x] -> Some x
+                    | _ -> Some (mkpat (Ppat_tuple lst))
+                  in
+                  mkpat (Ppat_construct(lid, arg, false)))
+                results
+          end
+      | Tpat_variant(label,p_opt,row_desc) ->
+          begin match p_opt with
+          | None ->
+              [mkpat (Ppat_variant(label, None))]
+          | Some p ->
+              let results = loop p in
+              List.map
+                (fun p ->
+                  mkpat (Ppat_variant(label, Some p)))
+                results
+          end
+      | Tpat_record (subpatterns, _closed_flag) ->
+          let pats =
+            select
+              (List.map (fun (_,_,x) -> loop x) subpatterns)
+          in
+          let label_idents =
+            List.map
+              (fun (_,lbl,_) ->
+                let id = fresh lbl.lbl_name in
+                Hashtbl.add labels id lbl;
+                Longident.Lident id)
+              subpatterns
+          in
+          List.map
+            (fun lst ->
+              let lst = List.map2 (fun lid pat ->
+                (mknoloc lid, pat)
+              )  label_idents lst in
+              mkpat (Ppat_record (lst, Open)))
+            pats
+      | Tpat_array lst ->
+          let results = select (List.map loop lst) in
+          List.map (fun lst -> mkpat (Ppat_array lst)) results
+      | Tpat_lazy p ->
+          let results = loop p in
+          List.map (fun p -> mkpat (Ppat_lazy p)) results
+    in
+    let ps = loop typed in
+    (ps, constrs, labels)
+end
+
+
+let do_check_partial ?pred exhaust loc casel pss = match pss with
 | [] ->
         (*
           This can occur
@@ -1534,31 +1853,52 @@
 | ps::_  ->
     begin match exhaust None pss (List.length ps) with
     | Rnone -> Total
-    | Rsome [v] ->
-        let errmsg =
-          try
-            let buf = Buffer.create 16 in
-            let fmt = formatter_of_buffer buf in
-            top_pretty fmt v;
-            begin match check_partial_all v casel with
-            | None -> ()
-            | Some _ ->
-                  (* This is 'Some loc', where loc is the location of
-                     a possibly matching clause.
-                     Forget about loc, because printing two locations
-                     is a pain in the top-level *)
-                Buffer.add_string buf
-                  "\n(However, some guarded clause may match this value.)"
-            end ;
-            Buffer.contents buf
-          with _ ->
-            "" in
-        Location.prerr_warning loc (Warnings.Partial_match errmsg) ;
-        Partial
+    | Rsome [u] ->
+        let v =
+          match pred with
+          | Some pred ->
+              let (patterns,constrs,labels) = Conv.conv u in
+(*              Hashtbl.iter (fun s (path, _) ->
+                Printf.fprintf stderr "CONV: %s -> %s \n%!" s (Path.name path))
+                constrs
+              ; *)
+              get_first (pred constrs labels) patterns
+          | None -> Some u
+        in
+        begin match v with
+          None -> Total
+        | Some v ->
+            let errmsg =
+              try
+                let buf = Buffer.create 16 in
+                let fmt = formatter_of_buffer buf in
+                top_pretty fmt v;
+                begin match check_partial_all v casel with
+                | None -> ()
+                | Some _ ->
+                    (* This is 'Some loc', where loc is the location of
+                       a possibly matching clause.
+                       Forget about loc, because printing two locations
+                       is a pain in the top-level *)
+                    Buffer.add_string buf
+                      "\n(However, some guarded clause may match this value.)"
+                end ;
+                Buffer.contents buf
+              with _ ->
+                "" in
+            Location.prerr_warning loc (Warnings.Partial_match errmsg) ;
+            Partial end
     | _ ->
         fatal_error "Parmatch.check_partial"
     end
 
+let do_check_partial_normal loc casel pss =
+  do_check_partial exhaust loc casel pss
+
+let do_check_partial_gadt pred loc casel pss =
+  do_check_partial ~pred exhaust_gadt loc casel pss
+
+
 
 (*****************)
 (* Fragile check *)
@@ -1576,10 +1916,11 @@
   not
     (Path.same path Predef.path_bool ||
     Path.same path Predef.path_list ||
+    Path.same path Predef.path_unit ||
     Path.same path Predef.path_option)
 
 let rec collect_paths_from_pat r p = match p.pat_desc with
-| Tpat_construct({cstr_tag=(Cstr_constant _|Cstr_block _)},ps) ->
+| Tpat_construct(_, {cstr_tag=(Cstr_constant _|Cstr_block _)},ps,_) ->
     let path =  get_type_path p.pat_type p.pat_env in
     List.fold_left
       collect_paths_from_pat
@@ -1587,16 +1928,17 @@
       ps
 | Tpat_any|Tpat_var _|Tpat_constant _| Tpat_variant (_,None,_) -> r
 | Tpat_tuple ps | Tpat_array ps
-| Tpat_construct ({cstr_tag=Cstr_exception _}, ps)->
+| Tpat_construct (_, {cstr_tag=Cstr_exception _}, ps,_)->
     List.fold_left collect_paths_from_pat r ps
-| Tpat_record lps ->
+| Tpat_record (lps,_) ->
     List.fold_left
-      (fun r (_,p) -> collect_paths_from_pat r p)
+      (fun r (_, _, p) -> collect_paths_from_pat r p)
       r lps
-| Tpat_variant (_, Some p, _) | Tpat_alias (p,_) -> collect_paths_from_pat r p
+| Tpat_variant (_, Some p, _) | Tpat_alias (p,_,_) -> collect_paths_from_pat r p
 | Tpat_or (p1,p2,_) ->
     collect_paths_from_pat (collect_paths_from_pat r p1) p2
-| Tpat_lazy p ->
+| Tpat_lazy p
+    ->
     collect_paths_from_pat r p
 
 
@@ -1607,7 +1949,7 @@
       the type is extended.
 *)
 
-let do_check_fragile loc casel pss =
+let do_check_fragile_param exhaust loc casel pss =
   let exts =
     List.fold_left
       (fun r (p,_) -> collect_paths_from_pat r p)
@@ -1627,30 +1969,8 @@
             | Rsome _ -> ())
           exts
 
-
-(********************************)
-(* Exported exhustiveness check *)
-(********************************)
-
-(*
-   Fragile check is performed when required and
-   on exhaustive matches only.
-*)
-
-let check_partial loc casel =
-  if Warnings.is_active (Warnings.Partial_match "") then begin
-    let pss = initial_matrix casel in
-    let pss = get_mins le_pats pss in
-    let total = do_check_partial loc casel pss in
-    if
-      total = Total && Warnings.is_active (Warnings.Fragile_match "")
-    then begin
-      do_check_fragile loc casel pss
-    end ;
-    total
-  end else
-    Partial
-
+let do_check_fragile_normal = do_check_fragile_param exhaust
+let do_check_fragile_gadt = do_check_fragile_param exhaust_gadt
 
 (********************************)
 (* Exported unused clause check *)
@@ -1677,7 +1997,7 @@
                         p.pat_loc Warnings.Unused_pat)
                     ps
               | Used -> ()
-            with e -> assert false
+            with Empty | Not_an_adt | Not_found | NoGuard -> assert false
             end ;
 
           if has_guard act then
@@ -1702,16 +2022,62 @@
     false
 | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_variant (_, None, _) ->
     true
-| Tpat_tuple ps | Tpat_construct (_, ps) | Tpat_array ps ->
+| Tpat_tuple ps | Tpat_construct (_, _, ps,_) | Tpat_array ps ->
     List.for_all (fun p -> inactive p.pat_desc) ps
-| Tpat_alias (p,_) | Tpat_variant (_, Some p, _) ->
+| Tpat_alias (p,_,_) | Tpat_variant (_, Some p, _) ->
     inactive p.pat_desc
-| Tpat_record ldps ->
-    List.exists (fun (_, p) -> inactive p.pat_desc) ldps
+| Tpat_record (ldps,_) ->
+    List.exists (fun (_, _, p) -> inactive p.pat_desc) ldps
 | Tpat_or (p,q,_) ->
     inactive p.pat_desc && inactive q.pat_desc
 
-
 (* A `fluid' pattern is both irrefutable and inactive *)
 
-let fluid pat = irrefutable pat && inactive pat.pat_desc
+let fluid pat =  irrefutable pat && inactive pat.pat_desc
+
+
+
+
+
+
+
+
+(********************************)
+(* Exported exhustiveness check *)
+(********************************)
+
+(*
+   Fragile check is performed when required and
+   on exhaustive matches only.
+*)
+
+let check_partial_param do_check_partial do_check_fragile loc casel =
+    if Warnings.is_active (Warnings.Partial_match "") then begin
+      let pss = initial_matrix casel in
+      let pss = get_mins le_pats pss in
+      let total = do_check_partial loc casel pss in
+      if
+        total = Total && Warnings.is_active (Warnings.Fragile_match "")
+      then begin
+        do_check_fragile loc casel pss
+      end ;
+      total
+    end else
+      Partial
+
+let check_partial =
+    check_partial_param
+      do_check_partial_normal
+      do_check_fragile_normal
+
+let check_partial_gadt pred loc casel =
+  (*ignores GADT constructors *)
+  let first_check = check_partial loc casel in
+  match first_check with
+  | Partial -> Partial
+  | Total ->
+      (* checks for missing GADT constructors *)
+      (* let casel =
+        match casel with [] -> [] | a :: l -> a :: l @ [a] in *)
+      check_partial_param (do_check_partial_gadt pred)
+        do_check_fragile_gadt loc casel
diff -Nru ocaml-3.12.1/typing/parmatch.mli ocaml-4.01.0/typing/parmatch.mli
--- ocaml-3.12.1/typing/parmatch.mli	2008-07-09 13:03:38.000000000 +0000
+++ ocaml-4.01.0/typing/parmatch.mli	2013-04-25 13:32:17.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,12 +10,12 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: parmatch.mli 8906 2008-07-09 13:03:38Z mauny $ *)
-
 (* Detection of partial matches and unused match cases. *)
-open Types
+open Asttypes
 open Typedtree
+open Types
 
+val pretty_const : constant -> string
 val top_pretty : Format.formatter -> pattern -> unit
 val pretty_pat : pattern -> unit
 val pretty_line : pattern list -> unit
@@ -26,7 +26,9 @@
 val omega_list : 'a list -> pattern list
 val normalize_pat : pattern -> pattern
 val all_record_args :
-    (label_description * pattern) list -> (label_description * pattern) list
+    (Longident.t loc * label_description * pattern) list ->
+    (Longident.t loc * label_description * pattern) list
+val const_compare : constant -> constant -> int
 
 val le_pat : pattern -> pattern -> bool
 val le_pats : pattern list -> pattern list -> bool
@@ -38,7 +40,7 @@
 
 val get_mins : ('a -> 'a -> bool) -> 'a list -> 'a list
 
-(* Those to functions recombine one pattern and its arguments:
+(* Those two functions recombine one pattern and its arguments:
    For instance:
      (_,_)::p1::p2::rem -> (p1, p2)::rem
    The second one will replace mutable arguments by '_'
@@ -52,6 +54,11 @@
 
 val pressure_variants: Env.t -> pattern list -> unit
 val check_partial: Location.t -> (pattern * expression) list -> partial
+val check_partial_gadt:
+    ((string, constructor_description) Hashtbl.t ->
+     (string, label_description) Hashtbl.t ->
+     Parsetree.pattern -> pattern option) ->
+    Location.t -> (pattern * expression) list -> partial
 val check_unused: Env.t -> (pattern * expression) list -> unit
 
 (* Irrefutability tests *)
diff -Nru ocaml-3.12.1/typing/path.ml ocaml-4.01.0/typing/path.ml
--- ocaml-3.12.1/typing/path.ml	2010-01-22 12:48:24.000000000 +0000
+++ ocaml-4.01.0/typing/path.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: path.ml 9547 2010-01-22 12:48:24Z doligez $ *)
-
 type t =
     Pident of Ident.t
   | Pdot of t * string * int
@@ -37,12 +35,20 @@
   | Pdot(p, s, pos) -> binding_time p
   | Papply(p1, p2) -> max (binding_time p1) (binding_time p2)
 
-let rec name = function
+let kfalse x = false
+
+let rec name ?(paren=kfalse) = function
     Pident id -> Ident.name id
-  | Pdot(p, s, pos) -> name p ^ "." ^ s
-  | Papply(p1, p2) -> name p1 ^ "(" ^ name p2 ^ ")"
+  | Pdot(p, s, pos) ->
+      name ~paren p ^ if paren s then ".( " ^ s ^ " )" else "." ^ s
+  | Papply(p1, p2) -> name ~paren p1 ^ "(" ^ name ~paren p2 ^ ")"
 
 let rec head = function
     Pident id -> id
   | Pdot(p, s, pos) -> head p
   | Papply(p1, p2) -> assert false
+
+let rec last = function
+  | Pident id -> Ident.name id
+  | Pdot(_, s, _) -> s
+  | Papply(_, p) -> last p
diff -Nru ocaml-3.12.1/typing/path.mli ocaml-4.01.0/typing/path.mli
--- ocaml-3.12.1/typing/path.mli	2003-07-01 13:05:43.000000000 +0000
+++ ocaml-4.01.0/typing/path.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: path.mli 5640 2003-07-01 13:05:43Z xleroy $ *)
-
 (* Access paths *)
 
 type t =
@@ -25,5 +23,8 @@
 
 val nopos: int
 
-val name: t -> string
+val name: ?paren:(string -> bool) -> t -> string
+    (* [paren] tells whether a path suffix needs parentheses *)
 val head: t -> Ident.t
+
+val last: t -> string
diff -Nru ocaml-3.12.1/typing/predef.ml ocaml-4.01.0/typing/predef.ml
--- ocaml-3.12.1/typing/predef.ml	2010-04-21 08:13:10.000000000 +0000
+++ ocaml-4.01.0/typing/predef.ml	2013-05-03 13:38:30.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,30 +10,37 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: predef.ml 10288 2010-04-21 08:13:10Z xleroy $ *)
-
 (* Predefined type constructors (with special typing rules in typecore) *)
 
-open Asttypes
 open Path
 open Types
 open Btype
 
-let ident_int = Ident.create "int"
-and ident_char = Ident.create "char"
-and ident_string = Ident.create "string"
-and ident_float = Ident.create "float"
-and ident_bool = Ident.create "bool"
-and ident_unit = Ident.create "unit"
-and ident_exn = Ident.create "exn"
-and ident_array = Ident.create "array"
-and ident_list = Ident.create "list"
-and ident_format6 = Ident.create "format6"
-and ident_option = Ident.create "option"
-and ident_nativeint = Ident.create "nativeint"
-and ident_int32 = Ident.create "int32"
-and ident_int64 = Ident.create "int64"
-and ident_lazy_t = Ident.create "lazy_t"
+let builtin_idents = ref []
+
+let wrap create s =
+  let id = create s in
+  builtin_idents := (s, id) :: !builtin_idents;
+  id
+
+let ident_create = wrap Ident.create
+let ident_create_predef_exn = wrap Ident.create_predef_exn
+
+let ident_int = ident_create "int"
+and ident_char = ident_create "char"
+and ident_string = ident_create "string"
+and ident_float = ident_create "float"
+and ident_bool = ident_create "bool"
+and ident_unit = ident_create "unit"
+and ident_exn = ident_create "exn"
+and ident_array = ident_create "array"
+and ident_list = ident_create "list"
+and ident_format6 = ident_create "format6"
+and ident_option = ident_create "option"
+and ident_nativeint = ident_create "nativeint"
+and ident_int32 = ident_create "int32"
+and ident_int64 = ident_create "int64"
+and ident_lazy_t = ident_create "lazy_t"
 
 let path_int = Pident ident_int
 and path_char = Pident ident_char
@@ -66,102 +73,89 @@
 and type_int64 = newgenty (Tconstr(path_int64, [], ref Mnil))
 and type_lazy_t t = newgenty (Tconstr(path_lazy_t, [t], ref Mnil))
 
-let ident_match_failure = Ident.create_predef_exn "Match_failure"
-and ident_out_of_memory = Ident.create_predef_exn "Out_of_memory"
-and ident_invalid_argument = Ident.create_predef_exn "Invalid_argument"
-and ident_failure = Ident.create_predef_exn "Failure"
-and ident_not_found = Ident.create_predef_exn "Not_found"
-and ident_sys_error = Ident.create_predef_exn "Sys_error"
-and ident_end_of_file = Ident.create_predef_exn "End_of_file"
-and ident_division_by_zero = Ident.create_predef_exn "Division_by_zero"
-and ident_stack_overflow = Ident.create_predef_exn "Stack_overflow"
-and ident_sys_blocked_io = Ident.create_predef_exn "Sys_blocked_io"
-and ident_assert_failure = Ident.create_predef_exn "Assert_failure"
+let ident_match_failure = ident_create_predef_exn "Match_failure"
+and ident_out_of_memory = ident_create_predef_exn "Out_of_memory"
+and ident_invalid_argument = ident_create_predef_exn "Invalid_argument"
+and ident_failure = ident_create_predef_exn "Failure"
+and ident_not_found = ident_create_predef_exn "Not_found"
+and ident_sys_error = ident_create_predef_exn "Sys_error"
+and ident_end_of_file = ident_create_predef_exn "End_of_file"
+and ident_division_by_zero = ident_create_predef_exn "Division_by_zero"
+and ident_stack_overflow = ident_create_predef_exn "Stack_overflow"
+and ident_sys_blocked_io = ident_create_predef_exn "Sys_blocked_io"
+and ident_assert_failure = ident_create_predef_exn "Assert_failure"
 and ident_undefined_recursive_module =
-        Ident.create_predef_exn "Undefined_recursive_module"
+        ident_create_predef_exn "Undefined_recursive_module"
 
 let path_match_failure = Pident ident_match_failure
 and path_assert_failure = Pident ident_assert_failure
 and path_undefined_recursive_module = Pident ident_undefined_recursive_module
 
+let decl_abstr =
+  {type_params = [];
+   type_arity = 0;
+   type_kind = Type_abstract;
+   type_loc = Location.none;
+   type_private = Asttypes.Public;
+   type_manifest = None;
+   type_variance = [];
+   type_newtype_level = None}
+
+let ident_false = ident_create "false"
+and ident_true = ident_create "true"
+and ident_void = ident_create "()"
+and ident_nil = ident_create "[]"
+and ident_cons = ident_create "::"
+and ident_none = ident_create "None"
+and ident_some = ident_create "Some"
 let build_initial_env add_type add_exception empty_env =
-  let decl_abstr =
-    {type_params = [];
-     type_arity = 0;
-     type_kind = Type_abstract;
-     type_private = Public;
-     type_manifest = None;
-     type_variance = []}
-  and decl_bool =
-    {type_params = [];
-     type_arity = 0;
-     type_kind = Type_variant(["false", []; "true", []]);
-     type_private = Public;
-     type_manifest = None;
-     type_variance = []}
+  let decl_bool =
+    {decl_abstr with
+     type_kind = Type_variant([ident_false, [], None; ident_true, [], None])}
   and decl_unit =
-    {type_params = [];
-     type_arity = 0;
-     type_kind = Type_variant(["()", []]);
-     type_private = Public;
-     type_manifest = None;
-     type_variance = []}
+    {decl_abstr with
+     type_kind = Type_variant([ident_void, [], None])}
   and decl_exn =
-    {type_params = [];
-     type_arity = 0;
-     type_kind = Type_variant [];
-     type_private = Public;
-     type_manifest = None;
-     type_variance = []}
+    {decl_abstr with
+     type_kind = Type_variant []}
   and decl_array =
     let tvar = newgenvar() in
-    {type_params = [tvar];
+    {decl_abstr with
+     type_params = [tvar];
      type_arity = 1;
-     type_kind = Type_abstract;
-     type_private = Public;
-     type_manifest = None;
-     type_variance = [true, true, true]}
+     type_variance = [Variance.full]}
   and decl_list =
     let tvar = newgenvar() in
-    {type_params = [tvar];
+    {decl_abstr with
+     type_params = [tvar];
      type_arity = 1;
      type_kind =
-       Type_variant(["[]", []; "::", [tvar; type_list tvar]]);
-     type_private = Public;
-     type_manifest = None;
-     type_variance = [true, false, false]}
+     Type_variant([ident_nil, [], None; ident_cons, [tvar; type_list tvar],
+                   None]);
+     type_variance = [Variance.covariant]}
   and decl_format6 =
-    {type_params = [
-       newgenvar(); newgenvar(); newgenvar();
-       newgenvar(); newgenvar(); newgenvar();
-     ];
+    let params = List.map newgenvar [();();();();();()] in
+    {decl_abstr with
+     type_params = params;
      type_arity = 6;
-     type_kind = Type_abstract;
-     type_private = Public;
-     type_manifest = None;
-     type_variance = [
-       true, true, true; true, true, true;
-       true, true, true; true, true, true;
-       true, true, true; true, true, true;
-     ]}
+     type_variance = List.map (fun _ -> Variance.full) params}
   and decl_option =
     let tvar = newgenvar() in
-    {type_params = [tvar];
+    {decl_abstr with
+     type_params = [tvar];
      type_arity = 1;
-     type_kind = Type_variant(["None", []; "Some", [tvar]]);
-     type_private = Public;
-     type_manifest = None;
-     type_variance = [true, false, false]}
+     type_kind = Type_variant([ident_none, [], None; ident_some, [tvar], None]);
+     type_variance = [Variance.covariant]}
   and decl_lazy_t =
     let tvar = newgenvar() in
-    {type_params = [tvar];
+    {decl_abstr with
+     type_params = [tvar];
      type_arity = 1;
-     type_kind = Type_abstract;
-     type_private = Public;
-     type_manifest = None;
-     type_variance = [true, false, false]}
+     type_variance = [Variance.covariant]}
   in
 
+  let add_exception id l =
+    add_exception id { exn_args = l; exn_loc = Location.none } in
   add_exception ident_match_failure
                          [newgenty (Ttuple[type_string; type_int; type_int])] (
   add_exception ident_out_of_memory [] (
@@ -206,4 +200,5 @@
    be defined in this file (above!) without breaking .cmi
    compatibility. *)
 
-let _ = Ident.set_current_time 999 
+let _ = Ident.set_current_time 999
+let builtin_idents = List.rev !builtin_idents
diff -Nru ocaml-3.12.1/typing/predef.mli ocaml-4.01.0/typing/predef.mli
--- ocaml-3.12.1/typing/predef.mli	2006-10-24 20:54:58.000000000 +0000
+++ ocaml-4.01.0/typing/predef.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: predef.mli 7702 2006-10-24 20:54:58Z weis $ *)
-
 (* Predefined type constructors (with special typing rules in typecore) *)
 
 open Types
@@ -63,3 +61,4 @@
 (* To initialize linker tables *)
 
 val builtin_values: (string * Ident.t) list
+val builtin_idents: (string * Ident.t) list
diff -Nru ocaml-3.12.1/typing/primitive.ml ocaml-4.01.0/typing/primitive.ml
--- ocaml-3.12.1/typing/primitive.ml	2008-07-24 05:35:22.000000000 +0000
+++ ocaml-4.01.0/typing/primitive.ml	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: primitive.ml 8930 2008-07-24 05:35:22Z frisch $ *)
-
 (* Description of primitive functions *)
 
 open Misc
diff -Nru ocaml-3.12.1/typing/primitive.mli ocaml-4.01.0/typing/primitive.mli
--- ocaml-3.12.1/typing/primitive.mli	2008-07-24 05:35:22.000000000 +0000
+++ ocaml-4.01.0/typing/primitive.mli	2012-10-15 17:50:56.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: primitive.mli 8930 2008-07-24 05:35:22Z frisch $ *)
-
 (* Description of primitive functions *)
 
 type description =
diff -Nru ocaml-3.12.1/typing/printtyp.ml ocaml-4.01.0/typing/printtyp.ml
--- ocaml-3.12.1/typing/printtyp.ml	2010-10-02 08:58:23.000000000 +0000
+++ ocaml-4.01.0/typing/printtyp.ml	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (* Xavier Leroy and Jerome Vouillon, projet Cristal, INRIA Rocquencourt*)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: printtyp.ml 10703 2010-10-02 08:58:23Z garrigue $ *)
-
 (* Printing functions *)
 
 open Misc
@@ -27,7 +25,7 @@
 (* Print a long identifier *)
 
 let rec longident ppf = function
-  | Lident s -> fprintf ppf "%s" s
+  | Lident s -> pp_print_string ppf s
   | Ldot(p, s) -> fprintf ppf "%a.%s" longident p s
   | Lapply(p1, p2) -> fprintf ppf "%a(%a)" longident p1 longident p2
 
@@ -43,7 +41,7 @@
   with Not_found ->
     unique_names := Ident.add id (Ident.unique_toplevel_name id) !unique_names
 
-let ident ppf id = fprintf ppf "%s" (ident_name id)
+let ident ppf id = pp_print_string ppf (ident_name id)
 
 (* Print a path *)
 
@@ -63,12 +61,23 @@
   | Pident id ->
       ident ppf id
   | Pdot(Pident id, s, pos) when Ident.same id ident_pervasive ->
-      fprintf ppf "%s" s
+      pp_print_string ppf s
   | Pdot(p, s, pos) ->
-      fprintf ppf "%a.%s" path p s
+      path ppf p;
+      pp_print_char ppf '.';
+      pp_print_string ppf s
   | Papply(p1, p2) ->
       fprintf ppf "%a(%a)" path p1 path p2
 
+let rec string_of_out_ident = function
+  | Oide_ident s -> s
+  | Oide_dot (id, s) -> String.concat "." [string_of_out_ident id; s]
+  | Oide_apply (id1, id2) ->
+      String.concat ""
+        [string_of_out_ident id1; "("; string_of_out_ident id2; ")"]
+
+let string_of_path p = string_of_out_ident (tree_of_path p)
+
 (* Print a recursive annotation *)
 
 let tree_of_rec = function
@@ -109,6 +118,10 @@
   | Mcons (priv, p, t1, t2, rem) -> p :: list_of_memo rem
   | Mlink rem -> list_of_memo !rem
 
+let print_name ppf = function
+    None -> fprintf ppf "None"
+  | Some name -> fprintf ppf "\"%s\"" name
+
 let visited = ref []
 let rec raw_type ppf ty =
   let ty = safe_repr [] ty in
@@ -119,7 +132,7 @@
   end
 and raw_type_list tl = raw_list raw_type tl
 and raw_type_desc ppf = function
-    Tvar -> fprintf ppf "Tvar"
+    Tvar name -> fprintf ppf "Tvar %a" print_name name
   | Tarrow(l,t1,t2,c) ->
       fprintf ppf "@[Tarrow(%s,@,%a,@,%a,@,%s)@]"
         l raw_type t1 raw_type t2
@@ -143,7 +156,7 @@
   | Tnil -> fprintf ppf "Tnil"
   | Tlink t -> fprintf ppf "@[<1>Tlink@,%a@]" raw_type t
   | Tsubst t -> fprintf ppf "@[<1>Tsubst@,%a@]" raw_type t
-  | Tunivar -> fprintf ppf "Tunivar"
+  | Tunivar name -> fprintf ppf "Tunivar %a" print_name name
   | Tpoly (t, tl) ->
       fprintf ppf "@[Tpoly(@,%a,@,%a)@]"
         raw_type t
@@ -183,32 +196,230 @@
   raw_type ppf t;
   visited := []
 
+let () = Btype.print_raw := raw_type_expr
+
+(* Normalize paths *)
+
+type param_subst = Id | Nth of int | Map of int list
+
+let compose l1 = function
+  | Id -> Map l1
+  | Map l2 -> Map (List.map (List.nth l1) l2)
+  | Nth n  -> Nth (List.nth l1 n)
+
+let apply_subst s1 tyl =
+  match s1 with
+    Nth n1 -> [List.nth tyl n1]
+  | Map l1 -> List.map (List.nth tyl) l1
+  | Id -> tyl
+
+type best_path = Paths of Path.t list | Best of Path.t
+
+let printing_env = ref Env.empty
+let printing_old = ref Env.empty
+let printing_pers = ref Concr.empty
+module Path2 = struct
+  include Path
+  let rec compare p1 p2 =
+    (* must ignore position when comparing paths *)
+    match (p1, p2) with
+      (Pdot(p1, s1, pos1), Pdot(p2, s2, pos2)) ->
+        let c = compare p1 p2 in
+        if c <> 0 then c else String.compare s1 s2
+    | (Papply(fun1, arg1), Papply(fun2, arg2)) ->
+        let c = compare fun1 fun2 in
+        if c <> 0 then c else compare arg1 arg2
+    | _ -> Pervasives.compare p1 p2
+end
+module PathMap = Map.Make(Path2)
+let printing_map = ref (Lazy.lazy_from_val PathMap.empty)
+
+let same_type t t' = repr t == repr t'
+
+let rec index l x =
+  match l with
+    [] -> raise Not_found
+  | a :: l -> if x == a then 0 else 1 + index l x
+
+let rec uniq = function
+    [] -> true
+  | a :: l -> not (List.memq a l) && uniq l
+
+let rec normalize_type_path ?(cache=false) env p =
+  try
+    let desc = Env.find_type p env in
+    if desc.type_private = Private || desc.type_newtype_level <> None then
+      (p, Id)
+    else match desc.type_manifest with
+      Some ty ->
+        let params = List.map repr desc.type_params in
+        begin match repr ty with
+          {desc = Tconstr (p1, tyl, _)} ->
+            let tyl = List.map repr tyl in
+            if List.length params = List.length tyl
+            && List.for_all2 (==) params tyl
+            then normalize_type_path ~cache env p1
+            else if cache || List.length params <= List.length tyl
+                 || not (uniq tyl) then (p, Id)
+            else
+              let l1 = List.map (index params) tyl in
+              let (p2, s2) = normalize_type_path ~cache env p1 in
+              (p2, compose l1 s2)
+        | ty ->
+            (p, Nth (index params ty))
+        end
+    | None -> (p, Id)
+  with
+    Not_found -> (p, Id)
+
+let rec path_size = function
+    Pident id ->
+      (let s = Ident.name id in if s <> "" && s.[0] = '_' then 10 else 1),
+      -Ident.binding_time id
+  | Pdot (p, _, _) ->
+      let (l, b) = path_size p in (1+l, b)
+  | Papply (p1, p2) ->
+      let (l, b) = path_size p1 in
+      (l + fst (path_size p2), b)
+
+let same_printing_env env =
+  let used_pers = Env.used_persistent () in
+  Env.same_types !printing_old env && Concr.equal !printing_pers used_pers
+
+let set_printing_env env =
+  printing_env := if !Clflags.real_paths then Env.empty else env;
+  if !printing_env == Env.empty || same_printing_env env then () else
+  begin
+    (* printf "Reset printing_map@."; *)
+    printing_old := env;
+    printing_pers := Env.used_persistent ();
+    printing_map := lazy begin
+      (* printf "Recompute printing_map.@."; *)
+      let map = ref PathMap.empty in
+      Env.iter_types
+        (fun p (p', decl) ->
+          let (p1, s1) = normalize_type_path env p' ~cache:true in
+          (* Format.eprintf "%a -> %a = %a@." path p path p' path p1 *)
+          if s1 = Id then
+          try
+            let r = PathMap.find p1 !map in
+            match !r with
+              Paths l -> r := Paths (p :: l)
+            | Best _  -> assert false
+          with Not_found ->
+            map := PathMap.add p1 (ref (Paths [p])) !map)
+        env;
+      !map
+    end
+  end
+
+let wrap_printing_env env f =
+  set_printing_env env;
+  try_finally f (fun () -> set_printing_env Env.empty)
+
+let is_unambiguous path env =
+  let l = Env.find_shadowed_types path env in
+  List.exists (Path.same path) l || (* concrete paths are ok *)
+  match l with
+    [] -> true
+  | p :: rem ->
+      (* allow also coherent paths:  *)
+      let normalize p = fst (normalize_type_path ~cache:true env p) in
+      let p' = normalize p in
+      List.for_all (fun p -> Path.same (normalize p) p') rem ||
+      (* also allow repeatedly defining and opening (for toplevel) *)
+      let id = lid_of_path p in
+      List.for_all (fun p -> lid_of_path p = id) rem &&
+      Path.same p (fst (Env.lookup_type id env))
+
+let rec get_best_path r =
+  match !r with
+    Best p' -> p'
+  | Paths [] -> raise Not_found
+  | Paths l ->
+      r := Paths [];
+      List.iter
+        (fun p ->
+          (* Format.eprintf "evaluating %a@." path p; *)
+          match !r with
+            Best p' when path_size p >= path_size p' -> ()
+          | _ -> if is_unambiguous p !printing_env then r := Best p)
+              (* else Format.eprintf "%a ignored as ambiguous@." path p *)
+        l;
+      get_best_path r
+
+let best_type_path p =
+  if !Clflags.real_paths || !printing_env == Env.empty
+  then (p, Id)
+  else
+    let (p', s) = normalize_type_path !printing_env p in
+    let p'' =
+      try get_best_path (PathMap.find  p' (Lazy.force !printing_map))
+      with Not_found -> p'
+    in
+    (* Format.eprintf "%a = %a -> %a@." path p path p' path p''; *)
+    (p'', s)
+
 (* Print a type expression *)
 
 let names = ref ([] : (type_expr * string) list)
 let name_counter = ref 0
+let named_vars = ref ([] : string list)
 
-let reset_names () = names := []; name_counter := 0
+let reset_names () = names := []; name_counter := 0; named_vars := []
+let add_named_var ty =
+  match ty.desc with
+    Tvar (Some name) | Tunivar (Some name) ->
+      if List.mem name !named_vars then () else
+      named_vars := name :: !named_vars
+  | _ -> ()
 
-let new_name () =
+let rec new_name () =
   let name =
     if !name_counter < 26
     then String.make 1 (Char.chr(97 + !name_counter))
     else String.make 1 (Char.chr(97 + !name_counter mod 26)) ^
            string_of_int(!name_counter / 26) in
   incr name_counter;
-  name
+  if List.mem name !named_vars
+  || List.exists (fun (_, name') -> name = name') !names
+  then new_name ()
+  else name
 
 let name_of_type t =
+  (* We've already been through repr at this stage, so t is our representative
+     of the union-find class. *)
   try List.assq t !names with Not_found ->
-    let name = new_name () in
-    names := (t, name) :: !names;
+    let name =
+      match t.desc with
+        Tvar (Some name) | Tunivar (Some name) ->
+          (* Some part of the type we've already printed has assigned another
+           * unification variable to that name. We want to keep the name, so try
+           * adding a number until we find a name that's not taken. *)
+          let current_name = ref name in
+          let i = ref 0 in
+          while List.exists (fun (_, name') -> !current_name = name') !names do
+            current_name := name ^ (string_of_int !i);
+            i := !i + 1;
+          done;
+          !current_name
+      | _ ->
+          (* No name available, create a new one *)
+          new_name ()
+    in
+    (* Exception for type declarations *)
+    if name <> "_" then names := (t, name) :: !names;
     name
 
 let check_name_of_type t = ignore(name_of_type t)
 
+let remove_names tyl =
+  let tyl = List.map repr tyl in
+  names := List.filter (fun (ty,_) -> not (List.memq ty tyl)) !names
+
+
 let non_gen_mark sch ty =
-  if sch && ty.desc = Tvar && ty.level <> generic_level then "_" else ""
+  if sch && is_Tvar ty && ty.level <> generic_level then "_" else ""
 
 let print_name_of_type sch ppf t =
   fprintf ppf "'%s%s" (non_gen_mark sch t) (name_of_type t)
@@ -223,9 +434,17 @@
 let is_aliased ty = List.memq (proxy ty) !aliased
 let add_alias ty =
   let px = proxy ty in
-  if not (is_aliased px) then aliased := px :: !aliased
+  if not (is_aliased px) then begin
+    aliased := px :: !aliased;
+    add_named_var px
+  end
+
 let aliasable ty =
-  match ty.desc with Tvar | Tunivar | Tpoly _ -> false | _ -> true
+  match ty.desc with
+    Tvar _ | Tunivar _ | Tpoly _ -> false
+  | Tconstr (p, _, _) ->
+      (match best_type_path p with (_, Nth _) -> false | _ -> true)
+  | _ -> true
 
 let namable_row row =
   row.row_name <> None &&
@@ -243,11 +462,14 @@
   if List.memq px visited && aliasable ty then add_alias px else
     let visited = px :: visited in
     match ty.desc with
-    | Tvar -> ()
+    | Tvar _ -> add_named_var ty
     | Tarrow(_, ty1, ty2, _) ->
         mark_loops_rec visited ty1; mark_loops_rec visited ty2
     | Ttuple tyl -> List.iter (mark_loops_rec visited) tyl
-    | Tconstr(_, tyl, _) | Tpackage (_, _, tyl) ->
+    | Tconstr(p, tyl, _) ->
+        let (p', s) = best_type_path p in
+        List.iter (mark_loops_rec visited) (apply_subst s tyl)
+    | Tpackage (_, _, tyl) ->
         List.iter (mark_loops_rec visited) tyl
     | Tvariant row ->
         if List.memq px !visited_objects then add_alias px else
@@ -288,7 +510,7 @@
     | Tpoly (ty, tyl) ->
         List.iter (fun t -> add_alias t) tyl;
         mark_loops_rec visited ty
-    | Tunivar -> ()
+    | Tunivar _ -> add_named_var ty
 
 let mark_loops ty =
   normalize_type Env.empty ty;
@@ -320,7 +542,7 @@
 
   let pr_typ () =
     match ty.desc with
-    | Tvar ->
+    | Tvar _ ->
         Otyp_var (is_non_gen sch ty, name_of_type ty)
     | Tarrow(l, ty1, ty2, _) ->
         let pr_arrow l ty1 ty2 =
@@ -340,7 +562,12 @@
     | Ttuple tyl ->
         Otyp_tuple (tree_of_typlist sch tyl)
     | Tconstr(p, tyl, abbrev) ->
-        Otyp_constr (tree_of_path p, tree_of_typlist sch tyl)
+        begin match best_type_path p with
+          (_, Nth n) -> tree_of_typexp sch (List.nth tyl n)
+        | (p', s) ->
+            let tyl' = apply_subst s tyl in
+            Otyp_constr (tree_of_path p', tree_of_typlist sch tyl')
+        end
     | Tvariant row ->
         let row = row_repr row in
         let fields =
@@ -358,7 +585,9 @@
         let all_present = List.length present = List.length fields in
         begin match row.row_name with
         | Some(p, tyl) when namable_row row ->
-            let id = tree_of_path p in
+            let (p', s) = best_type_path p in
+            assert (s = Id);
+            let id = tree_of_path p' in
             let args = tree_of_typlist sch tyl in
             if row.row_closed && all_present then
               Otyp_constr (id, args)
@@ -366,7 +595,7 @@
               let non_gen = is_non_gen sch px in
               let tags =
                 if all_present then None else Some (List.map fst present) in
-              Otyp_variant (non_gen, Ovar_name(tree_of_path p, args),
+              Otyp_variant (non_gen, Ovar_name(id, args),
                             row.row_closed, tags)
         | _ ->
             let non_gen =
@@ -377,26 +606,36 @@
             Otyp_variant (non_gen, Ovar_fields fields, row.row_closed, tags)
         end
     | Tobject (fi, nm) ->
-        tree_of_typobject sch fi nm
+        tree_of_typobject sch fi !nm
+    | Tnil | Tfield _ ->
+        tree_of_typobject sch ty None
     | Tsubst ty ->
         tree_of_typexp sch ty
-    | Tlink _ | Tnil | Tfield _ ->
+    | Tlink _ ->
         fatal_error "Printtyp.tree_of_typexp"
     | Tpoly (ty, []) ->
         tree_of_typexp sch ty
     | Tpoly (ty, tyl) ->
+        (*let print_names () =
+          List.iter (fun (_, name) -> prerr_string (name ^ " ")) !names;
+          prerr_string "; " in *)
         let tyl = List.map repr tyl in
-        (* let tyl = List.filter is_aliased tyl in *)
         if tyl = [] then tree_of_typexp sch ty else begin
           let old_delayed = !delayed in
+          (* Make the names delayed, so that the real type is
+             printed once when used as proxy *)
           List.iter add_delayed tyl;
           let tl = List.map name_of_type tyl in
           let tr = Otyp_poly (tl, tree_of_typexp sch ty) in
+          (* Forget names when we leave scope *)
+          remove_names tyl;
           delayed := old_delayed; tr
         end
-    | Tunivar ->
+    | Tunivar _ ->
         Otyp_var (false, name_of_type ty)
     | Tpackage (p, n, tyl) ->
+        let n =
+          List.map (fun li -> String.concat "." (Longident.flatten li)) n in
         Otyp_module (Path.name p, n, tree_of_typlist sch tyl)
   in
   if List.memq px !delayed then delayed := List.filter ((!=) px) !delayed;
@@ -419,7 +658,7 @@
   List.map (tree_of_typexp sch) tyl
 
 and tree_of_typobject sch fi nm =
-  begin match !nm with
+  begin match nm with
   | None ->
       let pr_fields fi =
         let (fields, rest) = flatten_fields fi in
@@ -431,26 +670,28 @@
                | _ -> l)
             fields [] in
         let sorted_fields =
-          Sort.list (fun (n, _) (n', _) -> n <= n') present_fields in
+          List.sort (fun (n, _) (n', _) -> compare n n') present_fields in
         tree_of_typfields sch rest sorted_fields in
       let (fields, rest) = pr_fields fi in
       Otyp_object (fields, rest)
   | Some (p, ty :: tyl) ->
       let non_gen = is_non_gen sch (repr ty) in
       let args = tree_of_typlist sch tyl in
-      Otyp_class (non_gen, tree_of_path p, args)
+      let (p', s) = best_type_path p in
+      assert (s = Id);
+      Otyp_class (non_gen, tree_of_path p', args)
   | _ ->
       fatal_error "Printtyp.tree_of_typobject"
   end
 
 and is_non_gen sch ty =
-    sch && ty.desc = Tvar && ty.level <> generic_level
+    sch && is_Tvar ty && ty.level <> generic_level
 
 and tree_of_typfields sch rest = function
   | [] ->
       let rest =
         match rest.desc with
-        | Tvar | Tunivar -> Some (is_non_gen sch rest)
+        | Tvar _ | Tunivar _ -> Some (is_non_gen sch rest)
         | Tconstr _ -> Some false
         | Tnil -> None
         | _ -> fatal_error "typfields (1)"
@@ -510,6 +751,17 @@
 
   let params = filter_params decl.type_params in
 
+  begin match decl.type_manifest with
+  | Some ty ->
+      let vars = free_variables ty in
+      List.iter
+        (function {desc = Tvar (Some "_")} as ty ->
+            if List.memq ty vars then ty.desc <- Tvar None
+          | _ -> ())
+        params
+  | None -> ()
+  end;
+
   List.iter add_alias params;
   List.iter mark_loops params;
   List.iter check_name_of_type (List.map proxy params);
@@ -533,9 +785,12 @@
   in
   begin match decl.type_kind with
   | Type_abstract -> ()
-  | Type_variant [] -> ()
   | Type_variant cstrs ->
-      List.iter (fun (_, args) -> List.iter mark_loops args) cstrs
+      List.iter
+        (fun (_, args,ret_type_opt) ->
+          List.iter mark_loops args;
+          may mark_loops ret_type_opt)
+        cstrs
   | Type_record(l, rep) ->
       List.iter (fun (_, _, ty) -> mark_loops ty) l
   end;
@@ -550,13 +805,17 @@
       match decl.type_kind with
         Type_abstract ->
           decl.type_manifest = None || decl.type_private = Private
-      | Type_variant _ | Type_record _ ->
+      | Type_record _ ->
           decl.type_private = Private
+      | Type_variant tll ->
+          decl.type_private = Private ||
+          List.exists (fun (_,_,ret) -> ret <> None) tll
     in
     let vari =
       List.map2
-        (fun ty (co,cn,ct) ->
-          if abstr || (repr ty).desc <> Tvar then (co,cn) else (true,true))
+        (fun ty v ->
+          if abstr || not (is_Tvar (repr ty)) then Variance.get_upper v
+          else (true,true))
         decl.type_params decl.type_variance
     in
     (Ident.name id,
@@ -587,11 +846,24 @@
   in
   (name, args, ty, priv, constraints)
 
-and tree_of_constructor (name, args) =
-  (name, tree_of_typlist false args)
+and tree_of_constructor (name, args, ret_type_opt) =
+  let name = Ident.name name in
+  if ret_type_opt = None then (name, tree_of_typlist false args, None) else
+  let nm = !names in
+  names := [];
+  let ret = may_map (tree_of_typexp false) ret_type_opt in
+  let args = tree_of_typlist false args in
+  names := nm;
+  (name, args, ret)
+
+
+and tree_of_constructor_ret =
+  function
+    | None -> None
+    | Some ret_type -> Some (tree_of_typexp false ret_type)
 
 and tree_of_label (name, mut, arg) =
-  (name, mut = Mutable, tree_of_typexp false arg)
+  (Ident.name name, mut = Mutable, tree_of_typexp false arg)
 
 let tree_of_type_declaration id decl rs =
   Osig_type (tree_of_type_decl id decl, tree_of_rec rs)
@@ -602,8 +874,8 @@
 (* Print an exception declaration *)
 
 let tree_of_exception_declaration id decl =
-  reset_and_mark_loops_list decl;
-  let tyl = tree_of_typlist false decl in
+  reset_and_mark_loops_list decl.exn_args;
+  let tyl = tree_of_typlist false decl.exn_args in
   Osig_exception (Ident.name id, tyl)
 
 let exception_declaration id ppf decl =
@@ -632,28 +904,30 @@
 
 let method_type (_, kind, ty) =
   match field_kind_repr kind, repr ty with
-    Fpresent, {desc=Tpoly(ty, _)} -> ty
-  | _       , ty                  -> ty
+    Fpresent, {desc=Tpoly(ty, tyl)} -> (ty, tyl)
+  | _       , ty                    -> (ty, [])
 
 let tree_of_metho sch concrete csil (lab, kind, ty) =
   if lab <> dummy_method then begin
     let kind = field_kind_repr kind in
     let priv = kind <> Fpresent in
     let virt = not (Concr.mem lab concrete) in
-    let ty = method_type (lab, kind, ty) in
-    Ocsg_method (lab, priv, virt, tree_of_typexp sch ty) :: csil
+    let (ty, tyl) = method_type (lab, kind, ty) in
+    let tty = tree_of_typexp sch ty in
+    remove_names tyl;
+    Ocsg_method (lab, priv, virt, tty) :: csil
   end
   else csil
 
 let rec prepare_class_type params = function
-  | Tcty_constr (p, tyl, cty) ->
+  | Cty_constr (p, tyl, cty) ->
       let sty = Ctype.self_type cty in
       if List.memq (proxy sty) !visited_objects
-      || List.exists (fun ty -> (repr ty).desc <> Tvar) params
+      || not (List.for_all is_Tvar params)
       || List.exists (deep_occur sty) tyl
       then prepare_class_type params cty
       else List.iter mark_loops tyl
-  | Tcty_signature sign ->
+  | Cty_signature sign ->
       let sty = repr sign.cty_self in
       (* Self may have a name *)
       let px = proxy sty in
@@ -662,23 +936,23 @@
       let (fields, _) =
         Ctype.flatten_fields (Ctype.object_fields sign.cty_self)
       in
-      List.iter (fun met -> mark_loops (method_type met)) fields;
+      List.iter (fun met -> mark_loops (fst (method_type met))) fields;
       Vars.iter (fun _ (_, _, ty) -> mark_loops ty) sign.cty_vars
-  | Tcty_fun (_, ty, cty) ->
+  | Cty_fun (_, ty, cty) ->
       mark_loops ty;
       prepare_class_type params cty
 
 let rec tree_of_class_type sch params =
   function
-  | Tcty_constr (p', tyl, cty) ->
+  | Cty_constr (p', tyl, cty) ->
       let sty = Ctype.self_type cty in
       if List.memq (proxy sty) !visited_objects
-      || List.exists (fun ty -> (repr ty).desc <> Tvar) params
+      || not (List.for_all is_Tvar params)
       then
         tree_of_class_type sch params cty
       else
         Octy_constr (tree_of_path p', tree_of_typlist true tyl)
-  | Tcty_signature sign ->
+  | Cty_signature sign ->
       let sty = repr sign.cty_self in
       let self_ty =
         if is_aliased sty then
@@ -710,7 +984,7 @@
         List.fold_left (tree_of_metho sch sign.cty_concr) csil fields
       in
       Octy_signature (self_ty, List.rev csil)
-  | Tcty_fun (l, ty, cty) ->
+  | Cty_fun (l, ty, cty) ->
       let lab = if !print_labels && l <> "" || is_optional l then l else "" in
       let ty =
        if is_optional l then
@@ -730,12 +1004,15 @@
   (match tree_of_typexp true param with
     Otyp_var (_, s) -> s
   | _ -> "?"),
-  if (repr param).desc = Tvar then (true, true) else variance
+  if is_Tvar (repr param) then (true, true) else variance
 
 let tree_of_class_params params =
   let tyl = tree_of_typlist true params in
   List.map (function Otyp_var (_, s) -> s | _ -> "?") tyl
 
+let class_variance =
+  List.map Variance.(fun v -> mem May_pos v, mem May_neg v)
+
 let tree_of_class_declaration id cl rs =
   let params = filter_params cl.cty_params in
 
@@ -751,7 +1028,7 @@
   let vir_flag = cl.cty_new = None in
   Osig_class
     (vir_flag, Ident.name id,
-     List.map2 tree_of_class_param params cl.cty_variance,
+     List.map2 tree_of_class_param params (class_variance cl.cty_variance),
      tree_of_class_type true params cl.cty_type,
      tree_of_rec rs)
 
@@ -784,7 +1061,7 @@
 
   Osig_class_type
     (virt, Ident.name id,
-     List.map2 tree_of_class_param params cl.clty_variance,
+     List.map2 tree_of_class_param params (class_variance cl.clty_variance),
      tree_of_class_type true params cl.clty_type,
      tree_of_rec rs)
 
@@ -793,43 +1070,91 @@
 
 (* Print a module type *)
 
+let wrap_env fenv ftree arg =
+  let env = !printing_env in
+  set_printing_env (fenv env);
+  let tree = ftree arg in
+  set_printing_env env;
+  tree
+
+let filter_rem_sig item rem =
+  match item, rem with
+  | Sig_class _, ctydecl :: tydecl1 :: tydecl2 :: rem ->
+      ([ctydecl; tydecl1; tydecl2], rem)
+  | Sig_class_type _, tydecl1 :: tydecl2 :: rem ->
+      ([tydecl1; tydecl2], rem)
+  | _ ->
+      ([], rem)
+
+let dummy =
+  { type_params = []; type_arity = 0; type_kind = Type_abstract;
+    type_private = Public; type_manifest = None; type_variance = [];
+    type_newtype_level = None; type_loc = Location.none; }
+
+let hide_rec_items = function
+  | Sig_type(id, decl, rs) ::rem
+    when rs <> Trec_next && not !Clflags.real_paths ->
+      let rec get_ids = function
+          Sig_type (id, _, Trec_next) :: rem ->
+            id :: get_ids rem
+        | _ -> []
+      in
+      let ids = id :: get_ids rem in
+      set_printing_env
+        (List.fold_right
+           (fun id -> Env.add_type (Ident.rename id) dummy)
+           ids !printing_env)
+  | _ -> ()
+
 let rec tree_of_modtype = function
-  | Tmty_ident p ->
+  | Mty_ident p ->
       Omty_ident (tree_of_path p)
-  | Tmty_signature sg ->
+  | Mty_signature sg ->
       Omty_signature (tree_of_signature sg)
-  | Tmty_functor(param, ty_arg, ty_res) ->
+  | Mty_functor(param, ty_arg, ty_res) ->
       Omty_functor
-        (Ident.name param, tree_of_modtype ty_arg, tree_of_modtype ty_res)
+        (Ident.name param, tree_of_modtype ty_arg,
+         wrap_env (Env.add_module param ty_arg) tree_of_modtype ty_res)
 
-and tree_of_signature = function
-  | [] -> []
-  | Tsig_value(id, decl) :: rem ->
-      tree_of_value_description id decl :: tree_of_signature rem
-  | Tsig_type(id, _, _) :: rem when is_row_name (Ident.name id) ->
-      tree_of_signature rem
-  | Tsig_type(id, decl, rs) :: rem ->
-      Osig_type(tree_of_type_decl id decl, tree_of_rec rs) ::
-      tree_of_signature rem
-  | Tsig_exception(id, decl) :: rem ->
-      tree_of_exception_declaration id decl :: tree_of_signature rem
-  | Tsig_module(id, mty, rs) :: rem ->
-      Osig_module (Ident.name id, tree_of_modtype mty, tree_of_rec rs) ::
-      tree_of_signature rem
-  | Tsig_modtype(id, decl) :: rem ->
-      tree_of_modtype_declaration id decl :: tree_of_signature rem
-  | Tsig_class(id, decl, rs) :: ctydecl :: tydecl1 :: tydecl2 :: rem ->
-      tree_of_class_declaration id decl rs :: tree_of_signature rem
-  | Tsig_cltype(id, decl, rs) :: tydecl1 :: tydecl2 :: rem ->
-      tree_of_cltype_declaration id decl rs :: tree_of_signature rem
-  | _ ->
-      assert false
+and tree_of_signature sg =
+  wrap_env (fun env -> env) (tree_of_signature_rec !printing_env) sg
+
+and tree_of_signature_rec env' = function
+    [] -> []
+  | item :: rem ->
+      begin match item with
+        Sig_type (_, _, rs) when rs <> Trec_next -> ()
+      | _ -> set_printing_env env'
+      end;
+      let (sg, rem) = filter_rem_sig item rem in
+      let trees =
+        match item with
+        | Sig_value(id, decl) ->
+            [tree_of_value_description id decl]
+        | Sig_type(id, _, _) when is_row_name (Ident.name id) ->
+            []
+        | Sig_type(id, decl, rs) ->
+            hide_rec_items (item :: rem);
+            [Osig_type(tree_of_type_decl id decl, tree_of_rec rs)]
+        | Sig_exception(id, decl) ->
+            [tree_of_exception_declaration id decl]
+        | Sig_module(id, mty, rs) ->
+            [Osig_module (Ident.name id, tree_of_modtype mty, tree_of_rec rs)]
+        | Sig_modtype(id, decl) ->
+            [tree_of_modtype_declaration id decl]
+        | Sig_class(id, decl, rs) ->
+            [tree_of_class_declaration id decl rs]
+        | Sig_class_type(id, decl, rs) ->
+            [tree_of_cltype_declaration id decl rs]
+      in
+      let env' = Env.add_signature (item :: sg) env' in
+      trees @ tree_of_signature_rec env' rem
 
 and tree_of_modtype_declaration id decl =
   let mty =
     match decl with
-    | Tmodtype_abstract -> Omty_abstract
-    | Tmodtype_manifest mty -> tree_of_modtype mty
+    | Modtype_abstract -> Omty_abstract
+    | Modtype_manifest mty -> tree_of_modtype mty
   in
   Osig_modtype (Ident.name id, mty)
 
@@ -850,11 +1175,32 @@
 
 (* Print an unification error *)
 
+let same_path t t' =
+  let t = repr t and t' = repr t' in
+  t == t' ||
+  match t.desc, t'.desc with
+    Tconstr(p,tl,_), Tconstr(p',tl',_) ->
+      let (p1, s1) = best_type_path p and (p2, s2)  = best_type_path p' in
+      begin match s1, s2 with
+        Nth n1, Nth n2 when n1 = n2 -> true
+      | (Id | Map _), (Id | Map _) when Path.same p1 p2 ->
+          let tl = apply_subst s1 tl and tl' = apply_subst s2 tl' in
+          List.length tl = List.length tl' &&
+          List.for_all2 same_type tl tl'
+      | _ -> false
+      end
+  | _ ->
+      false
+
 let type_expansion t ppf t' =
-  if t == t' then type_expr ppf t else
+  if same_path t t' then type_expr ppf t else
   let t' = if proxy t == proxy t' then unalias t' else t' in
   fprintf ppf "@[<2>%a@ =@ %a@]" type_expr t type_expr t'
 
+let type_path_expansion tp ppf tp' =
+  if Path.same tp tp' then path ppf tp else
+  fprintf ppf "@[<2>%a@ =@ %a@]" path tp path tp'
+
 let rec trace fst txt ppf = function
   | (t1, t1') :: (t2, t2') :: rem ->
       if not fst then fprintf ppf "@,";
@@ -863,26 +1209,38 @@
        (trace false txt) rem
   | _ -> ()
 
-let rec filter_trace = function
+let rec filter_trace keep_last = function
+  | (_, t1') :: (_, t2') :: [] when is_Tvar t1' || is_Tvar t2' ->
+      []
   | (t1, t1') :: (t2, t2') :: rem ->
-      let rem' = filter_trace rem in
-      if t1 == t1' && t2 == t2'
+      let rem' = filter_trace keep_last rem in
+      if is_constr_row t1' || is_constr_row t2'
+      || same_path t1 t1' && same_path t2 t2' && not (keep_last && rem' = [])
       then rem'
       else (t1, t1') :: (t2, t2') :: rem'
   | _ -> []
 
+let rec type_path_list ppf = function
+  | [tp, tp'] -> type_path_expansion tp ppf tp'
+  | (tp, tp') :: rem ->
+      fprintf ppf "%a@;<2 0>%a"
+        (type_path_expansion tp) tp'
+        type_path_list rem
+  | [] -> ()
+
 (* Hide variant name and var, to force printing the expanded type *)
 let hide_variant_name t =
   match repr t with
   | {desc = Tvariant row} as t when (row_repr row).row_name <> None ->
       newty2 t.level
         (Tvariant {(row_repr row) with row_name = None;
-                   row_more = newty2 (row_more row).level Tvar})
+                   row_more = newvar2 (row_more row).level})
   | _ -> t
 
 let prepare_expansion (t, t') =
   let t' = hide_variant_name t' in
-  mark_loops t; if t != t' then mark_loops t';
+  mark_loops t;
+  if not (same_path t t') then mark_loops t';
   (t, t')
 
 let may_prepare_expansion compact (t, t') =
@@ -899,11 +1257,11 @@
 
 let has_explanation unif t3 t4 =
   match t3.desc, t4.desc with
-    Tfield _, _ | _, Tfield _
-  | Tunivar, Tvar | Tvar, Tunivar
+    Tfield _, (Tnil|Tconstr _) | (Tnil|Tconstr _), Tfield _
+  | Tnil, Tconstr _ | Tconstr _, Tnil
+  | _, Tvar _ | Tvar _, _
   | Tvariant _, Tvariant _ -> true
-  | Tconstr (p, _, _), Tvar | Tvar, Tconstr (p, _, _) ->
-      unif && min t3.level t4.level < Path.binding_time p
+  | Tfield (l,_,_,{desc=Tnil}), Tfield (l',_,_,{desc=Tnil}) -> l = l'
   | _ -> false
 
 let rec mismatch unif = function
@@ -918,33 +1276,46 @@
 
 let explanation unif t3 t4 ppf =
   match t3.desc, t4.desc with
-  | Tfield _, Tvar | Tvar, Tfield _ ->
+  | Ttuple [], Tvar _ | Tvar _, Ttuple [] ->
       fprintf ppf "@,Self type cannot escape its class"
-  | Tconstr (p, _, _), Tvar
+  | Tconstr (p, tl, _), Tvar _
     when unif && t4.level < Path.binding_time p ->
       fprintf ppf
         "@,@[The type constructor@;<1 2>%a@ would escape its scope@]"
         path p
-  | Tvar, Tconstr (p, _, _)
+  | Tvar _, Tconstr (p, tl, _)
     when unif && t3.level < Path.binding_time p ->
       fprintf ppf
         "@,@[The type constructor@;<1 2>%a@ would escape its scope@]"
         path p
-  | Tvar, Tunivar | Tunivar, Tvar ->
+  | Tvar _, Tunivar _ | Tunivar _, Tvar _ ->
       fprintf ppf "@,The universal variable %a would escape its scope"
-        type_expr (if t3.desc = Tunivar then t3 else t4)
+        type_expr (if is_Tunivar t3 then t3 else t4)
+  | Tvar _, _ | _, Tvar _ ->
+      let t, t' = if is_Tvar t3 then (t3, t4) else (t4, t3) in
+      if occur_in Env.empty t t' then
+        fprintf ppf "@,@[The type variable %a occurs inside@ %a@]"
+          type_expr t type_expr t'
+      else
+        fprintf ppf "@,@[This instance of %a is ambiguous:@ %s@]"
+          type_expr t'
+          "it would escape the scope of its equation"
   | Tfield (lab, _, _, _), _
   | _, Tfield (lab, _, _, _) when lab = dummy_method ->
       fprintf ppf
         "@,Self type cannot be unified with a closed object type"
-  | Tfield (l, _, _, _), Tfield (l', _, _, _) when l = l' ->
+  | Tfield (l,_,_,{desc=Tnil}), Tfield (l',_,_,{desc=Tnil}) when l = l' ->
       fprintf ppf "@,Types for method %s are incompatible" l
-  | _, Tfield (l, _, _, _) ->
+  | (Tnil|Tconstr _), Tfield (l, _, _, _) ->
       fprintf ppf
         "@,@[The first object type has no method %s@]" l
-  | Tfield (l, _, _, _), _ ->
+  | Tfield (l, _, _, _), (Tnil|Tconstr _) ->
       fprintf ppf
         "@,@[The second object type has no method %s@]" l
+  | Tnil, Tconstr _ | Tconstr _, Tnil ->
+      fprintf ppf
+        "@,@[The %s object type has an abstract row, it cannot be closed@]"
+        (if t4.desc = Tnil then "first" else "second")
   | Tvariant row1, Tvariant row2 ->
       let row1 = row_repr row1 and row2 = row_repr row2 in
       begin match
@@ -985,7 +1356,8 @@
 
 let type_same_name t1 t2 =
   match (repr t1).desc, (repr t2).desc with
-    Tconstr (p1, _, _), Tconstr (p2, _, _) -> path_same_name p1 p2
+    Tconstr (p1, _, _), Tconstr (p2, _, _) ->
+      path_same_name (fst (best_type_path p1)) (fst (best_type_path p2))
   | _ -> ()
 
 let rec trace_same_names = function
@@ -1002,7 +1374,7 @@
   | [] | _ :: [] -> assert false
   | t1 :: t2 :: tr ->
     try
-      let tr = filter_trace tr in
+      let tr = filter_trace (mis = None) tr in
       let t1, t1' = may_prepare_expansion (tr = []) t1
       and t2, t2' = may_prepare_expansion (tr = []) t2 in
       print_labels := not !Clflags.classic;
@@ -1022,28 +1394,55 @@
       print_labels := true;
       raise exn
 
-let report_unification_error ppf tr txt1 txt2 =
-  unification_error true tr txt1 ppf txt2;;
+let report_unification_error ppf env ?(unif=true)
+    tr txt1 txt2 =
+  wrap_printing_env env (fun () -> unification_error unif tr txt1 ppf txt2)
+;;
 
-let trace fst txt ppf tr =
+let trace fst keep_last txt ppf tr =
   print_labels := not !Clflags.classic;
   trace_same_names tr;
   try match tr with
     t1 :: t2 :: tr' ->
-      if fst then trace fst txt ppf (t1 :: t2 :: filter_trace tr')
-      else trace fst txt ppf (filter_trace tr);
+      if fst then trace fst txt ppf (t1 :: t2 :: filter_trace keep_last tr')
+      else trace fst txt ppf (filter_trace keep_last tr);
       print_labels := true
   | _ -> ()
   with exn ->
     print_labels := true;
     raise exn
 
-let report_subtyping_error ppf tr1 txt1 tr2 =
-  reset ();
-  let tr1 = List.map prepare_expansion tr1
-  and tr2 = List.map prepare_expansion tr2 in
-  trace true txt1 ppf tr1;
-  if tr2 = [] then () else
-  let mis = mismatch true tr2 in
-  trace false "is not compatible with type" ppf tr2;
-  explanation true mis ppf
+let report_subtyping_error ppf env tr1 txt1 tr2 =
+  wrap_printing_env env (fun () ->
+    reset ();
+    let tr1 = List.map prepare_expansion tr1
+    and tr2 = List.map prepare_expansion tr2 in
+    fprintf ppf "@[%a" (trace true (tr2 = []) txt1) tr1;
+    if tr2 = [] then fprintf ppf "@]" else
+    let mis = mismatch true tr2 in
+    fprintf ppf "%a%t@]"
+      (trace false (mis = None) "is not compatible with type") tr2
+      (explanation true mis))
+
+let report_ambiguous_type_error ppf env (tp0, tp0') tpl txt1 txt2 txt3 =
+  wrap_printing_env env (fun () ->
+    reset ();
+    List.iter
+      (fun (tp, tp') -> path_same_name tp0 tp; path_same_name tp0' tp')
+      tpl;
+    match tpl with
+      [] -> assert false
+    | [tp, tp'] ->
+        fprintf ppf
+          "@[%t@;<1 2>%a@ \
+             %t@;<1 2>%a\
+           @]"
+          txt1 (type_path_expansion tp) tp'
+          txt3 (type_path_expansion tp0) tp0'
+    | _ ->
+        fprintf ppf
+          "@[%t@;<1 2>@[%a@]\
+             @ %t@;<1 2>%a\
+           @]"
+          txt2 type_path_list tpl
+          txt3 (type_path_expansion tp0) tp0')
diff -Nru ocaml-3.12.1/typing/printtyp.mli ocaml-4.01.0/typing/printtyp.mli
--- ocaml-3.12.1/typing/printtyp.mli	2006-04-16 23:28:22.000000000 +0000
+++ ocaml-4.01.0/typing/printtyp.mli	2013-07-23 14:48:47.000000000 +0000
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                                OCaml                                *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -10,8 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: printtyp.mli 7382 2006-04-16 23:28:22Z doligez $ *)
-
 (* Printing functions *)
 
 open Format
@@ -22,7 +20,13 @@
 val ident: formatter -> Ident.t -> unit
 val tree_of_path: Path.t -> out_ident
 val path: formatter -> Path.t -> unit
+val string_of_path: Path.t -> string
 val raw_type_expr: formatter -> type_expr -> unit
+
+val wrap_printing_env: Env.t -> (unit -> 'a) -> 'a
+    (* Call the function using the environment for type path shortening *)
+    (* This affects all the printing functions below *)
+
 val reset: unit -> unit
 val mark_loops: type_expr -> unit
 val reset_and_mark_loops: type_expr -> unit
@@ -38,31 +42,42 @@
 (* Fin Maxence *)
 val tree_of_value_description: Ident.t -> value_description -> out_sig_item
 val value_description: Ident.t -> formatter -> value_description -> unit
-val tree_of_type_declaration: Ident.t -> type_declaration -> rec_status -> out_sig_item
+val tree_of_type_declaration:
+    Ident.t -> type_declaration -> rec_status -> out_sig_item
 val type_declaration: Ident.t -> formatter -> type_declaration -> unit
-val tree_of_exception_declaration: Ident.t -> exception_declaration -> out_sig_item
-val exception_declaration: Ident.t -> formatter -> exception_declaration -> unit
+val tree_of_exception_declaration:
+    Ident.t -> exception_declaration -> out_sig_item
+val exception_declaration:
+    Ident.t -> formatter -> exception_declaration -> unit
 val tree_of_module: Ident.t -> module_type -> rec_status -> out_sig_item
 val modtype: formatter -> module_type -> unit
 val signature: formatter -> signature -> unit
-val tree_of_modtype_declaration: Ident.t -> modtype_declaration -> out_sig_item
+val tree_of_modtype_declaration:
+    Ident.t -> modtype_declaration -> out_sig_item
+val tree_of_signature: Types.signature -> out_sig_item list
+val tree_of_typexp: bool -> type_expr -> out_type
 val modtype_declaration: Ident.t -> formatter -> modtype_declaration -> unit
 val class_type: formatter -> class_type -> unit
-val tree_of_class_declaration: Ident.t -> class_declaration -> rec_status -> out_sig_item
+val tree_of_class_declaration:
+    Ident.t -> class_declaration -> rec_status -> out_sig_item
 val class_declaration: Ident.t -> formatter -> class_declaration -> unit
-val tree_of_cltype_declaration: Ident.t -> cltype_declaration -> rec_status -> out_sig_item
-val cltype_declaration: Ident.t -> formatter -> cltype_declaration -> unit
+val tree_of_cltype_declaration:
+    Ident.t -> class_type_declaration -> rec_status -> out_sig_item
+val cltype_declaration: Ident.t -> formatter -> class_type_declaration -> unit
 val type_expansion: type_expr -> Format.formatter -> type_expr -> unit
 val prepare_expansion: type_expr * type_expr -> type_expr * type_expr
-val trace: bool -> string -> formatter -> (type_expr * type_expr) list -> unit
-val unification_error:
-    bool -> (type_expr * type_expr) list ->
-    (formatter -> unit) -> formatter -> (formatter -> unit) ->
-    unit
+val trace:
+    bool -> bool-> string -> formatter -> (type_expr * type_expr) list -> unit
 val report_unification_error:
-    formatter -> (type_expr * type_expr) list ->
+    formatter -> Env.t -> ?unif:bool -> (type_expr * type_expr) list ->
     (formatter -> unit) -> (formatter -> unit) ->
     unit
 val report_subtyping_error:
-    formatter -> (type_expr * type_expr) list ->
+    formatter -> Env.t -> (type_expr * type_expr) list ->
     string -> (type_expr * type_expr) list -> unit
+val report_ambiguous_type_error:
+    formatter -> Env.t -> (Path.t * Path.t) -> (Path.t * Path.t) list ->
+    (formatter -> unit) -> (formatter -> unit) -> (formatter -> unit) -> unit
+
+(* for toploop *)
+val hide_rec_items: signature_item list -> unit
diff -Nru ocaml-3.12.1/typing/printtyped.ml ocaml-4.01.0/typing/printtyped.ml
--- ocaml-3.12.1/typing/printtyped.ml	1970-01-01 00:00:00.000000000 +0000
+++ ocaml-4.01.0/typing/printtyped.ml	2013-05-16 13:34:53.000000000 +0000
@@ -0,0 +1,763 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                  Fabrice Le Fessant, INRIA Saclay                   *)
+(*                                                                     *)
+(*  Copyright 1999 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Tublic License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+open Asttypes;;
+open Format;;
+open Lexing;;
+open Location;;
+open Typedtree;;
+
+let fmt_position f l =
+  if l.pos_lnum = -1
+  then fprintf f "%s[%d]" l.pos_fname l.pos_cnum
+  else fprintf f "%s[%d,%d+%d]" l.pos_fname l.pos_lnum l.pos_bol
+               (l.pos_cnum - l.pos_bol)
+;;
+
+let fmt_location f loc =
+  fprintf f "(%a..%a)" fmt_position loc.loc_start fmt_position loc.loc_end;
+  if loc.loc_ghost then fprintf f " ghost";
+;;
+
+let rec fmt_longident_aux f x =
+  match x with
+  | Longident.Lident (s) -> fprintf f "%s" s;
+  | Longident.Ldot (y, s) -> fprintf f "%a.%s" fmt_longident_aux y s;
+  | Longident.Lapply (y, z) ->
+      fprintf f "%a(%a)" fmt_longident_aux y fmt_longident_aux z;
+;;
+
+let fmt_longident_noloc f x = fprintf f "\"%a\"" fmt_longident_aux x;;
+let fmt_longident f x = fprintf f "\"%a\"" fmt_longident_aux x.txt;;
+
+let fmt_ident = Ident.print
+
+let rec fmt_path_aux f x =
+  match x with
+  | Path.Pident (s) -> fprintf f "%a" fmt_ident s;
+  | Path.Pdot (y, s, _pos) -> fprintf f "%a.%s" fmt_path_aux y s;
+  | Path.Papply (y, z) ->
+      fprintf f "%a(%a)" fmt_path_aux y fmt_path_aux z;
+;;
+
+let fmt_path f x = fprintf f "\"%a\"" fmt_path_aux x;;
+let fmt_path_loc f x = fprintf f "\"%a\"" fmt_path_aux x.txt;;
+
+let fmt_constant f x =
+  match x with
+  | Const_int (i) -> fprintf f "Const_int %d" i;
+  | Const_char (c) -> fprintf f "Const_char %02x" (Char.code c);
+  | Const_string (s) -> fprintf f "Const_string %S" s;
+  | Const_float (s) -> fprintf f "Const_float %s" s;
+  | Const_int32 (i) -> fprintf f "Const_int32 %ld" i;
+  | Const_int64 (i) -> fprintf f "Const_int64 %Ld" i;
+  | Const_nativeint (i) -> fprintf f "Const_nativeint %nd" i;
+;;
+
+let fmt_mutable_flag f x =
+  match x with
+  | Immutable -> fprintf f "Immutable";
+  | Mutable -> fprintf f "Mutable";
+;;
+
+let fmt_virtual_flag f x =
+  match x with
+  | Virtual -> fprintf f "Virtual";
+  | Concrete -> fprintf f "Concrete";
+;;
+
+let fmt_override_flag f x =
+  match x with
+  | Override -> fprintf f "Override";
+  | Fresh -> fprintf f "Fresh";
+;;
+
+let fmt_rec_flag f x =
+  match x with
+  | Nonrecursive -> fprintf f "Nonrec";
+  | Recursive -> fprintf f "Rec";
+  | Default -> fprintf f "Default";
+;;
+
+let fmt_direction_flag f x =
+  match x with
+  | Upto -> fprintf f "Up";
+  | Downto -> fprintf f "Down";
+;;
+
+let fmt_private_flag f x =
+  match x with
+  | Public -> fprintf f "Public";
+  | Private -> fprintf f "Private";
+;;
+
+let line i f s (*...*) =
+  fprintf f "%s" (String.make (2*i) ' ');
+  fprintf f s (*...*)
+;;
+
+let list i f ppf l =
+  match l with
+  | [] -> line i ppf "[]\n";
+  | _ :: _ ->
+     line i ppf "[\n";
+     List.iter (f (i+1) ppf) l;
+     line i ppf "]\n";
+;;
+
+let option i f ppf x =
+  match x with
+  | None -> line i ppf "None\n";
+  | Some x ->
+      line i ppf "Some\n";
+      f (i+1) ppf x;
+;;
+
+let longident i ppf li = line i ppf "%a\n" fmt_longident li;;
+let path i ppf li = line i ppf "%a\n" fmt_path li;;
+let ident i ppf li = line i ppf "%a\n" fmt_ident li;;
+let string i ppf s = line i ppf "\"%s\"\n" s;;
+let string_loc i ppf s = line i ppf "\"%s\"\n" s.txt;;
+let bool i ppf x = line i ppf "%s\n" (string_of_bool x);;
+let label i ppf x = line i ppf "label=\"%s\"\n" x;;
+
+let rec core_type i ppf x =
+  line i ppf "core_type %a\n" fmt_location x.ctyp_loc;
+  let i = i+1 in
+  match x.ctyp_desc with
+  | Ttyp_any -> line i ppf "Ptyp_any\n";
+  | Ttyp_var (s) -> line i ppf "Ptyp_var %s\n" s;
+  | Ttyp_arrow (l, ct1, ct2) ->
+      line i ppf "Ptyp_arrow\n";
+      string i ppf l;
+      core_type i ppf ct1;
+      core_type i ppf ct2;
+  | Ttyp_tuple l ->
+      line i ppf "Ptyp_tuple\n";
+      list i core_type ppf l;
+  | Ttyp_constr (li, _, l) ->
+      line i ppf "Ptyp_constr %a\n" fmt_path li;
+      list i core_type ppf l;
+  | Ttyp_variant (l, closed, low) ->
+      line i ppf "Ptyp_variant closed=%s\n" (string_of_bool closed);
+      list i label_x_bool_x_core_type_list ppf l;
+      option i (fun i -> list i string) ppf low
+  | Ttyp_object (l) ->
+      line i ppf "Ptyp_object\n";
+      list i core_field_type ppf l;
+  | Ttyp_class (li, _, l, low) ->
+      line i ppf "Ptyp_class %a\n" fmt_path li;
+      list i core_type ppf l;
+      list i string ppf low
+  | Ttyp_alias (ct, s) ->
+      line i ppf "Ptyp_alias \"%s\"\n" s;
+      core_type i ppf ct;
+  | Ttyp_poly (sl, ct) ->
+      line i ppf "Ptyp_poly%a\n"
+        (fun ppf -> List.iter (fun x -> fprintf ppf " '%s" x)) sl;
+      core_type i ppf ct;
+  | Ttyp_package { pack_name = s; pack_fields = l } ->
+      line i ppf "Ptyp_package %a\n" fmt_path s;
+      list i package_with ppf l;
+
+and package_with i ppf (s, t) =
+  line i ppf "with type %a\n" fmt_longident s;
+  core_type i ppf t
+
+and core_field_type i ppf x =
+  line i ppf "core_field_type %a\n" fmt_location x.field_loc;
+  let i = i+1 in
+  match x.field_desc with
+  | Tcfield (s, ct) ->
+      line i ppf "Pfield \"%s\"\n" s;
+      core_type i ppf ct;
+  | Tcfield_var -> line i ppf "Pfield_var\n";
+
+and pattern i ppf x =
+  line i ppf "pattern %a\n" fmt_location x.pat_loc;
+  let i = i+1 in
+  match x.pat_extra with
+    | (Tpat_unpack, _) :: rem ->
+        line i ppf "Tpat_unpack\n";
+        pattern i ppf { x with pat_extra = rem }
+    | (Tpat_constraint cty, _) :: rem ->
+        line i ppf "Tpat_constraint\n";
+        core_type i ppf cty;
+        pattern i ppf { x with pat_extra = rem }
+    | (Tpat_type (id, _), _) :: rem ->
+        line i ppf "Tpat_type %a\n" fmt_path id;
+        pattern i ppf { x with pat_extra = rem }
+    | [] ->
+  match x.pat_desc with
+  | Tpat_any -> line i ppf "Ppat_any\n";
+  | Tpat_var (s,_) -> line i ppf "Ppat_var \"%a\"\n" fmt_ident s;
+  | Tpat_alias (p, s,_) ->
+      line i ppf "Ppat_alias \"%a\"\n" fmt_ident s;
+      pattern i ppf p;
+  | Tpat_constant (c) -> line i ppf "Ppat_constant %a\n" fmt_constant c;
+  | Tpat_tuple (l) ->
+      line i ppf "Ppat_tuple\n";
+      list i pattern ppf l;
+  | Tpat_construct (li, _, po, explicity_arity) ->
+      line i ppf "Ppat_construct %a\n" fmt_longident li;
+      list i pattern ppf po;
+      bool i ppf explicity_arity;
+  | Tpat_variant (l, po, _) ->
+      line i ppf "Ppat_variant \"%s\"\n" l;
+      option i pattern ppf po;
+  | Tpat_record (l, c) ->
+      line i ppf "Ppat_record\n";
+      list i longident_x_pattern ppf l;
+  | Tpat_array (l) ->
+      line i ppf "Ppat_array\n";
+      list i pattern ppf l;
+  | Tpat_or (p1, p2, _) ->
+      line i ppf "Ppat_or\n";
+      pattern i ppf p1;
+      pattern i ppf p2;
+  | Tpat_lazy p ->
+      line i ppf "Ppat_lazy\n";
+      pattern i ppf p;
+
+and expression_extra i ppf x =
+  match x with
+  | Texp_constraint (cto1, cto2) ->
+      line i ppf "Pexp_constraint\n";
+      option i core_type ppf cto1;
+      option i core_type ppf cto2;
+  | Texp_open (ovf, m, _, _) ->
+      line i ppf "Pexp_open %a \"%a\"\n" fmt_override_flag ovf fmt_path m;
+  | Texp_poly cto ->
+      line i ppf "Pexp_poly\n";
+      option i core_type ppf cto;
+  | Texp_newtype s ->
+      line i ppf "Pexp_newtype \"%s\"\n" s;
+
+and expression i ppf x =
+  line i ppf "expression %a\n" fmt_location x.exp_loc;
+  let i =
+    List.fold_left (fun i (extra,_) -> expression_extra i ppf extra; i+1)
+      (i+1) x.exp_extra
+  in
+  match x.exp_desc with
+  | Texp_ident (li,_,_) -> line i ppf "Pexp_ident %a\n" fmt_path li;
+  | Texp_instvar (_, li,_) -> line i ppf "Pexp_instvar %a\n" fmt_path li;
+  | Texp_constant (c) -> line i ppf "Pexp_constant %a\n" fmt_constant c;
+  | Texp_let (rf, l, e) ->
+      line i ppf "Pexp_let %a\n" fmt_rec_flag rf;
+      list i pattern_x_expression_def ppf l;
+      expression i ppf e;
+  | Texp_function (p, l, _partial) ->
+      line i ppf "Pexp_function \"%s\"\n" p;
+(*      option i expression ppf eo; *)
+      list i pattern_x_expression_case ppf l;
+  | Texp_apply (e, l) ->
+      line i ppf "Pexp_apply\n";
+      expression i ppf e;
+      list i label_x_expression ppf l;
+  | Texp_match (e, l, partial) ->
+      line i ppf "Pexp_match\n";
+      expression i ppf e;
+      list i pattern_x_expression_case ppf l;
+  | Texp_try (e, l) ->
+      line i ppf "Pexp_try\n";
+      expression i ppf e;
+      list i pattern_x_expression_case ppf l;
+  | Texp_tuple (l) ->
+      line i ppf "Pexp_tuple\n";
+      list i expression ppf l;
+  | Texp_construct (li, _, eo, b) ->
+      line i ppf "Pexp_construct %a\n" fmt_longident li;
+      list i expression ppf eo;
+      bool i ppf b;
+  | Texp_variant (l, eo) ->
+      line i ppf "Pexp_variant \"%s\"\n" l;
+      option i expression ppf eo;
+  | Texp_record (l, eo) ->
+      line i ppf "Pexp_record\n";
+      list i longident_x_expression ppf l;
+      option i expression ppf eo;
+  | Texp_field (e, li, _) ->
+      line i ppf "Pexp_field\n";
+      expression i ppf e;
+      longident i ppf li;
+  | Texp_setfield (e1, li, _, e2) ->
+      line i ppf "Pexp_setfield\n";
+      expression i ppf e1;
+      longident i ppf li;
+      expression i ppf e2;
+  | Texp_array (l) ->
+      line i ppf "Pexp_array\n";
+      list i expression ppf l;
+  | Texp_ifthenelse (e1, e2, eo) ->
+      line i ppf "Pexp_ifthenelse\n";
+      expression i ppf e1;
+      expression i ppf e2;
+      option i expression ppf eo;
+  | Texp_sequence (e1, e2) ->
+      line i ppf "Pexp_sequence\n";
+      expression i ppf e1;
+      expression i ppf e2;
+  | Texp_while (e1, e2) ->
+      line i ppf "Pexp_while\n";
+      expression i ppf e1;
+      expression i ppf e2;
+  | Texp_for (s, _, e1, e2, df, e3) ->
+      line i ppf "Pexp_for \"%a\" %a\n" fmt_ident s fmt_direction_flag df;
+      expression i ppf e1;
+      expression i ppf e2;
+      expression i ppf e3;
+  | Texp_when (e1, e2) ->
+      line i ppf "Pexp_when\n";
+      expression i ppf e1;
+      expression i ppf e2;
+  | Texp_send (e, Tmeth_name s, eo) ->
+      line i ppf "Pexp_send \"%s\"\n" s;
+      expression i ppf e;
+      option i expression ppf eo
+  | Texp_send (e, Tmeth_val s, eo) ->
+      line i ppf "Pexp_send \"%a\"\n" fmt_ident s;
+      expression i ppf e;
+      option i expression ppf eo
+  | Texp_new (li, _, _) -> line i ppf "Pexp_new %a\n" fmt_path li;
+  | Texp_setinstvar (_, s, _, e) ->
+      line i ppf "Pexp_setinstvar \"%a\"\n" fmt_path s;
+      expression i ppf e;
+  | Texp_override (_, l) ->
+      line i ppf "Pexp_override\n";
+      list i string_x_expression ppf l;
+  | Texp_letmodule (s, _, me, e) ->
+      line i ppf "Pexp_letmodule \"%a\"\n" fmt_ident s;
+      module_expr i ppf me;
+      expression i ppf e;
+  | Texp_assert (e) ->
+      line i ppf "Pexp_assert";
+      expression i ppf e;
+  | Texp_assertfalse ->
+      line i ppf "Pexp_assertfalse";
+  | Texp_lazy (e) ->
+      line i ppf "Pexp_lazy";
+      expression i ppf e;
+  | Texp_object (s, _) ->
+      line i ppf "Pexp_object";
+      class_structure i ppf s
+  | Texp_pack me ->
+      line i ppf "Pexp_pack";
+      module_expr i ppf me
+
+and value_description i ppf x =
+  line i ppf "value_description\n";
+  core_type (i+1) ppf x.val_desc;
+  list (i+1) string ppf x.val_prim;
+
+and string_option_underscore i ppf =
+  function
+    | Some x ->
+        string i ppf x.txt
+    | None ->
+        string i ppf "_"
+
+and type_declaration i ppf x =
+  line i ppf "type_declaration %a\n" fmt_location x.typ_loc;
+  let i = i+1 in
+  line i ppf "ptype_params =\n";
+  list (i+1) string_option_underscore ppf x.typ_params;
+  line i ppf "ptype_cstrs =\n";
+  list (i+1) core_type_x_core_type_x_location ppf x.typ_cstrs;
+  line i ppf "ptype_kind =\n";
+  type_kind (i+1) ppf x.typ_kind;
+  line i ppf "ptype_private = %a\n" fmt_private_flag x.typ_private;
+  line i ppf "ptype_manifest =\n";
+  option (i+1) core_type ppf x.typ_manifest;
+
+and type_kind i ppf x =
+  match x with
+  | Ttype_abstract ->
+      line i ppf "Ptype_abstract\n"
+  | Ttype_variant l ->
+      line i ppf "Ptype_variant\n";
+      list (i+1) string_x_core_type_list_x_location ppf l;
+  | Ttype_record l ->
+      line i ppf "Ptype_record\n";
+      list (i+1) string_x_mutable_flag_x_core_type_x_location ppf l;
+
+and exception_declaration i ppf x = list i core_type ppf x
+
+and class_type i ppf x =
+  line i ppf "class_type %a\n" fmt_location x.cltyp_loc;
+  let i = i+1 in
+  match x.cltyp_desc with
+  | Tcty_constr (li, _, l) ->
+      line i ppf "Pcty_constr %a\n" fmt_path li;
+      list i core_type ppf l;
+  | Tcty_signature (cs) ->
+      line i ppf "Pcty_signature\n";
+      class_signature i ppf cs;
+  | Tcty_fun (l, co, cl) ->
+      line i ppf "Pcty_fun \"%s\"\n" l;
+      core_type i ppf co;
+      class_type i ppf cl;
+
+and class_signature i ppf { csig_self = ct; csig_fields = l } =
+  line i ppf "class_signature\n";
+  core_type (i+1) ppf ct;
+  list (i+1) class_type_field ppf l;
+
+and class_type_field i ppf x =
+  let loc = x.ctf_loc in
+  match x.ctf_desc with
+  | Tctf_inher (ct) ->
+      line i ppf "Pctf_inher\n";
+      class_type i ppf ct;
+  | Tctf_val (s, mf, vf, ct) ->
+      line i ppf
+        "Pctf_val \"%s\" %a %a %a\n" s
+        fmt_mutable_flag mf fmt_virtual_flag vf fmt_location loc;
+      core_type (i+1) ppf ct;
+  | Tctf_virt (s, pf, ct) ->
+      line i ppf
+        "Pctf_virt \"%s\" %a %a\n" s fmt_private_flag pf fmt_location loc;
+      core_type (i+1) ppf ct;
+  | Tctf_meth (s, pf, ct) ->
+      line i ppf
+        "Pctf_meth \"%s\" %a %a\n" s fmt_private_flag pf fmt_location loc;
+      core_type (i+1) ppf ct;
+  | Tctf_cstr (ct1, ct2) ->
+      line i ppf "Pctf_cstr %a\n" fmt_location loc;
+      core_type i ppf ct1;
+      core_type i ppf ct2;
+
+and class_description i ppf x =
+  line i ppf "class_description %a\n" fmt_location x.ci_loc;
+  let i = i+1 in
+  line i ppf "pci_virt = %a\n" fmt_virtual_flag x.ci_virt;
+  line i ppf "pci_params =\n";
+  string_list_x_location (i+1) ppf x.ci_params;
+  line i ppf "pci_name = \"%s\"\n" x.ci_id_name.txt;
+  line i ppf "pci_expr =\n";
+  class_type (i+1) ppf x.ci_expr;
+
+and class_type_declaration i ppf x =
+  line i ppf "class_type_declaration %a\n" fmt_location x.ci_loc;
+  let i = i+1 in
+  line i ppf "pci_virt = %a\n" fmt_virtual_flag x.ci_virt;
+  line i ppf "pci_params =\n";
+  string_list_x_location (i+1) ppf x.ci_params;
+  line i ppf "pci_name = \"%s\"\n" x.ci_id_name.txt;
+  line i ppf "pci_expr =\n";
+  class_type (i+1) ppf x.ci_expr;
+
+and class_expr i ppf x =
+  line i ppf "class_expr %a\n" fmt_location x.cl_loc;
+  let i = i+1 in
+  match x.cl_desc with
+  | Tcl_ident (li, _, l) ->
+      line i ppf "Pcl_constr %a\n" fmt_path li;
+      list i core_type ppf l;
+  | Tcl_structure (cs) ->
+      line i ppf "Pcl_structure\n";
+      class_structure i ppf cs;
+  | Tcl_fun (l, eo, p, e, _) -> assert false (* TODO *)
+(*      line i ppf "Pcl_fun\n";
+      label i ppf l;
+      option i expression ppf eo;
+      pattern i ppf p;
+      class_expr i ppf e; *)
+  | Tcl_apply (ce, l) ->
+      line i ppf "Pcl_apply\n";
+      class_expr i ppf ce;
+      list i label_x_expression ppf l;
+  | Tcl_let (rf, l1, l2, ce) ->
+      line i ppf "Pcl_let %a\n" fmt_rec_flag rf;
+      list i pattern_x_expression_def ppf l1;
+      list i ident_x_loc_x_expression_def ppf l2;
+      class_expr i ppf ce;
+  | Tcl_constraint (ce, Some ct, _, _, _) ->
+      line i ppf "Pcl_constraint\n";
+      class_expr i ppf ce;
+      class_type i ppf ct;
+  | Tcl_constraint (_, None, _, _, _) -> assert false
+        (* TODO : is it possible ? see parsetree *)
+
+and class_structure i ppf { cstr_pat = p; cstr_fields = l } =
+  line i ppf "class_structure\n";
+  pattern (i+1) ppf p;
+  list (i+1) class_field ppf l;
+
+and class_field i ppf x = assert false (* TODO *)
+(*  let loc = x.cf_loc in
+  match x.cf_desc with
+  | Tcf_inher (ovf, ce, so) ->
+      line i ppf "Pcf_inher %a\n" fmt_override_flag ovf;
+      class_expr (i+1) ppf ce;
+      option (i+1) string ppf so;
+  | Tcf_valvirt (s, mf, ct) ->
+      line i ppf "Pcf_valvirt \"%s\" %a %a\n"
+        s.txt fmt_mutable_flag mf fmt_location loc;
+      core_type (i+1) ppf ct;
+  | Tcf_val (s, mf, ovf, e) ->
+      line i ppf "Pcf_val \"%s\" %a %a %a\n"
+        s.txt fmt_mutable_flag mf fmt_override_flag ovf fmt_location loc;
+      expression (i+1) ppf e;
+  | Tcf_virt (s, pf, ct) ->
+      line i ppf "Pcf_virt \"%s\" %a %a\n"
+        s.txt fmt_private_flag pf fmt_location loc;
+      core_type (i+1) ppf ct;
+  | Tcf_meth (s, pf, ovf, e) ->
+      line i ppf "Pcf_meth \"%s\" %a %a %a\n"
+        s.txt fmt_private_flag pf fmt_override_flag ovf fmt_location loc;
+      expression (i+1) ppf e;
+  | Tcf_constr (ct1, ct2) ->
+      line i ppf "Pcf_constr %a\n" fmt_location loc;
+      core_type (i+1) ppf ct1;
+      core_type (i+1) ppf ct2;
+  | Tcf_init (e) ->
+      line i ppf "Pcf_init\n";
+      expression (i+1) ppf e;
+*)
+
+and class_declaration i ppf x =
+  line i ppf "class_declaration %a\n" fmt_location x.ci_loc;
+  let i = i+1 in
+  line i ppf "pci_virt = %a\n" fmt_virtual_flag x.ci_virt;
+  line i ppf "pci_params =\n";
+  string_list_x_location (i+1) ppf x.ci_params;
+  line i ppf "pci_name = \"%s\"\n" x.ci_id_name.txt;
+  line i ppf "pci_expr =\n";
+  class_expr (i+1) ppf x.ci_expr;
+
+and module_type i ppf x =
+  line i ppf "module_type %a\n" fmt_location x.mty_loc;
+  let i = i+1 in
+  match x.mty_desc with
+  | Tmty_ident (li,_) -> line i ppf "Pmty_ident %a\n" fmt_path li;
+  | Tmty_signature (s) ->
+      line i ppf "Pmty_signature\n";
+      signature i ppf s;
+  | Tmty_functor (s, _, mt1, mt2) ->
+      line i ppf "Pmty_functor \"%a\"\n" fmt_ident s;
+      module_type i ppf mt1;
+      module_type i ppf mt2;
+  | Tmty_with (mt, l) ->
+      line i ppf "Pmty_with\n";
+      module_type i ppf mt;
+      list i longident_x_with_constraint ppf l;
+  | Tmty_typeof m ->
+      line i ppf "Pmty_typeof\n";
+      module_expr i ppf m;
+
+and signature i ppf x = list i signature_item ppf x.sig_items
+
+and signature_item i ppf x =
+  line i ppf "signature_item %a\n" fmt_location x.sig_loc;
+  let i = i+1 in
+  match x.sig_desc with
+  | Tsig_value (s, _, vd) ->
+      line i ppf "Psig_value \"%a\"\n" fmt_ident s;
+      value_description i ppf vd;
+  | Tsig_type (l) ->
+      line i ppf "Psig_type\n";
+      list i string_x_type_declaration ppf l;
+  | Tsig_exception (s, _, ed) ->
+      line i ppf "Psig_exception \"%a\"\n" fmt_ident s;
+      exception_declaration i ppf ed.exn_params;
+  | Tsig_module (s, _, mt) ->
+      line i ppf "Psig_module \"%a\"\n" fmt_ident s;
+      module_type i ppf mt;
+  | Tsig_recmodule decls ->
+      line i ppf "Psig_recmodule\n";
+      list i string_x_module_type ppf decls;
+  | Tsig_modtype (s, _, md) ->
+      line i ppf "Psig_modtype \"%a\"\n" fmt_ident s;
+      modtype_declaration i ppf md;
+  | Tsig_open (ovf, li,_) ->
+    line i ppf "Psig_open %a %a\n" fmt_override_flag ovf fmt_path li;
+  | Tsig_include (mt, _) ->
+      line i ppf "Psig_include\n";
+      module_type i ppf mt;
+  | Tsig_class (l) ->
+      line i ppf "Psig_class\n";
+      list i class_description ppf l;
+  | Tsig_class_type (l) ->
+      line i ppf "Psig_class_type\n";
+      list i class_type_declaration ppf l;
+
+and modtype_declaration i ppf x =
+  match x with
+  | Tmodtype_abstract -> line i ppf "Pmodtype_abstract\n";
+  | Tmodtype_manifest (mt) ->
+      line i ppf "Pmodtype_manifest\n";
+      module_type (i+1) ppf mt;
+
+and with_constraint i ppf x =
+  match x with
+  | Twith_type (td) ->
+      line i ppf "Pwith_type\n";
+      type_declaration (i+1) ppf td;
+  | Twith_typesubst (td) ->
+      line i ppf "Pwith_typesubst\n";
+      type_declaration (i+1) ppf td;
+  | Twith_module (li,_) -> line i ppf "Pwith_module %a\n" fmt_path li;
+  | Twith_modsubst (li,_) -> line i ppf "Pwith_modsubst %a\n" fmt_path li;
+
+and module_expr i ppf x =
+  line i ppf "module_expr %a\n" fmt_location x.mod_loc;
+  let i = i+1 in
+  match x.mod_desc with
+  | Tmod_ident (li,_) -> line i ppf "Pmod_ident %a\n" fmt_path li;
+  | Tmod_structure (s) ->
+      line i ppf "Pmod_structure\n";
+      structure i ppf s;
+  | Tmod_functor (s, _, mt, me) ->
+      line i ppf "Pmod_functor \"%a\"\n" fmt_ident s;
+      module_type i ppf mt;
+      module_expr i ppf me;
+  | Tmod_apply (me1, me2, _) ->
+      line i ppf "Pmod_apply\n";
+      module_expr i ppf me1;
+      module_expr i ppf me2;
+  | Tmod_constraint (me, _, Tmodtype_explicit mt, _) ->
+      line i ppf "Pmod_constraint\n";
+      module_expr i ppf me;
+      module_type i ppf mt;
+  | Tmod_constraint (me, _, Tmodtype_implicit, _) -> assert false (* TODO *)
+(*      line i ppf "Pmod_constraint\n";
+      module_expr i ppf me;
+      module_type i ppf mt; *)
+  | Tmod_unpack (e, _) ->
+      line i ppf "Pmod_unpack\n";
+      expression i ppf e;
+
+and structure i ppf x = list i structure_item ppf x.str_items
+
+and structure_item i ppf x =
+  line i ppf "structure_item %a\n" fmt_location x.str_loc;
+  let i = i+1 in
+  match x.str_desc with
+  | Tstr_eval (e) ->
+      line i ppf "Pstr_eval\n";
+      expression i ppf e;
+  | Tstr_value (rf, l) ->
+      line i ppf "Pstr_value %a\n" fmt_rec_flag rf;
+      list i pattern_x_expression_def ppf l;
+  | Tstr_primitive (s, _, vd) ->
+      line i ppf "Pstr_primitive \"%a\"\n" fmt_ident s;
+      value_description i ppf vd;
+  | Tstr_type l ->
+      line i ppf "Pstr_type\n";
+      list i string_x_type_declaration ppf l;
+  | Tstr_exception (s, _, ed) ->
+      line i ppf "Pstr_exception \"%a\"\n" fmt_ident s;
+      exception_declaration i ppf ed.exn_params;
+  | Tstr_exn_rebind (s, _, li, _) ->
+      line i ppf "Pstr_exn_rebind \"%a\" %a\n" fmt_ident s fmt_path li;
+  | Tstr_module (s, _, me) ->
+      line i ppf "Pstr_module \"%a\"\n" fmt_ident s;
+      module_expr i ppf me;
+  | Tstr_recmodule bindings ->
+      line i ppf "Pstr_recmodule\n";
+      list i string_x_modtype_x_module ppf bindings;
+  | Tstr_modtype (s, _, mt) ->
+      line i ppf "Pstr_modtype \"%a\"\n" fmt_ident s;
+      module_type i ppf mt;
+  | Tstr_open (ovf, li, _) ->
+    line i ppf "Pstr_open %a %a\n" fmt_override_flag ovf fmt_path li;
+  | Tstr_class (l) ->
+      line i ppf "Pstr_class\n";
+      list i class_declaration ppf (List.map (fun (cl, _,_) -> cl) l);
+  | Tstr_class_type (l) ->
+      line i ppf "Pstr_class_type\n";
+      list i class_type_declaration ppf (List.map (fun (_, _, cl) -> cl) l);
+  | Tstr_include (me, _) ->
+      line i ppf "Pstr_include";
+      module_expr i ppf me
+
+and string_x_type_declaration i ppf (s, _, td) =
+  ident i ppf s;
+  type_declaration (i+1) ppf td;
+
+and string_x_module_type i ppf (s, _, mty) =
+  ident i ppf s;
+  module_type (i+1) ppf mty;
+
+and string_x_modtype_x_module i ppf (s, _, mty, modl) =
+  ident i ppf s;
+  module_type (i+1) ppf mty;
+  module_expr (i+1) ppf modl;
+
+and longident_x_with_constraint i ppf (li, _, wc) =
+  line i ppf "%a\n" fmt_path li;
+  with_constraint (i+1) ppf wc;
+
+and core_type_x_core_type_x_location i ppf (ct1, ct2, l) =
+  line i ppf " %a\n" fmt_location l;
+  core_type (i+1) ppf ct1;
+  core_type (i+1) ppf ct2;
+
+and string_x_core_type_list_x_location i ppf (s, _, l, r_opt) =
+  line i ppf "\"%a\"\n" fmt_ident s;
+  list (i+1) core_type ppf l;
+(*  option (i+1) core_type ppf r_opt; *)
+
+and string_x_mutable_flag_x_core_type_x_location i ppf (s, _, mf, ct, loc) =
+  line i ppf "\"%a\" %a %a\n" fmt_ident s fmt_mutable_flag mf fmt_location loc;
+  core_type (i+1) ppf ct;
+
+and string_list_x_location i ppf (l, loc) =
+  line i ppf " %a\n" fmt_location loc;
+  list (i+1) string_loc ppf l;
+
+and longident_x_pattern i ppf (li, _, p) =
+  line i ppf "%a\n" fmt_longident li;
+  pattern (i+1) ppf p;
+
+and pattern_x_expression_case i ppf (p, e) =
+  line i ppf "\n";
+  pattern (i+1) ppf  p;
+  expression (i+1) ppf e;
+
+and pattern_x_expression_def i ppf (p, e) =
+  line i ppf "\n";
+  pattern (i+1) ppf p;
+  expression (i+1) ppf e;
+
+and string_x_expression i ppf (s, _, e) =
+  line i ppf " \"%a\"\n" fmt_path s;
+  expression (i+1) ppf e;
+
+and longident_x_expression i ppf (li, _, e) =
+  line i ppf "%a\n" fmt_longident li;
+  expression (i+1) ppf e;
+
+and label_x_expression i ppf (l, e, _) =
+  line i ppf "